This commit was generated by cvs2svn to compensate for changes in r27676,

which included commits to RCS files with non-trunk default branches.

272 files changed, 81627 insertions, 17641 deletions

diff --git a/contrib/tcl/README b/contrib/tcl/README
index 5b647be..8c091b2 100644
--- a/contrib/tcl/README
+++ b/contrib/tcl/README
@@ -1,22 +1,22 @@
 Tcl
 
-SCCS: @(#) README 1.32 96/07/31 16:29:01
+SCCS: @(#) README 1.45 97/06/25 11:02:14
 
 1. Introduction
 ---------------
 
 This directory and its descendants contain the sources and documentation
 for Tcl, an embeddable scripting language.  The information here
-corresponds to release 7.5p1, the first patch release for Tcl 7.5.  The
-most important new feature in Tcl 7.5 is support for the PC and Mac
-platforms.  In addition, there are major new facilities for dynamic
-loading, package and version management, multiple interpreters, safe
-execution of untrusted scripts, and a new I/O system that supports
-nonblocking I/O and sockets.  This release also contains many bug fixes.
-Tcl 7.5 should be backwards compatible with Tcl 7.4 scripts (there are
-two small incompatibilities described below, but they are relatively
-insignificant and shouldn't affect most existing Tcl code and
-extensions).
+corresponds to release 8.0b2, the second (and probably final) beta
+release for Tcl 8.0. Tcl 8.0 is a major new release that replaces the
+core of the interpreter with an on-the-fly bytecode compiler to improve
+execution speed.  It also includes several other new features such as
+namespaces and binary I/O, plus many bug fixes.  The compiler introduces
+a few incompatibilities that may affect existing Tcl scripts; the
+incompatibilities are relatively obscure but may require modifications
+to some old scripts before they can run with this version. The compiler
+introduces many new C-level APIs, but the old APIs are still supported.
+See below for more details.
 
 2. Documentation
 ----------------
@@ -50,10 +50,11 @@ using the normal "man" mechanisms, such as
 		man Tcl
 
 There is also an official home for Tcl and Tk on the Web:
-	http://www.sunlabs.com/research/tcl
-These Web pages include release updates, reports on bug fixes and porting
-issues, HTML versions of the manual pages, and pointers to many other
-Tcl/Tk Web pages at other sites.  Check them out!
+	http://sunscript.sun.com
+These Web pages include information about the latest releases, products
+related to Tcl and Tk, reports on bug fixes and porting issues, HTML
+versions of the manual pages, and pointers to many other Tcl/Tk Web
+pages at other sites.  Check them out!
 
 3. Compiling and installing Tcl
 -------------------------------
@@ -66,13 +67,13 @@ Before trying to compile Tcl you should do the following things:
 
     (a) Check for a binary release.  Pre-compiled binary releases are
         available now for PCs, Macintoshes, and several flavors of UNIX.
-	Binary releases are much easier to install than source releases.
-	To find out whether a binary release is available for your platform,
-	check the home page for the Sun Tcl/Tk project
-	(http://www.sunlabs.com/research/tcl) and also check in the FTP
-	directory from which you retrieved the base distribution.  Some
-	of the binary releases are available freely, while others are for
-	sale.
+        Binary releases are much easier to install than source releases.
+        To find out whether a binary release is available for your
+        platform, check the home page for SunScript
+        (http://sunscript.sun.com) under "Tech Corner".  Also, check in
+        the FTP directory from which you retrieved the base
+        distribution.  Some of the binary releases are available freely,
+        while others are for sale.
 
     (b) Make sure you have the most recent patch release.  Look in the
 	FTP directory from which you retrieved this distribution to see
@@ -80,30 +81,30 @@ Before trying to compile Tcl you should do the following things:
 	without changing any features, so you should normally use the
 	latest patch release for the version of Tcl that you want. 
 	Patch releases are available in two forms.  A file like
-	tcl7.5p1.tar.Z is a complete release for patch level 1 of Tcl
-	version 7.5.  If there is a file with a higher patch level than
+	tcl8.0p1.tar.Z is a complete release for patch level 1 of Tcl
+	version 8.0.  If there is a file with a higher patch level than
 	this release, just fetch the file with the highest patch level
 	and use it.
 
 	Patches are also available in the form of patch files that just
 	contain the changes from one patch level to another.  These
-	files have names like tcl7.5p1.patch, tcl7.5p2.patch, etc.  They
+	files will have names like tcl8.0p1.patch, tcl8.0p2.patch, etc.  They
 	may also have .gz or .Z extensions to indicate compression.  To
 	use one of these files, you apply it to an existing release with
 	the "patch" program.  Patches must be applied in order:
-	tcl7.5p1.patch must be applied to an unpatched Tcl 7.5 release
-	to produce a Tcl 7.5p1 release;  tcl7.5p2.patch can then be
-	applied to Tcl7.5 p1 to produce Tcl 7.5 p2, and so on. To apply an
-	uncompressed patch file such as tcl7.5p1.patch, invoke a shell
+	tcl8.0p1.patch must be applied to an unpatched Tcl 8.0 release
+	to produce a Tcl 8.0p1 release;  tcl8.0p2.patch can then be
+	applied to Tcl8.0p1 to produce Tcl 8.0p2, and so on. To apply an
+	uncompressed patch file such as tcl8.0p1.patch, invoke a shell
 	command like the following from the directory containing this
 	file:
-	    patch -p < tcl7.5p1.patch
+	    patch -p < tcl8.0p1.patch
 	If the patch file has a .gz extension, invoke a command like the
 	following:
-	    gunzip -c tcl7.5p1.patch.gz | patch -p
+	    gunzip -c tcl8.0p1.patch.gz | patch -p
 	If the patch file has a .Z extension, it was compressed with
 	compress.  To apply it, invoke a command like the following:
-	    zcat tcl7.5p1.patch.Z | patch -p
+	    zcat tcl8.0p1.patch.Z | patch -p
 	If you're applying a patch to a release that has already been
 	compiled, then before applying the patch you should cd to the
 	"unix" subdirectory and type "make distclean" to restore the
@@ -115,140 +116,132 @@ compiling under UNIX, "win" if you're compiling under Windows, or
 in the README file in that directory for compiling Tcl, installing it,
 and running the test suite.
 
-4. Summary of changes in Tcl 7.5
+4. Summary of changes in Tcl 8.0
 --------------------------------
 
-The most important change for Tcl 7.5 is that Tcl now runs on Macintosh
-and PC platforms as well as UNIX.  The PC port runs under Windows 3.1
-(with Win32s), Windows 95, and Windows NT.  This required a lot of
-reorganization of the sources but it didn't require any changes to
-Tcl's externally visible interfaces.
-
-In addition to the ports, Tcl 7.5 also has many other new features.
-The following feature changes have occurred since Tcl 7.4:
-
-    1. Dynamic loading.  There is a new "load" command for loading binary
-    extensions into Tcl on the fly.  This works now on most of the major
-    UNIX platforms as well as PCs and Macintoshes.  Three new "info"
-    commands, "info loaded", "info sharedlibextension", and
-    "info nameofexecutable", were also added as part of the dynamic loading
-    implementation.  You can also create Tcl and Tk themselves as shared
-    libraries with the --enable-shared switch to the configure script.
-
-    2. Packages and versions.  There is a new "package" command for
-    package and version management.  See the manual entries for "package"
-    and "pkg_mkIndex" for details on how to use it.  There are also
-    C APIs to the package mechanism.  See PkgRequire.3.
-    
-    3. Multiple interpreters and Safe-Tcl.  There is a new "interp" command
-    that allows you to create multiple interpreters within a single application
-    and set up communication between them with "aliases".  The mechanism also
-    supports "safe" interpreters, which provide a generalized version of the
-    security mechanisms in Borenstein and Rose's Safe-Tcl.  There are still
-    a few missing security features, such as resource control.  You can use
-    "load" to add extensions (including Tk) into slave interpreters.
-
-    4. The event loop from Tk has been moved to Tcl.  Tcl now has commands
-    "after", "fileevent", "update", and "vwait" (which replaces tkwait).
-    The "tkerror" command has been renamed to "bgerror".  "Tkerror" is
-    still supported for backwards compatibility, but you should switch ASAP
-    to using "bgerror" instead.  Many C procedures that used to be in Tk
-    have been moved to Tcl and renamed, such as Tcl_DoOneEvent, Tcl_DoWhenIdle,
-    Tcl_CreateFileHandler, and Tcl_CreateTimerHandler.
-
-    5. Tcl has a whole new I/O system.  All of the Tcl commands like
-    "open" and "puts" should continue to operate as before, but there
-    is a totally new implementation that doesn't use the C stdio library:
-	- The new I/O system is more portable, and it can be extended
-	  with new kinds of I/O channels;  see CrtChannel.3 for details.
-	- Nonblocking I/O is supported on all platforms and there is a
-	  new command "fconfigure" to enable it and other channel options;
-	  see fconfigure.n for details.  There is also a new "fblocked"
-	  command.
-	- The I/O system automatically translates between different
-	  end-of-line representations (such as CR on Macs and CRLF on
-	  PC's) to the newline form used in UNIX and in all Tcl scripts;
-	  the "fconfigure" command can be used to control this feature.
-	- There is a set of C APIs for manipulating Tcl_Channel's, which
-	  are analogous to UNIX FILE's.  The C procedures have roughly the
-	  same functionality as the stdio procedures.  See OpenFileChnl.3,
-	  CrtCloseHdlr.3, and CrtChnlHdlr.3 for details.
-	- There is a new structure Tcl_File that provides platform-
-	  independent access to file handles such as UNIX fd's.  See
-	  GetFile.3 for details.
-	- There are new procedures Tcl_GetErrno and Tcl_SetErrno for
-	  accessing the "errno" variable in a safe and portable fashion.
-	  See SetErrno.3.
-
-    6. There are new commands "file split", "file join", and "file pathtype",
-    which make it possible to handle file names in a way that will work on
-    all platforms.  See the manual entries file.n and filename.n for
-    details.
-
-    7. There is a new "socket" command for network communication via
-    TCP sockets.  It works for both the client and server sides.  There
-    is also C-level support for sockets;  see OpenTcp.3.
-
-    8. There is a new "clock" command, which contains the functionality
-    of the TclX clock-handling commands.
-
-    9. The "foreach" command has been generalized significantly to support
-    multiple lists and multiple variables iterating over each list.
-
-    10. There is a new "notifier" mechanism, which was added as part of
-    the ports.  This allows the basic mechanisms for reporting events
-    to be implemented in different ways on different platforms.  It
-    may also be useful for other purposes, such as merging the Tk and
-    Xt event loops so that Tk and Xt widgets can coexist in a single
-    application.  See the manual entry Notifier.3 for more information.
-
-    11. There is an "AssocData" mechanism that allows extensions to store
-    their own data in an interpreter and get called back when the interpreter
-    is deleted.  This is visible at C level via the procedures Tcl_SetAssocData
-    and Tcl_GetAssocData.
-
-    12. When manual pages are installed, additional links are created for
-    each of the procedures described in the manual page, so that it's
-    easier to invoke the "man" command.
-
-    13. There is a new variable "tcl_platform" with platform information.
-    This is an associative array with elements like "os" and "machine"
-    that contain various pieces of information about the platform.
-
-    14. There is a new procedure Tcl_CreateExitHandler that you can use to
-    make sure a C procedure is called before the Tcl application exits.
-
-    15. There is a new procedure Tcl_UpdateLinkedVar to force the Tcl-level
-    variable to be updated after you've changed the corresponding C-level
-    variable.
-
-    16. The procedures Tk_Preserve, Tk_Release, and Tk_EventuallyFree
-    have been moved from Tk to Tcl and given names like Tcl_Preserve.
-
-Three incompatibilities were introduced by the changes.  All of these
-are at C-level, and only the first one should have much impact.  Existing
-scripts for Tcl 7.4 should run unchanged  under Tcl 7.5.
-
-    1. The procedure Tcl_EnterFile no longer exists.  However, a new
-    procedure Tcl_MakeFileChannel provides similar functionality.
-    Tcl_GetOpenFile still exists but only works under UNIX.
-    Tcl_CreatePipeline also remains, but it too works only under UNIX
-    now;  use Tcl_OpenCommandChannel for better portability.
-
-    2. Tcl doesn't export any global C variables anymore, because this doesn't
-    work with Windows DLLs.  The C variables tcl_AsyncReady and
-    tcl_FileCloseProc have been replaced with procedures Tcl_AsyncReady()
-    and Tcl_SetFileCloseProc().  The C variable tcl_RcFileName has been
-    replaced with a Tcl variable tcl_rcFileName (use Tcl_SetVar to set the
-    Tcl variable, instead of assigning to the old C variable).
-    
-    3. Files are no longer shared between interpreters by default:  if a
-    file is opened in one interpreter, it cannot normally be used in other
-    interpreters.  However, the new procedure Tcl_ShareHandle allows files
-    to be shared between interpreters if requested explicitly.
-
-For a complete list of all changes in this release, see the file "changes"
-in this directory.
+Here are the most significant changes in Tcl 8.0.  In addition to these
+changes, there are several smaller changes and bug fixes.  See the file
+"changes" for a complete list of all changes.
+
+    1. Bytecode compiler.  The core of the Tcl interpreter has been
+    replaced with an on-the-fly compiler that translates Tcl scripts to
+    byte codes; a new interpreter then executes the byte codes. In
+    earlier versions of Tcl, strings were used as a universal
+    representation;  in Tcl 8.0 strings are replaced with Tcl_Obj
+    structures ("objects") that can hold both a string value and an
+    internal form such as a binary integer or compiled bytecodes.  The
+    new objects make it possible to store information in efficient
+    internal forms and avoid the constant translations to and from
+    strings that occurred with the old interpreter.  We have not yet
+    converted all of Tcl to take full advantage of the compiler and
+    objects and have not converted any of Tk yet, but even so you
+    should see speedups of 2-3x on many programs and you may see
+    speedups as much as 10-20x in some cases (such as code that
+    manipulates long lists).  Future releases should achieve even
+    greater speedups.  The compiler introduces only a few minor changes
+    at the level of Tcl scripts, but it introduces many new C APIs for
+    managing objects.  See, for example, the manual entries doc/*Obj*.3.
+
+    2. Namespaces.  There is a new namespace mechanism based on the
+    namespace implementation by Michael McLennan of Lucent Technologies.
+    This includes new "namespace" and "variable" commands.  There are
+    many new C APIs associated with namespaces, but they will not be
+    exported until Tcl 8.1.  Note: the syntax of the namespace command
+    has been changed slightly since the b1 release.  See the changes
+    file for details.
+
+    3. Binary I/O.  The new object system in Tcl 8.0 supports binary
+    strings (internally, strings are counted in addition to being null
+    terminated).  There is a new "binary" command for inserting and
+    extracting data to/from binary strings.  Commands such as "puts",
+    "gets", and "read" commands now operate correctly on binary data. 
+    There is a new variable tcl_platform(byteOrder) to identify the
+    native byte order for the current host.
+
+    4. Random numbers.  The "expr" command now contains a random number
+    generator, which can be accessed via the "rand()" and "srand()" math
+    functions.
+
+    5. Safe-Tcl enhancements.  There is a new "hidden command"
+    mechanism, implemented with the Tcl commands "interp hide", "interp
+    expose", "interp invokehidden", and "interp hidden" and the C APIs
+    Tcl_HideCommand and Tcl_ExposeCommand.  There is now support for
+    loadable security policies, including new library procedures such as
+    tcl_safeCreateInterp.
+
+    6. There is a new package "registry" available under Windows for
+    accessing the Windows registry.
+
+    7. There is a new command "file attributes" for getting and setting
+    things like permissions and owner.  There is also a new command
+    "file nativename" for getting back the platform-specific name for a
+    particular file.
+
+    8. There is a new "fcopy" command to copy data between channels. 
+    This replaces and improves upon the not-so-secret unsupported old
+    command "unsupported0".
+
+    9. There is a new package "http" for doing GET, POST, and HEAD
+    requests via the HTTP/1.0 protocol.  See the manual entry http.n
+    for details.
+
+    10. There are new library procedures for finding word breaks in
+    strings.  See the manual entry library.n for details.
+
+    11. There are new C APIs Tcl_Finalize (for cleaning up before
+    unloading the Tcl DLL) and Tcl_Ungets for pushing bytes back into a
+    channel's input buffer.
+
+    12. Tcl now supports serial I/O devices on Windows and Unix, with a
+    new fconfigure -mode option.  The Windows driver does not yet
+    support event-driven I/O.
+
+    13. The lsort command has new options -dictionary and -index.  The
+    -index option allows for very rapid sorting based on an element
+    of a list.
+
+    14. The event notifier has been completely rewritten (again).  It
+    should now allow Tcl to use an external event loop (like Motif's)
+    when it is embedded in other applications.  No script-level
+    interfaces have changed, but many of the C APIs have.
+
+Tcl 8.0 introduces the following incompatibilities that may affect Tcl
+scripts that worked under Tcl 7.6 and earlier releases:
+
+    1. Variable and command names may not include the character sequence
+    "::" anymore: this sequence is now used as a namespace separator.
+
+    2. The semantics of some Tcl commands have been changed slightly to
+    maximize performance under the compiler.  These incompatibilities
+    are documented on the Web so that we can keep the list up-to-date.
+    See the URL http://www.sunlabs.com/research/tcl/compiler.html.
+
+    3. 2-digit years are now parsed differently by the "clock" command
+    to handle year 2000 issues better (years 00-38 are treated as
+    2000-2038 instead of 1900-1938).
+
+    4. The old Macintosh commands "cp", "mkdir", "mv", "rm", and "rmdir"
+    are no longer supported; all of these features are now available on
+    all platforms via the "file" command.
+
+    5. Support for the variable tcl_precision is mostly removed; when
+    real values are converted back to strings, the full 17 digits of
+    precision are always used.
+
+    6. The C APIs associated with the notifier have changed substantially.
+
+    7. The procedures Tcl_CreateModalTimeout and Tcl_DeleteModalTimeout
+    have been removed.
+
+    8. Tcl_CreateFileHandler and Tcl_DeleteFileHandler now take Unix
+    fd's and are only supported on the Unix platform
+
+    9. The C APIs for creating channel drivers have changed as part of
+    the new notifier implementation.  The Tcl_File interfaces have been
+    removed.  Tcl_GetChannelFile has been replaced with
+    Tcl_GetChannelHandle.  Tcl_MakeFileChannel now takes a platform-
+    specific file handle.  Tcl_DriverGetOptionProc procedures now take
+    an additional interp argument.
 
 5. Tcl newsgroup
 -----------------
@@ -284,8 +277,8 @@ We're very interested in receiving bug reports and suggestions for
 improvements.  We prefer that you send this information to the
 comp.lang.tcl newsgroup rather than to any of us at Sun.  We'll see
 anything on comp.lang.tcl, and in addition someone else who reads 
-omp.lang.tcl may be able to offer a solution.  The normal turn-around
-time for bugs is 2-4 weeks.  Enhancements may take longer and may not
+comp.lang.tcl may be able to offer a solution.  The normal turn-around
+time for bugs is 3-6 weeks.  Enhancements may take longer and may not
 happen at all unless there is widespread support for them (we're
 trying to slow the rate at which Tcl turns into a kitchen sink).  It's
 very difficult to make incompatible changes to Tcl at this point, due
@@ -346,6 +339,6 @@ be any more incompatibilities until the next release with a new major
 version number.
 
 Patch releases have a suffix such as p1 or p2.  These releases contain
-bug fixes only.  A patch release (e.g Tcl 7.5p2) should be completely
+bug fixes only.  A patch release (e.g Tcl 7.6p2) should be completely
 compatible with the base release from which it is derived (e.g. Tcl
-7.5), and you should normally use the highest available patch release.
+7.6), and you should normally use the highest available patch release.
diff --git a/contrib/tcl/changes b/contrib/tcl/changes
index 1eaf9e6..9390e86 100644
--- a/contrib/tcl/changes
+++ b/contrib/tcl/changes
@@ -1,6 +1,6 @@
 Recent user-visible changes to Tcl:
 
-SCCS: @(#) changes 1.142 96/08/01 17:00:22
+SCCS: @(#) changes 1.251 97/06/30 08:48:28
 
 1. No more [command1] [command2] construct for grouping multiple
 commands on a single command line.
@@ -128,7 +128,7 @@ Tcl_Eval.
 that came after version 3.3 was released.
 
 40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach.
-
+ 
 41. 5/23/91 Massive revision to Tcl parser to simplify the implementation
 of string and floating-point support in expressions.  Newlines inside
 [] are now treated as command separators rather than word separators
@@ -1322,7 +1322,7 @@ no longer shared between interpreters:  a file cannot normally be
 referenced in one interpreter if it was opened in another.  This
 feature is needed to support safe interpreters.  Added Tcl_ShareHandle()
 procedure for allowing files to be shared, and added "interp" argument
-to Tcl_FilePermissions procedure.
+to Tcl_FilePermissions procedure. (JL)
 *** POTENTIAL INCOMPATIBILITY ***
 
 9/11/95 (new feature) Added "AssocData" mechanism, whereby extensions
@@ -2179,3 +2179,918 @@ finished. The bug was reported by John Loverso and Steven Wahl,
 independently, test case supplied by John Loverso. (JL)
 
 ----------------- Released patch 7.5p1, 8/2/96 -----------------------
+
+5/8/96 (new feature) Added Tcl_GetChannelMode C API for retrieving whether
+a channel is open for reading and writing. (JL)
+
+5/8/96 (API changes) Revised C APIs for channel drivers:
+    - Removed all Tcl_Files from channel driver interface; you can now have
+      channels that are not based on Tcl_Files.
+    - Added channelReadyProc and watchChannelProc procedures to interface;
+      these are used to implement event notification for channels.
+    - Added getFileProc to channel driver, to allow the generic IO code
+      to retrieve a Tcl_File from a channel (presumably if the channel
+      uses Tcl_Files they will be stored inside its instanceData). (JL)
+*** INCOMPATIBILITY with Tcl 7.5 ***
+
+5/8/96 (API change) The Tcl_CreateChannel C API was modified to not take
+Tcl_File arguments, and instead to take a mask specifying whether the
+channel is readable and/or writable. (JL)
+*** INCOMPATIBILITY with Tcl 7.5 ***
+
+6/3/96 (bug fix) Made Tcl_SetVar2 robust against the case where the value
+of the variable is a NULL pointer instead of "". (JL)
+
+6/17/96 (bug fix) Fixed "reading uninitialized memory" error reported by
+Purify, in Tcl_Preserve/Tcl_Release. (JL)
+
+8/9/96 (bug fix) Fixed bug in init.tcl that caused incorrect error message
+if the act of autoloading a procedure caused the procedure to be invoked
+again. (JO)
+
+8/9/96 (bug fix) Configure script produced bad library names and extensions
+under SunOS and a few other platforms if the --disable-load switch was used.
+(JO)
+
+8/9/96 (bug fix) Tcl_UpdateLinkedVar generated an error if the variable
+being updated was read-only. (JO)
+
+8/14/96 (bug fix) The macintosh now supports synchronous socket
+connections.  Other minor bugs were also fixed. (RJ)
+
+8/15/96 (configuration improvement) Changed the file patchlevel.h
+to be tclPatch.h.  This avoids conflict with the Tk file and is now
+in 8.3 format on the Windows platform. (RJ)
+
+8/20/96 (bug fix) Fixed core dump in interp alias command for interpreters
+created with Tcl_CreateInterp (as opposed to with Tcl_CreateSlave). (JL)
+
+8/20/96 (bug fix) No longer masking ECONNRESET on Windows sockets so
+that the higher level of the IO mechanism sees the error instead of
+entering an infinite loop. (JL)
+
+8/20/96 (bug fix) Destroying the last interpreter no longer closes the
+standard channels. (JL)
+
+8/20/96 (bug fix) Closing one of the stdin, stdout or stderr channels and
+then opening a new channel now correctly assigns the new channel as the
+standard channel that was closed. (JL)
+
+8/20/96 (bug fix) Added code to unix/tclUnixChan.c for using ioctl with
+FIONBIO instead of fcntl with O_NONBLOCK, for those versions of Unix where
+either O_NONBLOCK is not supported or implemented incorrectly. (JL)
+
+8/21/96 (bug fix) Fixed "file extension" so it correctly returns the
+extension on files like "foo..c" as "..c" instead of ".c". (SS)
+
+8/22/96 (bug fix) If environ[] contains static strings, Tcl would core
+dump in TclSetupEnv because it was trying to write NULLs into the actual
+data in environ[]. Now we instead copy as appropriate. (JL)
+
+8/22/96 (added impl) Added missing implementation of Tcl_MakeTcpClientChannel
+for Windows platform. Code contributed by Mark Diekhans. (JL)
+
+8/22/96 (new feature) Added a new memory allocator for the Macintosh
+version of Tcl.  It's quite a bit faster than MetroWerk's version. (RJ)
+
+8/26/96 (documentation update) Removed old change bars (for all changes
+in Tcl 7.5 and earlier releases) from manual entries. (JO)
+
+8/27/96 (enhancement) The exec and open commands behave better and work in 
+more situations under Windows NT and Windows 95.  Documentation describes 
+what is still lacking. (CS)
+
+8/27/96 (enhancement) The Windows makefiles will now compile even if the
+compiler is not in the path and/or the compiler's environment variables
+have not been set up. (CS) 
+
+8/27/96 (configuration improvement) The Windows resource files are 
+automatically updated when the version/patch level changes.  The header file
+now has a comment that reminds the user which other files must be manually
+updated when the version/patch level changes. (CS)
+
+8/28/96 (new feature) Added file manipulation features (copy, rename, delete,
+mkdir) that are supported on all platforms. They are implemented as 
+subcommands to the "file" command. See the documentation for the "file"
+command for more information. (JH)
+
+----------------- Released 7.6b1, 8/30/96 -----------------------
+
+9/3/96 (bug fix) Simplified code so that standard channels are created
+lazily, they are added to an interpreter lazily, and they are never added
+to a safe interpreter. (JL)
+
+9/3/96 (bug fix) Closing a channel after closing a standard channel, e.g.
+stdout, would cause the implicit recreation of that standard channel. (JL)
+
+9/3/96 (new feature) Now calling Tcl_RegisterChannel with a NULL
+interpreter increments the refcount so that code outside any interpreter
+can use channels that are also registered in interpreters, without worrying
+that the channel may turn into a dangling pointer at any time. Calling
+Tcl_UnregisterChannel with a NULL interpreter only decrements the recount
+so that code outside any interpreter can safely declare it is no longer
+interested in a channel. (JL)
+
+9/4/96 (new features) Two changes to dynamic loading:
+    - If the file name is empty in the "load" command and there is no
+      statically loaded version of the package, a dynamically loaded
+      version will be used if there is one.
+    - Tcl_StaticPackage ignores redundant calls for the same package. (JO)
+
+9/6/96 (bug fix) Platform specific procedures for manipulating files are
+no longer macros and have been prefixed with "Tclp", such as TclpRenameFile.
+Unix file code now handles symbolic links and other special files correctly.
+The semantics of file copy and file rename has been changed so that if
+a target directory exists, the source files will NOT be merged with the
+existing files. (JH)
+
+9/6/96 (bug fix) If standard channel is NULL, because Tcl cannot connect
+to the standard channel, do not increment the refcount. The channel can
+be NULL if there is for example no standard input. (JL)
+
+9/6/96 (portability improvement) Changed parsing of backslash sequences
+like \n to translate directly to absolute values like 0xa instead of
+letting the compiler do the translation.  This guarantees that the
+translation is done the same everywhere. (JO)
+
+9/9/96 (bug fix) If channel is opened and not associated with any
+interpreter, but Tcl decides to use it as one of the standard channels, it
+became impossible to close the channel with Tcl_Close -- instead you had
+to call Tcl_UnregisterChannel. Fixed now so that it's safe to call
+Tcl_Close even when Tcl is using the channel as one of the standard ones. (JL)
+
+9/11/96 (feature change) The Tcl library is now placed in the Tcl
+shared libraries resource.  You no longer need to place the Tcl files
+in your applications explicitly.  (RJ)
+
+9/11/96 (feature change) Extensions no longer automatically have the
+resource fork of the extension opened for it.  Instead you need to
+use the tclMacLibrary.c file in your extension.  (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+9/12/96 (bug fix) The extension loading mechanism on the Macintosh now
+looks at the 'cfrg' resource to determine where to load the code
+fragment from.  This means FAT fragments should now work. (RJ)
+
+9/18/96 (enhancement) The exec and open commands behave better and work in
+more situations under Windows 3.X.  Documentation describes what is still
+lacking.  (CS)
+
+9/19/96 (bug fix) Fixed a panic which would occur if you delete a
+non-existent alias before any aliases are created. Now instead correctly
+returns an error that the alias is not found. (JL)
+
+9/19/96 (bug fix) Slave interpreters could rename aliases and they would
+not get deleted when the alias was being redefined. This led to dangling
+pointers etc. (JL)
+
+9/19/96 (bug fix) Fixed a panic where a hash table entry was being deleted
+twice during alias management operations. (JL)
+
+9/19/96 (bug fix) Fixed bug in event loop that could cause the input focus
+in Tk to get confused during menu traversal, among other problems.  The
+problem was related to handling of the "marker" when its event was
+deleted. (JO)
+
+9/26/96 (bug fix) Windows was losing EOF on a socket if the FD_CLOSE event
+happened to precede any left over FD_READ events. Now correctly remembers
+seeing FD_CLOSE, so that trailing FD_READ events are not discarded if they
+do not contain any data. This allows Tcl to correctly get a zero read and
+notice EOF. (JL)
+
+9/26/96 (bug fix) Was not resetting READABLE state properly on sockets
+under Windows if the driver discarded an FD_READ event because no data was
+present. Now correctly resets the state. (JL)
+
+9/30/96 (bug fix) Made EOF sticky on Windows sockets, so that fileevent
+readable will fire repeatedly until the socket is closed. Previously the
+fileevent fired only once. This could lead to never-closed connections if
+the Tcl script in the fileevent wasn't closing the socket immediately. (JL)
+
+10/2/96 (new feature) Improved the package loader:
+    - Added new variable tcl_pkgPath, which holds the default
+      directories under which packages are normally installed (each
+      package goes in a separate subdirectory of a directory in
+      $tcl_pkgPath).  These directories are included in auto_path by
+      default.
+    - Changed the package auto-loader to look for pkgIndex.tcl files 
+      not only in the auto_path directories but also in their immediate
+      children.  This should make it easier to install and uninstall
+      packages (don't have to change auto_path or merge pkgIndex.tcl
+      files). (JO)
+
+10/3/96 (bug fix) Changed tclsh to look for tclshrc.tcl instead of
+tclsh.rc on startup under Windows.  This is more consistent with wish and
+uses the right extension. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/8/96 (bug fix) Convertclock does not parse 24-hour times of the
+form "hhmm" correctly when hour = 00.  In the parse code, hour must be
+>= 100 for minutes to be non-zero.  Thanks to Lint LaCour for this
+bug fix. (RJ)
+
+10/11/96 (bug fix) Under Windows, the pid command returned the process
+handle instead of the process id. (SS)
+
+----------------- Released 7.6, 10/16/96 -----------------------
+
+10/29/96 (bug fix) Under Windows, sockets would consume 100% CPU time after
+the first accept(), due to a typo. (JL)
+
+10/29/96 (bug fix) Incorrect refcount management caused standard channels
+not to get deleted at process exit or DLL unload time, causing a memory
+leak of upwards of 20K each time. (JL)
+
+11/7/96 (bug fix) Auto-exec didn't work on file names that contained
+spaces. (JO)
+
+11/8/96 (bug fix) Fixed core dump that would occur if more than one call
+to Tcl_DeleteChannelHandler was made to delete a given channel handler. (JL)
+
+11/8/96 (bug fix) Fixed test for return value in Tcl_Seek and Tcl_SeekCmd
+to only treat -1 as error, instead of all negative numbers. (JL)
+
+11/12/96 (bug fix) Do not blocking waiting for processes at the end of a
+pipe during exit cleanup. (JL)
+
+11/12/96 (bug fix) If we are in exit cleanup, do not close the system level
+file descriptors 0, 1 and 2. Previously they were being closed which is
+incorrect, in the embedded case. This led to weird behavior for programs
+that want to interpose on I/O through the standard file descriptors (e.g.
+Netscape Navigator). (JL)
+
+11/15/96 (bug fix) Fixed core dump on Windows sockets due to dependency on
+deletion order at exit. Now all socket functions check to see if sockets
+are (still) initialized, before calling through function pointers. Before,
+they would call and might end up calling unloaded object code. (JL)
+
+11/15/96 (bug fix) Fixed core dump in Windows socket initialization routine
+if sockets were not installed on the system. Before, it was not properly
+checking the result of attempting to load the socket DLL, so it would call
+through uninitialized function pointers. (JL)
+
+11/15/96 (bug fix) Fixed memory leak in Windows sockets which left socket
+DLL handle open and could hold the socket DLL in memory uneccessarily,
+until a reboot. (JL)
+
+12/4/96 (bug fix) Fixed bug in Macintosh socket code that could result
+in lost data if a client was closed too soon after sending data. (RJ)
+
+12/17/96 (bug fix) Fixed deadlock bug in Windows sockets due to losing an
+event. This was happening because of an interaction between buffering and
+nonblocking mode on sockets. Now switched to sockets being blocking by
+default, so we are also no longer emulating blocking through a private
+event loop. (JL)
+
+1/21/97 (performance bug fix) Client TCP connections were slow to create
+because getservbyname was always called on the port.  Now this is only
+done if Tcl_GetInt fails. (BW)
+
+1/21/97 (configuration fix) Made it possible to override TCL_PACKAGE_PATH
+during make.  Previously it was only set during autoconf process.
+
+1/29/97 (bug fix) Fixed some problems with the clock command that
+impacted how dates were scaned after the year 2000. (RJ)
+
+----------------- Released 7.6p2, 1/31/97 -----------------------
+
+2/5/97 (bug fix) Fixed a bug where in CR-LF translation mode, \r bytes
+in the input stream were not being handled correctly. (JL)
+
+2/24/97 (bug fix) Fix bug with exec under Win32s not being able to create
+stderr file which caused all execs to fail.  Fixed temp file leak under
+Win32s.  Fixed optional parameter bug with SearchPath that only happened
+under Win32s 1.25. (CCS)
+
+----------------------------------------------------------
+Changes for Tcl 7.6 go above this line.
+Changes for Tcl 7.7 go below this line.
+----------------------------------------------------------
+
+5/8/96 (new feature) Added Tcl_Ungets C API for putting a sequence of bytes
+into a channel's input buffer. This can be used for "push" model channels
+where the input is obtained via callbacks instead of by request of the
+generic IO code. No Tcl procedure yet. (JL)
+
+11/15/96 (new feature) Implemented hidden commands. New C APIs:
+	Tcl_HideCommand		-- hides an existing exposed command.
+	Tcl_ExposeCommand	-- exposes an existing hidden command.
+New tcl APIs:
+	interp invokehidden	-- invokes a hidden command in a slave.
+	interp hide		-- hides an existing exposed command.
+	interp expose		-- exposes an existing hidden command.
+	interp hidden		-- returns a list of hidden commands.
+The implementation of Safe Tcl now uses the new hidden commands facility
+to implement the safe base, instead of deleting the commands from a safe
+interpreter. (JL)
+
+11/15/96 (new feature) Implemented the safe base, a mechanism for
+installing and requesting security policies, purely in Tcl code. Overloads
+the package command to also allow an interpreter to "require" a policy. The
+following new library commands are provided:
+	tcl_safeCreateInterp	-- creates a slave an initializes the
+				   policy mechanism.
+	tcl_safeInitInterp	-- initializes an existing slave with the
+				   policy mechanism.
+	tcl_safeDeleteInterp	-- deletes a slave and deinitializes the
+				   policy mechanism.
+	tcl_safeAutoPath	-- manages per slave path for package
+				   finding and auto-loading.
+	tcl_safePolicyPath	-- manages global search path for finding
+				   security policies.
+Added a new file to the library, safeinit.tcl, to hold implementation. (JL)
+
+12/6/96 (new feature) Implemented Tcl_Finalize, an API that should be
+called by a process when it is done using Tcl. This API runs all the exit
+handlers to allow them to clean up resources etc. (JL)
+
+12/17/96 (new feature) Add an http Tcl script package to the Tcl library.
+This package implements the client side of HTTP/1.0; the GET, HEAD,
+and POST requests. (BW)
+
+1/21/97 (new feature) Added a "marktrusted" subcommand to the "interp" and
+to the interpreter object command. It removes the "safe" mark on an
+interpreter and disables hard-wired checks for safety in the C sources. (JL)
+
+1/21/97 (removed feature) Removed "vwait" from set of commands available in
+a safe interpreter. (JL)
+
+2/11/97 (new feature, bug fix) http package.  Added -accept to http_config
+so you can set the Accept header.  Added -handler option to http_get so
+you can supply your own data handler.  Also fixed POST operation to
+set the correct MIME type on the request. (BW)
+
+----------------------------------------------------------
+Changes for Tcl 7.7 go above this line.
+Changes for Tcl 8.0 go below this line.
+----------------------------------------------------------
+
+9/17/96 (bug fix) Using "upvar" it was possible to turn an array element
+into an array itself.  Changed to disallow this; it was quirky and didn't
+really work correctly anyway. (JO)
+
+10/21/96 (new feature) The core of the Tcl interpreter has been replaced
+with an on-the-fly compiler that translates Tcl scripts to bytecoded
+instructions; a new interpreter then executes the bytecodes. The compiler
+introduces only a few minor changes at the level of Tcl scripts. The biggest
+changes are to expressions and lists.
+    - A second level of substitutions is no longer done for expressions.
+      This substantially improves their execution time. This means that
+      the expression "$x*4" produces a different result than in the past
+      if x is "$y+2". Fortunately, not much code depends on the old
+      two-level semantics. Some expressions that do, such as
+      "expr [join $list +]" can be recoded to work in Tcl8.0 by adding
+      an eval: e.g., "eval expr [join $list +]".
+    - Lists are now completely parsed on the first list operation to
+      create a faster internal representation. In the past, if you had a
+      misformed list but the erroneous part was after the point you
+      inserted or extracted an element, then you never saw an error.
+      In Tcl8.0 an error will be reported. This should only effect
+      incorrect programs that took advantage of behavior of the old
+      implementation that was not documented in the man pages.
+Other changes to Tcl scripts are discussed in the web page at
+http://www.sunlabs.com/research/tcl/compiler.html. (BL)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/21/96 (new feature) In earlier versions of Tcl, strings were used as a
+universal representation; in Tcl 8.0 strings are replaced with Tcl_Obj
+structures ("objects") that can hold both a string value and an internal
+form such as a binary integer or compiled bytecodes. The new objects make it
+possible to store information in efficient internal forms and avoid the
+constant translations to and from strings that occurred with the old
+interpreter. There are new many new C APIs for managing objects. Some of the
+new library procedures for objects (such as Tcl_EvalObj) resemble existing
+string-based procedures (such as Tcl_Eval) but take advantage of the
+internal form stored in Tcl objects for greater speed. Other new procedures
+manage objects and allow extension writers to define new kinds of objects.
+See the manual entries doc/*Obj*.3 (BL)
+
+10/24/96 (bug fix) Fixed memory leak on exit caused by some IO related
+data structures not being deallocated on exit because their refcount was
+artificially boosted. (JL)
+
+10/24/96 (bug fix) Fixed core dump in Tcl_Close if called with NULL
+Tcl_Channel. (JL)
+
+11/19/96 (new feature) Added library procedures for finding word
+breaks in strings in a platform specific manner.  See the library.n
+manual entry for more information. (SS)
+
+11/22/96 (feature improvements) Added support for different levels of
+tracing during bytecode compilation and execution. This should help in
+tracking down suspected problems with the compiler or with converting
+existing code to use Tcl8.0. Two global Tcl variables, traceCompile
+and traceExec, can be set to generate tracing information in stdout:
+    - traceCompile: 0  no tracing (default)
+                    1  trace compilations of top level commands and procs
+                    2  trace and display instructions for all compilations
+    - traceExec:    0  no tracing
+                    1  trace only calls to Tcl procs
+                    2  trace invocations of all commands including procs
+                    3  detailed trace showing the result of each instruction
+traceExec >= 2 provides a one line summary of each called command and
+its arguments. Commands that have been "compiled away" such as set are
+not shown. (BL)
+
+11/30/96 (bug fix) The command "info nameofexecutable" could sometimes
+return the name of a directory. (JO)
+
+11/30/96 (feature improvements) Changed the code in library/init.tcl
+that reads in pkgIndex.tcl so that (a) it reads the files from child
+directories before those in the parent, so that the parent gets
+precedence, and (b) it doesn't quit if there is an error in a
+pkgIndex.tcl file;  instead, it prints an error message on standard
+error and continues. (JO)
+
+10/5/96 (feature improvements) Partial implementation of binary string
+support: the ability for Tcl string values to contain embedded null bytes.
+Changed the Tcl object-based APIs to take a byte pointer and length pair
+instead of a null-terminated C string. Modified several object type managers
+to support binary strings but not, for example, the list type manager.
+Existing string-based C APIs are unchanged and will truncate binary
+strings. Compiled scripts containing nulls are also truncated. (BL)
+
+12/12/96 (feature change) Removed the commands "cp", "mkdir", "mv",
+"rm", and "rmdir" from the Macintosh version of Tcl.  They were never
+officially supported and their functionality is now available via
+the file command. (RJ)
+
+----------------- Released 8.0a1, 12/20/96 -----------------------
+
+1/7/97 (bug fix) Under Windows, "file stat c:" was returning error instead
+of stat for current dir on c: drive.
+
+1/10/97 (new feature) Added Tcl_GetIndexFromObj procedure for quick
+lookups of keyword arguments. (JO)
+
+1/12/97 (new feature) Serial IO channel drivers for Windows and Unix,
+available by using Tcl open command to open pseudo-files like "com1:" or
+"/dev/ttya".  New option to Tcl fconfigure command for serial files:  
+"-mode baud,parity,data,stop" to specify baud rate, parity, data bits, and
+stop bits.  Serial IO is not yet available on Mac.
+
+1/16/97 (feature change) Restored the Tcl7.x "two level substitution
+semantics" for expressions. Expressions not enclosed in braces are
+implemented, in general, by calling the expr command procedure
+(Tcl_ExprObjCmd) at runtime after the Tcl interpreter has already done a
+first round of substitutions. This is slow (about Tcl7.x speed) because new
+code for the expression is generally compiled each time. However, if the
+expression has only variable substitutions (and not command substitutions),
+"optimistic" fast code is generated inline. This inline code will fail if a
+second round of substitutions is needed (i.e., if the value of a substituted
+variable itself requires more substitutions). The optimistic code will
+catch the error and back off to call the slower but guaranteed correct
+expr command procedure. (BL)
+
+1/16/97 (feature improvements) Added Tcl_ExprLongObj and Tcl_ExprDoubleObj
+to round out expression-related procedures. (BL)
+
+1/16/97 (feature change) Under Windows, at startup the environment variables
+"path", "comspec", and "windir" in any capitalization are converted
+automatically to upper case.  The PATH variable could be spelled as path,
+Path, PaTh, etc. and it makes programming rather annoying.  All other
+environment variables are left alone. (CS)
+
+1/20/97 (new features) Rewrote the "lsort" command:
+    - The new version is based on reentrant merge sort code provided
+      by Richard Hipp, so it eliminates the reentrancy and stability
+      problems with the old qsort-based implementation.
+    - The new version supports a -dictionary option for sorting, and
+      it also supports a -index option for sorting lists using one
+      element for comparison.
+    - The new version is an object command, so it works well with the
+      Tcl compiler, especially in conjunction with the new -index
+      option.  When the -index option is used, this version of lsort
+      is more than 100 times faster than the Tcl 7.6 lsort, which had
+      to use the -command option to get the same effect. (JO)
+
+1/20/97 (feature improvements) Added the improved debugging support for Tcl
+objects prototyped by Karl Lehenbauer <karl@hammer1.ops.NeoSoft.com>.
+If TCL_MEM_DEBUG is defined, the object creation calls use Tcl_DbCkalloc
+directly in order to record the caller's source file name and line
+number. (BL)
+
+1/21/97 (removed feature) Desupported the tcl_precision variable: if
+set, it is ignored.  Tcl now uses the full 17 digits of precision when
+converting real numbers to strings (with the new object system real
+numbers are rarely converted to strings so there is no efficiency
+disadvantage to printing all 17 digits; the new scheme improves
+accuracy and simplifies several APIs). (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+1/21/97 (feature change) Removed the "interp" argument for the
+procedures Tcl_GetStringFromObj, Tcl_StringObjAppend, and
+Tcl_StringObjAppendObj.  Also removed the "interp" argument for
+the updateStringProc procedure in Tcl_ObjType structures.  With
+the tcl_precision changes above, these are no longer needed. (JO)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a1, but not with Tcl 7.6 ***
+
+1/22/97 (bug fix) Fixed http.tcl so that http_reset does not result in
+an extra call to the command callback.  In addition, if the transaction
+gets a premature eof, the state(status) is "eof", not "ok". (BW)
+
+----------------- Released 8.0a2, 1/24/97 -----------------------
+
+1/29/97 (feature change) Changed how two digit years are parsed in the
+clock command.  The old interface just added 1900 which will seem
+broken by the year 2000.  The new scheme follows the POSIX standard
+and treats dates 70-99 as 1970-1999 and dates 00-38 as 2000-2038.  All
+other two digit dates are undefined. (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/4/97 (bug fix) Fixed bug in clock code that dealt with relative
+dates.  Using the relative month code you could get an invalid date
+because it jumped into a non-existant day.  (For example, Jan 31
+to Feb 31.)  The code now will return the last valid day of the
+month in these situations.  Thanks to Hume Smith for sending in
+this bug fix.  (RJ)
+
+2/10/97 (feature change) Eliminated Tcl_StringObjAppend and 
+Tcl_StringObjAppendObj procedures, replaced them with Tcl_AppendToObj
+and Tcl_AppendStringsToObj procedures.  Added new procedure
+Tcl_SetObjLength. (JO)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2, but not with Tcl 7.6 ***
+
+2/10/97 (new feature) Added Tcl_WrongNumArgs procedure for generating
+error messages about incorrect number of arguments. (JO)
+
+2/11/97 (new feature, bug fix) http package.  Added -accept to http_config
+so you can set the Accept header.  Added -handler option to http_get so
+you can supply your own data handler.  Also fixed POST operation to
+set the correct MIME type on the request. (BW)
+
+2/22/97 (bug fix) Fixed bug that caused $tcl_platform(osVersion) to be
+computed incorrectly under AIX. (JO)
+
+2/25/97 (new feature, feature change) Added support for both int and long
+integer objects. Added Tcl_NewLongObj/Tcl_GetLongFromObj/Tcl_SetLongFromObj
+procedures and renamed the Tcl_Obj internalRep intValue member to
+longValue. Tcl_GetIntFromObj now checks for integer values too large to
+represent as non-long integers. Changed Tcl_GetAllObjTypes to
+Tcl_AppendAllObjTypes. (BL)
+
+3/5/97 (new feature) Added new Tcl_SetListObj procedure to round out
+collection of procedures that set the type and value of existing Tcl
+objects. (BL)
+
+3/6/97 (new feature) Added -global flag for interp invokehidden. (JL)
+
+3/6/97 (new feature, feature change) Added isNativeObjectProc field to the
+Tcl_CmdInfo structure to indicate (when 1) if the command has an
+object-based command procedure. Removed the nameLength arg from
+Tcl_CreateObjCommand since command names can't contain null characters. (BL)
+
+3/6/97 (bug fix) Fixed bug in "unknown" procedure that caused auto-
+loading to fail on commands whose names begin with digits. (JO)
+
+3/7/97 (bug fix) Auto-loading now works in Safe Base. Safe interpreters
+only accept the Version 2 and onwards tclIndex files. (JL)
+
+3/13/97 (bug fix) Fixed core dump due to interaction between aliases and
+hidden commands. Bug found by Lindsay Marshall. (JL)
+
+3/14/97 (bug fix) Fixed mac bugs relating to time.  The -gmt option
+now adjusts the time in the correct direction.  (Thanks to Ed Hume for
+reporting a fix to this problem.)  Also fixed file "mtime" etc. to
+return times from GMT rather than local time zone.  (RJ)
+
+3/18/97 (feature change) Declaration of objv in Tcl_ObjCmdProc function
+changed from "Tcl_Obj *objv[]" to "Tcl_Obj *CONST objv[]".  All Tcl object
+commands changed to use new declaration of objv.  Naive translation of
+string-based command procs to object-based command procs could very easily
+have yielded code where the contents of the objv array were changed.  This
+is not a problem with string-based command procs, but doing something as
+simple as objv[2] = objv[3] would corrupt the runtime stack and cause Tcl to
+crash.  Introduced CONST in declaration of objv so that attempted assignment
+of new pointer values to elements of the objv array will be caught by the
+compiler. (CCS)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 ***
+
+3/19/97 (bug fix) Fixed panic due to object sharing. The root cause was
+that old code was using Tcl_ResetResult instead of Tcl_ResetObjResult. (JL)
+
+3/20/97 (new feature) Added a new subcommand for the file
+command. file attributes filename can give a list of platform-specific
+options (such as file/creator type on the Mac, permissions on Unix) or
+set the values of them. Added a new subcommand for the file
+command. file nativename name gives back the platform-specific form
+for the file. This is useful when the filename is needed to pass to
+the OS, such as exec under Windows 95 or AppleScript on the Mac. For
+more info, see file.n. (SRP)
+
+3/24/97 (removed feature) Removed the tcl_safePolicyPath procedure. Now
+the policy path is computed from the auto_path by appending the directory
+'policies' to each element. Also fixed several bugs in automatic tracking
+of auto_path by computed policy path. (JL)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 ***
+
+4/8/97 (new feature) If the variable whose name is passed to lappend doesn't
+already exist, and there are no value arguments, lappend now creates the
+variable with an empty value instead of returning an error. Change suggested
+by Tom Tromey. (BL)
+
+4/9/97 (feature change) Changed the name of the TCL_PART1_NOT_PARSED flag to
+TCL_PARSE_PART1. (BL)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 ***
+
+4/10/97 (bug fixes) Fixed various compilation-related bugs:
+    - "UpdateStringOfCmdName should never be invoked" panic.
+    - Bad code generated for expressions not in {}'s inside catch commands.
+    - Segmentation fault in some command procedures when two argument
+      object pointers refer to the same object.
+    - Second level of substitutions were never done for expressions not
+      in {}'s that consist of a single variable reference: e.g.,
+      "set x 27; set bool {$x}; if $bool {puts foo}" would fail with error.
+    - Bad code generated when code storage was grown while compiling some
+      expressions: ones with compilation errors or consisting of only a
+      variable reference.
+    - Bugs involving multiple interpreters: wasn't checking that a
+      procedure's code was compiled for the same interpreter as the one
+      executing it, and didn't invalidate code on hidden-exposed command
+      transitions.
+    - "Bad stack top" panic when executing scripts that require a huge
+      amount of stack space.
+    - Incorrect sharing of code for procedure bodies, and procedure code
+      deallocated before last execution of the procedure finished.
+    - Fixed compilation of expression words in quotes. For example,
+      if "0 < 3" {puts foo}.
+    - Fixed performance bug in array set command with large assignments.
+    - Tcl_SetObjLength segmentation fault setting length of empty object.
+    - If Tcl_SetObjectResult was passed the same object as the interpreter's
+      result object, it freed the object instead of doing nothing. Bug fix
+      by Michael J. McLennan.
+    - Tcl_ListObjAppendList inserted elements from the wrong list. Bug fix
+      by Michael J. McLennan.
+    - Segmentation fault if empty variable list was specified in a foreach
+      command. Bug fix by Jan Nijtmans.
+    - NULL command name was always passed to Tcl_CreateTrace callback
+      procedure.
+    - Wrong string representation generated for the value LONG_MIN.
+      For example, expr 1<<31 printed incorrectly on a 32 bit machine.
+    - "set {a($x)} 1" stored value in wrong variable.
+    - Tcl_GetBooleanFromObj was not checking for garbage after a numeric
+      value.
+    - Garbled "bad operand type" error message when evaluating expressions
+      not surrounded by {}'s. (BL)
+
+4/16/97 (new feature) The expr command now has the "rand()" and
+"srand()" functions for getting random numbers in expr. (RJ)
+
+4/23/97 (bug fix) Fixed core dump in bgerror when the error handler command
+deletes the current interpreter. Found by Juergen Schoenwald. (JL)
+
+4/23/97 (feature change) The notifier interfaces have been redesigned
+to make embedding in applications with external event loops possible.
+A number of interfaces in the notifier and the channel drivers have
+changed.  Refer to the Notifier.3 and CrtChannel.3 manual entries for
+more details. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/23/97 (removed feature) The Tcl_File interfaces have been removed.
+The Tcl_CreateFileHandler/Tcl_DeleteFileHandler interfaces now take
+Unix fd's and are only supported on the Unix platform.
+Tcl_GetChannelFile has been replaced with Tcl_GetChannelHandle.
+Tcl_MakeFileChannel now takes a platform specific file handle. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/23/97 (removed feature) The modal timeout interface has been
+removed (Tcl_CreateModalTimeout/Tcl_DeleteModalTimeout) (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/23/97 (feature change) Channel drivers are now required to correctly
+implement blocking behavior when they are in blocking mode. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/23/97 (new feature) Added the "binary" command for manipulating
+binary strings. Also, changed the "puts", "gets", and "read" commands
+to preserve embedded nulls.  (SS)
+
+4/23/97 (new feature) Added tcl_platform(byteOrder) element to the
+tcl_platform array to identify the native byte order for the current
+host. (SS)
+
+4/23/97 (bug fix) Fixed bug in date parsing around year boundaries. (SS)
+
+4/24/97 (bug fix) In the process of copying a file owned by another user,
+Tcl was changing the owner of the copy back to the owner of the original
+file, therefore causing further file operations to fail because the current
+user didn't own the copy anymore.  The owner of the copy is now left as the
+current user. (CCS)
+
+4/24/97 (feature change) Under Windows, don't automatically uppercase the
+environment variable "windir" -- it's supposed to be lower case.  (CCS)
+
+4/29/97 (new feature) Added namespace support based on a namespace
+implementation by Michael J. McLennan of Lucent Technologies. A namespace
+encapsulates a collection of commands and variables to ensure that they
+won't interfere the commands and variables of other namespaces. The global
+namespace holds all global variables and commands. Additional namespaces are
+created with the new namespace command. The new variable command lets you
+create Tcl variables inside a namespace. The names of Tcl variables and
+commands may now be qualified by the name of the namespace containing them.
+The key namespace-related commands are summarized below:
+    - namespace ?eval? name arg ?arg...?
+         Used to define the commands and variables in a namespace.
+         Optionally creates the namespace.
+    - namespace export ?-clear? ?pattern pattern...?
+         Specifies which commands are exported from a namespace. These
+         are the ones that can be imported into another namespace.
+    - namespace import ?-force? ?pattern pattern...?
+         Makes the specified commands accessible in the current namespace.
+    - namespace current
+         Returns the name of the current namespace.
+    - variable name ?value? ?name ?value?...?
+         Creates one or more namespace variables. (BTL)
+
+5/1/97 (bug fix) Under Windows, file times were reported in GMT.  Should be
+reported in local time. (CCS)
+
+5/2/97 (feature change) Changed the name of the two Tcl variables used for
+tracing bytecode compilation and execution to tcl_traceCompile and
+tcl_traceExec respectively. These variables are now documented in the
+tclvars man page. (BL)
+
+5/5/97 (new feature) Support "end" as the index for "lsort -index". (BW)
+
+5/5/97 (bug fixes) Cleaned up the way the http package resets connections (BW)
+
+5/8/97 (feature change) Newly created Tcl objects now have a reference count
+of zero instead of one. This simplifies C code that stores newly created
+objects in Tcl variables or in data structures such as list objects. That C
+code must increment the new object's reference count since the variable or
+data structure will contain a long-term reference to the object. Formerly,
+when new objects started out with reference count one, it was necessary to
+decrement the new object's reference count after the store to make sure it
+was left with the correct value; this is no longer necessary. (BL)
+
+5/9/97 (new feature) Added the Tcl_GetsObj interface that takes an
+object reference instead of a dynamic string (as in Tcl_Gets). (SS)
+
+5/12/97 (new feature) Added Tcl_CreateAliasObj and Tcl_GetAliasObj C APIs
+to allow an alias command to be created with a vector of Tcl_Obj structures
+and to get the vector back later. (JL)
+
+5/12/97 (feature change) Changed Tcl_ExposeCommand and Tcl_HideCommand to
+leave an object result instead of a string result. (JL)
+
+5/14/97 (feature change) Improved the handling of the interpreter result.
+This is still either an object or a string, but the two values are now
+kept consistent unless some C code has set interp->result directly. See
+the SetResult man page for details. Removed the Tcl_ResetObjResult
+procedure. (BL)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 ***
+
+5/16/97 (new feature) Added "fcopy" command to move data between
+channels.  Refer to the manual page for more information.  Removed the
+"unsupported0" command since it is obsolete now.  (SS)
+
+5/16/97 (new feature) Added Tcl_GetStringResult procedure to allow programs
+to get an interpreter's result as a string. If the result was previously set
+to an object, this procedure will convert the object to a string. Use of
+Tcl_GetStringResult is intended to replace direct access to interp->result,
+which is not safe. (BL)
+
+5/20/97 (new features) Fixed "fcopy" to return the number of bytes
+transferred in the blocking case.  Updated the http package to use
+fcopy instead of unsupported0.  Added -timeout and -handler options to
+http_get.  http_get is now blocking by default.  It is only non-blocking
+if you supply a -command argument. (BW)
+
+5/22/97 (bug fix) Fixed several bugs in the "lsort" command having to do
+with the -dictionary option and the presence of numbers embedded in the
+strings.  (JO)
+
+----------------- Released 8.0b1, 5/27/97 -----------------------
+
+6/2/97 (bug fix) Fixed bug in startup code that caused a problem in
+finding the library files when they are installed in a directory
+containing a space in the name. (SS)
+
+6/2/97 (bug fix) Fixed bug in Unix notifier where the select mask was
+not being cleared under some circumstances. (SS)
+
+6/4/97 (bug fix) Fixed bug that prevented creation of Tk widgets in
+namespaces. Tcl_CreateObjCommand and Tcl_CreateCommand now always create
+commands in the global namespace unless the command names are qualified. Tcl
+procedures continue to be created in the current namespace by default. (BL)
+
+6/6/97 (new features) Added new namespace API procedures
+Tcl_AppendExportList and Tcl_Export to allow C code to get and set a
+namespace's export list. (BL)
+
+6/11/97 (new feature) Added Tcl_ConcatObj. This object-based routine
+parallels the string-based routine Tcl_Concat. (SRP)
+
+6/11/97 (new feature) Added Tcl_SetObjErrorCode. This object-based
+routines parallels the string-based routine Tcl_SetErrorCode. (SRP)
+
+6/12/97 (bug fix) Fix the "unknown" procedure so that wish under Windows
+will exec an external program, instead of always complaining "console1 not
+opened for writing". (CCS)
+
+6/12/97 (bug fix) Fixed core dump experienced by the following simple
+script:
+	interp create x
+	x alias exec exec
+	interp delete x
+This panic was caused by not installing the new CmdDeleteProc when exec
+got redefined by the alias creation step. Reported by Lindsay Marshal (JL)
+
+6/13/97 (new features) Tcl objects newly created by Tcl_NewObj now have a
+string representation that points to a shared heap string of length 1. (They
+used to have NULL bytes and typePtr fields. This was treated as a special
+case to indicate an empty string, but made type manager implementations
+complex and error prone.) The new procedure Tcl_InvalidateStringRep is used
+to mark an object's string representation invalid and to free any storage
+associated with the old string representation. (BL)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 ***
+
+6/16/97 (bug fix) Tcl_ScanCountedElement could leave braces unmatched
+if the string ended with a backslash. (JO)
+
+6/17/97 (bug fix) Fixed channel event bug where readable events would be
+lost during recursive events loops if the input buffers contained
+data. (SS)
+
+6/17/97 (bug fix) Fixed bug in Windows socket code that didn't
+reenable read events in the case where an external entity is also
+reading from the socket. (SS)
+
+6/18/97 (bug fix) Changed initial setting of the notifier service mode
+to TCL_SERVICE_NONE to avoid unexpected event handling during
+initialization. (SS)
+
+6/19/97 (bug fix/feature change) The command callback to fcopy is now
+called in case of errors during the background copy.  This adds a second,
+optional argument to the callback that is the error string.  The callback
+in case of errors is required for proper cleanup by the user of fcopy. (BW)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 ***
+
+6/19/97 (bug fix) Fixed a panic due to the following four line script:
+	interp create x
+	x alias foo bar
+	x eval rename foo blotz
+	x alias foo {}
+The problem was that the interp code was not using the actual current name
+of the command to be deleted as a result of un-aliasing foo. (JL)
+
+6/19/97 (feature change) Pass interp down to the ChannelOption and
+driver specific calls so system errors can be differentiated from syntax
+ones. Changed Tcl_DriverGetOptionProc type. Affects Tcl_GetChannelOption,
+TcpGetOptionProc,  TtyGetOptionProc, etc. (DL)
+*** POTENTIAL INCOMPATIBILITY ***
+
+6/19/97 (new feature) Added Tcl_BadChannelOption for use by by driver
+specific option procedures (Set and Get) to return a complete and
+meaningful error message. (DL)
+
+6/19/97 (bug fixes) If a system call error occurs while doing an
+fconfigure on tcp or tty/com channel: return the appropriate error
+message (instead of the syntax error one or none). (Fixed for Unix and
+most of the Win and Mac drivers). (DL)
+
+6/20/97 (feature change) Eval is no longer assumed as the subcommand name
+in namespace commands: you must now write "namespace eval nsName {...}".
+Abbreviations of namespace subcommand names are now allowed. (BL)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 ***
+
+6/20/97 (feature change) Changed the errorInfo traceback message for
+compilation errors from "invoked from within" to "while compiling". (BL)
+
+6/20/97 (bug fixes) Fixed various compilation-related bugs:
+    - "UpdateStringOfCmdName should never be called" and
+      "UpdateStringOfByteCode should never be called" panics.
+    - Segfault in TclObjInterpProc getting procedure name after evaluation
+      stack is reallocated (grown).
+    - Could not use ":" at end of variable and command names.
+    - Bad code generated for while and for commands with test expressions
+      enclosed in quotes: e.g., "set i 0; while "$i > 5" {}".
+    - Command trace procedures would crash if they did a Tcl_EvalObj that
+      reallocated the evaluation stack.
+    - Break and continue commands did not reset the interpreter result.
+    - The Tcl_ExprXXX routines, both string- or object-based, always
+      modified the interpreter result even if there was no error.
+    - The argument parsing procedure used by several compile procedures
+      always treated "]" as end of a command: e.g., "set a ]" would fail.
+    - Changed errorInfo traceback message for compilation errors from 
+      "invoked from within" to "while compiling".
+    - Problem initializing Tcl object managers during interpreter creation.
+    - Added check and error message if formal parameter to a procedure is
+      an array element. (BL)
+
+6/23/97 (new feature) Added "registry" package to allow manipulation
+of the Windows system registry.  See manual entry for details. (SS)
+
+6/24/97 (feature change) Converted http to a package and added the
+http1.0 subdirectory of the Tcl script library.  This means you have
+to do a "package require http" to use this, as advertised in the man page. (BW)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 ***
+
+6/24/97 (bug fix) Ensure that Tcl_Set/GetVar C APIs, when called without
+TCL_LEAVE_ERR_MSG, don't touch the interp result. (DL)
+
+6/26/97 (feature change) Changed name of Tcl_ExprStringObj to
+Tcl_ExprObj. (BL)
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 ***
+
+----------------- Released 8.0b2, 6/30/97 -----------------------
diff --git a/contrib/tcl/doc/AddErrInfo.3 b/contrib/tcl/doc/AddErrInfo.3
index 51e75c2..91708b8 100644
--- a/contrib/tcl/doc/AddErrInfo.3
+++ b/contrib/tcl/doc/AddErrInfo.3
@@ -1,24 +1,28 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) AddErrInfo.3 1.21 96/03/25 19:55:32
+'\" SCCS: @(#) AddErrInfo.3 1.28 97/06/12 13:39:53
 '\" 
 .so man.macros
 .TH Tcl_AddErrorInfo 3 7.5 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_AddErrorInfo, Tcl_SetErrorCode, Tcl_PosixError \- record information about errors
+Tcl_AddObjErrorInfo, Tcl_AddErrorInfo, Tcl_SetErrorCode, Tcl_PosixError \- record information about errors
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
+\fBTcl_AddObjErrorInfo\fR(\fIinterp, message, length\fR)
+.sp
 \fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
 .sp
-\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ...\fB (char *) NULL\fR)
+\fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR)
+.sp
+\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR)
 .sp
 char *
 \fBTcl_PosixError\fR(\fIinterp\fR)
@@ -27,7 +31,19 @@ char *
 .AP Tcl_Interp *interp in
 Interpreter in which to record information.
 .AP char *message in
-Identifying string to record in \fBerrorInfo\fR variable.
+For \fBTcl_AddObjErrorInfo\fR,
+this points to the first byte of an array of bytes
+containing a string to record in the \fBerrorInfo\fR variable.
+This byte array may contain embedded null bytes
+unless \fIlength\fR is negative.
+For \fBTcl_AddErrorInfo\fR,
+this is a conventional C string to record in the \fBerrorInfo\fR variable.
+.AP int length in
+The number of bytes to copy from \fImessage\fR when
+setting the \fBerrorInfo\fR variable.
+If negative, all bytes up to the first null byte are used.
+.AP Tcl_Obj *errorObjPtr in
+This variable \fBerrorCode\fR will be set to this value.
 .AP char *element in
 String to record as one element of \fBerrorCode\fR variable.
 Last \fIelement\fR argument must be NULL.
@@ -38,23 +54,23 @@ Last \fIelement\fR argument must be NULL.
 These procedures are used to manipulate two Tcl global variables
 that hold information about errors.
 The variable \fBerrorInfo\fR holds a stack trace of the
-operations that were in progress when an error occurred, and
-is intended to be human-readable.
+operations that were in progress when an error occurred,
+and is intended to be human-readable.
 The variable \fBerrorCode\fR holds a list of items that
 are intended to be machine-readable.
 The first item in \fBerrorCode\fR identifies the class of
-.VS
-error that occurred (e.g. POSIX means an error occurred in
-.VE
-a POSIX system call) and additional elements in \fBerrorCode\fR
-hold additional pieces of information that depend on the class.
+error that occurred
+(e.g. POSIX means an error occurred in a POSIX system call)
+and additional elements in \fBerrorCode\fR hold additional pieces
+of information that depend on the class.
 See the Tcl overview manual entry for details on the various
 formats for \fBerrorCode\fR.
 .PP
 The \fBerrorInfo\fR variable is gradually built up as an
 error unwinds through the nested operations.
-Each time an error code is returned to \fBTcl_Eval\fR
-it calls the procedure \fBTcl_AddErrorInfo\fR to add
+Each time an error code is returned to \fBTcl_EvalObj\fR
+(or \fBTcl_Eval\fR, which calls \fBTcl_EvalObj\fR)
+it calls the procedure \fBTcl_AddObjErrorInfo\fR to add
 additional text to \fBerrorInfo\fR describing the
 command that was being executed when the error occurred.
 By the time the error has been passed all the way back
@@ -63,34 +79,46 @@ of the activity in progress when the error occurred.
 .PP
 It is sometimes useful to add additional information to
 \fBerrorInfo\fR beyond what can be supplied automatically
-by \fBTcl_Eval\fR.
-\fBTcl_AddErrorInfo\fR may be used for this purpose:
-its \fImessage\fR argument contains an additional
+by \fBTcl_EvalObj\fR.
+\fBTcl_AddObjErrorInfo\fR may be used for this purpose:
+its \fImessage\fR and \fIlength\fR arguments describe an additional
 string to be appended to \fBerrorInfo\fR.
-For example, the \fBsource\fR command calls \fBTcl_AddErrorInfo\fR
+For example, the \fBsource\fR command calls \fBTcl_AddObjErrorInfo\fR
 to record the name of the file being processed and the
-line number on which the error occurred;  for Tcl procedures, the
-procedure name and line number within the procedure are recorded,
-and so on.
-The best time to call \fBTcl_AddErrorInfo\fR is just after
-\fBTcl_Eval\fR has returned \fBTCL_ERROR\fR.
-In calling \fBTcl_AddErrorInfo\fR, you may find it useful to
+line number on which the error occurred;
+for Tcl procedures, the procedure name and line number
+within the procedure are recorded, and so on.
+The best time to call \fBTcl_AddObjErrorInfo\fR is just after
+\fBTcl_EvalObj\fR has returned \fBTCL_ERROR\fR.
+In calling \fBTcl_AddObjErrorInfo\fR, you may find it useful to
 use the \fBerrorLine\fR field of the interpreter (see the
 \fBTcl_Interp\fR manual entry for details).
 .PP
-The procedure \fBTcl_SetErrorCode\fR is used to set the
-\fBerrorCode\fR variable.
-Its \fIelement\fR arguments give one or more strings to record
-in \fBerrorCode\fR:  each \fIelement\fR will become one item
-of a properly-formed Tcl list stored in \fBerrorCode\fR.
-\fBTcl_SetErrorCode\fR is typically invoked just before returning
-an error.
-If an error is returned without calling \fBTcl_SetErrorCode\fR
-then the Tcl interpreter automatically sets \fBerrorCode\fR
-to \fBNONE\fR.
+\fBTcl_AddErrorInfo\fR resembles \fBTcl_AddObjErrorInfo\fR
+but differs in initializing \fBerrorInfo\fR from the string
+value of the interpreter's result
+if the error is just starting to be logged.
+It does not use the result as a Tcl object
+so any embedded null characters in the result
+will cause information to be lost.
+It also takes a conventional C string in \fImessage\fR
+instead of \fBTcl_AddObjErrorInfo\fR's counted string.
+.PP
+The procedure \fBTcl_SetObjErrorCode\fR is used to set the
+\fBerrorCode\fR variable. \fIerrorObjPtr\fR contains a list object
+built up by the caller. \fBerrorCode\fR is set to this
+value. \fBTcl_SetObjErrorCode\fR is typically invoked just 
+before returning an error in an object command. If an error is
+returned without calling \fBTcl_SetObjErrorCode\fR or
+\fBTcl_SetErrorCode\fR the Tcl interpreter automatically sets
+\fBerrorCode\fR to \fBNONE\fR.
+.PP
+The procedure \fBTcl_SetErrorCode\fR is also used to set the
+\fBerrorCode\fR variable. However, it takes one or more strings to
+record instead of an object. Otherwise, it is similar to
+\fBTcl_SetObjErrorCode\fR in behavior.
 .PP
 \fBTcl_PosixError\fR
-.VS
 sets the \fBerrorCode\fR variable after an error in a POSIX kernel call.
 It reads the value of the \fBerrno\fR C variable and calls
 \fBTcl_SetErrorCode\fR to set \fBerrorCode\fR in the \fBPOSIX\fR format.
@@ -100,36 +128,39 @@ is linked into an application as a shared library, or when the error
 occurs in a dynamically loaded extension. See the manual entry for
 \fBTcl_SetErrno\fR for more information.
 .PP
-\fBTcl_PosixError\fR returns a human-readable
-.VE
-diagnostic message for the error (this is the same value that
-will appear as the third element in \fBerrorCode\fR).
+\fBTcl_PosixError\fR returns a human-readable diagnostic message
+for the error
+(this is the same value that will appear as the third element
+in \fBerrorCode\fR).
 It may be convenient to include this string as part of the
-error message returned to the application in \fIinterp->result\fR.
+error message returned to the application in
+the interpreter's result.
 .PP
 It is important to call the procedures described here rather than
 setting \fBerrorInfo\fR or \fBerrorCode\fR directly with
-\fBTcl_SetVar\fR.
+\fBTcl_ObjSetVar2\fR.
 The reason for this is that the Tcl interpreter keeps information
 about whether these procedures have been called.
-For example, the first time \fBTcl_AppendResult\fR is called
+For example, the first time \fBTcl_AddObjErrorInfo\fR is called
 for an error, it clears the existing value of \fBerrorInfo\fR
-and adds the error message in \fIinterp->result\fR to the variable
-before appending \fImessage\fR;  in subsequent calls, it just
-appends the new \fImessage\fR.
+and adds the error message in the interpreter's result to the variable
+before appending \fImessage\fR;
+in subsequent calls, it just appends the new \fImessage\fR.
 When \fBTcl_SetErrorCode\fR is called, it sets a flag indicating
-that \fBerrorCode\fR has been set;  this allows the Tcl interpreter
-to set \fBerrorCode\fR to \fBNONE\fB if it receives an error return
+that \fBerrorCode\fR has been set;
+this allows the Tcl interpreter to set \fBerrorCode\fR to \fBNONE\fR
+if it receives an error return
 when \fBTcl_SetErrorCode\fR hasn't been called.
 .PP
-If the procedure \fBTcl_ResetResult\fR is called, it clears all
-of the state associated with \fBerrorInfo\fR and \fBerrorCode\fR
+If the procedure \fBTcl_ResetResult\fR is called,
+it clears all of the state associated with
+\fBerrorInfo\fR and \fBerrorCode\fR
 (but it doesn't actually modify the variables).
 If an error had occurred, this will clear the error state to
 make it appear as if no error had occurred after all.
 
 .SH "SEE ALSO"
-Tcl_Interp, Tcl_ResetResult, Tcl_SetErrno
+Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_Interp, Tcl_ResetResult, Tcl_SetErrno
 
 .SH KEYWORDS
-error, stack, trace, variable
+error, object, object result, stack, trace, variable
diff --git a/contrib/tcl/doc/AppInit.3 b/contrib/tcl/doc/AppInit.3
index 8742661..ca78003 100644
--- a/contrib/tcl/doc/AppInit.3
+++ b/contrib/tcl/doc/AppInit.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) AppInit.3 1.9 96/03/25 19:56:02
+'\" SCCS: @(#) AppInit.3 1.10 96/08/26 12:59:40
 '\" 
 .so man.macros
 .TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures"
@@ -49,7 +49,6 @@ Tcl variables \fBargv\fR and \fBargv0\fR in \fIinterp\fR.
 .IP [3]
 Invoke a startup script to initialize the application.
 .LP
-.VS
 \fBTcl_AppInit\fR returns TCL_OK or TCL_ERROR.
 If it returns TCL_ERROR then it must leave an error message in
 \fIinterp->result\fR;  otherwise the result is ignored.
@@ -69,7 +68,6 @@ The best way to get started is to make a copy of the file
 \fBtclAppInit.c\fR from the Tcl library or source directory.
 It already contains a \fBmain\fR procedure and a template for
 \fBTcl_AppInit\fR that you can modify for your application.
-.VE
 
 .SH KEYWORDS
 application, argument, command, initialization, interpreter
diff --git a/contrib/tcl/doc/Async.3 b/contrib/tcl/doc/Async.3
index e40cbca..9a58b09 100644
--- a/contrib/tcl/doc/Async.3
+++ b/contrib/tcl/doc/Async.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Async.3 1.13 96/03/25 19:56:31
+'\" SCCS: @(#) Async.3 1.14 96/08/26 12:59:41
 '\" 
 .so man.macros
 .TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures"
@@ -25,11 +25,9 @@ int
 \fBTcl_AsyncInvoke\fR(\fIinterp, code\fR)
 .sp
 \fBTcl_AsyncDelete\fR(\fIasync\fR)
-.VS
 .sp
 int
 \fBTcl_AsyncReady\fR()
-.VE
 .SH ARGUMENTS
 .AS Tcl_AsyncHandler clientData
 .AP Tcl_AsyncProc *proc in
@@ -107,21 +105,15 @@ In this case \fIinterp\fR will be NULL and \fIcode\fR will be
 .PP
 The procedure \fBTcl_AsyncInvoke\fR is called to invoke all of the
 handlers that are ready.
-.VS
 The procedure \fBTcl_AsyncReady\fR will return non-zero whenever any
-.VE
 asynchronous handlers are ready;  it can be checked to avoid calls
 to \fBTcl_AsyncInvoke\fR when there are no ready handlers.
-.VS
 Tcl calls \fBTcl_AsyncReady\fR after each command is evaluated
-.VE
 and calls \fBTcl_AsyncInvoke\fR if needed.
 Applications may also call \fBTcl_AsyncInvoke\fR at interesting
 times for that application.
-.VS
 For example, Tcl's event handler calls \fBTcl_AsyncReady\fR
 after each event and calls \fBTcl_AsyncInvoke\fR if needed.
-.VE
 The \fIinterp\fR and \fIcode\fR arguments to \fBTcl_AsyncInvoke\fR
 have the same meaning as for \fIproc\fR:  they identify the active
 interpreter, if any, and the completion code from the command
diff --git a/contrib/tcl/doc/BoolObj.3 b/contrib/tcl/doc/BoolObj.3
new file mode 100644
index 0000000..691e5aa
--- /dev/null
+++ b/contrib/tcl/doc/BoolObj.3
@@ -0,0 +1,83 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) BoolObj.3 1.7 97/05/08 19:50:57
+'\" 
+.so man.macros
+.TH Tcl_BooleanObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- manipulate Tcl objects as boolean values
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewBooleanObj\fR(\fIboolValue\fR)
+.sp
+\fBTcl_SetBooleanObj\fR(\fIobjPtr, boolValue\fR)
+.sp
+int
+\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, boolPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP int boolValue in
+Integer value used to initialize or set a boolean object.
+If the integer is nonzero, the boolean object is set to 1;
+otherwise the boolean object is set to 0.
+.AP Tcl_Obj *objPtr in/out
+For \fBTcl_SetBooleanObj\fR, this points to the object to be converted
+to boolean type.
+For \fBTcl_GetBooleanFromObj\fR, this refers to the object
+from which to get a boolean value; 
+if \fIobjPtr\fR does not already point to a boolean object,
+an attempt will be made to convert it to one.
+.AP Tcl_Interp *interp in/out
+If an error occurs during conversion,
+an error message is left in the interpreter's result object
+unless \fIinterp\fR is NULL.
+.AP int *boolPtr out
+Points to place where \fBTcl_GetBooleanFromObj\fR
+stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are used to create, modify, and read
+boolean Tcl objects from C code.
+\fBTcl_NewBooleanObj\fR and \fBTcl_SetBooleanObj\fR
+will create a new object of boolean type
+or modify an existing object to have boolean type. 
+Both of these procedures set the object to have the
+boolean value (0 or 1) specified by \fIboolValue\fR;
+if \fIboolValue\fR is nonzero, the object is set to 1,
+otherwise to 0.
+\fBTcl_NewBooleanObj\fR returns a pointer to a newly created object
+with reference count zero.
+Both procedures set the object's type to be boolean
+and assign the boolean value to the object's internal representation
+\fIlongValue\fR member.
+\fBTcl_SetBooleanObj\fR invalidates any old string representation
+and, if the object is not already a boolean object,
+frees any old internal representation.
+.PP
+\fBTcl_GetBooleanFromObj\fR attempts to return a boolean value
+from the Tcl object \fIobjPtr\fR.
+If the object is not already a boolean object,
+it will attempt to convert it to one.
+If an error occurs during conversion, it returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+unless \fIinterp\fR is NULL.
+Otherwise, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR
+and stores the boolean value in the address given by \fIboolPtr\fR.
+If the object is not already a boolean object,
+the conversion will free any old internal representation.
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
+
+.SH KEYWORDS
+boolean, boolean object, boolean type, internal representation, object, object type, string representation
diff --git a/contrib/tcl/doc/Concat.3 b/contrib/tcl/doc/Concat.3
index 807fcad..be65732 100644
--- a/contrib/tcl/doc/Concat.3
+++ b/contrib/tcl/doc/Concat.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Concat.3 1.11 96/06/05 18:00:12
+'\" SCCS: @(#) Concat.3 1.12 97/06/11 17:54:12
 '\" 
 .so man.macros
 .TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures"
@@ -48,6 +48,8 @@ The result string is dynamically allocated
 using \fBTcl_Alloc\fR;  the caller must eventually release the space
 by calling \fBTcl_Free\fR.
 .VE
-
+.VS
+.SH "SEE ALSO"
+Tcl_ConcatObj
 .SH KEYWORDS
 concatenate, strings
diff --git a/contrib/tcl/doc/CrtChannel.3 b/contrib/tcl/doc/CrtChannel.3
index e54f74e..354665a 100644
--- a/contrib/tcl/doc/CrtChannel.3
+++ b/contrib/tcl/doc/CrtChannel.3
@@ -1,22 +1,22 @@
 '\"
-'\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" SCCS: @(#) CrtChannel.3 1.23 96/03/28 17:55:41
+'\" SCCS: @(#) CrtChannel.3 1.29 97/06/20 13:37:45
 .so man.macros
-.TH Tcl_CreateChannel 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateChannel 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelFile, Tcl_GetChannelBufferSize, Tcl_SetDefaultTranslation, Tcl_SetChannelBufferSize \- procedures for creating and manipulating channels
+Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetDefaultTranslation, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption \- procedures for creating and manipulating channels
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
 Tcl_Channel
-\fBTcl_CreateChannel\fR(\fItypePtr, channelName, inFile, outFile, instanceData\fR)
+\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR)
 .sp
 ClientData
 \fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
@@ -26,21 +26,31 @@ Tcl_ChannelType *
 .sp
 char *
 \fBTcl_GetChannelName\fR(\fIchannel\fR)
+.VS
 .sp
-Tcl_File
-\fBTcl_GetChannelFile\fR(\fIchannel, direction\fR)
+int
+\fBTcl_GetChannelHandle\fR(\fIchannel, direction, handlePtr\fR)
+.VE
+.sp
+int
+\fBTcl_GetChannelFlags\fR(\fIchannel\fR)
 .sp
-void
 \fBTcl_SetDefaultTranslation\fR(\fIchannel, transMode\fR)
 .sp
 int
 \fBTcl_GetChannelBufferSize\fR(\fIchannel\fR)
 .sp
-void
 \fBTcl_SetChannelBufferSize\fR(\fIchannel, size\fR)
 .sp
+.VS
+\fBTcl_NotifyChannel\fR(\fIchannel, mask\fR)
+.sp
+int
+\fBTcl_BadChannelOption\fR(\fIinterp, optionName, optionList\fR)
+.VE
+.sp
 .SH ARGUMENTS
-.AS Tcl_FileHandle pipelineSpec in
+.AS Tcl_EolTranslation *channelName in
 .AP Tcl_ChannelType *typePtr in
 Points to a structure containing the addresses of procedures that
 can be called to perform I/O and other functions on the channel.
@@ -48,25 +58,42 @@ can be called to perform I/O and other functions on the channel.
 The name of this channel, such as \fBfile3\fR; must not be in use
 by any other channel. Can be NULL, in which case the channel is
 created without a name.
-.AP Tcl_File inFile in
-Tcl file for the input device to associate with this channel.  If NULL,
-input will not be allowed on the channel.
-.AP Tcl_File outFile in
-Tcl file for the output device to associate with this channel.  If NULL,
-output will not be allowed on the channel.
 .AP ClientData instanceData in
 Arbitrary one-word value to be associated with this channel.  This
 value is passed to procedures in \fItypePtr\fR when they are invoked.
+.AP int mask in
+OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
+whether a channel is readable and writable.
 .AP Tcl_Channel channel in
 The channel to operate on.
+.VS
 .AP int direction in
-\fBTCL_READABLE\fR means the input file is wanted; \fBTCL_WRITABLE\fR
-means the output file is wanted.
+\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
+means the output handle is wanted.
+.AP ClientData *handlePtr out
+Points to the location where the desired OS-specific handle should be
+stored.
+.VE
 .AP Tcl_EolTranslation transMode in
 The translation mode; one of the constants \fBTCL_TRANSLATE_AUTO\fR,
 \fBTCL_TRANSLATE_CR\fR, \fBTCL_TRANSLATE_LF\fR and \fBTCL_TRANSLATE_CRLF\fR.
 .AP int size in
 The size, in bytes, of buffers to allocate in this channel.
+.VS
+.AP int mask in
+An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
+and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
+this channel.
+.AP Tcl_Interp *interp in
+Current interpreter. (can be NULL)
+.AP char *optionName in
+Name of the invalid option.
+.AP char *optionList in
+Specific options list (space separated words, without "-") 
+to append to the standard generic options list.
+Can be NULL for generic options error message only.
+.VE
+
 .BE
 
 .SH DESCRIPTION
@@ -76,12 +103,11 @@ layer to enable C and Tcl programs to perform input and output using the
 same APIs for a variety of files, devices, sockets etc. The generic C APIs
 are described in the manual entry for \fBTcl_OpenFileChannel\fR.
 .PP
-The lower layer provides type-specific channel drivers for each type of
-file, socket and device supported on each platform.
-This manual entry describes the C APIs
-used by the generic layer to communicate with type-specific channel drivers
-to perform the input and output operations. It also explains how new types
-of channels can be added by providing new channel drivers.
+The lower layer provides type-specific channel drivers for each type
+of device supported on each platform.  This manual entry describes the
+C APIs used to communicate between the generic layer and the
+type-specific channel drivers.  It also explains how new types of
+channels can be added by providing new channel drivers.
 .PP
 Channel drivers consist of a number of components: First, each channel
 driver provides a \fBTcl_ChannelType\fR structure containing pointers to
@@ -90,17 +116,17 @@ communicate with the channel driver. The \fBTcl_ChannelType\fR structure
 and the functions referenced by it are described in the section
 TCL_CHANNELTYPE, below.
 .PP
-Second, channel drivers usually provide a Tcl command to create instances
-of that type of channel. For example, the Tcl \fBopen\fR command creates
-channels that use the \fBfile\fR and \fBcommand\fR channel drivers, and
-the Tcl \fBsocket\fR command creates channels that use TCP sockets for
-network communication.
-.PP
-Third, a channel driver optionally provides a C function to open channel
-instances of that type. For example, \fBTcl_OpenFileChannel\fR opens a
-channel that uses the \fBfile\fR channel driver, and
-\fBTcl_OpenTcpClient\fR opens a channel that uses the TCP network protocol.
-These creation functions typically use
+Second, channel drivers usually provide a Tcl command to create
+instances of that type of channel. For example, the Tcl \fBopen\fR
+command creates channels that use the file and command channel
+drivers, and the Tcl \fBsocket\fR command creates channels that use
+TCP sockets for network communication.
+.PP
+Third, a channel driver optionally provides a C function to open
+channel instances of that type. For example, \fBTcl_OpenFileChannel\fR
+opens a channel that uses the file channel driver, and
+\fBTcl_OpenTcpClient\fR opens a channel that uses the TCP network
+protocol.  These creation functions typically use
 \fBTcl_CreateChannel\fR internally to open the channel.
 .PP
 To add a new type of channel you must implement a C API or a Tcl command
@@ -112,7 +138,8 @@ The generic layer will then invoke the functions referenced in that
 structure to perform operations on the channel.
 .PP
 \fBTcl_CreateChannel\fR opens a new channel and associates the supplied
-\fItypePtr\fR, \fIinFile\fR, \fIoutFile\fR and \fIinstanceData\fR with it.
+\fItypePtr\fR and \fIinstanceData\fR with it. The channel is opened in the
+mode indicated by \fImask\fR.
 For a discussion of channel drivers, their operations and the
 \fBTcl_ChannelType\fR structure, see the section TCL_CHANNELTYPE, below.
 .PP
@@ -129,11 +156,19 @@ the same as the \fItypePtr\fR argument in the call to
 with the channel, or NULL if the \fIchannelName\fR argument to
 \fBTcl_CreateChannel\fR was NULL.
 .PP
-\fBTcl_GetChannelFile\fR returns the \fIinFile\fR associated with
-\fIchannel\fR if \fIdirection\fR is \fBTCL_READABLE\fR, or the
-\fIoutFile\fR if \fIdirection\fR is \fBTCL_WRITABLE\fR. The operation
-returns NULL if the respective value was specified as NULL in the call to
-\fBTcl_CreateChannel\fR that created \fIchannel\fR.
+.VS
+\fBTcl_GetChannelHandle\fR places the OS-specific device handle
+associated with \fIchannel\fR for the given \fIdirection\fR in the
+location specified by \fIhandlePtr\fR and returns \fBTCL_OK\fR.  If
+the channel does not have a device handle for the specified direction,
+then \fBTCL_ERROR\fR is returned instead.  Different channel drivers
+will return different types of handle.  Refer to the manual entries
+for each driver to determine what type of handle is returned.
+.VE
+.PP
+\fBTcl_GetChannelMode\fR returns an OR-ed combination of \fBTCL_READABLE\fR
+and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input
+and output.
 .PP
 \fBTcl_SetDefaultTranslation\fR sets the default end of line translation
 mode. This mode will be installed as the translation mode for the channel
@@ -152,6 +187,19 @@ output. The \fIsize\fR argument should be between ten and one million,
 allowing buffers of ten bytes to one million bytes. If \fIsize\fR is
 outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
 4096.
+.PP
+.VS
+\fBTcl_NotifyChannel\fR is called by a channel driver to indicate to
+the generic layer that the events specified by \fImask\fR have
+occurred on the channel.  Channel drivers are responsible for invoking
+this function whenever the channel handlers need to be called for the
+channel.  See \fBWATCHPROC\fR below for more details.
+.VE
+.PP
+.VS
+\fBTcl_BadChannelOption\fR is called from driver specific set or get option
+procs to generate a complete error message.
+.VE
 
 .SH TCL_CHANNELTYPE
 .PP
@@ -160,6 +208,7 @@ pointers to functions that implement the various operations on a channel;
 these operations are invoked as needed by the generic layer. The
 \fBTcl_ChannelType\fR structure contains the following fields:
 .PP
+.VS
 .CS
 typedef struct Tcl_ChannelType {
 	char *\fItypeName\fR;
@@ -170,8 +219,11 @@ typedef struct Tcl_ChannelType {
 	Tcl_DriverSeekProc *\fIseekProc\fR;
 	Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
 	Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
+	Tcl_DriverWatchProc *\fIwatchProc\fR;
+	Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
 } Tcl_ChannelType;
 .CE
+.VE
 .PP
 The driver must provide implementations for all functions except
 \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR, and
@@ -195,25 +247,22 @@ the generic layer to set blocking and nonblocking mode on the device.
 .CS
 typedef int Tcl_DriverBlockModeProc(
 	ClientData \fIinstanceData\fR,
-	Tcl_File \fIinFile\fR,
-	Tcl_File \fIoutFile\fR,
 	int \fImode\fR);
 .CE
 .PP
-The \fIinstanceData\fR, \fIinFile\fR and \fIoutFile\fR arguments are the same
-as the values passed to \fBTcl_CreateChannel\fR when this channel was created.
-The \fImode\fR argument is either \fBTCL_MODE_BLOCKING\fR or
-\fBTCL_MODE_NONBLOCKING\fR to set the device into blocking or nonblocking
-mode. The function should return zero if the operation was successful,
-or a nonzero POSIX error code if the operation failed.
+The \fIinstanceData\fR is the same as the value passed to
+\fBTcl_CreateChannel\fR when this channel was created.  The \fImode\fR
+argument is either \fBTCL_MODE_BLOCKING\fR or \fBTCL_MODE_NONBLOCKING\fR to
+set the device into blocking or nonblocking mode. The function should
+return zero if the operation was successful, or a nonzero POSIX error code
+if the operation failed.
 .PP
 If the operation is successful, the function can modify the supplied
-\fIinstanceData\fR to record that the channel
-entered blocking or nonblocking mode, and modify \fIinFile\fR and
-\fIoutFile\fR to implement the blocking or nonblocking behavior.
+\fIinstanceData\fR to record that the channel entered blocking or
+nonblocking mode and to implement the blocking or nonblocking behavior.
 For some device types, the blocking and nonblocking behavior can be
-implemented by the underlying operating system; for other device types,
-the behavior must be emulated in the channel driver.
+implemented by the underlying operating system; for other device types, the
+behavior must be emulated in the channel driver.
 
 .SH CLOSEPROC
 .PP
@@ -224,22 +273,19 @@ closed. \fICloseProc\fR must match the following prototype:
 .CS
 typedef int Tcl_DriverCloseProc(
 	ClientData \fIinstanceData\fR,
-	Tcl_Interp *\fIinterp\fR,
-	Tcl_File \fIinFile\fR,
-	Tcl_File \fIoutFile\fR);
+	Tcl_Interp *\fIinterp\fR);
 .CE
 .PP
-The \fIinstanceData\fR, \fIinFile\fR, and \fIoutFile\fR arguments are the
-same as the respective values provided to \fBTcl_CreateChannel\fR when the
-channel was created. The function should release any storage maintained by
-the channel driver for this channel, and close the input and output devices
-identified by \fIinFile\fR and \fIoutFile\fR. All queued output will have
-been flushed to the device before this function is called, and no further
-driver operations will be invoked on this instance after calling the
-\fIcloseProc\fR. If the close operation is successful, the procedure should
-return zero; otherwise it should return a nonzero POSIX error code. In
-addition, if an error occurs and \fIinterp\fR is not NULL, the procedure
-should store an error message in \fIinterp->result\fR.
+The \fIinstanceData\fR argument is the same as the value provided to
+\fBTcl_CreateChannel\fR when the channel was created. The function should
+release any storage maintained by the channel driver for this channel, and
+close the input and output devices encapsulated by this channel. All queued
+output will have been flushed to the device before this function is called,
+and no further driver operations will be invoked on this instance after
+calling the \fIcloseProc\fR. If the close operation is successful, the
+procedure should return zero; otherwise it should return a nonzero POSIX
+error code. In addition, if an error occurs and \fIinterp\fR is not NULL,
+the procedure should store an error message in \fIinterp->result\fR.
 
 .SH INPUTPROC
 .PP
@@ -250,28 +296,27 @@ internal buffer. \fIInputProc\fR must match the following prototype:
 .CS
 typedef int Tcl_DriverInputProc(
 	ClientData \fIinstanceData\fR,
-	Tcl_File \fIinFile\fR,
 	char *\fIbuf\fR,
 	int \fIbufSize\fR,
 	int *\fIerrorCodePtr\fR);
 .CE
 .PP
-\fIInstanceData\fR and \fIInFile\fR are the same as the values passed to
+\fIInstanceData\fR is the same as the value passed to
 \fBTcl_CreateChannel\fR when the channel was created.  The \fIbuf\fR
-argument points to an array of bytes in which to store input from
-the device, and the \fIbufSize\fR argument indicates how many bytes are
+argument points to an array of bytes in which to store input from the
+device, and the \fIbufSize\fR argument indicates how many bytes are
 available at \fIbuf\fR.
 .PP
 The \fIerrorCodePtr\fR argument points to an integer variable provided by
 the generic layer. If an error occurs, the function should set the variable
 to a POSIX error code that identifies the error that occurred.
 .PP
-The function should read data from the input device identified by
-\fIinFile\fR and store it at \fIbuf\fR.  On success, the function should
-return a positive integer indicating how many bytes were read from the
-input device and stored at \fIbuf\fR. On error, the function should return
--1. If an error occurs after some data has been read from the device, that
-data is lost.
+The function should read data from the input device encapsulated by the
+channel and store it at \fIbuf\fR.  On success, the function should return
+a nonnegative integer indicating how many bytes were read from the input
+device and stored at \fIbuf\fR. On error, the function should return -1. If
+an error occurs after some data has been read from the device, that data is
+lost.
 .PP
 If \fIinputProc\fR can determine that the input device has some data
 available but less than requested by the \fIbufSize\fR argument, the
@@ -293,13 +338,12 @@ generic layer to transfer data from an internal buffer to the output device.
 .CS
 typedef int Tcl_DriverOutputProc(
 	ClientData \fIinstanceData\fR,
-	Tcl_File \fIoutFile\fR,
 	char *\fIbuf\fR,
 	int \fItoWrite\fR,
 	int *\fIerrorCodePtr\fR);
 .CE
 .PP
-\fIInstanceData\fR and \fIOutFile\fR are the same as the values passed to
+\fIInstanceData\fR is the same as the value passed to
 \fBTcl_CreateChannel\fR when the channel was created. The \fIbuf\fR
 argument contains an array of bytes to be written to the device, and the
 \fItoWrite\fR argument indicates how many bytes are to be written from the
@@ -310,14 +354,12 @@ the generic layer. If an error occurs, the function should set this
 variable to a POSIX error code that identifies the error.
 .PP
 The function should write the data at \fIbuf\fR to the output device
-identified by \fIoutFile\fR. On success, the function should return a
-positive integer indicating how many bytes were written to the output
-device.
-The return value is normally the same as \fItoWrite\fR, but may be
-less in some cases such as if the output operation is interrupted
-by a signal.
-If an error occurs the function should return -1.
-In case of error, some data may have been written to the device.
+encapsulated by the channel. On success, the function should return a
+nonnegative integer indicating how many bytes were written to the output
+device.  The return value is normally the same as \fItoWrite\fR, but may be
+less in some cases such as if the output operation is interrupted by a
+signal. If an error occurs the function should return -1.  In case of
+error, some data may have been written to the device.
 .PP
 If the channel is nonblocking and the output device is unable to absorb any
 data whatsoever, the function should return -1 with an \fBEAGAIN\fR error
@@ -333,25 +375,21 @@ prototype:
 .CS
 typedef int Tcl_DriverSeekProc(
 	ClientData \fIinstanceData\fR,
-	Tcl_File \fIinFile\fR,
-	Tcl_File \fIoutFile\fR,
 	long \fIoffset\fR,
 	int \fIseekMode\fR,
 	int *\fIerrorCodePtr\fR);
 .CE
 .PP
-The \fIinstanceData\fR, \fIinFile\fR and \fIoutFile\fR arguments are the
-same as the values given to \fBTcl_CreateChannel\fR when this channel was
-created.  \fIOffset\fR and \fIseekMode\fR have the same meaning as for the
-\fBTcl_SeekChannel\fR procedure (described in the manual entry for
-\fBTcl_OpenFileChannel\fR).
+The \fIinstanceData\fR argument is the same as the value given to
+\fBTcl_CreateChannel\fR when this channel was created.  \fIOffset\fR and
+\fIseekMode\fR have the same meaning as for the \fBTcl_SeekChannel\fR
+procedure (described in the manual entry for \fBTcl_OpenFileChannel\fR).
 .PP
-The \fIerrorCodePtr\fR argument points to
-an integer variable provided by the generic layer for returning
-\fBerrno\fR values from the function.
-The function should set this variable to a POSIX error code
-if an error occurs. The function should store an \fBEINVAL\fR error code if
-the channel type does not implement seeking.
+The \fIerrorCodePtr\fR argument points to an integer variable provided by
+the generic layer for returning \fBerrno\fR values from the function.  The
+function should set this variable to a POSIX error code if an error occurs.
+The function should store an \fBEINVAL\fR error code if the channel type
+does not implement seeking.
 .PP
 The return value is the new access point or -1 in case of error. If an
 error occurred, the function should not move the access point.
@@ -384,9 +422,15 @@ be NULL, which indicates that this channel type supports no type specific
 options. 
 .PP
 If the option value is successfully modified to the new value, the function
-returns \fBTCL_OK\fR. It returns \fBTCL_ERROR\fR if the \fIoptionName\fR is
-unrecognized or if \fIoptionValue\fR specifies a value for the option that
-is not supported. In this case, the function leaves an error message in the
+returns \fBTCL_OK\fR.
+.VS
+It should call \fBTcl_BadChannelOption\fR which itself returns
+\fBTCL_ERROR\fR if the \fIoptionName\fR is
+unrecognized. 
+.VE
+If \fIoptionValue\fR specifies a value for the option that
+is not supported or if a system call error occurs,
+the function should leave an error message in the
 \fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
 function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
 error code.
@@ -400,6 +444,9 @@ channel. \fIgetOptionProc\fR must match the following prototype:
 .CS
 typedef int Tcl_DriverGetOptionProc(
 	ClientData \fIinstanceData\fR,
+.VS
+	Tcl_Interp *\fIinterp\fR,
+.VE
 	char *\fIoptionName\fR,
 	Tcl_DString *\fIdsPtr\fR);
 .CE
@@ -409,9 +456,16 @@ channel. If the option name is not NULL, the function stores its current
 value, as a string, in the Tcl dynamic string \fIdsPtr\fR.
 If \fIoptionName\fR is NULL, the function stores in \fIdsPtr\fR an
 alternating list of all supported options and their current values.
-On success, the function returns \fBTCL_OK\fR. If an error occurs, the
-function returns \fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an
-appropriate POSIX error code.
+On success, the function returns \fBTCL_OK\fR. 
+.VS
+It should call \fBTcl_BadChannelOption\fR which itself returns
+\fBTCL_ERROR\fR if the \fIoptionName\fR is
+unrecognized. If a system call error occurs,
+the function should leave an error message in the
+\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
+function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
+error code.
+.VE
 .PP
 Some options are handled by the generic code and this function is never
 called to retrieve their value, e.g. \fB-blockmode\fR. Other options are
@@ -420,8 +474,98 @@ channel driver will get called to implement them. The \fIgetOptionProc\fR
 field can be NULL, which indicates that this channel type supports no type
 specific options.
 
+.SH WATCHPROC
+.VS
+.PP
+The \fIwatchProc\fR field contains the address of a function called
+by the generic layer to initialize the event notification mechanism to
+notice events of interest on this channel.
+\fIWatchProc\fR should match the following prototype:
+.PP
+.CS
+typedef void Tcl_DriverWatchProc(
+	ClientData \fIinstanceData\fR,
+	int \fImask\fR);
+.CE
+.VE
+.PP
+The \fIinstanceData\fR is the same as the value passed to
+\fBTcl_CreateChannel\fR when this channel was created. The \fImask\fR
+argument is an OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
+and \fBTCL_EXCEPTION\fR; it indicates events the caller is interested in
+noticing on this channel.
+.PP
+.VS
+The function should initialize device type specific mechanisms to
+notice when an event of interest is present on the channel.  When one
+or more of the designated events occurs on the channel, the channel
+driver is responsible for calling \fBTcl_NotifyChannel\fR to inform
+the generic channel module.  The driver should take care not to starve
+other channel drivers or sources of callbacks by invoking
+Tcl_NotifyChannel too frequently.  Fairness can be insured by using
+the Tcl event queue to allow the channel event to be scheduled in sequence
+with other events.  See the description of \fBTcl_QueueEvent\fR for
+details on how to queue an event.
+
+.SH GETHANDLEPROC
+.PP
+The \fIgetHandleProc\fR field contains the address of a function called by
+the generic layer to retrieve a device-specific handle from the channel.
+\fIGetHandleProc\fR should match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverGetHandleProc(
+	ClientData \fIinstanceData\fR,
+	int \fIdirection\fR,
+	ClientData *\fIhandlePtr\fR);
+.CE
+.PP
+\fIInstanceData is the same as the value passed to
+\fBTcl_CreateChannel\fR when this channel was created. The \fIdirection\fR
+argument is either \fBTCL_READABLE\fR to retrieve the handle used
+for input, or \fBTCL_WRITABLE\fR to retrieve the handle used for
+output.
+.PP
+If the channel implementation has device-specific handles, the
+function should retrieve the appropriate handle associated with the
+channel, according the \fIdirection\fR argument.  The handle should be
+stored in the location referred to by \fIhandlePtr\fR, and
+\fBTCL_OK\fR should be returned.  If the channel is not open for the
+specified direction, or if the channel implementation does not use
+device handles, the function should return \fBTCL_ERROR\fR.
+.VE
+
+.VS
+.SH TCL_BADCHANNELOPTION
+.PP
+This procedure generates a "bad option" error message in an
+(optional) interpreter.  It is used by channel drivers when 
+a invalid Set/Get option is requested. Its purpose is to concatenate
+the generic options list to the specific ones and factorize
+the generic options error message string.
+.PP
+It always return \fBTCL_ERROR\fR
+.PP
+An error message is generated in interp's result object to
+indicate that a command was invoked with the a bad option
+The message has the form
+.CS
+    bad option "blah": should be one of 
+    <...generic options...>+<...specific options...>
+so you get for instance:
+    bad option "-blah": should be one of -blocking,
+    -buffering, -buffersize, -eofchar, -translation,
+    -peername, or -sockname
+when called with optionList="peername sockname"
+.CE
+"blah" is the optionName argument and "<specific options>"
+is a space separated list of specific option words.
+The function takes good care of inserting minus signs before
+each option, commas after, and an "or" before the last option.
+.VE
+
 .SH "SEE ALSO"
-Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3)
+Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3)
 
 .SH KEYWORDS
 blocking, channel driver, channel registration, channel type, nonblocking
diff --git a/contrib/tcl/doc/CrtCommand.3 b/contrib/tcl/doc/CrtCommand.3
index 8c27e2f..3da0a30 100644
--- a/contrib/tcl/doc/CrtCommand.3
+++ b/contrib/tcl/doc/CrtCommand.3
@@ -1,41 +1,23 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) CrtCommand.3 1.22 96/03/25 19:58:44
+'\" SCCS: @(#) CrtCommand.3 1.29 97/06/04 17:23:53
 '\" 
 .so man.macros
 .TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_CreateCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo, Tcl_SetCommandInfo \- implement new commands in C
+Tcl_CreateCommand \- implement new commands in C
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
-.VS
-.VE
 Tcl_Command
 \fBTcl_CreateCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
-.sp
-int
-\fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR)
-.sp
-.VS
-int
-\fBTcl_GetCommandInfo\fR(\fIinterp, cmdName, infoPtr\fR)
-.sp
-int
-\fBTcl_SetCommandInfo\fR(\fIinterp, cmdName, infoPtr\fR)
-.sp
-.VS
-char *
-\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
-.VE
-.VE
 .SH ARGUMENTS
 .AS Tcl_CmdDeleteProc **deleteProcPtr
 .AP Tcl_Interp *interp in
@@ -51,14 +33,6 @@ Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
 Procedure to call before \fIcmdName\fR is deleted from the interpreter;
 allows for command-specific cleanup.  If NULL, then no procedure is
 called before the command is deleted.
-.AP Tcl_CmdInfo *infoPtr in/out
-.VS
-Pointer to structure containing various information about a
-Tcl command.
-.AP Tcl_Command token in
-Token for command, returned by previous call to \fBTcl_CreateCommand\fR.
-The command must not have been deleted.
-.VE
 .BE
 
 .SH DESCRIPTION
@@ -66,16 +40,41 @@ The command must not have been deleted.
 \fBTcl_CreateCommand\fR defines a new command in \fIinterp\fR and associates
 it with procedure \fIproc\fR such that whenever \fIcmdName\fR is
 invoked as a Tcl command (via a call to \fBTcl_Eval\fR) the Tcl interpreter
-will call \fIproc\fR
-to process the command.  If there is already a command \fIcmdName\fR
-associated with the interpreter, it is deleted.
-.VS
-\fBTcl_CreateCommand\fR returns a token that may be used to refer
+will call \fIproc\fR to process the command.
+It differs from \fBTcl_CreateObjCommand\fR in that a new string-based
+command is defined;
+that is, a command procedure is defined that takes an array of
+argument strings instead of objects.
+The object-based command procedures registered by \fBTcl_CreateObjCommand\fR
+can execute significantly faster than the string-based command procedures
+defined by \fBTcl_CreateCommand\fR.
+This is because they take Tcl objects as arguments
+and those objects can retain an internal representation that
+can be manipulated more efficiently.
+Also, Tcl's interpreter now uses objects internally.
+In order to invoke a string-based command procedure
+registered by \fBTcl_CreateCommand\fR,
+it must generate and fetch a string representation
+from each argument object before the call
+and create a new Tcl object to hold the string result returned by the
+string-based command procedure.
+New commands should be defined using \fBTcl_CreateObjCommand\fR.
+We support \fBTcl_CreateCommand\fR for backwards compatibility.
+.PP
+The procedures \fBTcl_DeleteCommand\fR, \fBTcl_GetCommandInfo\fR,
+and \fBTcl_SetCommandInfo\fR are used in conjunction with
+\fBTcl_CreateCommand\fR.
+.PP
+\fBTcl_CreateCommand\fR will delete an existing command \fIcmdName\fR,
+if one is already associated with the interpreter.
+It returns a token that may be used to refer
 to the command in subsequent calls to \fBTcl_GetCommandName\fR.
+If \fIcmdName\fR contains any \fB::\fR namespace qualifiers,
+then the command is added to the specified namespace;
+otherwise the command is added to the global namespace.
 If \fBTcl_CreateCommand\fR is called for an interpreter that is in
 the process of being deleted, then it does not create a new command
 and it returns NULL.
-.VE
 \fIProc\fR should have arguments and result that match the type
 \fBTcl_CmdProc\fR:
 .CS
@@ -101,24 +100,22 @@ last value is NULL.
 \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR.  See the Tcl overview man page
 for details on what these codes mean.  Most normal commands will only
 return \fBTCL_OK\fR or \fBTCL_ERROR\fR.  In addition, \fIproc\fR must set
-\fIinterp->result\fR to point to a string value;
+the interpreter result to point to a string value;
 in the case of a \fBTCL_OK\fR return code this gives the result
 of the command, and in the case of \fBTCL_ERROR\fR it gives an error message.
 The \fBTcl_SetResult\fR procedure provides an easy interface for setting
-the return value;  for complete details on how the \fIinterp->result\fR
+the return value;  for complete details on how the the interpreter result
 field is managed, see the \fBTcl_Interp\fR man page.
 Before invoking a command procedure,
-\fBTcl_Eval\fR sets \fIinterp->result\fR to point to an empty string, so simple
-commands can return an empty result by doing nothing at all.
+\fBTcl_Eval\fR sets the interpreter result to point to an empty string,
+so simple commands can return an empty result by doing nothing at all.
 .PP
-.VS
 The contents of the \fIargv\fR array belong to Tcl and are not
 guaranteed to persist once \fIproc\fR returns:  \fIproc\fR should
-not modify them, nor should it set \fIinterp->result\fR to point
+not modify them, nor should it set the interpreter result to point
 anywhere within the \fIargv\fR values.
 Call \fBTcl_SetResult\fR with status \fBTCL_VOLATILE\fR if you want
 to return something from the \fIargv\fR array.
-.VE
 .PP
 \fIDeleteProc\fR will be invoked when (if) \fIcmdName\fR is deleted.
 This can occur through a call to \fBTcl_DeleteCommand\fR or \fBTcl_DeleteInterp\fR,
@@ -133,49 +130,9 @@ typedef void Tcl_CmdDeleteProc(ClientData \fIclientData\fR);
 The \fIclientData\fR argument will be the same as the \fIclientData\fR
 argument passed to \fBTcl_CreateCommand\fR.
 .PP
-\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
-Once the call completes, attempts to invoke \fIcmdName\fR in
-\fIinterp\fR will result in errors.
-If \fIcmdName\fR isn't bound as a command in \fIinterp\fR then
-\fBTcl_DeleteCommand\fR does nothing and returns -1;  otherwise
-it returns 0.
-There are no restrictions on \fIcmdName\fR:  it may refer to
-a built-in command, an application-specific command, or a Tcl procedure.
-.PP
-.VS
-\fBTcl_GetCommandInfo\fR checks to see whether its \fIcmdName\fR argument
-exists as a command in \fIinterp\fR.  If not then it returns 0.
-Otherwise it places information about the command in the structure
-pointed to by \fIinfoPtr\fR and returns 1.
-Tcl_CmdInfo structures have fields named \fIproc\fR, \fIclientData\fR,
-and \fIdeleteProc\fR, which have the same meaning as the corresponding
-arguments to \fBTcl_CreateCommand\fR.
-There is also a field \fIdeleteData\fR, which is the ClientData value
-to pass to \fIdeleteProc\fR;  it is normally the same as
-\fIclientData\fR but may be set independently using the
-\fBTcl_SetCommandInfo\fR procedure.
-.PP
-\fBTcl_SetCommandInfo\fR is used to modify the procedures and
-ClientData values associated with a command.
-Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
-If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
-Otherwise, it copies the information from \fI*infoPtr\fR to
-Tcl's internal structure for the command and returns 1.
-Note that this procedure allows the ClientData for a command's
-deletion procedure to be given a different value than the ClientData
-for its command procedure.
-.PP
-\fBTcl_GetCommandName\fR provides a mechanism for tracking commands
-that have been renamed.  Given a token returned by \fBTcl_CreateCommand\fR
-when the command was created, \fBTcl_GetCommandName\fR returns the
-string name of the command.  If the command has been renamed since it
-was created, then \fBTcl_GetCommandName\fR returns the current name.
-The command corresponding to \fItoken\fR must not have been deleted.
-The string returned by \fBTcl_GetCommandName\fR is in dynamic memory
-owned by Tcl and is only guaranteed to retain its value as long as the
-command isn't deleted or renamed;  callers should copy the string if
-they need to keep it for a long time.
-.VE
+
+.SH "SEE ALSO"
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
 
 .SH KEYWORDS
-bind, command, create, delete, interpreter
+bind, command, create, delete, interpreter, namespace
diff --git a/contrib/tcl/doc/CrtFileHdlr.3 b/contrib/tcl/doc/CrtFileHdlr.3
index 31a5466..9b26975 100644
--- a/contrib/tcl/doc/CrtFileHdlr.3
+++ b/contrib/tcl/doc/CrtFileHdlr.3
@@ -1,29 +1,32 @@
 '\"
 '\" Copyright (c) 1990-1994 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) CrtFileHdlr.3 1.6 96/03/25 19:59:08
+'\" SCCS: @(#) CrtFileHdlr.3 1.7 97/04/23 16:11:17
 '\" 
 .so man.macros
-.TH Tcl_CreateFileHandler 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks with files or devices
+Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks with files or devices (Unix only)
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
+.VS
 .sp
-\fBTcl_CreateFileHandler\fR(\fIfile, mask, proc, clientData\fR)
+\fBTcl_CreateFileHandler\fR(\fIfd, mask, proc, clientData\fR)
 .sp
-\fBTcl_DeleteFileHandler\fR(\fIfile\fR)
+\fBTcl_DeleteFileHandler\fR(\fIfd\fR)
+.VE
 .SH ARGUMENTS
 .AS Tcl_FileProc clientData
-.AP Tcl_File file in
-Generic file handle for an open file or device (such as returned by
-\fBTcl_GetFile\fR call).
+.VS
+.AP int fd in
+Unix file descriptor for an open file or device.
+.VE
 .AP int mask in
 Conditions under which \fIproc\fR should be called:
 OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR,
@@ -38,10 +41,12 @@ Arbitrary one-word value to pass to \fIproc\fR.
 
 .SH DESCRIPTION
 .PP
+.VS
 \fBTcl_CreateFileHandler\fR arranges for \fIproc\fR to be
 invoked in the future whenever I/O becomes possible on a file
 or an exceptional condition exists for the file.  The file
-is indicated by \fIfile\fR, and the conditions of interest
+is indicated by \fIfd\fR, and the conditions of interest
+.VE
 are indicated by \fImask\fR.  For example, if \fImask\fR
 is \fBTCL_READABLE\fR, \fIproc\fR will be called when
 the file is readable.
@@ -70,12 +75,12 @@ to \fBTcl_CreateFileHandler\fR.
 .PP
 There may exist only one handler for a given file at a given time.
 If \fBTcl_CreateFileHandler\fR is called when a handler already
-exists for \fIfile\fR, then the new callback replaces the information
+exists for \fIfd\fR, then the new callback replaces the information
 that was previously recorded.
 .PP
 \fBTcl_DeleteFileHandler\fR may be called to delete the
-file handler for \fIfile\fR;  if no handler exists for the
-file given by \fIfile\fR then the procedure has no effect.
+file handler for \fIfd\fR;  if no handler exists for the
+file given by \fIfd\fR then the procedure has no effect.
 .PP
 The purpose of file handlers is to enable an application to respond to
 events while waiting for files to become ready for I/O.  For this to work
@@ -85,6 +90,11 @@ block if it reads or writes too much data; while waiting for the I/O to
 complete the application won't be able to service other events. Use
 \fBTcl_SetChannelOption\fR with \fB\-blocking\fR to set the channel into
 blocking or nonblocking mode as required.
+.PP
+.VS
+Note that these interfaces are only supported by the Unix
+implementation of the Tcl notifier.   
+.VE
 
 .SH KEYWORDS
 callback, file, handler
diff --git a/contrib/tcl/doc/CrtMathFnc.3 b/contrib/tcl/doc/CrtMathFnc.3
index f3f458d..907df03 100644
--- a/contrib/tcl/doc/CrtMathFnc.3
+++ b/contrib/tcl/doc/CrtMathFnc.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) CrtMathFnc.3 1.8 96/03/25 19:59:55
+'\" SCCS: @(#) CrtMathFnc.3 1.9 96/08/26 12:59:43
 '\" 
 .so man.macros
 .TH Tcl_CreateMathFunc 3 7.0 Tcl "Tcl Library Procedures"
@@ -66,8 +66,6 @@ which describe the actual arguments to the function:
 .CS
 typedef struct Tcl_Value {
 	Tcl_ValueType \fItype\fR;
-.VS
-.VE
 	long \fIintValue\fR;
 	double \fIdoubleValue\fR;
 } Tcl_Value;
diff --git a/contrib/tcl/doc/CrtObjCmd.3 b/contrib/tcl/doc/CrtObjCmd.3
new file mode 100644
index 0000000..e510889
--- /dev/null
+++ b/contrib/tcl/doc/CrtObjCmd.3
@@ -0,0 +1,249 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) CrtObjCmd.3 1.9 97/06/04 17:23:37
+'\" 
+.so man.macros
+.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName \- implement new commands in C
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Command
+\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
+.sp
+int
+\fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR)
+.sp
+int
+\fBTcl_DeleteCommandFromToken\fR(\fIinterp, token\fR)
+.sp
+int
+\fBTcl_GetCommandInfo\fR(\fIinterp, cmdName, infoPtr\fR)
+.sp
+int
+\fBTcl_SetCommandInfo\fR(\fIinterp, cmdName, infoPtr\fR)
+.sp
+char *
+\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
+.SH ARGUMENTS
+.AS Tcl_ObjCmdProc *deleteProc in/out
+.AP Tcl_Interp *interp in
+Interpreter in which to create a new command or that contains a command.
+.AP char *cmdName in
+Name of command.
+.AP Tcl_ObjCmdProc *proc in
+Implementation of the new command: \fIproc\fR will be called whenever
+\fIcmdName\fR is invoked as a command.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
+.AP Tcl_CmdDeleteProc *deleteProc in
+Procedure to call before \fIcmdName\fR is deleted from the interpreter;
+allows for command-specific cleanup. If NULL, then no procedure is
+called before the command is deleted.
+.AP Tcl_Command token in
+Token for command, returned by previous call to \fBTcl_CreateObjCommand\fR.
+The command must not have been deleted.
+.AP Tcl_CmdInfo *infoPtr in/out
+Pointer to structure containing various information about a
+Tcl command.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CreateObjCommand\fR defines a new command in \fIinterp\fR
+and associates it with procedure \fIproc\fR
+such that whenever \fIname\fR is
+invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObj\fR)
+the Tcl interpreter will call \fIproc\fR to process the command.
+.PP
+\fBTcl_CreateObjCommand\fR will delete any command \fIname\fR
+already associated with the interpreter.
+It returns a token that may be used to refer
+to the command in subsequent calls to \fBTcl_GetCommandName\fR.
+If \fIname\fR contains any \fB::\fR namespace qualifiers,
+then the command is added to the specified namespace;
+otherwise the command is added to the global namespace.
+If \fBTcl_CreateObjCommand\fR is called for an interpreter that is in
+the process of being deleted, then it does not create a new command
+and it returns NULL.
+\fIproc\fR should have arguments and result that match the type
+\fBTcl_ObjCmdProc\fR:
+.CS
+typedef int Tcl_ObjCmdProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	int \fIobjc\fR,
+.VS
+	Tcl_Obj *CONST \fIobjv\fR[]);
+.CE
+When \fIproc\fR is invoked, the \fIclientData\fR and \fIinterp\fR parameters
+will be copies of the \fIclientData\fR and \fIinterp\fR arguments given to
+\fBTcl_CreateObjCommand\fR.  Typically, \fIclientData\fR points to an
+application-specific data structure that describes what to do when the
+command procedure is invoked. \fIObjc\fR and \fIobjv\fR describe the
+arguments to the command, \fIobjc\fR giving the number of argument objects
+(including the command name) and \fIobjv\fR giving the values of the
+arguments.  The \fIobjv\fR array will contain \fIobjc\fR values, pointing to
+the argument objects.  Unlike \fIargv\fR[\fIargv\fR] used in a
+string-based command procedure, \fIobjv\fR[\fIobjc\fR] will not contain NULL.
+.PP
+Additionally, when \fIproc\fR is invoked, it must not modify the contents
+of the \fIobjv\fR array by assigning new pointer values to any element of the
+array (for example, \fIobjv\fR[\fB2\fR] = \fBNULL\fR) because this will
+cause memory to be lost and the runtime stack to be corrupted.  The
+\fBCONST\fR in the declaration of \fIobjv\fR will cause ANSI-compliant
+compilers to report any such attempted assignment as an error.  However,
+it is acceptable to modify the internal representation of any individual
+object argument.  For instance, the user may call
+\fBTcl_GetIntFromObject\fR on \fIobjv\fR[\fB2\fR] to obtain the integer
+representation of that object; that call may change the type of the object
+that \fIobjv\fR[\fB2\fR] points at, but will not change where
+\fIobjv\fR[\fB2\fR] points.
+.VE
+.PP
+\fIproc\fR must return an integer code that is either \fBTCL_OK\fR,
+\fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR.
+See the Tcl overview man page
+for details on what these codes mean.  Most normal commands will only
+return \fBTCL_OK\fR or \fBTCL_ERROR\fR.
+In addition, if \fIproc\fR needs to return a non-empty result,
+it can call \fBTcl_SetObjResult\fR to set the interpreter's result.
+In the case of a \fBTCL_OK\fR return code this gives the result
+of the command,
+and in the case of \fBTCL_ERROR\fR this gives an error message.
+Before invoking a command procedure,
+\fBTcl_EvalObj\fR sets interpreter's result to
+point to an object representing an empty string, so simple
+commands can return an empty result by doing nothing at all.
+.PP
+The contents of the \fIobjv\fR array belong to Tcl and are not
+guaranteed to persist once \fIproc\fR returns: \fIproc\fR should
+not modify them.
+Call \fBTcl_SetObjResult\fR if you want
+to return something from the \fIobjv\fR array.
+.PP
+\fIDeleteProc\fR will be invoked when (if) \fIname\fR is deleted.
+This can occur through a call to \fBTcl_DeleteCommand\fR
+or \fBTcl_DeleteInterp\fR,
+or by replacing \fIname\fR in another call to \fBTcl_CreateObjCommand\fR.
+\fIDeleteProc\fR is invoked before the command is deleted, and gives the
+application an opportunity to release any structures associated
+with the command.  \fIDeleteProc\fR should have arguments and
+result that match the type \fBTcl_CmdDeleteProc\fR:
+.CS
+typedef void Tcl_CmdDeleteProc(ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR argument will be the same as the \fIclientData\fR
+argument passed to \fBTcl_CreateObjCommand\fR.
+.PP
+\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
+Once the call completes, attempts to invoke \fIcmdName\fR in
+\fIinterp\fR will result in errors.
+If \fIcmdName\fR isn't bound as a command in \fIinterp\fR then
+\fBTcl_DeleteCommand\fR does nothing and returns -1;  otherwise
+it returns 0.
+There are no restrictions on \fIcmdName\fR:  it may refer to
+a built-in command, an application-specific command, or a Tcl procedure.
+If \fIname\fR contains any \fB::\fR namespace qualifiers,
+the command is deleted from the specified namespace.
+.PP
+Given a token returned by \fBTcl_CreateObjCommand\fR
+when the command was created,
+\fBTcl_DeleteCommandFromToken\fR deletes the command
+from a command interpreter.
+Once the call completes, attempts to invoke the command in
+\fIinterp\fR will result in errors.
+If the command corresponding to \fItoken\fR
+has already been deleted from \fIinterp\fR then
+\fBTcl_DeleteCommand\fR does nothing and returns -1;
+otherwise it returns 0.
+.PP
+\fBTcl_GetCommandInfo\fR checks to see whether its \fIcmdName\fR argument
+exists as a command in \fIinterp\fR.
+\fIcmdName\fR may include \fB::\fR namespace qualifiers
+to identify a command in a particular namespace.
+If the command is not found, then it returns 0.
+Otherwise it places information about the command
+in the \fBTcl_CmdInfo\fR structure
+pointed to by \fIinfoPtr\fR and returns 1.
+A \fBTcl_CmdInfo\fR structure has the following fields:
+.CS
+typedef struct Tcl_CmdInfo {
+    int isNativeObjectProc;
+    Tcl_ObjCmdProc *objProc;
+    ClientData objClientData;
+    Tcl_CmdProc *proc;
+    ClientData clientData;
+    Tcl_CmdDeleteProc *deleteProc;
+    ClientData deleteData;
+    Tcl_Namespace *namespacePtr;
+} Tcl_CmdInfo;
+.CE
+The \fIisNativeObjectProc\fR field has the value 1
+if \fBTcl_CreateObjCommand\fR was called to register the command;
+it is 0 if only \fBTcl_CreateCommand\fR was called.
+It allows a program to determine whether it is faster to
+call \fIobjProc\fR or \fIproc\fR:
+\fIobjProc\fR is normally faster
+if \fIisNativeObjectProc\fR has the value 1.
+The fields \fIobjProc\fR and \fIobjClientData\fR
+have the same meaning as the \fIproc\fR and \fIclientData\fR
+arguments to \fBTcl_CreateObjCommand\fR;
+they hold information about the object-based command procedure
+that the Tcl interpreter calls to implement the command.
+The fields \fIproc\fR and \fIclientData\fR
+hold information about the string-based command procedure
+that implements the command.
+If \fBTcl_CreateCommand\fR was called for this command,
+this is the procedure passed to it;
+otherwise, this is a compatibility procedure
+registered by \fBTcl_CreateObjCommand\fR
+that simply calls the command's
+object-based procedure after converting its string arguments to Tcl objects.
+The field \fIdeleteData\fR is the ClientData value
+to pass to \fIdeleteProc\fR;  it is normally the same as
+\fIclientData\fR but may be set independently using the
+\fBTcl_SetCommandInfo\fR procedure.
+The field \fInamespacePtr\fR holds a pointer to the
+Tcl_Namespace that contains the command.
+.PP
+\fBTcl_SetCommandInfo\fR is used to modify the procedures and
+ClientData values associated with a command.
+Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
+\fIcmdName\fR may include \fB::\fR namespace qualifiers
+to identify a command in a particular namespace.
+If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
+Otherwise, it copies the information from \fI*infoPtr\fR to
+Tcl's internal structure for the command and returns 1.
+Note that this procedure allows the ClientData for a command's
+deletion procedure to be given a different value than the ClientData
+for its command procedure.
+Note that \fBTcl_SetCmdInfo\fR will not change a command's namespace;
+you must use \fBTcl_RenameCommand\fR to do that.
+.PP
+\fBTcl_GetCommandName\fR provides a mechanism for tracking commands
+that have been renamed.
+Given a token returned by \fBTcl_CreateObjCommand\fR
+when the command was created, \fBTcl_GetCommandName\fR returns the
+string name of the command.  If the command has been renamed since it
+was created, then \fBTcl_GetCommandName\fR returns the current name.
+This name does not include any \fB::\fR namespace qualifiers.
+The command corresponding to \fItoken\fR must not have been deleted.
+The string returned by \fBTcl_GetCommandName\fR is in dynamic memory
+owned by Tcl and is only guaranteed to retain its value as long as the
+command isn't deleted or renamed;  callers should copy the string if
+they need to keep it for a long time.
+.PP
+
+.SH "SEE ALSO"
+Tcl_CreateCommand, Tcl_ResetResult, Tcl_SetObjResult
+
+.SH KEYWORDS
+bind, command, create, delete, namespace, object
diff --git a/contrib/tcl/doc/CrtSlave.3 b/contrib/tcl/doc/CrtSlave.3
index 7979bbb..3b3d7b8 100644
--- a/contrib/tcl/doc/CrtSlave.3
+++ b/contrib/tcl/doc/CrtSlave.3
@@ -4,14 +4,13 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) CrtSlave.3 1.13 96/03/25 20:00:42
+'\" SCCS: @(#) CrtSlave.3 1.22 97/06/10 17:52:33
 '\" 
 .so man.macros
-.TH Tcl_CreateSlave 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetSlaves, Tcl_GetMaster, Tcl_CreateAlias, Tcl_GetAlias, Tcl_GetAliases \- manage
-multiple Tcl interpreters and aliases.
+Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands.
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -34,20 +33,35 @@ Tcl_Interp *
 int
 \fBTcl_GetInterpPath\fR(\fIaskingInterp, slaveInterp\fR)
 .sp
+.VS
 int
 \fBTcl_CreateAlias\fR(\fIslaveInterp, srcCmd, targetInterp, targetCmd, argc, argv\fR)
 .sp
 int
+\fBTcl_CreateAliasObj\fR(\fIslaveInterp, srcCmd, targetInterp, targetCmd, objc, objv\fR)
+.VE
+.sp
+int
 \fBTcl_GetAlias\fR(\fIinterp, srcCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr\fR)
+.sp
+.VS
+int
+\fBTcl_GetAliasObj\fR(\fIinterp, srcCmd, targetInterpPtr, targetCmdPtr, objcPtr, objvPtr\fR)
+.sp
+int
+\fBTcl_ExposeCommand\fR(\fIinterp, hiddenCmdName, cmdName\fR)
+.sp
+int
+\fBTcl_HideCommand\fR(\fIinterp, cmdName, hiddenCmdName\fR)
 .SH ARGUMENTS
-.AS Tcl_InterpDeleteProc **delProcPtr
+.AS Tcl_InterpDeleteProc **hiddenCmdName
 .AP Tcl_Interp *interp in
 Interpreter in which to execute the specified command.
 .AP char *slaveName in
 Name of slave interpreter to create or manipulate.
 .AP int isSafe in
-Zero means the interpreter may have all Tcl functions. Non-zero means the
-new interpreter's functionality should be limited to make it safe.
+If non-zero, a ``safe'' slave that is suitable for running untrusted code
+is created, otherwise a trusted slave is created.
 .AP Tcl_Interp *slaveInterp in
 Interpreter to use for creating the source command for an alias (see
 below).
@@ -62,6 +76,12 @@ Count of additional arguments to pass to the alias command.
 .AP char **argv in
 Vector of strings, the additional arguments to pass to the alias command.
 This storage is owned by the caller.
+.AP int objc in
+Count of additional object arguments to pass to the alias object command.
+.AP Tcl_Object **objv in
+Vector of Tcl_Obj structures, the additional object argumenst to pass to
+the alias object command.
+This storage is owned by the caller.
 .AP Tcl_Interp **targetInterpPtr in
 Pointer to location to store the address of the interpreter where a target
 command is defined for an alias.
@@ -75,6 +95,20 @@ the alias. The location is in storage owned by the caller.
 Pointer to location to store a vector of strings, the additional arguments
 to pass to an alias. The location is in storage owned by the caller, the
 vector of strings is owned by the called function.
+.AP int *objcPtr out
+Pointer to location to store count of additional object arguments to be
+passed to the alias. The location is in storage owned by the caller.
+.AP Tcl_Obj ***objvPtr out
+Pointer to location to store a vector of Tcl_Obj structures, the additional
+arguments to pass to an object alias command. The location is in storage
+owned by the caller, the vector of Tcl_Obj structures is owned by the
+called function.
+.VS
+.AP char *cmdName in
+Name of an exposed command to hide or create.
+.AP char *hiddenCmdName in
+Name of a hidden command to create or expose.
+.VE
 .BE
 
 .SH DESCRIPTION
@@ -87,28 +121,31 @@ interpreter. The return value for those procedures that return an \fBint\fR
 is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
 then the \fBresult\fR field of the interpreter contains an error message.
 .PP
-\fBTcl_CreateSlave\fR creates a new interpreter as a slave of the given
-interpreter. It also creates a slave command in the given interpreter which
-allows the master interpreter to manipulate the slave. The slave
-interpreter and the slave command have the specified name. If \fIisSafe\fR
-is \fB1\fR, the new slave interpreter is made ``safe'' by removing all
-unsafe functionality. If the creation failed, \fBNULL\fR is returned.
+\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
+It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which 
+allows \fIinterp\fR to manipulate the new slave. 
+If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
+code has access to all the Tcl commands.
+If it is \fB1\fR, the command creates a ``safe'' slave in which Tcl code
+has access only to set of Tcl commands defined as ``Safe Tcl''; see the
+manual entry for the Tcl \fBinterp\fR command for details.
+If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
 .PP
-\fBTcl_IsSafe\fR returns \fB1\fR if the given interpreter is ``safe'',
+\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is ``safe'' (was created
+with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
 \fB0\fR otherwise.
 .PP
-\fBTcl_MakeSafe\fR makes the given interpreter ``safe'' by removing all
+\fBTcl_MakeSafe\fR makes \fIinterp\fR ``safe'' by removing all
 non-core and core unsafe functionality. Note that if you call this after
 adding some extension to an interpreter, all traces of that extension will
-be removed from the interpreter. This operation always succeeds and returns
-\fBTCL_OK\fR.
+be removed from the interpreter.
 .PP
-\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of the given
-interpreter. The slave interpreter is identified by the name specified.
+\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of
+\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
 If no such slave interpreter exists, \fBNULL\fR is returned.
 .PP
-\fBTcl_GetMaster\fR returns a pointer to the master interpreter of the
-given interpreter. If the given interpreter has no master (it is a
+\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
+\fIinterp\fR. If \fIinterp\fR has no master (it is a
 top-level interpreter) then \fBNULL\fR is returned.
 .PP
 \fBTcl_GetInterpPath\fR sets the \fIresult\fR field in \fIaskingInterp\fR
@@ -118,25 +155,66 @@ of the relative path succeeds, \fBTCL_OK\fR is returned, else
 \fBTCL_ERROR\fR is returned and the \fIresult\fR field in
 \fIaskingInterp\fR contains the error message.
 .PP
-\fBTcl_GetAlias\fR returns information about an alias of a specified name
-in a given interpreter. Any of the result fields can be \fBNULL\fR, in
+.VS
+\fBTcl_CreateAlias\fR creates an object command named \fIsrcCmd\fR in
+\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
+to be invoked in \fItargetInterp\fR. The arguments specified by the strings
+contained in \fIargv\fR are always prepended to any arguments supplied in the
+invocation of \fIsrcCmd\fR and passed to \fItargetCmd\fR.
+This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
+it fails; in that case, an error message is left in the object result
+of \fIslaveInterp\fR.
+Note that there are no restrictions on the ancestry relationship (as
+created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
+\fItargetInterp\fR. Any two interpreters can be used, without any
+restrictions on how they are related.
+.PP
+\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAliasObj\fR except 
+that it takes a vector of objects to pass as additional arguments instead
+of a vector of strings.
+.VE
+.PP
+\fBTcl_GetAlias\fR returns information about an alias \fIaliasName\fR
+in \fIinterp\fR. Any of the result fields can be \fBNULL\fR, in
 which case the corresponding datum is not returned. If a result field is
 non\-\fBNULL\fR, the address indicated is set to the corresponding datum.
 For example, if \fItargetNamePtr\fR is non\-\fBNULL\fR it is set to a
 pointer to the string containing the name of the target command.
+.VS
+.PP
+\fBTcl_GetAliasObj\fR is similar to \fBTcl_GetAlias\fR except that it
+returns a pointer to a vector of Tcl_Obj structures instead of a vector of
+strings.
+.PP
+\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
+the set of hidden commands to the set of exposed commands, renaming it to
+\fIcmdName\fR. \fIHiddenCmdName\fR must be the name of an existing hidden
+command, or the operation will return \fBTCL_ERROR\fR and deposit an error
+message in the \fIresult\fR field in \fIinterp\fR.
+If an exposed command named \fIcmdName\fR already exists,
+the operation returns \fBTCL_ERROR\fR and leaves an error message in the
+object result of \fIinterp\fR.
+If the operation succeeds, it returns \fBTCL_OK\fR.
+After executing this command, attempts to use \fIcmdName\fR in a call to
+\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will again succeed.
+.PP
+\fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of
+exposed commands to the set of hidden commands, renaming it to
+\fIhiddenCmdName\fR. \fICmdName\fR must be the name of an existing exposed
+command, or the operation will return \fBTCL_ERROR\fR and leave an error
+message in the object result of \fIinterp\fR.
+If a hidden command named \fIhiddenCmdName\fR already
+exists, the operation also returns \fBTCL_ERROR\fR and the \fIresult\fR
+field in \fIinterp\fR contains an error message.
+If the operation succeeds, it returns \fBTCL_OK\fR.
+After executing this command, attempts to use \fIcmdName\fR in a call to
+\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will fail.
 .PP
-In order to map over all slave interpreters, use \fBTcl_Eval\fR with the
-command \fBinterp slaves\fR and use the value (a Tcl list) deposited in the
-\fBresult\fR field of the interpreter. Similarly, to map over all aliases
-whose source commands are defined in an interpreter, use \fBTcl_Eval\fR
-with the command \fBinterp aliases\fR and use the value (a Tcl list)
-deposited in the \fBresult\fR field. Note that the storage of this list
-belongs to Tcl, so you should copy it before invoking any other Tcl
-commands in that interpreter.
 .SH "SEE ALSO"
 For a description of the Tcl interface to multiple interpreters, see
 \fIinterp(n)\fR.
 
 .SH KEYWORDS
-alias, command, interpreter, master, slave
+alias, command, exposed commands, hidden commands, interpreter, invoke,
+master, slave, 
 
diff --git a/contrib/tcl/doc/CrtTimerHdlr.3 b/contrib/tcl/doc/CrtTimerHdlr.3
index 75a13c6..14f48a4 100644
--- a/contrib/tcl/doc/CrtTimerHdlr.3
+++ b/contrib/tcl/doc/CrtTimerHdlr.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) CrtTimerHdlr.3 1.3 96/03/25 20:00:55
+'\" SCCS: @(#) CrtTimerHdlr.3 1.4 96/09/17 10:54:58
 '\" 
 .so man.macros
 .TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures"
@@ -67,7 +67,10 @@ previously-created timer handler.  It deletes the handler
 indicated by \fItoken\fR so that no call to \fIproc\fR
 will be made;  if that handler no longer exists
 (e.g. because the time period has already elapsed and \fIproc\fR
-has been invoked) then \fBTcl_DeleteTimerHandler\fR does nothing.
+has been invoked then \fBTcl_DeleteTimerHandler\fR does nothing.
+The tokens returned by \fBTcl_CreateTimerHandler\fR never have
+a value of NULL, so if NULL is passed to \fBTcl_DeleteTimerHandler\fR
+then the procedure does nothing.
 
 .SH KEYWORDS
 callback, clock, handler, timer
diff --git a/contrib/tcl/doc/DString.3 b/contrib/tcl/doc/DString.3
index 330d67d..e6ea142 100644
--- a/contrib/tcl/doc/DString.3
+++ b/contrib/tcl/doc/DString.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) DString.3 1.19 96/03/25 20:01:32
+'\" SCCS: @(#) DString.3 1.20 96/08/26 12:59:44
 '\" 
 .so man.macros
 .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
@@ -34,17 +34,13 @@ int
 char *
 \fBTcl_DStringValue\fR(\fIdsPtr\fR)
 .sp
-.VS
 \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
-.VE
 .sp
 \fBTcl_DStringFree\fR(\fIdsPtr\fR)
 .sp
 \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
 .sp
-.VS
 \fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
-.VE
 .SH ARGUMENTS
 .AS Tcl_DString newLength
 .AP Tcl_DString *dsPtr in/out
@@ -114,7 +110,6 @@ of a dynamic string (not including the terminating null character).
 \fBTcl_DStringValue\fR is a  macro that returns a pointer to the
 current contents of a dynamic string.
 .PP
-.VS
 .PP
 \fBTcl_DStringSetLength\fR changes the length of a dynamic string.
 If \fInewLength\fR is less than the string's current length, then
@@ -128,7 +123,6 @@ caller to fill in the new space.
 \fBTcl_DStringSetLength\fR does not free up the string's storage space
 even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
 will still need to be called.
-.VE
 .PP
 \fBTcl_DStringFree\fR should be called when you're finished using
 the string.  It frees up any memory that was allocated for the string
@@ -141,13 +135,11 @@ This saves the cost of allocating new memory and copying the string.
 \fBTcl_DStringResult\fR also reinitializes the dynamic string to
 an empty string.
 .PP
-.VS
 \fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR.
 It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and
 it clears \fIinterp\fR's result.
 If possible it does this by moving a pointer rather than by copying
 the string.
-.VE
 
 .SH KEYWORDS
 append, dynamic string, free, result
diff --git a/contrib/tcl/doc/DetachPids.3 b/contrib/tcl/doc/DetachPids.3
index 7c14721..153649b 100644
--- a/contrib/tcl/doc/DetachPids.3
+++ b/contrib/tcl/doc/DetachPids.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) DetachPids.3 1.14 96/03/25 20:01:48
+'\" SCCS: @(#) DetachPids.3 1.15 96/08/26 12:59:44
 '\" 
 .so man.macros
 .TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
@@ -18,9 +18,7 @@ Tcl_DetachPids, Tcl_ReapDetachedProcs \- manage child processes in background
 .sp
 \fBTcl_DetachPids\fR(\fInumPids, pidPtr\fR)
 .sp
-.VS
 \fBTcl_ReapDetachedProcs\fR()
-.VE
 .SH ARGUMENTS
 .AS int *statusPtr
 .AP int numPids in
@@ -31,7 +29,6 @@ Address of array containing \fInumPids\fR process ids.
 
 .SH DESCRIPTION
 .PP
-.VS
 \fBTcl_DetachPids\fR and \fBTcl_ReapDetachedProcs\fR provide a
 mechanism for managing subprocesses that are running in background.
 These procedures are needed because the parent of a process must
@@ -60,7 +57,6 @@ However, if you call \fBTcl_DetachPids\fR in situations where the
 \fBexec\fR command may never get executed, you may wish to call
 \fBTcl_ReapDetachedProcs\fR from time to time so that background
 processes can be cleaned up.
-.VE
 
 .SH KEYWORDS
 background, child, detach, process, wait
diff --git a/contrib/tcl/doc/DoOneEvent.3 b/contrib/tcl/doc/DoOneEvent.3
index a9e0bc9..fd092c8 100644
--- a/contrib/tcl/doc/DoOneEvent.3
+++ b/contrib/tcl/doc/DoOneEvent.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) DoOneEvent.3 1.5 96/03/25 20:02:05
+'\" SCCS: @(#) DoOneEvent.3 1.6 97/05/09 18:12:05
 '\" 
 .so man.macros
 .TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures"
@@ -46,7 +46,7 @@ If no events are found, \fBTcl_DoOneEvent\fR checks for \fBTcl_DoWhenIdle\fR
 callbacks; if any are found, it invokes all of them and returns.
 Finally, if no events or idle callbacks have been found, then
 \fBTcl_DoOneEvent\fR sleeps until an event occurs; then it adds any 
-ew events to the Tcl event queue, calls handlers for the first event,
+new events to the Tcl event queue, calls handlers for the first event,
 and returns.
 The normal return value is 1 to signify that some event
 was processed (see below for other alternatives).
diff --git a/contrib/tcl/doc/DoWhenIdle.3 b/contrib/tcl/doc/DoWhenIdle.3
index 2b43b05..c909026 100644
--- a/contrib/tcl/doc/DoWhenIdle.3
+++ b/contrib/tcl/doc/DoWhenIdle.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) DoWhenIdle.3 1.4 96/03/25 20:02:20
+'\" SCCS: @(#) DoWhenIdle.3 1.6 97/05/09 18:18:33
 '\" 
 .so man.macros
 .TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
@@ -74,7 +74,6 @@ to defer display updates until all pending commands have
 been processed.  Without this feature, redundant redisplays
 might occur in some situations, such as the processing of
 a command file.
-
 .SH BUGS
 .PP
 At present it is not safe for an idle callback to reschedule itself
diff --git a/contrib/tcl/doc/DoubleObj.3 b/contrib/tcl/doc/DoubleObj.3
new file mode 100644
index 0000000..b467851
--- /dev/null
+++ b/contrib/tcl/doc/DoubleObj.3
@@ -0,0 +1,79 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) DoubleObj.3 1.6 97/05/08 19:50:07
+'\" 
+.so man.macros
+.TH Tcl_DoubleObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl objects as floating-point values
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewDoubleObj\fR(\fIdoubleValue\fR)
+.sp
+\fBTcl_SetDoubleObj\fR(\fIobjPtr, doubleValue\fR)
+.sp
+int
+\fBTcl_GetDoubleFromObj\fR(\fIinterp, objPtr, doublePtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp doubleValue in/out
+.AP double doubleValue in
+A double-precision floating point value used to initialize or set a double object.
+.AP Tcl_Obj *objPtr in/out
+For \fBTcl_SetDoubleObj\fR, this points to the object to be converted
+to double type.
+For \fBTcl_GetDoubleFromObj\fR, this refers to the object
+from which to get a double value; 
+if \fIobjPtr\fR does not already point to a double object,
+an attempt will be made to convert it to one.
+.AP Tcl_Interp *interp in/out
+If an error occurs during conversion,
+an error message is left in the interpreter's result object
+unless \fIinterp\fR is NULL.
+.AP double *doublePtr out
+Points to place to store the double value
+obtained from \fIobjPtr\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are used to create, modify, and read
+double Tcl objects from C code.
+\fBTcl_NewDoubleObj\fR and \fBTcl_SetDoubleObj\fR
+will create a new object of double type
+or modify an existing object to have double type. 
+Both of these procedures set the object to have the
+double-precision floating point value given by \fIdoubleValue\fR;
+\fBTcl_NewDoubleObj\fR returns a pointer to a newly created object
+with reference count zero.
+Both procedures set the object's type to be double
+and assign the double value to the object's internal representation
+\fIdoubleValue\fR member.
+\fBTcl_SetDoubleObj\fR invalidates any old string representation
+and, if the object is not already a double object,
+frees any old internal representation.
+.PP
+\fBTcl_GetDoubleFromObj\fR attempts to return a double value
+from the Tcl object \fIobjPtr\fR.
+If the object is not already a double object,
+it will attempt to convert it to one.
+If an error occurs during conversion, it returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+unless \fIinterp\fR is NULL.
+Otherwise, it returns \fBTCL_OK\fR and stores the double value
+in the address given by \fIdoublePtr\fR.
+If the object is not already a double object,
+the conversion will free any old internal representation.
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
+
+.SH KEYWORDS
+double, double object, double type, internal representation, object, object type, string representation
diff --git a/contrib/tcl/doc/Eval.3 b/contrib/tcl/doc/Eval.3
index f1a78c8..f100697 100644
--- a/contrib/tcl/doc/Eval.3
+++ b/contrib/tcl/doc/Eval.3
@@ -1,11 +1,11 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Eval.3 1.17 96/03/25 20:02:33
+'\" SCCS: @(#) Eval.3 1.21 97/01/22 14:22:03
 '\" 
 .so man.macros
 .TH Tcl_Eval 3 7.0 Tcl "Tcl Library Procedures"
@@ -17,9 +17,7 @@ Tcl_Eval, Tcl_VarEval, Tcl_EvalFile, Tcl_GlobalEval \- execute Tcl commands
 \fB#include <tcl.h>\fR
 .sp
 int
-.VS
 \fBTcl_Eval\fR(\fIinterp, cmd\fR)
-.VE
 .sp
 int
 \fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR)
@@ -32,8 +30,8 @@ int
 .SH ARGUMENTS
 .AS Tcl_Interp **termPtr;
 .AP Tcl_Interp *interp in
-Interpreter in which to execute the command.  String result will be
-stored in \fIinterp->result\fR.
+Interpreter in which to execute the command.
+A string result will be stored in \fIinterp->result\fR.
 .AP char *cmd in
 Command (or sequence of commands) to execute.  Must be in writable
 memory (\fBTcl_Eval\fR makes temporary modifications to the command).
@@ -46,61 +44,71 @@ Name of file containing Tcl command string.
 .SH DESCRIPTION
 .PP
 All four of these procedures execute Tcl commands.
-\fBTcl_Eval\fR is the core procedure:  it parses commands
-from \fIcmd\fR and executes them in
-.VS
-order until either an error occurs or it reaches the end of the string.
-.VE
-The return value from \fBTcl_Eval\fR is one
-of the Tcl return codes \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or
+\fBTcl_Eval\fR is the core procedure and is used by all the others.
+It executes the commands in the script held by \fIcmd\fR
+until either an error occurs or it reaches the end of the script.
+.PP
+Note that \fBTcl_Eval\fR and \fBTcl_GlobalEval\fR
+have been largely replaced by the
+object-based procedures \fBTcl_EvalObj\fR and \fBTcl_GlobalEvalObj\fR.
+Those object-based procedures evaluate a script held in a Tcl object
+instead of a string.
+The object argument can retain the bytecode instructions for the script
+and so avoid reparsing the script each time it is executed.
+\fBTcl_Eval\fR is implemented using \fBTcl_EvalObj\fR
+but is slower because it must reparse the script each time
+since there is no object to retain the bytecode instructions.
+.PP
+The return value from \fBTcl_Eval\fR is one of the Tcl return codes
+\fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or
 \fBTCL_CONTINUE\fR, and \fIinterp->result\fR will point to
-a string with additional information (result value or error message).
-This return information corresponds to the last command executed from
-\fIcmd\fR.
+a string with additional information (a result value or error message).
+If an error occurs during compilation, this return information
+describes the error.
+Otherwise, this return information corresponds to the last command
+executed from \fIcmd\fR.
 .PP
 \fBTcl_VarEval\fR takes any number of string arguments
-of any length, concatenates
-them into a single string, then calls \fBTcl_Eval\fR to
-execute that string as a Tcl command.
+of any length, concatenates them into a single string,
+then calls \fBTcl_Eval\fR to execute that string as a Tcl command.
 It returns the result of the command and also modifies
-\fIinterp->result\fR in the usual fashion for Tcl commands.  The
-last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
+\fIinterp->result\fR in the usual fashion for Tcl commands.
+The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
 of arguments.
 .PP
 \fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates
 its contents as a Tcl command by calling \fBTcl_Eval\fR.  It returns
-a standard Tcl result that reflects the result of evaluating the
-file.
+a standard Tcl result that reflects the result of evaluating the file.
 If the file couldn't be read then a Tcl error is returned to describe
 why the file couldn't be read.
 .PP
-\fBTcl_GlobalEval\fR is similar to \fBTcl_Eval\fR except that it
-processes the command at global level.
-This means that the variable context for the command consists of
-global variables only (it ignores any Tcl procedure that is active).
-This produces an effect similar to the Tcl command ``\fBuplevel 0\fR''.
-.PP
 During the processing of a Tcl command it is legal to make nested
-calls to evaluate other commands (this is how conditionals, loops,
-and procedures are implemented).
-If a code other than
-\fBTCL_OK\fR is returned from a nested \fBTcl_Eval\fR invocation, then the
-caller should normally return immediately, passing that same
-return code back to its caller, and so on until the top-level application is
-reached.  A few commands, like \fBfor\fR, will check for certain
+calls to evaluate other commands (this is how procedures and
+some control structures are implemented).
+If a code other than \fBTCL_OK\fR is returned
+from a nested \fBTcl_Eval\fR invocation,
+then the caller should normally return immediately,
+passing that same return code back to its caller,
+and so on until the top-level application is reached.
+A few commands, like \fBfor\fR, will check for certain
 return codes, like \fBTCL_BREAK\fR and \fBTCL_CONTINUE\fR, and process them
 specially without returning.
 .PP
-\fBTcl_Eval\fR keeps track of how many nested Tcl_Eval invocations are
-in progress for \fIinterp\fR.
+\fBTcl_Eval\fR keeps track of how many nested \fBTcl_Eval\fR
+invocations are in progress for \fIinterp\fR.
 If a code of \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR is
-about to be returned from the topmost \fBTcl_Eval\fR invocation for
-\fIinterp\fR, then \fBTcl_Eval\fR converts the return code to \fBTCL_ERROR\fR
-and sets \fIinterp->result\fR to point to an error message indicating that
+about to be returned from the topmost \fBTcl_Eval\fR
+invocation for \fIinterp\fR,
+it converts the return code to \fBTCL_ERROR\fR
+and sets \fIinterp->result\fR
+to point to an error message indicating that
 the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was
-invoked in an inappropriate place.  This means that top-level
-applications should never see a return code from \fBTcl_Eval\fR other then
-\fBTCL_OK\fR or \fBTCL_ERROR\fR.
+invoked in an inappropriate place.
+This means that top-level applications should never see a return code
+from \fBTcl_Eval\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
+
+.SH "SEE ALSO"
+Tcl_EvalObj, Tcl_GlobalEvalObj
 
 .SH KEYWORDS
-command, execute, file, global, interpreter, variable
+command, execute, file, global, object, object result, variable
diff --git a/contrib/tcl/doc/EvalObj.3 b/contrib/tcl/doc/EvalObj.3
new file mode 100644
index 0000000..8cb8f82
--- /dev/null
+++ b/contrib/tcl/doc/EvalObj.3
@@ -0,0 +1,91 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) EvalObj.3 1.4 97/01/22 15:18:44
+'\" 
+.so man.macros
+.TH Tcl_EvalObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_EvalObj, Tcl_GlobalEvalObj \- execute Tcl commands
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_EvalObj\fR(\fIinterp, objPtr\fR)
+.sp
+int
+\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp **termPtr;
+.AP Tcl_Interp *interp in
+Interpreter in which to execute the command.
+The command's result will be stored in the interpreter's result object
+and can be retrieved using \fBTcl_GetObjResult\fR.
+.AP Tcl_Obj *objPtr in
+A Tcl object containing a command string
+(or sequence of commands in a string) to execute.
+.BE
+
+.SH DESCRIPTION
+.PP
+These two procedures execute Tcl commands.
+\fBTcl_EvalObj\fR is the core procedure
+and is used by \fBTcl_GlobalEvalObj\fR.
+It executes the commands in the script held by \fIobjPtr\fR
+until either an error occurs or it reaches the end of the script.
+If this is the first time \fIobjPtr\fR has been executed,
+its commands are compiled into bytecode instructions
+that are then executed if there are no compilation errors.
+.PP
+The return value from \fBTcl_EvalObj\fR is one of the Tcl return codes
+\fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or
+\fBTCL_CONTINUE\fR,
+and a result object containing additional information
+(a result value or error message)
+that can be retrieved using \fBTcl_GetObjResult\fR.
+If an error occurs during compilation, this return information
+describes the error.
+Otherwise, this return information corresponds to the last command
+executed from \fIobjPtr\fR.
+.PP
+\fBTcl_GlobalEvalObj\fR is similar to \fBTcl_EvalObj\fR except that it
+processes the command at global level.
+This means that the variable context for the command consists of
+global variables only (it ignores any Tcl procedure that is active).
+This produces an effect similar to the Tcl command ``\fBuplevel 0\fR''.
+.PP
+During the processing of a Tcl command it is legal to make nested
+calls to evaluate other commands (this is how procedures and
+some control structures are implemented).
+If a code other than \fBTCL_OK\fR is returned
+from a nested \fBTcl_EvalObj\fR invocation,
+then the caller should normally return immediately,
+passing that same return code back to its caller,
+and so on until the top-level application is reached.
+A few commands, like \fBfor\fR, will check for certain
+return codes, like \fBTCL_BREAK\fR and \fBTCL_CONTINUE\fR, and process them
+specially without returning.
+.PP
+\fBTcl_EvalObj\fR keeps track of how many nested \fBTcl_EvalObj\fR
+invocations are in progress for \fIinterp\fR.
+If a code of \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR is
+about to be returned from the topmost \fBTcl_EvalObj\fR
+invocation for \fIinterp\fR,
+it converts the return code to \fBTCL_ERROR\fR
+and sets the interpreter's result object
+to point to an error message indicating that
+the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was
+invoked in an inappropriate place.
+This means that top-level applications should never see a return code
+from \fBTcl_EvalObj\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
+
+.SH "SEE ALSO"
+Tcl_GetObjResult, Tcl_SetObjResult
+
+.SH KEYWORDS
+command, execute, file, global, object, object result, variable
diff --git a/contrib/tcl/doc/Exit.3 b/contrib/tcl/doc/Exit.3
index dc370bd..1d3e26d 100644
--- a/contrib/tcl/doc/Exit.3
+++ b/contrib/tcl/doc/Exit.3
@@ -4,19 +4,21 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Exit.3 1.4 96/03/25 20:02:50
+'\" SCCS: @(#) Exit.3 1.8 96/12/10 07:37:23
 '\" 
 .so man.macros
-.TH Tcl_Exit 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_Exit 3 7.7 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_Exit, Tcl_CreateExitHandler, Tcl_DeleteExitHandler \- end the application (and invoke exit handlers)
+Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler \- end the application (and invoke exit handlers)
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
 \fBTcl_Exit\fR(\fIstatus\fR)
 .sp
+\fBTcl_Finalize\fR()
+.sp
 \fBTcl_CreateExitHandler\fR(\fIproc, clientData\fR)
 .sp
 \fBTcl_DeleteExitHandler\fR(\fIproc, clientData\fR)
@@ -24,8 +26,8 @@ Tcl_Exit, Tcl_CreateExitHandler, Tcl_DeleteExitHandler \- end the application (a
 .AS Tcl_ExitProc clientData
 .AP int status  in
 Provides information about why application exited.  Exact meaning may
-be platform-specific.  0 usually means a normal exit, 1 means that an
-error occurred.
+be platform-specific.  0 usually means a normal exit, any nonzero value
+usually means that an error occurred.
 .AP Tcl_ExitProc *proc in
 Procedure to invoke before exiting application.
 .AP ClientData clientData in
@@ -34,18 +36,41 @@ Arbitrary one-word value to pass to \fIproc\fR.
 
 .SH DESCRIPTION
 .PP
-\fBTcl_Exit\fR is the procedure that is invoked to end a Tcl application.
-It is invoked by the \fBexit\fR command, as well as anyplace else that
-terminates the application.
-No-one should ever invoke the \fBexit\fR procedure directly;  always
+The procedures described here provide a graceful mechanism to end the
+execution of a \fBTcl\fR application. Exit handlers are invoked to cleanup the
+application's state before ending the execution of \fBTcl\fR code.
+.PP
+Invoke \fBTcl_Exit\fR to end a \fBTcl\fR application and to exit from this
+process. This procedure is invoked by the \fBexit\fR command, and can be
+invoked anyplace else to terminate the application.
+No-one should ever invoke the \fBexit\fR system procedure directly;  always
 invoke \fBTcl_Exit\fR instead, so that it can invoke exit handlers.
+Note that if other code invokes \fBexit\fR system procedure directly, or
+otherwise causes the application to terminate without calling
+\fBTcl_Exit\fR, the exit handlers will not be run.
+\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never
+returns control to its caller.
+.PP
+.VS
+\fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not
+exit from the current process.
+It is useful for cleaning up when a process is finished using \fBTcl\fR but
+wishes to continue executing, and when \fBTcl\fR is used in a dynamically
+loaded extension that is about to be unloaded.
+On some systems \fBTcl\fR is automatically notified when it is being
+unloaded, and it calls \fBTcl_Finalize\fR internally; on these systems it
+not necessary for the caller to explicitly call \fBTcl_Finalize\fR.
+However, to ensure portability, your code should always invoke
+\fBTcl_Finalize\fR when \fBTcl\fR is being unloaded, to ensure that the
+code will work on all platforms. \fBTcl_Finalize\fR can be safely called
+more than once.
+.VE
 .PP
 \fBTcl_CreateExitHandler\fR arranges for \fIproc\fR to be invoked
-by \fBTcl_Exit\fR before it terminates the application.
+by \fBTcl_Finalize\fR and \fBTcl_Exit\fR.
 This provides a hook for cleanup operations such as flushing buffers
 and freeing global memory.
-\fIProc\fR should have arguments and return value that match
-the type \fBTcl_ExitProc\fR:
+\fIProc\fR should match the type \fBTcl_ExitProc\fR:
 .CS
 typedef void Tcl_ExitProc(ClientData \fIclientData\fR);
 .CE
@@ -61,6 +86,18 @@ previously-created exit handler.  It removes the handler
 indicated by \fIproc\fR and \fIclientData\fR so that no call
 to \fIproc\fR will be made.  If no such handler exists then
 \fBTcl_DeleteExitHandler\fR does nothing.
+.PP
+.VS
+.PP
+\fBTcl_Finalize\fR and \fBTcl_Exit\fR execute all registered exit handlers,
+in reverse order from the order in which they were registered.
+This matches the natural order in which extensions are loaded and unloaded;
+if extension \fBA\fR loads extension \fBB\fR, it usually
+unloads \fBB\fR before it itself is unloaded.
+If extension \fBA\fR registers its exit handlers before loading extension
+\fBB\fR, this ensures that any exit handlers for \fBB\fR will be executed
+before the exit handlers for \fBA\fR.
+.VE
 
 .SH KEYWORDS
-callback, end application, exit
+callback, cleanup, dynamic loading, end application, exit, unloading
diff --git a/contrib/tcl/doc/ExprLong.3 b/contrib/tcl/doc/ExprLong.3
index 100bec3..634f3c0 100644
--- a/contrib/tcl/doc/ExprLong.3
+++ b/contrib/tcl/doc/ExprLong.3
@@ -1,11 +1,11 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) ExprLong.3 1.17 96/03/25 20:03:03
+'\" SCCS: @(#) ExprLong.3 1.26 97/06/26 13:42:47
 '\" 
 .so man.macros
 .TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures"
@@ -30,7 +30,7 @@ int
 .SH ARGUMENTS
 .AS Tcl_Interp *booleanPtr
 .AP Tcl_Interp *interp in
-Interpreter in whose context to evaluate \fIstring\fR.
+Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR.
 .AP char *string in
 Expression to be evaluated.  Must be in writable memory (the expression
 parser makes temporary modifications to the string during parsing, which
@@ -48,20 +48,29 @@ expression.
 
 .SH DESCRIPTION
 .PP
-These four procedures all evaluate an expression, returning
-the result in one of four different forms.
-The expression is given by the \fIstring\fR argument, and it
-can have any of the forms accepted by the \fBexpr\fR command.
+These four procedures all evaluate the expression
+given by the \fIstring\fR argument
+and return the result in one of four different forms.
+The expression can have any of the forms accepted by the \fBexpr\fR command.
+Note that these procedures have been largely replaced by the
+object-based procedures \fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR,
+\fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprStringObj\fR.
+Those object-based procedures evaluate an expression held in a Tcl object
+instead of a string.
+The object argument can retain an internal representation
+that is more efficient to execute.
+.PP
 The \fIinterp\fR argument refers to an interpreter used to
 evaluate the expression (e.g. for variables and nested Tcl
-commands) and to return error information.  \fIInterp->result\fR
-is assumed to be initialized in the standard fashion when any
-of the procedures are invoked.
+commands) and to return error information.
+\fIinterp->result\fR is assumed to be initialized
+in the standard fashion when they are invoked.
 .PP
 For all of these procedures the return value is a standard
-Tcl result:  \fBTCL_OK\fR means the expression was successfully
+Tcl result: \fBTCL_OK\fR means the expression was successfully
 evaluated, and \fBTCL_ERROR\fR means that an error occurred while
-evaluating the expression.  If \fBTCL_ERROR\fR is returned then
+evaluating the expression.
+If \fBTCL_ERROR\fR is returned then
 \fIinterp->result\fR will hold a message describing the error.
 If an error occurs while executing a Tcl command embedded in
 the expression then that error will be returned.
@@ -83,24 +92,23 @@ an error is returned.
 .PP
 \fBTcl_ExprBoolean\fR stores a 0/1 integer value at \fI*booleanPtr\fR.
 If the expression's actual value is an integer or floating-point
-number, then \fBTcl_ExprBoolean\fR stores 0 at \fI*booleanPtr\fR if
+number, then they store 0 at \fI*booleanPtr\fR if
 the value was zero and 1 otherwise.
-.VS
 If the expression's actual value is a non-numeric string then
-it must be one of the values accepted by \fBTcl_GetBoolean\fR,
+it must be one of the values accepted by \fBTcl_GetBoolean\fR
 such as ``yes'' or ``no'', or else an error occurs.
-.VE
 .PP
 \fBTcl_ExprString\fR returns the value of the expression as a
 string stored in \fIinterp->result\fR.
-.VS
 If the expression's actual value is an integer
 then \fBTcl_ExprString\fR converts it to a string using \fBsprintf\fR
 with a ``%d'' converter.
 If the expression's actual value is a floating-point
 number, then \fBTcl_ExprString\fR calls \fBTcl_PrintDouble\fR
 to convert it to a string.
-.VE
+
+.SH "SEE ALSO"
+Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj
 
 .SH KEYWORDS
-boolean, double, evaluate, expression, integer, string
+boolean, double, evaluate, expression, integer, object, string
diff --git a/contrib/tcl/doc/ExprLongObj.3 b/contrib/tcl/doc/ExprLongObj.3
new file mode 100644
index 0000000..569dc93
--- /dev/null
+++ b/contrib/tcl/doc/ExprLongObj.3
@@ -0,0 +1,104 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) ExprLongObj.3 1.6 97/06/26 13:41:12
+'\" 
+.so man.macros
+.TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj \- evaluate an expression
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ExprLongObj\fR(\fIinterp, objPtr, longPtr\fR)
+.sp
+int
+\fBTcl_ExprDoubleObj\fR(\fIinterp, objPtr, doublePtr\fR)
+.sp
+int
+\fBTcl_ExprBooleanObj\fR(\fIinterp, objPtr, booleanPtr\fR)
+.sp
+int
+\fBTcl_ExprObj\fR(\fIinterp, objPtr, resultPtrPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *resultPtrPtr out
+.AP Tcl_Interp *interp in
+Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR.
+.AP Tcl_Obj *objPtr in
+Pointer to an object containing the expression to evaluate.
+.AP long *longPtr out
+Pointer to location in which to store the integer value of the
+expression.
+.AP int *doublePtr out
+Pointer to location in which to store the floating-point value of the
+expression.
+.AP int *booleanPtr out
+Pointer to location in which to store the 0/1 boolean value of the
+expression.
+.AP Tcl_Obj *resultPtrPtr out
+Pointer to location in which to store a pointer to the object
+that is the result of the expression.
+.BE
+
+.SH DESCRIPTION
+.PP
+These four procedures all evaluate an expression, returning
+the result in one of four different forms.
+The expression is given by the \fIobjPtr\fR argument, and it
+can have any of the forms accepted by the \fBexpr\fR command.
+.PP
+The \fIinterp\fR argument refers to an interpreter used to
+evaluate the expression (e.g. for variables and nested Tcl
+commands) and to return error information.
+.PP
+For all of these procedures the return value is a standard
+Tcl result: \fBTCL_OK\fR means the expression was successfully
+evaluated, and \fBTCL_ERROR\fR means that an error occurred while
+evaluating the expression.
+If \fBTCL_ERROR\fR is returned,
+then a message describing the error
+can be retrieved using \fBTcl_GetObjResult\fR.
+If an error occurs while executing a Tcl command embedded in
+the expression then that error will be returned.
+.PP
+If the expression is successfully evaluated, then its value is
+returned in one of four forms, depending on which procedure
+is invoked.
+\fBTcl_ExprLongObj\fR stores an integer value at \fI*longPtr\fR.
+If the expression's actual value is a floating-point number,
+then it is truncated to an integer.
+If the expression's actual value is a non-numeric string then
+an error is returned.
+.PP
+\fBTcl_ExprDoubleObj\fR stores a floating-point value at \fI*doublePtr\fR.
+If the expression's actual value is an integer, it is converted to
+floating-point.
+If the expression's actual value is a non-numeric string then
+an error is returned.
+.PP
+\fBTcl_ExprBooleanObj\fR stores a 0/1 integer value at \fI*booleanPtr\fR.
+If the expression's actual value is an integer or floating-point
+number, then they store 0 at \fI*booleanPtr\fR if
+the value was zero and 1 otherwise.
+If the expression's actual value is a non-numeric string then
+it must be one of the values accepted by \fBTcl_GetBoolean\fR
+such as ``yes'' or ``no'', or else an error occurs.
+.PP
+If \fBTcl_ExprObj\fR successfully evaluates the expression,
+it stores a pointer to the Tcl object
+containing the expression's value at \fI*resultPtrPtr\fR.
+In this case, the caller is responsible for calling
+\fBTcl_DecrRefCount\fR to decrement the object's reference count
+when it is finished with the object.
+
+.SH "SEE ALSO"
+Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString, Tcl_GetObjResult
+
+.SH KEYWORDS
+boolean, double, evaluate, expression, integer, object, string
diff --git a/contrib/tcl/doc/GetIndex.3 b/contrib/tcl/doc/GetIndex.3
new file mode 100644
index 0000000..6678257
--- /dev/null
+++ b/contrib/tcl/doc/GetIndex.3
@@ -0,0 +1,74 @@
+'\"
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) GetIndex.3 1.2 97/02/11 13:25:45
+'\" 
+.so man.macros
+.TH Tcl_GetIndexFromObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetIndexFromObj \- lookup string in table of keywords
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_GetIndexFromObj\fR(\fIinterp, objPtr, tablePtr, msg, flags, indexPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp **tablePtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting; if NULL, then no message is
+provided on errors.
+.AP Tcl_Obj *objPtr in/out
+The string value of this object is used to search through \fItablePtr\fR.
+The internal representation is modified to hold the index of the matching
+table entry.
+.AP char **tablePtr in
+An array of null-terminated strings.  The end of the array is marked
+by a NULL string pointer.
+.AP char *msg in
+Null-terminated string describing what is being looked up, such as
+\fBoption\fR.  This string is included in error messages.
+.AP int flags in
+OR-ed combination of bits providing additional information for
+operation.  The only bit that is currently defined is \fBTCL_EXACT\fR.
+.AP int *indexPtr out
+The index of the string in \fItablePtr\fR that matches the value of
+\fIobjPtr\fR is returned here.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure provides an efficient way for looking up keywords,
+switch names, option names, and similar things where the value of
+an object must be one of a predefined set of values.
+\fIObjPtr\fR is compared against each of
+the strings in \fItablePtr\fR to find a match.  A match occurs if
+\fIobjPtr\fR's string value is identical to one of the strings in
+\fItablePtr\fR, or if it is a unique abbreviation
+for exactly one of the strings in \fItablePtr\fR and the
+\fBTCL_EXACT\fR flag was not specified; in either case
+the index of the matching entry is stored at \fI*indexPtr\fR
+and TCL_OK is returned.
+.PP
+If there is no matching entry,
+TCL_ERROR is returned and an error message is left in \fIinterp\fR's
+result if \fIinterp\fR isn't NULL.  \fIMsg\fR is included in the
+error message to indicate what was being looked up.  For example,
+if \fImsg\fR is \fBoption\fR the error message will have a form like
+\fBbad option "firt": must be first, second, or third\fR.
+.PP
+If \fBTcl_GetIndexFromObj\fR completes successfully it modifies the
+internal representation of \fIobjPtr\fR to hold the address of
+the table and the index of the matching entry.  If \fBTcl_GetIndexFromObj\fR
+is invoked again with the same \fIobjPtr\fR and \fItablePtr\fR
+arguments (e.g. during a reinvocation of a Tcl command), it returns
+the matching index immediately without having to redo the lookup
+operation.  Note: \fBTcl_GetIndexFromObj\fR assumes that the entries
+in \fItablePtr\fR are static: they must not change between invocations.
+
+.SH KEYWORDS
+index, object, table lookup
diff --git a/contrib/tcl/doc/GetOpnFl.3 b/contrib/tcl/doc/GetOpnFl.3
index 8f37d11..decb9a4 100644
--- a/contrib/tcl/doc/GetOpnFl.3
+++ b/contrib/tcl/doc/GetOpnFl.3
@@ -1,15 +1,15 @@
 '\"
-'\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) GetOpnFl.3 1.2 96/03/26 13:40:26
+'\" SCCS: @(#) GetOpnFl.3 1.3 97/04/23 16:14:43
 .so man.macros
-.TH Tcl_GetOpenFile 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_GetOpenFile \- Get a standard IO File * handle from a channel.
+Tcl_GetOpenFile \- Get a standard IO File * handle from a channel. (Unix only)
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -52,6 +52,10 @@ for the access specified by \fIwrite\fR) then TCL_ERROR is returned
 and \fIinterp->result\fR will contain an error message.
 In the current implementation \fIcheckUsage\fR is ignored and consistency
 checks are always performed.
+.VS
+.PP
+Note that this interface is only supported on the Unix platform.
+.VE
 
 .SH KEYWORDS
 channel, file handle, permissions, pipeline, read, write
diff --git a/contrib/tcl/doc/IntObj.3 b/contrib/tcl/doc/IntObj.3
new file mode 100644
index 0000000..a87ac92
--- /dev/null
+++ b/contrib/tcl/doc/IntObj.3
@@ -0,0 +1,104 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) IntObj.3 1.7 97/05/08 19:49:22
+'\" 
+.so man.macros
+.TH Tcl_IntObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_NewIntObj, Tcl_NewLongObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj \- manipulate Tcl objects as integers
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewIntObj\fR(\fIintValue\fR)
+.sp
+Tcl_Obj *
+\fBTcl_NewLongObj\fR(\fIlongValue\fR)
+.sp
+\fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR)
+.sp
+\fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR)
+.sp
+int
+\fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR)
+.sp
+int
+\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP int intValue in
+Integer value used to initialize or set an integer object.
+.AP long longValue in
+Long integer value used to initialize or set an integer object.
+.AP Tcl_Obj *objPtr in/out
+For \fBTcl_SetIntObj\fR and \fBTcl_SetLongObj\fR,
+this points to the object to be converted to integer type.
+For \fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\fR,
+this refers to the object
+from which to get an integer or long integer value; 
+if \fIobjPtr\fR does not already point to an integer object,
+an attempt will be made to convert it to one.
+.AP Tcl_Interp *interp in/out
+If an error occurs during conversion,
+an error message is left in the interpreter's result object
+unless \fIinterp\fR is NULL.
+.AP int *intPtr out
+Points to place to store the integer value
+obtained by \fBTcl_GetIntFromObj\fR from \fIobjPtr\fR.
+.AP long *longPtr out
+Points to place to store the long integer value
+obtained by \fBTcl_GetLongFromObj\fR from \fIobjPtr\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are used to create, modify, and read
+integer Tcl objects from C code.
+\fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR,
+\fBTcl_SetIntObj\fR, and \fBTcl_SetLongObj\fR
+create a new object of integer type
+or modify an existing object to have integer type. 
+\fBTcl_NewIntObj\fR and \fBTcl_SetIntObj\fR set the object to have the
+integer value given by \fIintValue\fR,
+while \fBTcl_NewLongObj\fR and \fBTcl_SetLongObj\fR
+set the object to have the
+long integer value given by \fIlongValue\fR.
+\fBTcl_NewIntObj\fR and \fBTcl_NewLongObj\fR
+return a pointer to a newly created object with reference count zero.
+These procedures set the object's type to be integer
+and assign the integer value to the object's internal representation
+\fIlongValue\fR member.
+\fBTcl_SetIntObj\fR and \fBTcl_SetLongObj\fR
+invalidate any old string representation and,
+if the object is not already an integer object,
+free any old internal representation.
+.PP
+\fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\fR
+attempt to return an integer value from the Tcl object \fIobjPtr\fR.
+If the object is not already an integer object,
+they will attempt to convert it to one.
+If an error occurs during conversion, they return \fBTCL_ERROR\fR
+and leave an error message in the interpreter's result object
+unless \fIinterp\fR is NULL.
+Also, if the long integer held in the object's internal representation
+\fIlongValue\fR member can not be represented in a (non-long) integer,
+\fBTcl_GetIntFromObj\fR returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+unless \fIinterp\fR is NULL.
+Otherwise, both procedures return \fBTCL_OK\fR and
+store the integer or the long integer value
+in the address given by \fIintPtr\fR and \fIlongPtr\fR respectively.
+If the object is not already an integer object,
+the conversion will free any old internal representation.
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
+
+.SH KEYWORDS
+integer, integer object, integer type, internal representation, object, object type, string representation
diff --git a/contrib/tcl/doc/LinkVar.3 b/contrib/tcl/doc/LinkVar.3
index 1926460..a7a5355 100644
--- a/contrib/tcl/doc/LinkVar.3
+++ b/contrib/tcl/doc/LinkVar.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) LinkVar.3 1.13 96/06/05 18:00:14
+'\" SCCS: @(#) LinkVar.3 1.15 96/09/05 17:16:57
 '\" 
 .so man.macros
 .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
@@ -21,16 +21,15 @@ int
 .sp
 \fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
 .sp
-.VS
 \fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
-.VE
 .SH ARGUMENTS
 .AS Tcl_Interp writable
 .AP Tcl_Interp *interp in
 Interpreter that contains \fIvarName\fR.
 Also used by \fBTcl_LinkVar\fR to return error messages.
 .AP char *varName in
-Name of global variable.
+Name of global variable.  Must be in writable memory: Tcl may make
+temporary modifications to it while parsing the variable name.
 .AP char *addr in
 Address of C variable that is to be linked to \fIvarName\fR.
 .AP int type in
@@ -102,7 +101,6 @@ Attempts to write the variable from Tcl will be rejected with errors.
 variable given by \fIvarName\fR.  If there does not exist a link
 for \fIvarName\fR then the procedure has no effect.
 .PP
-.VS
 \fBTcl_UpdateLinkedVar\fR may be invoked after the C variable has
 changed to force the Tcl variable to be updated immediately.
 In many cases this procedure is not needed, since any attempt to
@@ -112,7 +110,6 @@ Tk widget that wishes to display the value of the variable), the
 trace will not trigger when the C variable has changed.
 \fBTcl_UpdateLinkedVar\fR ensures that any traces on the Tcl
 variable are invoked.
-.VE
 
 .SH KEYWORDS
 boolean, integer, link, read-only, real, string, traces, variable
diff --git a/contrib/tcl/doc/ListObj.3 b/contrib/tcl/doc/ListObj.3
new file mode 100644
index 0000000..1e30429
--- /dev/null
+++ b/contrib/tcl/doc/ListObj.3
@@ -0,0 +1,249 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) ListObj.3 1.9 97/06/03 13:51:42
+'\" 
+.so man.macros
+.TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl objects as lists
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ListObjAppendList\fR(\fIinterp, listPtr, elemListPtr\fR)
+.sp
+int
+\fBTcl_ListObjAppendElement\fR(\fIinterp, listPtr, objPtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_NewListObj\fR(\fIobjc, objv\fR)
+.sp
+\fBTcl_SetListObj\fR(\fIobjPtr, objc, objv\fR)
+.sp
+int
+\fBTcl_ListObjGetElements\fR(\fIinterp, listPtr, objcPtr, objvPtr\fR)
+.sp
+int
+\fBTcl_ListObjLength\fR(\fIinterp, listPtr, intPtr\fR)
+.sp
+int
+\fBTcl_ListObjIndex\fR(\fIinterp, listPtr, index, objPtrPtr\fR)
+.sp
+int
+\fBTcl_ListObjReplace\fR(\fIinterp, listPtr, first, count, objc, objv\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp "*CONST objv[]" out
+.AP Tcl_Interp *interp in
+If an error occurs while converting an object to be a list object,
+an error message is left in the interpreter's result object
+unless \fIinterp\fR is NULL.
+.AP Tcl_Obj *listPtr in/out
+Points to the list object to be manipulated.
+If \fIlistPtr\fR does not already point to a list object,
+an attempt will be made to convert it to one.
+.AP Tcl_Obj *elemListPtr in/out
+For \fBTcl_ListObjAppendList\fR, this points to a list object
+containing elements to be appended onto \fIlistPtr\fR.
+Each element of *\fIelemListPtr\fR will
+become a new element of \fIlistPtr\fR.
+If *\fIelemListPtr\fR is not NULL and
+does not already point to a list object,
+an attempt will be made to convert it to one.
+.AP Tcl_Obj *objPtr in
+For \fBTcl_ListObjAppendElement\fR,
+points to the Tcl object that will be appended to \fIlistPtr\fR.
+For \fBTcl_SetListObj\fR,
+this points to the Tcl object that will be converted to a list object
+containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR.
+.AP int *objcPtr in
+Points to location where \fBTcl_ListObjGetElements\fR
+stores the number of element objects in \fIlistPtr\fR.
+.AP Tcl_Obj ***objvPtr out
+A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
+of pointers to the element objects of \fIlistPtr\fR.  
+.AP int objc in
+The number of Tcl objects that \fBTcl_NewListObj\fR
+will insert into a new list object,
+and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
+For \fBTcl_SetListObj\fR,
+the number of Tcl objects to insert into \fIobjPtr\fR.
+.VS
+.TP 
+Tcl_Obj	*CONST \fIobjv\fR[]	(in)
+.
+An array of pointers to objects.
+\fBTcl_NewListObj\fR will insert these objects into a new list object
+and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
+Each object will become a separate list element.  
+.VE
+.AP int *intPtr out
+Points to location where \fBTcl_ListObjLength\fR
+stores the length of the list.
+.AP int index in
+Index of the list element that \fBTcl_ListObjIndex\fR
+is to return.
+The first element has index 0.
+.AP Tcl_Obj **objPtrPtr out
+Points to place where \fBTcl_ListObjIndex\fR is to store
+a pointer to the resulting list element object.
+.AP int first in
+Index of the starting list element that \fBTcl_ListObjReplace\fR
+is to replace.
+The list's first element has index 0.
+.AP int last in
+Index of the final list element that \fBTcl_ListObjReplace\fR
+is to replace.
+.BE
+
+.SH DESCRIPTION
+.PP
+Tcl list objects have an internal representation that supports
+the efficient indexing and appending.
+The procedures described in this man page are used to
+create, modify, index, and append to Tcl list objects from C code.
+.PP
+\fBTcl_ListObjAppendList\fR and \fBTcl_ListObjAppendElement\fR
+both add one or more objects
+to the end of the list object referenced by \fIlistPtr\fR.
+\fBTcl_ListObjAppendList\fR appends each element of the list object
+referenced by \fIelemListPtr\fR while
+\fBTcl_ListObjAppendElement\fR appends the single object
+referenced by \fIobjPtr\fR.
+Both procedures will convert the object referenced by \fIlistPtr\fR
+to a list object if necessary.
+If an error occurs during conversion,
+both procedures return \fBTCL_ERROR\fR and leave an error message
+in the interpreter's result object if \fIinterp\fR is not NULL.
+Similarly, if \fIelemListPtr\fR does not already refer to a list object,
+\fBTcl_ListObjAppendList\fR will attempt to convert it to one
+and if an error occurs during conversion,
+will return \fBTCL_ERROR\fR
+and leave an error message in the interpreter's result object
+if interp is not NULL.
+Both procedures invalidate any old string representation of \fIlistPtr\fR
+and, if it was converted to a list object,
+free any old internal representation.
+Similarly, \fBTcl_ListObjAppendList\fR frees any old internal representation
+of \fIelemListPtr\fR if it converts it to a list object.
+After appending each element in \fIelemListPtr\fR,
+\fBTcl_ListObjAppendList\fR increments the element's reference count
+since \fIlistPtr\fR now also refers to it.
+For the same reason, \fBTcl_ListObjAppendElement\fR
+increments \fIobjPtr\fR's reference count.
+If no error occurs,
+the two procedures return \fBTCL_OK\fR after appending the objects.
+.PP
+\fBTcl_NewListObj\fR and \fBTcl_SetListObj\fR
+create a new object or modify an existing object to hold 
+the \fIobjc\fR elements of the array referenced by \fIobjv\fR
+where each element is a pointer to a Tcl object.
+If \fIobjc\fR is less than or equal to zero,
+they return an empty object.
+The new object's string representation is left invalid.
+The two procedures increment the reference counts
+of the elements in \fIobjc\fR since the list object now refers to them.
+The new list object returned by \fBTcl_NewListObj\fR
+has reference count zero.
+.PP
+\fBTcl_ListObjGetElements\fR returns a count and
+a pointer to an array of the elements in a list object.
+It returns the count by storing it in the address \fIobjcPtr\fR.
+Similarly, it returns the array pointer by storing it
+in the address \fIobjvPtr\fR.
+If \fIlistPtr\fR is not already a list object,
+\fBTcl_ListObjGetElements\fR will attempt to convert it to one;
+if the conversion fails, it returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+if \fIinterp\fR is not NULL.
+Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer.
+.PP
+\fBTcl_ListObjLength\fR returns the number of elements in the list object
+referenced by \fIlistPtr\fR.
+It returns this count by storing an integer in the address \fIintPtr\fR.
+If the object is not already a list object,
+\fBTcl_ListObjLength\fR will attempt to convert it to one;
+if the conversion fails, it returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+if \fIinterp\fR is not NULL.
+Otherwise it returns \fBTCL_OK\fR after storing the list's length.
+.PP
+The procedure \fBTcl_ListObjIndex\fR returns a pointer to the object
+at element \fIindex\fR in the list referenced by \fIlistPtr\fR.
+It returns this object by storing a pointer to it
+in the address \fIobjPtrPtr\fR.
+If \fIlistPtr\fR does not already refer to a list object,
+\fBTcl_ListObjIndex\fR will attempt to convert it to one;
+if the conversion fails, it returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+if \fIinterp\fR is not NULL.
+If the index is out of range,
+that is, \fIindex\fR is negative or
+greater than or equal to the number of elements in the list,
+\fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR
+and returns \fBTCL_OK\fR.
+Otherwise it returns \fBTCL_OK\fR after storing the element's
+object pointer.
+The reference count for the list element is not incremented;
+the caller must do that if it needs to retain a pointer to the element.
+.PP
+\fBTcl_ListObjReplace\fR replaces zero or more elements
+of the list referenced by \fIlistPtr\fR
+with the \fIobjc\fR objects in the array referenced by \fIobjv\fR.
+If \fIlistPtr\fR does not point to a list object,
+\fBTcl_ListObjReplace\fR will attempt to convert it to one;
+if the conversion fails, it returns \fBTCL_ERROR\fR
+and leaves an error message in the interpreter's result object
+if \fIinterp\fR is not NULL.
+Otherwise, it returns \fBTCL_OK\fR after replacing the objects.
+If \fIobjv\fR is NULL, no new elements are added.
+If the argument \fIfirst\fR is zero or negative,
+it refers to the first element.
+If \fIfirst\fR is greater than or equal to the
+number of elements in the list, then no elements are deleted;
+the new elements are appended to the list.
+\fIcount\fR gives the number of elements to replace.
+If \fIcount\fR is zero or negative then no elements are deleted;
+the new elements are simply inserted before the one
+designated by \fIfirst\fR.
+\fBTcl_ListObjReplace\fR invalidates \fIlistPtr\fR's
+old string representation.
+The reference counts of any elements inserted from \fIobjv\fR
+are incremented since the resulting list now refers to them.
+Similarly, the reference counts for any replaced objects are decremented.
+.PP
+Because \fBTcl_ListObjReplace\fR combines
+both element insertion and deletion,
+it can be used to implement a number of list operations.
+For example, the following code inserts the \fIobjc\fR objects
+referenced by the array of object pointers \fIobjv\fR
+just before the element \fIindex\fR of the list referenced by \fIlistPtr\fR:
+.CS
+result = Tcl_ListObjReplace(interp, listPtr, index, 0, objc, objv);
+.CE
+Similarly, the following code appends the \fIobjc\fR objects
+referenced by the array \fIobjv\fR
+to the end of the list \fIlistPtr\fR:
+.CS
+result = Tcl_ListObjLength(interp, listPtr, &length);
+if (result == TCL_OK) {
+	result = Tcl_ListObjReplace(interp, listPtr, length, 0, objc, objv);
+}
+.CE
+The \fIcount\fR list elements starting at \fIfirst\fR can be deleted
+by simply calling \fBTcl_ListObjReplace\fR
+with a NULL \fIobjvPtr\fR:
+.CS
+result = Tcl_ListObjReplace(interp, listPtr, first, count, 0, NULL);
+.CE
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
+
+.SH KEYWORDS
+append, index, insert, internal representation, length, list, list object, list type, object, object type, replace, string representation
diff --git a/contrib/tcl/doc/Notifier.3 b/contrib/tcl/doc/Notifier.3
index 0d3ff93..5016200 100644
--- a/contrib/tcl/doc/Notifier.3
+++ b/contrib/tcl/doc/Notifier.3
@@ -1,50 +1,63 @@
 '\"
-'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Notifier.3 1.11 96/06/05 18:00:17
+'\" SCCS: @(#) Notifier.3 1.16 97/05/17 17:03:17
 '\" 
 .so man.macros
-.TH Tcl_CreateEventSource 3 7.5 Tcl "Tcl Library Procedures"
+.TH Notifier 3 8.0 Tcl "Tcl Library Procedures"
 .BS
+.VS
 .SH NAME
-Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_WatchFile, Tcl_FileReady, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_WaitForEvent \- Event sources, the event notifier, and the event queue
+Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_DeleteEvents, Tcl_WaitForEvent, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces
+
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
-\fBTcl_CreateEventSource(\fIsetupProc, checkProc, clientData\fB)\fR
+\fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+.sp
+\fBTcl_DeleteEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+.sp
+\fBTcl_SetMaxBlockTime\fR(\fItimePtr\fB)\fR
 .sp
-\fBTcl_DeleteEventSource(\fIsetupProc, checkProc, clientData\fB)\fR
+\fBTcl_QueueEvent\fR(\fIevPtr, position\fR)
+.VS
+.sp
+\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
 .sp
-\fBTcl_WatchFile(\fIfile, mask\fB)\fR
+int
+\fBTcl_WaitForEvent\fR(\fItimePtr\fR)
 .sp
-\fBTcl_SetMaxBlockTime(\fItimePtr\fB)\fR
+\fBTcl_SetTimer\fR(\fItimePtr\fR)
 .sp
 int
-\fBTcl_FileReady(\fIfile, mask\fB)\fR
+\fBTcl_ServiceAll\fR()
 .sp
-\fBTcl_QueueEvent(\fIevPtr, position\fB)\fR
+int
+\fBTcl_ServiceEvent\fR(\fIflags\fR)
 .sp
 int
-\fBTcl_WaitForEvent(\fItimePtr\fB)\fR
+\fBTcl_GetServiceMode\fR()
+.sp
+int		
+\fBTcl_SetServiceMode\fR(\fImode\fR)
+.VE
+
 .SH ARGUMENTS
+.AS Tcl_EventDeleteProc milliseconds
 .AS Tcl_EventSetupProc *setupProc
 .AP Tcl_EventSetupProc *setupProc in
-Procedure to invoke to prepare for event wait in \fBTcl_DoWhenIdle\fR.
+Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
 .AP Tcl_EventCheckProc *checkProc in
-Procedure for \fBTcl_DoWhenIdle\fR to invoke after waiting for
+Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for
 events.  Checks to see if any events have occurred and, if so,
 queues them.
 .AP ClientData clientData in
-Arbitrary one-word value to pass to \fIsetupProc\fR and \fIcheckProc\fR.
-.AP Tcl_File file in
-Generic file handle as returned by \fBTcl_GetFile\fR.
-.AP int mask in
-Indicates the events of interest on \fIfile\fR:  an OR'ed combination
-of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR, and \fBTCL_EXCEPTION\fR.
+Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
+\fIdeleteProc\fR.
 .AP Tcl_Time *timePtr in
 Indicates the maximum amount of time to wait for an event.  This
 is specified as an interval (how long to wait), not an absolute
@@ -53,59 +66,104 @@ is NULL, it means there is no maximum wait time:  wait forever if
 necessary.
 .AP Tcl_Event *evPtr in
 An event to add to the event queue.  The storage for the event must
-.VS
 have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
-.VE
 .AP Tcl_QueuePosition position in
 Where to add the new event in the queue:  \fBTCL_QUEUE_TAIL\fR,
 \fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR.
 .AP int flags in
-A copy of the \fIflags\fR argument passed to \fBTcl_DoOneEvent\fR.
+What types of events to service.  These flags are the same as those
+passed to \fBTcl_DoOneEvent\fR.
+.AP Tcl_EventDeleteProc *deleteProc in
+Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
+.VS
+.AP int mode in
+Inidicates whether events should be serviced by \fBTcl_ServiceAll\fR.
+Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
+.VE
 .BE
 
 .SH INTRODUCTION
 .PP
-The procedures described here are the building blocks out of which
-the Tcl event notifier is constructed.  The event notifier is the
-lowest layer in the Tcl event mechanism.  It consists of three
-things:
+.VS
+The interfaces described here are used to customize the Tcl event
+loop.  The two most common customizations are to add new sources of
+events and to merge Tcl's event loop with some other event loop, such
+as one provided by an application in which Tcl is embedded.  Each of
+these tasks is described in a separate section below.
+.VE
+.PP
+The procedures in this manual entry are the building blocks out of which
+the Tcl event notifier is constructed.  The event notifier is the lowest
+layer in the Tcl event mechanism.  It consists of three things:
 .IP [1]
-Event sources:  these represent the ways in which events can be
+Event sources: these represent the ways in which events can be
 generated.  For example, there is a timer event source that implements
-the \fBTcl_CreateTimerHandler\fR procedure and the \fBafter\fR command,
-and there is a file event source that implements the
-\fBTcl_CreateFileHandler\fR procedure.  An event source must work
-with the notifier to detect events at the right times, record them
-on the event queue, and eventually notify higher-level software that
-they have occurred.
+the \fBTcl_CreateTimerHandler\fR procedure and the \fBafter\fR
+command, and there is a file event source that implements the
+\fBTcl_CreateFileHandler\fR procedure on Unix systems.  An event
+source must work with the notifier to detect events at the right
+times, record them on the event queue, and eventually notify
+higher-level software that they have occurred.  The procedures
+\fBTcl_CreateEventSource\fR, \fBTcl_DeleteEventSource\fR,
+and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and
+\fBTcl_DeleteEvents\fR are used primarily by event sources.
 .IP [2]
-The event queue:  there is a single queue for the whole application,
-containing events that have been detected but not yet serviced.
-The event queue guarantees a fair discipline of event handling, so
-that no event source can starve the others.  It also allows events
-to be saved for servicing at a future time.
+The event queue: there is a single queue for the whole application,
+containing events that have been detected but not yet serviced.  Event
+sources place events onto the queue so that they may be processed in
+order at appropriate times during the event loop. The event queue
+guarantees a fair discipline of event handling, so that no event
+source can starve the others.  It also allows events to be saved for
+servicing at a future time.
+.VS
+\fBTcl_QueueEvent\fR is used (primarily
+by event sources) to add events to the event queue and 
+\fBTcl_DeleteEvents\fR is used to remove events from the queue without
+processing them.
 .IP [3]
-The procedure \fBTcl_DoOneEvent\fR:  this is procedure that is invoked
-by the application to service events.  It works with the event sources
-and the event queue to detect and handle events, and calls
-\fBTcl_WaitForEvent\fR to actually wait for an event to occur.
+The event loop: in order to detect and process events, the application
+enters a loop that waits for events to occur, places them on the event
+queue, and then processes them.  Most applications will do this by
+calling the procedure \fBTcl_DoOneEvent\fR, which is described in a
+separate manual entry.
+.PP
+Most Tcl applications need not worry about any of the internals of
+the Tcl notifier.  However, the notifier now has enough flexibility
+to be retargeted either for a new platform or to use an external event
+loop (such as the Motif event loop, when Tcl is embedded in a Motif
+application).  The procedures \fBTcl_WaitForEvent\fR and
+\fBTcl_SetTimer\fR are normally implemented by Tcl, but may be
+replaced with new versions to retarget the notifier (the \fBTcl_Sleep\fR,
+\fBTcl_CreateFileHandler\fR, and \fBTcl_DeleteFileHandler\fR must
+also be replaced; see CREATING A NEW NOTIFIER below for details).
+The procedures \fBTcl_ServiceAll\fR, \fBTcl_ServiceEvent\fR,
+\fBTcl_GetServiceMode\fR, and \fBTcl_SetServiceMode\fR are provided
+to help connect Tcl's event loop to an external event loop such as
+Motif's.
+.SH "NOTIFIER BASICS"
+.VE
 .PP
 The easiest way to understand how the notifier works is to consider
 what happens when \fBTcl_DoOneEvent\fR is called.
-\fBTcl_DoOneEvent\fR is passed a \fIflags\fR
-argument that indicates what sort of events it is OK to process and
-also whether or not to block if no events are ready.
-\fBTcl_DoOneEvent\fR does the following things:
+\fBTcl_DoOneEvent\fR is passed a \fIflags\fR argument that indicates
+what sort of events it is OK to process and also whether or not to
+block if no events are ready.  \fBTcl_DoOneEvent\fR does the following
+things:
 .IP [1]
 Check the event queue to see if it contains any events that can
 be serviced.  If so, service the first possible event, remove it
-from the queue, and return.
+.VS
+from the queue, and return.  It does this by calling
+\fBTcl_ServiceEvent\fR and passing in the \fIflags\fR argument.
+.VE
 .IP [2]
 Prepare to block for an event.  To do this, \fBTcl_DoOneEvent\fR
 invokes a \fIsetup procedure\fR in each event source.
-The event source will call procedures like \fBTcl_WatchFile\fR and
-\fBTcl_SetMaxBlockTime\fR to indicate what low-level events to look
-for in \fBTcl_WaitForEvent\fR.
+The event source will perform event-source specific initialization and
+.VS
+possibly call \fBTcl_SetMaxBlockTime\fR to limit how long
+.VE
+\fBTcl_WaitForEvent\fR will block if no new events occur.
 .IP [3]
 Call \fBTcl_WaitForEvent\fR.  This procedure is implemented differently
 on different platforms;  it waits for an event to occur, based on the
@@ -120,26 +178,17 @@ and \fBTcl_DoOneEvent\fR returns 0.
 .IP [4]
 Call a \fIcheck procedure\fR in each event source.  The check
 procedure determines whether any events of interest to this source
-occurred (e.g. by calling \fBTcl_FileReady\fR).  If so,
-the events are added to the event queue.
+occurred.  If so, the events are added to the event queue.
 .IP [5]
 Check the event queue to see if it contains any events that can
 be serviced.  If so, service the first possible event, remove it
 from the queue, and return.
 .IP [6]
-See if there are idle callbacks pending.
-If so, invoke all of them and return.
+See if there are idle callbacks pending. If so, invoke all of them and
+return.
 .IP [7]
 Either return 0 to indicate that no events were ready, or go back to
 step [2] if blocking was requested by the caller.
-.PP
-The procedures in this file allow you to do two things.  First, they
-allow you to create new event sources, such as one for UNIX signals
-or one to notify when subprocesses have exited.  Second, the procedures
-can be used to build a new version of \fBTcl_DoOneEvent\fR.  This
-might be necessary to support a new operating system with different
-low-level event reporting mechanisms, or it might be necessary to
-merge Tcl's event loop with that of some other toolkit like Xt.
 
 .SH "CREATING A NEW EVENT SOURCE"
 .PP
@@ -164,38 +213,34 @@ argument to \fBTcl_CreateEventSource\fR;  it is typically used to
 point to private information managed by the event source.
 The \fIflags\fR argument will be the same as the \fIflags\fR
 argument passed to \fBTcl_DoOneEvent\fR except that it will never
-by 0 (\fBTcl_DoOneEvent\fR replaces 0 with \fBTCL_ALL_EVENTS\fR).
+be 0 (\fBTcl_DoOneEvent\fR replaces 0 with \fBTCL_ALL_EVENTS\fR).
 \fIFlags\fR indicates what kinds of events should be considered;
 if the bit corresponding to this event source isn't set, the event
 source should return immediately without doing anything.  For
 example, the file event source checks for the \fBTCL_FILE_EVENTS\fR
 bit.
 .PP
-\fISetupProc\fR's job is to provide information to
-\fBTcl_WaitForEvent\fR about how to wait for events.
-It usually does this by calling \fBTcl_WatchFile\fR or
-\fBTcl_SetMaxBlockTime\fR.
-For example, \fIsetupProc\fR can call \fBTcl_WatchFile\fR to indicate
-that \fBTcl_WaitForEvent\fR should return when the conditions
-given by the \fImask\fR argument become true for the file given
-by \fIfile\fR.
-The UNIX version of \fBTcl_WaitForEvent\fR uses the
-information passed to \fBTcl_WatchFile\fR to set the file masks
-for \fBselect\fR, which it uses to wait for events.
-If \fBTcl_WatchFile\fR isn't called by any event sources then
-\fBTcl_WaitForEvent\fR will ignore files while waiting.
-.PP
-\fISetupProc\fR can also invoke \fBTcl_SetMaxBlockTime\fR to set an
-upper bound on how long \fBTcl_WaitForEvent\fR will block.
-If no event source calls \fBTcl_SetMaxBlockTime\fR then
-\fBTcl_WaitForEvent\fR will wait as long as necessary for an event
-to occur;  otherwise, it will only wait as long as the shortest
+\fISetupProc\fR's job is to make sure that the application wakes up
+when events of the desired type occur.  This is typically done in a
+platform-dependent fashion.  For example, under Unix an event source
+might call \fBTcl_CreateFileHandler\fR; under Windows it might
+request notification with a Windows event.  For timer-driven event
+sources such as timer events or any polled event, the event source
+can call \fBTcl_SetMaxBlockTime\fR to force the application to wake
+up after a specified time even if no events have occurred.
+.VS
+If no event source calls \fBTcl_SetMaxBlockTime\fR
+then \fBTcl_WaitForEvent\fR will wait as long as necessary for an
+event to occur; otherwise, it will only wait as long as the shortest
 interval passed to \fBTcl_SetMaxBlockTime\fR by one of the event
-sources.
-For example, the timer event source uses this procedure to limit the
-wait time to the interval before the next timer event is ready.
-If an event source knows that it already has events ready to report,
-it can request a zero maximum block time.
+sources.  If an event source knows that it already has events ready to
+report, it can request a zero maximum block time.  For example, the
+setup procedure for the X event source looks to see if there are
+events already queued.  If there are, it calls
+\fBTcl_SetMaxBlockTime\fR with a 0 block time so that
+\fBTcl_WaitForEvent\fR does not block if there is no new data on the X
+connection.
+.VE
 The \fItimePtr\fR argument to \fBTcl_WaitForEvent\fR points to
 a structure that describes a time interval in seconds and
 microseconds:
@@ -207,17 +252,32 @@ typedef struct Tcl_Time {
 .CE
 The \fIusec\fR field should be less than 1000000.
 .PP
-Information provided to \fBTcl_WatchFile\fR and \fBTcl_SetMaxBlockTime\fR
+.VS
+Information provided to \fBTcl_SetMaxBlockTime\fR
 is only used for the next call to \fBTcl_WaitForEvent\fR; it is
 discarded after \fBTcl_WaitForEvent\fR returns.
+.VE
 The next time an event wait is done each of the event sources'
 setup procedures will be called again, and they can specify new
 information for that event wait.
 .PP
-In addition to the generic procedures \fBTcl_WatchFile\fR and
-\fBTcl_SetMaxBlockTime\fR, other platform-specific procedures may
-also be available for \fIsetupProc\fR, if there is additional
-information needed by \fBTcl_WaitForEvent\fR on that platform.
+.VS
+If the application uses an external event loop rather than
+\fBTcl_DoOneEvent\fR, the event sources may need to call
+\fBTcl_SetMaxBlockTime\fR at other times.  For example, if a new event
+handler is registered that needs to poll for events, the event source
+may call \fBTcl_SetMaxBlockTime\fR to set the block time to zero to
+force the external event loop to call Tcl.  In this case,
+\fBTcl_SetMaxBlockTime\fR invokes \fBTcl_SetTimer\fR with the shortest
+interval seen since the last call to \fBTcl_DoOneEvent\fR or
+\fBTcl_ServiceAll\fR.
+.PP
+In addition to the generic procedure \fBTcl_SetMaxBlockTime\fR, other
+platform-specific procedures may also be available for
+\fIsetupProc\fR, if there is additional information needed by
+\fBTcl_WaitForEvent\fR on that platform.  For example, on Unix systems
+the \fBTcl_CreateFileHandler\fR interface can be used to wait for file events.
+.VE
 .PP
 The second procedure provided by each event source is its check
 procedure, indicated by the \fIcheckProc\fR argument to
@@ -234,28 +294,18 @@ for events.  Presumably at least one event source is now prepared to
 queue an event.  \fBTcl_DoOneEvent\fR calls each of the event sources
 in turn, so they all have a chance to queue any events that are ready.
 The check procedure does two things.  First, it must see if any events
-have triggered.  Different event sources do this in different ways,
-but the procedure \fBTcl_FileReady\fR may be useful for some event
-sources.  It takes as arguments a file identifier \fIfile\fR and
-a mask of interesting conditions;  it returns another mask indicating
-which of those conditions were found to be present on the file during
-the most recent call to \fBTcl_WaitForEvent\fR.
-\fBTcl_WaitForEvent\fR only checks a file if \fBTcl_WatchFile\fR was
-called by at least one event source, so it is possible for
-\fBTcl_FileReady\fR to return 0 even if the file is ready.
+have triggered.  Different event sources do this in different ways.
 .PP
-If an event source's check procedure detects that an interesting
-event has occurred, then it must add the event to Tcl's event queue.
-To do this, the event source calls \fBTcl_QueueEvent\fR.
-The \fIevPtr\fR argument is a pointer to a dynamically allocated
-structure containing the event (see below for more information
-on memory management issues).
-Each event source can define its own event structure with
-whatever information is relevant to that event source.
-However, the first element of the structure must be a structure
-of type \fBTcl_Event\fR, and the address of this structure is used when
-communicating between the event source and the rest of the notifier.
-A \fBTcl_Event\fR has the following definition:
+If an event source's check procedure detects an interesting event, it
+must add the event to Tcl's event queue.  To do this, the event source
+calls \fBTcl_QueueEvent\fR.  The \fIevPtr\fR argument is a pointer to
+a dynamically allocated structure containing the event (see below for
+more information on memory management issues).  Each event source can
+define its own event structure with whatever information is relevant
+to that event source.  However, the first element of the structure
+must be a structure of type \fBTcl_Event\fR, and the address of this
+structure is used when communicating between the event source and the
+rest of the notifier.  A \fBTcl_Event\fR has the following definition:
 .CS
 typedef struct Tcl_Event {
     Tcl_EventProc *\fIproc\fR;
@@ -285,8 +335,10 @@ events at the front of the queue, such as a series of
 Enter and Leave events synthesized during a grab or ungrab operation
 in Tk.
 .PP
-When it is time to handle an event from the queue (steps 1 and 5
-above) \fBTcl_DoOneEvent\fR will invoke the \fIproc\fR specified
+.VS
+When it is time to handle an event from the queue (steps 1 and 4
+above) \fBTcl_ServiceEvent\fR will invoke the \fIproc\fR specified
+.VE
 in the first queued \fBTcl_Event\fR structure.
 \fIProc\fR must match the following prototype:
 .CS
@@ -298,7 +350,9 @@ The first argument to \fIproc\fR is a pointer to the event, which will
 be the same as the first argument to the \fBTcl_QueueEvent\fR call that
 added the event to the queue.
 The second argument to \fIproc\fR is the \fIflags\fR argument for the
-current call to \fBTcl_DoOneEvent\fR;  this is used by the event source
+.VS
+current call to \fBTcl_ServiceEvent\fR;  this is used by the event source
+.VE
 to return immediately if its events are not relevant.
 .PP
 It is up to \fIproc\fR to handle the event, typically by invoking
@@ -307,7 +361,9 @@ Once the event source has finished handling the event it returns 1
 to indicate that the event can be removed from the queue.
 If for some reason the event source decides that the event cannot
 be handled at this time, it may return 0 to indicate that the event
-should be deferred for processing later;  in this case \fBTcl_DoOneEvent\fR
+.VS
+should be deferred for processing later;  in this case \fBTcl_ServiceEvent\fR
+.VE
 will go on to the next event in the queue and attempt to service it.
 There are several reasons why an event source might defer an event.
 One possibility is that events of this type are excluded by the
@@ -318,53 +374,164 @@ Another example of deferring events happens in Tk if
 \fBTk_RestrictEvents\fR has been invoked to defer certain kinds
 of window events.
 .PP
-When \fIproc\fR returns 1, \fBTcl_DoOneEvent\fR will remove the
+.VS
+When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the
 event from the event queue and free its storage.
 Note that the storage for an event must be allocated by
-.VS
 the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR)
-.VE
 before calling \fBTcl_QueueEvent\fR, but it
-will be freed by \fBTcl_DoOneEvent\fR, not by the event source.
+will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
+.PP
+\fBTcl_DeleteEvents\fR can be used to explicitly remove one or more
+events from the event queue.  \fBTcl_DeleteEvents\fR calls \fIproc\fR
+for each event in the queue, deleting those for with the procedure
+returns 1.  Events for which the procedure returns 0 are left in the
+queue.  \fIProc\fR should match the following prototype:
+.CS
+typedef int Tcl_EventDeleteProc(
+	Tcl_Event *\fIevPtr\fR,
+	ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR argument will be the same as the \fIclientData\fR
+argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
+private information managed by the event source.  The \fIevPtr\fR will
+point to the next event in the queue.
+.VE
 
 .SH "CREATING A NEW NOTIFIER"
 .PP
-The notifier consists of all the procedures described in this
-manual entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR.
-Most of these procedures are generic, in that they are the
-same for all platforms.  However, four of the procedures are
-platform-dependent:  \fBTcl_WatchFile\fR,
-\fBTcl_FileReady\fR, \fBTcl_WaitForEvent\fR, and \fBTcl_Sleep\fR.
-To support a new platform, you must write new versions of these
+The notifier consists of all the procedures described in this manual
+entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR, which are
+.VS
+available on all platforms, and \fBTcl_CreateFileHandler\fR and
+\fBTcl_DeleteFileHandler\fR, which are Unix-specific.  Most of these
+procedures are generic, in that they are the same for all notifiers.
+However, five of the procedures are notifier-dependent:
+\fBTcl_SetTimer\fR, \fBTcl_Sleep\fR, \fBTcl_WaitForEvent\fR,
+\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR.  To
+support a new platform or to integrate Tcl with an
+application-specific event loop, you must write new versions of these
 procedures.
-\fBTcl_WatchFile\fR and \fBTcl_FileReady\fR have already been
-described previously in this document, and \fBTcl_Sleep\fR
-is described in its own manual entry.
 .PP
-\fBTcl_WaitForEvent\fR is the lowest-level procedure in the
-notifier;  it is responsible for waiting for an ``interesting''
-event to occur or for a given time to elapse.
-Before \fBTcl_WaitForEvent\fR is invoked, each of the event
-sources' setup procedure will have been invoked;  the setup
-procedures will have provided information about what to wait
-for by invoking procedures like \fBTcl_WatchFile\fR.
-The \fItimePtr\fR argument to \fBTcl_WaitForEvent\fR gives
-the maximum time to block for an event, based on calls to
-\fBTcl_SetMaxBlockTime\fR made by setup procedures and
-on other information (such as the \fBTCL_DONT_WAIT\fR bit in \fIflags\fR).
-\fBTcl_WaitForEvent\fR uses information saved by \fBTcl_WatchFile\fR,
-plus the \fItimePtr\fR argument to decide what to wait for
-and how long to block.
-It returns TCL_OK as soon as one of the specified events has occurred
-or the given amount of time has elapsed.
-However, if there are no event handlers (neither \fBTcl_WatchFile\fR nor
-\fBTcl_SetMaxBlockTime\fR has been called since the last call to
-\fBTcl_WaitForEvent\fR), so that the procedure would block forever,
-then it returns immediately with a result of TCL_ERROR.
+\fBTcl_WaitForEvent\fR is the lowest-level procedure in the notifier;
+it is responsible for waiting for an ``interesting'' event to occur or
+for a given time to elapse.  Before \fBTcl_WaitForEvent\fR is invoked,
+each of the event sources' setup procedure will have been invoked.
+The \fItimePtr\fR argument to
+\fBTcl_WaitForEvent\fR gives the maximum time to block for an event,
+based on calls to \fBTcl_SetMaxBlockTime\fR made by setup procedures
+and on other information (such as the \fBTCL_DONT_WAIT\fR bit in
+\fIflags\fR).
+.PP
+Ideally, \fBTcl_WaitForEvent\fR should only wait for an event
+to occur; it should not actually process the event in any way.
+Later on, the
+event sources will process the raw events and create Tcl_Events on
+the event queue in their \fIcheckProc\fR procedures.
+However, on some platforms (such as Windows) this isn't possible;
+events may be processed in \fBTcl_WaitForEvent\fR, including queuing
+Tcl_Events and more (for example, callbacks for native widgets may be
+invoked).  The return value from \fBTcl_WaitForEvent\fR must be either
+0, 1, or \-1.  On platforms such as Windows where events get processed in
+\fBTcl_WaitForEvent\fR, a return value of 1 means that there may be more
+events still pending that haven't been processed.  This is a sign to the
+caller that it must call \fBTcl_WaitForEvent\fR again if it wants all
+pending events to be processed. A 0 return value means that calling
+\fBTcl_WaitForEvent\fR again will not have any effect: either this is a
+platform where \fBTcl_WaitForEvent\fR only waits without doing any event
+processing, or \fBTcl_WaitForEvent\fR knows for sure that there are no
+additional events to process (e.g. it returned because the time
+elapsed).  Finally, a return value of \-1 means that the event loop is
+no longer operational and the application should probably unwind and
+terminate.  Under Windows this happens when a WM_QUIT message is received;
+under Unix it happens when \fBTcl_WaitForEvent\fR would have waited
+forever because there were no active event sources and the timeout was
+infinite.
+.PP
+If the notifier will be used with an external event loop, then it must
+also support the \fBTcl_SetTimer\fR interface.  \fBTcl_SetTimer\fR is
+invoked by \fBTcl_SetMaxBlockTime\fR whenever the maximum blocking
+time has been reduced.  \fBTcl_SetTimer\fR should arrange for the
+external event loop to invoke \fBTcl_ServiceAll\fR after the specified
+interval even if no events have occurred.  This interface is needed
+because \fBTcl_WaitForEvent\fR isn't invoked when there is an external
+event loop.  If the
+notifier will only be used from \fBTcl_DoOneEvent\fR, then
+\fBTcl_SetTimer\fR need not do anything.
+.PP
+On Unix systems, the file event source also needs support from the
+notifier.  The file event source consists of the
+\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR
+procedures, which are described elsewhere.
+.PP
+The \fBTcl_Sleep\fR and \fBTcl_DoOneEvent\fR interfaces are described
+elsewhere.
 .PP
 The easiest way to create a new notifier is to look at the code
-for an existing notifier, such as the files \fBgeneric/tclNotify.c\fR
-and \fBunix/tclUnixNotfy.c\fR.
+for an existing notifier, such as the files \fBunix/tclUnixNotfy.c\fR
+or \fBwin/tclWinNotify.c\fR in the Tcl source distribution.
+
+.SH "EXTERNAL EVENT LOOPS"
+.PP
+The notifier interfaces are designed so that Tcl can be embedded into
+applications that have their own private event loops.  In this case,
+the application does not call \fBTcl_DoOneEvent\fR except in the case
+of recursive event loops such as calls to the Tcl commands \fBupdate\fR
+or \fBvwait\fR.  Most of the time is spent in the external event loop
+of the application.  In this case the notifier must arrange for the
+external event loop to call back into Tcl when something
+happens on the various Tcl event sources.  These callbacks should
+arrange for appropriate Tcl events to be placed on the Tcl event queue.
+.PP
+Because the external event loop is not calling \fBTcl_DoOneEvent\fR on
+a regular basis, it is up to the notifier to arrange for
+\fBTcl_ServiceEvent\fR to be called whenever events are pending on the
+Tcl event queue.  The easiest way to do this is to invoke
+\fBTcl_ServiceAll\fR at the end of each callback from the external
+event loop.  This will ensure that all of the event sources are
+polled, any queued events are serviced, and any pending idle handlers
+are processed before returning control to the application.  In
+addition, event sources that need to poll for events can call
+\fBTcl_SetMaxBlockTime\fR to force the external event loop to call
+Tcl even if no events are available on the system event queue.
+.PP
+As a side effect of processing events detected in the main external
+event loop, Tcl may invoke \fBTcl_DoOneEvent\fR to start a recursive event
+loop in commands like \fBvwait\fR.  \fBTcl_DoOneEvent\fR will invoke
+the external event loop, which will result in callbacks as described
+in the preceding paragraph, which will result in calls to
+\fBTcl_ServiceAll\fR.  However, in these cases it is undesirable to
+service events in \fBTcl_ServiceAll\fR.  Servicing events there is
+unnecessary because control will immediately return to the
+external event loop and hence to \fBTcl_DoOneEvent\fR, which can
+service the events itself.  Furthermore, \fBTcl_DoOneEvent\fR is
+supposed to service only a single event, whereas \fBTcl_ServiceAll\fR
+normally services all pending events.  To handle this situation,
+\fBTcl_DoOneEvent\fR sets a flag for \fBTcl_ServiceAll\fR
+that causes it to return without servicing any events.
+This flag is called the \fIservice mode\fR;
+\fBTcl_DoOneEvent\fR restores it to its previous value before it returns.
+.PP
+In some cases, however, it may be necessary for \fBTcl_ServiceAll\fR
+to service events
+even when it has been invoked from \fBTcl_DoOneEvent\fR.  This happens
+when there is yet another recursive event loop invoked via an
+event handler called by \fBTcl_DoOneEvent\fR (such as one that is
+part of a native widget).  In this case, \fBTcl_DoOneEvent\fR may not
+have a chance to service events so \fBTcl_ServiceAll\fR must service
+them all.  Any recursive event loop that calls an external event
+loop rather than \fBTcl_DoOneEvent\fR must reset the service mode so
+that all events get processed in \fBTcl_ServiceAll\fR.  This is done
+by invoking the \fBTcl_SetServiceMode\fR procedure.  If
+\fBTcl_SetServiceMode\fR is passed \fBTCL_SERVICE_NONE\fR, then calls
+to \fBTcl_ServiceAll\fR will return immediately without processing any
+events.  If \fBTcl_SetServiceMode\fR is passed \fBTCL_SERVICE_ALL\fR,
+then calls to \fBTcl_ServiceAll\fR will behave normally.
+\fBTcl_SetServiceMode\fR returns the previous value of the service
+mode, which should be restored when the recursive loop exits.
+\fBTcl_GetServiceMode\fR returns the current value of the service
+mode.
+.VE
 
 .SH KEYWORDS
-block time, event notifier, event queue, event sources, file events
+event, notifier, event queue, event sources, file events, timer, idle, service mode
diff --git a/contrib/tcl/doc/ObjSetVar.3 b/contrib/tcl/doc/ObjSetVar.3
new file mode 100644
index 0000000..49dd82d
--- /dev/null
+++ b/contrib/tcl/doc/ObjSetVar.3
@@ -0,0 +1,162 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) ObjSetVar.3 1.6 97/05/19 17:35:44
+'\" 
+.so man.macros
+.TH Tcl_ObjSetVar2 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ObjSetVar2, Tcl_ObjGetVar2 \- manipulate Tcl variables
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_ObjSetVar2\fR(\fIinterp, part1Ptr, part2Ptr, newValuePtr, flags\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ObjGetVar2\fR(\fIinterp, part1Ptr, part2Ptr, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *newValuePtr
+.AP Tcl_Interp *interp in
+Interpreter containing variable.
+.AP Tcl_Obj *part1Ptr in
+Points to a Tcl object containing the variable's name.
+The name may include a series of \fB::\fR namespace qualifiers
+to specify a variable in a particular namespace.
+May refer to a scalar variable or an element of an array variable.
+.AP Tcl_Obj *part2Ptr in
+If non-NULL, points to an object containing the name of an element
+within an array and \fIpart1Ptr\fR must refer to an array variable.
+.AP Tcl_Obj *newValuePtr in
+Points to a Tcl object containing the new value for the variable.
+.AP int flags in
+OR-ed combination of bits providing additional information for
+operation. See below for valid values.
+.BE
+
+.SH DESCRIPTION
+.PP
+These two procedures may be used to read and modify
+Tcl variables from C code.
+\fBTcl_ObjSetVar2\fR will create a new variable or modify an existing one.
+It sets the specified variable to
+the object referenced by \fInewValuePtr\fR
+and returns a pointer to the object which is the variable's new value.
+The returned object may not be the same one
+referenced by \fInewValuePtr\fR;
+this might happen because variable traces may modify the variable's value.
+The reference count for the variable's old value is decremented
+and the reference count for its new value is incremented.
+If the new value for the variable
+is not the same one referenced by \fInewValuePtr\fR
+(perhaps as a result of a variable trace),
+then \fInewValuePtr\fR's reference count is left unchanged.
+The reference count for the returned object is not incremented
+to reflect the returned reference.
+If the caller needs to keep a reference to the object,
+say in a data structure,
+it must increment its reference count using \fBTcl_IncrRefCount\fR.
+If an error occurs in setting the variable
+(e.g. an array variable is referenced
+without giving an index into the array),
+then NULL is returned.
+.PP
+The variable name specified to \fBTcl_ObjSetVar2\fR consists of two parts.
+\fIpart1Ptr\fR contains the name of a scalar or array variable.
+If \fIpart2Ptr\fR is NULL, the variable must be a scalar.
+If \fIpart2Ptr\fR is not NULL,
+it contains the name of an element in the array named by \fIpart2Ptr\fR.
+As a special case, if the flag TCL_PARSE_PART1 is specified,
+\fIpart1Ptr\fR may contain both an array and an element name:
+if the name contains an open parenthesis and ends with a
+close parenthesis, then the value between the parentheses is
+treated as an element name (which can have any string value) and
+the characters before the first open
+parenthesis are treated as the name of an array variable.
+If the flag TCL_PARSE_PART1 is given,
+\fIpart2Ptr\fR should be NULL since the array and element names
+are taken from \fIpart2Ptr\fR.
+.PP
+The \fIflags\fR argument may be used to specify any of several
+options to the procedures.
+It consists of an OR-ed combination of any of the following
+bits:
+.TP
+\fBTCL_GLOBAL_ONLY\fR
+Under normal circumstances the procedures look up variables as follows:
+If a procedure call is active in \fIinterp\fR,
+a variable is looked up at the current level of procedure call.
+Otherwise, a variable is looked up first in the current namespace,
+then in the global namespace.
+However, if this bit is set in \fIflags\fR then the variable
+is looked up only in the global namespace
+even if there is a procedure call active.
+If both \fBTCL_GLOBAL_ONLY\fR and \fBTCL_NAMESPACE_ONLY\fR are given,
+\fBTCL_GLOBAL_ONLY\fR is ignored.
+.TP
+\fBTCL_NAMESPACE_ONLY\fR
+Under normal circumstances the procedures look up variables as follows:
+If a procedure call is active in \fIinterp\fR,
+a variable is looked up at the current level of procedure call.
+Otherwise, a variable is looked up first in the current namespace,
+then in the global namespace.
+However, if this bit is set in \fIflags\fR then the variable
+is looked up only in the current namespace
+even if there is a procedure call active.
+.TP
+\fBTCL_LEAVE_ERR_MSG\fR
+If an error is returned and this bit is set in \fIflags\fR, then
+an error message will be left in the interpreter's result,
+where it can be retrieved with \fBTcl_GetObjResult\fR
+or \fBTcl_GetStringResult\fR.
+If this flag bit isn't set then no error message is left
+and the interpreter's result will not be modified.
+.TP
+\fBTCL_APPEND_VALUE\fR
+If this bit is set then \fInewValuePtr\fR is appended to the current
+value, instead of replacing it.
+If the variable is currently undefined, then this bit is ignored.
+.TP
+\fBTCL_LIST_ELEMENT\fR
+If this bit is set, then \fInewValuePtr\fR is converted to a valid
+Tcl list element before setting (or appending to) the variable.
+A separator space is appended before the new list element unless
+the list element is going to be the first element in a list or
+sublist (i.e. the variable's current value is empty, or contains
+the single character ``{'', or ends in `` }'').
+.TP
+\fBTCL_PARSE_PART1\fR
+If this bit is set,
+then \fBTcl_ObjGetVar2\fR and \fBTcl_ObjSetVar2\fR
+will parse \fIpart1Ptr\fR
+to obtain both an array name and an element name.
+If the name in \fIpart1Ptr\fR contains an open parenthesis
+and ends with a close parenthesis,
+the name is treated as the name of an element of an array;
+otherwise, the name in \fIpart1Ptr\fR
+is interpreted as the name of a scalar variable.
+When this bit is set,
+\fIpart2Ptr\fR is ignored.
+.PP
+\fBTcl_ObjGetVar2\fR returns the value of the specified variable.
+Its arguments are treated the same way as those for \fBTcl_ObjSetVar2\fR.
+It returns a pointer to the object which is the variable's value.
+The reference count for the returned object is not incremented.
+If the caller needs to keep a reference to the object,
+say in a data structure,
+it must increment the reference count using \fBTcl_IncrRefCount\fR.
+If an error occurs in setting the variable
+(e.g. an array variable is referenced
+without giving an index into the array),
+then NULL is returned.
+
+.SH "SEE ALSO"
+Tcl_GetObjResult, Tcl_GetStringResult, Tcl_GetVar, Tcl_GetVar2, Tcl_SetVar, Tcl_SetVar2, Tcl_TraceVar, Tcl_UnsetVar, Tcl_UnsetVar2
+
+.SH KEYWORDS
+array, interpreter, object, scalar, set, unset, variable
diff --git a/contrib/tcl/doc/Object.3 b/contrib/tcl/doc/Object.3
new file mode 100644
index 0000000..e564de9
--- /dev/null
+++ b/contrib/tcl/doc/Object.3
@@ -0,0 +1,336 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) Object.3 1.9 97/06/13 18:36:20
+'\" 
+.so man.macros
+.TH Tcl_Obj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared \- manipulate Tcl objects
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewObj\fR()
+.sp
+Tcl_Obj *
+\fBTcl_DuplicateObj\fR(\fIobjPtr\fR)
+.sp
+\fBTcl_IncrRefCount\fR(\fIobjPtr\fR)
+.sp
+\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
+.sp
+int
+\fBTcl_IsShared\fR(\fIobjPtr\fR)
+.sp
+\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Obj *objPtr in
+.AP Tcl_Obj *objPtr in
+Points to an object;
+must have been the result of a previous call to \fBTcl_NewObj\fR.
+.BE
+
+.SH INTRODUCTION
+.PP
+This man page presents an overview of Tcl objects and how they are used.
+It also describes generic procedures for managing Tcl objects.
+These procedures are used to create and copy objects,
+and increment and decrement the count of references (pointers) to objects.
+The procedures are used in conjunction with ones
+that operate on specific types of objects such as
+\fBTcl_GetIntFromObj\fR and \fBTcl_ListObjAppendElement\fR.
+The individual procedures are described along with the data structures
+they manipulate.
+.PP
+Tcl's \fIdual-ported\fR objects provide a general-purpose mechanism
+for storing and exchanging Tcl values.
+They largely replace the use of strings in Tcl.
+For example, they are used to store variable values,
+command arguments, command results, and scripts.
+Tcl objects behave like strings but also hold an internal representation
+that can be manipulated more efficiently.
+For example, a Tcl list is now represented as an object
+that holds the list's string representation
+as well as an array of pointers to the objects for each list element.
+Dual-ported objects avoid most runtime type conversions.
+They also improve the speed of many operations
+since an appropriate representation is immediately available.
+The compiler itself uses Tcl objects to
+cache the instruction bytecodes resulting from compiling scripts.
+.PP
+The two representations are a cache of each other and are computed lazily.
+That is, each representation is only computed when necessary,
+it is computed from the other representation,
+and, once computed, it is saved.
+In addition, a change in one representation invalidates the other one.
+As an example, a Tcl program doing integer calculations can
+operate directly on a variable's internal machine integer
+representation without having to constantly convert
+between integers and strings.
+Only when it needs a string representing the variable's value,
+say to print it,
+will the program regenerate the string representation from the integer.
+Although objects contain an internal representation,
+their semantics are defined in terms of strings:
+an up-to-date string can always be obtained,
+and any change to the object will be reflected in that string
+when the object's string representation is fetched.
+Because of this representation invalidation and regeneration,
+it is dangerous for extension writers to access
+\fBTcl_Obj\fR fields directly.
+It is better to access Tcl_Obj information using
+procedures like \fBTcl_GetStringFromObj\fR.
+.PP
+Objects are allocated on the heap
+and are referenced using a pointer to their \fBTcl_Obj\fR structure.
+Objects are shared as much as possible.
+This significantly reduces storage requirements
+because some objects such as long lists are very large.
+Also, most Tcl values are only read and never modified.
+This is especially true for procedure arguments,
+which can be shared between the caller and the called procedure.
+Assignment and argument binding is done by
+simply assigning a pointer to the value. 
+Reference counting is used to determine when it is safe to
+reclaim an object's storage.
+.PP
+Tcl objects are typed.
+An object's internal representation is controlled by its type.
+Seven types are predefined in the Tcl core
+including integer, double, list, and bytecode.
+Extension writers can extend the set of types
+by using the procedure \fBTcl_RegisterObjType\fR .
+
+.SH "THE TCL_OBJ STRUCTURE"
+.PP
+Each Tcl object is represented by a \fBTcl_Obj\fR structure
+which is defined as follows.
+.CS
+typedef struct Tcl_Obj {
+	int \fIrefCount\fR;
+	char *\fIbytes\fR;
+	int \fIlength\fR;
+	Tcl_ObjType *\fItypePtr\fR;
+	union {
+		long \fIlongValue\fR;
+		double \fIdoubleValue\fR;
+		VOID *\fIotherValuePtr\fR;
+		struct {
+			VOID *\fIptr1\fR;
+			VOID *\fIptr2\fR;
+		} \fItwoPtrValue\fR;
+	} \fIinternalRep\fR;
+} Tcl_Obj;
+.CE
+The \fIbytes\fR and the \fIlength\fR members together hold
+an object's string representation,
+which is a \fIcounted\fR or \fIbinary string\fR
+that may contain binary data with embedded null bytes.
+\fIbytes\fR points to the first byte of the string representation.
+The \fIlength\fR member gives the number of bytes.
+The byte array must always have a null after the last byte,
+at offset \fIlength\fR;
+this allows string representations that do not contain nulls
+to be treated as conventional null-terminated C strings.
+C programs use \fBTcl_GetStringFromObj\fR to get
+an object's string representation.
+If \fIbytes\fR is NULL,
+the string representation is invalid.
+.PP
+An object's type manages its internal representation.
+The member \fItypePtr\fR points to the Tcl_ObjType structure
+that describes the type.
+If \fItypePtr\fR is NULL,
+the internal representation is invalid.
+.PP
+The \fIinternalRep\fR union member holds
+an object's internal representation.
+This is either a (long) integer, a double-precision floating point number,
+a pointer to a value containing additional information
+needed by the object's type to represent the object,
+or two arbitrary pointers.
+.PP
+The \fIrefCount\fR member is used to tell when it is safe to free
+an object's storage.
+It holds the count of active references to the object.
+Maintaining the correct reference count is a key responsibility
+of extension writers.
+Reference counting is discussed below
+in the section \fBSTORAGE MANAGEMENT OF OBJECTS\fR.
+.PP
+Although extension writers can directly access
+the members of a Tcl_Obj structure,
+it is much better to use the appropriate procedures and macros.
+For example, extension writers should never
+read or update \fIrefCount\fR directly;
+they should use macros such as
+\fBTcl_IncrRefCount\fR and \fBTcl_IsShared\fR instead.
+.PP
+A key property of Tcl objects is that they hold two representations.
+An object typically starts out containing only a string representation:
+it is untyped and has a NULL \fItypePtr\fR.
+An object containing an empty string or a copy of a specified string
+is created using \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR respectively.
+An object's string value is gotten with \fBTcl_GetStringFromObj\fR
+and changed with \fBTcl_SetStringObj\fR.
+If the object is later passed to a procedure like \fBTcl_GetIntFromObj\fR
+that requires a specific internal representation,
+the procedure will create one and set the object's \fItypePtr\fR.
+The internal representation is computed from the string representation.
+An object's two representations are duals of each other:
+changes made to one are reflected in the other.
+For example, \fBTcl_ListObjReplace\fR will modify an object's
+internal representation and the next call to \fBTcl_GetStringFromObj\fR
+will reflect that change.
+.PP
+Representations are recomputed lazily for efficiency.
+A change to one representation made by a procedure
+such as \fBTcl_ListObjReplace\fR is not reflected immediately
+in the other representation.
+Instead, the other representation is marked invalid
+so that it is only regenerated if it is needed later.
+Most C programmers never have to be concerned with how this is done
+and simply use procedures such as \fBTcl_GetBooleanFromObj\fR or
+\fBTcl_ListObjIndex\fR.
+Programmers that implement their own object types
+must check for invalid representations
+and mark representations invalid when necessary.
+The procedure \fBTcl_InvalidateStringRep\fR is used
+to mark an object's string representation invalid and to
+free any storage associated with the old string representation.
+.PP
+Objects usually remain one type over their life,
+but occasionally an object must be converted from one type to another.
+For example, a C program might build up a string in an object
+with repeated calls to \fBTcl_StringObjAppend\fR,
+and then call \fBTcl_ListObjIndex\fR to extract a list element from
+the object.
+The same object holding the same string value
+can have several different internal representations
+at different times.
+Extension writers can also force an object to be converted from one type
+to another using the \fBTcl_ConvertToType\fR procedure.
+Only programmers that create new object types need to be concerned
+about how this is done.
+A procedure defined as part of the object type's implementation
+creates a new internal representation for an object
+and changes its \fItypePtr\fR.
+See the man page for \fBTcl_RegisterObjType\fR
+to see how to create a new object type.
+
+.SH "EXAMPLE OF THE LIFETIME OF AN OBJECT"
+.PP
+As an example of the lifetime of an object,
+consider the following sequence of commands:
+.CS
+\fBset x 123\fR
+.CE
+This assigns to \fIx\fR an untyped object whose
+\fIbytes\fR member points to \fB123\fR and \fIlength\fR member contains 3.
+The object's \fItypePtr\fR member is NULL.
+.CS
+\fBputs "x is $x"\fR
+.CE
+\fIx\fR's string representation is valid (since \fIbytes\fR is non-NULL)
+and is fetched for the command.
+.CS
+\fBincr x\fR
+.CE
+The \fBincr\fR command first gets an integer from \fIx\fR's object
+by calling \fBTcl_GetIntFromObj\fR.
+This procedure checks whether the object is already an integer object.
+Since it is not, it converts the object
+by setting the object's \fIinternalRep.longValue\fR member
+to the integer \fB123\fR
+and setting the object's \fItypePtr\fR
+to point to the integer Tcl_ObjType structure.
+Both representations are now valid.
+\fBincr\fR increments the object's integer internal representation
+then invalidates its string representation
+(by calling \fBTcl_InvalidateStringRep\fR)
+since the string representation
+no longer corresponds to the internal representation.
+.CS
+\fBputs "x is now $x"\fR
+.CE
+The string representation of \fIx\fR's object is needed
+and is recomputed.
+The string representation is now \fB124\fR.
+and both representations are again valid.
+
+.SH "STORAGE MANAGEMENT OF OBJECTS"
+.PP
+Tcl objects are allocated on the heap and are shared as much as possible
+to reduce storage requirements.
+Reference counting is used to determine when an object is
+no longer needed and can safely be freed.
+An object just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
+has \fIrefCount\fR 0.
+The macro \fBTcl_IncrRefCount\fR increments the reference count
+when a new reference to the object is created.
+The macro \fBTcl_DecrRefCount\fR decrements the count
+when a reference is no longer needed and,
+if the object's reference count drops to zero, frees its storage.
+An object shared by different code or data structures has
+\fIrefCount\fR greater than 1.
+Incrementing an object's reference count ensures that
+it won't be freed too early or have its value change accidently.
+.PP
+As an example, the bytecode interpreter shares argument objects
+between calling and called Tcl procedures to avoid having to copy objects.
+It assigns the call's argument objects to the procedure's
+formal parameter variables.
+In doing so, it calls \fBTcl_IncrRefCount\fR to increment
+the reference count of each argument since there is now a new
+reference to it from the formal parameter.
+When the called procedure returns,
+the interpreter calls \fBTcl_DecrRefCount\fR to decrement
+each argument's reference count.
+When an object's reference count drops to zero,
+\fBTcl_DecrRefCount\fR reclaims its storage.
+Most command procedures do not have to be concerned about
+reference counting since they use an object's value immediately
+and don't retain a pointer to the object after they return.
+However, if they do retain a pointer to an object in a data structure,
+they must be careful to increment its reference count
+since the retained pointer is a new reference.
+.PP
+Command procedures that directly modify objects
+such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
+copy a shared object before changing it.
+They must first check whether the object is shared
+by calling \fBTcl_IsShared\fR.
+If the object is shared they must copy the object
+by using \fBTcl_DuplicateObj\fR;
+this returns a new duplicate of the original object
+that has \fIrefCount\fR 1.
+If the object is not shared,
+the command procedure "owns" the object and can safely modify it directly.
+For example, the following code appears in the command procedure
+that implements \fBlinsert\fR.
+This procedure modifies the list object passed to it in \fIobjv[1]\fR
+by inserting \fIobjc-3\fR new elements before \fIindex\fR.
+.CS
+listPtr = objv[1];
+if (Tcl_IsShared(listPtr)) {
+	listPtr = Tcl_DuplicateObj(listPtr);
+}
+result = Tcl_ListObjReplace(interp, listPtr, index, 0, (objc-3), &(objv[3]));
+.CE
+As another example, \fBincr\fR's command procedure
+must check whether the variable's object is shared before
+incrementing the integer in its internal representation.
+If it is shared, it needs to duplicate the object
+in order to avoid accidently changing values in other data structures.
+
+.SH "SEE ALSO"
+Tcl_ConvertToType, Tcl_GetIntFromObj, Tcl_ListObjAppendElement, Tcl_ListObjIndex, Tcl_ListObjReplace, Tcl_RegisterObjType
+
+.SH KEYWORDS
+internal representation, object, object creation, object type, reference counting, string representation, type conversion
diff --git a/contrib/tcl/doc/ObjectType.3 b/contrib/tcl/doc/ObjectType.3
new file mode 100644
index 0000000..515d85c
--- /dev/null
+++ b/contrib/tcl/doc/ObjectType.3
@@ -0,0 +1,198 @@
+'\"
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) ObjectType.3 1.8 97/04/30 15:42:29
+'\" 
+.so man.macros
+.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType  \- manipulate Tcl object types
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_RegisterObjType\fR(\fItypePtr\fR)
+.sp
+Tcl_ObjType *
+\fBTcl_GetObjType\fR(\fItypeName\fR)
+.sp
+int
+\fBTcl_AppendAllObjTypes\fR(\fIinterp, objPtr\fR)
+.sp
+int
+\fBTcl_ConvertToType\fR(\fIinterp, objPtr, typePtr\fR)
+.SH ARGUMENTS
+.AS Tcl_ObjType *typeName in
+.AP Tcl_ObjType *typePtr in
+Points to the structure containing information about the Tcl object type.
+This storage must must live forever,
+typically by being statically allocated.
+.AP char *typeName in
+The name of a Tcl object type that \fBTcl_GetObjType\fR should look up.
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tcl_Obj *objPtr in
+For \fBTcl_AppendAllObjTypes\fR, this points to the object onto which
+it appends the name of each object type as a list element.
+For \fBTcl_ConvertToType\fR, this points to an object that
+must have been the result of a previous call to \fBTcl_NewObj\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedures in this man page manage Tcl object types.
+The are used to register new object types,
+look up types,
+and force conversions from one type to another.
+.PP
+\fBTcl_RegisterObjType\fR registers a new Tcl object type
+in the table of all object types supported by Tcl.
+The argument \fItypePtr\fR points to a Tcl_ObjType structure that
+describes the new type by giving its name
+and by supplying pointers to four procedures
+that implement the type.
+If the type table already containes a type
+with the same name as in \fItypePtr\fR,
+it is replaced with the new type.
+The Tcl_ObjType structure is described
+in the section \fBTHE TCL_OBJTYPE STRUCTURE\fR below.
+.PP
+\fBTcl_GetObjType\fR returns a pointer to the Tcl_ObjType
+with name \fItypeName\fR.
+It returns NULL if no type with that name is registered.
+.PP
+\fBTcl_AppendAllObjTypes\fR appends the name of each object type
+as a list element onto the Tcl object referenced by \fIobjPtr\fR.
+The return value is \fBTCL_OK\fR unless there was an error
+converting \fIobjPtr\fR to a list object;
+in that case \fBTCL_ERROR\fR is returned.
+.PP
+\fBTcl_ConvertToType\fR converts an object from one type to another
+if possible.
+It creates a new internal representation for \fIobjPtr\fR
+appropriate for the target type \fItypePtr\fR
+and sets its \fItypePtr\fR member to that type.
+Any internal representation for \fIobjPtr\fR's old type is freed.
+If an error occurs during conversion, it returns \fBTCL_ERROR\fR
+and leaves an error message in the result object for \fIinterp\fR
+unless \fIinterp\fR is NULL.
+Otherwise, it returns \fBTCL_OK\fR.
+Passing a NULL \fIinterp\fR allows this procedure to be used
+as a test whether the conversion can be done (and in fact was done).
+
+.SH "THE TCL_OBJTYPE STRUCTURE"
+.PP
+Extension writers can define new object types by defining four
+procedures,
+initializing a Tcl_ObjType structure to describe the type,
+and calling \fBTcl_RegisterObjType\fR.
+The \fBTcl_ObjType\fR structure is defined as follows:
+.CS
+typedef struct Tcl_ObjType {
+	char *\fIname\fR;
+	Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
+	Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
+	Tcl_UpdateStringProc *\fIupdateStringProc\fR;
+	Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
+} Tcl_ObjType;
+.CE
+.PP
+The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
+Extension writers can look up an object type using its name
+with the \fBTcl_GetObjType\fR procedure.
+The remaining four members are pointers to procedures
+called by the generic Tcl object code:
+.PP
+The \fIsetFromAnyProc\fR member contains the address of a function
+called to create a valid internal representation
+from an object's string representation.
+.CS
+typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *\fIinterp\fR, Tcl_Obj *\fIobjPtr\fR);
+.CE
+If an internal representation can't be created from the string,
+it returns \fBTCL_ERROR\fR and puts a message
+describing the error in the result object for \fIinterp\fR
+unless \fIinterp\fR is NULL.
+If \fIsetFromAnyProc\fR is successful,
+it stores the new internal representation,
+sets \fIobjPtr\fR's \fItypePtr\fR member to point to
+\fIsetFromAnyProc\fR's \fBTcl_ObjType\fR, and returns \fBTCL_OK\fR.
+Before setting the new internal representation,
+the \fIsetFromAnyProc\fR must free any internal representation
+of \fIobjPtr\fR's old type;
+it does this by calling the old type's \fIfreeIntRepProc\fR
+if it is not NULL.
+As an example, the \fIsetFromAnyProc\fR for the builtin Tcl integer type
+gets an up-to-date string representation for \fIobjPtr\fR
+by calling \fBTcl_GetStringFromObj\fR.
+It parses the string to obtain an integer and,
+if this succeeds,
+stores the integer in \fIobjPtr\fR's internal representation
+and sets \fIobjPtr\fR's \fItypePtr\fR member to point to the integer type's
+Tcl_ObjType structure.
+.PP
+The \fIupdateStringProc\fR member contains the address of a function
+called to create a valid string representation
+from an object's internal representation.
+.CS
+typedef void (Tcl_UpdateStringProc) (Tcl_Obj *\fIobjPtr\fR);
+.CE
+\fIobjPtr\fR's \fIbytes\fR member is always NULL when it is called.
+It must always set \fIbytes\fR non-NULL before returning.
+We require the string representation's byte array
+to have a null after the last byte, at offset \fIlength\fR;
+this allows string representations that do not contain null bytes
+to be treated as conventional null character-terminated C strings.
+Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR.
+Note that \fIupdateStringProc\fRs must allocate
+enough storage for the string's bytes and the terminating null byte.
+The \fIupdateStringProc\fR for Tcl's builtin list type, for example,
+builds an array of strings for each element object
+and then calls \fBTcl_Merge\fR
+to construct a string with proper Tcl list structure.
+It stores this string as the list object's string representation.
+.PP
+The \fIdupIntRepProc\fR member contains the address of a function
+called to copy an internal representation from one object to another.
+.CS
+typedef void (Tcl_DupInternalRepProc) (Tcl_Obj *\fIsrcPtr\fR, Tcl_Obj *\fIdupPtr\fR);
+.CE
+\fIdupPtr\fR's internal representation is made a copy of \fIsrcPtr\fR's
+internal representation.
+Before the call,
+\fIsrcPtr\fR's internal representation is valid and \fIdupPtr\fR's is not.
+\fIsrcPtr\fR's object type determines what
+copying its internal representation means.
+For example, the \fIdupIntRepProc\fR for the Tcl integer type
+simply copies an integer.
+The builtin list type's \fIdupIntRepProc\fR
+allocates a new array that points at the original element objects;
+the elements are shared between the two lists
+(and their reference counts are incremented to reflect the new references).
+.PP
+The \fIfreeIntRepProc\fR member contains the address of a function
+that is called when an object is freed.
+.CS
+typedef void (Tcl_FreeInternalRepProc) (Tcl_Obj *\fIobjPtr\fR);
+.CE
+The \fIfreeIntRepProc\fR function can deallocate the storage
+for the object's internal representation
+and do other type-specific processing necessary when an object is freed.
+For example, Tcl list objects have an \fIinternalRep.otherValuePtr\fR
+that points to an array of pointers to each element in the list.
+The list type's \fIfreeIntRepProc\fR decrements
+the reference count for each element object
+(since the list will no longer refer to those objects),
+then deallocates the storage for the array of pointers.
+The \fIfreeIntRepProc\fR member can be set to NULL
+to indicate that the internal representation does not require freeing.
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount
+
+.SH KEYWORDS
+internal representation, object, object type, string representation, type conversion
diff --git a/contrib/tcl/doc/OpenFileChnl.3 b/contrib/tcl/doc/OpenFileChnl.3
index c17cc64..09768d9 100644
--- a/contrib/tcl/doc/OpenFileChnl.3
+++ b/contrib/tcl/doc/OpenFileChnl.3
@@ -1,16 +1,16 @@
 '\"
-'\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" SCCS: @(#) OpenFileChnl.3 1.27 96/03/22 14:55:07
+'\" SCCS: @(#) OpenFileChnl.3 1.39 97/05/09 18:14:49
 .so man.macros
-.TH Tcl_OpenFileChannel 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_OpenFileChannel 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_Close, Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_Eof, Tcl_InputBlocked, Tcl_GetChannelOption, Tcl_SetChannelOption \- buffered I/O facilities using channels
+Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_Close, Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_GetChannelOption, Tcl_SetChannelOption \- buffered I/O facilities using channels
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -22,9 +22,11 @@ Tcl_Channel
 .sp
 Tcl_Channel
 \fBTcl_OpenCommandChannel\fR(\fIinterp, argc, argv, flags\fR)
+.VS
 .sp
 Tcl_Channel
-\fBTcl_MakeFileChannel\fR(\fIinOsFile, outOsFile, readOrWrite\fR)
+\fBTcl_MakeFileChannel\fR(\fIhandle, readOrWrite\fR)
+.VE
 .sp
 Tcl_Channel
 \fBTcl_GetChannel\fR(\fIinterp, channelName, modePtr\fR)
@@ -45,6 +47,9 @@ int
 \fBTcl_Gets\fR(\fIchannel, lineRead\fR)
 .sp
 int
+\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
+.sp
+int
 \fBTcl_Write\fR(\fIchannel, buf, toWrite\fR)
 .sp
 int
@@ -102,14 +107,14 @@ as the standard input of the invoking process; likewise for
 then the pipe can redirect stdio handles to override the stdio handles for
 which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set.
 If it is set, then such redirections cause an error.
-.AP ClientData inOsFile in
-Operating system specific handle for input from a file. For Unix this is a
-file descriptor, for Windows it is a HANDLE, etc.
-.AP ClientData outOsFile in
-Operating system specific handle for output to a file.
+.VS
+.AP ClientData handle in
+Operating system specific handle for I/O to a file. For Unix this is a
+file descriptor, for Windows it is a HANDLE.
 .AP int readOrWrite in
 OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
-which of \fIinOsFile\fR and \fIoutOsFile\fR contains a valid value.
+what operations are valid on \fIhandle\fR.
+.VE
 .AP int *modePtr out
 Points at an integer variable that will receive an OR-ed combination of
 \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is
@@ -120,11 +125,21 @@ from a procedure such as \fBTcl_OpenFileChannel\fR.
 .AP char *buf in
 An array of bytes in which to store channel input, or from which
 to read channel output.
+.AP int len in
+The length of the input or output.
+.AP int atEnd in
+If nonzero, store the input at the end of the input queue, otherwise store
+it at the head of the input queue.
 .AP int toRead in
 The number of bytes to read from the channel.
 .AP Tcl_DString *lineRead in
 A pointer to a Tcl dynamic string in which to store the line read from the
-channel.  Must have been initialized by the caller.
+channel.  Must have been initialized by the caller.  The line read
+will be appended to any data already in the dynamic string.
+.AP Tcl_Obj *linePtrObj in
+A pointer to a Tcl object in which to store the line read from the
+channel.  The line read will be appended to the current value of the
+object. 
 .AP int toWrite in
 The number of bytes to read from \fIbuf\fR and output to the channel.
 .AP int offset in
@@ -176,6 +191,12 @@ returns NULL and records a POSIX error code that can be
 retrieved with \fBTcl_GetErrno\fR.
 In addition, if \fIinterp\fR is non-NULL, \fBTcl_OpenFileChannel\fR
 leaves an error message in \fIinterp->result\fR after any error.
+.PP
+The newly created channel is not registered in the supplied interpreter; to
+register it, use \fBTcl_RegisterChannel\fR, described below.
+If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+previously closed, the act of creating the new channel also assigns it as a
+replacement for the standard channel.
 
 .SH TCL_OPENCOMMANDCHANNEL
 .PP
@@ -208,11 +229,22 @@ returns NULL and records a POSIX error code that can be retrieved with
 \fBTcl_GetErrno\fR.
 In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in
 \fIinterp->result\fR if \fIinterp\fR is not NULL.
+.PP
+The newly created channel is not registered in the supplied interpreter; to
+register it, use \fBTcl_RegisterChannel\fR, described below.
+If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+previously closed, the act of creating the new channel also assigns it as a
+replacement for the standard channel.
 
 .SH TCL_MAKEFILECHANNEL
 .PP
 \fBTcl_MakeFileChannel\fR makes a \fBTcl_Channel\fR from an existing,
 platform-specific, file handle.
+The newly created channel is not registered in the supplied interpreter; to
+register it, use \fBTcl_RegisterChannel\fR, described below.
+If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+previously closed, the act of creating the new channel also assigns it as a
+replacement for the standard channel.
 
 .SH TCL_GETCHANNEL
 .PP
@@ -228,41 +260,46 @@ open for reading and writing.
 .PP
 \fBTcl_RegisterChannel\fR adds a channel to the set of channels accessible
 in \fIinterp\fR. After this call, Tcl programs executing in that
-interpreter can refer to the channel in input or output operations using the
-name given in the call to \fBTcl_CreateChannel\fR.
-After this call the channel becomes the property of the interpreter.
-The caller should not call \fBTcl_Close\fR for the channel; the
-channel will be closed automatically when it is unregistered from
-the interpreter.
-Furthermore, it is not generally safe to reference the channel
-anymore, since it could be deleted at any time by a \fBclose\fR
-command in the interpreter.
+interpreter can refer to the channel in input or output operations using
+the name given in the call to \fBTcl_CreateChannel\fR.  After this call,
+the channel becomes the property of the interpreter, and the caller should
+not call \fBTcl_Close\fR for the channel; the channel will be closed
+automatically when it is unregistered from the interpreter.
+.PP
+Code executing outside of any Tcl interpreter can call
+\fBTcl_RegisterChannel\fR with \fIinterp\fR as NULL, to indicate that it
+wishes to hold a reference to this channel. Subsequently, the channel can
+be registered in a Tcl interpreter and it will only be closed when the
+matching number of calls to \fBTcl_UnregisterChannel\fR have been made.
+This allows code executing outside of any interpreter to safely hold a
+reference to a channel that is also registered in a Tcl interpreter.
 
 .SH TCL_UNREGISTERCHANNEL
 .PP
 \fBTcl_UnregisterChannel\fR removes a channel from the set of channels
-accessible in \fIinterp\fR. After this call, Tcl programs will no longer
-be able to use the channel's name to refer to the channel in that
-interpreter. If this operation removed the last registration of the channel
-in any interpreter, the channel is also closed and destroyed.
+accessible in \fIinterp\fR. After this call, Tcl programs will no longer be
+able to use the channel's name to refer to the channel in that interpreter.
+If this operation removed the last registration of the channel in any
+interpreter, the channel is also closed and destroyed.
+.PP
+Code not associated with a Tcl interpreter can call
+\fBTcl_UnregisterChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
+that it no longer holds a reference to that channel. If this is the last
+reference to the channel, it will now be closed.
 
 .SH TCL_CLOSE
 .PP
 \fBTcl_Close\fR destroys the channel \fIchannel\fR, which must denote a
-currently open channel.
-The channel should not be registered in any interpreter when
-\fBTcl_Close\fR is called; see the manual entry for \fBTcl_CreateChannel\fR
-for a description of \fBTcl_RegisterChannel\fR and \fBTcl_UnregisterChannel\fR.
-Buffered output is flushed to the channel's output device prior to
-destroying the channel, and any buffered input is discarded.
-If this is a blocking channel, the call does not return until all
-buffered data is successfully sent to the channel's output device.
-If this is a nonblocking channel and there is buffered output that
-cannot be written without blocking, the call
-returns immediately;  output is flushed in the background and
-the channel will be closed once all of the buffered data has
-been output.
-In this case errors during flushing are not reported. 
+currently open channel. The channel should not be registered in any
+interpreter when \fBTcl_Close\fR is called. Buffered output is flushed to
+the channel's output device prior to destroying the channel, and any
+buffered input is discarded.  If this is a blocking channel, the call does
+not return until all buffered data is successfully sent to the channel's
+output device.  If this is a nonblocking channel and there is buffered
+output that cannot be written without blocking, the call returns
+immediately; output is flushed in the background and the channel will be
+closed once all of the buffered data has been output.  In this case errors
+during flushing are not reported.
 .PP
 If the channel was closed successfully, \fBTcl_Close\fR returns \fBTCL_OK\fR.
 If an error occurs, \fBTcl_Close\fR returns \fBTCL_ERROR\fR and records a
@@ -271,9 +308,13 @@ If the channel is being closed synchronously and an error occurs during
 closing of the channel and \fIinterp\fR is not NULL, an error message is
 left in \fIinterp->result\fR.
 .PP
-Note: it is not safe to call \fBTcl_Close\fR on a channel that has
-been registered in an interpreter using \fBTcl_RegisterChannel\fR;
-see the documentation for \fBTcl_RegisterChannel\fR for details.
+Note: it is not safe to call \fBTcl_Close\fR on a channel that has been
+registered using \fBTcl_RegisterChannel\fR; see the documentation for
+\fBTcl_RegisterChannel\fR, above, for details. If the channel has ever been
+given as the \fBchan\fR argument in a call to \fBTcl_RegisterChannel\fR,
+you should instead use \fBTcl_UnregisterChannel\fR, which will internally
+call \fBTcl_Close\fR when all calls to \fBTcl_RegisterChannel\fR have been
+matched by corresponding calls to \fBTcl_UnregisterChannel\fR.
 
 .SH TCL_READ
 .PP
@@ -307,7 +348,7 @@ current end-of-line recognition mode. End-of-line recognition and the
 various platform-specific modes are described in the manual entry for the
 Tcl \fBfconfigure\fR command.
 
-.SH TCL_GETS
+.SH TCL_GETS AND TCL_GETSOBJ
 .PP
 \fBTcl_Gets\fR reads a line of input from a channel and appends all of
 the characters of the line except for the terminating end-of-line character(s)
@@ -329,7 +370,10 @@ did not contain an end-of-line character.
 When -1 is returned, the \fBTcl_InputBlocked\fR procedure may be
 invoked to determine if the channel is blocked because of input
 unavailability.
-
+.PP
+\fBTcl_GetsObj\fR is the same as \fBTcl_Gets\fR except the resulting
+characters are appended to a Tcl object \fBlineObjPtr\fR rather than a
+dynamic string.
 .SH TCL_WRITE
 .PP
 \fBTcl_Write\fR accepts \fItoWrite\fR bytes of data at \fIbuf\fR for output
@@ -433,6 +477,20 @@ The call always returns zero if the channel is in blocking mode.
 buffered in the internal buffers for a channel. If the channel is not open
 for reading, this function always returns zero.
 
+.VS
+.SH "PLATFORM ISSUES"
+.PP
+The handles returned from \fBTcl_GetChannelHandle\fR depend on the
+platform and the channel type.  On Unix platforms, the handle is
+always a Unix file descriptor as returned from the \fBopen\fR system
+call.  On Windows platforms, the handle is a file \fBHANDLE\fR when
+the channel was created with \fBTcl_OpenFileChannel\fR,
+\fBTcl_OpenCommandChannel\fR, or \fBTcl_MakeFileChannel\fR.  Other
+channel types may return a different type of handle on Windows
+platforms.  On the Macintosh platform, the handle is a file reference
+number as returned from \fBHOpenDF\fR.
+.VE
+
 .SH "SEE ALSO"
 DString(3), fconfigure(n), filename(n), fopen(2), Tcl_CreateChannel(3)
 
diff --git a/contrib/tcl/doc/OpenTcp.3 b/contrib/tcl/doc/OpenTcp.3
index 3f6d1d3..8f7c7d0 100644
--- a/contrib/tcl/doc/OpenTcp.3
+++ b/contrib/tcl/doc/OpenTcp.3
@@ -1,16 +1,16 @@
 '\"
-'\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1996-7 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" SCCS: @(#) OpenTcp.3 1.16 96/03/17 09:51:18
+'\" SCCS: @(#) OpenTcp.3 1.19 97/06/25 14:44:00
 .so man.macros
-.TH Tcl_OpenTcpClient 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-Tcl_OpenTcpClient, Tcl_OpenTcpServer \- procedures to open channels using TCP sockets
+Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer \- procedures to open channels using TCP sockets
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h> \fR
@@ -92,11 +92,23 @@ NULL and records a POSIX error code that can be retrieved
 with \fBTcl_GetErrno\fR.
 In addition, if \fIinterp\fR is non-NULL, an error message
 is left in \fIinterp->result\fR.
+.PP
+The newly created channel is not registered in the supplied interpreter; to
+register it, use \fBTcl_RegisterChannel\fR.
+If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+previously closed, the act of creating the new channel also assigns it as a
+replacement for the standard channel.
 
 .SH TCL_MAKETCPCLIENTCHANNEL
 .PP
 \fBTcl_MakeTcpClientChannel\fR creates a \fBTcl_Channel\fR around an
 existing, platform specific, handle for a client TCP socket.
+.PP
+The newly created channel is not registered in the supplied interpreter; to
+register it, use \fBTcl_RegisterChannel\fR.
+If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+previously closed, the act of creating the new channel also assigns it as a
+replacement for the standard channel.
 
 .SH TCL_OPENTCPSERVER
 .PP
@@ -144,9 +156,24 @@ TCP server channels operate correctly only in applications that dispatch
 events through \fBTcl_DoOneEvent\fR or through Tcl commands such as
 \fBvwait\fR; otherwise Tcl will never notice that a connection request from
 a remote client is pending.
+.PP
+The newly created channel is not registered in the supplied interpreter; to
+register it, use \fBTcl_RegisterChannel\fR.
+If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+previously closed, the act of creating the new channel also assigns it as a
+replacement for the standard channel.
+
+.VS
+.SH "PLATFORM ISSUES"
+.PP
+On Unix platforms, the socket handle is a Unix file descriptor as
+returned by the \fBsocket\fR system call.  On the Windows platform, the
+socket handle is a \fBSOCKET\fR as defined in the WinSock API.  On the
+Macintosh platform, the socket handle is a \fBStreamPtr\fR.
+.VE
 
 .SH "SEE ALSO"
-Tcl_OpenFileChannel(3), vwait(n)
+Tcl_OpenFileChannel(3), Tcl_RegisterChannel(3), vwait(n)
 
 .SH KEYWORDS
 client, server, TCP
diff --git a/contrib/tcl/doc/PrintDbl.3 b/contrib/tcl/doc/PrintDbl.3
index 413e2b7..e4a4c7e 100644
--- a/contrib/tcl/doc/PrintDbl.3
+++ b/contrib/tcl/doc/PrintDbl.3
@@ -1,14 +1,14 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) PrintDbl.3 1.6 96/03/25 20:05:45
+'\" SCCS: @(#) PrintDbl.3 1.8 97/02/18 16:34:51
 '\" 
 .so man.macros
-.TH Tcl_PrintDouble 3 7.0 Tcl "Tcl Library Procedures"
+.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
 Tcl_PrintDouble \- Convert floating value to string
@@ -20,7 +20,11 @@ Tcl_PrintDouble \- Convert floating value to string
 .SH ARGUMENTS
 .AS Tcl_Interp *interp
 .AP Tcl_Interp *interp in
-Interpreter that controls the conversion.
+.VS
+Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter
+controlled the conversion.  As of Tcl 8.0, this argument is ignored and
+17 digits of precision are always used for conversion.
+.VE
 .AP double value in
 Floating-point value to be converted.
 .AP char *dst out
@@ -32,14 +36,11 @@ least TCL_DOUBLE_SPACE characters of storage.
 .PP
 \fBTcl_PrintDouble\fR generates a string that represents the value
 of \fIvalue\fR and stores it in memory at the location given by
-\fIdst\fR.  It uses %g format to generate the string, with two
-special twists.  First, the string is guaranteed to contain either
-a ``.'' or an ``e'' so that it doesn't look like an integer (where
-%g would generate an integer with no decimal point, \fBTcl_PrintDouble\fR
-adds ``.0'').  Second, the number of significant digits printed at
-\fIdst\fR is controlled by the \fBtcl_precision\fR variable in
-\fIinterp\fR;  if \fBtcl_precision\fR is undefined then 6 significant
-digits are printed.
+\fIdst\fR.  It uses \fB%g\fR format to generate the string, with one
+special twist: the string is guaranteed to contain either
+a ``.'' or an ``e'' so that it doesn't look like an integer.  Where
+\fB%g\fR would generate an integer with no decimal point, \fBTcl_PrintDouble\fR
+adds ``.0''.
 
 .SH KEYWORDS
 conversion, double-precision, floating-point, string
diff --git a/contrib/tcl/doc/RecordEval.3 b/contrib/tcl/doc/RecordEval.3
index 36567d9..6e6fb27 100644
--- a/contrib/tcl/doc/RecordEval.3
+++ b/contrib/tcl/doc/RecordEval.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) RecordEval.3 1.16 96/03/25 20:06:06
+'\" SCCS: @(#) RecordEval.3 1.17 96/08/26 12:59:47
 '\" 
 .so man.macros
 .TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures"
@@ -25,20 +25,16 @@ Tcl interpreter in which to evaluate command.
 .AP char *cmd in
 Command (or sequence of commands) to execute.
 .AP int flags in
-.VS
 An OR'ed combination of flag bits.  TCL_NO_EVAL means record the
 command but don't evaluate it.  TCL_EVAL_GLOBAL means evaluate
 the command at global level instead of the current stack level.
-.VE
 .BE
 
 .SH DESCRIPTION
 .PP
 \fBTcl_RecordAndEval\fR is invoked to record a command as an event
 on the history list and then execute it using \fBTcl_Eval\fR
-.VS
 (or \fBTcl_GlobalEval\fR if the TCL_EVAL_GLOBAL bit is set in \fIflags\fR).
-.VE
 It returns a completion code such as TCL_OK just like \fBTcl_Eval\fR
 and it leaves information in \fIinterp->result\fR.
 If you don't want the command recorded on the history list then
diff --git a/contrib/tcl/doc/RegExp.3 b/contrib/tcl/doc/RegExp.3
index eea3f42..fef9245 100644
--- a/contrib/tcl/doc/RegExp.3
+++ b/contrib/tcl/doc/RegExp.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) RegExp.3 1.8 96/02/15 20:01:42
+'\" SCCS: @(#) RegExp.3 1.9 96/08/26 12:59:48
 '\" 
 .so man.macros
 .TH Tcl_RegExpMatch 3 7.4 Tcl "Tcl Library Procedures"
@@ -19,7 +19,6 @@ Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern m
 int
 \fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR)
 .sp
-.VS
 Tcl_RegExp
 \fBTcl_RegExpCompile\fR(\fIinterp\fR, \fIpattern\fR)
 .sp
@@ -27,7 +26,6 @@ int
 \fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fIstring\fR, \fIstart\fR)
 .sp
 \fBTcl_RegExpRange\fR(\fIregexp\fR, \fIindex\fR, \fIstartPtr\fR, \fIendPtr\fR)
-.VE
 .SH ARGUMENTS
 .AS Tcl_Interp *interp
 .AP Tcl_Interp *interp in
@@ -37,7 +35,6 @@ String to check for a match with a regular expression.
 .AP char *pattern in
 String in the form of a regular expression pattern.
 .AP Tcl_RegExp regexp in
-.VS
 Compiled regular expression.  Must have been returned previously
 by \fBTcl_RegExpCompile\fR.
 .AP char *start in
@@ -55,7 +52,6 @@ NULL if there is no such range.
 .AP char **endPtr out
 The address of the character just after the last one in the range
 is stored here, or NULL if there is no such range.
-.VE
 .BE
 
 .SH DESCRIPTION
@@ -70,7 +66,6 @@ If an error occurs in the matching process (e.g. \fIpattern\fR
 is not a valid regular expression) then \fBTcl_RegExpMatch\fR
 returns \-1 and leaves an error message in \fIinterp->result\fR.
 .PP
-.VS
 \fBTcl_RegExpCompile\fR, \fBTcl_RegExpExec\fR, and \fBTcl_RegExpRange\fR
 provide lower-level access to the regular expression pattern matcher.
 \fBTcl_RegExpCompile\fR compiles a regular expression string into
@@ -80,11 +75,9 @@ used in subsequent calls to \fBTcl_RegExpExec\fR or \fBTcl_RegExpRange\fR.
 If an error occurs while compiling the regular expression then
 \fBTcl_RegExpCompile\fR returns NULL and leaves an error message
 in \fIinterp->result\fR.
-.VS
 Note:  the return value from \fBTcl_RegExpCompile\fR is only valid
 up to the next call to \fBTcl_RegExpCompile\fR;  it is not safe to
 retain these values for long periods of time.
-.VE
 .PP
 \fBTcl_RegExpExec\fR executes the regular expression pattern matcher.
 It returns 1 if \fIstring\fR contains a range of characters that
@@ -118,7 +111,6 @@ information is returned about the range of characters that matched the
 \fIindex\fR'th parenthesized subexpression within the pattern.
 If there is no range corresponding to \fIindex\fR then NULL
 is stored in \fI*firstPtr\fR and \fI*lastPtr\fR.
-.VE
 
 .SH KEYWORDS
 match, pattern, regular expression, string, subexpression
diff --git a/contrib/tcl/doc/SetResult.3 b/contrib/tcl/doc/SetResult.3
index b70977d..5616de8 100644
--- a/contrib/tcl/doc/SetResult.3
+++ b/contrib/tcl/doc/SetResult.3
@@ -1,28 +1,34 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) SetResult.3 1.19 96/06/05 18:00:15
+'\" SCCS: @(#) SetResult.3 1.23 97/06/26 14:05:57
 '\" 
 .so man.macros
 .TH Tcl_SetResult 3 7.5 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_SetResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult \- manipulate Tcl result string
+Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult \- manipulate Tcl result
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
+\fBTcl_SetObjResult\fR(\fIinterp, objPtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_GetObjResult\fR(\fIinterp\fR)
+.sp
 \fBTcl_SetResult\fR(\fIinterp, string, freeProc\fR)
 .sp
-\fBTcl_AppendResult(\fIinterp, string, string, ... , \fB(char *) NULL\fR)
+char *
+\fBTcl_GetStringResult\fR(\fIinterp\fR)
+.sp
+\fBTcl_AppendResult\fR(\fIinterp, string, string, ... , \fB(char *) NULL\fR)
 .sp
-.VS
 \fBTcl_AppendElement\fR(\fIinterp, string\fR)
-.VE
 .sp
 \fBTcl_ResetResult\fR(\fIinterp\fR)
 .sp
@@ -30,10 +36,12 @@ Tcl_SetResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult \- manipulat
 .SH ARGUMENTS
 .AS Tcl_FreeProc freeProc
 .AP Tcl_Interp *interp out
-Interpreter whose result is to be modified.
+Interpreter whose result is to be modified or read.
+.AP Tcl_Obj *objPtr in
+Object value to become result for \fIinterp\fR.
 .AP char *string in
 String value to become result for \fIinterp\fR or to be
-appended to existing result.
+appended to the existing result.
 .AP Tcl_FreeProc *freeProc in
 Address of procedure to call to release storage at
 \fIstring\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or
@@ -42,51 +50,75 @@ Address of procedure to call to release storage at
 
 .SH DESCRIPTION
 .PP
-The procedures described here are utilities for setting the
-result/error string in a Tcl interpreter.
+The procedures described here are utilities for manipulating the
+result value in a Tcl interpreter.
+The interpreter result may be either a Tcl object or a string.
+For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR
+set the interpreter result to, respectively, an object and a string.
+Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR
+return the interpreter result as an object and as a string.
+The procedures always keep the string and object forms
+of the interpreter result consistent.
+For example, if \fBTcl_SetObjResult\fR is called to set
+the result to an object,
+then \fBTcl_GetStringResult\fR is called,
+it will return the object's string value.
 .PP
-\fBTcl_SetResult\fR
-arranges for \fIstring\fR to be the return string for the current Tcl
-command in \fIinterp\fR, replacing any existing result.
-If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIstring\fR
-refers to an area of static storage that is guaranteed not to be
-modified until at least the next call to \fBTcl_Eval\fR.
-.VS
-If \fIfreeProc\fR
-is \fBTCL_DYNAMIC\fR it means that \fIstring\fR was allocated with a call
-to \fBTcl_Alloc\fR and is now the property of the Tcl system.
-\fBTcl_SetResult\fR will arrange for the string's storage to be
-released by calling \fBTcl_Free\fR when it is no longer needed.
-.VE
-If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIstring\fR
-points to an area of memory that is likely to be overwritten when
-\fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame).
-In this case \fBTcl_SetResult\fR will make a copy of the string in
-dynamically allocated storage and arrange for the copy to be the
-return string for the current Tcl command.
+\fBTcl_SetObjResult\fR
+arranges for \fIobjPtr\fR to be the result for \fIinterp\fR,
+replacing any existing result.
+The result is left pointing to the object
+referenced by \fIobjPtr\fR.
+\fIobjPtr\fR's reference count is incremented
+since there is now a new reference to it from \fIinterp\fR.
+The reference count for any old result object
+is decremented and the old result object is freed if no
+references to it remain.
 .PP
-If \fIfreeProc\fR isn't one of the values \fBTCL_STATIC\fR,
-\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address
-of a procedure that Tcl should call to free the string.
-This allows applications to use non-standard storage allocators.
-When Tcl no longer needs the storage for the string, it will
-call \fIfreeProc\fR.  \fIFreeProc\fR should have arguments and
-result that match the type \fBTcl_FreeProc\fR:
-.CS
-typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
-.CE
-When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
-the value of \fIstring\fR passed to \fBTcl_SetResult\fR.
+\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as an object.
+The object's reference count is not incremented;
+if the caller needs to retain a long-term pointer to the object
+they should use \fBTcl_IncrRefCount\fR to increment its reference count
+in order to keep it from being freed too early or accidently changed.
 .PP
+\fBTcl_SetResult\fR
+arranges for \fIstring\fR to be the result for the current Tcl
+command in \fIinterp\fR, replacing any existing result.
+The \fIfreeProc\fR argument specifies how to manage the storage
+for the \fIstring\fR argument;
+it is discussed in the section
+\fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below.
 If \fIstring\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored
 and \fBTcl_SetResult\fR
-re-initializes \fIinterp\fR's result to point to the pre-allocated result
-area, with an empty string in the result area.
+re-initializes \fIinterp\fR's result to point to an empty string.
+.PP
+\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as an string.
+If the result was set to an object by a \fBTcl_SetObjResult\fR call,
+the object form will be converted to a string and returned.
+If the object's string representation contains null bytes,
+this conversion will lose information.
+For this reason, programmers are encouraged to
+write their code to use the new object API procedures
+and to call \fBTcl_GetObjResult\fR instead.
 .PP
-If \fBTcl_SetResult\fR is called at a time when \fIinterp\fR holds a
-result, \fBTcl_SetResult\fR does whatever is necessary to dispose
-of the old result (see the \fBTcl_Interp\fR manual entry for details
-on this).
+\fBTcl_ResetResult\fR clears the result for \fIinterp\fR
+and leaves the result in its normal empty initialized state.
+If the result is an object,
+its reference count is decremented and the result is left
+pointing to an unshared object representing an empty string.
+If the result is a dynamically allocated string, its memory is free*d
+and the result is left as a empty string.
+\fBTcl_ResetResult\fR also clears the error state managed by
+\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR,
+and \fBTcl_SetErrorCode\fR.
+
+.SH OLD STRING PROCEDURES
+.PP
+Use of the following procedures is deprecated
+since they manipulate the Tcl result as a string.
+Procedures such as \fBTcl_SetObjResult\fR
+that manipulate the result as an object
+can be significantly more efficient.
 .PP
 \fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces.
 It takes each of its \fIstring\fR arguments and appends them in order
@@ -100,8 +132,10 @@ of the result are produced.
 \fBTcl_AppendResult\fR takes care of all the
 storage management issues associated with managing \fIinterp\fR's
 result, such as allocating a larger result area if necessary.
+It also converts the current interpreter result from an object
+to a string, if necessary, before appending the argument strings.
 Any number of \fIstring\fR arguments may be passed in a single
-call;  the last argument in the list must be a NULL pointer.
+call; the last argument in the list must be a NULL pointer.
 .PP
 \fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
 that it allows results to be built up in pieces.
@@ -115,33 +149,69 @@ Under normal conditions, \fBTcl_AppendElement\fR will add a space
 character to \fIinterp\fR's result just before adding the new
 list element, so that the list elements in the result are properly
 separated.
-.VS
 However if the new list element is the first in a list or sub-list
 (i.e. \fIinterp\fR's current result is empty, or consists of the
 single character ``{'', or ends in the characters `` {'') then no
 space is added.
-.VE
-.PP
-\fBTcl_ResetResult\fR clears the result for \fIinterp\fR,
-freeing the memory associated with it if the current result was
-dynamically allocated.
-It leaves the result in its normal initialized state with
-\fIinterp->result\fR pointing to a static buffer containing
-\fBTCL_RESULT_SIZE\fR characters, of which the first character
-is zero.
-\fBTcl_ResetResult\fR also clears the error state managed by
-\fBTcl_AddErrorInfo\fR and \fBTcl_SetErrorCode\fR.
 .PP
-\fBTcl_FreeResult\fR is a macro that performs part of the work
+\fBTcl_FreeResult\fR performs part of the work
 of \fBTcl_ResetResult\fR.
-It frees up the memory associated with \fIinterp\fR's result
-and sets \fIinterp->freeProc\fR to zero, but it doesn't
+It frees up the memory associated with \fIinterp\fR's result.
+It also sets \fIinterp->freeProc\fR to zero, but doesn't
 change \fIinterp->result\fR or clear error state.
 \fBTcl_FreeResult\fR is most commonly used when a procedure
 is about to replace one result value with another.
 
+.SH DIRECT ACCESS TO INTERP->RESULT IS DEPRECATED
+.PP
+It used to be legal for programs to
+directly read and write \fIinterp->result\fR
+to manipulate the interpreter result.
+Direct access to \fIinterp->result\fR is now strongly deprecated
+because it can make the result's string and object forms inconsistent.
+Programs should always read the result
+using the procedures \fBTcl_GetObjResult\fR or \fBTcl_GetStringResult\fR,
+and write the result using \fBTcl_SetObjResult\fR or \fBTcl_SetResult\fR.
+
+.SH THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT
+.PP
+\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how 
+the Tcl system is to manage the storage for the \fIstring\fR argument.
+If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called
+at a time when \fIinterp\fR holds a string result,
+they do whatever is necessary to dispose of the old string result
+(see the \fBTcl_Interp\fR manual entry for details on this).
+.PP
+If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIstring\fR
+refers to an area of static storage that is guaranteed not to be
+modified until at least the next call to \fBTcl_Eval\fR.
+If \fIfreeProc\fR
+is \fBTCL_DYNAMIC\fR it means that \fIstring\fR was allocated with a call
+to \fBTcl_Alloc\fR and is now the property of the Tcl system.
+\fBTcl_SetResult\fR will arrange for the string's storage to be
+released by calling \fBTcl_Free\fR when it is no longer needed.
+If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIstring\fR
+points to an area of memory that is likely to be overwritten when
+\fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame).
+In this case \fBTcl_SetResult\fR will make a copy of the string in
+dynamically allocated storage and arrange for the copy to be the
+result for the current Tcl command.
+.PP
+If \fIfreeProc\fR isn't one of the values \fBTCL_STATIC\fR,
+\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address
+of a procedure that Tcl should call to free the string.
+This allows applications to use non-standard storage allocators.
+When Tcl no longer needs the storage for the string, it will
+call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and
+result that match the type \fBTcl_FreeProc\fR:
+.CS
+typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+.CE
+When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
+the value of \fIstring\fR passed to \fBTcl_SetResult\fR.
+
 .SH "SEE ALSO"
-Tcl_AddErrorInfo, Tcl_SetErrorCode, Tcl_Interp
+Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp
 
 .SH KEYWORDS
-append, command, element, list, result, return value, interpreter
+append, command, element, list, object, result, return value, interpreter
diff --git a/contrib/tcl/doc/SetVar.3 b/contrib/tcl/doc/SetVar.3
index 8d1696f..10850ae 100644
--- a/contrib/tcl/doc/SetVar.3
+++ b/contrib/tcl/doc/SetVar.3
@@ -1,11 +1,11 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) SetVar.3 1.22 96/03/25 20:07:08
+'\" SCCS: @(#) SetVar.3 1.29 97/05/19 17:35:05
 '\" 
 .so man.macros
 .TH Tcl_SetVar 3 7.4 Tcl "Tcl Library Procedures"
@@ -38,13 +38,14 @@ int
 .AP Tcl_Interp *interp in
 Interpreter containing variable.
 .AP char *varName in
-Name of variable.  May refer to a scalar variable or an element of
+Name of variable.
+May include a series of \fB::\fR namespace qualifiers
+to specify a variable in a particular namespace.
+May refer to a scalar variable or an element of
 an array variable.
-.VS
 If the name references an element of an array, then it
 must be in writable memory:  Tcl will make temporary modifications 
 to it while looking up the name.
-.VE
 .AP char *newValue in
 New value for variable.
 .AP int flags in
@@ -53,6 +54,8 @@ operation. See below for valid values.
 .AP char *name1 in
 Name of scalar variable, or name of array variable if \fIname2\fR
 is non-NULL.
+May include a series of \fB::\fR namespace qualifiers
+to specify a variable in a particular namespace.
 .AP char *name2 in
 If non-NULL, gives name of element within array and \fIname1\fR
 must refer to an array variable.
@@ -62,8 +65,19 @@ must refer to an array variable.
 .PP
 These procedures may be used to create, modify, read, and delete
 Tcl variables from C code.
-\fBTcl_SetVar\fR and \fBTcl_SetVar2\fR will create a new variable
-or modify an existing one.
+.PP
+Note that \fBTcl_GetVar\fR and \fBTcl_SetVar\fR
+have been largely replaced by the
+object-based procedures \fBTcl_ObjGetVar2\fR and \fBTcl_ObjSetVar2\fR.
+Those object-based procedures read, modify, and create
+a variable whose name is held in a Tcl object instead of a string.
+They also return a pointer to the object
+which is the variable's value instead of returning a string.
+Operations on objects can be faster since objects
+hold an internal representation that can be manipulated more efficiently.
+.PP
+\fBTcl_SetVar\fR and \fBTcl_SetVar2\fR
+will create a new variable or modify an existing one.
 Both of these procedures set the given variable to the value
 given by \fInewValue\fR, and they return a pointer to a
 copy of the variable's new value, which is stored in Tcl's
@@ -73,9 +87,10 @@ may change \fInewValue\fR after these procedures return without
 affecting the value of the variable.
 If an error occurs in setting the variable (e.g. an array
 variable is referenced without giving an index into the array),
-then NULL is returned.
+they return NULL.
 .PP
-The name of the variable may be specified in either of two ways.
+The name of the variable may be specified to
+\fBTcl_SetVar\fR and \fBTcl_SetVar2\fR in either of two ways.
 If \fBTcl_SetVar\fR is called, the variable name is given as
 a single string, \fIvarName\fR.
 If \fIvarName\fR contains an open parenthesis and ends with a
@@ -96,18 +111,34 @@ It consists of an OR-ed combination of any of the following
 bits:
 .TP
 \fBTCL_GLOBAL_ONLY\fR
-Under normal circumstances the procedures look up variables
-at the current level of procedure call for \fIinterp\fR, or
-at global level if there is no call active.
+Under normal circumstances the procedures look up variables as follows:
+If a procedure call is active in \fIinterp\fR,
+a variable is looked up at the current level of procedure call.
+Otherwise, a variable is looked up first in the current namespace,
+then in the global namespace.
+However, if this bit is set in \fIflags\fR then the variable
+is looked up only in the global namespace
+even if there is a procedure call active.
+If both \fBTCL_GLOBAL_ONLY\fR and \fBTCL_NAMESPACE_ONLY\fR are given,
+\fBTCL_GLOBAL_ONLY\fR is ignored.
+.TP
+\fBTCL_NAMESPACE_ONLY\fR
+Under normal circumstances the procedures look up variables as follows:
+If a procedure call is active in \fIinterp\fR,
+a variable is looked up at the current level of procedure call.
+Otherwise, a variable is looked up first in the current namespace,
+then in the global namespace.
 However, if this bit is set in \fIflags\fR then the variable
-is looked up at global level even if there is a procedure
-call active.
+is looked up only in the current namespace
+even if there is a procedure call active.
 .TP
 \fBTCL_LEAVE_ERR_MSG\fR
 If an error is returned and this bit is set in \fIflags\fR, then
-an error message will be left in \fI\%interp->result\fR.  If this
-flag bit isn't set then no error message is left (\fI\%interp->result\fR
-will not be modified).
+an error message will be left in the interpreter's result,
+where it can be retrieved with \fBTcl_GetObjResult\fR
+or \fBTcl_GetStringResult\fR.
+If this flag bit isn't set then no error message is left
+and the interpreter's result will not be modified.
 .TP
 \fBTCL_APPEND_VALUE\fR
 If this bit is set then \fInewValue\fR is appended to the current
@@ -118,14 +149,12 @@ If the variable is currently undefined, then this bit is ignored.
 If this bit is set, then \fInewValue\fR is converted to a valid
 Tcl list element before setting (or appending to) the variable.
 A separator space is appended before the new list element unless
-.VS
 the list element is going to be the first element in a list or
 sublist (i.e. the variable's current value is empty, or contains
 the single character ``{'', or ends in `` }'').
-.VE
 .PP
-\fBTcl_GetVar\fR and \fBTcl_GetVar2\fR return the current value
-of a variable.
+\fBTcl_GetVar\fR and \fBTcl_GetVar2\fR
+return the current value of a variable.
 The arguments to these procedures are treated in the same way
 as the arguments to \fBTcl_SetVar\fR and \fBTcl_SetVar2\fR.
 Under normal circumstances, the return value is a pointer
@@ -145,18 +174,16 @@ a variable, so that future calls to \fBTcl_GetVar\fR or \fBTcl_GetVar2\fR
 for the variable will return an error.
 The arguments to these procedures are treated in the same way
 as the arguments to \fBTcl_GetVar\fR and \fBTcl_GetVar2\fR.
-.VS
 If the variable is successfully removed then TCL_OK is returned.
 If the variable cannot be removed because it doesn't exist then
 TCL_ERROR is returned.
-.VE
 If an array element is specified, the given element is removed
 but the array remains.
 If an array name is specified without an index, then the entire
 array is removed.
 
 .SH "SEE ALSO"
-Tcl_TraceVar
+Tcl_GetObjResult, Tcl_GetStringResult, Tcl_ObjGetVar2, Tcl_ObjSetVar2, Tcl_TraceVar
 
 .SH KEYWORDS
-array, interpreter, scalar, set, unset, variable
+array, interpreter, object, scalar, set, unset, variable
diff --git a/contrib/tcl/doc/SplitList.3 b/contrib/tcl/doc/SplitList.3
index a136450..a250c8f 100644
--- a/contrib/tcl/doc/SplitList.3
+++ b/contrib/tcl/doc/SplitList.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) SplitList.3 1.20 96/06/05 18:00:16
+'\" SCCS: @(#) SplitList.3 1.21 97/04/29 14:07:10
 '\" 
 .so man.macros
 .TH Tcl_SplitList 3 7.5 Tcl "Tcl Library Procedures"
@@ -24,9 +24,19 @@ char *
 .sp
 int
 \fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
+.VS
+.sp
+int
+\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
+.VE
 .sp
 int
 \fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
+.VS
+.sp
+int
+\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
+.VE
 .SH ARGUMENTS
 .AS Tcl_Interp ***argvPtr
 .AP Tcl_Interp *interp out
@@ -53,6 +63,10 @@ String that is to become an element of a list.
 .AP int *flagsPtr in
 Pointer to word to fill in with information about \fIsrc\fR.
 The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
+.VS
+.AP int length in
+Number of bytes in string \fIsrc\fR.
+.VE
 .AP char *dst in
 Place to copy converted list element.  Must contain enough characters
 to hold converted string.
@@ -165,6 +179,13 @@ special situations, such as when \fBTcl_ConvertElement\fR is being
 used to generate a portion of an argument for a Tcl command.
 In this case, surrounding \fIsrc\fR with curly braces would cause
 the command not to be parsed correctly.
+.PP
+.VS
+\fBTcl_ScanCountedElement\fR and \fBTcl_ConvertCountedElement\fR are
+the same as \fBTcl_ScanElement\fR and \fBTcl_ConvertElement\fR, except
+the length of string \fIsrc\fR is specified by the \fIlength\fR
+argument, and the string may contain embedded nulls.
+.VE
 
 .SH KEYWORDS
 backslash, convert, element, list, merge, split, strings
diff --git a/contrib/tcl/doc/SplitPath.3 b/contrib/tcl/doc/SplitPath.3
index abfffb5..f98a78b 100644
--- a/contrib/tcl/doc/SplitPath.3
+++ b/contrib/tcl/doc/SplitPath.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) SplitPath.3 1.3 96/07/31 17:04:33
+'\" SCCS: @(#) SplitPath.3 1.4 96/08/19 14:59:35
 '\" 
 .so man.macros
 .TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures"
@@ -59,11 +59,11 @@ responsibility to free all of this storage.
 For example, suppose that you have called \fBTcl_SplitPath\fR with the
 following code:
 .CS
-int argc, code;
+int argc;
 char *path;
 char **argv;
 \&...
-code = Tcl_SplitPath(interp, string, &argc, &argv);
+Tcl_SplitPath(string, &argc, &argv);
 .CE
 Then you should eventually free the storage with a call like the
 following:
diff --git a/contrib/tcl/doc/StaticPkg.3 b/contrib/tcl/doc/StaticPkg.3
index 729e91c..ccb1a69 100644
--- a/contrib/tcl/doc/StaticPkg.3
+++ b/contrib/tcl/doc/StaticPkg.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) StaticPkg.3 1.3 96/03/15 08:29:37
+'\" SCCS: @(#) StaticPkg.3 1.4 96/09/04 11:21:26
 '\" 
 .so man.macros
 .TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
@@ -38,12 +38,15 @@ can't be used in safe interpreters.
 .SH DESCRIPTION
 .PP
 This procedure may be invoked to announce that a package has been
-linked statically with a Tcl application and,  optionally, that it
+linked statically with a Tcl application and, optionally, that it
 has already been loaded into an interpreter.
-\fBTcl_StaticPackage\fR is typically invoked by the \fBTcl_AppInit\fR
-procedure for the application.
 Once \fBTcl_StaticPackage\fR has been invoked for a package, it
 may be loaded into interpreters using the \fBload\fR command.
+\fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR
+procedure for the application, not by packages for themselves
+(\fBTcl_StaticPackage\fR should only be invoked for statically
+loaded packages, and code in the package itself should not need
+to know whether the package is dynamically or statically loaded).
 .PP
 When the \fBload\fR command is used later to load the package into
 an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
diff --git a/contrib/tcl/doc/StringObj.3 b/contrib/tcl/doc/StringObj.3
new file mode 100644
index 0000000..a98fc46
--- /dev/null
+++ b/contrib/tcl/doc/StringObj.3
@@ -0,0 +1,132 @@
+'\"
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) StringObj.3 1.13 97/06/25 13:40:25
+'\" 
+.so man.macros
+.TH Tcl_StringObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_NewStringObj, Tcl_SetStringObj, Tcl_GetStringFromObj, Tcl_AppendToObj, Tcl_AppendStringsToObj, Tcl_SetObjLength, TclConcatObj \- manipulate Tcl objects as strings
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
+.sp
+\fBTcl_SetStringObj\fR(\fIobjPtr, bytes, length\fR)
+.sp
+char *
+\fBTcl_GetStringFromObj\fR(\fIobjPtr, lengthPtr\fR)
+.sp
+\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)
+.sp
+\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
+.sp
+\fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *lengthPtr out
+.AP char *bytes in
+Points to the first byte of an array of bytes
+used to set or append to a string object.
+This byte array may contain embedded null bytes
+unless \fIlength\fR is negative.
+.AP int length in
+The number of bytes to copy from \fIbytes\fR when
+initializing, setting, or appending to a string object.
+If negative, all bytes up to the first null are used.
+.AP Tcl_Obj *objPtr in/out
+Points to an object to manipulate.
+.AP int *lengthPtr out
+If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
+the the length of an object's string representation.
+.AP char *string in
+Null-terminated string value to append to \fIobjPtr\fR.
+.AP int newLength in
+New length for the string value of \fIobjPtr\fR, not including the
+final NULL character.
+.AP int objc in
+The number of elements to concatenate.
+.AP Tcl_Obj *objv[] in
+The array of objects to concatenate.
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedures described in this manual entry allow Tcl objects to
+be manipulated as string values.  They use the internal representation
+of the object to store additional information to make the string
+manipulations more efficient.  In particular, they make a series of
+append operations efficient by allocating extra storage space for the
+string so that it doesn't have to be copied for each append.
+.PP
+\fBTcl_NewStringObj\fR and \fBTcl_SetStringObj\fR create a new object
+or modify an existing object to hold a copy of
+the string given by \fIbytes\fR and \fIlength\fR.
+\fBTcl_NewStringObj\fR returns a pointer to a newly created object
+with reference count zero.
+Both procedures set the object to hold a copy of the specified string.
+\fBTcl_SetStringObj\fR frees any old string representation
+as well as any old internal representation of the object.
+.PP
+\fBTcl_GetStringFromObj\fR returns an object's string representation.
+This is given by the returned byte pointer
+and length, which is stored in \fIlengthPtr\fR if it is non-NULL.
+If the object's string representation is invalid
+(its byte pointer is NULL),
+the string representation is regenerated from the
+object's internal representation.
+The storage referenced by the returned byte pointer
+is owned by the object manager and should not be modified by the caller.
+.PP
+\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
+\fIlength\fR to the object specified by \fIobjPtr\fR.  It does this
+in a way that handles repeated calls relatively efficiently (it
+overallocates the string space to avoid repeated reallocations
+and copies of object's string value).
+.PP
+\fBTcl_AppendStringsToObj\fR is similar to \fBTcl_AppendToObj\fR
+except that it can be passed more than one value to append and
+each value must be a null-terminated string (i.e. none of the
+values may contain internal null characters).  Any number of
+\fIstring\fR arguments may be provided, but the last argument
+must be a NULL pointer to indicate the end of the list.
+.PP
+The \fBTcl_SetObjLength\fR procedure changes the length of the
+string value of its \fIobjPtr\fR argument.  If the \fInewLength\fR
+argument is greater than the space allocated for the object's
+string, then the string space is reallocated and the old value
+is copied to the new space; the bytes between the old length of
+the string and the new length may have arbitrary values.
+If the \fInewLength\fR argument is less than the current length
+of the object's string, with \fIobjPtr->length\fR is reduced without
+reallocating the string space; the original allocated size for the
+string is recorded in the object, so that the string length can be
+enlarged in a subsequent call to \fBTcl_SetObjLength\fR without
+reallocating storage.  In all cases \fBTcl_SetObjLength\fR leaves
+a null character at \fIobjPtr->bytes[newLength]\fR.
+.PP
+The \fBTcl_ConcatObj\fR function returns a new string object whose
+value is the space-separated concatenation of the string
+representations of all of the objects in the \fIobjv\fR
+array. \fBTcl_ConcatObj\fR eliminates leading and trailing white space
+as it copies the string representations of the \fIobjv\fR array to the
+result. If an element of the \fIobjv\fR array consists of nothing but
+white space, then that object is ignored entirely. This white-space
+removal was added to make the output of the \fBconcat\fR command
+cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
+newly-created object whose ref count is zero.
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
+
+.SH KEYWORDS
+append, internal representation, object, object type, string object,
+string type, string representation, concat, concatenate
diff --git a/contrib/tcl/doc/Tcl.n b/contrib/tcl/doc/Tcl.n
index d0b60e5..610fe1b 100644
--- a/contrib/tcl/doc/Tcl.n
+++ b/contrib/tcl/doc/Tcl.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Tcl.n 1.127 96/03/25 20:08:20
+'\" SCCS: @(#) Tcl.n 1.128 96/08/26 12:59:50
 '
 .so man.macros
 .TH Tcl n "" Tcl "Tcl Built-In Commands"
@@ -102,22 +102,18 @@ Variable substitution is not performed on words enclosed in braces.
 .IP [8]
 If a backslash (``\e'') appears within a word then
 \fIbackslash substitution\fR occurs.
-.VS
 In all cases but those described below the backslash is dropped and
 the following character is treated as an ordinary
 character and included in the word.
-.VE
 This allows characters such as double quotes, close brackets,
 and dollar signs to be included in words without triggering
 special processing.
 The following table lists the backslash sequences that are
 handled specially, along with the value that replaces each sequence.
 .RS
-.VS
 .TP 6
 \e\fBa\fR
 Audible alert (bell) (0x7).
-.VE
 .TP 6
 \e\fBb\fR
 Backspace (0x8).
@@ -138,7 +134,6 @@ Tab (0x9).
 Vertical tab (0xb).
 .TP 6
 \e\fB<newline>\fIwhiteSpace\fR
-.VS
 A single space character replaces the backslash, newline, and all
 spaces and tabs after the newline.
 This backslash sequence is unique in that it is replaced in a separate
@@ -146,7 +141,6 @@ pre-pass before the command is actually parsed.
 This means that it will be replaced even when it occurs between
 braces, and the resulting space will be treated as a word separator
 if it isn't in braces or quotes.
-.VE
 .TP 6
 \e\e
 Backslash (``\e'').
@@ -156,10 +150,8 @@ The digits \fIooo\fR (one, two, or three of them) give the octal value of
 the character.
 .TP 6
 \e\fBx\fIhh\fR
-.VS
 The hexadecimal digits \fIhh\fR give the hexadecimal value of
 the character.  Any number of digits may be present.
-.VE
 .LP
 Backslash substitution is not performed on words enclosed in braces,
 except for backslash-newline as described above.
diff --git a/contrib/tcl/doc/TraceVar.3 b/contrib/tcl/doc/TraceVar.3
index ecfdc3e..665a3a7 100644
--- a/contrib/tcl/doc/TraceVar.3
+++ b/contrib/tcl/doc/TraceVar.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) TraceVar.3 1.25 96/03/25 20:08:44
+'\" SCCS: @(#) TraceVar.3 1.26 96/08/26 12:59:52
 '\" 
 .so man.macros
 .TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
@@ -39,11 +39,9 @@ Interpreter containing variable.
 Name of variable.  May refer to a scalar variable, to
 an array variable with no index, or to an array variable
 with a parenthesized index.
-.VS
 If the name references an element of an array, then it
 must be in writable memory:  Tcl will make temporary modifications 
 to it while looking up the name.
-.VE
 .AP int flags in
 OR-ed combination of the values TCL_TRACE_READS, TCL_TRACE_WRITES, and
 TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY.  Not all flags are used by all
@@ -195,10 +193,8 @@ for the variable, so that calls to \fBTcl_GetVar2\fR and
 to be invoked again.
 Disabling only occurs for the variable whose trace procedure
 is active;  accesses to other variables will still be traced.
-.VS
 However, if a variable is unset during a read or write trace then unset
 traces will be invoked.
-.VE
 .PP
 During unset traces the variable has already been completely
 expunged.
@@ -222,10 +218,8 @@ and \fBTcl_GetVar2\fR procedures.
 returned.
 It may modify the value of the variable to affect what
 is returned by the traced access.
-.VS
 If it unsets the variable then the access will return an error
 just as if the variable never existed.
-.VE
 .PP
 When write tracing has been specified for a variable, the
 trace procedure will be invoked whenever the variable's value
@@ -239,10 +233,8 @@ returned.
 It may modify the value of the variable to override the change
 and to determine the value actually returned by the traced
 access.
-.VS
 If it deletes the variable then the traced access will return
 an empty string.
-.VE
 .PP
 When unset tracing has been specified, the trace procedure
 will be invoked whenever the variable is destroyed.
@@ -270,11 +262,9 @@ access, in order from most-recently-created to least-recently-created.
 When there exist whole-array traces for an array as well as
 traces on individual elements, the whole-array traces are invoked
 before the individual-element traces.
-.VS
 If a read or write trace unsets the variable then all of the unset
 traces will be invoked but the remainder of the read and write traces
 will be skipped.
-.VE
 
 .SH "ERROR RETURNS"
 .PP
diff --git a/contrib/tcl/doc/Translate.3 b/contrib/tcl/doc/Translate.3
index 81a16da..6330ee9 100644
--- a/contrib/tcl/doc/Translate.3
+++ b/contrib/tcl/doc/Translate.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) Translate.3 1.21 96/03/25 20:08:58
+'\" SCCS: @(#) Translate.3 1.22 96/08/26 12:59:51
 '\" 
 .so man.macros
 .TH Tcl_TranslateFileName 3 7.5 Tcl "Tcl Library Procedures"
@@ -17,9 +17,7 @@ Tcl_TranslateFileName \- convert file name to native form and replace tilde with
 \fB#include <tcl.h>\fR
 .sp
 char *
-.VS
 \fBTcl_TranslateFileName\fR(\fIinterp\fR, \fIname\fR, \fIbufferPtr\fR)
-.VE
 .SH ARGUMENTS
 .AS Tcl_DString *bufferPtr
 .AP Tcl_Interp *interp in
@@ -27,17 +25,14 @@ Interpreter in which to report an error, if any.
 .AP char *name in
 File name, which may start with a ``~''.
 .AP Tcl_DString *bufferPtr in/out
-.VS
 If needed, this dynamic string is used to store the new file name.
 At the time of the call it should be uninitialized or empty.  The
 caller must eventually call \fBTcl_DStringFree\fR to free up
 anything stored here.
-.VE
 .BE
 
 .SH DESCRIPTION
 .PP
-.VS
 This utility procedure translates a file name to a form suitable for
 passing to the local operating system.  It converts network names into
 native form and does tilde substitution.
@@ -53,24 +48,19 @@ placed in \fI*bufferPtr\fR.  The caller need not know whether or
 not \fBTcl_TranslateFileName\fR actually used the string;  \fBTcl_TranslateFileName\fR
 initializes \fI*bufferPtr\fR even if it doesn't use it, so the call to
 \fBTcl_DStringFree\fR will be safe in either case.
-.VE
 .PP
 If an error occurs (e.g. because there was no user by the given
 name) then NULL is returned and an error message will be left
 at \fIinterp->result\fR.
-.VS
 When an error occurs, \fBTcl_TranslateFileName\fR
 frees the dynamic string itself so that the caller need not call
 \fBTcl_DStringFree\fR.
-.VE
 .PP
 The caller is responsible for making sure that \fIinterp->result\fR
 has its default empty value when \fBTcl_TranslateFileName\fR is invoked.
 
-.VS
 .SH "SEE ALSO"
 filename
-.VE
 
 .SH KEYWORDS
 file name, home directory, tilde, translate, user
diff --git a/contrib/tcl/doc/WrongNumArgs.3 b/contrib/tcl/doc/WrongNumArgs.3
new file mode 100644
index 0000000..528ebc8
--- /dev/null
+++ b/contrib/tcl/doc/WrongNumArgs.3
@@ -0,0 +1,59 @@
+'\"
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) @(#) WrongNumArgs.3 1.3 97/03/18 11:53:25
+'\" 
+.so man.macros
+.TH Tcl_WrongNumArgs 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_WrongNumArgs \- generate standard error message for wrong number of arguments
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp "*CONST objv[]"
+.AP Tcl_Interp interp in
+Interpreter in which error will be reported: error message gets stored
+in its result object.
+.AP int objc in
+Number of leading arguments from \fIobjv\fR to include in error
+message.
+.TP
+Tcl_Obj	*CONST \fIobjv\fR[]	(in)
+Arguments to command that had the wrong number of arguments.
+.AP char *message in
+Additional error information to print after leading arguments
+from \fIobjv\fR.  This typically gives the acceptable syntax
+of the command.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_WrongNumArgs\fR is a utility procedure that is invoked by
+command procedures when they discover that they have received the
+wrong number of arguments.  \fBTcl_WrongNumArgs\fR generates a
+standard error message and stores it in the result object of
+\fIinterp\fR.  The message includes the \fIobjc\fR initial
+elements of \fIobjv\fR plus \fImessage\fR.  For example, if
+\fIobjv\fR consists of the values \fBfoo\fR and \fBbar\fR,
+\fIobjc\fR is 1, and \fImessage\fR is ``\fBfileName count\fR''
+then \fIinterp\fR's result object will be set to the following
+string:
+.CS
+wrong # args: should be "foo fileName count"
+.CE
+If \fIobjc\fR is 2, the result will be set to the following string:
+.CS
+wrong # args: should be "foo bar fileName count"
+.CE
+\fIObjc\fR is usually 1, but may be 2 or more for commands like \fBstring\fR
+and the Tk widget commands, which use the first argument as a subcommand.
+
+.SH KEYWORDS
+command, error message, wrong number of arguments
diff --git a/contrib/tcl/doc/array.n b/contrib/tcl/doc/array.n
index 37265f1..a6e8817 100644
--- a/contrib/tcl/doc/array.n
+++ b/contrib/tcl/doc/array.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) array.n 1.7 96/03/25 20:09:58
+'\" SCCS: @(#) array.n 1.8 96/08/26 12:59:53
 '\" 
 .so man.macros
 .TH array n 7.4 Tcl "Tcl Built-In Commands"
@@ -47,31 +47,24 @@ been the return value from a previous invocation of
 \fBarray startsearch\fR.  Returns an empty string.
 .TP
 \fBarray exists \fIarrayName\fR
-.VS
 Returns 1 if \fIarrayName\fR is an array variable, 0 if there
 is no variable by that name or if it is a scalar variable.
-.VE
 .TP
 \fBarray get \fIarrayName\fR ?\fIpattern\fR?
-.VS
 Returns a list containing pairs of elements.  The first
 element in each pair is the name of an element in \fIarrayName\fR
 and the second element of each pair is the value of the
 array element.  The order of the pairs is undefined.
-.VS
 If \fIpattern\fR is not specified, then all of the elements of the
 array are included in the result.
 If \fIpattern\fR is specified, then only those elements whose names
 match \fIpattern\fR (using the glob-style matching rules of
 \fBstring match\fR) are included.
-.VE
 If \fIarrayName\fR isn't the name of an array variable, or if
 the array contains no elements, then an empty list is returned.
-.VE
 .TP
 \fBarray names \fIarrayName\fR ?\fIpattern\fR?
 Returns a list containing the names of all of the elements in
-.VS
 the array that match \fIpattern\fR (using the glob-style matching
 rules of \fBstring match\fR).
 If \fIpattern\fR is omitted then the command returns all of
@@ -79,7 +72,6 @@ the element names in the array.
 If there are no (matching) elements in the array, or if \fIarrayName\fR
 isn't the name of an array variable, then an empty string is
 returned.
-.VE
 .TP
 \fBarray nextelement \fIarrayName searchId\fR
 Returns the name of the next element in \fIarrayName\fR, or
@@ -93,21 +85,17 @@ then all searches are automatically terminated just as if
 \fBarray nextelement\fR operations to fail for those searches.
 .TP
 \fBarray set \fIarrayName list\fR
-.VS
 Sets the values of one or more elements in \fIarrayName\fR.
 \fIlist\fR must have a form like that returned by \fBarray get\fR,
 consisting of an even number of elements.
 Each odd-numbered element in \fIlist\fR is treated as an element
 name within \fIarrayName\fR, and the following element in \fIlist\fR
 is used as a new value for that array element.
-.VE
 .TP
 \fBarray size \fIarrayName\fR
 Returns a decimal string giving the number of elements in the
 array.
-.VS
 If \fIarrayName\fR isn't the name of an array then 0 is returned.
-.VE
 .TP
 \fBarray startsearch \fIarrayName\fR
 This command initializes an element-by-element search through the
diff --git a/contrib/tcl/doc/binary.n b/contrib/tcl/doc/binary.n
new file mode 100644
index 0000000..17d9380
--- /dev/null
+++ b/contrib/tcl/doc/binary.n
@@ -0,0 +1,532 @@
+'\"
+'\" Copyright (c) 1997 by Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) binary.n 1.5 97/06/10 17:52:46
+'\" 
+.so man.macros
+.TH binary n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+binary \- Insert and extract fields from binary strings
+.SH SYNOPSIS
+\fBbinary format \fIformatString \fR?\fIarg arg ...\fR?
+.br
+\fBbinary scan \fIstring formatString \fR?\fIvarName varName ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command provides facilities for manipulating binary data.  The
+first form, \fBbinary format\fR, creates a binary string from normal
+Tcl values.  For example, given the values 16 and 22, it might produce
+an 8-byte binary string consisting of two 4-byte integers, one for
+each of the numbers.  The second form of the command, 
+\fBbinary scan\fR, does the opposite: it extracts data from a binary
+string and returns it as ordinary Tcl string values.
+
+.SH "BINARY FORMAT"
+.PP
+The \fBbinary format\fR command generates a binary string whose layout
+is specified by the \fIformatString\fR and whose contents come from
+the additional arguments.  The resulting binary value is returned.
+.PP
+The \fIformatString\fR consists of a sequence of zero or more field
+specifiers separated by zero or more spaces.  Each field specifier is
+a single type character followed by an optional numeric \fIcount\fR.
+Most field specifiers consume one argument to obtain the value to be
+formatted.  The type character specifies how the value is to be
+formatted.  The \fIcount\fR typically indicates how many items of the
+specified type are taken from the value.  If present, the \fIcount\fR
+is a non-negative decimal integer or \fB*\fR, which normally indicates
+that all of the items in the value are to be used.  If the number of
+arguments does not match the number of fields in the format string
+that consume arguments, then an error is generated.
+.PP
+Each type-count pair moves an imaginary cursor through the binary
+data, storing bytes at the current position and advancing the cursor
+to just after the last byte stored.  The cursor is initially at
+position 0 at the beginning of the data.  The type may be any one of
+the following characters:
+.IP \fBa\fR 5
+Stores a character string of length \fIcount\fR in the output string.
+If \fIarg\fR has fewer than \fIcount\fR bytes, then additional zero
+bytes are used to pad out the field.  If \fIarg\fR is longer than the
+specified length, the extra characters will be ignored.  If
+\fIcount\fR is \fB*\fR, then all of the bytes in \fIarg\fR will be
+formatted.  If \fIcount\fR is omitted, then one character will be
+formatted.  For example,
+.RS
+.CS
+\fBbinary format a7a*a alpha bravo charlie\fR
+.CE
+will return a string equivalent to \fBalpha\\000\\000bravoc\fR.
+.RE
+.IP \fBA\fR 5
+This form is the same as \fBa\fR except that spaces are used for
+padding instead of nulls.  For example,
+.RS
+.CS
+\fBbinary format A6A*A alpha bravo charlie\fR
+.CE
+will return \fBalpha bravoc\fR.
+.RE
+.IP \fBb\fR 5
+Stores a string of \fIcount\fR binary digits in low-to-high order
+within each byte in the output string.  \fIArg\fR must contain a
+sequence of \fB1\fR and \fB0\fR characters.  The resulting bytes are
+emitted in first to last order with the bits being formatted in
+low-to-high order within each byte.  If \fIarg\fR has fewer than
+\fIcount\fR digits, then zeros will be used for the remaining bits.
+If \fIarg\fR has more than the specified number of digits, the extra
+digits will be ignored.  If \fIcount\fR is \fB*\fR, then all of the
+digits in \fIarg\fR will be formatted.  If \fIcount\fR is omitted,
+then one digit will be formatted.  If the number of bits formatted
+does not end at a byte boundary, the remaining bits of the last byte
+will be zeros.  For example,
+.RS
+.CS
+\fBbinary format b5b* 11100 111000011010\fR
+.CE
+will return a string equivalent to \fB\\x07\\x87\\x05\fR.
+.RE
+.IP \fBB\fR 5
+This form is the same as \fBb\fR except that the bits are stored in
+high-to-low order within each byte.  For example,
+.RS
+.CS
+\fBbinary format B5B* 11100 111000011010\fR
+.CE
+will return a string equivalent to \fB\\xe0\\xe1\\xa0\fR.
+.RE
+.IP \fBh\fR 5
+Stores a string of \fIcount\fR hexadecimal digits in low-to-high
+within each byte in the output string.  \fIArg\fR must contain a
+sequence of characters in the set ``0123456789abcdefABCDEF''.  The
+resulting bytes are emitted in first to last order with the hex digits
+being formatted in low-to-high order within each byte.  If \fIarg\fR
+has fewer than \fIcount\fR digits, then zeros will be used for the
+remaining digits.  If \fIarg\fR has more than the specified number of
+digits, the extra digits will be ignored.  If \fIcount\fR is
+\fB*\fR, then all of the digits in \fIarg\fR will be formatted.  If
+\fIcount\fR is omitted, then one digit will be formatted.  If the
+number of digits formatted does not end at a byte boundary, the
+remaining bits of the last byte will be zeros.  For example,
+.RS
+.CS
+\fBbinary format h3h* AB def\fR
+.CE
+will return a string equivalent to \fB\\xba\\xed\\x0f\fR.
+.RE
+.IP \fBH\fR 5
+This form is the same as \fBh\fR except that the digits are stored in
+high-to-low order within each byte.  For example,
+.RS
+.CS
+\fBbinary format H3H* ab DEF\fR
+.CE
+will return a string equivalent to \fB\\xab\\xde\\xf0\fR.
+.RE
+.IP \fBc\fR 5
+Stores one or more 8-bit integer values in the output string.  If no
+\fIcount\fR is specified, then \fIarg\fR must consist of an integer
+value; otherwise \fIarg\fR must consist of a list containing at least
+\fIcount\fR integer elements.  The low-order 8 bits of each integer
+are stored as a one-byte value at the cursor position.  If \fIcount\fR
+is \fB*\fR, then all of the integers in the list are formatted.  If
+the number of elements in the list is fewer than \fIcount\fR, then an
+error is generated.  If the number of elements in the list is greater
+than \fIcount\fR, then the extra elements are ignored.  For example,
+.RS
+.CS
+\fBbinary format c3cc* {3 -3 128 1} 257 {2 5}\fR
+.CE
+will return a string equivalent to
+\fB\\x03\\xfd\\x80\\x01\\x02\\x05\fR, whereas
+.CS
+\fBbinary format c {2 5}\fR
+.CE
+will generate an error.
+.RE
+.IP \fBs\fR 5
+This form is the same as \fBc\fR except that it stores one or more
+16-bit integers in little-endian byte order in the output string.  The
+low-order 16-bits of each integer are stored as a two-byte value at
+the cursor position with the least significant byte stored first.  For
+example,
+.RS
+.CS
+\fBbinary format s3 {3 -3 258 1}\fR
+.CE
+will return a string equivalent to 
+\fB\\x03\\x00\\xfd\\xff\\x02\\x01\fR.
+.RE
+.IP \fBS\fR 5
+This form is the same as \fBs\fR except that it stores one or more
+16-bit integers in big-endian byte order in the output string.  For
+example,
+.RS
+.CS
+\fBbinary format S3 {3 -3 258 1}\fR
+.CE
+will return a string equivalent to 
+\fB\\x00\\x03\\xff\\xfd\\x01\\x02\fR.
+.RE
+.IP \fBi\fR 5
+This form is the same as \fBc\fR except that it stores one or more
+32-bit integers in little-endian byte order in the output string.  The
+low-order 32-bits of each integer are stored as a four-byte value at
+the cursor position with the least significant byte stored first.  For
+example,
+.RS
+.CS
+\fBbinary format i3 {3 -3 65536 1}\fR
+.CE
+will return a string equivalent to 
+\fB\\x03\\x00\\x00\\x00\\xfd\\xff\\xff\\xff\\x00\\x00\\x10\\x00\fR.
+.RE
+.IP \fBI\fR 5
+This form is the same as \fBi\fR except that it stores one or more one
+or more 32-bit integers in big-endian byte order in the output string.
+For example,
+.RS
+.CS
+\fBbinary format I3 {3 -3 65536 1}\fR
+.CE
+will return a string equivalent to 
+\fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x10\\x00\\x00\fR.
+.RE
+.IP \fBf\fR 5
+This form is the same as \fBc\fR except that it stores one or more one
+or more single-precision floating in the machine's native
+representation in the output string.  This representation is not
+portable across architectures, so it should not be used to communicate
+floating point numbers across the network.  The size of a floating
+point number may vary across architectures, so the number of bytes
+that are generated may vary.  If the value is out of range for the
+machine's native representation, then the value of FLT_MIN or FLT_MAX
+as defined by the system will be used instead.  Because Tcl uses
+double-precision floating-point numbers internally, there may be some
+loss of precision in the conversion to single-precision.  For example,
+on a Windows system running on an Intel Pentium processor,
+.RS
+.CS
+\fBbinary format f2 {1.6 3.4}\fR
+.CE
+will return a string equivalent to 
+\fB\\xcd\\xcc\\xcc\\x3f\\x9a\\x99\\x59\\x40\fR.
+.RE
+.IP \fBd\fR 5
+This form is the same as \fBf\fR except that it stores one or more one
+or more double-precision floating in the machine's native
+representation in the output string.  For example, on a
+Windows system running on an Intel Pentium processor,
+.RS
+.CS
+\fBbinary format d1 {1.6}\fR
+.CE
+will return a string equivalent to 
+\fB\\x9a\\x99\\x99\\x99\\x99\\x99\\xf9\\x3f\fR.
+.RE
+.IP \fBx\fR 5
+Stores \fIcount\fR null bytes in the output string.  If \fIcount\fR is
+not specified, stores one null byte.  If \fIcount\fR is \fB*\fR,
+generates an error.  This type does not consume an argument.  For
+example,
+.RS
+.CS
+\fBbinary format a3xa3x2a3 abc def ghi\fR
+.CE
+will return a string equivalent to \fBabc\\000def\\000\\000ghi\fR.
+.RE
+.IP \fBX\fR 5
+Moves the cursor back \fIcount\fR bytes in the output string.  If
+\fIcount\fR is \fB*\fR or is larger than the current cursor position,
+then the cursor is positioned at location 0 so that the next byte
+stored will be the first byte in the result string.  If \fIcount\fR is
+omitted then the cursor is moved back one byte.  This type does not
+consume an argument.  For example,
+.RS
+.CS
+\fBbinary format a3X*a3X2a3 abc def ghi\fR
+.CE
+will return \fBdghi\fR.
+.RE
+.IP \fB@\fR 5
+Moves the cursor to the absolute location in the output string
+specified by \fIcount\fR.  Position 0 refers to the first byte in the
+output string.  If \fIcount\fR refers to a position beyond the last
+byte stored so far, then null bytes will be placed in the unitialized
+locations and the cursor will be placed at the specified location.  If
+\fIcount\fR is \fB*\fR, then the cursor is moved to the current end of
+the output string.  If \fIcount\fR is omitted, then an error will be
+generated.  This type does not consume an argument. For example,
+.RS
+.CS
+\fBbinary format a5@2a1@*a3@10a1 abcde f ghi j\fR
+.CE
+will return \fBabfdeghi\\000\\000j\fR.
+.RE
+
+.SH "BINARY SCAN"
+.PP
+The \fBbinary scan\fR command parses fields from a binary string,
+returning the number of conversions performed.  \fIString\fR gives the
+input to be parsed and \fIformatString\fR indicates how to parse it.
+Each \fIvarName\fR gives the name of a variable; when a field is
+scanned from \fIstring\fR the result is assigned to the corresponding
+variable.
+.PP
+As with \fBbinary format\fR, the \fIformatString\fR consists of a
+sequence of zero or more field specifiers separated by zero or more
+spaces.  Each field specifier is a single type character followed by
+an optional numeric \fIcount\fR.  Most field specifiers consume one
+argument to obtain the variable into which the scanned values should
+be placed.  The type character specifies how the binary data is to be
+interpreted.  The \fIcount\fR typically indicates how many items of
+the specified type are taken from the data.  If present, the
+\fIcount\fR is a non-negative decimal integer or \fB*\fR, which
+normally indicates that all of the remaining items in the data are to
+be used.  If there are not enough bytes left after the current cursor
+position to satisfy the current field specifier, then the
+corresponding variable is left untouched and \fBbinary scan\fR returns
+immediately with the number of variables that were set.  If there are
+not enough arguments for all of the fields in the format string that
+consume arguments, then an error is generated.
+.PP
+Each type-count pair moves an imaginary cursor through the binary data,
+reading bytes from the current position.  The cursor is initially
+at position 0 at the beginning of the data.  The type may be any one of
+the following characters:
+.IP \fBa\fR 5
+The data is a character string of length \fIcount\fR.  If \fIcount\fR
+is \fB*\fR, then all of the remaining bytes in \fIstring\fR will be
+scanned into the variable.  If \fIcount\fR is omitted, then one
+character will be scanned.  For example,
+.RS
+.CS
+\fBbinary scan abcde\\000fghi a6a10 var1 var2\fR
+.CE
+will return \fB1\fR with the string equivalent to \fBabcde\\000\fR
+stored in \fBvar1\fR and \fBvar2\fR left unmodified.
+.RE
+.IP \fBA\fR 5
+This form is the same as \fBa\fR, except trailing blanks and nulls are stripped from
+the scanned value before it is stored in the variable.  For example,
+.RS
+.CS
+\fBbinary scan "abc efghi  \\000" a* var1\fR
+.CE
+will return \fB1\fR with \fBabc efghi\fR stored in \fBvar1\fR.
+.RE
+.IP \fBb\fR 5
+The data is turned into a string of \fIcount\fR binary digits in
+low-to-high order represented as a sequence of ``1'' and ``0''
+characters.  The data bytes are scanned in first to last order with
+the bits being taken in low-to-high order within each byte.  Any extra
+bits in the last byte are ignored.  If \fIcount\fR is \fB*\fR, then
+all of the remaining bits in \fBstring\fR will be scanned.  If
+\fIcount\fR is omitted, then one bit will be scanned.  For example,
+.RS
+.CS
+\fBbinary scan \\x07\\x87\\x05 b5b* var1 var2\fR
+.CE
+will return \fB2\fR with \fB11100\fR stored in \fBvar1\fR and
+\fB1110000110100000\fR stored in \fBvar2\fR.
+.RE
+.IP \fBB\fR 5
+This form is the same as \fBB\fR, except the bits are taken in
+high-to-low order within each byte.  For example,
+.RS
+.CS
+\fBbinary scan \\x70\\x87\\x05 b5b* var1 var2\fR
+.CE
+will return \fB2\fR with \fB01110\fR stored in \fBvar1\fR and
+\fB1000011100000101\fR stored in \fBvar2\fR.
+.RE
+.IP \fBh\fR 5
+The data is turned into a string of \fIcount\fR hexadecimal digits in
+low-to-high order represented as a sequence of characters in the set
+``0123456789abcdef''.  The data bytes are scanned in first to last
+order with the hex digits being taken in low-to-high order within each
+byte.  Any extra bits in the last byte are ignored.  If \fIcount\fR
+is \fB*\fR, then all of the remaining hex digits in \fBstring\fR will be
+scanned.  If \fIcount\fR is omitted, then one hex digit will be
+scanned.  For example,
+.RS
+.CS
+\fBbinary scan \\x07\\x86\\x05 h3h* var1 var2\fR
+.CE
+will return \fB2\fR with \fB706\fR stored in \fBvar1\fR and
+\fB50\fR stored in \fBvar2\fR.
+.RE
+.IP \fBH\fR 5
+This form is the same as \fBh\fR, except the digits are taken in
+low-to-high order within each byte.  For example,
+.RS
+.CS
+\fBbinary scan \\x07\\x86\\x05 H3H* var1 var2\fR
+.CE
+will return \fB2\fR with \fB078\fR stored in \fBvar1\fR and
+\fB05\fR stored in \fBvar2\fR.
+.RE
+.IP \fBc\fR 5
+The data is turned into \fIcount\fR 8-bit signed integers and stored
+in the corresponding variable as a list. If \fIcount\fR is \fB*\fR,
+then all of the remaining bytes in \fBstring\fR will be scanned.  If
+\fIcount\fR is omitted, then one 8-bit integer will be scanned.  For
+example,
+.RS
+.CS
+\fBbinary scan \\x07\\x86\\x05 c2c* var1 var2\fR
+.CE
+will return \fB2\fR with \fB7 -122\fR stored in \fBvar1\fR and \fB5\fR
+stored in \fBvar2\fR.  Note that the integers returned are signed, but
+they can be converted to unsigned 8-bit quantities using an expression
+like:
+.CS
+\fBexpr ( $num + 0x100 ) % 0x100\fR
+.CE
+.RE
+.IP \fBs\fR 5
+The data is interpreted as \fIcount\fR 16-bit signed integers
+represented in little-endian byte order.  The integers are stored in
+the corresponding variable as a list.  If \fIcount\fR is \fB*\fR, then
+all of the remaining bytes in \fBstring\fR will be scanned.  If
+\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
+example,
+.RS
+.CS
+\fBbinary scan \\x05\\x00\\x07\\x00\\xf0\\xff s2s* var1 var2\fR
+.CE
+will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
+stored in \fBvar2\fR.  Note that the integers returned are signed, but
+they can be converted to unsigned 16-bit quantities using an expression
+like:
+.CS
+\fBexpr ( $num + 0x10000 ) % 0x10000\fR
+.CE
+.RE
+.IP \fBS\fR 5
+This form is the same as \fBs\fR except that the data is interpreted
+as \fIcount\fR 16-bit signed integers represented in big-endian byte
+order.  For example,
+.RS
+.CS
+\fBbinary scan \\x00\\x05\\x00\\x07\\xff\\xf0 S2S* var1 var2\fR
+.CE
+will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
+stored in \fBvar2\fR. 
+.RE
+.IP \fBi\fR 5
+The data is interpreted as \fIcount\fR 32-bit signed integers
+represented in little-endian byte order.  The integers are stored in
+the corresponding variable as a list.  If \fIcount\fR is \fB*\fR, then
+all of the remaining bytes in \fBstring\fR will be scanned.  If
+\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
+example,
+.RS
+.CS
+\fBbinary scan \\x05\\x00\\x00\\x00\\x07\\x00\\x00\\x00\\xf0\\xff\\xff\\xff i2i* var1 var2\fR
+.CE
+will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
+stored in \fBvar2\fR.  Note that the integers returned are signed and
+cannot be represented by Tcl as unsigned values.
+.RE
+.IP \fBI\fR 5
+This form is the same as \fBI\fR except that the data is interpreted
+as \fIcount\fR 32-bit signed integers represented in big-endian byte
+order.  For example,
+.RS
+.CS
+\fBbinary \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0 I2I* var1 var2\fR
+.CE
+will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
+stored in \fBvar2\fR.
+.RE
+.IP \fBf\fR 5
+The data is interpreted as \fIcount\fR single-precision floating point
+numbers in the machine's native representation.  The floating point
+numbers are stored in the corresponding variable as a list.  If
+\fIcount\fR is \fB*\fR, then all of the remaining bytes in
+\fBstring\fR will be scanned.  If \fIcount\fR is omitted, then one
+single-precision floating point number will be scanned.  The size of a
+floating point number may vary across architectures, so the number of
+bytes that are scanned may vary.  If the data does not represent a
+valid floating point number, the resulting value is undefined and
+compiler dependent.  For example, on a Windows system running on an
+Intel Pentium processor,
+.RS
+.CS
+\fBbinary scan \\x3f\\xcc\\xcc\\xcd f var1\fR
+.CE
+will return \fB1\fR with \fB1.6000000238418579\fR stored in
+\fBvar1\fR.
+.RE
+.IP \fBd\fR 5
+This form is the same as \fBf\fR except that the data is interpreted
+as \fIcount\fR double-precision floating point numbers in the
+machine's native representation. For example, on a Windows system
+running on an Intel Pentium processor,
+.RS
+.CS
+\fBbinary scan \\x9a\\x99\\x99\\x99\\x99\\x99\\xf9\\x3f d var1\fR
+.CE
+will return \fB1\fR with \fB1.6000000000000001\fR
+stored in \fBvar1\fR.
+.RE
+.IP \fBx\fR 5
+Moves the cursor forward \fIcount\fR bytes in \fIstring\fR.  If
+\fIcount\fR is \fB*\fR or is larger than the number of bytes after the
+current cursor cursor position, then the cursor is positioned after
+the last byte in \fIstring\fR.  If \fIcount\fR is omitted, then the
+cursor is moved forward one byte.  Note that this type does not
+consume an argument.  For example,
+.RS
+.CS
+\fBbinary scan \\x01\\x02\\x03\\x04 x2H* var1\fR
+.CE
+will return \fB1\fR with \fB0304\fR stored in \fBvar1\fR.
+.RE
+.IP \fBX\fR 5
+Moves the cursor back \fIcount\fR bytes in \fIstring\fR.  If
+\fIcount\fR is \fB*\fR or is larger than the current cursor position,
+then the cursor is positioned at location 0 so that the next byte
+scanned will be the first byte in \fIstring\fR.  If \fIcount\fR
+is omitted then the cursor is moved back one byte.  Note that this
+type does not consume an argument.  For example,
+.RS
+.CS
+\fBbinary scan \\x01\\x02\\x03\\x04 c2XH* var1 var2\fR
+.CE
+will return \fB2\fR with \fB1 2\fR stored in \fBvar1\fR and \fB020304\fR
+stored in \fBvar2\fR.
+.RE
+.IP \fB@\fR 5
+Moves the cursor to the absolute location in the data string specified
+by \fIcount\fR.  Note that position 0 refers to the first byte in
+\fIstring\fR.  If \fIcount\fR refers to a position beyond the end of
+\fIstring\fR, then the cursor is positioned after the last byte.  If
+\fIcount\fR is omitted, then an error will be generated.  For example,
+.RS
+.CS
+\fBbinary scan \\x01\\x02\\x03\\x04 c2@1H* var1 var2\fR
+.CE
+will return \fB2\fR with \fB1 2\fR stored in \fBvar1\fR and \fB020304\fR
+stored in \fBvar2\fR.
+.RE
+
+.SH "PLATFORM ISSUES"
+Sometimes it is desirable to format or scan integer values in the
+native byte order for the machine.  Refer to the \fBbyteOrder\fR
+element of the \fBtcl_platform\fR array to decide which type character
+to use when formatting or scanning integers.
+
+.SH "SEE ALSO"
+format, scan, tclvars
+
+.SH KEYWORDS
+binary, format, scan
diff --git a/contrib/tcl/doc/clock.n b/contrib/tcl/doc/clock.n
index 548ffc0..c7777a6 100644
--- a/contrib/tcl/doc/clock.n
+++ b/contrib/tcl/doc/clock.n
@@ -1,6 +1,6 @@
 '\"
 '\" Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
-'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
 '\"
 '\" This documentation is derived from the time and date facilities of
 '\" TclX, by Mark Diekhans and Karl Lehenbauer.
@@ -8,7 +8,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) clock.n 1.13 96/05/03 14:40:37
+'\" SCCS: @(#) clock.n 1.17 97/02/03 16:34:17
 '\" 
 .so man.macros
 .TH clock n 7.4 Tcl "Tcl Built-In Commands"
@@ -150,7 +150,10 @@ A specific month and day with optional year.  The
 acceptable formats are \fImm/dd\fR?\fI/yy\fR?, \fImonthname dd\fR
 ?, \fIyy\fR?, \fIdd monthname \fR?\fIyy\fR? and \fIday, dd monthname
 yy\fR.  The default year is the current year.  If the year is less
-then 100, then 1900 is added to it.
+then 100, we treat the years 00-38 as 2000-2038 and the years 70-99
+as 1970-1999.  The years 39-70 are undefined and may not be valid on
+certain platforms.  (For thos platforms where it is defined then the
+years 69-99 match to 1969-1999.)
 .TP
 \fIrelative time\fR
 A specification relative to the current time.  The format is \fInumber
@@ -170,7 +173,8 @@ Next, relative specifications are used.  If a date or day is
 specified, and no absolute or relative time is given, midnight is
 used.  Finally, a correction is applied so that the correct hour of
 the day is produced after allowing for daylight savings time
-differences.
+differences and the correct date is given when going from the end
+of a long month to a short month.
 .RE
 .TP
 \fBclock seconds\fR
diff --git a/contrib/tcl/doc/concat.n b/contrib/tcl/doc/concat.n
index f248335..3a1e7a4 100644
--- a/contrib/tcl/doc/concat.n
+++ b/contrib/tcl/doc/concat.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) concat.n 1.7 96/03/25 20:11:56
+'\" SCCS: @(#) concat.n 1.8 96/08/26 12:59:54
 '\" 
 .so man.macros
 .TH concat n "" Tcl "Tcl Built-In Commands"
@@ -14,9 +14,7 @@
 .SH NAME
 concat \- Join lists together
 .SH SYNOPSIS
-.VS
 \fBconcat\fI \fR?\fIarg arg ...\fR?
-.VE
 .BE
 
 .SH DESCRIPTION
@@ -36,9 +34,7 @@ will return
 .CE
 as its result.
 .PP
-.VS
 If no \fIarg\fRs are supplied, the result is an empty string.
-.VE
 
 .SH KEYWORDS
 concatenate, join, lists
diff --git a/contrib/tcl/doc/exec.n b/contrib/tcl/doc/exec.n
index 6b731e2..22caf80 100644
--- a/contrib/tcl/doc/exec.n
+++ b/contrib/tcl/doc/exec.n
@@ -5,10 +5,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) exec.n 1.12 96/03/25 20:13:20
+'\" SCCS: @(#) exec.n 1.17 96/09/18 15:21:17
 '\" 
 .so man.macros
-.TH exec n 7.0 Tcl "Tcl Built-In Commands"
+.TH exec n 7.6 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -26,7 +26,6 @@ where each \fIarg\fR becomes one word of a command, and
 each distinct command becomes a subprocess.
 .PP
 If the initial arguments to \fBexec\fR start with \fB\-\fR then
-.VS
 they are treated as command-line switches and are not part
 of the pipeline specification.  The following switches are
 currently supported:
@@ -38,17 +37,14 @@ Normally a trailing newline will be deleted.
 \fB\-\|\-\fR
 Marks the end of switches.  The argument following this one will
 be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
-.VE
 .PP
 If an \fIarg\fR (or pair of \fIarg\fR's) has one of the forms
 described below then it is used by \fBexec\fR to control the
 flow of input and output among the subprocess(es).
 Such arguments will not be passed to the subprocess(es).  In forms
-.VS
 such as ``< \fIfileName\fR'' \fIfileName\fR may either be in a
 separate argument from ``<'' or in the same argument with no
 intervening space (i.e. ``<\fIfileName\fR'').
-.VE
 .TP 15
 |
 Separates distinct commands in the pipeline.  The standard output
@@ -66,12 +62,10 @@ The file named by \fIfileName\fR is opened and used as the standard
 input for the first command in the pipeline.
 .TP 15
 <@\0\fIfileId\fR
-.VS
 \fIFileId\fR must be the identifier for an open file, such as the return
 value from a previous call to \fBopen\fR.
 It is used as the standard input for the first command in the pipeline.
 \fIFileId\fR must have been opened for reading.
-.VE
 .TP 15
 <<\0\fIvalue\fR
 \fIValue\fR is passed to the first command as its standard input.
@@ -81,7 +75,6 @@ Standard output from the last command is redirected to the file named
 \fIfileName\fR, overwriting its previous contents.
 .TP 15
 2>\0\fIfileName\fR
-.VS
 Standard error from all commands in the pipeline is redirected to the
 file named \fIfileName\fR, overwriting its previous contents.
 .TP 15
@@ -89,7 +82,6 @@ file named \fIfileName\fR, overwriting its previous contents.
 Both standard output from the last command and standard error from all
 commands are redirected to the file named \fIfileName\fR, overwriting
 its previous contents.
-.VE
 .TP 15
 >>\0\fIfileName\fR
 Standard output from the last command is
@@ -97,7 +89,6 @@ redirected to the file named \fIfileName\fR, appending to it rather
 than overwriting it.
 .TP 15
 2>>\0\fIfileName\fR
-.VS
 Standard error from all commands in the pipeline is
 redirected to the file named \fIfileName\fR, appending to it rather
 than overwriting it.
@@ -126,7 +117,6 @@ value from a previous call to \fBopen\fR.
 Both standard output from the last command and standard error from
 all commands are redirected to \fIfileId\fR's file.
 The file must have been opened for writing.
-.VE
 .PP
 If standard output has not been redirected then the \fBexec\fR
 command returns the standard output from the last command
@@ -149,10 +139,8 @@ is a newline then that character is normally deleted
 from the result or error message.
 This is consistent with other Tcl return values, which don't
 normally end with newlines.
-.VS
 However, if \fB\-keepnewline\fR is specified then the trailing
 newline is retained.
-.VE
 .PP
 If standard input isn't redirected with ``<'' or ``<<''
 or ``<@'' then the standard input for the first command in the
@@ -160,11 +148,9 @@ pipeline is taken from the application's current standard input.
 .PP
 If the last \fIarg\fR is ``&'' then the pipeline will be
 executed in background.
-.VS
 In this case the \fBexec\fR command will return a list whose
 elements are the process identifiers for all of the subprocesses
 in the pipeline.
-.VE
 The standard output from the last command in the pipeline will
 go to the application's standard output if it hasn't been
 redirected, and error output from all of
@@ -181,5 +167,191 @@ reachable from the current directory.
 No ``glob'' expansion or other shell-like substitutions
 are performed on the arguments to commands.
 
+.VS
+.SH "PORTABILITY ISSUES"
+.TP
+\fBWindows\fR (all versions)
+.
+Reading from or writing to a socket, using the ``\fB@\0\fIfileId\fR''
+notation, does not work.  When reading from a socket, a 16-bit DOS
+application will hang and a 32-bit application will return immediately with
+end-of-file.  When either type of application writes to a socket, the
+information is instead sent to the console, if one is present, or is
+discarded.
+.sp
+The Tk console text widget does not provide real standard IO capabilities.
+Under Tk, when redirecting from standard input, all applications will see an
+immediate end-of-file; information redirected to standard output or standard
+error will be discarded.  
+.sp
+Either forward or backward slashes are accepted as path separators for
+arguments to Tcl commands.  When executing an application, the path name
+specified for the application may also contain forward or backward slashes
+as path separators.  Bear in mind, however, that most Windows applications
+accept arguments with forward slashes only as option delimiters and
+backslashes only in paths.  Any arguments to an application that specify a
+path name with forward slashes will not automatically be converted to use
+the backslash character.  If an argument contains forward slashes as the
+path separator, it may or may not be recognized as a path name, depending on
+the program.  
+.sp
+Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
+names must use the short, cryptic, path format (e.g., using ``applba~1.def''
+instead of ``applbakery.default'').
+.sp
+Two or more forward or backward slashes in a row in a path refer to a
+network path.  For example, a simple concatenation of the root directory
+\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
+\fBc://windows/system\fR (two slashes together), which refers to the
+directory \fB/system\fR on the machine \fBwindows\fR (and the \fBc:/\fR is
+ignored), and is not equivalent to \fBc:/windows/system\fR, which describes
+a directory on the current computer.
+.TP
+\fBWindows NT\fR
+.
+When attempting to execute an application, \fBexec\fR first searches for the
+name as it was specified.  Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR 
+are appended to the end of the specified name and it searches for
+the longer name.  If a directory name was not specified as part of the
+application name, the following directories are automatically searched in
+order when attempting to locate the application:
+.sp
+.RS
+.RS
+The directory from which the Tcl executable was loaded.
+.br
+The current directory.
+.br
+The Windows NT 32-bit system directory.
+.br
+The Windows NT 16-bit system directory.
+.br
+The Windows NT home directory.
+.br
+The directories listed in the path.
+.RE
+.sp
+In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR,
+the caller must prepend ``\fBcmd.exe /c\0\fR'' to the desired command.  
+.sp
+.RE
+.TP
+\fBWindows 95\fR
+.
+When attempting to execute an application, \fBexec\fR first searches for the
+name as it was specified.  Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR
+are appended to the end of the specified name and it searches for
+the longer name.  If a directory name was not specified as part of the
+application name, the following directories are automatically searched in
+order when attempting to locate the application:
+.sp
+.RS
+.RS
+The directory from which the Tcl executable was loaded.
+.br
+The current directory.
+.br
+The Windows 95 system directory.
+.br
+The Windows 95 home directory.
+.br
+The directories listed in the path.
+.RE
+.sp
+In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR,
+the caller must prepend ``\fBcommand.com /c\0\fR'' to the desired command.
+.sp
+Once a 16-bit DOS application has read standard input from a console and 
+then quit, all subsequently run 16-bit DOS applications will see the 
+standard input as already closed.  32-bit applications do not have this
+problem and will run correctly even after a 16-bit DOS application thinks 
+that standard input is closed.  There is no known workaround for this bug
+at this time.
+.sp
+Redirection between the \fBNUL:\fR device and a 16-bit application does not
+always work.  When redirecting from \fBNUL:\fR, some applications may hang,
+others will get an infinite stream of ``0x01'' bytes, and some will actually
+correctly get an immediate end-of-file; the behavior seems to depend upon 
+something compiled into the application itself.  When redirecting greater than
+4K or so to \fBNUL:\fR, some applications will hang.  The above problems do not
+happen with 32-bit applications.  
+.sp
+All DOS 16-bit applications are run synchronously.  All standard input from
+a pipe to a 16-bit DOS application is collected into a temporary file; the
+other end of the pipe must be closed before the 16-bit DOS application
+begins executing.  All standard output or error from a 16-bit DOS
+application to a pipe is collected into temporary files; the application
+must terminate before the temporary files are redirected to the next stage
+of the pipeline.  This is due to a workaround for a Windows 95 bug in the 
+implementation of pipes, and is how the Windows 95 command line interpreter
+handles pipes itself.
+.sp
+Certain applications, such as \fBcommand.com\fR, should not be executed
+interactively.  Applications which directly access the console window,
+rather than reading from their standard input and writing to their standard
+output may fail, hang Tcl, or even hang the system if their own private
+console window is not available to them.
+.RE
+.TP
+\fBWindows 3.X\fR
+.
+When attempting to execute an application, \fBexec\fR first searches for the
+name as it was specified.  Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR
+are appended to the end of the specified name and it searches for
+the longer name.  If a directory name was not specified as part of the
+application name, the following directories are automatically searched in
+order when attempting to locate the application:
+.sp
+.RS
+.RS
+The directory from which the Tcl executable was loaded.
+.br
+The current directory.
+.br
+The Windows 3.X system directory.
+.br
+The Windows 3.X home directory.
+.br
+The directories listed in the path.
+.RE
+.sp
+In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR,
+the caller must prepend ``\fBcommand.com /c\0\fR'' to the desired command.
+.sp
+16-bit and 32-bit DOS and Windows applications may be executed.  However,
+redirection and piping of standard IO only works with 16-bit DOS
+applications.  32-bit applications always see standard input as already
+closed, and any standard output or error is discarded, no matter where in the
+pipeline the application occurs or what redirection symbols are used by the
+caller.  Additionally, for 16-bit applications, standard error is always
+sent to the same place as standard output; it cannot be redirected to a
+separate location.  In order to achieve pseudo-redirection for 32-bit
+applications, the 32-bit application must instead be written to take command
+line arguments that specify the files that it should read from and write to
+and open those files itself.  
+.sp
+All applications, both 16-bit and 32-bit, run synchronously; each application
+runs to completion before the next one in the pipeline starts.  Temporary files
+are used to simulate piping between applications.  The \fBexec\fR
+command cannot be used to start an application in the background.
+.sp
+When standard input is redirected from an open file using the
+``\fB@\0\fIfileId\fR'' notation, the open file is completely read up to its
+end.  This is slightly different than under Windows 95 or NT, where the child
+application consumes from the open file only as much as it wants.
+Redirecting to an open file is supported as normal.
+.RE
+.TP
+\fBMacintosh\fR
+The \fBexec\fR command is not implemented and does not exist under Macintosh.
+.TP
+\fBUnix\fR\0\0\0\0\0\0\0
+The \fBexec\fR command is fully functional and works as described.
+
+.SH "SEE ALSO"
+open(n)
+.VE
+
 .SH KEYWORDS
 execute, pipeline, redirection, subprocess
+
diff --git a/contrib/tcl/doc/fcopy.n b/contrib/tcl/doc/fcopy.n
new file mode 100644
index 0000000..cea5066
--- /dev/null
+++ b/contrib/tcl/doc/fcopy.n
@@ -0,0 +1,127 @@
+'\"
+'\" Copyright (c) 1993 The Regents of the University of California.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) fcopy.n 1.4 97/06/19 11:10:07
+'\" 
+.so man.macros
+.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+fcopy \- Copy data from one channel to another.
+.SH SYNOPSIS
+\fBfcopy \fIinchan\fR \fIoutchan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfcopy\fP command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR.
+The \fBfcopy\fP command leverages the buffering in the Tcl I/O system to
+avoid extra copies and to avoid buffering too much data in
+main memory when copying large files to slow destinations like
+network sockets.
+.PP
+The \fBfcopy\fP 
+command transfers data from \fIinchan\fR until end of file
+or \fIsize\fP bytes have been 
+transferred. If no \fB\-size\fP argument is given,
+then the copy goes until end of file.
+All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
+Without the \fB\-command\fP option, \fBfcopy\fP blocks until the copy is complete
+and returns the number of bytes written to \fIoutchan\fR.
+.PP
+The \fB\-command\fP argument makes \fBfcopy\fP work in the background.
+In this case it returns immediately and the \fIcallback\fP is invoked
+later when the copy completes.
+The \fIcallback\fP is called with
+one or two additional 
+arguments that indicates how many bytes were written to \fIoutchan\fR.
+If an error occurred during the background copy, the second argument is the
+error string associated with the error.
+With a background copy,
+it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
+non-blocking mode; the \fBfcopy\fP command takes care of that automatically.
+However, it is necessary to enter the event loop by using
+the \fBvwait\fP command or by using Tk.
+.PP
+You are not allowed to do other I/O operations with
+\fIinchan\fR or \fIoutchan\fR during a background fcopy.
+If either \fIinchan\fR or \fIoutchan\fR get closed
+while the copy is in progress, the current copy is stopped
+and the command callback is \fInot\fP made.
+If \fIinchan\fR is closed,
+then all data already queued for \fIoutchan\fR is written out.
+.PP
+Note that \fIinchan\fR can become readable during a background copy.
+You should turn off any \fBfileevent\fP handlers during a background
+copy so those handlers do not interfere with the copy.
+Any I/O attempted by a \fBfileevent\fP handler will get a "channel busy" error.
+.PP
+\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
+according to the \fB\-translation\fR option
+for these channels.
+See the manual entry for \fBfconfigure\fR for details on the
+\fB\-translation\fR option.
+The translations mean that the number of bytes read from \fIinchan\fR
+can be different than the number of bytes written to \fIoutchan\fR.
+Only the number of bytes written to \fIoutchan\fR is reported,
+either as the return value of a synchronous \fBfcopy\fP or
+as the argument to the callback for an asynchronous \fBfcopy\fP.
+
+.SH EXAMPLE
+.PP
+This first example shows how the callback gets
+passed the number of bytes transferred.
+It also uses vwait to put the application into the event loop.
+Of course, this simplified example could be done without the command 
+callback.
+.DS
+proc Cleanup {in out bytes {error {}}} {
+    global total
+    set total $bytes
+    close $in
+    close $out
+    if {[string length $error] != 0} {
+	# error occurred during the copy
+    }
+}
+set in [open $file1]
+set out [socket $server $port]
+fcopy $in $out -command [list Cleanup $in $out]
+vwait total
+
+.DE
+.PP
+The second example copies in chunks and tests for end of file
+in the command callback
+.DS
+proc CopyMore {in out chunk bytes {error {}}} {
+    global total done
+    incr total $bytes
+    if {([string length $error] != 0) || [eof $in] {
+	set done $total
+	close $in
+	close $out
+    } else {
+	fcopy $in $out -command [list CopyMore $in $out $chunk] \\
+	    -size $chunk
+    }
+}
+set in [open $file1]
+set out [socket $server $port]
+set chunk 1024
+set total 0
+fcopy $in $out -command [list CopyMore $in $out $chunk] -size $chunk
+vwait done
+
+.DE
+
+.SH "SEE ALSO"
+eof(n), fblocked(n), fconfigure(n)
+
+.SH KEYWORDS
+blocking, channel, end of line, end of file, nonblocking, read, translation
diff --git a/contrib/tcl/doc/file.n b/contrib/tcl/doc/file.n
index 1451fc3..5b3a1f5 100644
--- a/contrib/tcl/doc/file.n
+++ b/contrib/tcl/doc/file.n
@@ -5,10 +5,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) file.n 1.13 96/04/11 17:03:13
+'\" SCCS: @(#) file.n 1.23 97/04/30 11:37:10
 '\" 
 .so man.macros
-.TH file n 7.5 Tcl "Tcl Built-In Commands"
+.TH file n 7.6 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -19,25 +19,92 @@ file \- Manipulate file names and attributes
 
 .SH DESCRIPTION
 .PP
-.VS
 This command provides several operations on a file's name or attributes.
-\fIName\fR is the name of a file;
-if it starts with a tilde, then tilde substitution is done before
-executing the command (see the manual entry for \fBfilename\fR 
-for details).
-.VE
-\fIOption\fR indicates what to do with the file name.  Any unique
-abbreviation for \fIoption\fR is acceptable.  The valid options are:
+\fIName\fR is the name of a file; if it starts with a tilde, then tilde
+substitution is done before executing the command (see the manual entry for
+\fBfilename\fR for details).  \fIOption\fR indicates what to do with the
+file name.  Any unique abbreviation for \fIoption\fR is acceptable.  The
+valid options are:
 .TP
 \fBfile atime \fIname\fR
+.
 Returns a decimal string giving the time at which file \fIname\fR
 was last accessed.  The time is measured in the standard POSIX
 fashion as seconds from a fixed starting time (often January 1, 1970).
 If the file doesn't exist or its access time cannot be queried then an
 error is generated.
+.VS
+.TP
+\fBfile attributes \fIname\fR
+.br
+\fBfile attributes \fIname\fR ?\fBoption\fR?
+.br
+\fBfile attributes \fIname\fR ?\fBoption value option value...\fR?
+.RS
+This subcommand returns or sets platform specific values associated
+with a file. The first form returns a list of the platform specific
+flags and their values. The second form returns the value for the
+specific option. The third form sets one or more of the values. The
+values are as follows:
+.PP
+On Unix, \fB-group\fR gets or sets the group name for the file. A group id can
+be given to the command, but it returns a group name. \fB-owner\fR
+gets or sets the user name of the owner of the file. The command
+returns the owner name, but the numerical id can be passed when
+setting the owner. \fB-permissions\fR sets or retrieves the octal code
+that chmod(1) uses. This command does not support the symbolic
+attributes for chmod(1) at this time.
+.PP
+On Windows, \fB-archive\fR gives the value or sets or clears the
+archive attribute of the file. \fB-hidden\fR gives the value or sets
+or clears the hidden attribute of the file. \fB-longname\fR will
+expand each path element to its long version. This attribute cannot be
+set. \fB-readonly\fR gives the value or sets or clears the readonly
+attribute of the file. \fB-shortname\fR gives a string where every
+path element is replaced with its short (8.3) version of the
+name. This attribute cannot be set. \fB-system\fR gives or sets or
+clears the value of the system attribute of the file.
+.PP
+On Macintosh, \fB-creator\fR gives or sets the Finder creator type of
+the file. \fB-hidden\fR gives or sets or clears the hidden attribute
+of the file. \fB-readonly\fR gives or sets or clears the readonly
+attribute of the file. Note that directories can only be locked if
+File Sharing is turned on. \fB-type\fR gives or sets the Finder file
+type for the file.
+.RE
+.VE
+.PP
+\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
+.br
+\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR
+.RS
+The first form makes a copy of the file or directory \fIsource\fR under
+the pathname \fItarget\fR.  If \fItarget\fR is an existing directory,
+then the second form is used.  The second form makes a copy inside
+\fItargetDir\fR of each \fIsource\fR file listed.  If a directory is
+specified as a \fIsource\fR, then the contents of the directory will be
+recursively copied into \fItargetDir\fR.  Existing files will not be
+overwritten unless the \fB\-force\fR option is specified.  Trying to
+overwrite a non-empty directory, overwrite a directory with a file, or a
+file with a directory will all result in errors even if \fI\-force\fR was
+specified.  Arguments are processed in the order specified, halting at the
+first error, if any.  A \fB\-\|\-\fR marks the end of switches; the argument
+following the \fB\-\|\-\fR will be treated as a \fIsource\fR even if it
+starts with a \fB\-\fR.
+.RE
+.TP
+\fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIpathname\fR ?\fIpathname\fR ... ?
+.
+Removes the file or directory specified by each \fIpathname\fR argument.
+Non-empty directories will be removed only if the \fB\-force\fR option is
+specified.  Trying to delete a non-existant file is not considered an
+error.  Trying to delete a read-only file will cause the file to be deleted,
+even if the \fB\-force\fR flags is not specified.  Arguments are processed
+in the order specified, halting at the first error, if any.  A \fB\-\|\-\fR
+marks the end of switches; the argument following the \fB\-\|\-\fR will be
+treated as a \fIpathname\fR even if it starts with a \fB\-\fR.
 .TP
 \fBfile dirname \fIname\fR
-.VS
 Returns a name comprised of all of the path components in \fIname\fR
 excluding the last element.  If \fIname\fR is a relative file name and
 only contains one path element, then returns ``\fB.\fR'' (or ``\fB:\fR''
@@ -50,7 +117,7 @@ root directory is returned.  For example,
 returns \fBc:/\fR. 
 .PP
 Note that tilde substitution will only be
-performed if it is necessary to complete the command.  For example,
+performed if it is necessary to complete the command. For example,
 .CS
 \fBfile dirname ~/src/foo.c\fR
 .CE
@@ -60,36 +127,35 @@ returns \fB~/src\fR, whereas
 .CE
 returns \fB/home\fR (or something similar).
 .RE
-.VE
 .TP
 \fBfile executable \fIname\fR
-Returns \fB1\fR if file \fIname\fR is executable by
-the current user, \fB0\fR otherwise.
-Under UNIX this command uses the real user and group identifiers,
-not the effective ones.
+.
+Returns \fB1\fR if file \fIname\fR is executable by the current user,
+\fB0\fR otherwise.  
 .TP
 \fBfile exists \fIname\fR
+.
 Returns \fB1\fR if file \fIname\fR exists and the current user has
 search privileges for the directories leading to it, \fB0\fR otherwise.
 .TP
 \fBfile extension \fIname\fR
-Returns all of the characters in \fIname\fR after and including the
-last dot in the last element of \fIname\fR.  If there is no dot in
-the last element of \fIname\fR then returns
-the empty string.
+.
+Returns all of the characters in \fIname\fR after and including the last
+dot in the last element of \fIname\fR.  If there is no dot in the last
+element of \fIname\fR then returns the empty string.
 .TP
 \fBfile isdirectory \fIname\fR
-Returns \fB1\fR if file \fIname\fR is a directory,
-\fB0\fR otherwise.
+.
+Returns \fB1\fR if file \fIname\fR is a directory, \fB0\fR otherwise.
 .TP
 \fBfile isfile \fIname\fR
-Returns \fB1\fR if file \fIname\fR is a regular file,
-\fB0\fR otherwise.
-.VS br
+.
+Returns \fB1\fR if file \fIname\fR is a regular file, \fB0\fR otherwise.
 .TP
 \fBfile join \fIname\fR ?\fIname ...\fR?
-Takes one or more file names and combines them, using the correct
-path separator for the current platform.  If a particular \fIname\fR is
+.
+Takes one or more file names and combines them, using the correct path
+separator for the current platform.  If a particular \fIname\fR is
 relative, then it will be joined to the previous file name argument.
 Otherwise, any earlier arguments will be discarded, and joining will
 proceed from the current argument.  For example,
@@ -103,9 +169,9 @@ Note that any of the names can contain separators, and that the result
 is always canonical for the current platform: \fB/\fR for Unix and
 Windows, and \fB:\fR for Macintosh.
 .RE
-.VE
 .TP
 \fBfile lstat \fIname varName\fR
+.
 Same as \fBstat\fR option (see below) except uses the \fIlstat\fR
 kernel call instead of \fIstat\fR.  This means that if \fIname\fR
 refers to a symbolic link the information returned in \fIvarName\fR
@@ -113,19 +179,38 @@ is for the link rather than the file it refers to.  On systems that
 don't support symbolic links this option behaves exactly the same
 as the \fBstat\fR option.
 .TP
+\fBfile mkdir \fIdir\fR ?\fIdir\fR ...?
+.
+Creates each directory specified.  For each pathname \fIdir\fR specified,
+this command will create all non-existing parent directories as
+well as \fIdir\fR itself.  If an existing directory is specified, then
+no action is taken and no error is returned.  Trying to overwrite an existing
+file with a directory will result in an error.  Arguments are processed in
+the order specified, halting at the first error, if any.
+.TP
 \fBfile mtime \fIname\fR
-Returns a decimal string giving the time at which file \fIname\fR
-was last modified.  The time is measured in the standard POSIX
-fashion as seconds from a fixed starting time (often January 1, 1970).
-If the file doesn't exist or its modified time cannot be queried then an
-error is generated.
+.
+Returns a decimal string giving the time at which file \fIname\fR was
+last modified.  The time is measured in the standard POSIX fashion as
+seconds from a fixed starting time (often January 1, 1970).  If the file
+doesn't exist or its modified time cannot be queried then an error is
+generated.
+.VS
 .TP
-\fBfile owned \fIname\fR
-Returns \fB1\fR if file \fIname\fR is owned by the current user,
-\fB0\fR otherwise.
-.VS br
+\fBfile nativename \fIname\fR
+.
+Returns the platform-specific name of the file. This is useful if the
+filename is needed to pass to a platform-specific call, such as exec
+under Windows or AppleScript on the Macintosh.
+.VE
+.TP
+\fBfile owned \fIname\fR 
+.
+Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR
+otherwise.
 .TP
 \fBfile pathtype \fIname\fR
+.
 Returns one of \fBabsolute\fR, \fBrelative\fR, \fBvolumerelative\fR.  If
 \fIname\fR refers to a specific file on a specific volume, the path type
 will be \fBabsolute\fR.  If \fIname\fR refers to a file relative to the
@@ -133,37 +218,55 @@ current working directory, then the path type will be \fBrelative\fR.  If
 \fIname\fR refers to a file relative to the current working directory on
 a specified volume, or to a specific file on the current working volume, then
 the file type is \fBvolumerelative\fR.
-.VE
 .TP
 \fBfile readable \fIname\fR
-Returns \fB1\fR if file \fIname\fR is readable by
-the current user, \fB0\fR otherwise.
-Under UNIX this command uses the real user and group identifiers,
-not the effective ones.
+.
+Returns \fB1\fR if file \fIname\fR is readable by the current user,
+\fB0\fR otherwise. 
 .TP
 \fBfile readlink \fIname\fR
-Returns the value of the symbolic link given by \fIname\fR (i.e. the
-name of the file it points to).  If
-\fIname\fR isn't a symbolic link or its value cannot be read, then
-an error is returned.  On systems that don't support symbolic links
-this option is undefined.
+.
+Returns the value of the symbolic link given by \fIname\fR (i.e. the name
+of the file it points to).  If \fIname\fR isn't a symbolic link or its
+value cannot be read, then an error is returned.  On systems that don't
+support symbolic links this option is undefined.
+.PP
+\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
+.br
+\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR
+.RS
+The first form takes the file or directory specified by pathname
+\fIsource\fR and renames it to \fItarget\fR, moving the file if the
+pathname \fItarget\fR specifies a name in a different directory.  If
+\fItarget\fR is an existing directory, then the second form is used.  The
+second form moves each \fIsource\fR file or directory into the directory
+\fItargetDir\fR.  Existing files will not be overwritten unless the
+\fB\-force\fR option is specified.  Trying to overwrite a non-empty
+directory, overwrite a directory with a file, or a file with a directory
+will all result in errors.  Arguments are processed in the order specified,
+halting at the first error, if any.  A \fB\-\|\-\fR marks the end of
+switches; the argument following the \fB\-\|\-\fR will be treated as a
+\fIsource\fR even if it starts with a \fB\-\fR.
+.RE
 .TP
 \fBfile rootname \fIname\fR
-Returns all of the characters in \fIname\fR up to but not including
-the last ``.'' character in the last component of name.  If the last
+.
+Returns all of the characters in \fIname\fR up to but not including the
+last ``.'' character in the last component of name.  If the last
 component of \fIname\fR doesn't contain a dot, then returns \fIname\fR.
 .TP
 \fBfile size \fIname\fR
-Returns a decimal string giving the size of file \fIname\fR in bytes.
-If the file doesn't exist or its size cannot be queried then an
-error is generated.
-.VS br
+.
+Returns a decimal string giving the size of file \fIname\fR in bytes.  If
+the file doesn't exist or its size cannot be queried then an error is
+generated.
 .TP
 \fBfile split \fIname\fR
+.
 Returns a list whose elements are the path components in \fIname\fR.  The
 first element of the list will have the same path type as \fIname\fR.
 All other elements will be relative.  Path separators will be discarded
-unless they are needed ensure that an element is unambiguously relative.  
+unless they are needed ensure that an element is unambiguously relative.
 For example, under Unix
 .RS
 .CS
@@ -173,45 +276,56 @@ returns \fB/\0\0foo\0\0./~bar\0\0baz\fR to ensure that later commands
 that use the third component do not attempt to perform tilde
 substitution.
 .RE
-.VE
 .TP
 \fBfile stat  \fIname varName\fR
-Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the
-variable given by \fIvarName\fR to hold information returned from
-the kernel call.
-\fIVarName\fR is treated as an array variable,
-and the following elements of that variable are set: \fBatime\fR,
-\fBctime\fR, \fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR, \fBmtime\fR,
-\fBnlink\fR, \fBsize\fR, \fBtype\fR, \fBuid\fR.
-Each element except \fBtype\fR is a decimal string with the value of
-the corresponding field from the \fBstat\fR return structure; see the
-manual entry for \fBstat\fR for details on the meanings of the values.
-The \fBtype\fR element gives the type of the file in the same form
-returned by the command \fBfile type\fR.
-This command returns an empty string.
+.
+Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
+given by \fIvarName\fR to hold information returned from the kernel call.
+\fIVarName\fR is treated as an array variable, and the following elements
+of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR,
+\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR,
+\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
+value of the corresponding field from the \fBstat\fR return structure;
+see the manual entry for \fBstat\fR for details on the meanings of the
+values.  The \fBtype\fR element gives the type of the file in the same
+form returned by the command \fBfile type\fR.  This command returns an
+empty string.
 .TP
 \fBfile tail \fIname\fR
-.VS
+.
 Returns all of the characters in \fIname\fR after the last directory
 separator.  If \fIname\fR contains no separators then returns
 \fIname\fR.
-.VE
 .TP
 \fBfile type \fIname\fR
-Returns a string giving the type of file \fIname\fR, which will be
-one of \fBfile\fR, \fBdirectory\fR, \fBcharacterSpecial\fR,
-\fBblockSpecial\fR, \fBfifo\fR, \fBlink\fR, or \fBsocket\fR.
+.
+Returns a string giving the type of file \fIname\fR, which will be one of
+\fBfile\fR, \fBdirectory\fR, \fBcharacterSpecial\fR, \fBblockSpecial\fR,
+\fBfifo\fR, \fBlink\fR, or \fBsocket\fR.
+.TP
+\fBfile volume\fR
+. 
+Returns the absolute paths to the volumes mounted on the system, as a proper 
+Tcl list.  On the Macintosh, this will be a list of the mounted drives, 
+both local and network.  N.B. if two drives have the same name, they will 
+both appear on the volume list, but there is currently no way, from Tcl, to 
+access any but the first of these drives.  On UNIX, the command will always return 
+"/", since all filesystems are locally mounted.  On Windows, it will return 
+a list of the available local drives (e.g. {a:/ c:/}).
 .TP
 \fBfile writable \fIname\fR
-Returns \fB1\fR if file \fIname\fR is writable by
-the current user, \fB0\fR otherwise.
-Under UNIX this command uses the real user and group identifiers,
-not the effective ones.
+.
+Returns \fB1\fR if file \fIname\fR is writable by the current user,
+\fB0\fR otherwise.
+.SH "PORTABILITY ISSUES"
+.TP
+\fBUnix\fR\0\0\0\0\0\0\0
+.
+These commands always operate using the real user and group identifiers,
+not the effective ones. 
 
-.VS
 .SH "SEE ALSO"
 filename
-.VE
 
 .SH KEYWORDS
-attributes, directory, file, name, stat
+attributes, copy files, delete files, directory, file, move files, name, rename files, stat
diff --git a/contrib/tcl/doc/flush.n b/contrib/tcl/doc/flush.n
index 4a224a8..f69354a 100644
--- a/contrib/tcl/doc/flush.n
+++ b/contrib/tcl/doc/flush.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) flush.n 1.9 96/02/15 20:02:05
+'\" SCCS: @(#) flush.n 1.10 96/08/26 12:59:57
 '\" 
 .so man.macros
 .TH flush n 7.5 Tcl "Tcl Built-In Commands"
@@ -22,13 +22,11 @@ flush \- Flush buffered output for a channel
 Flushes any output that has been buffered for \fIchannelId\fR.
 \fIChannelId\fR must be a channel identifier such as returned by a previous
 \fBopen\fR or \fBsocket\fR command, and it must have been opened for writing.
-.VS
 If the channel is in blocking mode the command does not return until all the
 buffered output has been flushed to the channel. If the channel is in
 nonblocking mode, the command may return before all buffered output has been
 flushed; the remainder will be flushed in the background as fast as the
 underlying file or device is able to absorb it.
-.VE
 
 .SH "SEE ALSO"
 open(n), socket(n)
diff --git a/contrib/tcl/doc/for.n b/contrib/tcl/doc/for.n
index 11e5d01..3680cf4 100644
--- a/contrib/tcl/doc/for.n
+++ b/contrib/tcl/doc/for.n
@@ -1,11 +1,11 @@
 '\"
 '\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) for.n 1.5 96/03/25 20:15:01
+'\" SCCS: @(#) for.n 1.6 97/04/08 17:13:49
 '\" 
 .so man.macros
 .TH for n "" Tcl "Tcl Built-In Commands"
@@ -39,6 +39,22 @@ return immediately.
 The operation of \fBbreak\fR and \fBcontinue\fR are similar to the
 corresponding statements in C.
 \fBFor\fR returns an empty string.
+.PP
+Note: \fItest\fR should almost always be enclosed in braces.  If not,
+variable substitutions will be made before the \fBfor\fR
+command starts executing, which means that variable changes
+made by the loop body will not be considered in the expression.
+This is likely to result in an infinite loop.  If \fItest\fR is
+enclosed in braces, variable substitutions are delayed until the
+expression is evaluated (before
+each loop iteration), so changes in the variables will be visible.
+For an example, try the following script with and without the braces
+around \fB$x<10\fR:
+.CS
+for {set x 0} {$x<10} {incr x} {
+	puts "x is $x"
+}
+.CE
 
 .SH KEYWORDS
 for, iteration, looping
diff --git a/contrib/tcl/doc/format.n b/contrib/tcl/doc/format.n
index a207fa3..57c97d6 100644
--- a/contrib/tcl/doc/format.n
+++ b/contrib/tcl/doc/format.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) format.n 1.10 96/03/25 20:15:25
+'\" SCCS: @(#) format.n 1.11 96/08/26 12:59:57
 '\" 
 .so man.macros
 .TH format n "" Tcl "Tcl Built-In Commands"
@@ -44,16 +44,13 @@ The \fBformat\fR command must be given enough \fIarg\fRs to meet the needs
 of all of the conversion specifiers in \fIformatString\fR.
 .PP
 Each conversion specifier may contain up to six different parts:
-.VS
 an XPG3 position specifier,
-.VE
 a set of flags, a minimum field width, a precision, a length modifier,
 and a conversion character.
 Any of these fields may be omitted except for the conversion character.
 The fields that are present must appear in the order given above.
 The paragraphs below discuss each of these fields in turn.
 .PP
-.VS
 If the \fB%\fR is followed by a decimal number and a \fB$\fR, as in
 ``\fB%2$d\fR'', then the value to convert is not taken from the
 next sequential argument.
@@ -66,7 +63,6 @@ given by the number.
 This follows the XPG3 conventions for positional specifiers.
 If there are any positional specifiers in \fIformatString\fR
 then all of the specifiers must be positional.
-.VE
 .PP
 The second portion of a conversion specifier may contain any of the
 following flag characters, in any order:
@@ -196,25 +192,21 @@ the conversion specifier.
 
 .SH "DIFFERENCES FROM ANSI SPRINTF"
 .PP
-.VS
 The behavior of the format command is the same as the
 ANSI C \fBsprintf\fR procedure except for the following
 differences:
 .IP [1]
 \fB%p\fR and \fB%n\fR specifiers are not currently supported.
-.VE
 .IP [2]
 For \fB%c\fR conversions the argument must be a decimal string,
 which will then be converted to the corresponding character value.
 .IP [3]
-.VS
 The \fBl\fR modifier is ignored;  integer values are always converted
 as if there were no modifier present and real values are always
 converted as if the \fBl\fR modifier were present (i.e. type
 \fBdouble\fR is used for the internal representation).
 If the \fBh\fR modifier is specified then integer values are truncated
 to \fBshort\fR before conversion.
-.VE
 
 .SH KEYWORDS
 conversion specifier, format, sprintf, string, substitution
diff --git a/contrib/tcl/doc/gets.n b/contrib/tcl/doc/gets.n
index 175a831..025f76d 100644
--- a/contrib/tcl/doc/gets.n
+++ b/contrib/tcl/doc/gets.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) gets.n 1.12 96/02/15 20:02:08
+'\" SCCS: @(#) gets.n 1.13 96/08/26 12:59:58
 '\" 
 .so man.macros
 .TH gets n 7.5 Tcl "Tcl Built-In Commands"
@@ -28,7 +28,6 @@ If \fIvarName\fR is specified then the line is placed in the variable by
 that name and the return value is a count of the number of characters
 returned.
 .PP
-.VS
 If end of file occurs while scanning for an end of
 line, the command returns whatever input is available up to the end of file.
 If \fIchannelId\fR is in nonblocking mode and there is not a full
@@ -43,7 +42,6 @@ produce the same results as if there were an input line consisting
 only of the end-of-line character(s).
 The \fBeof\fR and \fBfblocked\fR commands can be used to distinguish
 these three cases.
-.VE
 
 .SH "SEE ALSO"
 eof(n), fblocked(n)
diff --git a/contrib/tcl/doc/glob.n b/contrib/tcl/doc/glob.n
index 11c6cc7..2097534 100644
--- a/contrib/tcl/doc/glob.n
+++ b/contrib/tcl/doc/glob.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) glob.n 1.10 96/03/25 20:15:48
+'\" SCCS: @(#) glob.n 1.11 96/08/26 12:59:59
 '\" 
 .so man.macros
 .TH glob n 7.5 Tcl "Tcl Built-In Commands"
@@ -24,7 +24,6 @@ the csh shell.  It returns a list of the files whose names match any
 of the \fIpattern\fR arguments.
 .LP
 If the initial arguments to \fBglob\fR start with \fB\-\fR then
-.VS
 they are treated as switches.  The following switches are
 currently supported:
 .TP 15
@@ -35,7 +34,6 @@ switch an error is returned if the result list would be empty.
 \fB\-\|\-\fR
 Marks the end of switches.  The argument following this one will
 be treated as a \fIpattern\fR even if it starts with a \fB\-\fR.
-.VE
 .PP
 The \fIpattern\fR arguments may contain any of the following
 special characters:
@@ -69,7 +67,6 @@ the HOME environment variable is used.
 The \fBglob\fR command differs from csh globbing in two ways.
 First, it does not sort its result list (use the \fBlsort\fR
 command if you want the list sorted).
-.VS
 Second, \fBglob\fR only returns the names of files that actually
 exist;  in csh no check for existence is made unless a pattern
 contains a ?, *, or [] construct.
@@ -82,7 +79,6 @@ native and network names are specified), the \fBglob\fR command only
 accepts native names.  Also, for Windows UNC names, the servername and
 sharename components of the path may not contain ?, *, or []
 constructs. 
-.VE
 
 .SH KEYWORDS
 exist, file, glob, pattern
diff --git a/contrib/tcl/doc/global.n b/contrib/tcl/doc/global.n
index 17ac62f..a89cbef 100644
--- a/contrib/tcl/doc/global.n
+++ b/contrib/tcl/doc/global.n
@@ -1,11 +1,11 @@
 '\"
 '\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) global.n 1.5 96/03/25 20:16:10
+'\" SCCS: @(#) global.n 1.6 97/05/18 15:23:09
 '\" 
 .so man.macros
 .TH global n "" Tcl "Tcl Built-In Commands"
@@ -21,10 +21,15 @@ global \- Access global variables
 .PP
 This command is ignored unless a Tcl procedure is being interpreted.
 If so then it declares the given \fIvarname\fR's to be global variables
-rather than local ones.  For the duration of the current procedure
-(and only while executing in the current procedure), any reference to
-any of the \fIvarname\fRs will refer to the global variable by the same
-name.
+rather than local ones.
+Global variables are variables in the global namespace.
+For the duration of the current procedure
+(and only while executing in the current procedure),
+any reference to any of the \fIvarname\fRs
+will refer to the global variable by the same name.
+
+.SH "SEE ALSO"
+namespace(n), variable(n)
 
 .SH KEYWORDS
-global, procedure, variable
+global, namespace, procedure, variable
diff --git a/contrib/tcl/doc/http.n b/contrib/tcl/doc/http.n
new file mode 100644
index 0000000..5a5b2d2
--- /dev/null
+++ b/contrib/tcl/doc/http.n
@@ -0,0 +1,359 @@
+'\"
+'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) http.n 1.10 97/06/24 17:15:09
+'\" 
+.so man.macros
+.TH "Http" n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Http \- Client-side implementation of the HTTP/1.0 protocol.
+.SH SYNOPSIS
+\fBpackage require http ?1.0?\fP
+.sp
+\fBhttp_config \fI?options?\fR
+.sp
+\fBhttp_get \fIurl ?options?\fR
+.sp
+\fBhttp_formatQuery \fIlist\fR
+.sp
+\fBhttp_reset \fItoken\fR
+.sp
+\fBhttp_wait \fItoken\fR
+.sp
+\fBhttp_status \fItoken\fR
+.sp
+\fBhttp_size \fItoken\fR
+.sp
+\fBhttp_code \fItoken\fR
+.sp
+\fBhttp_data \fItoken\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBhttp\fR package provides the client side of the HTTP/1.0
+protocol.  The package implements the GET, POST, and HEAD operations
+of HTTP/1.0.  It allows configuration of a proxy host to get through
+firewalls.  The package is compatible with the \fBSafesock\fR security
+policy, so it can be used by untrusted applets to do URL fetching from
+a restricted set of hosts.
+.PP
+The \fBhttp_get\fR procedure does a HTTP transaction.
+Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction
+is performed.  
+The return value of \fBhttp_get\fR is a token for the transaction.
+The value is also the name of a global array that contains state
+information about the transaction.  The elements of this array are
+described in the STATE ARRAY section.
+.PP
+If the \fB-command\fP option is specified, then
+the HTTP operation is done in the background.
+\fBhttp_get\fR returns immediately after generating the
+HTTP request and the callback is invoked
+when the transaction completes.  For this to work, the Tcl event loop
+must be active.  In Tk applications this is always true.  For pure-Tcl
+applications, the caller can use \fBhttp_wait\fR after calling
+\fBhttp_get\fR to start the event loop.
+.SH COMMANDS
+.TP
+\fBhttp_config\fP ?\fIoptions\fR?
+The \fBhttp_config\fR command is used to set and query the name of the
+proxy server and port, and the User-Agent name used in the HTTP
+requests.  If no options are specified, then the current configuration
+is returned.  If a single argument is specified, then it should be one
+of the flags described below.  In this case the current value of
+that setting is returned.  Otherwise, the options should be a set of
+flags and values that define the configuration:
+.RS
+.TP
+\fB\-accept\fP \fImimetypes\fP
+The Accept header of the request.  The default is */*, which means that
+all types of documents are accepted.  Otherwise you can supply a 
+comma separated list of mime type patterns that you are
+willing to receive.  For example, "image/gif, image/jpeg, text/*".
+.TP
+\fB\-proxyhost\fP \fIhostname\fP
+The name of the proxy host, if any.  If this value is the
+empty string, the URL host is contacted directly.
+.TP
+\fB\-proxyport\fP \fInumber\fP
+The proxy port number.
+.TP
+\fB\-proxyfilter\fP \fIcommand\fP
+The command is a callback that is made during
+\fBhttp_get\fR
+to determine if a proxy is required for a given host.  One argument, a
+host name, is added to \fIcommand\fR when it is invoked.  If a proxy
+is required, the callback should return a two element list containing
+the proxy server and proxy port.  Otherwise the filter should return
+an empty list.  The default filter returns the values of the
+\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
+non-empty.
+.TP
+\fB\-useragent\fP \fIstring\fP
+The value of the User-Agent header in the HTTP request.  The default
+is \fB"Tcl http client package 1.0."\fR
+.RE
+.TP
+\fBhttp_get\fP \fIurl\fP ?\fIoptions\fP? 
+The \fBhttp_get \fR command is the main procedure in the package.
+The \fB\-query\fR option causes a POST operation and
+the \fB\-validate\fR option causes a HEAD operation;
+otherwise, a GET operation is performed.  The \fBhttp_get\fR command
+returns a \fItoken\fR value that can be used to get
+information about the transaction.  See the STATE ARRAY section for
+details.  The \fBhttp_get\fR command blocks until the operation
+completes, unless the \fB\-command\fR option specifies a callback
+that is invoked when the HTTP transaction completes.
+\fBhttp_get\fR takes several options:
+.RS
+.TP
+\fB\-blocksize\fP \fIsize\fP
+The blocksize used when reading the URL.
+At most 
+\fIsize\fR
+bytes are read at once.  After each block, a call to the
+\fB\-progress\fR
+callback is made.
+.TP
+\fB\-channel\fP \fIname\fP
+Copy the URL contents to channel \fIname\fR instead of saving it in
+\fBstate(body)\fR.
+.TP
+\fB\-command\fP \fIcallback\fP
+Invoke \fIcallback\fP after the HTTP transaction completes.
+This option causes \fBhttp_get\fP to return immediately.
+The \fIcallback\fP gets an additional argument that is the \fItoken\fR returned
+from \fBhttp_get\fR. This token is the name of a global array that is
+described in the STATE ARRAY section.  Here is a template for the
+callback:
+.RS
+.CS
+proc httpCallback {token} {
+    upvar #0 $token state
+    # Access state as a Tcl array
+}
+.CE
+.RE
+.TP
+\fB\-handler\fP \fIcallback\fP
+Invoke \fIcallback\fP whenever HTTP data is available; if present, nothing
+else will be done with the HTTP data.  This procedure gets two additional
+arguments: the socket for the HTTP data and the \fItoken\fR returned from
+\fBhttp_get\fR.  The token is the name of a global array that is described
+in the STATE ARRAY section.  The procedure is expected to return the number
+of bytes read from the socket.  Here is a template for the callback:
+.RS
+.CS
+proc httpHandlerCallback {socket token} {
+    upvar #0 $token state
+    # Access socket, and state as a Tcl array
+    ...
+    (example: set data [read $socket 1000];set nbytes [string length $data])
+    ...
+    return nbytes
+}
+.CE
+.RE
+.TP
+\fB\-headers\fP \fIkeyvaluelist\fP
+This option is used to add extra headers to the HTTP request.  The
+\fIkeyvaluelist\fR argument must be a list with an even number of
+elements that alternate between keys and values.  The keys become
+header field names.  Newlines are stripped from the values so the
+header cannot be corrupted.  For example, if \fIkeyvaluelist\fR is
+\fBPragma no-cache\fR then the following header is included in the
+HTTP request:
+.CS
+Pragma: no-cache
+.CE
+.TP
+\fB\-progress\fP \fIcallback\fP
+The \fIcallback\fR is made after each transfer of data from the URL.
+The callback gets three additional arguments: the \fItoken\fR from
+\fBhttp_get\fR, the expected total size of the contents from the
+\fBContent-Length\fR meta-data, and the current number of bytes
+transferred so far.  The expected total size may be unknown, in which
+case zero is passed to the callback.  Here is a template for the
+progress callback:
+.RS
+.CS
+proc httpProgress {token total current} {
+    upvar #0 $token state
+}
+.CE
+.RE
+.TP
+\fB\-query\fP \fIquery\fP
+This flag causes \fBhttp_get\fR to do a POST request that passes the
+\fIquery\fR to the server. The \fIquery\fR must be a x-url-encoding
+formatted query.  The \fBhttp_formatQuery\fR procedure can be used to
+do the formatting.
+.TP
+\fB\-timeout\fP \fImilliseconds\fP
+If \fImilliseconds\fR is non-zero, then \fBhttp_get\fR sets up a timeout
+to occur after the specified number of milliseconds.
+A timeout results in a call to \fBhttp_reset\fP and to
+the \fB-command\fP callback, if specified.
+The return value of \fBhttp_status\fP is \fBtimeout\fP
+after a timeout has occurred.
+.TP
+\fB\-validate\fP \fIboolean\fP
+If \fIboolean\fR is non-zero, then \fBhttp_get\fR does an HTTP HEAD
+request.  This request returns meta information about the URL, but the
+contents are not returned.  The meta information is available in the
+\fBstate(meta) \fR variable after the transaction.  See the STATE
+ARRAY section for details.
+.RE
+.TP
+\fBhttp_formatQuery\fP \fIkey value\fP ?\fIkey value\fP ...?
+This procedure does x-url-encoding of query data.  It takes an even
+number of arguments that are the keys and values of the query.  It
+encodes the keys and values, and generates one string that has the
+proper & and = separators.  The result is suitable for the
+\fB\-query\fR value passed to \fBhttp_get\fR.
+.TP
+\fBhttp_reset\fP \fItoken\fP ?\fIwhy\fP?
+This command resets the HTTP transaction identified by \fItoken\fR, if
+any.  This sets the \fBstate(status)\fP value to \fIwhy\fP, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback.
+.TP
+\fBhttp_wait\fP \fItoken\fP
+This is a convenience procedure that blocks and waits for the
+transaction to complete.  This only works in trusted code because it
+uses \fBvwait\fR.
+.TP
+\fBhttp_data\fP \fItoken\fP
+This is a convenience procedure that returns the \fBbody\fP element
+(i.e., the URL data) of the state array.
+.TP
+\fBhttp_status\fP \fItoken\fP
+This is a convenience procedure that returns the \fBstatus\fP element of
+the state array.
+.TP
+\fBhttp_code\fP \fItoken\fP
+This is a convenience procedure that returns the \fBhttp\fP element of the
+state array.
+.TP
+\fBhttp_size\fP \fItoken\fP
+This is a convenience procedure that returns the \fBcurrentsize\fP
+element of the state array.
+.SH "STATE ARRAY"
+The \fBhttp_get\fR procedure returns a \fItoken\fR that can be used to
+get to the state of the HTTP transaction in the form of a Tcl array.
+Use this construct to create an easy-to-use array variable:
+.CS
+upvar #0 $token state
+.CE
+The following elements of the array are supported:
+.RS
+.TP
+\fBbody\fR
+The contents of the URL.  This will be empty if the \fB\-channel\fR
+option has been specified.  This value is returned by the \fBhttp_data\fP command.
+.TP
+\fBcurrentsize\fR
+The current number of bytes fetched from the URL.
+This value is returned by the \fBhttp_size\fP command.
+.TP
+\fBerror\fR
+If defined, this is the error string seen when the HTTP transaction
+was aborted.
+.TP
+\fBhttp\fR
+The HTTP status reply from the server.  This value
+is returned by the \fBhttp_code\fP command.  The format of this value is:
+.RS
+.CS
+\fIcode string\fP
+.CE
+The \fIcode\fR is a three-digit number defined in the HTTP standard.
+A code of 200 is OK.  Codes beginning with 4 or 5 indicate errors.
+Codes beginning with 3 are redirection errors.  In this case the
+\fBLocation\fR meta-data specifies a new URL that contains the
+requested information.
+.RE
+.TP
+\fBmeta\fR
+The HTTP protocol returns meta-data that describes the URL contents.
+The \fBmeta\fR element of the state array is a list of the keys and
+values of the meta-data.  This is in a format useful for initializing
+an array that just contains the meta-data:
+.RS
+.CS
+array set meta $state(meta)
+.CE
+Some of the meta-data keys are listed below, but the HTTP standard defines
+more, and servers are free to add their own.
+.TP
+\fBContent-Type\fR
+The type of the URL contents.  Examples include \fBtext/html\fR,
+\fBimage/gif,\fR \fBapplication/postscript\fR and
+\fBapplication/x-tcl\fR.
+.TP
+\fBContent-Length\fR
+The advertised size of the contents.  The actual size obtained by
+\fBhttp_get\fR is available as \fBstate(size)\fR.
+.TP
+\fBLocation\fR
+An alternate URL that contains the requested data.
+.RE
+.TP
+\fBstatus\fR
+Either \fBok\fR, for successful completion, \fBreset\fR for
+user-reset, or \fBerror\fR for an error condition.  During the
+transaction this value is the empty string.
+.TP
+\fBtotalsize\fR
+A copy of the \fBContent-Length\fR meta-data value.
+.TP
+\fBtype\fR
+A copy of the \fBContent-Type\fR meta-data value.
+.TP
+\fBurl\fR
+The requested URL.
+.RE
+.SH EXAMPLE
+.DS
+# Copy a URL to a file and print meta-data
+proc Http_Copy { url file {chunk 4096} } {
+    set out [open $file w]
+    set token [http_get $url -channel $out -progress HttpProgress \\
+	-blocksize $chunk]
+    close $out
+    # This ends the line started by HttpProgress
+    puts stderr ""
+    upvar #0 $token state
+    set max 0
+    foreach {name value} $state(meta) {
+	if {[string length $name] > $max} {
+	    set max [string length $name]
+	}
+	if {[regexp -nocase ^location$ $name]} {
+	    # Handle URL redirects
+	    puts stderr "Location:$value"
+	    return [Http_Copy [string trim $value] $file $chunk]
+	}
+    }
+    incr max
+    foreach {name value} $state(meta) {
+	puts [format "%-*s %s" $max $name: $value]
+    }
+
+    return $token
+}
+proc HttpProgress {args} {
+    puts -nonewline stderr . ; flush stderr
+}
+
+.DE
+.SH "SEE ALSO"
+safe(n), socket(n), safesock(n)
+.SH KEYWORDS
+security policy, socket
+
+
diff --git a/contrib/tcl/doc/if.n b/contrib/tcl/doc/if.n
index f76d8d9..9e86214 100644
--- a/contrib/tcl/doc/if.n
+++ b/contrib/tcl/doc/if.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) if.n 1.6 96/03/25 20:16:42
+'\" SCCS: @(#) if.n 1.7 96/08/26 13:00:00
 '\" 
 .so man.macros
 .TH if n "" Tcl "Tcl Built-In Commands"
@@ -22,11 +22,9 @@ if \- Execute scripts conditionally
 The \fIif\fR command evaluates \fIexpr1\fR as an expression (in the
 same way that \fBexpr\fR evaluates its argument).  The value of the
 expression must be a boolean
-.VS
 (a numeric value, where 0 is false and
 anything is true, or a string value such as \fBtrue\fR or \fByes\fR
 for true and \fBfalse\fR or \fBno\fR for false);
-.VE
 if it is true then \fIbody1\fR is executed by passing it to the
 Tcl interpreter.
 Otherwise \fIexpr2\fR is evaluated as an expression and if it is true
diff --git a/contrib/tcl/doc/info.n b/contrib/tcl/doc/info.n
index a84509c..a0c2001 100644
--- a/contrib/tcl/doc/info.n
+++ b/contrib/tcl/doc/info.n
@@ -1,11 +1,12 @@
 '\"
 '\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) info.n 1.13 96/07/20 16:07:40
+'\" SCCS: @(#) info.n 1.17 97/05/19 14:48:52
 '\" 
 .so man.macros
 .TH info n 7.5 Tcl "Tcl Built-In Commands"
@@ -37,12 +38,21 @@ Returns a count of the total number of commands that have been invoked
 in this interpreter.
 .TP
 \fBinfo commands \fR?\fIpattern\fR?
-If \fIpattern\fR isn't specified, returns a list of names of all the
-Tcl commands, including both the built-in commands written in C and
+If \fIpattern\fR isn't specified,
+returns a list of names of all the Tcl commands in the current namespace,
+including both the built-in commands written in C and
 the command procedures defined using the \fBproc\fR command.
-If \fIpattern\fR is specified, only those names matching \fIpattern\fR
-are returned.  Matching is determined using the same rules as for
-\fBstring match\fR.
+If \fIpattern\fR is specified,
+only those names matching \fIpattern\fR are returned.
+Matching is determined using the same rules as for \fBstring match\fR.
+\fIpattern\fR can be a qualified name like \fBFoo::print*\fR.
+That is, it may specify a particular namespace
+using a sequence of namespace names separated by \fB::\fRs,
+and may have pattern matching special characters
+at the end to specify a set of commands in that namespace.
+If \fIpattern\fR is a qualified name,
+the resulting list of command names has each one qualified with the name
+of the specified namespace.
 .TP
 \fBinfo complete \fIcommand\fR
 Returns 1 if \fIcommand\fR is a complete Tcl command in the sense of
@@ -68,15 +78,14 @@ otherwise.
 \fBinfo globals \fR?\fIpattern\fR?
 If \fIpattern\fR isn't specified, returns a list of all the names
 of currently-defined global variables.
+Global variables are variables in the global namespace.
 If \fIpattern\fR is specified, only those names matching \fIpattern\fR
 are returned.  Matching is determined using the same rules as for
 \fBstring match\fR.
-.VS br
 .TP
 \fBinfo hostname\fR
 Returns the name of the computer on which this invocation is being
 executed.
-.VE
 .TP
 \fBinfo level\fR ?\fInumber\fR?
 If \fInumber\fR is not specified, this command returns a number
@@ -94,7 +103,6 @@ levels mean.
 \fBinfo library\fR
 Returns the name of the library directory in which standard Tcl
 scripts are stored.
-.VS
 This is actually the value of the \fBtcl_library\fR
 variable and may be changed by setting \fBtcl_library\fR.
 See the \fBtclvars\fR manual entry for more information.
@@ -110,7 +118,6 @@ If \fIinterp\fR is omitted then information is returned for all packages
 loaded in any interpreter in the process.
 To get a list of just the packages in the current interpreter, specify
 an empty string for the \fIinterp\fR argument.
-.VE
 .TP
 \fBinfo locals \fR?\fIpattern\fR?
 If \fIpattern\fR isn't specified, returns a list of all the names
@@ -121,7 +128,6 @@ will not be returned.
 If \fIpattern\fR is specified, only those names matching \fIpattern\fR
 are returned.  Matching is determined using the same rules as for
 \fBstring match\fR.
-.VS br
 .TP
 \fBinfo nameofexecutable\fR
 Returns the full path name of the binary file from which the application
@@ -131,13 +137,14 @@ string is returned.
 \fBinfo patchlevel\fR
 Returns the value of the global variable \fBtcl_patchLevel\fR; see
 the \fBtclvars\fR manual entry for more information.
-.VE
 .TP
 \fBinfo procs \fR?\fIpattern\fR?
 If \fIpattern\fR isn't specified, returns a list of all the
-names of Tcl command procedures.
-If \fIpattern\fR is specified, only those names matching \fIpattern\fR
-are returned.  Matching is determined using the same rules as for
+names of Tcl command procedures in the current namespace.
+If \fIpattern\fR is specified,
+only those procedure names in the current namespace
+matching \fIpattern\fR are returned.
+Matching is determined using the same rules as for
 \fBstring match\fR.
 .TP
 \fBinfo script\fR
@@ -146,7 +153,6 @@ call to \fBTcl_EvalFile\fR active or there is an active invocation
 of the \fBsource\fR command), then this command returns the name
 of the innermost file being processed.  Otherwise the command returns an
 empty string.
-.VS br
 .TP
 \fBinfo sharedlibextension\fR
 Returns the extension used on this platform for the names of files
@@ -157,15 +163,23 @@ string is returned.
 \fBinfo tclversion\fR
 Returns the value of the global variable \fBtcl_version\fR; see
 the \fBtclvars\fR manual entry for more information.
-.VE
 .TP
 \fBinfo vars\fR ?\fIpattern\fR?
 If \fIpattern\fR isn't specified,
-returns a list of all the names of currently-visible variables, including
-both locals and currently-visible globals.
+returns a list of all the names of currently-visible variables.
+This includes locals and currently-visible globals.
 If \fIpattern\fR is specified, only those names matching \fIpattern\fR
 are returned.  Matching is determined using the same rules as for
 \fBstring match\fR.
+\fIpattern\fR can be a qualified name like \fBFoo::option*\fR.
+That is, it may specify a particular namespace
+using a sequence of namespace names separated by \fB::\fRs,
+and may have pattern matching special characters
+at the end to specify a set of variables in that namespace.
+If \fIpattern\fR is a qualified name,
+the resulting list of variable names
+has each matching namespace variable qualified with the name
+of its namespace.
 
 .SH KEYWORDS
-command, information, interpreter, level, procedure, variable
+command, information, interpreter, level, namespace, procedure, variable
diff --git a/contrib/tcl/doc/interp.n b/contrib/tcl/doc/interp.n
index 05615f6..a7dda33 100644
--- a/contrib/tcl/doc/interp.n
+++ b/contrib/tcl/doc/interp.n
@@ -4,10 +4,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) interp.n 1.19 96/05/10 16:36:44
+'\" SCCS: @(#) interp.n 1.29 97/03/06 17:41:39
 '\" 
 .so man.macros
-.TH interp n 7.5 Tcl "Tcl Built-In Commands"
+.TH interp n 7.6 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -15,6 +15,7 @@ interp \- Create and manipulate Tcl interpreters
 .SH SYNOPSIS
 \fBinterp \fIoption \fR?\fIarg arg ...\fR?
 .BE
+
 .SH DESCRIPTION
 .PP
 This command makes it possible to create one or more new Tcl 
@@ -43,32 +44,45 @@ The \fBinterp\fR command also provides support for \fIsafe\fR
 interpreters.  A safe interpreter is a slave whose functions have
 been greatly restricted, so that it is safe to execute untrusted
 scripts without fear of them damaging other interpreters or the
-application's environment.  For example, all IO channel creation commands
-and subprocess creation commands are removed from safe interpreters.
-See SAFE INTERPRETERS below for more information on what features
-are present in a safe interpreter.  The alias mechanism can be
-used for protected communication (analogous to a kernel call)
-between a slave interpreter and its master.
+application's environment. For example, all IO channel creation
+commands and subprocess creation commands are made inaccessible to safe
+interpreters.
+.VS
+See SAFE INTERPRETERS below for more information on
+what features are present in a safe interpreter.
+The dangerous functionality is not removed from the safe interpreter;
+instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
+access to it. For a detailed explanation of hidden commands, see
+HIDDEN COMMANDS, below.
+The alias mechanism can be used for protected communication (analogous to a
+kernel call) between a slave interpreter and its master. See ALIAS
+INVOCATION, below, for more details on how the alias mechanism works.
+.VE
 .PP
 A qualified interpreter name is a proper Tcl lists containing a subset of its
 ancestors in the interpreter hierarchy, terminated by the string naming the
 interpreter in its immediate master. Interpreter names are relative to the
-interpreter in which they are used. For example, if \fIa\fR is a slave of
-the current interpreter and it has a slave \fIa1\fR, which in turn has a
-slave \fIa11\fR, the qualified name of \fIa11\fR in \fIa\fR is the list
-\fI{a1 a11}\fR.
+interpreter in which they are used. For example, if \fBa\fR is a slave of
+the current interpreter and it has a slave \fBa1\fR, which in turn has a
+slave \fBa11\fR, the qualified name of \fBa11\fR in \fBa\fR is the list
+\fBa1 a11\fR.
 .PP
 The \fBinterp\fR command, described below, accepts qualified interpreter
 names as arguments; the interpreter in which the command is being evaluated
-can always be referred to as \fI{}\fR (the empty list or string). Note that
+can always be referred to as \fB{}\fR (the empty list or string). Note that
 it is impossible to refer to a master (ancestor) interpreter by name in a
 slave interpreter except through aliases. Also, there is no global name by
 which one can refer to the first interpreter created in an application.
 Both restrictions are motivated by safety concerns.
+
+.VS
+.SH "THE INTERP COMMAND"
 .PP
+.VE
 The \fBinterp\fR command is used to create, delete, and manipulate
-slave interpreters.  It can have any of several forms, depending on
-the \fIoption\fR argument:
+slave interpreters, and to share or transfer
+channels between interpreters.  It can have any of several forms, depending
+on the \fIoption\fR argument:
 .TP
 \fBinterp \fBalias \fIsrcPath \fIsrcCmd\fR
 Returns a Tcl list whose elements are the \fItargetCmd\fR and
@@ -117,9 +131,9 @@ Creates a slave interpreter identified by \fIpath\fR and a new command,
 called a \fIslave command\fR. The name of the slave command is the last
 component of \fIpath\fR. The new slave interpreter and the slave command
 are created in the interpreter identified by the path obtained by removing
-the last component from \fIpath\fR. For example, if \fIpath is ``\fBa b
-c\fR'' then a new slave interpreter and slave command named ``\fBc\fR'' are
-created in the interpreter identified by the path ``\fBa b\fR''.
+the last component from \fIpath\fR. For example, if \fIpath is \fBa b
+c\fR then a new slave interpreter and slave command named \fBc\fR are
+created in the interpreter identified by the path \fBa b\fR.
 The slave command may be used to manipulate the new interpreter as
 described below. If \fIpath\fR is omitted, Tcl creates a unique name of the
 form \fBinterp\fIx\fR, where \fIx\fR is an integer, and uses it for the
@@ -153,10 +167,49 @@ invoking interpreter.
 Returns  \fB1\fR if a slave interpreter by the specified \fIpath\fR
 exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
 invoking interpreter is used.
+.VS BR
+.TP
+\fBinterp \fBexpose \fIpath\fR \fIhiddenCmdName\fR ?\fIexposedCmdName\fR?
+Makes the hidden command \fIhiddenCmdName\fR exposed, potentially renaming
+it to \fIexposedCmdName\fR, in the interpreter denoted by \fIpath\fR.
+If an exposed command with the targetted name already exists, this command
+fails.
+Hidden commands are explained in more detail in HIDDEN COMMANDS, below.
+.TP
+\fBinterp \fBhide \fIpath\fR \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
+Makes the exposed command \fIexposedCmdName\fR hidden, potentially renaming
+it to \fIhiddenCmdName\fR, in the interpreter denoted by \fIpath\fR.
+If a hidden command with the targetted name already exists, this command
+fails.
+Hidden commands are explained in more detail in HIDDEN COMMANDS, below.
+.TP
+\fBinterp \fBhidden \fIpath\fR
+Returns a list of the names of all hidden commands in the interpreter
+identified by \fIpath\fR.
+.TP
+\fBinterp \fBinvokehidden\fR \fIpath\fR ?\fB-global\fR \fIhiddenCmdName\fR ?\fIarg ...\fR?
+Invokes the hidden command \fIhiddenCmdName\fR with the arguments supplied
+in the interpreter denoted by \fIpath\fR. No substitutions or evaluation
+are applied to the arguments.
+If the \fB-global\fR flag is present, the hidden command is invoked at the
+global level in the target interpreter; otherwise it is invoked at the
+current call frame and can access local variables in that and outer call
+frames.
+Hidden commands are explained in more detail in HIDDEN COMMANDS, below.
+.VE
 .TP
 \fBinterp \fBissafe\fR ?\fIpath\fR?
 Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR
 is safe, \fB0\fR otherwise.
+.VS BR
+.TP
+\fBinterp \fBmarktrusted\fR \fIpath\fR
+Marks the interpreter identified by \fIpath\fR as trusted. Does
+not expose the hidden commands. This command can only be invoked from a
+trusted interpreter.
+The command has no effect if the interpreter identified by \fIpath\fR is
+already trusted.
+.VE
 .TP
 \fBinterp \fBshare\fR \fIsrcPath channelId destPath\fR
 Causes the IO channel identified by \fIchannelId\fR to become shared
@@ -186,6 +239,7 @@ The target command does not have to be defined at the time of this invocation.
 Causes the IO channel identified by \fIchannelId\fR to become available in
 the interpreter identified by \fIdestPath\fR and unavailable in the
 interpreter identified by \fIsrcPath\fR.
+
 .SH "SLAVE COMMAND"
 .PP
 For each slave interpreter created with the \fBinterp\fR command, a
@@ -235,50 +289,46 @@ the resulting string as a Tcl script in \fIslave\fR.
 The result of this evaluation (including error information
 such as the \fBerrorInfo\fR and \fBerrorCode\fR variables, if an
 error occurs) is returned to the invoking interpreter.
+.VS BR
+.TP
+\fIslave \fBexpose \fIhiddenCmdName \fR?\fIexposedCmdName\fR?
+This command exposes the hidden command \fIhiddenCmdName\fR, potentially
+renaming it to \fIexposedCmdName\fR, in \fIslave\fR.
+If an exposed command with the targeted name already exists, this command
+fails.
+For more details on hidden commands, see HIDDEN COMMANDS, below.
+.TP
+\fIslave \fBhide \fIexposedCmdName \fR?\fIhiddenCmdName\fR?
+This command hides the exposed command \fIexposedCmdName\fR, potentially
+renaming it to \fIhiddenCmdName\fR, in \fIslave\fR.
+If a hidden command with the targeted name already exists, this command
+fails.
+For more details on hidden commands, see HIDDEN COMMANDS, below.
+.TP
+\fIslave \fBhidden\fR
+Returns a list of the names of all hidden commands in \fIslave\fR.
+.TP
+\fIslave \fBinvokehidden\fR ?\fB-global\fR \fIhiddenCmdName \fR?\fIarg ..\fR?
+This command invokes the hidden command \fIhiddenCmdName\fR with the
+supplied arguments, in \fIslave\fR. No substitutions or evaluations are
+applied to the arguments.
+If the \fB-global\fR flag is given, the command is invoked at the global
+level in the slave; otherwise it is invoked at the current call frame and
+can access local variables in that or outer call frames.
+For more details on hidden commands, see HIDDEN
+COMMANDS, below.
+.VE
 .TP
 \fIslave \fBissafe\fR
 Returns  \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
-
-.SH "ALIAS INVOCATION"
-.PP
-The alias mechanism has been carefully designed so that it can
-be used safely when an untrusted script is executing
-in a safe slave and the target of the alias is a trusted
-master.  The most important thing in guaranteeing safety is to
-ensure that information passed from the slave to the master is
-never evaluated or substituted in the master;  if this were to
-occur, it would enable an evil script in the slave to invoke
-arbitrary functions in the master, which would compromise security.
-.PP
-When the source for an alias is invoked in the slave interpreter, the
-usual Tcl substitutions are performed when parsing that command.
-These substitutions are carried out in the source interpreter just
-as they would be for any other command invoked in that interpreter.
-The command procedure for the source command takes its arguments
-and merges them with the \fItargetCmd\fR and \fIarg\fRs for the
-alias to create a new array of arguments.  If the words
-of \fIsrcCmd\fR were ``\fIsrcCmd arg1 arg2 ... argN\fR'',
-the new set of words will be
-``\fItargetCmd arg arg ... arg arg1 arg2 ... argN\fR'',
-where \fItargetCmd\fR and \fIarg\fRs are the values supplied when the
-alias was created.  \fITargetCmd\fR is then used to locate a command
-procedure in the target interpreter, and that command procedure
-is invoked with the new set of arguments.  An error occurs if
-there is no command named \fItargetCmd\fR in the target interpreter.
-No additional substitutions are performed on the words:  the
-target command procedure is invoked directly, without
-going through the normal Tcl evaluation mechanism.
-Substitutions are thus performed on each word exactly once:
-\fItargetCmd\fR and \fIargs\fR were substituted when parsing the command
-that created the alias, and \fIarg1 - argN\fR are substituted when
-the alias's source command is parsed in the source interpreter.
-.PP
-When writing the \fItargetCmd\fRs for aliases in safe interpreters,
-it is very important that the arguments to that command never be
-evaluated or substituted, since this would provide an escape
-mechanism whereby the slave interpreter could execute arbitrary
-code in the master.  This in turn would compromise the security
-of the system.
+.VS BR
+.TP
+\fIslave \fBmarktrusted\fR
+Marks the slave interpreter as trusted. Can only be invoked by a
+trusted interpreter. This command does not expose any hidden
+commands in the slave interpreter. The command has no effect if the slave
+is already trusted.
+.VE
 
 .SH "SAFE INTERPRETERS"
 .PP
@@ -321,9 +371,18 @@ split	string	subst	switch
 tell	trace	unset	update
 uplevel	upvar	vwait	while\fR
 .DE
-All commands not on this list are removed from the interpreter by
-the \fBinterp create\fR command.  Of course, the missing commands
-can be recreated later as Tcl procedures or aliases.
+.VS BR
+The following commands are hidden by \fBinterp create\fR when it
+creates a safe interpreter:
+.DS
+.ta 1.2i 2.4i 3.6i
+\fBcd	exec	exit	fconfigure
+file	glob	load	open
+pwd	socket	source	vwait\fR
+.DE
+These commands can be recreated later as Tcl procedures or aliases, or
+re-exposed by \fBinterp expose\fR.
+.VE
 .PP
 In addition, the \fBenv\fR variable is not present in a safe interpreter,
 so it cannot share environment variables with other interpreters. The
@@ -336,15 +395,118 @@ security risk.
 .PP
 If extensions are loaded into a safe interpreter, they may also restrict
 their own functionality to eliminate unsafe commands. For a discussion of
-management of extensions for safety see the manual entries for the
-\fBpackage\fR and \fBload\fR Tcl commands.
+management of extensions for safety see the manual entries for
+\fBSafe\-Tcl\fR and the \fBload\fR Tcl command.
+
+.SH "ALIAS INVOCATION"
+.PP
+The alias mechanism has been carefully designed so that it can
+be used safely when an untrusted script is executing
+in a safe slave and the target of the alias is a trusted
+master.  The most important thing in guaranteeing safety is to
+ensure that information passed from the slave to the master is
+never evaluated or substituted in the master;  if this were to
+occur, it would enable an evil script in the slave to invoke
+arbitrary functions in the master, which would compromise security.
+.PP
+When the source for an alias is invoked in the slave interpreter, the
+usual Tcl substitutions are performed when parsing that command.
+These substitutions are carried out in the source interpreter just
+as they would be for any other command invoked in that interpreter.
+The command procedure for the source command takes its arguments
+and merges them with the \fItargetCmd\fR and \fIarg\fRs for the
+alias to create a new array of arguments.  If the words
+of \fIsrcCmd\fR were ``\fIsrcCmd arg1 arg2 ... argN\fR'',
+the new set of words will be
+``\fItargetCmd arg arg ... arg arg1 arg2 ... argN\fR'',
+where \fItargetCmd\fR and \fIarg\fRs are the values supplied when the
+alias was created.  \fITargetCmd\fR is then used to locate a command
+procedure in the target interpreter, and that command procedure
+is invoked with the new set of arguments.  An error occurs if
+there is no command named \fItargetCmd\fR in the target interpreter.
+No additional substitutions are performed on the words:  the
+target command procedure is invoked directly, without
+going through the normal Tcl evaluation mechanism.
+Substitutions are thus performed on each word exactly once:
+\fItargetCmd\fR and \fIargs\fR were substituted when parsing the command
+that created the alias, and \fIarg1 - argN\fR are substituted when
+the alias's source command is parsed in the source interpreter.
+.PP
+When writing the \fItargetCmd\fRs for aliases in safe interpreters,
+it is very important that the arguments to that command never be
+evaluated or substituted, since this would provide an escape
+mechanism whereby the slave interpreter could execute arbitrary
+code in the master.  This in turn would compromise the security
+of the system.
+
+.VS
+.SH "HIDDEN COMMANDS"
+.PP
+Safe interpreters greatly restrict the functionality available to Tcl
+programs executing within them.
+Allowing the untrusted Tcl program to have direct access to this
+functionality is unsafe, because it can be used for a variety of
+attacks on the environment.
+However, there are times when there is a legitimate need to use the
+dangerous functionality in the context of the safe interpreter. For
+example, sometimes a program must be \fBsource\fRd into the interpreter.
+Another example is Tk, where windows are bound to the hierarchy of windows
+for a specific interpreter; some potentially dangerous functions, e.g.
+window management, must be performed on these windows within the
+interpreter context.
+.PP
+The \fBinterp\fR command provides a solution to this problem in the form of
+\fIhidden commands\fR. Instead of removing the dangerous commands entirely
+from a safe interpreter, these commands are hidden so they become
+unavailable to Tcl scripts executing in the interpreter. However, such
+hidden commands can be invoked by any trusted ancestor of the safe
+interpreter, in the context of the safe interpreter, using \fBinterp
+invoke\fR. Hidden commands and exposed commands reside in separate name
+spaces. It is possible to define a hidden command and an exposed command by
+the same name within one interpreter.
+.PP
+Hidden commands in a slave interpreter can be invoked in the body of
+procedures called in the master during alias invocation. For example, an
+alias for \fBsource\fR could be created in a slave interpreter. When it is
+invoked in the slave interpreter, a procedure is called in the master
+interpreter to check that the operation is allowable (e.g. it asks to
+source a file that the slave interpreter is allowed to access). The
+procedure then it invokes the hidden \fBsource\fR command in the slave
+interpreter to actually source in the contents of the file. Note that two
+commands named \fBsource\fR exist in the slave interpreter: the alias, and
+the hidden command.
+.PP
+Because a master interpreter may invoke a hidden command as part of
+handling an alias invocation, great care must be taken to avoid evaluating
+any arguments passed in through the alias invocation.
+Otherwise, malicious slave interpreters could cause a trusted master
+interpreter to execute dangerous commands on their behalf. See the section
+on ALIAS INVOCATION for a more complete discussion of this topic.
+To help avoid this problem, no substitutions or evaluations are
+applied to arguments of \fBinterp invokehidden\fR.
+.PP
+Safe interpreters are not allowed to invoke hidden commands in themselves
+or in their descendants. This prevents safe slaves from gaining access to
+hidden functionality in themselves or their descendants.
+.PP
+The set of hidden commands in an interpreter can be manipulated by a trusted
+interpreter using \fBinterp expose\fR and \fBinterp hide\fR. The \fBinterp
+expose\fR command moves a hidden command to the
+set of exposed commands in the interpreter identified by \fIpath\fR,
+potentially renaming the command in the process. If an exposed command by
+the targeted name already exists, the operation fails. Similarly,
+\fBinterp hide\fR moves an exposed command to the set of hidden commands in
+that interpreter. Safe interpreters are not allowed to move commands
+between the set of hidden and exposed commands, in either themselves or
+their descendants.
+.VE
 .SH CREDITS
 .PP
 This mechanism is based on the Safe-Tcl prototype implemented
 by Nathaniel Borenstein and Marshall Rose.
 
 .SH "SEE ALSO"
-load(n), package(n) Tcl_CreateSlave(3)
+load(n), safe(n), Tcl_CreateSlave(3)
 
 .SH KEYWORDS
 alias, master interpreter, safe interpreter, slave interpreter
diff --git a/contrib/tcl/doc/library.n b/contrib/tcl/doc/library.n
index 232c799..215a569 100644
--- a/contrib/tcl/doc/library.n
+++ b/contrib/tcl/doc/library.n
@@ -5,9 +5,9 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) library.n 1.20 96/03/25 20:18:29
+'\" SCCS: @(#) library.n 1.23 96/11/20 14:07:04
 .so man.macros
-.TH library n "" Tcl "Tcl Built-In Commands"
+.TH library n "8.0" Tcl "Tcl Built-In Commands"
 .BS
 .SH NAME
 library \- standard library of Tcl procedures
@@ -18,6 +18,13 @@ library \- standard library of Tcl procedures
 \fBauto_mkindex \fIdir pattern pattern ...\fR
 \fBauto_reset\fR
 \fBparray \fIarrayName\fR
+.VS
+\fBtcl_endOfWord \fIstr start\fR
+\fBtcl_startOfNextWord \fIstr start\fR
+\fBtcl_startOfPreviousWord \fIstr start\fR
+\fBtcl_wordBreakAfter \fIstr start\fR
+\fBtcl_wordBreakBefore \fIstr start\fR
+.VE
 .BE
 
 .SH INTRODUCTION
@@ -38,7 +45,7 @@ To access the procedures in the Tcl library, an application should
 source the file \fBinit.tcl\fR in the library, for example with
 the Tcl command
 .CS
-\fBsource [info library]/init.tcl\fR
+\fBsource [file join [info library] init.tcl]\fR
 .CE
 If the library procedure \fBTcl_Init\fR is invoked from an application's
 \fBTcl_AppInit\fR procedure, this happens automatically.
@@ -74,14 +81,12 @@ variable is used, if it exists.
 Otherwise the auto-load path consists of just the Tcl library directory.
 Within each directory in the auto-load path there must be a file
 \fBtclIndex\fR that describes one
-.VS
 or more commands defined in that directory
 and a script to evaluate to load each of the commands.
 The \fBtclIndex\fR file should be generated with the
 \fBauto_mkindex\fR command.
 If \fIcmd\fR is found in an index file, then the appropriate
 script is evaluated to create the command.
-.VE
 The \fBauto_load\fR command returns 1 if \fIcmd\fR was successfully
 created.
 The command returns 0 if there was no index entry for \fIcmd\fR
@@ -99,11 +104,9 @@ This will force the next \fBauto_load\fR command to reload the
 index database from disk.
 .TP
 \fBauto_mkindex \fIdir pattern pattern ...\fR
-.VS
 Generates an index suitable for use by \fBauto_load\fR.
 The command searches \fIdir\fR for all files whose names match
 any of the \fIpattern\fR arguments
-.VE
 (matching is done with the \fBglob\fR command),
 generates an index of all the Tcl command
 procedures defined in all the matching files, and stores the
@@ -141,6 +144,45 @@ Prints on standard output the names and values of all the elements
 in the array \fIarrayName\fR.
 \fBArrayName\fR must be an array accessible to the caller of \fBparray\fR.
 It may be either local or global.
+.TP
+\fBtcl_endOfWord \fIstr start\fR
+.VS
+Returns the index of the first end-of-word location that occurs after
+a starting index \fIstart\fR in the string \fIstr\fR.  An end-of-word
+location is defined to be the first non-word character following the
+first word character after the starting point.  Returns -1 if there
+are no more end-of-word locations after the starting point.  See the
+description of \fBtcl_wordchars\fR and \fBtcl_nonwordchars\fR below
+for more details on how Tcl determines which characters are word
+characters.
+.TP
+\fBtcl_startOfNextWord \fIstr start\fR
+Returns the index of the first start-of-word location that occurs
+after a starting index \fIstart\fR in the string \fIstr\fR.  A
+start-of-word location is defined to be the first word character
+following a non-word character.  Returns \-1 if there are no more
+start-of-word locations after the starting point.
+.TP
+\fBtcl_startOfPreviousWord \fIstr start\fR
+Returns the index of the first start-of-word location that occurs
+before a starting index \fIstart\fR in the string \fIstr\fR.  Returns
+\-1 if there are no more start-of-word locations before the starting
+point.
+.TP
+\fBtcl_wordBreakAfter \fIstr start\fR
+Returns the index of the first word boundary after the starting index
+\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
+boundaries after the starting point in the given string.  The index
+returned refers to the second character of the pair that comprises a
+boundary.
+.TP
+\fBtcl_wordBreakBefore \fIstr start\fR
+Returns the index of the first word boundary before the starting index
+\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
+boundaries before the starting point in the given string.  The index
+returned refers to the second character of the pair that comprises a
+boundary.
+.VE
 
 .SH "VARIABLES"
 .PP
@@ -178,6 +220,25 @@ If set, then it must contain a valid Tcl list giving directories to
 search during auto-load operations.
 This variable is only used if \fBauto_path\fR is not defined.
 .TP
+\fBtcl_nonwordchars\fR
+.VS
+This variable contains a regular expression that is used by routines
+like \fBtcl_endOfWord\fR to identify whether a character is part of a
+word or not.  If the pattern matches a character, the character is
+considered to be a non-word character.  On Windows platforms, spaces,
+tabs, and newlines are considered non-word characters.  Under Unix,
+everything but numbers, letters and underscores are considered
+non-word characters.
+.TP
+\fBtcl_wordchars\fR
+This variable contains a regular expression that is used by routines
+like \fBtcl_endOfWord\fR to identify whether a character is part of a
+word or not.  If the pattern matches a character, the character is
+considered to be a word character.  On Windows platforms, words are
+comprised of any character that is not a space, tab, or newline.  Under
+Unix, words are comprised of numbers, letters or underscores.
+.VE
+.TP
 \fBunknown_active\fR
 This variable is set by \fBunknown\fR to indicate that it is active.
 It is used to detect errors where \fBunknown\fR recurses on itself
@@ -185,4 +246,4 @@ infinitely.
 The variable is unset before \fBunknown\fR returns.
 
 .SH KEYWORDS
-auto-exec, auto-load, library, unknown
+auto-exec, auto-load, library, unknown, word, whitespace 
diff --git a/contrib/tcl/doc/lindex.n b/contrib/tcl/doc/lindex.n
index 794d128..cf0979c 100644
--- a/contrib/tcl/doc/lindex.n
+++ b/contrib/tcl/doc/lindex.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) lindex.n 1.7 96/03/25 20:18:43
+'\" SCCS: @(#) lindex.n 1.8 96/08/26 13:00:02
 '\" 
 .so man.macros
 .TH lindex n 7.4 Tcl "Tcl Built-In Commands"
@@ -28,10 +28,8 @@ substitution and command substitution do not occur.
 If \fIindex\fR is negative or greater than or equal to the number
 of elements in \fIvalue\fR, then an empty
 string is returned.
-.VS
 If \fIindex\fR has the value \fBend\fR, it refers to the last element
 in the list.
-.VE
 
 .SH KEYWORDS
 element, index, list
diff --git a/contrib/tcl/doc/linsert.n b/contrib/tcl/doc/linsert.n
index 17c7538..7d62b5f 100644
--- a/contrib/tcl/doc/linsert.n
+++ b/contrib/tcl/doc/linsert.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) linsert.n 1.7 96/03/25 20:18:57
+'\" SCCS: @(#) linsert.n 1.8 96/08/26 13:00:03
 '\" 
 .so man.macros
 .TH linsert n 7.4 Tcl "Tcl Built-In Commands"
@@ -25,9 +25,7 @@ element of \fIlist\fR.  Each \fIelement\fR argument will become
 a separate element of the new list.  If \fIindex\fR is less than
 or equal to zero, then the new elements are inserted at the
 beginning of the list.  If \fIindex\fR
-.VS
 has the value \fBend\fR,
-.VE
 or if it is greater than or equal to the number of elements in the list,
 then the new elements are appended to the list.
 
diff --git a/contrib/tcl/doc/list.n b/contrib/tcl/doc/list.n
index f89b203..5a688cb 100644
--- a/contrib/tcl/doc/list.n
+++ b/contrib/tcl/doc/list.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) list.n 1.8 96/03/25 20:19:13
+'\" SCCS: @(#) list.n 1.9 96/08/26 13:00:04
 '\" 
 .so man.macros
 .TH list n "" Tcl "Tcl Built-In Commands"
@@ -14,17 +14,13 @@
 .SH NAME
 list \- Create a list
 .SH SYNOPSIS
-.VS
 \fBlist \fR?\fIarg arg ...\fR?
-.VE
 .BE
 
 .SH DESCRIPTION
 .PP
 This command returns a list comprised of all the \fIarg\fRs,
-.VS
 or an empty string if no \fIarg\fRs are specified.
-.VE
 Braces and backslashes get added as necessary, so that the \fBindex\fR command
 may be used on the result to re-extract the original arguments, and also
 so that \fBeval\fR may be used to execute the resulting list, with
diff --git a/contrib/tcl/doc/load.n b/contrib/tcl/doc/load.n
index 73a3f16..096081f 100644
--- a/contrib/tcl/doc/load.n
+++ b/contrib/tcl/doc/load.n
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) load.n 1.5 96/03/25 20:19:39
+'\" SCCS: @(#) load.n 1.8 96/12/20 09:23:23
 '\" 
 .so man.macros
 .TH load n 7.5 Tcl "Tcl Built-In Commands"
@@ -52,6 +52,10 @@ be \fBFoo_Init\fR.
 If the target interpreter is a safe interpreter, then the name
 of the initialization procedure will be \fIpkg\fB_SafeInit\fR
 instead of \fIpkg\fB_Init\fR.
+The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
+initializes the safe interpreter only with partial functionality provided
+by the package that is safe for use by untrusted code. For more information
+on Safe\-Tcl, see the \fBsafe\fR manual entry.
 .PP
 The initialization procedure must match the following prototype:
 .CS
@@ -75,10 +79,7 @@ The \fBload\fR command also supports packages that are statically
 linked with the application, if those packages have been registered
 by calling the \fBTcl_StaticPackage\fR procedure.
 If \fIfileName\fR is an empty string, then \fIpackageName\fR must
-be specified and it must give the name of a statically loaded
-package.
-The appropriate initialization procedure for that package will then
-be invoked to incorporate the package into the target interpreter.
+be specified.
 .PP
 If \fIpackageName\fR is omitted or specified as an empty string,
 Tcl tries to guess the name of the package.
@@ -86,10 +87,24 @@ This may be done differently on different platforms.
 The default guess, which is used on most UNIX platforms, is to
 take the last element of \fIfileName\fR, strip off the first
 three characters if they are \fBlib\fR, and use any following
-alphabetic characters as the module name.
+.VS
+alphabetic and underline characters as the module name.
+.VE
 For example, the command \fBload libxyz4.2.so\fR uses the module
 name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
 module name \fBlast\fR.
+.VS br
+.PP
+If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+be specified.
+The \fBload\fR command first searches for a statically loaded package
+(one that has been registered by calling the \fBTcl_StaticPackage\fR
+procedure) by that name; if one is found, it is used.
+Otherwise, the \fBload\fR command searches for a dynamically loaded
+package by that name, and uses it if it is found.  If several
+different files have been \fBload\fRed with different versions of
+the package, Tcl picks the file that was loaded first.
+.VE
 
 .SH BUGS
 .PP
@@ -99,7 +114,7 @@ behavior of this varies from system to system (some systems may
 detect the redundant loads, others may not).
 
 .SH "SEE ALSO"
-\fBinfo sharedlibextension\fR, Tcl_StaticPackage
+\fBinfo sharedlibextension\fR, Tcl_StaticPackage, safe(n)
 
 .SH KEYWORDS
-binary code, loading, shared library
+binary code, loading, safe interpreter, shared library
diff --git a/contrib/tcl/doc/lrange.n b/contrib/tcl/doc/lrange.n
index 1dbc012..8a5d98c 100644
--- a/contrib/tcl/doc/lrange.n
+++ b/contrib/tcl/doc/lrange.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) lrange.n 1.8 96/03/25 20:19:51
+'\" SCCS: @(#) lrange.n 1.9 96/08/26 13:00:05
 '\" 
 .so man.macros
 .TH lrange n 7.4 Tcl "Tcl Built-In Commands"
@@ -22,9 +22,7 @@ lrange \- Return one or more adjacent elements from a list
 \fIList\fR must be a valid Tcl list.  This command will
 return a new list consisting of elements
 \fIfirst\fR through \fIlast\fR, inclusive.
-.VS
 \fIFirst\fR or \fIlast\fR
-.VE
 may be \fBend\fR (or any abbreviation of it) to refer to the last
 element of the list.
 If \fIfirst\fR is less than zero, it is treated as if it were zero.
diff --git a/contrib/tcl/doc/lreplace.n b/contrib/tcl/doc/lreplace.n
index 6ee6664..0065da5 100644
--- a/contrib/tcl/doc/lreplace.n
+++ b/contrib/tcl/doc/lreplace.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) lreplace.n 1.8 96/03/25 20:20:05
+'\" SCCS: @(#) lreplace.n 1.9 96/08/26 13:00:07
 '\" 
 .so man.macros
 .TH lreplace n 7.4 Tcl "Tcl Built-In Commands"
@@ -28,11 +28,9 @@ element of \fIlist\fR;  the element indicated by \fIfirst\fR
 must exist in the list.
 \fILast\fR gives the index in \fIlist\fR of the last element
 to be replaced.
-.VS
 If \fIlast\fR is less than \fIfirst\fR then no elements are deleted;
 the new elements are simply inserted before \fIfirst\fR.
 \fIFirst\fR or \fIlast\fR may be \fBend\fR
-.VE
 (or any abbreviation of it) to refer to the last element of the list.
 The \fIelement\fR arguments specify zero or more new arguments to
 be added to the list in place of those that were deleted.
diff --git a/contrib/tcl/doc/lsearch.n b/contrib/tcl/doc/lsearch.n
index a411c96..aca019d 100644
--- a/contrib/tcl/doc/lsearch.n
+++ b/contrib/tcl/doc/lsearch.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) lsearch.n 1.6 96/03/25 20:20:16
+'\" SCCS: @(#) lsearch.n 1.7 96/08/26 13:00:05
 '\" 
 .so man.macros
 .TH lsearch n 7.0 Tcl "Tcl Built-In Commands"
@@ -24,7 +24,6 @@ of them matches \fIpattern\fR.
 If so, the command returns the index of the first matching
 element.
 If not, the command returns \fB\-1\fR.
-.VS
 The \fImode\fR argument indicates how the elements of the list are to
 be matched against \fIpattern\fR and it must have one of the following
 values:
@@ -41,7 +40,6 @@ element using the same rules as the \fBstring match\fR command.
 each list element using the same rules as the \fBregexp\fR command.
 .PP
 If \fImode\fR is omitted then it defaults to \fB\-glob\fR.
-.VE
 
 .SH KEYWORDS
 list, match, pattern, regular expression, search, string
diff --git a/contrib/tcl/doc/lsort.n b/contrib/tcl/doc/lsort.n
index e6cf40f..8184663 100644
--- a/contrib/tcl/doc/lsort.n
+++ b/contrib/tcl/doc/lsort.n
@@ -5,16 +5,16 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) lsort.n 1.6 96/03/25 20:20:27
+'\" SCCS: @(#) lsort.n 1.9 97/03/24 20:51:09
 '\" 
 .so man.macros
-.TH lsort n 7.0 Tcl "Tcl Built-In Commands"
+.TH lsort n 8.0 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
 lsort \- Sort the elements of a list
 .SH SYNOPSIS
-\fBlsort \fR?\fIswitches\fR? \fIlist\fR
+\fBlsort \fR?\fIoptions\fR? \fIlist\fR
 .BE
 
 .SH DESCRIPTION
@@ -22,14 +22,23 @@ lsort \- Sort the elements of a list
 This command sorts the elements of \fIlist\fR, returning a new
 list in sorted order.  By default ASCII sorting is used with
 the result returned in increasing order.
-.VS
 However, any of the
-following switches may be specified before \fIlist\fR to
+following options may be specified before \fIlist\fR to
 control the sorting process (unique abbreviations are accepted):
 .TP 20
 \fB\-ascii\fR
 Use string comparison with ASCII collation order.  This is
 the default.
+.VS br
+.TP 20
+\fB\-dictionary\fR
+Use dictionary-style comparison.  This is the same as \fB\-ascii\fR
+except (a) case is ignored except as a tie-breaker and (b) if two
+strings contain embedded numbers, the numbers compare as integers,
+not characters.  For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR
+sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR
+sorts between \fBx9y\fR and \fBx11y\fR.
+.VE
 .TP 20
 \fB\-integer\fR
 Convert list elements to integers and use integer comparison.
@@ -53,7 +62,24 @@ This is the default.
 .TP 20
 \fB\-decreasing\fR
 Sort the list in decreasing order (``largest'' items first).
+.VS br
+.TP 20
+\fB\-index\0\fIindex\fR
+If this option is specified, each of the elements of \fIlist\fR must
+itself be a proper Tcl sublist.  Instead of sorting based on whole sublists,
+\fBlsort\fR will extract the \fIindex\fR'th element from each sublist
+and sort based on the given element.  The keyword \fBend\fP is allowed
+for the \fIindex\fP to sort on the last sublist element. For example,
+.RS
+.CS
+lsort -integer -index 1 {{First 24} {Second 18} {Third 30}}
+.CE
+returns \fB{Second 18} {First 24} {Third 30}\fR.
+This option is much more efficient than using \fB\-command\fR
+to achieve the same effect.
+.RE
 .VE
 
+
 .SH KEYWORDS
 element, list, order, sort
diff --git a/contrib/tcl/doc/namespace.n b/contrib/tcl/doc/namespace.n
new file mode 100644
index 0000000..4be685a
--- /dev/null
+++ b/contrib/tcl/doc/namespace.n
@@ -0,0 +1,663 @@
+'\"
+'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) namespace.n 1.8 97/06/20 16:48:18
+'\" 
+.so man.macros
+.TH namespace n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+namespace \- create and manipulate contexts for commands and variables
+.SH SYNOPSIS
+\fBnamespace ?\fIsubcommand\fR? ?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBnamespace\fR command lets you create, access, and destroy
+separate contexts for commands and variables.
+See the section \fBWHAT IS A NAMESPACE?\fR below
+for a brief overview of namespaces.
+The legal \fIsubcommand\fR's are listed below.
+Note that you can abbreviate the names of subcommands.
+.TP
+\fBnamespace children \fR?\fIname\fR? ?\fIpattern\fR?
+Returns a list of all child namespaces that belong to the
+namespace \fIname\fR.
+If \fIname\fR is not specified,
+then the children are returned for the current namespace.
+This command returns fully-qualified names which start with \fB::\fR.
+If the optional \fIpattern\fR is given,
+then this command returns only the names that match the glob-style pattern.
+The actual pattern used is determined as follows:
+a pattern that starts with \fB::\fR is used directly,
+otherwise the namespace \fIname\fR
+(or the fully-qualified name of the current namespace)
+is prepended onto the the pattern.
+.TP
+\fBnamespace code \fIarg\fR
+Captures the current namespace context for later execution
+of the script \fIarg\fR.
+It returns a new Tcl scoped command that can be evaluated later
+to execute \fIarg\fR in the current namespace.
+It is typically used to create callback scripts, 
+where the \fIarg\fR argument is a list containing a script.
+The command it produces is equivalent to that produced by
+\fBlist namespace inscope [namespace current] $arg\fR
+If \fIarg\fR is itself a scoped command starting with
+\fBnamespace inscope\fR,
+the result is just \fIarg\fR.
+.br
+.sp
+Extensions like Tk normally execute callback scripts
+in the global namespace.
+A scoped command captures a command together with its namespace context
+in a way that allows it to be executed properly later.
+See the section \fBSCOPED VALUES\fR for some examples
+of how this is used to create callback scripts.
+.TP
+\fBnamespace current\fR
+Returns the fully-qualified name for the current namespace.
+The actual name of the global namespace is ``''
+(i.e., an empty string),
+but this command returns \fB::\fR for the global namespace
+as a convenience to programmers.
+Tcl treats ``'' and \fB::\fR as synonyms
+for the name of the global namespace.
+This make it easier to manipulate namespace names
+and ensures that commands like
+\fBset [namespace current]::x\fR
+always work.
+.TP
+\fBnamespace delete \fR?\fIname name ...\fR?
+Each namespace \fIname\fR is deleted
+and all variables, procedures, and child namespaces
+contained in the namespace are deleted.
+\fIname\fR may include a sequence of namespace qualifiers
+separated by \fB::\fRs.
+If a procedure is currently executing inside the namespace,
+the namespace will be kept alive until the procedure returns;
+however, the namespace is marked to prevent other code from
+looking it up by name.
+If a namespace doesn't exist, this command returns an error.
+If no namespace names are given, this command does nothing.
+.TP
+\fBnamespace eval\fR \fIname arg\fR ?\fIarg ...\fR?
+Activates a namespace called \fIname\fR and evaluates some code
+in that context.
+If the namespace does not already exist, it is created.
+This command is normally used to define the
+commands and variables in a namespace.
+If more than one \fIarg\fR argument is specified,
+the arguments are concatenated together with a space between each one
+in the same fashion as the \fBconcat\fR command,
+and the result is evaluated.
+.br
+.sp
+If a \fBnamespace eval\fR command creates a new namespace \fIname\fR,
+then \fIname\fR determines its parent namespace and
+the new namespace's position in the hierarchy of namespaces.
+If \fIname\fR includes a sequence of namespace qualifiers
+separated by \fB::\fRs,
+it is created as a child of the specified parent namespace;
+otherwise, the namespace is created as a child of the current namespace.
+If \fIname\fR has leading namespace qualifiers
+and any leading namespaces do not exist,
+they are automatically created.
+.br
+.sp
+\fBnamespace eval\fR is another way (besides procedure calls)
+that the Tcl naming context can change.
+It adds a call frame to the stack to represent the namespace context.
+This means each \fBnamespace eval\fR command
+counts as another call level for \fBuplevel\fR and \fBupvar\fR commands.
+For example, \fBinfo level 1\fR will return a list
+describing a command that is either
+the outermost procedure call or the outermost \fBnamespace eval\fR command.
+Also, \fBuplevel #0\fR evaluates a script
+at top-level in the outermost namespace (the global namespace).
+.TP
+\fBnamespace export \fR?\fB-clear\fR? ?\fIpattern pattern ...\fR?
+Specifies which commands are exported from a namespace.
+The exported commands are those that can be later imported
+into another namespace using a \fBnamespace import\fR command.
+Both commands defined in a namespace and
+commands the namespace has previously imported
+can be exported by a namespace.
+The commands do not have to be defined
+at the time the \fBnamespace export\fR command is executed.
+Each \fIpattern\fR may contain glob-style special characters,
+but it may not include any namespace qualifiers.
+That is, the pattern can only specify commands
+in the current (exporting) namespace.
+Each \fIpattern\fR is appended onto the namespace's list of export patterns.
+If the \fB-clear\fR flag is given,
+the namespace's export pattern list is reset to empty before any
+\fIpattern\fR arguments are appended.
+If no \fIpattern\fRs are given and the \fB-clear\fR flag isn't given,
+this command returns the namespace's current export list.
+.TP
+\fBnamespace forget \fR?\fIpattern pattern ...\fR?
+Removes previously imported commands from a namespace.
+Each \fIpattern\fR is a \fIqualified name\fR like
+\fBfoo::x\fR or \fBa::b::p*\fR.
+Qualified names contain \fB::\fRs and qualify a name
+with the name of one or more namespaces.
+Each \fIpattern\fR is qualified with the name of an exporting namespace
+and may have glob-style special characters in the command name
+at the end of the qualified name.
+Glob characters may not appear in a namespace name.
+This command first finds the matching exported commands.
+It then checks whether any of those those commands
+were previously imported by the current namespace.
+If so, this command deletes the corresponding imported command. 
+In effect, this un-does the action of a \fBnamespace import\fR command.
+.TP
+\fBnamespace import \fR?\fB-force\fR? ?\fIpattern\fR \fIpattern ...\fR?
+Imports commands into a namespace.
+Each \fIpattern\fR is a qualified name like
+\fBfoo::x\fR or \fBa::p*\fR.
+That is, it includes the name of an exporting namespace
+and may have glob-style special characters in the command name
+at the end of the qualified name.
+Glob characters may not appear in a namespace name.
+All the commands that match a \fIpattern\fR string
+and which are exported from their namespace
+are added to the current namespace.
+This is done by creating a new command in the current namespace
+that points to the exported command in its original namespace;
+when the new imported command is called, it invokes the exported command.
+This command normally returns an error
+if an imported command conflicts with an existing command.
+However, if the \fB-force\fR option is given,
+imported commands will silently replace existing commands.
+.TP
+\fBnamespace inscope\fR \fIname arg\fR ?\fIarg ...\fR?
+Executes a script in the context of a particular namespace.
+This command is not expected to be used directly by programmers;
+calls to it are generated implicitly when applications
+use \fBnamespace code\fR commands to create callback scripts
+that the applications then register with, e.g., Tk widgets.
+The \fBnamespace inscope\fR command is much like the \fBnamespace eval\fR
+command except that it has \fBlappend\fR semantics
+and the namespace must already exist.
+It treats the first argument as a list,
+and appends any arguments after the first
+onto the end as proper list elements.
+\fBnamespace inscope ::foo a x y z\fR
+is equivalent to
+\fBnamespace eval ::foo [concat a [list x y z]]\fR
+This \fBlappend\fR semantics is important because many callback scripts
+are actually prefixes.
+.TP
+\fBnamespace origin name\fR
+Returns the fully-qualified name of the original command
+to which the imported command \fIname\fR refers.
+When a command is imported into a namespace,
+a new command is created in that namespace
+that points to the actual command in the exporting namespace.
+If a command is imported into a sequence of namespaces
+\fIa, b,...,n\fR where each successive namespace
+just imports the command from the previous namespace,
+this command returns the fully-qualified name of the original command
+in the first namespace, \fIa\fR.
+If \fIname\fR does not refer to an imported command,
+the command's own fully-qualified name is returned.
+.TP
+\fBnamespace parent\fR ?\fIname\fR?
+Returns the fully-qualified name of the parent namespace
+for namespace \fIname\fR.
+If \fIname\fR is not specified,
+the fully-qualified name of the current namespace's parent is returned.
+.TP
+\fBnamespace qualifiers\fR \fIstring\fR
+Returns any leading namespace qualifiers for \fIstring\fR.
+Qualifiers are namespace names separated by \fB::\fRs.
+For the \fIstring\fR \fB::foo::bar::x\fR,
+this command returns \fB::foo::bar\fR,
+and for \fB::\fR it returns \fB``''\fR (an empty string).
+This command is the complement of the \fBnamespace tail\fR command.
+Note that it does not check whether the
+namespace names are, in fact,
+the names of currently defined namespaces.
+.TP
+\fBnamespace tail\fR \fIstring\fR
+Returns the simple name at the end of a qualified string.
+Qualifiers are namespace names separated by \fB::\fRs.
+For the \fIstring\fR \fB::foo::bar::x\fR,
+this command returns \fBx\fR,
+and for \fB::\fR it returns \fB``''\fR (an empty string).
+This command is the complement of the \fBnamespace qualifiers\fR command.
+It does not check whether the namespace names are, in fact,
+the names of currently defined namespaces.
+.TP
+\fBnamespace which\fR ?\fB-command\fR? ?\fB-variable\fR? \fIname\fR
+Looks up \fIname\fR as either a command or variable
+and returns its fully-qualified name.
+For example, if \fIname\fR does not exist in the current namespace
+but does exist in the global namespace,
+this command returns a fully-qualified name in the global namespace.
+If the command or variable does not exist,
+this command returns an empty string.
+If no flag is given, \fIname\fR is treated as a command name.
+See the section \fBNAME RESOLUTION\fR below for an explanation of
+the rules regarding name resolution.
+
+.SH "WHAT IS A NAMESPACE?"
+.PP
+A namespace is a collection of commands and variables.
+It encapsulates the commands and variables to ensure that they
+won't interfere with the commands and variables of other namespaces.
+Tcl has always had one such collection,
+which we refer to as the \fIglobal namespace\fR.
+The global namespace holds all global variables and commands.
+The \fBnamespace eval\fR command lets you create new namespaces.
+For example,
+.CS
+\fBnamespace eval Counter {
+    namespace export Bump
+    variable num 0
+
+    proc Bump {} {
+        variable num
+        incr num
+    }
+}\fR
+.CE
+creates a new namespace containing the variable \fBnum\fR and
+the procedure \fBBump\fR.
+The commands and variables in this namespace are separate from
+other commands and variables in the same program.
+If there is a command named \fBBump\fR in the global namespace,
+for example, it will not interfere with the command \fBBump\fR
+in the \fBCounter\fR namespace.
+.PP
+Namespace variables resemble global variables in Tcl.
+They exist outside of the procedures in a namespace
+but can be accessed in a procedure via the \fBvariable\fR command,
+as shown in the example above.
+.PP
+Namespaces are dynamic.
+You can add and delete commands and variables at any time.
+So you can build up the contents of a
+namespace over time using a series of \fBnamespace eval\fR commands.
+For example, the following series of commands has the same effect
+as the namespace definition shown above:
+.CS
+\fBnamespace eval Counter {
+    variable num 0
+    proc Bump {} {
+        variable num
+        return [incr num]
+    }
+}
+namespace eval Counter {
+    proc test {args} {
+        return $args
+    }
+}
+namespace eval Counter {
+    rename test ""
+}\fR
+.CE
+Note that the \fBtest\fR procedure is added to the \fBCounter\fR namespace,
+and later removed via the \fBrename\fR command.
+.PP
+Namespaces can have other namespaces within them,
+so they nest hierarchically.
+A nested namespace is encapsulated inside its parent namespace
+and can not interfere with other namespaces.
+If namespaces are used to represent packages,
+this feature lets one package contain its own copy of another package. 
+
+.SH "QUALIFIED NAMES"
+Procedures execute in the context of the namespace that contains them.
+So in the following namespace,
+.CS
+\fBnamespace eval Counter {
+    namespace export Bump Reset
+    variable num 0
+
+    proc Bump {{by 1}} {
+        variable num
+        return [incr num $by]
+    }
+    proc Reset {} {
+        variable num
+        set num 0
+    }
+}\fR
+.CE
+procedures like \fBBump\fR and \fBReset\fR execute in the context of
+namespace \fBCounter\fR.
+.PP
+In this context, you can access the commands and variables that
+reside in the namespace using simple names.
+In the example above,
+we access the \fBnum\fR variable with the command \fBvariable num\fR.
+(We can't use \fBglobal num\fR since that would only
+look up \fBnum\fR in the global namespace.)
+We can access the \fBBump\fR and \fBReset\fR procedures in
+another procedure like this:
+.CS
+\fBnamespace eval Counter {
+    namespace export Rebump
+    proc Rebump {{by 1}} {
+        Reset
+        Bump $by
+    }
+}\fR
+.CE
+This is the real benefit of namespaces.
+The commands and variables in a namespace fit together as a module.
+.PP
+If you want to access commands and variables from another namespace,
+you must use some extra syntax.
+Names must be qualified by the namespace that contains them.
+The \fB::\fR string acts as a separator
+between the various qualifiers in a name.
+From the global namespace,
+we might access the \fBCounter\fR procedures like this:
+.CS
+\fBCounter::Bump 5
+Counter::Reset
+Counter::Rebump 10\fR
+.CE
+We could access the current count like this:
+.CS
+\fBputs "count = $Counter::num"
+set Counter::num 35\fR
+.CE
+When one namespace contains another, you may need more than one
+qualifier to reach its elements.
+If we had a namespace \fBFoo\fR that contained the namespace \fBCounter\fR,
+you could invoke its \fBBump\fR procedure
+from the global namespace like this:
+.CS
+\fBFoo::Counter::Bump 3\fR
+.CE
+You can think of namespaces like directories in a file system.
+When you are sitting in a particular directory context,
+you can access files with simple names.
+But from another context, you must use a proper path name.
+A name like \fBFoo::Counter::Bump\fR
+is just like a file name \fBFoo/Counter/Bump\fR,
+except that we have used \fB::\fR instead of \fB/\fR as the separator.
+Just as the file system has a root directory \fB/\fR,
+all namespaces are rooted in the global namespace named \fB::\fR.
+So all names can be given with an absolute path that begins with \fB::\fR.
+For example, we can say:
+.CS
+\fB::Foo::Counter::Bump 3\fR
+.CE
+With this name, you can be sure that you'll get the \fBBump\fR procedure
+in the \fBCounter\fR namespace, in the \fBFoo\fR namespace, in the global
+namespace\-no matter what the current namespace context may be.
+.PP
+You can also use qualified names when you create and rename commands.
+For example, you could add a procedure to the \fBFoo\fR
+namespace like this:
+.CS
+\fBproc Foo::Test {args} {return $args}\fR
+.CE
+And you could move the same procedure to another namespace like this:
+.CS
+\fBrename Foo::Test Bar::Test\fR
+.CE
+.PP
+There are a few remaining points about qualified names
+that we should cover.
+\fB::\fR is disallowed in both simple command and variable names except
+as a namespace separator.
+Extra \fB:\fRs in a qualified name are ignored;
+that is, two or more \fB:\fRs are treated as a namespace separator.
+A trailing \fB::\fR in a qualified variable or command name
+refers to the variable or command named {}.
+However, a trailing \fB::\fR in a qualified namespace name is ignored.
+
+.SH "NAME RESOLUTION"
+.PP
+In general, all Tcl commands that take variable and command names
+support qualified names.
+This means you can give qualified names to such commands as
+\fBset\fR, \fBproc\fR, \fBrename\fR, and \fBinterp alias\fR.
+If you provide a fully-qualified name that starts with a \fB::\fR,
+there is no question about what command, variable, or namespace
+you mean.
+However, if the name does not start with a \fB::\fR
+(i.e., is \fIrelative\fR), 
+Tcl follows a fixed rule for looking it up:
+Command and variable names are always resolved
+by looking first in the current namespace,
+and then in the global namespace.
+Namespace names, on the other hand, are always resolved
+by looking in only the current namespace.
+.PP
+In the following example,
+.CS
+\fBset traceLevel 0
+namespace eval Debug {
+    printTrace $traceLevel
+}\fR
+.CE
+Tcl looks for \fBtraceLevel\fR in the namespace \fBDebug\fR
+and then in the global namespace.
+It looks up the command \fBprintTrace\fR in the same way.
+If a variable or command name is not found in either context,
+the name is undefined.
+To make this point absolutely clear, consider the following example:
+.CS
+\fBset traceLevel 0
+namespace eval Foo {
+    variable traceLevel 3
+
+    namespace eval Debug {
+        printTrace $traceLevel
+    }
+}\fR
+.CE
+Here Tcl looks for \fBtraceLevel\fR first in the namespace \fBFoo::Debug\fR.
+Since it is not found there, Tcl then looks for it 
+in the global namespace.
+The variable \fBFoo::traceLevel\fR is completely ignored
+during the name resolution process.
+.PP
+You can use the \fBnamespace which\fR command to clear up any question
+about name resolution.
+For example, the command:
+.CS
+\fBnamespace eval Foo::Debug {namespace which -variable traceLevel}\fR
+.CE
+returns \fB::traceLevel\fR.
+On the other hand, the command,
+.CS
+\fBnamespace eval Foo {namespace which -variable traceLevel}\fR
+.CE
+returns \fB::Foo::traceLevel\fR.
+.PP
+Although Tcl always follows the
+``look in the current then in the global namespace''
+rule for variables and commands,
+there is a question of how to resolve a
+qualified name like \fBfoo::bar::cmd\fR.
+A relative name like this might resolve to either
+\fB[namespace current]::foo::bar::cmd\fR
+or to \fB::foo::bar::cmd\fR.
+If \fBcmd\fR does not appear in \fB[namespace current]::foo::bar\fR
+but does appear in \fB::foo::bar\fR,
+Tcl assumes it refers to the latter command.
+.PP
+As mentioned above,
+namespace names are looked up differently
+than the names of variables and commands.
+Namespace names are always resolved in the current namespace.
+This means, for example,
+that a \fBnamespace eval\fR command that creates a new namespace
+always creates a child of the current namespace
+unless the new namespace name begins with a \fB::\fR.
+.PP
+Tcl has no access control to limit what variables, commands,
+or namespaces you can reference.
+If you provide a qualified name that resolves to an element
+by the name resolution rule above,
+you can access the element.
+.PP
+You can access a namespace variable
+within a procedure in the same namespace
+by using the \fBvariable\fR command.
+Much like the \fBglobal\fR command,
+this creates a local link to the namespace variable.
+If necessary, it also creates the variable in the current namespace
+and initializes it.
+Note that the \fBglobal\fR command only creates links
+to variables in the global namespace.
+It is not necessary to use a \fBvariable\fR command
+if you always refer to the namespace variable using an
+appropriate qualified name.
+
+.SH "IMPORTING COMMANDS"
+.PP
+Namespaces are often used to represent libraries.
+Some library commands are used so frequently
+that it is a nuisance to type their qualified names.
+For example, suppose that all of the commands in a package
+like BLT are contained in a namespace called \fBBlt\fR.
+Then you might access these commands like this:
+.CS
+\fBBlt::graph .g -background red
+Blt::table . .g 0,0\fR
+.CE
+If you use the \fBgraph\fR and \fBtable\fR commands frequently,
+you may want to access them without the \fBBlt::\fR prefix.
+You can do this by importing the commands into the current namespace,
+like this:
+.CS
+\fBnamespace import Blt::*\fR
+.CE
+This adds all commands from the \fBBlt\fR namespace into the current
+namespace context, so you can write code like this:
+.CS
+\fBgraph .g -background red
+table . .g 0,0\fR
+.CE
+Importing \fIevery\fR command from a namespace is generally
+a bad idea since you don't know what you will get.
+It is better to import just the specific commands you need.
+For example, the command
+.CS
+\fBnamespace import Blt::graph Blt::table\fR
+.CE
+imports only the \fBgraph\fR and \fBtable\fR commands into the
+current context.
+.PP
+The \fBnamespace import\fR command has snapshot semantics:
+that is, only requested commands that are currently defined
+in the exporting namespace are imported.
+In other words, you can import only the commands that are in a namespace
+like \fBBlt\fR at the time when the \fBnamespace import\fR command is
+executed.  If another command appears in this namespace later on, it
+will not be imported.
+.PP
+If you try to import a command that already exists, you will get an
+error.  This prevents you from importing the same command from two
+different packages.  But from time to time (perhaps when debugging),
+you may want to get around this restriction.  You may want to
+reissue the \fBnamespace import\fR command to pick up new commands
+that have appeared in a namespace.  In that case, you can use the
+\fB-force\fR option, and existing commands will be silently overwritten:
+.CS
+\fBnamespace import -force Blt::graph Blt::table\fR
+.CE
+If for some reason, you want to stop using the imported commands,
+you can remove them with an \fBnamespace forget\fR command, like this:
+.CS
+\fBnamespace forget Blt::*\fR
+.CE
+This searches the current namespace for any commands imported from \fBBlt\fR.
+If it finds any, it removes them.  Otherwise, it does nothing.
+After this, the \fBBlt\fR commands must be accessed with the \fBBlt::\fR
+prefix.
+.PP
+When you delete a command from the exporting namespace like this:
+.CS
+\fBrename Blt::graph ""\fR
+.CE
+the command is automatically removed from all namespaces that import it.
+
+.SH "EXPORTING COMMANDS"
+You can export commands from a namespace like this:
+.CS
+\fBnamespace eval Counter {
+    namespace export Bump Reset
+    variable num 0
+    variable max 100
+
+    proc Bump {{by 1}} {
+        variable num
+        incr num $by
+        check
+        return $num
+    }
+    proc Reset {} {
+        variable num
+        set num 0
+    }
+    proc check {} {
+        variable num
+        variable max
+        if {$num > $max} {
+            error "too high!"
+        }
+    }
+}\fR
+.CE
+The procedures \fBBump\fR and \fBReset\fR are exported,
+so they are included when you import from the \fBCounter\fR namespace,
+like this:
+.CS
+\fBnamespace import Counter::*\fR
+.CE
+However, the \fBcheck\fR procedure is not exported,
+so it is ignored by the import operation.
+.PP
+The \fBnamespace import\fR command only imports commands
+that were declared as exported by their namespace.
+The \fBnamespace export\fR command specifies what commands
+may be imported by other namespaces.
+If a \fBnamespace import\fR command specifies a command
+that is not exported, the command is not imported.
+
+.SH "SCOPED VALUES"
+.PP
+Extensions like Tk execute ordinary code fragments in the global
+namespace.
+A scoped command captures a script together with
+its namespace in a way that allows it to be executed properly later.
+It is needed, for example, to wrap up script
+when a Tk widget is used within a namespace.
+It is also needed for commands such as \fBafter\fR that
+execute a script at the global level at some future time.
+If a \fBafter\fR command is executed in a namespace,
+a \fBnamespace code\fR command is needed to ensure
+its script executes in the correct context:
+.CS
+\fBnamespace eval Foo {
+    variable v 123
+    proc report {msg} {
+        puts "$msg"
+    }
+
+    after 2000 [namespace code {report "Hello World, v = $v"}]
+}\fR
+.CE
+
+.SH "SEE ALSO"
+variable(n)
+
+.SH KEYWORDS
+exported, internal, variable
diff --git a/contrib/tcl/doc/open.n b/contrib/tcl/doc/open.n
index 8e6f1d3..feb7b61 100644
--- a/contrib/tcl/doc/open.n
+++ b/contrib/tcl/doc/open.n
@@ -5,10 +5,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) open.n 1.11 96/02/15 20:02:25
+'\" SCCS: @(#) open.n 1.16 97/01/14 18:00:35
 '\" 
 .so man.macros
-.TH open n 7.5 Tcl "Tcl Built-In Commands"
+.TH open n 7.6 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -24,8 +24,10 @@ open \- Open a file-based or command pipeline channel
 
 .SH DESCRIPTION
 .PP
-This command opens a file or command pipeline and returns a channel
-identifier that may be used in future invocations of commands like
+.VS
+This command opens a file, serial port, or command pipeline and returns a
+.VE
+channel identifier that may be used in future invocations of commands like
 \fBread\fR, \fBputs\fR, and \fBclose\fR.
 If the first character of \fIfileName\fR is not \fB|\fR then
 the command opens a file:
@@ -90,7 +92,6 @@ If the file is a terminal device, this flag prevents the file from
 becoming the controlling terminal of the process.
 .TP 15
 \fBNONBLOCK\fR
-.VS
 Prevents the process from blocking while opening the file, and
 possibly in subsequent I/O operations.  The exact behavior of
 this flag is system- and device-dependent;  its use is discouraged
@@ -98,7 +99,6 @@ this flag is system- and device-dependent;  its use is discouraged
 in nonblocking mode).
 For details refer to your system documentation on the \fBopen\fR system
 call's \fBO_NONBLOCK\fR flag.
-.VE
 .TP 15
 \fBTRUNC\fR
 If the file exists it is truncated to zero length.
@@ -122,10 +122,128 @@ output unless overridden by the command.
 If read-only access is used (e.g. \fIaccess\fR is \fBr\fR),
 standard input for the pipeline is taken from the current standard
 input unless overridden by the command.
+.SH "SERIAL COMMUNICATIONS"
+.VS
+.PP
+If \fIfileName\fR refers to a serial port, then the specified serial port
+is opened and initialized in a platform-dependent manner.  Acceptable
+values for the \fIfileName\fR to use to open a serial port are described in
+the PORTABILITY ISSUES section.
 
-.SH "SEE ALSO"
-close(n), filename(n), gets(n), read(n), puts(n)
+.SH "CONFIGURATION OPTIONS"
+The \fBfconfigure\fR command can be used to query and set the following
+configuration option for open serial ports:
+.TP
+\fB\-mode \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR
+.
+This option is a set of 4 comma-separated values: the baud rate, parity,
+number of data bits, and number of stop bits for this serial port.  The
+\fIbaud\fR rate is a simple integer that specifies the connection speed.
+\fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR,
+\fBm\fR, \fBs\fR; respectively signifying the parity options of ``none'',
+``odd'', ``even'', ``mark'', or ``space''.  \fIData\fR is the number of
+data bits and should be an integer from 5 to 8, while \fIstop\fR is the
+number of stop bits and should be the integer 1 or 2.
+.VE
 
+.VS
+.SH "PORTABILITY ISSUES"
+.sp
+.TP
+\fBWindows \fR(all versions)
+.
+Valid values for \fIfileName\fR to open a serial port are of the form
+\fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4.  An
+attempt to open a serial port that does not exist will fail.
+.TP
+\fBWindows NT\fR
+.
+When running Tcl interactively, there may be some strange interactions
+between the real console, if one is present, and a command pipeline that uses
+standard input or output.  If a command pipeline is opened for reading, some
+of the lines entered at the console will be sent to the command pipeline and
+some will be sent to the Tcl evaluator.  If a command pipeline is opened for
+writing, keystrokes entered into the console are not visible until the the
+pipe is closed.  This behavior occurs whether the command pipeline is
+executing 16-bit or 32-bit applications.  These problems only occur because
+both Tcl and the child application are competing for the console at
+the same time.  If the command pipeline is started from a script, so that Tcl
+is not accessing the console, or if the command pipeline does not use
+standard input or output, but is redirected from or to a file, then the
+above problems do not occur.  
+.TP
+\fBWindows 95\fR 
+.
+A command pipeline that executes a 16-bit DOS application cannot be opened
+for both reading and writing, since 16-bit DOS applications that receive
+standard input from a pipe and send standard output to a pipe run
+synchronously.  Command pipelines that do not execute 16-bit DOS
+applications run asynchronously and can be opened for both reading and
+writing.  
+.sp
+When running Tcl interactively, there may be some strange interactions
+between the real console, if one is present, and a command pipeline that uses
+standard input or output.  If a command pipeline is opened for reading from
+a 32-bit application, some of the keystrokes entered at the console will be
+sent to the command pipeline and some will be sent to the Tcl evaluator.  If
+a command pipeline is opened for writing to a 32-bit application, no output
+is visible on the console until the the pipe is closed.  These problems only
+occur because both Tcl and the child application are competing for the
+console at the same time.  If the command pipeline is started from a script,
+so that Tcl is not accessing the console, or if the command pipeline does
+not use standard input or output, but is redirected from or to a file, then
+the above problems do not occur.  
+.sp
+Whether or not Tcl is running interactively, if a command pipeline is opened
+for reading from a 16-bit DOS application, the call to \fBopen\fR will not
+return until end-of-file has been received from the command pipeline's
+standard output.  If a command pipeline is opened for writing to a 16-bit DOS
+application, no data will be sent to the command pipeline's standard output
+until the pipe is actually closed.  This problem occurs because 16-bit DOS
+applications are run synchronously, as described above.  
+.TP
+\fBWindows 3.X\fR 
+.
+A command pipeline can execute 16-bit or 32-bit DOS or Windows
+applications, but the call to \fBopen\fR will not return until the last
+program in the pipeline has finished executing; command pipelines run
+synchronously.  If the pipeline is opened with write access (either just
+writing or both reading and writing) the first application in the
+pipeline will instead see an immediate end-of-file; any data the caller
+writes to the open pipe will instead be discarded.
+.sp
+Since Tcl cannot be run with a real console under Windows 3.X, there are
+no interactions between command pipelines and the console.
+.TP
+\fBMacintosh\fR
+.
+Opening a serial port is not currently implemented under Macintosh.
+.sp
+Opening a command pipeline is not supported under Macintosh, since 
+applications do not support the concept of standard input or output.
+.TP
+\fBUnix\fR\0\0\0\0\0\0\0
+.
+Valid values for \fIfileName\fR to open a serial port are generally of the
+form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name
+of any pseudo-file that maps to a serial port may be used.
+.sp
+When running Tcl interactively, there may be some strange interactions
+between the console, if one is present, and a command pipeline that uses
+standard input.  If a command pipeline is opened for reading, some
+of the lines entered at the console will be sent to the command pipeline and
+some will be sent to the Tcl evaluator.  This problem only occurs because
+both Tcl and the child application are competing for the console at the
+same time.  If the command pipeline is started from a script, so that Tcl is
+not accessing the console, or if the command pipeline does not use standard
+input, but is redirected from a file, then the above problem does not occur.  
+.LP
+See the PORTABILITY ISSUES section of the \fBexec\fR command for additional
+information not specific to command pipelines about executing
+applications on the various platforms
+.SH "SEE ALSO"
+close(n), filename(n), gets(n), read(n), puts(n), exec(n)
+.VE
 .SH KEYWORDS
 access mode, append, create, file, non-blocking, open, permissions,
-pipeline, process
+pipeline, process, serial
diff --git a/contrib/tcl/doc/pkgMkIndex.n b/contrib/tcl/doc/pkgMkIndex.n
index 251c033..a0f32fd 100644
--- a/contrib/tcl/doc/pkgMkIndex.n
+++ b/contrib/tcl/doc/pkgMkIndex.n
@@ -4,10 +4,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) pkgMkIndex.n 1.2 96/02/15 20:03:23
+'\" SCCS: @(#) pkgMkIndex.n 1.6 96/10/04 11:31:53
 '\" 
 .so man.macros
-.TH pkg_mkIndex n 7.5 Tcl "Tcl Built-In Commands"
+.TH pkg_mkIndex n 7.6 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -46,22 +46,42 @@ It does this by loading each file and seeing what packages
 and new commands appear (this is why it is essential to have
 \fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
 in the files, as described above).
+.VS br
 .IP [3]
-Make sure that the directory is in the \fBauto_path\fR global variable.
+Install the package as a subdirectory of one of the directories given by
+the \fBtcl_pkgPath\fR variable.  If \fB$tcl_pkgPath\fR contains more
+than one directory, machine-dependent packages (e.g., those that
+contain binary shared libraries) should normally be installed
+under the first directory and machine-independent packages (e.g.,
+those that contain only Tcl scripts) should be installed under the
+second directory.
+The subdirectory should include
+the package's script and/or binary files as well as the \fBpkgIndex.tcl\fR
+file.  As long as the package is installed as a subdirectory of a
+directory in \fB$tcl_pkgPath\fR it will automatically be found during
+\fBpackage require\fR commands.
+.RS
+.LP
+If you install the package anywhere else, then you must ensure that
+the directory contaiingn the package is in the \fBauto_path\fR global variable
+or an immediate subdirectory of one of the directories in \fBauto_path\fR.
 \fBAuto_path\fR contains a list of directories that are searched
-by both the auto-loader and the package loader.
-If you want access to files described by a \fBpkgIndex.tcl\fR file
-in a directory, that directory must be present in \fBauto_path\fR.
-You can add the directory to \fBauto_path\fR explicitly in your
+by both the auto-loader and the package loader; by default it
+includes \fB$tcl_pkgPath\fR.
+The package loader also checks all of the subdirectories of the
+directories in \fBauto_path\fR.
+.VE
+You can add a directory to \fBauto_path\fR explicitly in your
 application, or you can add the directory to your \fBTCLLIBPATH\fR
 environment variable:  if this environment variable is present,
 Tcl initializes \fBauto_path\fR from it during application startup.
+.RE
 .IP [4]
 Once the above steps have been taken, all you need to do to use a
 package is to invoke \fBpackage require\fR.
 For example, if versions 2.1, 2.3, and 3.1 of package \fBTest\fR
 have been indexed by \fBpkg_mkIndex\fR, the command
-\fBpackage require Test\fR will make vesion 3.1 available
+\fBpackage require Test\fR will make version 3.1 available
 and the command \fBpackage require \-exact Test 2.1\fR will
 make version 2.1 available.
 There may be many versions of a package in the various index files
diff --git a/contrib/tcl/doc/proc.n b/contrib/tcl/doc/proc.n
index 85ee2da..6615a4b 100644
--- a/contrib/tcl/doc/proc.n
+++ b/contrib/tcl/doc/proc.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) proc.n 1.5 96/03/25 20:21:12
+'\" SCCS: @(#) proc.n 1.6 97/05/18 15:49:45
 '\" 
 .so man.macros
 .TH proc n "" Tcl "Tcl Built-In Commands"
@@ -24,6 +24,11 @@ The \fBproc\fR command creates a new Tcl procedure named
 any existing command or procedure there may have been by that name.
 Whenever the new command is invoked, the contents of \fIbody\fR will
 be executed by the Tcl interpreter.
+Normally, \fIname\fR is unqualified
+(does not include the names of any containing namespaces),
+and the new procedure is created in the current namespace.
+If \fIname\fR includes any namespace qualifiers,
+the procedure is created in the specified namespace.
 \fIArgs\fR specifies the formal arguments to the
 procedure.  It consists of a list, possibly empty, each of whose
 elements specifies
@@ -54,6 +59,8 @@ deleted when the procedure returns.  One local variable is automatically
 created for each of the procedure's arguments.
 Global variables can only be accessed by invoking
 the \fBglobal\fR command or the \fBupvar\fR command.
+Namespace variables can only be accessed by invoking
+the \fBvariable\fR command or the \fBupvar\fR command.
 .PP
 The \fBproc\fR command returns an empty string.  When a procedure is
 invoked, the procedure's return value is the value specified in a
diff --git a/contrib/tcl/doc/puts.n b/contrib/tcl/doc/puts.n
index 61599c1..e455071 100644
--- a/contrib/tcl/doc/puts.n
+++ b/contrib/tcl/doc/puts.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) puts.n 1.10 96/02/15 20:02:28
+'\" SCCS: @(#) puts.n 1.11 96/08/26 13:00:09
 '\" 
 .so man.macros
 .TH puts n 7.5 Tcl "Tcl Built-In Commands"
@@ -28,7 +28,6 @@ for output. If no \fIchannelId\fR is specified then it defaults to
 \fIstring\fR, but this feature may be suppressed by specifying the
 \fB\-nonewline\fR switch.
 .PP
-.VS
 Newline characters in the output are translated by \fBputs\fR to
 platform-specific end-of-line sequences according to the current
 value of the \fB\-translation\fR option for the channel (for example,
@@ -37,7 +36,6 @@ sequences;  on Macintoshes newlines are normally replaced with
 carriage-returns).
 See the \fBfconfigure\fR manual entry for a discussion of end-of-line
 translations.
-.VE
 .PP
 Tcl buffers output internally, so characters written with \fBputs\fR
 may not appear immediately on the output file or device;  Tcl will
@@ -46,7 +44,6 @@ closed.
 You can force output to appear immediately with the \fBflush\fR
 command.
 .PP
-.VS
 When the output buffer fills up, the \fBputs\fR command will normally
 block until all the buffered data has been accepted for output by the
 operating system.
@@ -64,7 +61,6 @@ To avoid wasting memory, nonblocking I/O should normally
 be used in an event-driven fashion with the \fBfileevent\fR command
 (don't invoke \fBputs\fR unless you have recently been notified
 via a file event that the channel is ready for more output data).
-.VE
 
 .SH "SEE ALSO"
 fileevent(n)
diff --git a/contrib/tcl/doc/read.n b/contrib/tcl/doc/read.n
index c56d8db..20206fe 100644
--- a/contrib/tcl/doc/read.n
+++ b/contrib/tcl/doc/read.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) read.n 1.14 96/02/15 20:02:29
+'\" SCCS: @(#) read.n 1.15 96/08/26 13:00:09
 '\" 
 .so man.macros
 .TH read n 7.5 Tcl "Tcl Built-In Commands"
@@ -30,7 +30,6 @@ read.  Exactly that many bytes will be read and returned, unless
 there are fewer than \fInumBytes\fR left in the file;  in this case
 all the remaining bytes are returned.
 .PP
-.VS
 If \fIchannelId\fR is in nonblocking mode, the command may not read
 as many bytes as requested:  once all available input has been read,
 the command will return the data that is available rather than blocking
@@ -43,7 +42,6 @@ newline characters according to the \fB\-translation\fR option
 for the channel.
 See the manual entry for \fBfconfigure\fR for details on the
 \fB\-translation\fR option.
-.VE
 
 .SH "SEE ALSO"
 eof(n), fblocked(n), fconfigure(n)
diff --git a/contrib/tcl/doc/regexp.n b/contrib/tcl/doc/regexp.n
index f4e3fab..f3951ee 100644
--- a/contrib/tcl/doc/regexp.n
+++ b/contrib/tcl/doc/regexp.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) regexp.n 1.11 96/03/25 20:21:48
+'\" SCCS: @(#) regexp.n 1.12 96/08/26 13:00:10
 '\" 
 .so man.macros
 .TH regexp n "" Tcl "Tcl Built-In Commands"
@@ -33,7 +33,6 @@ contain the characters that matched the next parenthesized
 subexpression to the right in \fIexp\fR, and so on.
 .LP
 If the initial arguments to \fBregexp\fR start with \fB\-\fR then
-.VS
 they are treated as switches.  The following switches are
 currently supported:
 .TP 10
@@ -52,7 +51,6 @@ range of characters.
 \fB\-\|\-\fR
 Marks the end of switches.  The argument following this one will
 be treated as \fIexp\fR even if it starts with a \fB\-\fR.
-.VE
 .LP
 If there are more \fIsubMatchVar\fR's than parenthesized
 subexpressions within \fIexp\fR, or if a particular subexpression
diff --git a/contrib/tcl/doc/registry.n b/contrib/tcl/doc/registry.n
new file mode 100644
index 0000000..6e35f2d
--- /dev/null
+++ b/contrib/tcl/doc/registry.n
@@ -0,0 +1,162 @@
+'\"
+'\" Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
+'\"
+'\" SCCS: @(#) registry.n 1.3 97/06/23 14:41:04
+'\" 
+.so man.macros
+.TH registry n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+registry \- Manipulate the Windows registry
+.SH SYNOPSIS
+.sp
+\fBpackage require registry 1.0\fR
+.sp
+\fBregistry \fIoption\fR \fIkeyName\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBregistry\fR package provides a general set of operations for
+manipulating the Windows registry.  The package implements the
+\fBregistry\fR Tcl command.  This command is only supported on the
+Windows platform.  Warning: this command should be used with caution
+as a corrupted registry can leave your system in an unusable state.
+.PP
+\fIKeyName\fR is the name of a registry key.  Registry keys must be
+one of the following forms:
+.IP
+\fB\e\e\fIhostname\fB\e\fIrootname\fB\e\fIkeypath\fR
+.IP
+\fIrootname\fB\e\fIkeypath\fR
+.IP
+\fIrootname\fR
+.PP
+\fIHostname\fR specifies the name of any valid Windows
+host that exports its registry.  The \fIrootname\fR component must be
+one of \fBHKEY_LOCAL_MACHINE\fR, \fBHKEY_USERS\fR,
+\fBHKEY_CLASSES_ROOT\fR, \fBHKEY_CURRENT_USER\fR, or
+\fBHKEY_CURRENT_CONFIG\fR.  The \fIkeypath\fR can be one or more
+registry key names separated by backslash (\fB\e\fR) characters.
+.PP
+\fIOption\fR indicates what to do with the registry key name.  Any
+unique abbreviation for \fIoption\fR is acceptable.  The valid options
+are:
+.TP
+\fBregistry delete \fIkeyName\fR ?\fIvalueName\fR?
+.
+If the optional \fIvalueName\fR argument is present, the specified
+value under \fIkeyName\fR will be deleted from the registry.  If the
+optional \fIvalueName\fR is omitted, the specified key and any subkeys
+or values beneath it in the registry heirarchy will be deleted.  If
+the key could not be deleted then an error is generated.  If the key
+did not exist, the command has no effect.
+.TP
+\fBregistry get \fIkeyName valueName\fR
+.
+Returns the data associated with the value \fIvalueName\fR under the key
+\fIkeyName\fR.  If either the key or the value does not exist, then an
+error is generated.  For more details on the format of the returned
+data, see SUPPORTED TYPES, below.
+.TP
+\fBregistry keys \fIkeyName\fR ?\fIpattern\fR?
+.
+If \fIpattern\fR isn't specified, returns a list of names of all the
+subkeys of \fIkeyName\fR.  If \fIpattern\fR is specified, only those
+names matching \fIpattern\fR are returned.  Matching is determined
+using the same rules as for \fBstring\fR \fBmatch\fR.
+.TP
+\fBregistry set \fIkeyName\fR ?\fIvalueName data \fR?\fItype\fR??
+.
+If \fIvalueName\fR isn't specified, creates the key \fIkeyName\fR if
+it doesn't already exist.  If \fIvalueName\fR is specified, creates
+the key \fIkeyName\fR and value \fIvalueName\fR if necessary.  The
+contents of \fIvalueName\fR are set to \fIdata\fR with the type
+indicated by \fItype\fR.  If \fItype\fR isn't specified, the type
+\fBsz\fR is assumed.  For more details on the data and type arguments,
+see SUPPORTED TYPES below.
+.TP
+\fBregistry type \fIkeyName valueName\fR
+.
+Returns the type of the value \fIvalueName\fR in the key
+\fIkeyName\fR.  For more information on the possible types, see
+SUPPORTED TYPES, below.
+.TP
+\fBregistry values \fIkeyName\fR ?\fIpattern\fR?
+.
+If \fIpattern\fR isn't specified, returns a list of names of all the
+values of \fIkeyName\fR.  If \fIpattern\fR is specified, only those
+names matching \fIpattern\fR are returned.  Matching is determined
+using the same rules as for \fBstring\fR \fBmatch\fR.
+
+.SH "SUPPORTED TYPES"
+Each value under a key in the registry contains some data of a
+particular type in a type-specific representation.  The \fBregistry\fR
+command converts between this internal representation and one that can
+be manipulated by Tcl scripts.  In most cases, the data is simply
+returned as a Tcl string.  The type indicates the intended use for the
+data, but does not actually change the representation.  For some
+types, the \fBregistry\fR command returns the data in a different form to
+make it easier to manipulate.  The following types are recognized by the
+registry command:
+.TP 17
+\fBbinary\fR
+.
+The registry value contains arbitrary binary data.  The data is represented
+exactly in Tcl, including any embedded nulls.
+Tcl 
+.TP
+\fBnone\fR
+.
+The registry value contains arbitrary binary data with no defined
+type.  The data is represented exactly in Tcl, including any embedded
+nulls.
+.TP
+\fBsz\fR
+.
+The registry value contains a null-terminated string.  The data is 
+represented in Tcl as a string.
+.TP
+\fBexpand_sz\fR
+.
+The registry value contains a null-terminated string that contains
+unexpanded references to environment variables in the normal Windows
+style (for example, "%PATH%").  The data is represented in Tcl as a
+string.
+.TP
+\fBdword\fR
+.
+The registry value contains a little-endian 32-bit number.  The data is
+represented in Tcl as a decimal string.
+.TP
+\fBdword_big_endian\fR
+.
+The registry value contains a big-endian 32-bit number.  The data is
+represented in Tcl as a decimal string.
+.TP
+\fBlink\fR
+.
+The registry value contains a symbolic link.  The data is represented
+exactly in Tcl, including any embedded nulls.
+.TP
+\fBmulti_sz\fR
+.
+The registry value contains an array of null-terminated strings.  The
+data is represented in Tcl as a list of strings.
+.TP
+\fBresource_list\fR
+.
+The registry value contains a device-driver resource list.  The data
+is represented exactly in Tcl, including any embedded nulls.
+.PP
+In addition to the symbolically named types listed above, unknown
+types are identified using a 32-bit integer that corresponds to the
+type code returned by the system interfaces.  In this case, the data
+is represented exactly in Tcl, including any embedded nulls.
+
+.SH "PORTABILITY ISSUES"
+The registry command is only available on Windows.
+
+.SH KEYWORDS
+registry
diff --git a/contrib/tcl/doc/regsub.n b/contrib/tcl/doc/regsub.n
index efa7b74..62720ac 100644
--- a/contrib/tcl/doc/regsub.n
+++ b/contrib/tcl/doc/regsub.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) regsub.n 1.8 96/03/25 20:22:01
+'\" SCCS: @(#) regsub.n 1.9 96/08/26 13:00:11
 '\" 
 .so man.macros
 .TH regsub n 7.4 Tcl "Tcl Built-In Commands"
@@ -21,12 +21,10 @@ regsub \- Perform substitutions based on regular expression pattern matching
 .PP
 This command matches the regular expression \fIexp\fR against
 \fIstring\fR,
-.VS
 and it copies \fIstring\fR to the variable whose name is
 given by \fIvarName\fR.
 If there is a match, then while copying \fIstring\fR to \fIvarName\fR
 the portion of \fIstring\fR that
-.VE
 matched \fIexp\fR is replaced with \fIsubSpec\fR.
 If \fIsubSpec\fR contains a ``&'' or ``\e0'', then it is replaced
 in the substitution with the portion of \fIstring\fR that
@@ -44,7 +42,6 @@ safest to enclose \fIsubSpec\fR in braces if it includes
 backslashes.
 .LP
 If the initial arguments to \fBregexp\fR start with \fB\-\fR then
-.VS
 they are treated as switches.  The following switches are
 currently supported:
 .TP 10
@@ -65,12 +62,9 @@ by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
 \fB\-\|\-\fR
 Marks the end of switches.  The argument following this one will
 be treated as \fIexp\fR even if it starts with a \fB\-\fR.
-.VE
 .PP
-.VS
 The command returns a count of the number of matching ranges that
 were found and replaced.
-.VE
 See the manual entry for \fBregexp\fR for details on the interpretation
 of regular expressions.
 
diff --git a/contrib/tcl/doc/return.n b/contrib/tcl/doc/return.n
index e2c0d5d..fdf783b 100644
--- a/contrib/tcl/doc/return.n
+++ b/contrib/tcl/doc/return.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) return.n 1.12 96/03/25 20:22:26
+'\" SCCS: @(#) return.n 1.13 96/08/26 13:00:12
 '\" 
 .so man.macros
 .TH return n 7.0 Tcl "Tcl Built-In Commands"
@@ -27,7 +27,6 @@ an empty string will be returned as result.
 .SH "EXCEPTIONAL RETURNS"
 .PP
 In the usual case where the \fB\-code\fR option isn't
-.VS
 specified the procedure will return normally (its completion
 code will be TCL_OK).
 However, the \fB\-code\fR option may be used to generate an
@@ -85,7 +84,6 @@ If the \fB\-errorcode\fR option is specified then \fIcode\fR provides
 a value for the \fBerrorCode\fR variable.
 If the option is not specified then \fBerrorCode\fR will
 default to \fBNONE\fR.
-.VE
 
 .SH KEYWORDS
 break, continue, error, procedure, return
diff --git a/contrib/tcl/doc/safe.n b/contrib/tcl/doc/safe.n
new file mode 100644
index 0000000..acc50ed
--- /dev/null
+++ b/contrib/tcl/doc/safe.n
@@ -0,0 +1,303 @@
+'\"
+'\" Copyright (c) 1995-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.
+'\" 
+'\" SCCS: @(#) safe.n 1.10 97/03/24 09:21:12
+'\" 
+.so man.macros
+.TH "Safe Tcl" n 7.7 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Safe Tcl \- A mechanism for managing security policies.
+.SH SYNOPSIS
+.nf
+\fBtcl_safeCreateInterp\fR \fIslave\fR
+.sp
+\fBtcl_safeInitInterp\fR \fIslave\fR
+.sp
+\fBtcl_safeDeleteInterp\fR \fIslave\fR
+.sp
+\fIpolicy\fB_policyInit\fR \fIslave\fR
+.sp
+\fIpolicy\fB_policyFinalize\fR \fIslave\fR
+.fi
+.BE
+
+.SH DESCRIPTION
+.PP
+This manual entry describes \fBSafe Tcl\fR, a mechanism and collection of
+library procedures for managing security policies. \fBSafe Tcl\fR is used
+in \fBapplications\fR that want to provide a flexible, extensible safe
+hosting environment for untrusted guest scripts, \fBtclets\fR. It
+provides a mechanism to ensure that tclets cannot harm the hosting
+application, and a way to extend limited degrees of trust to such tclets,
+to allow them to have access to unsafe features.
+.PP
+The content of this manual entry is of interest to four different
+audiences: authors of tclets will primarily be interested in the sections
+on the \fBSAFE BASE\fR and on \fBUSING SAFE TCL IN TCLETS\fR.
+Application authors will find relevant information in the section on
+\fBUSING SAFE TCL IN APPLICATIONS\fR. To create a new security
+policy, e.g. to enable tclets to have access to a new feature, read the
+section on \fBWRITING SECURITY POLICIES\fB. Finally, system administrators
+and people installing \fBSafe Tcl\fR will find useful information in the
+section on \fBINSTALLING SECURITY POLICIES\fR.
+.PP
+\fBSecurity policies\fR are collections of procedures, aliases, hidden
+commands and variable settings that together implement a controlled way for
+an application to allow a tclet to have restricted access to unsafe features.
+For a complete description of aliases, hidden commands and how to use
+multiple interpreters in an application, see the manual entry for the
+\fBinterp\fR command.
+.PP
+Packaging collections of features into security policies has several
+advantages: First, it allows these collections to have names. This
+facilitates the formation of a common, agreed upon, understanding of what
+features are included in each policy. Second, it enables a reasoned
+approach to developing extensions that make restricted features available
+to untrusted tclets.
+Third, because the feature set is delineated clearly, a security policy can
+be subjected to analysis to determine what risks it exposes its user to.
+.PP
+The \fBSafe Tcl\fR approach to safe execution of untrusted code is further
+discussed in \fBThe Safe\-Tcl Security Model\fR
+(http://www.sunlabs.com/people/john.ousterhout/SafeTcl.ps).
+This paper provides a detailed discussion of the underlying
+motivations and philosophy, and compares the \fBSafe Tcl\fR model with
+other current efforts.
+
+.SH "SAFE BASE"
+.PP
+This section describes the environment in which tclets start execution in
+an application using \fBSafe Tcl\fR. This environment is known as the
+\fBSafe Base\fR, as it provides the basis on which further security
+policies are built.
+.PP
+When a tclet starts execution in an environment using \fBSafe Tcl\fR,
+its interpreter will contain aliases for the following commands:
+.DS
+.ta 1.2i 2.4i 3.6i
+\fBexit	file	load	source
+tclPkgUnknown\fR
+.DE
+The \fBexit\fR alias terminates the execution of the
+invoking slave.
+\fBFile\fR allows access to a subset of the sub\-commands of the full
+\fBfile\fR command.
+\fBload\fR and \fBsource\fR make extensions available to the tclet in a
+controlled manner.
+The \fBtclPkgUnknown\fR alias allows the application to interpose on
+\fBpackage require\fR invocations by the tclet.
+.PP
+The following \fBTcl\fR commands are hidden in the Safe Base:
+.DS
+.ta 1.2i 2.4i 3.6i
+\fBcd	exec	exit	fconfigure
+file	glob	load	open
+pwd	socket	source	vwait\fR
+.DE
+.PP
+A tclet can also request to load packages using \fBpackage require\fR.
+Please read the manual page on the \fBpackage\fR and \fBload\fR commands
+for a discussion of package loading and special restrictions on loading
+into safe interpreters.
+.PP
+Tclets can use auto-loading to obtain the definitions for procedures as
+needed. The auto-loading mechanism in the Safe Base supports tclIndex files
+generated by \fBauto_mkindex\fR Version 2 and later.
+
+.SH "USING SAFE TCL IN TCLETS"
+.PP
+Tclets start executing in the environment described in the previous
+section, on the \fBSAFE BASE\fR. If they need access to unsafe features,
+tclets can request to use a named security policy by invoking \fBpackage
+require\fR with the policy name. If the request is denied by the
+application's master interpreter, an error is returned.
+A tclet can \fBcatch\fR the error and request to use a different named
+policy, until a request is granted.
+.PP
+A tclet can only use one security policy during its lifetime. Once an
+invocation of \fBpackage require\fR to load a security policy succeeds,
+Safe Tcl prevents subsequent invocations of \fBpackage require\fR from
+succeeding if the requested package is a security policy. There is also no
+mechanism for a tclet to stop using a security policy, once it is loaded.
+Invocations of \fBpackage require\fR to load other packages unrelated to
+security policies will still succeed.
+.PP
+These restrictions are designed to prevent a tclet from composing security
+policies either concurrently or sequentially, in ways not supported or
+forseen by the authors of the policies. Allowing such composition would
+expose the application to unknown security risks, because a security policy
+that is safe in isolation is not necessarily safe when used in conjunction
+with other security policies.
+For example, a security policy that allows read\-only access to the local
+file system can not disclose private data belonging to the application if
+it does not have access to network communication commands such as
+\fBsocket\fR. However, when used in conjunction with another security
+policy that enables the \fBsocket\fR command, this policy is no longer
+safe.
+
+.SH "USING SAFE TCL IN APPLICATIONS"
+.PP
+An application using Safe Tcl is usually structured as one or more unsafe
+interpreters in which trusted code belonging to the application is
+executed. Each such \fBmaster interpreter\fR controls one or more safe
+\fBslave interpreters\fR in which tclets are executed.
+Tclets communicate with their master interpreter via the aliases provided
+by the Safe Base and via additional mechanisms installed by each security
+policy.
+This section describes the procedures an application invokes to use Safe
+Tcl and to manage slave interpreters.
+.PP
+An application invokes \fBtcl_safeCreateInterp\fR \fIslave\fR to create a
+new slave interpreter; this new interpreter will contain the aliases
+provided by the Safe Base. A new command named \fBslave\fR is also created
+in the invoking interpreter, to allow the application to manipulate the new
+slave interpreter.
+.PP
+An application can use \fBtcl_safeInitInterp\fR \fIslave\fR to initialize
+an existing slave interpreter with the Safe-Tcl security policy mechanism.
+This procedure is useful when an application already has a safe slave
+interpreter created with \fBinterp create -safe\fR and wishes to enable it
+to use security policies.
+.PP
+An application should invoke \fBtcl_safeDeleteInterp\fR \fIslave\fR to
+delete an interpreter previously created by \fBtcl_safeCreateInterp\fR. This
+procedure terminates the execution of the tclet in the \fIslave\fR
+interpreter and cleans up associated state maintained by the Safe Tcl
+mechanism.
+.PP
+Security policies are installed on the file system of the system on which
+the application is executing. Security policies are found in the
+\fIpolicies\fR sub-directories of directories mentioned in the
+application's \fBauto_path\fR, and in sub-directories of these
+\fIpolicies\fR directories.
+.PP
+Safe Tcl will invoke, on behalf of an application, additional procedures
+provided by individual security policies to manage the lifecycle of those
+policies. These additional procedures are described in the next section.
+
+.SH "WRITING SECURITY POLICIES"
+.PP
+Writing a security policy is a complex effort that should not be undertaken
+lightly. It involves careful design, exhaustive testing, public review and
+analysis and continuous debugging.
+In addition to considering what features a security policy should provide,
+the implementer has to constantly keep in mind the security risks to which
+an application using the policy may be exposed.
+Actively considering each feature to see if it can be used to compromise an
+application will help to minimize the chance of a security mishap later on.
+.PP
+A security policy is a Tcl script or a shared library that is loaded into
+an unsafe master interpreter.
+A security policy consists of two parts: a \fBmanagement\fR part, concerned
+with installing the policy into safe slaves and cleaning up after a slave
+is destroyed, and a \fBruntime\fR part, concerned with actually
+implementing the features of the policy.
+.PP
+The management part of a security policy consists of two Tcl procedures or
+commands, one for installing the security policy features into a safe
+slave, and the other for cleaning up any associated state when a slave is
+destroyed.
+The names of these procedures or commands are \fIpolicy\fB_policyInit\fR
+and \fIpolicy\fB_policyFinalize, where \fIpolicy\fR is the name of the
+policy as used by the slave interpreter in the \fBpackage require\fR
+invocation.
+.PP
+The policy initialization procedure \fIpolicy\fB_policyInit\fR called in
+the master interpreter with one argument, the name of the slave
+interpreter, when a slave requests to use the \fIpolicy\fR security policy.
+Error returns indicate that the slave was denied permission to use this
+policy; the error is propagated back to the slave interpreter. Successful
+return indicates that the policy is now available in the requesting slave.
+If it decides to allow the slave to use the requested policy,
+\fIpolicy\fB_policyInit\fR should install new aliases and command into the
+slave, initialize variables both in the master interpreter and in the
+slave, and do any other initialization work to make the policy features
+available in the slave.
+Policy initialization procedures may also perform other tasks, such as
+creating policy specific state data for the new slave using this policy.
+.PP
+Policy initialization procedures should be careful to leave a clean state
+in the slave interpreter if a failure occurs during initialization; the
+rule is that if an error is returned, no changes in any variables,
+procedures or aliases should be detectable in the slave.
+For example, if use of a security policy requires creation
+of a socket to a remote host at initialization time, and if that host is
+not accessible, all aliases created in the slave to use the policy
+should be removed. Otherwise, these aliases might open security holes when
+used in conjunction with another security policy subsequently requested by
+the slave. Without this, a malicious tclet could purposely cause a failure
+during initialization in one security policy and compose features provided
+by that policy in an unsafe manner with another security policy requested
+later.
+.PP
+When an application invokes \fBtcl_safeDeleteInterp\fR to delete a slave
+interpreter, the policy finalization procedure
+\fIpolicy\fB_policyFinalize\fR for the policy in use by the slave is called.
+It receives one argument, the name of the slave interpreter being deleted.
+This procedure should ensure that subsequently if a slave by the
+same name is re\-created, the new slave will be able to use this policy.
+It may also wish to remove any policy specific state data created by
+\fIpolicy\fB_policyInit\fR.
+.PP
+During initialization, a number of aliases may be created in the slave;
+when these aliases are invoke, they cause commands defined in the master to
+execute. The runtime part of a security policy consists of implementations
+of all the target commands that handle the invocation of aliases in the
+slave. Because these commands execute in a trusted interpreter, they have
+full access to all the capabilities of Tcl and any extensions loaded into
+the master interpreter.
+.PP
+A security policy must provide a \fBtclIndex\fR file in addition to files
+containing Tcl procedures and shared libraries implementing the policy.
+To generate a \fBtclIndex\fR file, use the Tcl command \fBauto_mkindex\fR
+which is described in the manual page for the Tcl library.
+
+.SH "INSTALLING SECURITY POLICIES"
+.PP
+Safe Tcl uses a platform dependent mechanism for obtaining the initial
+setting for the search path for finding security policies.
+On \fBUnix\fR, the environment variable \fBTCL_POLICY_PATH\fR is consulted.
+On \fBWin32\fR systems and on \fBMacOS\fR there is currently no mechanism
+provided to obtain the initial value; each application should provide its
+own mechanism for obtaining the initial search path. Such mechanisms will
+be provided shortly.
+.PP
+The search path is searched in reverse order of the order in which entries
+appear. Thus, if two or more policies by the same name occur in the path,
+the last policy by that name will be used by Safe Tcl.
+This enable system administrators to install system wide security policies
+in a centralized directory and then require users to include that directory
+as the last component in the search path. Doing so will ensure that system
+wide policies are used in preference of policies installed by individual
+users.
+.PP
+To install a policy, create a sub\-directory of one of the directories
+mentioned in the policy search path, and copy all the files comprising the
+policy into the new directory.
+Applications should be able, in most situations, to use the newly available
+policy immediately, without having to restart.
+If a security policy uses the same name as a regular package, a \fBpackage
+require\fR invocation in a slave interpreter will preferentially use the
+security policy over the regular package.
+However, if a security policy is installed after the first invocation of
+\fBpackage require\fR in an application, and a regular package exists by
+the same name, the security policy will not be available for use in that
+application. In this case you must restart the application for the policy
+to become available.
+
+.SH CREDITS
+.PP
+The security policy mechanism extends and expands on the Safe-Tcl prototype
+first implemented by Nathaniel Borenstein and Marshall Rose.
+
+.SH "SEE ALSO"
+interp(n), library(n), load(n), package(n), source(n), unknown(n)
+
+.SH KEYWORDS
+alias, auto\-loading, auto_mkindex, load, master interpreter, security
+policy, safe interpreter, slave interpreter, source
diff --git a/contrib/tcl/doc/scan.n b/contrib/tcl/doc/scan.n
index bdc3230..96121f8 100644
--- a/contrib/tcl/doc/scan.n
+++ b/contrib/tcl/doc/scan.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) scan.n 1.11 96/03/25 20:22:44
+'\" SCCS: @(#) scan.n 1.12 96/08/26 13:00:13
 '\" 
 .so man.macros
 .TH scan n "" Tcl "Tcl Built-In Commands"
@@ -21,10 +21,8 @@ scan \- Parse string using conversion specifiers in the style of sscanf
 .PP
 This command parses fields from an input string in the same fashion
 as the ANSI C \fBsscanf\fR procedure and returns a count of the number
-.VS
 of conversions performed, or -1 if the end of the input string is
 reached before any conversions have been performed.
-.VE
 \fIString\fR gives the input to be parsed and \fIformat\fR indicates
 how to parse it, using \fB%\fR conversion specifiers as in \fBsscanf\fR.
 Each \fIvarName\fR gives the name of a variable; when a field is
@@ -118,23 +116,19 @@ then no variable is assigned and the next scan argument is not consumed.
 The behavior of the \fBscan\fR command is the same as the behavior of
 the ANSI C \fBsscanf\fR procedure except for the following differences:
 .IP [1]
-.VS
 \fB%p\fR and \fB%n\fR conversion specifiers are not currently
 supported.
-.VE
 .IP [2]
 For \fB%c\fR conversions a single character value is
 converted to a decimal string, which is then assigned to the
 corresponding \fIvarName\fR;
 no field width may be specified for this conversion.
 .IP [3]
-.VS
 The \fBl\fR, \fBh\fR, and \fBL\fR modifiers are ignored;  integer
 values are always converted as if there were no modifier present
 and real values are always converted as if the \fBl\fR modifier
 were present (i.e. type \fBdouble\fR is used for the internal
 representation).
-.VE
 
 .SH KEYWORDS
 conversion specifier, parse, scan
diff --git a/contrib/tcl/doc/seek.n b/contrib/tcl/doc/seek.n
index d31cf15..ac796e6 100644
--- a/contrib/tcl/doc/seek.n
+++ b/contrib/tcl/doc/seek.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) seek.n 1.9 96/02/15 20:02:34
+'\" SCCS: @(#) seek.n 1.10 96/08/26 13:00:14
 '\" 
 .so man.macros
 .TH seek n 7.5 Tcl "Tcl Built-In Commands"
@@ -45,10 +45,7 @@ position after the end of file.
 The \fIorigin\fR argument defaults to \fBstart\fR.
 .PP
 The command flushes all buffered output for the channel before the command
-returns,
-.VS
-even if the channel is in nonblocking mode.
-.VE
+returns, even if the channel is in nonblocking mode.
 It also discards any buffered and unread input.
 This command returns an empty string.
 An error occurs if this command is applied to channels whose underlying
diff --git a/contrib/tcl/doc/set.n b/contrib/tcl/doc/set.n
index 84f63ee..caf6cc2 100644
--- a/contrib/tcl/doc/set.n
+++ b/contrib/tcl/doc/set.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) set.n 1.5 96/03/25 20:23:07
+'\" SCCS: @(#) set.n 1.6 97/05/18 15:56:26
 '\" 
 .so man.macros
 .TH set n "" Tcl "Tcl Built-In Commands"
@@ -25,14 +25,24 @@ the value of \fIvarName\fR to \fIvalue\fR, creating a new variable
 if one doesn't already exist, and return its value.
 If \fIvarName\fR contains an open parenthesis and ends with a
 close parenthesis, then it refers to an array element:  the characters
-before the first open parenthesis are the name of the array, and the characters
-between the parentheses are the index within the array.
+before the first open parenthesis are the name of the array,
+and the characters between the parentheses are the index within the array.
 Otherwise \fIvarName\fR refers to a scalar variable.
-If no procedure is active, then \fIvarName\fR refers to a global
-variable.
+Normally, \fIvarName\fR is unqualified
+(does not include the names of any containing namespaces),
+and the variable of that name in the current namespace is read or written.
+If \fIvarName\fR includes namespace qualifiers
+(in the array name if it refers to an array element),
+the variable in the specified namespace is read or written.
+.PP
+If no procedure is active,
+then \fIvarName\fR refers to a namespace variable
+(global variable if the current namespace is the global namespace).
 If a procedure is active, then \fIvarName\fR refers to a parameter
-or local variable of the procedure unless the \fIglobal\fR command
-has been invoked to declare \fIvarName\fR to be global.
+or local variable of the procedure unless the \fBglobal\fR command
+was invoked to declare \fIvarName\fR to be global,
+or unless a \fBvariable\fR command
+was invoked to declare \fIvarName\fR to be a namespace variable.
 
 .SH KEYWORDS
 read, write, variable
diff --git a/contrib/tcl/doc/string.n b/contrib/tcl/doc/string.n
index bed040d..0bccf30 100644
--- a/contrib/tcl/doc/string.n
+++ b/contrib/tcl/doc/string.n
@@ -5,10 +5,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) string.n 1.7 96/03/25 20:24:06
+'\" SCCS: @(#) string.n 1.9 96/08/26 13:00:14
 '\" 
 .so man.macros
-.TH string n 7.4 Tcl "Tcl Built-In Commands"
+.TH string n 7.6 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -77,9 +77,10 @@ avoiding the special interpretation of the characters
 \fBstring range \fIstring first last\fR
 Returns a range of consecutive characters from \fIstring\fR, starting
 with the character whose index is \fIfirst\fR and ending with the
-character whose index is \fIlast\fR.  An index of 0 refers to the
-first character of the string.  \fILast\fR may be \fBend\fR (or any
-abbreviation of it) to refer to the last character of the string.
+character whose index is \fIlast\fR. An index of 0 refers to the
+first character of the string.  
+An index of \fBend\fR (or any
+abbreviation of it) refers to the last character of the string.
 If \fIfirst\fR is less than zero then it is treated as if it were zero, and
 if \fIlast\fR is greater than or equal to the length of the string then
 it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater than
@@ -115,7 +116,6 @@ If \fIchars\fR is not specified then white space is removed
 (spaces, tabs, newlines, and carriage returns).
 .TP
 \fBstring wordend \fIstring index\fR
-.VS
 Returns the index of the character just after the last one in the
 word containing character \fIindex\fR of \fIstring\fR.
 A word is considered to be any contiguous range of alphanumeric
@@ -126,7 +126,6 @@ Returns the index of the first character in the
 word containing character \fIindex\fR of \fIstring\fR.
 A word is considered to be any contiguous range of alphanumeric
 or underscore characters, or any single character other than these.
-.VE
 
 .SH KEYWORDS
 case conversion, compare, index, match, pattern, string, word
diff --git a/contrib/tcl/doc/tclsh.1 b/contrib/tcl/doc/tclsh.1
index 228a9a4..2922d81 100644
--- a/contrib/tcl/doc/tclsh.1
+++ b/contrib/tcl/doc/tclsh.1
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) tclsh.1 1.12 96/03/25 20:25:06
+'\" SCCS: @(#) tclsh.1 1.13 96/08/26 13:00:15
 '\" 
 .so man.macros
 .TH tclsh 1 "" Tcl "Tcl Applications"
@@ -50,7 +50,6 @@ you mark the file as executable.
 This assumes that \fBtclsh\fR has been installed in the default
 location in /usr/local/bin;  if it's installed somewhere else
 then you'll have to modify the above line to match.
-.VS
 Many UNIX systems do not allow the \fB#!\fR line to exceed about
 30 characters in length, so be sure that the \fBtclsh\fR
 executable can be accessed with a short file name.
@@ -80,7 +79,6 @@ instead to start up \fBtclsh\fR to reprocess the entire script.
 When \fBtclsh\fR starts up, it treats all three lines as comments,
 since the backslash at the end of the second line causes the third
 line to be treated as part of the comment on the second line.
-.VE
 
 .SH "VARIABLES"
 .PP
diff --git a/contrib/tcl/doc/tclvars.n b/contrib/tcl/doc/tclvars.n
index 47f1b15..9270fcf 100644
--- a/contrib/tcl/doc/tclvars.n
+++ b/contrib/tcl/doc/tclvars.n
@@ -1,14 +1,14 @@
 '\"
 '\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) tclvars.n 1.15 96/04/12 08:28:20
+'\" SCCS: @(#) tclvars.n 1.30 97/05/02 13:06:45
 '\" 
 .so man.macros
-.TH tclvars n 7.5 Tcl "Tcl Built-In Commands"
+.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -36,6 +36,14 @@ passed to children by commands like \fBexec\fR.
 If the entire \fBenv\fR array is unset then Tcl will stop
 monitoring \fBenv\fR accesses and will not update environment
 variables.
+.RS
+Under Windows, the environment variables PATH, COMSPEC, and WINDIR in any
+capitalization are converted automatically to upper case.  For instance, the
+PATH variable could be exported by the operating system as ``path'',
+``Path'', ``PaTh'', etc., causing otherwise simple Tcl code to have to
+support many special cases.  All other environment variables inherited by
+Tcl are left unmodified.
+.RE
 .TP
 \fBerrorCode\fR
 After an error has occurred, this variable will be set to hold
@@ -49,7 +57,6 @@ Tcl core; individual applications may define additional formats.
 .RS
 .TP
 \fBARITH\fI code msg\fR
-.VS
 This format is used when an arithmetic error occurs (e.g. an attempt
 to divide by zero in the \fBexpr\fR command).
 \fICode\fR identifies the precise error and \fImsg\fR provides a
@@ -59,7 +66,6 @@ DOMAIN (if an argument is outside the domain of a function, such as acos(\-3)),
 IOVERFLOW (for integer overflow),
 OVERFLOW (for a floating-point overflow),
 or UNKNOWN (if the cause of the error cannot be determined).
-.VE
 .TP
 \fBCHILDKILLED\fI pid sigName msg\fR
 This format is used when a child process has been killed because of
@@ -97,10 +103,8 @@ error.  In these cases \fBerrorCode\fR will consist of a list
 containing a single element whose contents are \fBNONE\fR.
 .TP
 \fBPOSIX \fIerrName msg\fR
-.VS
 If the first element of \fBerrorCode\fR is \fBPOSIX\fR, then
 the error occurred during a POSIX kernel call.
-.VE
 The second element of the list will contain the symbolic name
 of the error that occurred, such as \fBENOENT\fR; this will
 be one of the values defined in the include file errno.h.
@@ -109,10 +113,7 @@ message corresponding to \fIerrName\fR, such as
 ``no such file or directory'' for the \fBENOENT\fR case.
 .PP
 To set \fBerrorCode\fR, applications should use library
-procedures such as \fBTcl_SetErrorCode\fR and
-.VS
-\fBTcl_PosixError\fR,
-.VE
+procedures such as \fBTcl_SetErrorCode\fR and \fBTcl_PosixError\fR,
 or they may invoke the \fBerror\fR command.
 If one of these methods hasn't been used, then the Tcl
 interpreter will reset the variable to \fBNONE\fR after
@@ -127,12 +128,11 @@ Its contents take the form of a stack trace showing the various
 nested Tcl commands that had been invoked at the time of the error.
 .TP
 \fBtcl_library\fR
-.VS
-This variable holds the network name of a directory containing the
+This variable holds the name of a directory containing the
 system library of Tcl scripts, such as those used for auto-loading.
 The value of this variable is returned by the \fBinfo library\fR command.
 See the \fBlibrary\fR manual entry for details of the facilities 
-rovided by the Tcl script library.
+provided by the Tcl script library.
 Normally each application or package will have its own application-specific
 script library in addition to the Tcl script library;
 each application should set a global variable with a name like
@@ -147,7 +147,6 @@ If \fBTCL_LIBRARY\fR isn't set or doesn't refer to an appropriate
 directory, then Tcl checks several other directories based on a
 compiled-in default location, the location of the binary containing
 the application, and the current working directory.
-.VE
 .TP
 \fBtcl_patchLevel\fR
 When an interpreter is created Tcl initializes this variable to
@@ -158,6 +157,24 @@ The value of this variable is returned by the \fBinfo patchlevel\fR
 command.
 .VS br
 .TP
+\fBtcl_pkgPath\fR
+This variable holds a list of directories indicating where packages are
+normally installed.  It typically contains either one or two entries; 
+if it contains two entries, the first is normally a directory for
+platform-dependent packages (e.g., shared library binaries) and the
+second is normally a directory for platform-independent packages (e.g.,
+script files). Typically a package is installed as a subdirectory of one
+of the entries in \fB$tcl_pkgPath\fR. The directories in
+\fB$tcl_pkgPath\fR are included by default in the \fBauto_path\fR
+variable, so they and their immediate subdirectories are automatically
+searched for packages during \fBpackage require\fR commands.  Note:
+\fBtcl_pkgPath\fR it not intended to be modified by the application.
+Its value is added to \fBauto_path\fR at startup; changes to
+\fBtcl_pkgPath\fR are not reflected in \fBauto_path\fR.  If you
+want Tcl to search additional directories for packages you should add
+the names of those directories to \fBauto_path\fR, not \fBtcl_pkgPath\fR.
+.VE
+.TP
 \fBtcl_platform\fR
 This is an associative array whose elements contain information about
 the platform on which the application is running, such as the name of
@@ -168,16 +185,22 @@ retrieve any relevant information.  In addition, extensions
 and applications may add additional values to the array.  The
 predefined elements are:
 .RS
+.VS
+.TP
+\fBbyteOrder\fR
+The native byte order of this machine: either \fBlittleEndian\fR or
+\fBbigEndian\fR. 
+.VE
 .TP
 \fBmachine\fR
 The instruction set executed by this machine, such as
-\fBPPC\fR, \fB68k\fR, or \fBsun4m\fR.  On UNIX machines, this
+\fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR.  On UNIX machines, this
 is the value returned by \fBuname -m\fR.
 .TP
-\fBos\fR
-The name of the operating system running on this machine, such
-as \fBWin95\fR, \fBMacOS\fR, or \fBSunOS\fR.  On UNIX machines,
-this is the value returned by \fBuname -s\fR.
+\fBos\fR 
+The name of the operating system running on this machine,
+such as \fBWin32s\fR, \fBWindows NT\fR, \fBMacOS\fR, or \fBSunOS\fR.
+On UNIX machines, this is the value returned by \fBuname -s\fR.
 .TP
 \fBosVersion\fR
 The version number for the operating system running on this machine.
@@ -187,25 +210,72 @@ On UNIX machines, this is the value returned by \fBuname -r\fR.
 Either \fBwindows\fR, \fBmacintosh\fR, or \fBunix\fR.  This identifies the
 general operating environment of the machine.
 .RE
-.VE
 .TP
 \fBtcl_precision\fR
-If this variable is set, it must contain a decimal number giving the
+.VS
+In Tcl versions before 8.0, this variable controlled the
 number of significant digits to include when converting floating-point
 values to strings.
-If this variable is not set then 6 digits are included.
+If the variable was not set then 6 digits were included.
 17 digits is ``perfect'' for IEEE floating-point in that it allows
 double-precision values to be converted to strings and back to
 binary with no loss of precision.
-.VS br
+As of Tcl 8.0 this variable is ignored and all conversions use the
+full 17 digits.
+.VE
 .TP
 \fBtcl_rcFileName\fR
 This variable is used during initialization to indicate the name of a
 user-specific startup file.  If it is set by application-specific
 initialization, then the Tcl startup code will check for the existence
 of this file and \fBsource\fR it if it exists.  For example, for \fBwish\fR
-the variable is set to \fB~/.wishrc\fR.
-.VE
+the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR
+for Windows.
+.TP
+\fBtcl_rcRsrcName\fR
+This variable is only used on Macintosh systems.  The variable is used
+during initialization to indicate the name of a user-specific
+\fBTEXT\fR resource located in the application or extension resource
+forks.  If it is set by application-specific initialization, then the
+Tcl startup code will check for the existence of this resource and
+\fBsource\fR it if it exists.  For example, the Macintosh \fBwish\fR
+application has the variable is set to \fBtclshrc\fR.
+.TP
+\fBtcl_traceCompile\fR
+The value of this variable can be set to control
+how much tracing information
+is displayed during bytecode compilation.
+By default, tcl_traceCompile is zero and no information is displayed.
+Setting tcl_traceCompile to 1 generates a one line summary in stdout
+whenever a procedure or top level command is compiled.
+Setting it to 2 generates a detailed listing in stdout of the
+bytecode instructions emitted during every compilation.
+This variable is useful in
+tracking down suspected problems with the Tcl compiler.
+It is also occasionally useful when converting
+existing code to use Tcl8.0.
+.TP
+\fBtcl_traceExec\fR
+The value of this variable can be set to control
+how much tracing information
+is displayed during bytecode execution.
+By default, tcl_traceExec is zero and no information is displayed.
+Setting tcl_traceExec to 1 generates a one line trace in stdout
+on each call to a Tcl procedure.
+Setting it to 2 generates a line of output
+whenever any Tcl command is invoked
+that contains the name of the command and its arguments.
+Setting it to 3 produces a detailed trace showing the result of
+executing each bytecode instruction.
+Note that when tcl_traceExec is 2 or 3,
+commands such as set and incr
+that have been entirely replaced by a sequence
+of bytecode instructions are not shown.
+Setting this variable is useful in
+tracking down suspected problems with the bytecode compiler
+and interpreter.
+It is also occasionally useful when converting
+code to use Tcl8.0.
 .TP
 \fBtcl_version\fR
 When an interpreter is created Tcl initializes this variable to
@@ -217,4 +287,4 @@ The value of this variable is returned by the \fBinfo tclversion\fR
 command.
 
 .SH KEYWORDS
-arithmetic, error, environment, POSIX, precision, subprocess, variables
+arithmetic, bytecode, compiler, error, environment, POSIX, precision, subprocess, variables
diff --git a/contrib/tcl/doc/tell.n b/contrib/tcl/doc/tell.n
index 9edf7d2..b2c0ec1 100644
--- a/contrib/tcl/doc/tell.n
+++ b/contrib/tcl/doc/tell.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) tell.n 1.8 96/02/15 20:02:42
+'\" SCCS: @(#) tell.n 1.9 96/08/26 13:00:17
 '\" 
 .so man.macros
 .TH tell n 7.5 Tcl "Tcl Built-In Commands"
@@ -21,10 +21,8 @@ tell \- Return current access position for an open channel
 .PP
 Returns a decimal string giving the current access position in
 \fIchannelId\fR.
-.VS
 The value returned is -1 for channels that do not support
 seeking.
-.VE
 
 .SH KEYWORDS
 access position, channel, seeking
diff --git a/contrib/tcl/doc/trace.n b/contrib/tcl/doc/trace.n
index 7832d2f..cabf495 100644
--- a/contrib/tcl/doc/trace.n
+++ b/contrib/tcl/doc/trace.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) trace.n 1.11 96/03/25 20:25:42
+'\" SCCS: @(#) trace.n 1.12 96/08/26 13:00:18
 '\" 
 .so man.macros
 .TH trace n "" Tcl "Tcl Built-In Commands"
@@ -92,9 +92,7 @@ result of the traced operation.
 The return value from  \fIcommand\fR is ignored except that
 if it returns an error of any sort then the traced operation
 also returns an error with
-.VS
 the same error message returned by the trace command
-.VE
 (this mechanism can be used to implement read-only variables, for
 example).
 For write traces, \fIcommand\fR is invoked after the variable's
@@ -108,10 +106,8 @@ on the variable are temporarily disabled.
 This means that reads and writes invoked by
 \fIcommand\fR will occur directly, without invoking \fIcommand\fR
 (or any other traces) again.
-.VS
 However, if \fIcommand\fR unsets the variable then unset traces
 will be invoked.
-.VE
 .PP
 When an unset trace is invoked, the variable has already been
 deleted:  it will appear to be undefined with no traces.
@@ -122,9 +118,7 @@ will no longer exist.
 Traces are not disabled during unset traces, so if an unset trace
 command creates a new trace and accesses the variable, the
 trace will be invoked.
-.VS
 Any errors in unset traces are ignored.
-.VE
 .PP
 If there are multiple traces on a variable they are invoked
 in order of creation, most-recent first.
diff --git a/contrib/tcl/doc/upvar.n b/contrib/tcl/doc/upvar.n
index 37baf4c..e6e47ce 100644
--- a/contrib/tcl/doc/upvar.n
+++ b/contrib/tcl/doc/upvar.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) upvar.n 1.14 96/03/25 20:27:03
+'\" SCCS: @(#) upvar.n 1.15 96/08/26 13:00:19
 '\" 
 .so man.macros
 .TH upvar n "" Tcl "Tcl Built-In Commands"
@@ -34,13 +34,11 @@ The variable named by \fIotherVar\fR need not exist at the time of the
 call;  it will be created the first time \fImyVar\fR is referenced, just like
 an ordinary variable.  There must not exist a variable by the
 name \fImyVar\fR at the time \fBupvar\fR is invoked.
-.VS
 \fIMyVar\fR is always treated as the name of a variable, not an
 array element.  Even if the name looks like an array element,
 such as \fBa(b)\fR, a regular variable is created.
 \fIOtherVar\fR may refer to a scalar variable, an array,
 or an array element.
-.VE
 \fBUpvar\fR returns an empty string.
 .PP
 The \fBupvar\fR command simplifies the implementation of call-by-name
diff --git a/contrib/tcl/doc/variable.n b/contrib/tcl/doc/variable.n
new file mode 100644
index 0000000..1475d47
--- /dev/null
+++ b/contrib/tcl/doc/variable.n
@@ -0,0 +1,67 @@
+'\"
+'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" SCCS: @(#) variable.n 1.2 97/05/18 15:20:28
+'\" 
+.so man.macros
+.TH variable n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+variable \- create and initialize a namespace variable
+.SH SYNOPSIS
+\fBvariable \fR?\fIname value...\fR? \fIname \fR?\fIvalue\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is normally used within a
+\fBnamespace eval\fR command to create one or more variables
+within a namespace.
+Each variable \fIname\fR is initialized with \fIvalue\fR.
+The \fIvalue\fR for the last variable is optional.
+.PP
+If a variable \fIname\fR does not exist,
+it is created and given the optional \fIvalue\fR.
+If it already exists, it is simply set to the optional \fIvalue\fR.
+Normally, \fIname\fR is unqualified
+(does not include the names of any containing namespaces),
+and the variable is created in the current namespace.
+If \fIname\fR includes any namespace qualifiers,
+the variable is created in the specified namespace.
+.PP
+If the \fBvariable\fR command is executed inside a Tcl procedure,
+it creates local variables
+linked to the corresponding namespace variables.
+In this way the \fBvariable\fR command resembles the \fBglobal\fR command,
+although the \fBglobal\fR command
+only links to variables in the global namespace.
+If any \fIvalue\fRs are given,
+they are used to modify the values of the associated namespace variables.
+If a namespace variable does not exist,
+it is created and optionally initialized.
+.PP
+A \fIname\fR argument cannot reference an element within an array.
+Instead, \fIname\fR should reference the entire array,
+and the initialization \fIvalue\fR should be left off.
+After the variable has been declared,
+elements within the array can be set using ordinary
+\fBset\fR or \fBarray\fR commands.
+.PP
+It is generally best to provide a \fIvalue\fR to initialize each variable,
+or to initialize it immediately after the \fBvariable\fR command.
+This is because a namespace variable declared by a \fBvariable\fR command
+is not actually created until it is given a value.
+A declared but not yet initialized namespace variable
+will not appear in the output of an \fBinfo vars\fR command,
+for example.
+
+.SH "SEE ALSO"
+global(n), namespace(n)
+
+.SH KEYWORDS
+global, namespace, procedure, variable
diff --git a/contrib/tcl/doc/while.n b/contrib/tcl/doc/while.n
index 8703684..326d18f 100644
--- a/contrib/tcl/doc/while.n
+++ b/contrib/tcl/doc/while.n
@@ -1,11 +1,11 @@
 '\"
 '\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" SCCS: @(#) while.n 1.6 96/03/25 20:27:35
+'\" SCCS: @(#) while.n 1.7 97/04/08 17:13:50
 '\" 
 .so man.macros
 .TH while n "" Tcl "Tcl Built-In Commands"
@@ -19,7 +19,7 @@ while \- Execute script repeatedly as long as a condition is met
 
 .SH DESCRIPTION
 .PP
-The \fIwhile\fR command evaluates \fItest\fR as an expression
+The \fBwhile\fR command evaluates \fItest\fR as an expression
 (in the same way that \fBexpr\fR evaluates its argument).
 The value of the expression must a proper boolean
 value; if it is a true value
@@ -32,6 +32,24 @@ iteration of the loop, and \fBbreak\fR
 commands may be executed inside \fIbody\fR to cause immediate
 termination of the \fBwhile\fR command.  The \fBwhile\fR command
 always returns an empty string.
+.PP
+Note: \fItest\fR should almost always be enclosed in braces.  If not,
+variable substitutions will be made before the \fBwhile\fR
+command starts executing, which means that variable changes
+made by the loop body will not be considered in the expression.
+This is likely to result in an infinite loop.  If \fItest\fR is
+enclosed in braces, variable substitutions are delayed until the
+expression is evaluated (before
+each loop iteration), so changes in the variables will be visible.
+For an example, try the following script with and without the braces
+around \fB$x<10\fR:
+.CS
+set x 0
+while {$x<10} {
+	puts "x is $x"
+	incr x
+}
+.CE
 
 .SH KEYWORDS
 boolean value, loop, test, while
diff --git a/contrib/tcl/generic/panic.c b/contrib/tcl/generic/panic.c
index 4ad98fd..420a157 100644
--- a/contrib/tcl/generic/panic.c
+++ b/contrib/tcl/generic/panic.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) panic.c 1.11 96/02/15 11:50:29
+ * SCCS: @(#) panic.c 1.15 96/09/12 14:55:25
  */
 
 #include <stdio.h>
@@ -21,7 +21,13 @@
 #   include <stdlib.h>
 #endif
 
+#define panic panicDummy
 #include "tcl.h"
+#undef panic
+
+EXTERN void		panic _ANSI_ARGS_((char *format, char *arg1,
+			    char *arg2, char *arg3, char *arg4, char *arg5,
+			    char *arg6, char *arg7, char *arg8));
 
 /*
  * The panicProc variable contains a pointer to an application
@@ -29,8 +35,6 @@
  */
 
 void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
-
-
 
 /*
  *----------------------------------------------------------------------
diff --git a/contrib/tcl/generic/regexp.c b/contrib/tcl/generic/regexp.c
index 52e5a51..8254836 100644
--- a/contrib/tcl/generic/regexp.c
+++ b/contrib/tcl/generic/regexp.c
@@ -41,7 +41,7 @@
  * *** 2. This in addition to changes to TclRegError makes the   ***
  * ***    code multi-thread safe.                                ***
  *
- * SCCS: @(#) regexp.c 1.12 96/04/02 13:54:57
+ * SCCS: @(#) regexp.c 1.13 97/04/29 17:49:17
  */
 
 #include "tclInt.h"
@@ -569,13 +569,11 @@ struct regcomp_state *rcstate;
 	case ')':
 		FAIL("internal urp");	/* Supposed to be caught earlier. */
 		/* NOTREACHED */
-		break;
 	case '?':
 	case '+':
 	case '*':
 		FAIL("?+* follows nothing");
 		/* NOTREACHED */
-		break;
 	case '\\':
 		if (*rcstate->regparse == '\0')
 			FAIL("trailing \\");
diff --git a/contrib/tcl/generic/tcl.h b/contrib/tcl/generic/tcl.h
index 37490ba..22331af 100644
--- a/contrib/tcl/generic/tcl.h
+++ b/contrib/tcl/generic/tcl.h
@@ -5,18 +5,45 @@
  *	of the Tcl interpreter.
  *
  * Copyright (c) 1987-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1996 Lucent Technologies.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tcl.h 1.269 96/06/13 16:36:48
+ * SCCS: @(#) tcl.h 1.318 97/06/26 13:43:02
  */
 
 #ifndef _TCL
 #define _TCL
 
 /*
+ * When version numbers change here, must also go into the following files
+ * and update the version numbers:
+ *
+ * library/init.tcl
+ * unix/configure.in
+ * unix/pkginfo
+ * win/makefile.bc
+ * win/makefile.vc
+ *
+ * The release level should be  0 for alpha, 1 for beta, and 2 for
+ * final/patch.  The release serial value is the number that follows the
+ * "a", "b", or "p" in the patch level; for example, if the patch level
+ * is 7.6b2, TCL_RELEASE_SERIAL is 2.  It restarts at 1 whenever the
+ * release level is changed, except for the final release which is 0
+ * (the first patch will start at 1).
+ */
+
+#define TCL_MAJOR_VERSION   8
+#define TCL_MINOR_VERSION   0
+#define TCL_RELEASE_LEVEL   1
+#define TCL_RELEASE_SERIAL  2
+
+#define TCL_VERSION	    "8.0"
+#define TCL_PATCH_LEVEL	    "8.0b2"
+
+/*
  * The following definitions set up the proper options for Windows
  * compilers.  We use this method because there is no autoconf equivalent.
  */
@@ -28,6 +55,9 @@
 #endif
 
 #ifdef __WIN32__
+#   ifndef STRICT
+#	define STRICT
+#   endif
 #   ifndef USE_PROTOTYPE
 #	define USE_PROTOTYPE 1
 #   endif
@@ -40,16 +70,42 @@
 #   ifndef USE_TCLALLOC
 #	define USE_TCLALLOC 1
 #   endif
+#   ifndef STRINGIFY
+#	define STRINGIFY(x)	    STRINGIFY1(x)
+#	define STRINGIFY1(x)	    #x
+#   endif
 #endif /* __WIN32__ */
 
+/*
+ * The following definitions set up the proper options for Macintosh
+ * compilers.  We use this method because there is no autoconf equivalent.
+ */
+
+#ifdef MAC_TCL
+#   ifndef HAS_STDARG
+#	define HAS_STDARG 1
+#   endif
+#   ifndef USE_TCLALLOC
+#	define USE_TCLALLOC 1
+#   endif
+#   ifndef NO_STRERROR
+#	define NO_STRERROR 1
+#   endif
+#endif
+
+/* 
+ * A special definition used to allow this header file to be included 
+ * in resource files so that they can get obtain version information from
+ * this file.  Resource compilers don't like all the C stuff, like typedefs
+ * and procedure declarations, that occur below.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
 #ifndef BUFSIZ
 #include <stdio.h>
 #endif
 
-#define TCL_VERSION "7.5"
-#define TCL_MAJOR_VERSION 7
-#define TCL_MINOR_VERSION 5
-
 /*
  * Definitions that allow Tcl functions with variable numbers of
  * arguments to be used with either varargs.h or stdarg.h.  TCL_VARARGS
@@ -142,55 +198,69 @@ typedef long LONG;
 #endif
 
 /*
- * Data structures defined opaquely in this module.  The definitions
- * below just provide dummy types.  A few fields are made visible in
- * Tcl_Interp structures, namely those for returning string values.
- * Note:  any change to the Tcl_Interp definition below must be mirrored
+ * Data structures defined opaquely in this module. The definitions below
+ * just provide dummy types. A few fields are made visible in Tcl_Interp
+ * structures, namely those used for returning a string result from
+ * commands. Direct access to the result field is discouraged in Tcl 8.0.
+ * The interpreter result is either an object or a string, and the two
+ * values are kept consistent unless some C code sets interp->result
+ * directly. Programmers should use either the procedure Tcl_GetObjResult()
+ * or Tcl_GetStringResult() to read the interpreter's result. See the
+ * SetResult man page for details.
+ * 
+ * Note: any change to the Tcl_Interp definition below must be mirrored
  * in the "real" definition in tclInt.h.
+ *
+ * Note: Tcl_ObjCmdProc procedures do not directly set result and freeProc.
+ * Instead, they set a Tcl_Obj member in the "real" structure that can be
+ * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
  */
 
-typedef struct Tcl_Interp{
-    char *result;		/* Points to result string returned by last
-				 * command. */
+typedef struct Tcl_Interp {
+    char *result;		/* If the last command returned a string
+				 * result, this points to it. */
     void (*freeProc) _ANSI_ARGS_((char *blockPtr));
-				/* Zero means result is statically allocated.
-				 * TCL_DYNAMIC means result was allocated with
-				 * ckalloc and should be freed with ckfree.
-				 * Other values give address of procedure
-				 * to invoke to free the result.  Must be
-				 * freed by Tcl_Eval before executing next
-				 * command. */
-    int errorLine;		/* When TCL_ERROR is returned, this gives
-				 * the line number within the command where
-				 * the error occurred (1 means first line). */
+				/* Zero means the string result is
+				 * statically allocated. TCL_DYNAMIC means
+				 * it was allocated with ckalloc and should
+				 * be freed with ckfree. Other values give
+				 * the address of procedure to invoke to
+				 * free the result. Tcl_Eval must free it
+				 * before executing next command. */
+    int errorLine;              /* When TCL_ERROR is returned, this gives
+                                 * the line number within the command where
+                                 * the error occurred (1 if first line). */
 } Tcl_Interp;
 
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
+typedef struct Tcl_Channel_ *Tcl_Channel;
 typedef struct Tcl_Command_ *Tcl_Command;
 typedef struct Tcl_Event Tcl_Event;
-typedef struct Tcl_File_ *Tcl_File;
-typedef struct Tcl_Channel_ *Tcl_Channel;
+typedef struct Tcl_Pid_ *Tcl_Pid;
 typedef struct Tcl_RegExp_ *Tcl_RegExp;
 typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
 typedef struct Tcl_Trace_ *Tcl_Trace;
+typedef struct Tcl_Var_ *Tcl_Var;
 
 /*
- * When a TCL command returns, the string pointer interp->result points to
- * a string containing return information from the command.  In addition,
- * the command procedure returns an integer value, which is one of the
- * following:
+ * When a TCL command returns, the interpreter contains a result from the
+ * command. Programmers are strongly encouraged to use one of the
+ * procedures Tcl_GetObjResult() or Tcl_GetStringResult() to read the
+ * interpreter's result. See the SetResult man page for details. Besides
+ * this result, the command procedure returns an integer code, which is 
+ * one of the following:
  *
- * TCL_OK		Command completed normally;  interp->result contains
- *			the command's result.
+ * TCL_OK		Command completed normally; the interpreter's
+ *			result contains	the command's result.
  * TCL_ERROR		The command couldn't be completed successfully;
- *			interp->result describes what went wrong.
+ *			the interpreter's result describes what went wrong.
  * TCL_RETURN		The command requests that the current procedure
- *			return;  interp->result contains the procedure's
- *			return value.
+ *			return; the interpreter's result contains the
+ *			procedure's return value.
  * TCL_BREAK		The command requests that the innermost loop
- *			be exited;  interp->result is meaningless.
+ *			be exited; the interpreter's result is meaningless.
  * TCL_CONTINUE		Go on to the next iteration of the current loop;
- *			interp->result is meaningless.
+ *			the interpreter's result is meaningless.
  */
 
 #define TCL_OK		0
@@ -214,6 +284,14 @@ typedef struct Tcl_Value {
 } Tcl_Value;
 
 /*
+ * Forward declaration of Tcl_Obj to prevent an error when the forward
+ * reference to Tcl_Obj is encountered in the procedure types declared 
+ * below.
+ */
+
+struct Tcl_Obj;
+
+/*
  * Procedure types defined by Tcl:
  */
 
@@ -228,6 +306,8 @@ typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
 typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
 	ClientData cmdClientData, int argc, char *argv[]));
+typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr, 
+        struct Tcl_Obj *dupPtr));
 typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
 typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
 	int flags));
@@ -238,31 +318,231 @@ typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
 typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData));
 typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
 typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
 typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
 typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData));
 typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp));
 typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
+typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
 typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
 typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
         Tcl_Channel chan, char *address, int port));
 typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	struct Tcl_Obj *objPtr));
+typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
 typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, char *part1, char *part2, int flags));
 
 /*
- * The structure returned by Tcl_GetCmdInfo and passed into
- * Tcl_SetCmdInfo:
+ * The following structure represents a type of object, which is a
+ * particular internal representation for an object plus a set of
+ * procedures that provide standard operations on objects of that type.
+ */
+
+typedef struct Tcl_ObjType {
+    char *name;			/* Name of the type, e.g. "int". */
+    Tcl_FreeInternalRepProc *freeIntRepProc;
+				/* Called to free any storage for the type's
+				 * internal rep. NULL if the internal rep
+				 * does not need freeing. */
+    Tcl_DupInternalRepProc *dupIntRepProc;
+    				/* Called to create a new object as a copy
+				 * of an existing object. */
+    Tcl_UpdateStringProc *updateStringProc;
+    				/* Called to update the string rep from the
+				 * type's internal representation. */
+    Tcl_SetFromAnyProc *setFromAnyProc;
+    				/* Called to convert the object's internal
+				 * rep to this type. Frees the internal rep
+				 * of the old type. Returns TCL_ERROR on
+				 * failure. */
+} Tcl_ObjType;
+
+/*
+ * One of the following structures exists for each object in the Tcl
+ * system. An object stores a value as either a string, some internal
+ * representation, or both.
  */
 
+typedef struct Tcl_Obj {
+    int refCount;		/* When 0 the object will be freed. */
+    char *bytes;		/* This points to the first byte of the
+				 * object's string representation. The array
+				 * must be followed by a null byte (i.e., at
+				 * offset length) but may also contain
+				 * embedded null characters. The array's
+				 * storage is allocated by ckalloc. NULL
+				 * means the string rep is invalid and must
+				 * be regenerated from the internal rep.
+				 * Clients should use Tcl_GetStringFromObj
+				 * to get a pointer to the byte array as a
+				 * readonly value. */
+    int length;			/* The number of bytes at *bytes, not
+				 * including the terminating null. */
+    Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
+				 * corresponds to the type of the object's
+				 * internal rep. NULL indicates the object
+				 * has no internal rep (has no type). */
+    union {			/* The internal representation: */
+	long longValue;		/*   - an long integer value */
+	double doubleValue;	/*   - a double-precision floating value */
+	VOID *otherValuePtr;	/*   - another, type-specific value */
+	struct {		/*   - internal rep as two pointers */
+	    VOID *ptr1;
+	    VOID *ptr2;
+	} twoPtrValue;
+    } internalRep;
+} Tcl_Obj;
+
+/*
+ * Macros to increment and decrement a Tcl_Obj's reference count, and to
+ * test whether an object is shared (i.e. has reference count > 1).
+ * Note: clients should use Tcl_DecrRefCount() when they are finished using
+ * an object, and should never call TclFreeObj() directly. TclFreeObj() is
+ * only defined and made public in tcl.h to support Tcl_DecrRefCount's macro
+ * definition. Note also that Tcl_DecrRefCount() refers to the parameter
+ * "obj" twice. This means that you should avoid calling it with an
+ * expression that is expensive to compute or has side effects.
+ */
+
+#define Tcl_IncrRefCount(objPtr) \
+    ++(objPtr)->refCount
+#define Tcl_DecrRefCount(objPtr) \
+    if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr)
+#define Tcl_IsShared(objPtr) \
+    ((objPtr)->refCount > 1)
+
+/*
+ * Macros and definitions that help to debug the use of Tcl objects.
+ * When TCL_MEM_DEBUG is defined, the Tcl_New* declarations are 
+ * overridden to call debugging versions of the object creation procedures.
+ */
+
+EXTERN Tcl_Obj *	Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
+EXTERN Tcl_Obj *	Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
+EXTERN Tcl_Obj *	Tcl_NewIntObj _ANSI_ARGS_((int intValue));
+EXTERN Tcl_Obj *	Tcl_NewListObj _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Obj *	Tcl_NewLongObj _ANSI_ARGS_((long longValue));
+EXTERN Tcl_Obj *	Tcl_NewObj _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	Tcl_NewStringObj _ANSI_ARGS_((char *bytes,
+			    int length));
+
+#ifdef TCL_MEM_DEBUG
+#  define Tcl_NewBooleanObj(val) \
+     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
+#  define Tcl_NewDoubleObj(val) \
+     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
+#  define Tcl_NewIntObj(val) \
+     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+#  define Tcl_NewListObj(objc, objv) \
+     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
+#  define Tcl_NewLongObj(val) \
+     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+#  define Tcl_NewObj() \
+     Tcl_DbNewObj(__FILE__, __LINE__)
+#  define Tcl_NewStringObj(bytes, len) \
+     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * The following definitions support Tcl's namespace facility.
+ * Note: the first five fields must match exactly the fields in a
+ * Namespace structure (see tcl.h). 
+ */
+
+typedef struct Tcl_Namespace {
+    char *name;                 /* The namespace's name within its parent
+				 * namespace. This contains no ::'s. The
+				 * name of the global namespace is ""
+				 * although "::" is an synonym. */
+    char *fullName;             /* The namespace's fully qualified name.
+				 * This starts with ::. */
+    ClientData clientData;      /* Arbitrary value associated with this
+				 * namespace. */
+    Tcl_NamespaceDeleteProc* deleteProc;
+                                /* Procedure invoked when deleting the
+				 * namespace to, e.g., free clientData. */
+    struct Tcl_Namespace* parentPtr;
+                                /* Points to the namespace that contains
+				 * this one. NULL if this is the global
+				 * namespace. */
+} Tcl_Namespace;
+
+/*
+ * The following structure represents a call frame, or activation record.
+ * A call frame defines a naming context for a procedure call: its local
+ * scope (for local variables) and its namespace scope (used for non-local
+ * variables; often the global :: namespace). A call frame can also define
+ * the naming context for a namespace eval or namespace inscope command:
+ * the namespace in which the command's code should execute. The
+ * Tcl_CallFrame structures exist only while procedures or namespace
+ * eval/inscope's are being executed, and provide a Tcl call stack.
+ * 
+ * A call frame is initialized and pushed using Tcl_PushCallFrame and
+ * popped using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be
+ * provided by the Tcl_PushCallFrame caller, and callers typically allocate
+ * them on the C call stack for efficiency. For this reason, Tcl_CallFrame
+ * is defined as a structure and not as an opaque token. However, most
+ * Tcl_CallFrame fields are hidden since applications should not access
+ * them directly; others are declared as "dummyX".
+ *
+ * WARNING!! The structure definition must be kept consistent with the
+ * CallFrame structure in tclInt.h. If you change one, change the other.
+ */
+
+typedef struct Tcl_CallFrame {
+    Tcl_Namespace *nsPtr;
+    int dummy1;
+    int dummy2;
+    char *dummy3;
+    char *dummy4;
+    char *dummy5;
+    int dummy6;
+    char *dummy7;
+    char *dummy8;
+    int dummy9;
+    char* dummy10;
+} Tcl_CallFrame;
+
+/*
+ * Information about commands that is returned by Tcl_GetCmdInfo and passed
+ * to Tcl_SetCmdInfo. objProc is an objc/objv object-based command procedure
+ * while proc is a traditional Tcl argc/argv string-based procedure.
+ * Tcl_CreateObjCommand and Tcl_CreateCommand ensure that both objProc and
+ * proc are non-NULL and can be called to execute the command. However,
+ * it may be faster to call one instead of the other. The member
+ * isNativeObjectProc is set to 1 if an object-based procedure was
+ * registered by Tcl_CreateObjCommand, and to 0 if a string-based procedure
+ * was registered by Tcl_CreateCommand. The other procedure is typically set
+ * to a compatibility wrapper that does string-to-object or object-to-string
+ * argument conversions then calls the other procedure.
+ */
+     
 typedef struct Tcl_CmdInfo {
-    Tcl_CmdProc *proc;			/* Procedure to implement command. */
-    ClientData clientData;		/* ClientData passed to proc. */
-    Tcl_CmdDeleteProc *deleteProc;	/* Procedure to call when command
-					 * is deleted. */
-    ClientData deleteData;		/* Value to pass to deleteProc (usually
-					 * the same as clientData). */
+    int isNativeObjectProc;	 /* 1 if objProc was registered by a call to
+				  * Tcl_CreateObjCommand; 0 otherwise.
+				  * Tcl_SetCmdInfo does not modify this
+				  * field. */
+    Tcl_ObjCmdProc *objProc;	 /* Command's object-based procedure. */
+    ClientData objClientData;	 /* ClientData for object proc. */
+    Tcl_CmdProc *proc;		 /* Command's string-based procedure. */
+    ClientData clientData;	 /* ClientData for string proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+                                 /* Procedure to call when command is
+                                  * deleted. */
+    ClientData deleteData;	 /* Value to pass to deleteProc (usually
+				  * the same as clientData). */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace that contains
+				  * this command. Note that Tcl_SetCmdInfo
+				  * will not change a command's namespace;
+				  * use Tcl_RenameCommand to do that. */
+
 } Tcl_CmdInfo;
 
 /*
@@ -274,7 +554,7 @@ typedef struct Tcl_CmdInfo {
 #define TCL_DSTRING_STATIC_SIZE 200
 typedef struct Tcl_DString {
     char *string;		/* Points to beginning of string:  either
-				 * staticSpace below or a malloc'ed array. */
+				 * staticSpace below or a malloced array. */
     int length;			/* Number of non-NULL characters in the
 				 * string. */
     int spaceAvl;		/* Total number of bytes available for the
@@ -293,7 +573,7 @@ typedef struct Tcl_DString {
  * be specified in the "tcl_precision" variable, and the number of
  * characters of buffer space required by Tcl_PrintDouble.
  */
-
+ 
 #define TCL_MAX_PREC 17
 #define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
 
@@ -306,6 +586,13 @@ typedef struct Tcl_DString {
 #define TCL_DONT_USE_BRACES	1
 
 /*
+ * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
+ * abbreviated strings.
+ */
+
+#define TCL_EXACT	1
+
+/*
  * Flag values passed to Tcl_RecordAndEval.
  * WARNING: these bit choices must not conflict with the bit choices
  * for evalFlag bits in tclInt.h!!
@@ -327,15 +614,17 @@ typedef struct Tcl_DString {
  * Flag values passed to variable-related procedures.
  */
 
-#define TCL_GLOBAL_ONLY		1
-#define TCL_APPEND_VALUE	2
-#define TCL_LIST_ELEMENT	4
-#define TCL_TRACE_READS		0x10
-#define TCL_TRACE_WRITES	0x20
-#define TCL_TRACE_UNSETS	0x40
-#define TCL_TRACE_DESTROYED	0x80
-#define TCL_INTERP_DESTROYED	0x100
-#define TCL_LEAVE_ERR_MSG	0x200
+#define TCL_GLOBAL_ONLY		 1
+#define TCL_NAMESPACE_ONLY	 2
+#define TCL_APPEND_VALUE	 4
+#define TCL_LIST_ELEMENT	 8
+#define TCL_TRACE_READS		 0x10
+#define TCL_TRACE_WRITES	 0x20
+#define TCL_TRACE_UNSETS	 0x40
+#define TCL_TRACE_DESTROYED	 0x80
+#define TCL_INTERP_DESTROYED	 0x100
+#define TCL_LEAVE_ERR_MSG	 0x200
+#define TCL_PARSE_PART1		 0x400
 
 /*
  * Types for linked variables:
@@ -388,21 +677,6 @@ EXTERN void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
 #endif /* TCL_MEM_DEBUG */
 
 /*
- * Macro to free result of interpreter.
- */
-
-#define Tcl_FreeResult(interp)					\
-    if ((interp)->freeProc != 0) {				\
-	if (((interp)->freeProc == TCL_DYNAMIC)			\
-	    || ((interp)->freeProc == (Tcl_FreeProc *) free)) {	\
-	    ckfree((interp)->result);				\
-	} else {						\
-	    (*(interp)->freeProc)((interp)->result);		\
-	}							\
-	(interp)->freeProc = 0;					\
-    }
-
-/*
  * Forward declaration of Tcl_HashTable.  Needed by some C++ compilers
  * to prevent errors when the forward reference to Tcl_HashTable is
  * encountered in the Tcl_HashEntry structure.
@@ -472,9 +746,9 @@ typedef struct Tcl_HashTable {
                                          * is the size of the key.
 					 */
     Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
-	    char *key));
+	    CONST char *key));
     Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
-	    char *key, int *newPtr));
+	    CONST char *key, int *newPtr));
 } Tcl_HashTable;
 
 /*
@@ -545,7 +819,7 @@ struct Tcl_Event {
 };
 
 /*
- * Positions to pass to Tk_QueueEvent:
+ * Positions to pass to Tcl_QueueEvent:
  */
 
 typedef enum {
@@ -553,6 +827,14 @@ typedef enum {
 } Tcl_QueuePosition;
 
 /*
+ * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier
+ * event routines.
+ */
+
+#define TCL_SERVICE_NONE 0
+#define TCL_SERVICE_ALL 1
+
+/*
  * The following structure keeps is used to hold a time value, either as
  * an absolute time (the number of seconds from the epoch) or as an
  * elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
@@ -588,25 +870,27 @@ typedef struct Tcl_Time {
  * Typedefs for the various operations in a channel type:
  */
 
-typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((ClientData instanceData,
-		    Tcl_File inFile, Tcl_File outFile, int mode));
+typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mode));
 typedef int	(Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
-		    Tcl_Interp *interp, Tcl_File inFile, Tcl_File outFile));
+		    Tcl_Interp *interp));
 typedef int	(Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
-		    Tcl_File inFile, char *buf, int toRead,
-		    int *errorCodePtr));
+		    char *buf, int toRead, int *errorCodePtr));
 typedef int	(Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
-	            Tcl_File outFile, char *buf, int toWrite,
-        	    int *errorCodePtr));
+		    char *buf, int toWrite, int *errorCodePtr));
 typedef int	(Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
-		    Tcl_File inFile, Tcl_File outFile, long offset, int mode,
-		    int *errorCodePtr));
+		    long offset, int mode, int *errorCodePtr));
 typedef int	(Tcl_DriverSetOptionProc) _ANSI_ARGS_((
 		    ClientData instanceData, Tcl_Interp *interp,
-                    char *optionName, char *value));
+	            char *optionName, char *value));
 typedef int	(Tcl_DriverGetOptionProc) _ANSI_ARGS_((
-		    ClientData instanceData, char *optionName,
-                    Tcl_DString *dsPtr));
+		    ClientData instanceData, Tcl_Interp *interp,
+		    char *optionName, Tcl_DString *dsPtr));
+typedef void	(Tcl_DriverWatchProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mask));
+typedef int	(Tcl_DriverGetHandleProc) _ANSI_ARGS_((
+		    ClientData instanceData, int direction,
+		    ClientData *handlePtr));
 
 /*
  * Enum for different end of line translation and recognition modes.
@@ -646,6 +930,11 @@ typedef struct Tcl_ChannelType {
     					/* Set an option on a channel. */
     Tcl_DriverGetOptionProc *getOptionProc;
     					/* Get an option from a channel. */
+    Tcl_DriverWatchProc *watchProc;	/* Set up the notifier to watch
+                                         * for events on this channel. */
+    Tcl_DriverGetHandleProc *getHandleProc;
+					/* Get an OS handle from the channel
+                                         * or NULL if not supported. */
 } Tcl_ChannelType;
 
 /*
@@ -659,18 +948,6 @@ typedef struct Tcl_ChannelType {
 					 * mode. */
 
 /*
- * Types for file handles:
- */
-
-#define TCL_UNIX_FD	1
-#define TCL_MAC_FILE	2
-#define TCL_MAC_SOCKET	3
-#define TCL_WIN_PIPE	4
-#define TCL_WIN_FILE	5
-#define TCL_WIN_SOCKET	6
-#define TCL_WIN_CONSOLE 7
-
-/*
  * Enum for different types of file paths.
  */
 
@@ -681,27 +958,24 @@ typedef enum Tcl_PathType {
 } Tcl_PathType;
 
 /*
- * The following interface is exported for backwards compatibility, but
- * is only implemented on Unix.  Portable applications should use
- * Tcl_OpenCommandChannel, instead.
- */
-
-EXTERN int		Tcl_CreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
-			    int argc, char **argv, int **pidArrayPtr,
-			    int *inPipePtr, int *outPipePtr,
-			    int *errFilePtr));
-
-/*
  * Exported Tcl procedures:
  */
 
 EXTERN void		Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *message));
+EXTERN void		Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *message, int length));
 EXTERN void		Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_AppendAllObjTypes _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr));
 EXTERN void		Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string));
 EXTERN void		Tcl_AppendResult _ANSI_ARGS_(
-    			    TCL_VARARGS(Tcl_Interp *,interp));
+			    TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN void		Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *bytes, int length));
+EXTERN void		Tcl_AppendStringsToObj _ANSI_ARGS_(
+			    TCL_VARARGS(Tcl_Obj *,interp));
 EXTERN int		Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN Tcl_AsyncHandler	Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
 			    ClientData clientData));
@@ -713,6 +987,8 @@ EXTERN int		Tcl_AsyncReady _ANSI_ARGS_((void));
 EXTERN void		Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN char		Tcl_Backslash _ANSI_ARGS_((char *src,
 			    int *readPtr));
+EXTERN int		Tcl_BadChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *optionName, char *optionList));
 EXTERN void		Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_InterpDeleteProc *proc,
 			    ClientData clientData));
@@ -725,15 +1001,24 @@ EXTERN int		Tcl_Close _ANSI_ARGS_((Tcl_Interp *interp,
         		    Tcl_Channel chan));
 EXTERN int		Tcl_CommandComplete _ANSI_ARGS_((char *cmd));
 EXTERN char *		Tcl_Concat _ANSI_ARGS_((int argc, char **argv));
+EXTERN Tcl_Obj *	Tcl_ConcatObj _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[]));
+EXTERN int		Tcl_ConvertCountedElement _ANSI_ARGS_((char *src,
+			    int length, char *dst, int flags));
 EXTERN int		Tcl_ConvertElement _ANSI_ARGS_((char *src,
 			    char *dst, int flags));
+EXTERN int		Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_ObjType *typePtr));
 EXTERN int		Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp *slave,
 			    char *slaveCmd, Tcl_Interp *target,
         		    char *targetCmd, int argc, char **argv));
+EXTERN int		Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp *slave,
+			    char *slaveCmd, Tcl_Interp *target,
+        		    char *targetCmd, int objc,
+		            Tcl_Obj *CONST objv[]));
 EXTERN Tcl_Channel	Tcl_CreateChannel _ANSI_ARGS_((
     			    Tcl_ChannelType *typePtr, char *chanName,
-                            Tcl_File inFile, Tcl_File outFile,
-                            ClientData instanceData));
+                            ClientData instanceData, int mask));
 EXTERN void		Tcl_CreateChannelHandler _ANSI_ARGS_((
 			    Tcl_Channel chan, int mask,
                             Tcl_ChannelProc *proc, ClientData clientData));
@@ -745,20 +1030,23 @@ EXTERN Tcl_Command	Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
 			    ClientData clientData,
 			    Tcl_CmdDeleteProc *deleteProc));
 EXTERN void		Tcl_CreateEventSource _ANSI_ARGS_((
-			    Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc
-			    *checkProc, ClientData clientData));
+			    Tcl_EventSetupProc *setupProc,
+			    Tcl_EventCheckProc *checkProc,
+			    ClientData clientData));
 EXTERN void		Tcl_CreateExitHandler _ANSI_ARGS_((Tcl_ExitProc *proc,
 			    ClientData clientData));
 EXTERN void		Tcl_CreateFileHandler _ANSI_ARGS_((
-    			    Tcl_File file, int mask, Tcl_FileProc *proc,
+    			    int fd, int mask, Tcl_FileProc *proc,
 			    ClientData clientData));
 EXTERN Tcl_Interp *	Tcl_CreateInterp _ANSI_ARGS_((void));
 EXTERN void		Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *name, int numArgs, Tcl_ValueType *argTypes,
 			    Tcl_MathProc *proc, ClientData clientData));
-EXTERN void		Tcl_CreateModalTimeout _ANSI_ARGS_((int milliseconds,
-			    Tcl_TimerProc *proc, ClientData clientData));
-EXTERN Tcl_Interp	*Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Command	Tcl_CreateObjCommand _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *cmdName,
+			    Tcl_ObjCmdProc *proc, ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc));
+EXTERN Tcl_Interp *	Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
 		            char *slaveName, int isSafe));
 EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
 			    Tcl_TimerProc *proc, ClientData clientData));
@@ -771,39 +1059,49 @@ EXTERN int		Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
 			    char *file, int line));
 EXTERN char *		Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
 			    unsigned int size, char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
+                            char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
+                            char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewListObj _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[], char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
+                            char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewObj _ANSI_ARGS_((char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewStringObj _ANSI_ARGS_((char *bytes,
+			    int length, char *file, int line));
 EXTERN void		Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp *interp,
                             char *name));
 EXTERN int		Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *cmdName));
+EXTERN int		Tcl_DeleteCommandFromToken _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Command command));
 EXTERN void		Tcl_DeleteChannelHandler _ANSI_ARGS_((
     			    Tcl_Channel chan, Tcl_ChannelProc *proc,
                             ClientData clientData));
 EXTERN void		Tcl_DeleteCloseHandler _ANSI_ARGS_((
 			    Tcl_Channel chan, Tcl_CloseProc *proc,
                             ClientData clientData));
+EXTERN void		Tcl_DeleteEvents _ANSI_ARGS_((
+			    Tcl_EventDeleteProc *proc,
+                            ClientData clientData));
 EXTERN void		Tcl_DeleteEventSource _ANSI_ARGS_((
 			    Tcl_EventSetupProc *setupProc,
 			    Tcl_EventCheckProc *checkProc,
 			    ClientData clientData));
-EXTERN void		Tcl_DeleteEvents _ANSI_ARGS_((
-			    Tcl_EventDeleteProc *proc,
-                            ClientData clientData));
 EXTERN void		Tcl_DeleteExitHandler _ANSI_ARGS_((Tcl_ExitProc *proc,
 			    ClientData clientData));
-EXTERN void		Tcl_DeleteFileHandler _ANSI_ARGS_((
-    			    Tcl_File file));
+EXTERN void		Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
 EXTERN void		Tcl_DeleteHashEntry _ANSI_ARGS_((
 			    Tcl_HashEntry *entryPtr));
 EXTERN void		Tcl_DeleteHashTable _ANSI_ARGS_((
 			    Tcl_HashTable *tablePtr));
 EXTERN void		Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void		Tcl_DeleteModalTimeout _ANSI_ARGS_((
-			    Tcl_TimerProc *proc, ClientData clientData));
 EXTERN void		Tcl_DeleteTimerHandler _ANSI_ARGS_((
 			    Tcl_TimerToken token));
 EXTERN void		Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Trace trace));
-EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids, int *pidPtr));
+EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids, Tcl_Pid *pidPtr));
 EXTERN void		Tcl_DontCallWhenDeleted _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
 			    ClientData clientData));
@@ -825,51 +1123,73 @@ EXTERN void		Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
 			    int length));
 EXTERN void		Tcl_DStringStartSublist _ANSI_ARGS_((
 			    Tcl_DString *dsPtr));
+EXTERN Tcl_Obj *	Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj *objPtr));
 EXTERN int		Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
 EXTERN char *		Tcl_ErrnoId _ANSI_ARGS_((void));
 EXTERN char *		Tcl_ErrnoMsg _ANSI_ARGS_((int err));
-EXTERN int		Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp, char *cmd));
+EXTERN int		Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
 EXTERN int		Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *fileName));
 EXTERN void		Tcl_EventuallyFree _ANSI_ARGS_((ClientData clientData,
 			    Tcl_FreeProc *freeProc));
+EXTERN int		Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
 EXTERN void		Tcl_Exit _ANSI_ARGS_((int status));
+EXTERN int		Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *hiddenCmdName, char *cmdName));
 EXTERN int		Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, int *ptr));
+EXTERN int		Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, int *ptr));
 EXTERN int		Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, double *ptr));
+EXTERN int		Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, double *ptr));
 EXTERN int		Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, long *ptr));
+EXTERN int		Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, long *ptr));
+EXTERN int		Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr));
 EXTERN int		Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string));
-EXTERN int		Tcl_FileReady _ANSI_ARGS_((Tcl_File file,
-			    int mask));
+EXTERN void		Tcl_Finalize _ANSI_ARGS_((void));
 EXTERN void		Tcl_FindExecutable _ANSI_ARGS_((char *argv0));
 EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry _ANSI_ARGS_((
 			    Tcl_HashTable *tablePtr,
 			    Tcl_HashSearch *searchPtr));
 EXTERN int		Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN void 		Tcl_FreeFile _ANSI_ARGS_((
-    			    Tcl_File file));
+EXTERN void		TclFreeObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN void		Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int		Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp *interp,
        			    char *slaveCmd, Tcl_Interp **targetInterpPtr,
                             char **targetCmdPtr, int *argcPtr,
 			    char ***argvPtr));
+EXTERN int		Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp *interp,
+       			    char *slaveCmd, Tcl_Interp **targetInterpPtr,
+                            char **targetCmdPtr, int *objcPtr,
+			    Tcl_Obj ***objv));
 EXTERN ClientData	Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
                             char *name, Tcl_InterpDeleteProc **procPtr));
 EXTERN int		Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, int *boolPtr));
+EXTERN int		Tcl_GetBooleanFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    int *boolPtr));
 EXTERN Tcl_Channel	Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp *interp,
 	        	    char *chanName, int *modePtr));
 EXTERN int		Tcl_GetChannelBufferSize _ANSI_ARGS_((
     			    Tcl_Channel chan));
-EXTERN Tcl_File		Tcl_GetChannelFile _ANSI_ARGS_((Tcl_Channel chan,
-	        	    int direction));
+EXTERN int		Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
+	        	    int direction, ClientData *handlePtr));
 EXTERN ClientData	Tcl_GetChannelInstanceData _ANSI_ARGS_((
     			    Tcl_Channel chan));
-EXTERN int		Tcl_GetChannelOption _ANSI_ARGS_((Tcl_Channel chan,
-		            char *optionName, Tcl_DString *dsPtr));
+EXTERN int		Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
 EXTERN char *		Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_GetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Channel chan, char *optionName,
+			    Tcl_DString *dsPtr));
 EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
 EXTERN int		Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *cmdName, Tcl_CmdInfo *infoPtr));
@@ -878,35 +1198,54 @@ EXTERN char *		Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp *interp,
 EXTERN char *		Tcl_GetCwd _ANSI_ARGS_((char *buf, int len));
 EXTERN int		Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, double *doublePtr));
+EXTERN int		Tcl_GetDoubleFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    double *doublePtr));
 EXTERN int		Tcl_GetErrno _ANSI_ARGS_((void));
-EXTERN Tcl_File		Tcl_GetFile _ANSI_ARGS_((ClientData fileData,
-			    int type));
-EXTERN ClientData	Tcl_GetFileInfo _ANSI_ARGS_((Tcl_File file,
-			    int *typePtr));
+EXTERN int		Tcl_GetErrorLine _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN char *		Tcl_GetHostName _ANSI_ARGS_((void));
+EXTERN int		Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, char **tablePtr, char *msg,
+			    int flags, int *indexPtr));
 EXTERN int		Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, int *intPtr));
 EXTERN int		Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp,
 			    Tcl_Interp *slaveInterp));
-EXTERN Tcl_Interp	*Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN ClientData	Tcl_GetNotifierData _ANSI_ARGS_((Tcl_File file,
-			    Tcl_FileFreeProc **freeProcPtr));
+EXTERN int		Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, int *intPtr));
+EXTERN int		Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, long *longPtr));
+EXTERN Tcl_Interp *	Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Obj *	Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_ObjType *	Tcl_GetObjType _ANSI_ARGS_((char *typeName));
 EXTERN int		Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, int write, int checkUsage,
 			    ClientData *filePtr));
+EXTERN Tcl_Command	Tcl_GetOriginalCommand _ANSI_ARGS_((
+			    Tcl_Command command));
 EXTERN Tcl_PathType	Tcl_GetPathType _ANSI_ARGS_((char *path));
 EXTERN int		Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
         		    Tcl_DString *dsPtr));
-EXTERN Tcl_Interp	*Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
+        		    Tcl_Obj *objPtr));
+EXTERN int		Tcl_GetServiceMode _ANSI_ARGS_((void));
+EXTERN Tcl_Interp *	Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *slaveName));
 EXTERN Tcl_Channel	Tcl_GetStdChannel _ANSI_ARGS_((int type));
+EXTERN char *		Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    int *lengthPtr));
+EXTERN char *		Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN char *		Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *varName, int flags));
 EXTERN char *		Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *part1, char *part2, int flags));
 EXTERN int		Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *command));
+EXTERN int		Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
 EXTERN char *		Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+EXTERN int		Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp *interp,
+		            char *cmdName, char *hiddenCmdName));
 EXTERN int		Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN void		Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
 			    int keyType));
@@ -915,20 +1254,47 @@ EXTERN int		Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
 EXTERN int		Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
 EXTERN int		Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int		Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_InvalidateStringRep _ANSI_ARGS_((
+			    Tcl_Obj *objPtr));
 EXTERN char *		Tcl_JoinPath _ANSI_ARGS_((int argc, char **argv,
 			    Tcl_DString *resultPtr));
 EXTERN int		Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *varName, char *addr, int type));
+EXTERN int		Tcl_ListObjAppendList _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *listPtr, 
+			    Tcl_Obj *elemListPtr));
+EXTERN int		Tcl_ListObjAppendElement _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Obj *objPtr));
+EXTERN int		Tcl_ListObjGetElements _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    int *objcPtr, Tcl_Obj ***objvPtr));
+EXTERN int		Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, int index, 
+			    Tcl_Obj **objPtrPtr));
+EXTERN int		Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, int *intPtr));
+EXTERN int		Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, int first, int count,
+			    int objc, Tcl_Obj *CONST objv[]));
 EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc));
-EXTERN Tcl_Channel	Tcl_MakeFileChannel _ANSI_ARGS_((ClientData inFile,
-		            ClientData outFile, int mode));
+EXTERN Tcl_Channel	Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
+			    int mode));
 EXTERN int		Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel _ANSI_ARGS_((
     			    ClientData tcpSocket));
 EXTERN char *		Tcl_Merge _ANSI_ARGS_((int argc, char **argv));
 EXTERN Tcl_HashEntry *	Tcl_NextHashEntry _ANSI_ARGS_((
 			    Tcl_HashSearch *searchPtr));
+EXTERN void		Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
+			    int mask));
+EXTERN Tcl_Obj *	Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    int flags));
+EXTERN Tcl_Obj *	Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    Tcl_Obj *newValuePtr, int flags));
 EXTERN Tcl_Channel	Tcl_OpenCommandChannel _ANSI_ARGS_((
     			    Tcl_Interp *interp, int argc, char **argv,
 			    int flags));
@@ -970,16 +1336,25 @@ EXTERN void		Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
 			    int index, char **startPtr, char **endPtr));
 EXTERN void		Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
 	        	    Tcl_Channel chan));
+EXTERN void		Tcl_RegisterObjType _ANSI_ARGS_((
+			    Tcl_ObjType *typePtr));
 EXTERN void		Tcl_Release _ANSI_ARGS_((ClientData clientData));
+EXTERN void		Tcl_RestartIdleTimer _ANSI_ARGS_((void));
 EXTERN void		Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
 #define Tcl_Return Tcl_SetResult
+EXTERN int		Tcl_ScanCountedElement _ANSI_ARGS_((char *string,
+			    int length, int *flagPtr));
 EXTERN int		Tcl_ScanElement _ANSI_ARGS_((char *string,
 			    int *flagPtr));
 EXTERN int		Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
         		    int offset, int mode));
+EXTERN int		Tcl_ServiceAll _ANSI_ARGS_((void));
+EXTERN int		Tcl_ServiceEvent _ANSI_ARGS_((int flags));
 EXTERN void		Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
                             char *name, Tcl_InterpDeleteProc *proc,
                             ClientData clientData));
+EXTERN void		Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    int boolValue));
 EXTERN void		Tcl_SetChannelBufferSize _ANSI_ARGS_((
 			    Tcl_Channel chan, int sz));
 EXTERN int		Tcl_SetChannelOption _ANSI_ARGS_((
@@ -987,20 +1362,36 @@ EXTERN int		Tcl_SetChannelOption _ANSI_ARGS_((
 	        	    char *optionName, char *newValue));
 EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *cmdName, Tcl_CmdInfo *infoPtr));
-EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int errno));
+EXTERN void		Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    double doubleValue));
+EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int err));
 EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_(
-    			    TCL_VARARGS(Tcl_Interp *,interp));
+    			    TCL_VARARGS(Tcl_Interp *,arg1));
+EXTERN void		Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    int intValue));
+EXTERN void		Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    int objc, Tcl_Obj *CONST objv[]));
+EXTERN void		Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    long longValue));
 EXTERN void		Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN void		Tcl_SetNotifierData _ANSI_ARGS_((Tcl_File file,
-			    Tcl_FileFreeProc *freeProcPtr, ClientData data));
+EXTERN void		Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *errorObjPtr));
+EXTERN void		Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    int length));
+EXTERN void		Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *resultObjPtr));
 EXTERN void		Tcl_SetPanicProc _ANSI_ARGS_((void (*proc)
 			    _ANSI_ARGS_(TCL_VARARGS(char *, format))));
 EXTERN int		Tcl_SetRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
 			    int depth));
 EXTERN void		Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, Tcl_FreeProc *freeProc));
+EXTERN int		Tcl_SetServiceMode _ANSI_ARGS_((int mode));
 EXTERN void		Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
 			    int type));
+EXTERN void		Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    char *bytes, int length));
+EXTERN void		Tcl_SetTimer _ANSI_ARGS_((Tcl_Time *timePtr));
 EXTERN char *		Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *varName, char *newValue, int flags));
 EXTERN char *		Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1009,6 +1400,7 @@ EXTERN char *		Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
 EXTERN char *		Tcl_SignalId _ANSI_ARGS_((int sig));
 EXTERN char *		Tcl_SignalMsg _ANSI_ARGS_((int sig));
 EXTERN void		Tcl_Sleep _ANSI_ARGS_((int ms));
+EXTERN void		Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int		Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *list, int *argcPtr, char ***argvPtr));
 EXTERN void		Tcl_SplitPath _ANSI_ARGS_((char *path,
@@ -1028,6 +1420,8 @@ EXTERN int		Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_VarTraceProc *proc, ClientData clientData));
 EXTERN char *		Tcl_TranslateFileName _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *name, Tcl_DString *bufferPtr));
+EXTERN int		Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, char *str,
+			    int len, int atHead));
 EXTERN void		Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *varName));
 EXTERN int		Tcl_UnregisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1061,11 +1455,12 @@ EXTERN ClientData	Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_VarTraceProc *procPtr,
 			    ClientData prevClientData));
 EXTERN int		Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN int		Tcl_WaitPid _ANSI_ARGS_((int pid, int *statPtr,
-                            int options));
-EXTERN void		Tcl_WatchFile _ANSI_ARGS_((Tcl_File file,
-			    int mask));
+EXTERN Tcl_Pid		Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int *statPtr, 
+			    int options));
 EXTERN int		Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
-        		    char *s, int slen));
+			    char *s, int slen));
+EXTERN void		Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[], char *message));
 
+#endif /* RESOURCE_INCLUDED */
 #endif /* _TCL */
diff --git a/contrib/tcl/generic/tclBasic.c b/contrib/tcl/generic/tclBasic.c
index 7f39f80..c043dd4 100644
--- a/contrib/tcl/generic/tclBasic.c
+++ b/contrib/tcl/generic/tclBasic.c
@@ -6,153 +6,233 @@
  *	and deletion, and command parsing and execution.
  *
  * Copyright (c) 1987-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclBasic.c 1.211 96/05/10 17:48:04
+ * SCCS: @(#) tclBasic.c 1.280 97/05/20 19:09:26
  */
 
 #include "tclInt.h"
+#include "tclCompile.h"
 #ifndef TCL_GENERIC_ONLY
 #   include "tclPort.h"
 #endif
-#include "patchlevel.h"
-
-/*
- * This variable indicates to the close procedures of channel drivers that
- * we are in the middle of an interpreter deletion, and hence in "implicit"
- * close mode. In that mode, the close procedures should not close the
- * OS handle for standard IO channels. Since interpreter deletion may be
- * recursive, this variable is actually a counter of the levels of nesting.
- */
-
-int tclInInterpreterDeletion = 0;
 
 /*
  * Static procedures in this file:
  */
 
 static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
+static void		HiddenCmdsDeleteProc _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp));
 
 /*
- * The following structure defines all of the commands in the Tcl core,
- * and the C procedures that execute them.
+ * The following structure defines the commands in the Tcl core.
  */
 
 typedef struct {
-    char *name;			/* Name of command. */
-    Tcl_CmdProc *proc;		/* Procedure that executes command. */
+    char *name;			/* Name of object-based command. */
+    Tcl_CmdProc *proc;		/* String-based procedure for command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based procedure for command. */
+    CompileProc *compileProc;	/* Procedure called to compile command. */
+    int isSafe;			/* If non-zero, command will be present
+                                 * in safe interpreter. Otherwise it will
+                                 * be hidden. */
 } CmdInfo;
 
 /*
- * Built-in commands, and the procedures associated with them:
+ * The built-in commands, and the procedures that implement them:
  */
 
 static CmdInfo builtInCmds[] = {
     /*
-     * Commands in the generic core:
-     */
-
-    {"append",		Tcl_AppendCmd},
-    {"array",		Tcl_ArrayCmd},
-    {"break",		Tcl_BreakCmd},
-    {"case",		Tcl_CaseCmd},
-    {"catch",		Tcl_CatchCmd},
-    {"clock",		Tcl_ClockCmd},
-    {"concat",		Tcl_ConcatCmd},
-    {"continue",	Tcl_ContinueCmd},
-    {"error",		Tcl_ErrorCmd},
-    {"eval",		Tcl_EvalCmd},
-    {"exit",		Tcl_ExitCmd},
-    {"expr",		Tcl_ExprCmd},
-    {"fileevent",	Tcl_FileEventCmd},
-    {"for",		Tcl_ForCmd},
-    {"foreach",		Tcl_ForeachCmd},
-    {"format",		Tcl_FormatCmd},
-    {"global",		Tcl_GlobalCmd},
-    {"history",		Tcl_HistoryCmd},
-    {"if",		Tcl_IfCmd},
-    {"incr",		Tcl_IncrCmd},
-    {"info",		Tcl_InfoCmd},
-    {"interp",		Tcl_InterpCmd},
-    {"join",		Tcl_JoinCmd},
-    {"lappend",		Tcl_LappendCmd},
-    {"lindex",		Tcl_LindexCmd},
-    {"linsert",		Tcl_LinsertCmd},
-    {"list",		Tcl_ListCmd},
-    {"llength",		Tcl_LlengthCmd},
-    {"load",		Tcl_LoadCmd},
-    {"lrange",		Tcl_LrangeCmd},
-    {"lreplace",	Tcl_LreplaceCmd},
-    {"lsearch",		Tcl_LsearchCmd},
-    {"lsort",		Tcl_LsortCmd},
-    {"package",		Tcl_PackageCmd},
-    {"proc",		Tcl_ProcCmd},
-    {"regexp",		Tcl_RegexpCmd},
-    {"regsub",		Tcl_RegsubCmd},
-    {"rename",		Tcl_RenameCmd},
-    {"return",		Tcl_ReturnCmd},
-    {"scan",		Tcl_ScanCmd},
-    {"set",		Tcl_SetCmd},
-    {"split",		Tcl_SplitCmd},
-    {"string",		Tcl_StringCmd},
-    {"subst",		Tcl_SubstCmd},
-    {"switch",		Tcl_SwitchCmd},
-    {"trace",		Tcl_TraceCmd},
-    {"unset",		Tcl_UnsetCmd},
-    {"uplevel",		Tcl_UplevelCmd},
-    {"upvar",		Tcl_UpvarCmd},
-    {"while",		Tcl_WhileCmd},
+     * Commands in the generic core. Note that at least one of the proc or
+     * objProc members should be non-NULL. This avoids infinitely recursive
+     * calls between TclInvokeObjectCommand and TclInvokeStringCommand if a
+     * command name is computed at runtime and results in the name of a
+     * compiled command.
+     */
+
+    {"append",		(Tcl_CmdProc *) NULL,	Tcl_AppendObjCmd,
+        (CompileProc *) NULL,		1},
+    {"array",		(Tcl_CmdProc *) NULL,	Tcl_ArrayObjCmd,
+        (CompileProc *) NULL,		1},
+    {"binary",		(Tcl_CmdProc *) NULL,	Tcl_BinaryObjCmd,
+        (CompileProc *) NULL,		1},
+    {"break",		Tcl_BreakCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileBreakCmd,		1},
+    {"case",		(Tcl_CmdProc *) NULL,	Tcl_CaseObjCmd,
+        (CompileProc *) NULL,		1},
+    {"catch",		(Tcl_CmdProc *) NULL,	Tcl_CatchObjCmd,	
+        TclCompileCatchCmd,		1},
+    {"clock",		(Tcl_CmdProc *) NULL,	Tcl_ClockObjCmd,
+        (CompileProc *) NULL,		1},
+    {"concat",		(Tcl_CmdProc *) NULL,	Tcl_ConcatObjCmd,
+        (CompileProc *) NULL,		1},
+    {"continue",	Tcl_ContinueCmd,	(Tcl_ObjCmdProc *) NULL,
+        TclCompileContinueCmd,		1},
+    {"error",		(Tcl_CmdProc *) NULL,	Tcl_ErrorObjCmd,
+        (CompileProc *) NULL,		1},
+    {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
+        (CompileProc *) NULL,		1},
+    {"exit",		(Tcl_CmdProc *) NULL,	Tcl_ExitObjCmd,
+        (CompileProc *) NULL,		0},
+    {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,
+        TclCompileExprCmd,		1},
+    {"fcopy",		(Tcl_CmdProc *) NULL,	Tcl_FcopyObjCmd,
+        (CompileProc *) NULL,		1},
+    {"fileevent",	Tcl_FileEventCmd,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"for",		Tcl_ForCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileForCmd,		1},
+    {"foreach",		(Tcl_CmdProc *) NULL,	Tcl_ForeachObjCmd,
+        TclCompileForeachCmd,		1},
+    {"format",		Tcl_FormatCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"global",		(Tcl_CmdProc *) NULL,	Tcl_GlobalObjCmd,
+        (CompileProc *) NULL,		1},
+    {"history",		Tcl_HistoryCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"if",		Tcl_IfCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileIfCmd,		1},
+    {"incr",		Tcl_IncrCmd,		(Tcl_ObjCmdProc *) NULL,
+        TclCompileIncrCmd,		1},
+    {"info",		(Tcl_CmdProc *) NULL,	Tcl_InfoObjCmd,
+        (CompileProc *) NULL,		1},
+    {"interp",		(Tcl_CmdProc *) NULL,	Tcl_InterpObjCmd,
+        (CompileProc *) NULL,		1},
+    {"join",		(Tcl_CmdProc *) NULL,	Tcl_JoinObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lappend",		(Tcl_CmdProc *) NULL,	Tcl_LappendObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lindex",		(Tcl_CmdProc *) NULL,	Tcl_LindexObjCmd,
+        (CompileProc *) NULL,		1},
+    {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
+        (CompileProc *) NULL,		1},
+    {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
+        (CompileProc *) NULL,		1},
+    {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,
+        (CompileProc *) NULL,		1},
+    {"load",		Tcl_LoadCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"lrange",		(Tcl_CmdProc *) NULL,	Tcl_LrangeObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lreplace",	(Tcl_CmdProc *) NULL,	Tcl_LreplaceObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lsearch",		(Tcl_CmdProc *) NULL,	Tcl_LsearchObjCmd,
+        (CompileProc *) NULL,		1},
+    {"lsort",		(Tcl_CmdProc *) NULL,	Tcl_LsortObjCmd,
+        (CompileProc *) NULL,		1},
+    {"namespace",	(Tcl_CmdProc *) NULL,	Tcl_NamespaceObjCmd,
+        (CompileProc *) NULL,		1},
+    {"package",		Tcl_PackageCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"proc",		(Tcl_CmdProc *) NULL,	Tcl_ProcObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"regexp",		Tcl_RegexpCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"regsub",		Tcl_RegsubCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"rename",		(Tcl_CmdProc *) NULL,	Tcl_RenameObjCmd,
+        (CompileProc *) NULL,		1},
+    {"return",		(Tcl_CmdProc *) NULL,	Tcl_ReturnObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"scan",		Tcl_ScanCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"set",		Tcl_SetCmd,		(Tcl_ObjCmdProc *) NULL,    
+        TclCompileSetCmd,		1},
+    {"split",		Tcl_SplitCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"string",		(Tcl_CmdProc *) NULL,	Tcl_StringObjCmd,
+        (CompileProc *) NULL,		1},
+    {"subst",		Tcl_SubstCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"switch",		(Tcl_CmdProc *) NULL,	Tcl_SwitchObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"trace",		Tcl_TraceCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"unset",		(Tcl_CmdProc *) NULL,	Tcl_UnsetObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"uplevel",		(Tcl_CmdProc *) NULL,	Tcl_UplevelObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"upvar",		(Tcl_CmdProc *) NULL,	Tcl_UpvarObjCmd,	
+        (CompileProc *) NULL,		1},
+    {"variable",	(Tcl_CmdProc *) NULL,	Tcl_VariableObjCmd,
+        (CompileProc *) NULL,		1},
+    {"while",		Tcl_WhileCmd,		(Tcl_ObjCmdProc *) NULL,    
+        TclCompileWhileCmd,		1},
 
     /*
      * Commands in the UNIX core:
      */
 
 #ifndef TCL_GENERIC_ONLY
-    {"after",		Tcl_AfterCmd},
-    {"cd",		Tcl_CdCmd},
-    {"close",		Tcl_CloseCmd},
-    {"eof",		Tcl_EofCmd},
-    {"fblocked",	Tcl_FblockedCmd},
-    {"fconfigure",	Tcl_FconfigureCmd},
-    {"file",		Tcl_FileCmd},
-    {"flush",		Tcl_FlushCmd},
-    {"gets",		Tcl_GetsCmd},
-    {"glob",		Tcl_GlobCmd},
-    {"open",		Tcl_OpenCmd},
-    {"pid",		Tcl_PidCmd},
-    {"puts",		Tcl_PutsCmd},
-    {"pwd",		Tcl_PwdCmd},
-    {"read",		Tcl_ReadCmd},
-    {"seek",		Tcl_SeekCmd},
-    {"socket",		Tcl_SocketCmd},
-    {"tell",		Tcl_TellCmd},
-    {"time",		Tcl_TimeCmd},
-    {"update",		Tcl_UpdateCmd},
-    {"vwait",		Tcl_VwaitCmd},
-    {"unsupported0",	TclUnsupported0Cmd},
-    
-#ifndef MAC_TCL
-    {"exec",		Tcl_ExecCmd},
-    {"source",		Tcl_SourceCmd},
-#endif
+    {"after",		Tcl_AfterCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"cd",		Tcl_CdCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"close",		Tcl_CloseCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"eof",		Tcl_EofCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"fblocked",	Tcl_FblockedCmd,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"fconfigure",	Tcl_FconfigureCmd,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"file",		(Tcl_CmdProc *) NULL,	Tcl_FileObjCmd,
+        (CompileProc *) NULL,		0},
+    {"flush",		(Tcl_CmdProc *) NULL,	Tcl_FlushObjCmd,
+        (CompileProc *) NULL,		1},
+    {"gets",		(Tcl_CmdProc *) NULL,	Tcl_GetsObjCmd,
+        (CompileProc *) NULL,		1},
+    {"glob",		Tcl_GlobCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"open",		Tcl_OpenCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"pid",		(Tcl_CmdProc *) NULL,	Tcl_PidObjCmd,
+        (CompileProc *) NULL,		1},
+    {"puts",		(Tcl_CmdProc *) NULL,	Tcl_PutsObjCmd,
+        (CompileProc *) NULL,		1},
+    {"pwd",		Tcl_PwdCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"read",		(Tcl_CmdProc *) NULL,	Tcl_ReadObjCmd,
+        (CompileProc *) NULL,		1},
+    {"seek",		Tcl_SeekCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"socket",		Tcl_SocketCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"tell",		Tcl_TellCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"time",		(Tcl_CmdProc *) NULL,	Tcl_TimeObjCmd,
+        (CompileProc *) NULL,		1},
+    {"update",		Tcl_UpdateCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		1},
+    {"vwait",		Tcl_VwaitCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
     
 #ifdef MAC_TCL
-    {"beep",		Tcl_MacBeepCmd},
-    {"cp",		Tcl_CpCmd},
-    {"echo",		Tcl_EchoCmd},
-    {"ls",		Tcl_LsCmd},
-    {"mkdir",		Tcl_MkdirCmd},
-    {"mv",		Tcl_MvCmd},
-    {"rm",		Tcl_RmCmd},
-    {"rmdir",		Tcl_RmdirCmd},
-    {"source",		Tcl_MacSourceCmd},
+    {"beep",		(Tcl_CmdProc *) NULL,	Tcl_BeepObjCmd,
+        (CompileProc *) NULL,		0},
+    {"echo",		Tcl_EchoCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"ls",		Tcl_LsCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"resource",	(Tcl_CmdProc *) NULL,	Tcl_ResourceObjCmd,
+        (CompileProc *) NULL,		1},
+    {"source",		(Tcl_CmdProc *) NULL,	Tcl_MacSourceObjCmd,
+        (CompileProc *) NULL,		0},
+#else
+    {"exec",		Tcl_ExecCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"source",		(Tcl_CmdProc *) NULL,	Tcl_SourceObjCmd,
+        (CompileProc *) NULL,		0},
 #endif /* MAC_TCL */
     
 #endif /* TCL_GENERIC_ONLY */
-    {NULL,		(Tcl_CmdProc *) NULL}
+    {NULL,		(Tcl_CmdProc *) NULL,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0}
 };
 
 /*
@@ -180,16 +260,36 @@ Tcl_CreateInterp()
     register Interp *iPtr;
     register Command *cmdPtr;
     register CmdInfo *cmdInfoPtr;
-    Tcl_Channel chan;
+    union {
+	char c[sizeof(short)];
+	short s;
+    } order;
     int i;
 
+    /*
+     * Panic if someone updated the CallFrame structure without
+     * also updating the Tcl_CallFrame structure (or vice versa).
+     */  
+
+    if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
+        panic("Tcl_CallFrame and CallFrame are not the same size");
+    }
+
+    /*
+     * Initialize support for namespaces and create the global namespace
+     * (whose name is ""; an alias is "::"). This also initializes the
+     * Tcl object type table and other object management code.
+     */
+
+    TclInitNamespaces();
+    
     iPtr = (Interp *) ckalloc(sizeof(Interp));
     iPtr->result = iPtr->resultSpace;
     iPtr->freeProc = 0;
+    iPtr->objResultPtr = Tcl_NewObj(); /* an empty object */
+    Tcl_IncrRefCount(iPtr->objResultPtr);
     iPtr->errorLine = 0;
-    Tcl_InitHashTable(&iPtr->commandTable, TCL_STRING_KEYS);
     Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
-    Tcl_InitHashTable(&iPtr->globalTable, TCL_STRING_KEYS);
     iPtr->numLevels = 0;
     iPtr->maxNestingDepth = 1000;
     iPtr->framePtr = NULL;
@@ -216,37 +316,85 @@ Tcl_CreateInterp()
     }
     Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
     iPtr->packageUnknown = NULL;
-    strcpy(iPtr->pdFormat, DEFAULT_PD_FORMAT);
-    iPtr->pdPrec = DEFAULT_PD_PREC;
     iPtr->cmdCount = 0;
-    iPtr->noEval = 0;
+    iPtr->termOffset = 0;
+    iPtr->compileEpoch = 0;
+    iPtr->compiledProcPtr = NULL;
     iPtr->evalFlags = 0;
     iPtr->scriptFile = NULL;
     iPtr->flags = 0;
     iPtr->tracePtr = NULL;
     iPtr->assocData = (Tcl_HashTable *) NULL;
+    iPtr->execEnvPtr = NULL;	      /* set after namespaces initialized */
+    iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
+    Tcl_IncrRefCount(iPtr->emptyObjPtr);
     iPtr->resultSpace[0] = 0;
 
+    iPtr->globalNsPtr = NULL;	/* force creation of global ns below */
+    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(
+	    (Tcl_Interp *) iPtr, "", (ClientData) NULL,
+	    (Tcl_NamespaceDeleteProc *) NULL);
+    if (iPtr->globalNsPtr == NULL) {
+        panic("Tcl_CreateInterp: can't create global namespace");
+    }
+
     /*
-     * Create the built-in commands.  Do it here, rather than calling
-     * Tcl_CreateCommand, because it's faster (there's no need to
-     * check for a pre-existing command by the same name).
+     * Initialize support for code compilation. Do this after initializing
+     * namespaces since TclCreateExecEnv will try to reference a Tcl
+     * variable (it links to the Tcl "tcl_traceExec" variable).
      */
+    
+    iPtr->execEnvPtr = TclCreateExecEnv((Tcl_Interp *) iPtr);
 
-    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
+    /*
+     * Create the core commands. Do it here, rather than calling
+     * Tcl_CreateCommand, because it's faster (there's no need to check for
+     * a pre-existing command by the same name). If a command has a
+     * Tcl_CmdProc but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
+     * TclInvokeStringCommand. This is an object-based wrapper procedure
+     * that extracts strings, calls the string procedure, and creates an
+     * object for the result. Similarly, if a command has a Tcl_ObjCmdProc
+     * but no Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
+     */
+
+    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL;
+	    cmdInfoPtr++) {
 	int new;
 	Tcl_HashEntry *hPtr;
 
-	hPtr = Tcl_CreateHashEntry(&iPtr->commandTable,
-		cmdInfoPtr->name, &new);
+	if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL)
+	        && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
+	        && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
+	    panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n");
+	}
+	
+	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
+	        cmdInfoPtr->name, &new);
 	if (new) {
 	    cmdPtr = (Command *) ckalloc(sizeof(Command));
 	    cmdPtr->hPtr = hPtr;
-	    cmdPtr->proc = cmdInfoPtr->proc;
-	    cmdPtr->clientData = (ClientData) NULL;
+	    cmdPtr->nsPtr = iPtr->globalNsPtr;
+	    cmdPtr->refCount = 1;
+	    cmdPtr->cmdEpoch = 0;
+	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
+	    if (cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) {
+		cmdPtr->proc = TclInvokeObjectCommand;
+		cmdPtr->clientData = (ClientData) cmdPtr;
+	    } else {
+		cmdPtr->proc = cmdInfoPtr->proc;
+		cmdPtr->clientData = (ClientData) NULL;
+	    }
+	    if (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
+		cmdPtr->objProc = TclInvokeStringCommand;
+		cmdPtr->objClientData = (ClientData) cmdPtr;
+	    } else {
+		cmdPtr->objProc = cmdInfoPtr->objProc;
+		cmdPtr->objClientData = (ClientData) NULL;
+	    }
 	    cmdPtr->deleteProc = NULL;
 	    cmdPtr->deleteData = (ClientData) NULL;
 	    cmdPtr->deleted = 0;
+	    cmdPtr->importRefPtr = NULL;
 	    Tcl_SetHashValue(hPtr, cmdPtr);
 	}
     }
@@ -270,37 +418,60 @@ Tcl_CreateInterp()
 	    TCL_GLOBAL_ONLY);
     Tcl_SetVar((Tcl_Interp *) iPtr, "tcl_version", TCL_VERSION,
 	    TCL_GLOBAL_ONLY);
-    Tcl_TraceVar2((Tcl_Interp *) iPtr, "tcl_precision", (char *) NULL,
-	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    TclPrecTraceProc, (ClientData) NULL);
 
     /*
-     * Register Tcl's version number.
+     * Compute the byte order of this machine.
      */
 
-    Tcl_PkgProvide((Tcl_Interp *) iPtr, "Tcl", TCL_VERSION);
+    order.s = 1;
+    Tcl_SetVar2((Tcl_Interp *) iPtr, "tcl_platform", "byteOrder",
+	    (order.c[0] == 1) ? "litteEndian" : "bigEndian",
+	    TCL_GLOBAL_ONLY);
 
     /*
-     * Add the standard channels.
+     * Register Tcl's version number.
      */
 
-    chan = Tcl_GetStdChannel(TCL_STDIN);
-    if (chan != (Tcl_Channel) NULL) {
-        Tcl_RegisterChannel((Tcl_Interp *) iPtr, chan);
-    }
-    chan = Tcl_GetStdChannel(TCL_STDOUT);
-    if (chan != (Tcl_Channel) NULL) {
-        Tcl_RegisterChannel((Tcl_Interp *) iPtr, chan);
-    }
-    chan = Tcl_GetStdChannel(TCL_STDERR);
-    if (chan != (Tcl_Channel) NULL) {
-        Tcl_RegisterChannel((Tcl_Interp *) iPtr, chan);
-    }
+    Tcl_PkgProvide((Tcl_Interp *) iPtr, "Tcl", TCL_VERSION);
     
     return (Tcl_Interp *) iPtr;
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclHideUnsafeCommands --
+ *
+ *	Hides base commands that are not marked as safe from this
+ *	interpreter.
+ *
+ * Results:
+ *	TCL_OK if it succeeds, TCL_ERROR else.
+ *
+ * Side effects:
+ *	Hides functionality in an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclHideUnsafeCommands(interp)
+    Tcl_Interp *interp;		/* Hide commands in this interpreter. */
+{
+    register CmdInfo *cmdInfoPtr;
+
+    if (interp == (Tcl_Interp *) NULL) {
+        return TCL_ERROR;
+    }
+    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
+        if (!cmdInfoPtr->isSafe) {
+            Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
+        }
+    }
+    return TCL_OK;
+}
+
+/*
  *--------------------------------------------------------------
  *
  * Tcl_CallWhenDeleted --
@@ -558,9 +729,9 @@ DeleteInterpProc(interp)
     Interp *iPtr = (Interp *) interp;
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    int i;
     Tcl_HashTable *hTablePtr;
     AssocData *dPtr;
+    int i;
 
     /*
      * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
@@ -580,38 +751,27 @@ DeleteInterpProc(interp)
     }
 
     /*
-     * Increment the interp deletion counter, so that close procedures
-     * for channel drivers can notice that we are in "implicit" close mode.
+     * Dismantle everything in the global namespace except for the
+     * "errorInfo" and "errorCode" variables. These remain until the
+     * namespace is actually destroyed, in case any errors occur.
+     *   
+     * Dismantle the namespace here, before we clear the assocData. If any
+     * background errors occur here, they will be deleted below.
      */
-
-    tclInInterpreterDeletion++;
     
+    TclTeardownNamespace(iPtr->globalNsPtr);
+
     /*
-     * First delete all the commands.  There's a special hack here
-     * because "tkerror" is just a synonym for "bgerror" (they share
-     * a Command structure).  Just delete the hash table entry for
-     * "tkerror" without invoking its callback or cleaning up its
-     * Command structure.
+     * Tear down the math function table.
      */
 
-    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, "tkerror");
-    if (hPtr != NULL) {
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
-	     hPtr != NULL;
-             hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search)) {
-        Tcl_DeleteCommand(interp,
-                Tcl_GetHashKey(&iPtr->commandTable, hPtr));
-    }
-    Tcl_DeleteHashTable(&iPtr->commandTable);
     for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
 	     hPtr != NULL;
              hPtr = Tcl_NextHashEntry(&search)) {
 	ckfree((char *) Tcl_GetHashValue(hPtr));
     }
     Tcl_DeleteHashTable(&iPtr->mathFuncTable);
-    
+
     /*
      * Invoke deletion callbacks; note that a callback can create new
      * callbacks, so we iterate.
@@ -635,10 +795,10 @@ DeleteInterpProc(interp)
     }
 
     /*
-     * Delete all global variables:
+     * Finish deleting the global namespace.
      */
     
-    TclDeleteVars(iPtr, &iPtr->globalTable);
+    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
 
     /*
      * Free up the result *after* deleting variables, since variable
@@ -648,7 +808,8 @@ DeleteInterpProc(interp)
 
     Tcl_FreeResult(interp);
     interp->result = NULL;
-
+    Tcl_DecrRefCount(iPtr->objResultPtr);
+    iPtr->objResultPtr = NULL;
     if (iPtr->errorInfo != NULL) {
 	ckfree(iPtr->errorInfo);
         iPtr->errorInfo = NULL;
@@ -658,8 +819,6 @@ DeleteInterpProc(interp)
         iPtr->errorCode = NULL;
     }
     if (iPtr->events != NULL) {
-	int i;
-
 	for (i = 0; i < iPtr->numEvents; i++) {
 	    ckfree(iPtr->events[i].command);
 	}
@@ -692,15 +851,11 @@ DeleteInterpProc(interp)
 	ckfree((char *) iPtr->tracePtr);
 	iPtr->tracePtr = nextPtr;
     }
-
-    /*
-     * Finally decrement the nested interpreter deletion counter.
-     */
-    
-    tclInInterpreterDeletion--;
-    if (tclInInterpreterDeletion < 0) {
-        tclInInterpreterDeletion = 0;
+    if (iPtr->execEnvPtr != NULL) {
+	TclDeleteExecEnv(iPtr->execEnvPtr);
     }
+    Tcl_DecrRefCount(iPtr->emptyObjPtr);
+    iPtr->emptyObjPtr = NULL;
     
     ckfree((char *) iPtr);
 }
@@ -784,41 +939,488 @@ Tcl_DeleteInterp(interp)
 /*
  *----------------------------------------------------------------------
  *
+ * HiddenCmdsDeleteProc --
+ *
+ *	Called on interpreter deletion to delete all the hidden
+ *	commands in an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees up memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+HiddenCmdsDeleteProc(clientData, interp)
+    ClientData clientData;		/* The hidden commands hash table. */
+    Tcl_Interp *interp;			/* The interpreter being deleted. */
+{
+    Tcl_HashTable *hiddenCmdTblPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+    Command *cmdPtr;
+
+    hiddenCmdTblPtr = (Tcl_HashTable *) clientData;
+    hPtr = Tcl_FindHashEntry(hiddenCmdTblPtr, "tkerror");
+    if (hPtr != NULL) {
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    for (hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch);
+	     hPtr != NULL;
+             hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch)) {
+
+        /*
+         * Cannot use Tcl_DeleteCommand because (a) the command is not
+         * in the command hash table, and (b) that table has already been
+         * deleted above. Hence we emulate what it does, below.
+         */
+        
+        cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+	/*
+         * The code here is tricky.  We can't delete the hash table entry
+         * before invoking the deletion callback because there are cases
+         * where the deletion callback needs to invoke the command (e.g.
+         * object systems such as OTcl).  However, this means that the
+         * callback could try to delete or rename the command.  The deleted
+         * flag allows us to detect these cases and skip nested deletes.
+         */
+
+        if (cmdPtr->deleted) {
+
+	    /*
+             * Another deletion is already in progress.  Remove the hash
+             * table entry now, but don't invoke a callback or free the
+             * command structure.
+             */
+
+            Tcl_DeleteHashEntry(cmdPtr->hPtr);
+            cmdPtr->hPtr = NULL;
+            continue;
+        }
+        cmdPtr->deleted = 1;
+        if (cmdPtr->deleteProc != NULL) {
+            (*cmdPtr->deleteProc)(cmdPtr->deleteData);
+        }
+
+	/*
+	 * Bump the command epoch counter. This will invalidate all cached
+         * references that refer to this command.
+	 */
+	
+        cmdPtr->cmdEpoch++;
+
+	/*
+         * Don't use hPtr to delete the hash entry here, because it's
+         * possible that the deletion callback renamed the command.
+         * Instead, use cmdPtr->hptr, and make sure that no-one else
+         * has already deleted the hash entry.
+         */
+
+        if (cmdPtr->hPtr != NULL) {
+            Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        }
+        ckfree((char *) cmdPtr);
+    }
+    Tcl_DeleteHashTable(hiddenCmdTblPtr);
+    ckfree((char *) hiddenCmdTblPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_HideCommand --
+ *
+ *	Makes a command hidden so that it cannot be invoked from within
+ *	an interpreter, only from within an ancestor.
+ *
+ * Results:
+ *	A standard Tcl result; also leaves a message in interp->result
+ *	if an error occurs.
+ *
+ * Side effects:
+ *	Moves a command from the command table to the hidden command
+ *	table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_HideCommand(interp, cmdName, hiddenCmdName)
+    Tcl_Interp *interp;		/* Interpreter in which to hide command. */
+    char *cmdName;		/* Name of hidden command. */
+    char *hiddenCmdName;	/* Name of to-be-hidden command. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    Tcl_HashTable *hTblPtr;
+    Tcl_HashEntry *hPtr, *tkErrorHPtr;
+    int isBgerror, new;
+
+    if (iPtr->flags & DELETED) {
+
+        /*
+         * The interpreter is being deleted. Do not create any new
+         * structures, because it is not safe to modify the interpreter.
+         */
+        
+        return TCL_ERROR;
+    }
+
+    if (strstr(hiddenCmdName, "::") != NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "hidden command names can't have namespace qualifiers",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the command to hide. An error is returned if cmdName can't
+     * be found.
+     */
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+	    /*flags*/ TCL_LEAVE_ERR_MSG);
+    if (cmd == (Tcl_Command) NULL) {
+	return TCL_ERROR;
+    }
+    cmdPtr = (Command *) cmd;
+
+    /*
+     * If this command is the "bgerror" command in the global namespace,
+     * make note of it now. We'll need to know this later so that we can
+     * handle its "tkerror" twin below.
+     */
+    
+    isBgerror = 0;
+    if (cmdPtr->hPtr != NULL) {
+        char *tail = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+        if ((*tail == 'b') && (strcmp(tail, "bgerror") == 0)
+	        && (cmdPtr->nsPtr == iPtr->globalNsPtr)) {
+            isBgerror = 1;
+        }
+    }
+    
+    /*
+     * Initialize the hidden command table if necessary.
+     */
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
+            NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        hTblPtr = (Tcl_HashTable *)
+	        ckalloc((unsigned) sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
+        Tcl_SetAssocData(interp, "tclHiddenCmds", HiddenCmdsDeleteProc,
+                (ClientData) hTblPtr);
+    }
+
+    /*
+     * It is an error to move an exposed command to a hidden command with
+     * hiddenCmdName if a hidden command with the name hiddenCmdName already
+     * exists.
+     */
+    
+    hPtr = Tcl_CreateHashEntry(hTblPtr, hiddenCmdName, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "hidden command named \"", hiddenCmdName, "\" already exists",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Remove the hash entry for the command from the interpreter command
+     * table. This is like deleting the command, so bump its command epoch;
+     * this invalidates any cached references that point to the command.
+     */
+
+    if (cmdPtr->hPtr != NULL) {
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
+	cmdPtr->cmdEpoch++;
+    }
+
+    /*
+     * If we are creating a hidden command named "bgerror", share the
+     * command data structure with another command named "tkerror". This
+     * code should eventually be removed.
+     */
+
+    if (isBgerror) {
+        tkErrorHPtr = Tcl_CreateHashEntry(hTblPtr, "tkerror", &new);
+        if (!new) {
+            panic("Tcl_HideCommand: hiding bgerror while tkerror is already hidden!");
+        }
+        Tcl_SetHashValue(tkErrorHPtr, (ClientData) cmdPtr);
+        tkErrorHPtr = Tcl_FindHashEntry(&(iPtr->globalNsPtr->cmdTable),
+                "tkerror");
+        if (tkErrorHPtr != (Tcl_HashEntry *) NULL) {
+            Tcl_DeleteHashEntry(tkErrorHPtr);
+        }
+    }
+
+    /*
+     * Now link the hash table entry with the command structure. Keep the
+     * containing namespace the same. After all, the command really
+     * "belongs" to that namespace.
+     */
+    
+    cmdPtr->hPtr = hPtr;
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+
+    /*
+     * If the command being hidden has a compile procedure, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled with
+     * command-specific (i.e., inline) bytecodes for the now-hidden
+     * command. This field is checked in Tcl_EvalObj and ObjInterpProc,
+     * and code whose compilation epoch doesn't match is recompiled.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+	iPtr->compileEpoch++;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ExposeCommand --
+ *
+ *	Makes a previously hidden command callable from inside the
+ *	interpreter instead of only by its ancestors.
+ *
+ * Results:
+ *	A standard Tcl result. If an error occurs, a message is left
+ *	in interp->result.
+ *
+ * Side effects:
+ *	Moves commands from one hash table to another.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ExposeCommand(interp, hiddenCmdName, cmdName)
+    Tcl_Interp *interp;		/* Interpreter in which to make command
+                                 * callable. */
+    char *hiddenCmdName;	/* Name of hidden command. */
+    char *cmdName;		/* Name of to-be-exposed command. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Command *cmdPtr;
+    Namespace *nsPtr, *dummy1, *dummy2;
+    Tcl_HashEntry *hPtr, *tkErrorHPtr;
+    Tcl_HashTable *hTblPtr;
+    char *tail;
+    int new, result;
+
+    if (iPtr->flags & DELETED) {
+        /*
+         * The interpreter is being deleted. Do not create any new
+         * structures, because it is not safe to modify the interpreter.
+         */
+        
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the hash table for the hidden commands; error out if there
+     * is none.
+     */
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
+            NULL);
+    if (hTblPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown hidden command \"", hiddenCmdName,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+        
+    /*
+     * Get the command from the hidden command table:
+     */
+
+    hPtr = Tcl_FindHashEntry(hTblPtr, hiddenCmdName);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown hidden command \"", hiddenCmdName,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * Normally, the command will go right back into its containing
+     * namespace. But if the exposed command name has "::" namespace
+     * qualifiers, it is being moved to another context.
+     */
+    
+    if (strstr(cmdName, "::") != NULL) {
+	result = TclGetNamespaceForQualName(interp, cmdName,
+		iPtr->globalNsPtr,
+		(CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+                &nsPtr, &dummy1, &dummy2, &tail);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if ((nsPtr == NULL) || (tail == NULL)) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "bad command name \"", cmdName, "\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else {
+        nsPtr = cmdPtr->nsPtr;
+        tail = cmdName;
+    }
+
+    /*
+     * It is an error to overwrite an existing exposed command as a result
+     * of exposing a previously hidden command.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "exposed command \"", cmdName,
+                "\" already exists", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Remove the hash entry for the command from the interpreter hidden
+     * command table.
+     */
+
+    if (cmdPtr->hPtr != NULL) {
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        cmdPtr->hPtr = NULL;
+    }
+
+    /*
+     * If we are creating a command named "bgerror", share the command
+     * data structure with another command named "tkerror". This code
+     * should eventually be removed.
+     */
+
+    if ((*tail == 'b') && (strcmp(tail, "bgerror") == 0)
+	    && (nsPtr == iPtr->globalNsPtr)) {
+        tkErrorHPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
+                "tkerror", &new);
+        if (!new) {
+            panic("Tcl_ExposeCommand: exposing bgerror while tkerror is already exposed!");
+        }
+        Tcl_SetHashValue(tkErrorHPtr, (ClientData) cmdPtr);
+        tkErrorHPtr = Tcl_FindHashEntry(hTblPtr, "tkerror");
+        if (tkErrorHPtr != NULL) {
+            Tcl_DeleteHashEntry(tkErrorHPtr);
+        }
+    }
+
+    /*
+     * Now link the hash table entry with the command structure.
+     * This is like creating a new command, so deal with any shadowing
+     * of commands in the global namespace.
+     */
+    
+    cmdPtr->hPtr = hPtr;
+    cmdPtr->nsPtr = nsPtr;
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    TclResetShadowedCmdRefs(interp, cmdPtr);
+
+    /*
+     * If the command being exposed has a compile procedure, increment
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled
+     * assuming the command is hidden. This field is checked in Tcl_EvalObj
+     * and ObjInterpProc, and code whose compilation epoch doesn't match is
+     * recompiled.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+	iPtr->compileEpoch++;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_CreateCommand --
  *
  *	Define a new command in a command table.
  *
  * Results:
  *	The return value is a token for the command, which can
- *	be used in future calls to Tcl_NameOfCommand.
+ *	be used in future calls to Tcl_GetCommandName.
  *
  * Side effects:
- *	If a command named cmdName already exists for interp, it is
- *	deleted.  In the future, when cmdName is seen as the name of
- *	a command by Tcl_Eval, proc will be called.  When the command
- *	is deleted from the table, deleteProc will be called.  See the
- *	manual entry for details on the calling sequence.
+ *	If a command named cmdName already exists for interp, it is deleted.
+ *	In the future, when cmdName is seen as the name of a command by
+ *	Tcl_Eval, proc will be called. To support the bytecode interpreter,
+ *	the command is created with a wrapper Tcl_ObjCmdProc
+ *	(TclInvokeStringCommand) that eventially calls proc. When the
+ *	command is deleted from the table, deleteProc will be called.
+ *	See the manual entry for details on the calling sequence.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
 Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
-    Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by a previous call to Tcl_CreateInterp). */
-    char *cmdName;		/* Name of command. */
-    Tcl_CmdProc *proc;		/* Command procedure to associate with
-				 * cmdName. */
-    ClientData clientData;	/* Arbitrary one-word value to pass to proc. */
+    Tcl_Interp *interp;		/* Token for command interpreter returned by
+				 * a previous call to Tcl_CreateInterp. */
+    char *cmdName;		/* Name of command. If it contains namespace
+				 * qualifiers, the new command is put in the
+				 * specified namespace; otherwise it is put
+				 * in the global namespace. */
+    Tcl_CmdProc *proc;		/* Procedure to associate with cmdName. */
+    ClientData clientData;	/* Arbitrary value passed to string proc. */
     Tcl_CmdDeleteProc *deleteProc;
-				/* If not NULL, gives a procedure to call when
-				 * this command is deleted. */
+				/* If not NULL, gives a procedure to call
+				 * when this command is deleted. */
 {
     Interp *iPtr = (Interp *) interp;
+    Namespace *nsPtr, *dummy1, *dummy2;
     Command *cmdPtr;
     Tcl_HashEntry *hPtr;
-    int new;
+    char *tail;
+    int new, result;
+
+    if (iPtr->flags & DELETED) {
+	/*
+	 * The interpreter is being deleted.  Don't create any new
+	 * commands; it's not safe to muck with the interpreter anymore.
+	 */
+
+	return (Tcl_Command) NULL;
+    }
+
+    /*
+     * Determine where the command should reside. If its name contains 
+     * namespace qualifiers, we put it in the specified namespace; 
+     * otherwise, we always put it in the global namespace.
+     */
 
+    if (strstr(cmdName, "::") != NULL) {
+	result = TclGetNamespaceForQualName(interp, cmdName, 
+                (Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr, 
+                &dummy1, &dummy2, &tail);
+	if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
+	    return (Tcl_Command) NULL;
+	}
+    } else {
+	nsPtr = iPtr->globalNsPtr;
+	tail = cmdName;
+    }
+    
     /*
      * The code below was added in 11/95 to preserve backwards compatibility
      * when "tkerror" was renamed "bgerror":  if anyone attempts to define
@@ -826,12 +1428,126 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
      * code should eventually be removed.
      */
 
-    if ((cmdName[0] == 't') && (strcmp(cmdName, "tkerror") == 0)) {
-	cmdName = "bgerror";
+    if ((*tail == 't') && (strcmp(tail, "tkerror") == 0)
+	    && (nsPtr == iPtr->globalNsPtr)) {
+	tail = "bgerror";
     }
 
-    if (iPtr->flags & DELETED) {
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+	/*
+	 * Command already exists. Delete the old one.
+	 */
+
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+	if (!new) {
+	    /*
+	     * If the deletion callback recreated the command, just throw
+             * away the new command (if we try to delete it again, we
+             * could get stuck in an infinite loop).
+	     */
+
+	     ckfree((char*) cmdPtr);
+	}
+    }
+    cmdPtr = (Command *) ckalloc(sizeof(Command));
+    Tcl_SetHashValue(hPtr, cmdPtr);
+    cmdPtr->hPtr = hPtr;
+    cmdPtr->nsPtr = nsPtr;
+    cmdPtr->refCount = 1;
+    cmdPtr->cmdEpoch = 0;
+    cmdPtr->compileProc = (CompileProc *) NULL;
+    cmdPtr->objProc = TclInvokeStringCommand;
+    cmdPtr->objClientData = (ClientData) cmdPtr;
+    cmdPtr->proc = proc;
+    cmdPtr->clientData = clientData;
+    cmdPtr->deleteProc = deleteProc;
+    cmdPtr->deleteData = clientData;
+    cmdPtr->deleted = 0;
+    cmdPtr->importRefPtr = NULL;
 
+    /*
+     * The code below provides more backwards compatibility for the
+     * renaming of "tkerror" to "bgerror". Like the code above, this
+     * code should eventually become unnecessary.
+     */
+
+    if ((*tail == 'b') && (strcmp(tail, "bgerror") == 0)
+	    && (nsPtr == iPtr->globalNsPtr)) {
+	/*
+	 * We're currently creating the "bgerror" command; create
+	 * a "tkerror" command that shares the same Command structure.
+	 */
+
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, "tkerror", &new);
+	Tcl_SetHashValue(hPtr, cmdPtr);
+    }
+
+    /*
+     * We just created a command, so in its namespace and all of its parent
+     * namespaces, it may shadow global commands with the same name. If any
+     * shadowed commands are found, invalidate all cached command references
+     * in the affected namespaces.
+     */
+    
+    TclResetShadowedCmdRefs(interp, cmdPtr);
+    return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateObjCommand --
+ *
+ *	Define a new object-based command in a command table.
+ *
+ * Results:
+ *	The return value is a token for the command, which can
+ *	be used in future calls to Tcl_NameOfCommand.
+ *
+ * Side effects:
+ *	If no command named "cmdName" already exists for interp, one is
+ *	created. Otherwise, if a command does exist, then if the
+ *	object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume
+ *	Tcl_CreateCommand was called previously for the same command and
+ *	just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we
+ *	delete the old command.
+ *
+ *	In the future, during bytecode evaluation when "cmdName" is seen as
+ *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
+ *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
+ *	the table, deleteProc will be called. See the manual entry for
+ *	details on the calling sequence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by previous call to Tcl_CreateInterp). */
+    char *cmdName;		/* Name of command. If it contains namespace
+				 * qualifiers, the new command is put in the
+				 * specified namespace; otherwise it is put
+				 * in the global namespace. */
+    Tcl_ObjCmdProc *proc;	/* Object-based procedure to associate with
+				 * name. */
+    ClientData clientData;	/* Arbitrary value to pass to object
+    				 * procedure. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* If not NULL, gives a procedure to call
+				 * when this command is deleted. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Namespace *nsPtr, *dummy1, *dummy2;
+    Command *cmdPtr;
+    Tcl_HashEntry *hPtr;
+    char *tail;
+    int new, result;
+
+    if (iPtr->flags & DELETED) {
 	/*
 	 * The interpreter is being deleted.  Don't create any new
 	 * commands;  it's not safe to muck with the interpreter anymore.
@@ -839,46 +1555,98 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
 
 	return (Tcl_Command) NULL;
     }
-    hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, cmdName, &new);
+
+    /*
+     * Determine where the command should reside. If its name contains 
+     * namespace qualifiers, we put it in the specified namespace; 
+     * otherwise, we always put it in the global namespace.
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+	result = TclGetNamespaceForQualName(interp, cmdName, 
+                (Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr, 
+                &dummy1, &dummy2, &tail);
+	if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
+	    return (Tcl_Command) NULL;
+	}
+    } else {
+	nsPtr = iPtr->globalNsPtr;
+	tail = cmdName;
+    }
+
+    /*
+     * The code below was added in 11/95 to preserve backwards compatibility
+     * when "tkerror" was renamed "bgerror":  if anyone attempts to define
+     * "tkerror" as a command, it is actually created as "bgerror".  This
+     * code should eventually be removed.
+     */
+
+    if ((*tail == 't') && (strcmp(tail, "tkerror") == 0)
+	    && (nsPtr == iPtr->globalNsPtr)) {
+	tail = "bgerror";
+    }
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
     if (!new) {
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
 	/*
-	 * Command already exists:  delete the old one.
+	 * Command already exists. If its object-based Tcl_ObjCmdProc is
+	 * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
+	 * argument "proc". Otherwise, we delete the old command. 
 	 */
 
-	Tcl_DeleteCommand(interp, Tcl_GetHashKey(&iPtr->commandTable, hPtr));
-	hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, cmdName, &new);
+	if (cmdPtr->objProc == TclInvokeStringCommand) {
+	    cmdPtr->objProc = proc;
+	    cmdPtr->objClientData = clientData;
+            cmdPtr->deleteProc = deleteProc;
+            cmdPtr->deleteData = clientData;
+	    goto checkForBgerror;
+	}
+
+	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
 	if (!new) {
 	    /*
-	     * Drat.  The stupid deletion callback recreated the command.
-	     * Just throw away the new command (if we try to delete it again,
-	     * we could get stuck in an infinite loop).
+	     * If the deletion callback recreated the command, just throw
+	     * away the new command (if we try to delete it again, we
+	     * could get stuck in an infinite loop).
 	     */
 
-	     ckfree((char  *) Tcl_GetHashValue(hPtr));
-	 }
+	     ckfree((char *) Tcl_GetHashValue(hPtr));
+	}
     }
     cmdPtr = (Command *) ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
-    cmdPtr->proc = proc;
-    cmdPtr->clientData = clientData;
+    cmdPtr->nsPtr = nsPtr;
+    cmdPtr->refCount = 1;
+    cmdPtr->cmdEpoch = 0;
+    cmdPtr->compileProc = (CompileProc *) NULL;
+    cmdPtr->objProc = proc;
+    cmdPtr->objClientData = clientData;
+    cmdPtr->proc = TclInvokeObjectCommand;
+    cmdPtr->clientData = (ClientData) cmdPtr;
     cmdPtr->deleteProc = deleteProc;
     cmdPtr->deleteData = clientData;
     cmdPtr->deleted = 0;
-
+    cmdPtr->importRefPtr = NULL;
+    
     /*
      * The code below provides more backwards compatibility for the
      * renaming of "tkerror" to "bgerror".  Like the code above, this
      * code should eventually become unnecessary.
      */
 
-    if ((cmdName[0] == 'b') && (strcmp(cmdName, "bgerror") == 0)) {
+    checkForBgerror:
+    if ((*tail == 'b') && (strcmp(tail, "bgerror") == 0)
+	    && (nsPtr == iPtr->globalNsPtr)) {
 	/*
-	 * We're currently creating the "bgerror" command;  create
+	 * We're currently creating the "bgerror" command; create
 	 * a "tkerror" command that shares the same Command structure.
 	 */
 
-	hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, "tkerror", &new);
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, "tkerror", &new);
 	Tcl_SetHashValue(hPtr, cmdPtr);
     }
     return (Tcl_Command) cmdPtr;
@@ -887,15 +1655,378 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
 /*
  *----------------------------------------------------------------------
  *
+ * TclInvokeStringCommand --
+ *
+ *	"Wrapper" Tcl_ObjCmdProc used to call an existing string-based
+ *	Tcl_CmdProc if no object-based procedure exists for a command. A
+ *	pointer to this procedure is stored as the Tcl_ObjCmdProc in a
+ *	Command structure. It simply turns around and calls the string
+ *	Tcl_CmdProc in the Command structure.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	Besides those side effects of the called Tcl_CmdProc,
+ *	TclInvokeStringCommand allocates and frees storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvokeStringCommand(clientData, interp, objc, objv)
+    ClientData clientData;	/* Points to command's Command structure. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    register int objc;		/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Command *cmdPtr = (Command *) clientData;
+    register int i;
+    int result;
+
+    /*
+     * This procedure generates an argv array for the string arguments. It
+     * starts out with stack-allocated space but uses dynamically-allocated
+     * storage if needed.
+     */
+
+#define NUM_ARGS 20
+    char *(argStorage[NUM_ARGS]);
+    char **argv = argStorage;
+
+    /*
+     * Create the string argument array "argv". Make sure argv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-argv word.
+     * THIS FAILS IF ANY ARGUMENT OBJECT CONTAINS AN EMBEDDED NULL.
+     */
+
+    if ((objc + 1) > NUM_ARGS) {
+	argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+    }
+
+    for (i = 0;  i < objc;  i++) {
+	argv[i] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+    }
+    argv[objc] = 0;
+
+    /*
+     * Invoke the command's string-based Tcl_CmdProc.
+     */
+
+    result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
+
+    /*
+     * Free the argv array if malloc'ed storage was used.
+     */
+
+    if (argv != argStorage) {
+	ckfree((char *) argv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvokeObjectCommand --
+ *
+ *	"Wrapper" Tcl_CmdProc used to call an existing object-based
+ *	Tcl_ObjCmdProc if no string-based procedure exists for a command.
+ *	A pointer to this procedure is stored as the Tcl_CmdProc in a
+ *	Command structure. It simply turns around and calls the object
+ *	Tcl_ObjCmdProc in the Command structure.
+ *
+ * Results:
+ *	A standard Tcl string result value.
+ *
+ * Side effects:
+ *	Besides those side effects of the called Tcl_CmdProc,
+ *	TclInvokeStringCommand allocates and frees storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvokeObjectCommand(clientData, interp, argc, argv)
+    ClientData clientData;	/* Points to command's Command structure. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int argc;			/* Number of arguments. */
+    register char **argv;	/* Argument strings. */
+{
+    Command *cmdPtr = (Command *) clientData;
+    register Tcl_Obj *objPtr;
+    register int i;
+    int length, result;
+
+    /*
+     * This procedure generates an objv array for object arguments that hold
+     * the argv strings. It starts out with stack-allocated space but uses
+     * dynamically-allocated storage if needed.
+     */
+
+#define NUM_ARGS 20
+    Tcl_Obj *(argStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = argStorage;
+
+    /*
+     * Create the object argument array "objv". Make sure objv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-objv word.
+     */
+
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+    }
+
+    for (i = 0;  i < argc;  i++) {
+	length = strlen(argv[i]);
+	TclNewObj(objPtr);
+	TclInitStringRep(objPtr, argv[i], length);
+	Tcl_IncrRefCount(objPtr);
+	objv[i] = objPtr;
+    }
+    objv[argc] = 0;
+
+    /*
+     * Invoke the command's object-based Tcl_ObjCmdProc.
+     */
+
+    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+
+    /*
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULL BYTES.
+     */
+
+    Tcl_SetResult(interp,
+	    TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	    TCL_VOLATILE);
+    
+    /*
+     * Decrement the ref counts for the argument objects created above,
+     * then free the objv array if malloc'ed storage was used.
+     */
+
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    if (objv != argStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRenameCommand --
+ *
+ *      Called to give an existing Tcl command a different name. Both the
+ *      old command name and the new command name can have "::" namespace
+ *      qualifiers. If the new command has a different namespace context,
+ *      the command is automatically moved to that namespace.
+ *
+ *      If the new command name is NULL or the null string, the command is
+ *      deleted.
+ *
+ * Results:
+ *      Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *      If anything goes wrong, an error message is returned in the
+ *      interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRenameCommand(interp, oldName, newName)
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    char *oldName;                      /* Existing command name. */
+    char *newName;                      /* New command name. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *cmdTail, *newTail;
+    Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    Tcl_HashEntry *hPtr, *oldHPtr;
+    int new, isSrcBgerror, isDestBgerror, result;
+
+    /*
+     * Find the existing command. An error is returned if cmdName can't
+     * be found.
+     */
+
+    cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,
+	/*flags*/ 0);
+    cmdPtr = (Command *) cmd;
+    if (cmdPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't ",
+                ((newName == NULL) || (*newName == '\0'))? "delete":"rename",
+                " \"", oldName, "\": command doesn't exist", (char *) NULL);
+	return TCL_ERROR;
+    }
+    cmdTail = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+    cmdNsPtr = cmdPtr->nsPtr;
+
+    /*
+     * If the new command name is NULL or empty, delete the command. Do this
+     * with Tcl_DeleteCommandFromToken, since we already have the command.
+     */
+    
+    if ((newName == NULL) || (*newName == '\0')) {
+	Tcl_DeleteCommandFromToken(interp, cmd);
+	return TCL_OK;
+    }
+
+    /*
+     * Make sure that the destination command does not already exist.
+     * The rename operation is like creating a command, so we should
+     * automatically create the containing namespaces just like
+     * Tcl_CreateCommand would.
+     */
+
+    result = TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
+            (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+            &newNsPtr, &dummy1, &dummy2, &newTail);
+    if (result != TCL_OK) {
+        return result;
+    }
+    if ((newNsPtr == NULL) || (newTail == NULL)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		 "can't rename to \"", newName, "\": bad command name",
+    	    	 (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		 "can't rename to \"", newName,
+		 "\": command already exists", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * The code below was added in 11/95 to preserve backwards compatibility
+     * when "tkerror" was renamed "bgerror":  we guarantee that the hash
+     * table entries for both commands refer to a single shared Command
+     * structure.  This code should eventually become unnecessary.
+     */
+
+    if ((*cmdTail == 't') && (strcmp(cmdTail, "tkerror") == 0)
+	    && (cmdNsPtr == iPtr->globalNsPtr)) {
+	cmdTail = "bgerror";
+    }
+    isSrcBgerror = ((*cmdTail == 'b') && (strcmp(cmdTail, "bgerror") == 0)
+	    && (cmdNsPtr == iPtr->globalNsPtr));
+
+    if ((*newTail == 't') && (strcmp(newTail, "tkerror") == 0)
+	    && (newNsPtr == iPtr->globalNsPtr)) {
+	newTail = "bgerror";
+    }
+    isDestBgerror = ((*newTail == 'b') && (strcmp(newTail, "bgerror") == 0)
+            && (newNsPtr == iPtr->globalNsPtr));
+
+    /*
+     * Put the command in the new namespace, so we can check for an alias
+     * loop. Since we are adding a new command to a namespace, we must
+     * handle any shadowing of the global commands that this might create.
+     * Note that the renamed command has a different hashtable pointer than
+     * it used to have. This allows the command caching code in tclExecute.c
+     * to recognize that a command pointer it has cached for this command is
+     * now invalid.
+     */
+    
+    oldHPtr = cmdPtr->hPtr;
+    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    cmdPtr->hPtr = hPtr;
+    cmdPtr->nsPtr = newNsPtr;
+    TclResetShadowedCmdRefs(interp, cmdPtr);
+
+    /*
+     * Everything is in place so we can check for an alias loop. If we
+     * detect one, put everything back the way it was and report the error.
+     */
+
+    result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
+    if (result != TCL_OK) {
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        cmdPtr->hPtr = oldHPtr;
+        cmdPtr->nsPtr = cmdNsPtr;
+        return result;
+    }
+
+    /*
+     * The new command name is okay, so remove the command from its
+     * current namespace. This is like deleting the command, so bump
+     * the cmdEpoch to invalidate any cached references to the command.
+     */
+    
+    Tcl_DeleteHashEntry(oldHPtr);
+    cmdPtr->cmdEpoch++;
+
+    /*
+     * If the command being renamed has a compile procedure, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled for
+     * the now-renamed command.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+	iPtr->compileEpoch++;
+    }
+
+    /*
+     * The code below provides more backwards compatibility for the
+     * "tkerror" => "bgerror" renaming. As with the other compatibility
+     * code above, it should eventually be removed.
+     */
+
+    if (isSrcBgerror) {
+	/*
+	 * The source command is "bgerror": delete the hash table entry for
+	 * "tkerror" if it exists.
+	 */
+	
+	hPtr = Tcl_FindHashEntry(&cmdNsPtr->cmdTable, "tkerror");
+        if (hPtr != NULL) {
+	    Tcl_DeleteHashEntry(hPtr);
+        }
+    }
+    if (isDestBgerror) {
+	/*
+	 * The destination command is "bgerror"; create a "tkerror"
+	 * command that shares the same Command structure.
+	 */
+	
+	hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, "tkerror", &new);
+	Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_SetCommandInfo --
  *
- *	Modifies various information about a Tcl command.
+ *	Modifies various information about a Tcl command. Note that
+ *	this procedure will not change a command's namespace; use
+ *	Tcl_RenameCommand to do that. Also, the isNativeObjectProc
+ *	member of *infoPtr is ignored.
  *
  * Results:
  *	If cmdName exists in interp, then the information at *infoPtr
  *	is stored with the command in place of the current information
- *	and 1 is returned.  If the command doesn't exist then 0 is
- *	returned.
+ *	and 1 is returned. If the command doesn't exist then 0 is
+ *	returned. 
  *
  * Side effects:
  *	None.
@@ -911,16 +2042,29 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
     Tcl_CmdInfo *infoPtr;		/* Where to store information about
 					 * command. */
 {
-    Tcl_HashEntry *hPtr;
+    Tcl_Command cmd;
     Command *cmdPtr;
 
-    hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
-    if (hPtr == NULL) {
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
 	return 0;
     }
-    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
+     */
+    
+    cmdPtr = (Command *) cmd;
     cmdPtr->proc = infoPtr->proc;
     cmdPtr->clientData = infoPtr->clientData;
+    if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
+	cmdPtr->objProc = TclInvokeStringCommand;
+	cmdPtr->objClientData = (ClientData) cmdPtr;
+    } else {
+	cmdPtr->objProc = infoPtr->objProc;
+	cmdPtr->objClientData = infoPtr->objClientData;
+    }
     cmdPtr->deleteProc = infoPtr->deleteProc;
     cmdPtr->deleteData = infoPtr->deleteData;
     return 1;
@@ -953,18 +2097,30 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
     Tcl_CmdInfo *infoPtr;		/* Where to store information about
 					 * command. */
 {
-    Tcl_HashEntry *hPtr;
+    Tcl_Command cmd;
     Command *cmdPtr;
 
-    hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
-    if (hPtr == NULL) {
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
 	return 0;
     }
-    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * Set isNativeObjectProc 1 if objProc was registered by a call to
+     * Tcl_CreateObjCommand. Otherwise set it to 0.
+     */
+
+    cmdPtr = (Command *) cmd;
+    infoPtr->isNativeObjectProc =
+	    (cmdPtr->objProc != TclInvokeStringCommand);
+    infoPtr->objProc = cmdPtr->objProc;
+    infoPtr->objClientData = cmdPtr->objClientData;
     infoPtr->proc = cmdPtr->proc;
     infoPtr->clientData = cmdPtr->clientData;
     infoPtr->deleteProc = cmdPtr->deleteProc;
     infoPtr->deleteData = cmdPtr->deleteData;
+    infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
     return 1;
 }
 
@@ -989,24 +2145,76 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
 char *
 Tcl_GetCommandName(interp, command)
     Tcl_Interp *interp;		/* Interpreter containing the command. */
-    Tcl_Command command;	/* Token for the command, returned by a
-				 * previous call to Tcl_CreateCommand.
-				 * The command must not have been deleted. */
+    Tcl_Command command;	/* Token for command returned by a previous
+				 * call to Tcl_CreateCommand. The command
+				 * must not have been deleted. */
 {
     Command *cmdPtr = (Command *) command;
-    Interp *iPtr = (Interp *) interp;
 
     if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
 
 	/*
 	 * This should only happen if command was "created" after the
 	 * interpreter began to be deleted, so there isn't really any
-	 * command.  Just return an empty string.
+	 * command. Just return an empty string.
 	 */
 
 	return "";
     }
-    return Tcl_GetHashKey(&iPtr->commandTable, cmdPtr->hPtr);
+    return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandFullName --
+ *
+ *	Given a token returned by, e.g., Tcl_CreateCommand or
+ *	Tcl_FindCommand, this procedure appends to an object the command's
+ *	full name, qualified by a sequence of parent namespace names. The
+ *	command's fully-qualified name may have changed due to renaming.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The command's fully-qualified name is appended to the string
+ *	representation of objPtr. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetCommandFullName(interp, command, objPtr)
+    Tcl_Interp *interp;		/* Interpreter containing the command. */
+    Tcl_Command command;	/* Token for command returned by a previous
+				 * call to Tcl_CreateCommand. The command
+				 * must not have been deleted. */
+    Tcl_Obj *objPtr;		/* Points to the object onto which the
+				 * command's full name is appended. */
+
+{
+    Interp *iPtr = (Interp *) interp;
+    register Command *cmdPtr = (Command *) command;
+    char *name;
+
+    /*
+     * Add the full name of the containing namespace, followed by the "::"
+     * separator, and the command name.
+     */
+
+    if (cmdPtr != NULL) {
+	if (cmdPtr->nsPtr != NULL) {
+	    Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
+	    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
+		Tcl_AppendToObj(objPtr, "::", 2);
+	    }
+	}
+	if (cmdPtr->hPtr != NULL) {
+	    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+	    Tcl_AppendToObj(objPtr, name, -1);
+	}
+    }
 }
 
 /*
@@ -1018,11 +2226,10 @@ Tcl_GetCommandName(interp, command)
  *
  * Results:
  *	0 is returned if the command was deleted successfully.
- *	-1 is returned if there didn't exist a command by that
- *	name.
+ *	-1 is returned if there didn't exist a command by that name.
  *
  * Side effects:
- *	CmdName will no longer be recognized as a valid command for
+ *	cmdName will no longer be recognized as a valid command for
  *	interp.
  *
  *----------------------------------------------------------------------
@@ -1031,40 +2238,71 @@ Tcl_GetCommandName(interp, command)
 int
 Tcl_DeleteCommand(interp, cmdName)
     Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by a previous call to Tcl_CreateInterp). */
+				 * by a previous Tcl_CreateInterp call). */
     char *cmdName;		/* Name of command to remove. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr, *tkErrorHPtr;
-    Command *cmdPtr;
+    Tcl_Command cmd;
 
     /*
-     * The code below was added in 11/95 to preserve backwards compatibility
-     * when "tkerror" was renamed "bgerror":  if anyone attempts to delete
-     * "tkerror", delete both it  and "bgerror".  This  code should
-     * eventually be removed.
+     *  Find the desired command and delete it.
      */
 
-    if ((cmdName[0] == 't') && (strcmp(cmdName, "tkerror") == 0)) {
-	cmdName = "bgerror";
-    }
-    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, cmdName);
-    if (hPtr == NULL) {
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
 	return -1;
     }
-    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    return Tcl_DeleteCommandFromToken(interp, cmd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteCommandFromToken --
+ *
+ *	Removes the given command from the given interpreter. This procedure
+ *	resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead
+ *	of a command name for efficiency.
+ *
+ * Results:
+ *	0 is returned if the command was deleted successfully.
+ *	-1 is returned if there didn't exist a command by that name.
+ *
+ * Side effects:
+ *	The command specified by "cmd" will no longer be recognized as a
+ *	valid command for "interp".
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DeleteCommandFromToken(interp, cmd)
+    Tcl_Interp *interp;		/* Token for command interpreter returned by
+				 * a previous call to Tcl_CreateInterp. */
+    Tcl_Command cmd;            /* Token for command to delete. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Command *cmdPtr = (Command *) cmd;
+    char *cmdName;
+    int isBgerror;
+    ImportRef *refPtr, *nextRefPtr;
+    Tcl_Command importCmd;
+    Tcl_HashEntry *tkErrorHPtr;
+
+    cmdName = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+    isBgerror = ((*cmdName == 'b') && (strcmp(cmdName, "bgerror") == 0)
+	    && (cmdPtr->nsPtr == iPtr->globalNsPtr));
 
     /*
      * The code here is tricky.  We can't delete the hash table entry
      * before invoking the deletion callback because there are cases
      * where the deletion callback needs to invoke the command (e.g.
-     * object systems such as OTcl).  However, this means that the
-     * callback could try to delete or rename the command.  The deleted
+     * object systems such as OTcl). However, this means that the
+     * callback could try to delete or rename the command. The deleted
      * flag allows us to detect these cases and skip nested deletes.
      */
 
     if (cmdPtr->deleted) {
-
 	/*
 	 * Another deletion is already in progress.  Remove the hash
 	 * table entry now, but don't invoke a callback or free the
@@ -1075,19 +2313,59 @@ Tcl_DeleteCommand(interp, cmdName)
 	cmdPtr->hPtr = NULL;
 	return 0;
     }
+
+    /*
+     * If the command being deleted has a compile procedure, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This
+     * makes sure that we don't later try to execute old code compiled with
+     * command-specific (i.e., inline) bytecodes for the now-deleted
+     * command. This field is checked in Tcl_EvalObj and ObjInterpProc, and
+     * code whose compilation epoch doesn't match is recompiled.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+        iPtr->compileEpoch++;
+    }
+
     cmdPtr->deleted = 1;
     if (cmdPtr->deleteProc != NULL) {
+	/*
+	 * Delete the command's client data. If this was an imported command
+	 * created when a command was imported into a namespace, this client
+	 * data will be a pointer to a ImportedCmdData structure describing
+	 * the "real" command that this imported command refers to.
+	 */
+	
 	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
     }
 
     /*
+     * Bump the command epoch counter. This will invalidate all cached
+     * references that point to this command.
+     */
+    
+    cmdPtr->cmdEpoch++;
+
+    /*
+     * If this command was imported into other namespaces, then imported
+     * commands were created that refer back to this command. Delete these
+     * imported commands now.
+     */
+
+    for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
+            refPtr = nextRefPtr) {
+	nextRefPtr = refPtr->nextPtr;
+	importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+        Tcl_DeleteCommandFromToken(interp, importCmd);
+    }
+
+    /*
      * The code below provides more backwards compatibility for the
-     * renaming of "tkerror" to "bgerror".  Like the code above, this
+     * renaming of "tkerror" to "bgerror". Like the code above, this
      * code should eventually become unnecessary.
      */
 
-    if ((cmdName[0] == 'b') && (strcmp(cmdName, "bgerror") == 0)) {
-
+    if (isBgerror) {
 	/*
 	 * When the "bgerror" command is deleted, delete "tkerror"
 	 * as well.  It shared the same Command structure as "bgerror",
@@ -1096,7 +2374,9 @@ Tcl_DeleteCommand(interp, cmdName)
          * been deleted before bgerror.
 	 */
 
-        tkErrorHPtr = Tcl_FindHashEntry(&iPtr->commandTable, "tkerror");
+        tkErrorHPtr = Tcl_FindHashEntry(cmdPtr->hPtr->tablePtr,
+            "tkerror");
+
         if (tkErrorHPtr != (Tcl_HashEntry *) NULL) {
             Tcl_DeleteHashEntry(tkErrorHPtr);
         }
@@ -1112,117 +2392,187 @@ Tcl_DeleteCommand(interp, cmdName)
     if (cmdPtr->hPtr != NULL) {
 	Tcl_DeleteHashEntry(cmdPtr->hPtr);
     }
-    ckfree((char *) cmdPtr);
 
+    /*
+     * Mark the Command structure as no longer valid. This allows
+     * TclExecuteByteCode to recognize when a Command has logically been
+     * deleted and a pointer to this Command structure cached in a CmdName
+     * object is invalid. TclExecuteByteCode will look up the command again
+     * in the interpreter's command hashtable.
+     */
+
+    cmdPtr->objProc = NULL;
+
+    /*
+     * Now free the Command structure, unless there is another reference to
+     * it from a CmdName Tcl object in some ByteCode code sequence. In that
+     * case, delay the cleanup until all references are either discarded
+     * (when a ByteCode is freed) or replaced by a new reference (when a
+     * cached CmdName Command reference is found to be invalid and
+     * TclExecuteByteCode looks up the command in the command hashtable).
+     */
+    
+    TclCleanupCommand(cmdPtr);
     return 0;
 }
 
 /*
- *-----------------------------------------------------------------
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupCommand --
+ *
+ *	This procedure frees up a Command structure unless it is still
+ *	referenced from an interpreter's command hashtable or from a CmdName
+ *	Tcl object representing the name of a command in a ByteCode
+ *	instruction sequence. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets freed unless a reference to the Command structure still
+ *	exists. In that case the cleanup is delayed until the command is
+ *	deleted or when the last ByteCode referring to it is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCleanupCommand(cmdPtr)
+    register Command *cmdPtr;	/* Points to the Command structure to
+				 * be freed. */
+{
+    cmdPtr->refCount--;
+    if (cmdPtr->refCount <= 0) {
+	ckfree((char *) cmdPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
  *
  * Tcl_Eval --
  *
- *	Parse and execute a command in the Tcl language.
+ *	Execute a Tcl command in a string.
  *
  * Results:
- *	The return value is one of the return codes defined in tcl.hd
+ *	The return value is one of the return codes defined in tcl.h
  *	(such as TCL_OK), and interp->result contains a string value
- *	to supplement the return code.  The value of interp->result
- *	will persist only until the next call to Tcl_Eval:  copy it or
- *	lose it! *TermPtr is filled in with the character just after
- *	the last one that was part of the command (usually a NULL
- *	character or a closing bracket).
+ *	to supplement the return code. The value of interp->result
+ *	will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
+ *	you must copy it or lose it!
  *
  * Side effects:
- *	Almost certainly;  depends on the command.
+ *	The string is compiled to produce a ByteCode object that holds the
+ *	command's bytecode instructions. However, this ByteCode object is
+ *	lost after executing the command. The command's execution will
+ *	almost certainly have side effects. interp->termOffset is set to the
+ *	offset of the character in "string" just after the last one
+ *	successfully compiled or executed.
  *
- *-----------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 int
-Tcl_Eval(interp, cmd)
+Tcl_Eval(interp, string)
     Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by a previous call to Tcl_CreateInterp). */
-    char *cmd;			/* Pointer to TCL command to interpret. */
+				 * by previous call to Tcl_CreateInterp). */
+    char *string;		/* Pointer to TCL command to execute. */
 {
-    /*
-     * The storage immediately below is used to generate a copy
-     * of the command, after all argument substitutions.  Pv will
-     * contain the argv values passed to the command procedure.
-     */
+    register Tcl_Obj *cmdPtr;
+    int length = strlen(string);
+    int result;
 
-#   define NUM_CHARS 200
-    char copyStorage[NUM_CHARS];
-    ParseValue pv;
-    char *oldBuffer;
+    if (length > 0) {
+	/*
+	 * Initialize a Tcl object from the command string.
+	 */
 
-    /*
-     * This procedure generates an (argv, argc) array for the command,
-     * It starts out with stack-allocated space but uses dynamically-
-     * allocated storage to increase it if needed.
-     */
+	TclNewObj(cmdPtr);
+	TclInitStringRep(cmdPtr, string, length);
+	Tcl_IncrRefCount(cmdPtr);
 
-#   define NUM_ARGS 10
-    char *(argStorage[NUM_ARGS]);
-    char **argv = argStorage;
-    int argc;
-    int argSize = NUM_ARGS;
-
-    register char *src;			/* Points to current character
-					 * in cmd. */
-    char termChar;			/* Return when this character is found
-					 * (either ']' or '\0').  Zero means
-					 * that newlines terminate commands. */
+	/*
+	 * Compile and execute the bytecodes.
+	 */
+    
+	result = Tcl_EvalObj(interp, cmdPtr);
+
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+
+	/*
+	 * Discard the Tcl object created to hold the command and its code.
+	 */
+	
+	Tcl_DecrRefCount(cmdPtr);	
+    } else {
+	/*
+	 * An empty string. Just reset the interpreter's result.
+	 */
+
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObj --
+ *
+ *	Execute Tcl commands stored in a Tcl object. These commands are
+ *	compiled into bytecodes if necessary.
+ *
+ * Results:
+ *	The return value is one of the return codes defined in tcl.h
+ *	(such as TCL_OK), and the interpreter's result contains a value
+ *	to supplement the return code.
+ *
+ * Side effects:
+ *	The object is converted, if necessary, to a ByteCode object that
+ *	holds the bytecode instructions for the commands. Executing the
+ *	commands will almost certainly have side effects that depend
+ *	on those commands.
+ *
+ *	Just as in Tcl_Eval, interp->termOffset is set to the offset of the
+ *	last character executed in the objPtr's string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalObj(interp, objPtr)
+    Tcl_Interp *interp;			/* Token for command interpreter
+					 * (returned by a previous call to
+					 * Tcl_CreateInterp). */
+    Tcl_Obj *objPtr;			/* Pointer to object containing
+					 * commands to execute. */
+{
+    register Interp *iPtr = (Interp *) interp;
     int flags;				/* Interp->evalFlags value when the
 					 * procedure was called. */
-    int result;				/* Return value. */
-    register Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr;
-    Command *cmdPtr;
-    char *termPtr;			/* Contains character just after the
-					 * last one in the command. */
-    char *cmdStart;			/* Points to first non-blank char. in
-					 * command (used in calling trace
-					 * procedures). */
-    char *ellipsis = "";		/* Used in setting errorInfo variable;
-					 * set to "..." to indicate that not
-					 * all of offending command is included
-					 * in errorInfo.  "" means that the
-					 * command is all there. */
-    register Trace *tracePtr;
+    register ByteCode* codePtr;		/* Tcl Internal type of bytecode. */
     int oldCount = iPtr->cmdCount;	/* Used to tell whether any commands
 					 * at all were executed. */
+    int numSrcChars;
+    register int result;
 
     /*
-     * Initialize the result to an empty string and clear out any
-     * error information.  This makes sure that we return an empty
+     * Reset both the interpreter's string and object results and clear out
+     * any error information. This makes sure that we return an empty
      * result if there are no commands in the command string.
      */
 
-    Tcl_FreeResult((Tcl_Interp *) iPtr);
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
-    result = TCL_OK;
-
-    /*
-     * Initialize the area in which command copies will be assembled.
-     */
-
-    pv.buffer = copyStorage;
-    pv.end = copyStorage + NUM_CHARS - 1;
-    pv.expandProc = TclExpandParseValue;
-    pv.clientData = (ClientData) NULL;
-
-    src = cmd;
-    flags = iPtr->evalFlags;
-    iPtr->evalFlags = 0;
-    if (flags & TCL_BRACKET_TERM) {
-	termChar = ']';
-    } else {
-	termChar = 0;
-    }
-    termPtr = src;
-    cmdStart = src;
+    Tcl_ResetResult(interp);
 
     /*
      * Check depth of nested calls to Tcl_Eval:  if this gets too large,
@@ -1232,226 +2582,102 @@ Tcl_Eval(interp, cmd)
     iPtr->numLevels++;
     if (iPtr->numLevels > iPtr->maxNestingDepth) {
 	iPtr->numLevels--;
-	iPtr->result =  "too many nested calls to Tcl_Eval (infinite loop?)";
-	iPtr->termPtr = termPtr;
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
 	return TCL_ERROR;
     }
 
     /*
-     * There can be many sub-commands (separated by semi-colons or
-     * newlines) in one command string.  This outer loop iterates over
-     * individual commands.
+     * If the interpreter has been deleted, return an error.
      */
+    
+    if (iPtr->flags & DELETED) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "attempt to call eval in deleted interpreter", -1);
+	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+	        "attempt to call eval in deleted interpreter", (char *) NULL);
+	iPtr->numLevels--;
+	return TCL_ERROR;
+    }
 
-    while (*src != termChar) {
-
-        /*
-         * If we have been deleted, return an error preventing further
-         * evals.
-         */
-        
-        if (iPtr->flags & DELETED) {
-            Tcl_ResetResult(interp);
-            interp->result = "attempt to call eval in deleted interpreter";
-            Tcl_SetErrorCode(interp, "CORE", "IDELETE", interp->result,
-                    (char *) NULL);
-            iPtr->numLevels--;
-            return TCL_ERROR;
-        }
-
-	iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET);
-
-	/*
-	 * Skim off leading white space and semi-colons, and skip
-	 * comments.
-	 */
-
-	while (1) {
-	    register char c = *src;
-
-	    if ((CHAR_TYPE(c) != TCL_SPACE) && (c != ';') && (c != '\n')) {
-		break;
-	    }
-	    src += 1;
-	}
-	if (*src == '#') {
-	    while (*src != 0) {
-		if (*src == '\\') {
-		    int length;
-		    Tcl_Backslash(src, &length);
-		    src += length;
-		} else if (*src == '\n') {
-		    src++;
-		    termPtr = src;
-		    break;
-		} else {
-		    src++;
-		}
-	    }
-	    continue;
-	}
-	cmdStart = src;
-
-	/*
-	 * Parse the words of the command, generating the argc and
-	 * argv for the command procedure.  May have to call
-	 * TclParseWords several times, expanding the argv array
-	 * between calls.
-	 */
-
-	pv.next = oldBuffer = pv.buffer;
-	argc = 0;
-	while (1) {
-	    int newArgs, maxArgs;
-	    char **newArgv;
-	    int i;
-
-	    /*
-	     * Note:  the "- 2" below guarantees that we won't use the
-	     * last two argv slots here.  One is for a NULL pointer to
-	     * mark the end of the list, and the other is to leave room
-	     * for inserting the command name "unknown" as the first
-	     * argument (see below).
-	     */
-
-	    maxArgs = argSize - argc - 2;
-	    result = TclParseWords((Tcl_Interp *) iPtr, src, flags,
-		    maxArgs, &termPtr, &newArgs, &argv[argc], &pv);
-	    src = termPtr;
-	    if (result != TCL_OK) {
-		ellipsis = "...";
-		goto done;
-	    }
-
-	    /*
-	     * Careful!  Buffer space may have gotten reallocated while
-	     * parsing words.  If this happened, be sure to update all
-	     * of the older argv pointers to refer to the new space.
-	     */
-
-	    if (oldBuffer != pv.buffer) {
-		int i;
-
-		for (i = 0; i < argc; i++) {
-		    argv[i] = pv.buffer + (argv[i] - oldBuffer);
-		}
-		oldBuffer = pv.buffer;
-	    }
-	    argc += newArgs;
-	    if (newArgs < maxArgs) {
-		argv[argc] = (char *) NULL;
-		break;
-	    }
-
-	    /*
-	     * Args didn't all fit in the current array.  Make it bigger.
-	     */
-
-	    argSize *= 2;
-	    newArgv = (char **)
-		    ckalloc((unsigned) argSize * sizeof(char *));
-	    for (i = 0; i < argc; i++) {
-		newArgv[i] = argv[i];
-	    }
-	    if (argv != argStorage) {
-		ckfree((char *) argv);
-	    }
-	    argv = newArgv;
-	}
-
-	/*
-	 * If this is an empty command (or if we're just parsing
-	 * commands without evaluating them), then just skip to the
-	 * next command.
-	 */
+    /*
+     * Get the ByteCode from the object. If it exists, make sure it hasn't
+     * been invalidated by, e.g., someone redefining a command with a
+     * compile procedure (this might make the compiled code wrong). If
+     * necessary, convert the object to be a ByteCode object and compile it.
+     * Also, if the code was compiled in/for a different interpreter,
+     * we recompile it.
+     */
 
-	if ((argc == 0) || iPtr->noEval) {
-	    continue;
+    if (objPtr->typePtr == &tclByteCodeType) {
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	
+	if ((codePtr->iPtr != iPtr)
+	        || (codePtr->compileEpoch != iPtr->compileEpoch)) {
+	    tclByteCodeType.freeIntRepProc(objPtr);
 	}
-	argv[argc] = NULL;
-
+    }
+    if (objPtr->typePtr != &tclByteCodeType) {
 	/*
-	 * Save information for the history module, if needed.
+	 * First reset any error line number information.
 	 */
-
-	if (flags & TCL_RECORD_BOUNDS) {
-	    iPtr->evalFirst = cmdStart;
-	    iPtr->evalLast = src-1;
+	
+	iPtr->errorLine = 1;   /* no correct line # information yet */
+	result = tclByteCodeType.setFromAnyProc(interp, objPtr);
+	if (result != TCL_OK) {
+	    iPtr->numLevels--;
+	    return result;
 	}
+    }
+    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
 
-	/*
-	 * Find the procedure to execute this command.  If there isn't
-	 * one, then see if there is a command "unknown".  If so,
-	 * invoke it instead, passing it the words of the original
-	 * command as arguments.
-	 */
-
-	hPtr = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]);
-	if (hPtr == NULL) {
-	    int i;
+    /*
+     * Extract then reset the compilation flags in the interpreter.
+     * Resetting the flags must be done after any compilation.
+     */
 
-	    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, "unknown");
-	    if (hPtr == NULL) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "invalid command name \"",
-			argv[0], "\"", (char *) NULL);
-		result = TCL_ERROR;
-		goto done;
-	    }
-	    for (i = argc; i >= 0; i--) {
-		argv[i+1] = argv[i];
-	    }
-	    argv[0] = "unknown";
-	    argc++;
-	}
-	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    flags = iPtr->evalFlags;
+    iPtr->evalFlags = 0;
 
-	/*
-	 * Call trace procedures, if any.
-	 */
+    /*
+     * Save information for the history module, if needed.
+     * BTL: setting these NULL disables history revisions.
+     */
 
-	for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
-		tracePtr = tracePtr->nextPtr) {
-	    char saved;
+    if (flags & TCL_RECORD_BOUNDS) {
+	iPtr->evalFirst = NULL;
+	iPtr->evalLast = NULL;
+    }
 
-	    if (tracePtr->level < iPtr->numLevels) {
-		continue;
-	    }
-	    saved = *src;
-	    *src = 0;
-	    (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
-		    cmdStart, cmdPtr->proc, cmdPtr->clientData, argc, argv);
-	    *src = saved;
-	}
+    /*
+     * Execute the commands. If the code was compiled from an empty string,
+     * don't bother executing the code.
+     */
 
+    numSrcChars = codePtr->numSrcChars;
+    if (numSrcChars > 0) {
 	/*
-	 * At long last, invoke the command procedure.  Reset the
-	 * result to its default empty value first (it could have
-	 * gotten changed by earlier commands in the same command
-	 * string).
+	 * Increment the code's ref count while it is being executed. If
+	 * afterwards no references to it remain, free the code.
 	 */
-
-	iPtr->cmdCount++;
-	Tcl_FreeResult(iPtr);
-	iPtr->result = iPtr->resultSpace;
-	iPtr->resultSpace[0] = 0;
-	result = (*cmdPtr->proc)(cmdPtr->clientData, interp, argc, argv);
-	if (Tcl_AsyncReady()) {
-	    result = Tcl_AsyncInvoke(interp, result);
-	}
-	if (result != TCL_OK) {
-	    break;
+	
+	codePtr->refCount++;
+	result = TclExecuteByteCode(interp, codePtr);
+	codePtr->refCount--;
+	if (codePtr->refCount <= 0) {
+	    TclCleanupByteCode(codePtr);
 	}
+    } else {
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
     }
 
-    done:
-
     /*
      * If no commands at all were executed, check for asynchronous
      * handlers so that they at least get one change to execute.
      * This is needed to handle event loops written in Tcl with
-     * empty bodies (I'm not sure that loops like this are a good
-     * idea, * but...).
+     * empty bodies.
      */
 
     if ((oldCount == iPtr->cmdCount) && (Tcl_AsyncReady())) {
@@ -1462,12 +2688,6 @@ Tcl_Eval(interp, cmd)
      * Free up any extra resources that were allocated.
      */
 
-    if (pv.buffer != copyStorage) {
-	ckfree((char *) pv.buffer);
-    }
-    if (argv != argStorage) {
-	ckfree((char *) argv);
-    }
     iPtr->numLevels--;
     if (iPtr->numLevels == 0) {
 	if (result == TCL_RETURN) {
@@ -1477,13 +2697,15 @@ Tcl_Eval(interp, cmd)
 		&& !(flags & TCL_ALLOW_EXCEPTIONS)) {
 	    Tcl_ResetResult(interp);
 	    if (result == TCL_BREAK) {
-		iPtr->result = "invoked \"break\" outside of a loop";
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "invoked \"break\" outside of a loop", -1);
 	    } else if (result == TCL_CONTINUE) {
-		iPtr->result = "invoked \"continue\" outside of a loop";
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "invoked \"continue\" outside of a loop", -1);
 	    } else {
-		iPtr->result = iPtr->resultSpace;
-		sprintf(iPtr->resultSpace, "command returned bad code: %d",
-			result);
+		char buf[50];
+		sprintf(buf, "command returned bad code: %d", result);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
 	    }
 	    result = TCL_ERROR;
 	}
@@ -1495,14 +2717,18 @@ Tcl_Eval(interp, cmd)
      */
 
     if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
-	int numChars;
-	register char *p;
+	char buf[200];
+	char *ellipsis = "";
+	char *bytes;
+	int length;
 
 	/*
 	 * Compute the line number where the error occurred.
+	 * BTL: no line # information yet.
 	 */
 
 	iPtr->errorLine = 1;
+#ifdef NOT_YET
 	for (p = cmd; p != cmdStart; p++) {
 	    if (*p == '\n') {
 		iPtr->errorLine++;
@@ -1513,32 +2739,958 @@ Tcl_Eval(interp, cmd)
 		iPtr->errorLine++;
 	    }
 	}
-
+#endif
+	
 	/*
 	 * Figure out how much of the command to print in the error
 	 * message (up to a certain number of characters, or up to
 	 * the first new-line).
+	 * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS A NULL.
 	 */
 
-	numChars = src - cmdStart;
-	if (numChars > (NUM_CHARS-50)) {
-	    numChars = NUM_CHARS-50;
+	bytes = Tcl_GetStringFromObj(objPtr, &length);
+	length = TclMin(numSrcChars, length);
+	if (length > 150) {
+	    length = 150;
 	    ellipsis = " ...";
 	}
 
 	if (!(iPtr->flags & ERR_IN_PROGRESS)) {
-	    sprintf(copyStorage, "\n    while executing\n\"%.*s%s\"",
-		    numChars, cmdStart, ellipsis);
+	    sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+		    length, bytes, ellipsis);
 	} else {
-	    sprintf(copyStorage, "\n    invoked from within\n\"%.*s%s\"",
-		    numChars, cmdStart, ellipsis);
+	    sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+		    length, bytes, ellipsis);
 	}
-	Tcl_AddErrorInfo(interp, copyStorage);
-	iPtr->flags &= ~ERR_ALREADY_LOGGED;
+	Tcl_AddObjErrorInfo(interp, buf, -1);
+    }
+
+    /*
+     * Set the interpreter's termOffset member to the offset of the
+     * character just after the last one executed. We approximate the offset
+     * of the last character executed by using the number of characters
+     * compiled.
+     */
+
+    iPtr->termOffset = numSrcChars;
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
+ *
+ *	Procedures to evaluate an expression and return its value in a
+ *	particular form.
+ *
+ * Results:
+ *	Each of the procedures below returns a standard Tcl result. If an
+ *	error occurs then an error message is left in interp->result.
+ *	Otherwise the value of the expression, in the appropriate form, is
+ *	stored at *ptr. If the expression had a result that was
+ *	incompatible with the desired form then an error is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprLong(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    char *string;		/* Expression to evaluate. */
+    long *ptr;			/* Where to store result. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    int result = TCL_OK;
+
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
+	Tcl_IncrRefCount(exprPtr);
+	
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store an integer based on the expression result.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		*ptr = resultPtr->internalRep.longValue;
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		*ptr = (long) resultPtr->internalRep.doubleValue;
+	    } else {
+		Tcl_SetResult(interp,
+		        "expression didn't have numeric value", TCL_STATIC);
+		result = TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	} else {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+		            (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr);  /* discard the expression object */	
+    } else {
+	/*
+	 * An empty string. Just set the result integer to 0.
+	 */
+	
+	*ptr = 0;
+    }
+    return result;
+}
+
+int
+Tcl_ExprDouble(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    char *string;		/* Expression to evaluate. */
+    double *ptr;		/* Where to store result. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    int result = TCL_OK;
+
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
+	Tcl_IncrRefCount(exprPtr);
+	
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store a double  based on the expression result.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		*ptr = (double) resultPtr->internalRep.longValue;
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		*ptr = resultPtr->internalRep.doubleValue;
+	    } else {
+		Tcl_SetResult(interp,
+		        "expression didn't have numeric value", TCL_STATIC);
+		result = TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	} else {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+		            (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr);  /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the result double to 0.0.
+	 */
+	
+	*ptr = 0.0;
+    }
+    return result;
+}
+
+int
+Tcl_ExprBoolean(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+			         * expression. */
+    char *string;		/* Expression to evaluate. */
+    int *ptr;			/* Where to store 0/1 result. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    int result = TCL_OK;
+
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
+	Tcl_IncrRefCount(exprPtr);
+	
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store a boolean based on the expression result.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		*ptr = (resultPtr->internalRep.longValue != 0);
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		*ptr = (resultPtr->internalRep.doubleValue != 0.0);
+	    } else {
+		result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	}
+	if (result != TCL_OK) {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+		            (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the result boolean to 0 (false).
+	 */
+	
+	*ptr = 0;
+    }
+    return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
+ *
+ *	Procedures to evaluate an expression in an object and return its
+ *	value in a particular form.
+ *
+ * Results:
+ *	Each of the procedures below returns a standard Tcl result
+ *	object. If an error occurs then an error message is left in the
+ *	interpreter's result. Otherwise the value of the expression, in the
+ *	appropriate form, is stored at *ptr. If the expression had a result
+ *	that was incompatible with the desired form then an error is
+ *	returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprLongObj(interp, objPtr, ptr)
+    Tcl_Interp *interp;			/* Context in which to evaluate the
+					 * expression. */
+    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
+    long *ptr;				/* Where to store long result. */
+{
+    Tcl_Obj *resultPtr;
+    int result;
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = resultPtr->internalRep.longValue;
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = (long) resultPtr->internalRep.doubleValue;
+	} else {
+	    result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+    }
+    return result;
+}
+
+int
+Tcl_ExprDoubleObj(interp, objPtr, ptr)
+    Tcl_Interp *interp;			/* Context in which to evaluate the
+					 * expression. */
+    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
+    double *ptr;			/* Where to store double result. */
+{
+    Tcl_Obj *resultPtr;
+    int result;
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = (double) resultPtr->internalRep.longValue;
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = resultPtr->internalRep.doubleValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+    }
+    return result;
+}
+
+int
+Tcl_ExprBooleanObj(interp, objPtr, ptr)
+    Tcl_Interp *interp;			/* Context in which to evaluate the
+					 * expression. */
+    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
+    int *ptr;				/* Where to store 0/1 result. */
+{
+    Tcl_Obj *resultPtr;
+    int result;
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = (resultPtr->internalRep.longValue != 0);
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = (resultPtr->internalRep.doubleValue != 0.0);
+	} else {
+	    result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvoke --
+ *
+ *	Invokes a Tcl command, given an argv/argc, from either the
+ *	exposed or the hidden sets of commands in the given interpreter.
+ *	NOTE: The command is invoked in the current stack frame of
+ *	the interpreter, thus it can modify local variables.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvoke(interp, argc, argv, flags)
+    Tcl_Interp *interp;		/* Where to invoke the command. */
+    int argc;			/* Count of args. */
+    register char **argv;	/* The arg strings; argv[0] is the name of
+                                 * the command to invoke. */
+    int flags;			/* Combination of flags controlling the
+				 * call: TCL_INVOKE_HIDDEN and
+				 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Tcl_Obj *objPtr;
+    register int i;
+    int length, result;
+
+    /*
+     * This procedure generates an objv array for object arguments that hold
+     * the argv strings. It starts out with stack-allocated space but uses
+     * dynamically-allocated storage if needed.
+     */
+
+#define NUM_ARGS 20
+    Tcl_Obj *(objStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = objStorage;
+
+    /*
+     * Create the object argument array "objv". Make sure objv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-objv word.
+     */
+
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+    }
+
+    for (i = 0;  i < argc;  i++) {
+	length = strlen(argv[i]);
+	objv[i] = Tcl_NewStringObj(argv[i], length);
+	Tcl_IncrRefCount(objv[i]);
+    }
+    objv[argc] = 0;
+
+    /*
+     * Use TclObjInterpProc to actually invoke the command.
+     */
+
+    result = TclObjInvoke(interp, argc, objv, flags);
+
+    /*
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+    
+    Tcl_SetResult(interp,
+	    TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	    TCL_VOLATILE);
+
+    /*
+     * Decrement the ref counts on the objv elements since we are done
+     * with them.
+     */
+
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    
+    /*
+     * Free the objv array if malloc'ed storage was used.
+     */
+
+    if (objv != objStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGlobalInvoke --
+ *
+ *	Invokes a Tcl command, given an argv/argc, from either the
+ *	exposed or hidden sets of commands in the given interpreter.
+ *	NOTE: The command is invoked in the global stack frame of
+ *	the interpreter, thus it cannot see any current state on
+ *	the stack for that interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGlobalInvoke(interp, argc, argv, flags)
+    Tcl_Interp *interp;		/* Where to invoke the command. */
+    int argc;			/* Count of args. */
+    register char **argv;	/* The arg strings; argv[0] is the name of
+                                 * the command to invoke. */
+    int flags;			/* Combination of flags controlling the
+				 * call: TCL_INVOKE_HIDDEN and
+				 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = TclInvoke(interp, argc, argv, flags);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInvokeGlobal --
+ *
+ *	Object version: Invokes a Tcl command, given an objv/objc, from
+ *	either the exposed or hidden set of commands in the given
+ *	interpreter.
+ *	NOTE: The command is invoked in the global stack frame of the
+ *	interpreter, thus it cannot see any current state on the
+ *	stack of that interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInvokeGlobal(interp, objc, objv, flags)
+    Tcl_Interp *interp;		/* Interpreter in which command is
+				 * to be invoked. */
+    int objc;			/* Count of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument value objects; objv[0]
+				 * points to the name of the
+				 * command to invoke. */
+    int flags;			/* Combination of flags controlling
+                                 * the call: TCL_INVOKE_HIDDEN and
+                                 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = TclObjInvoke(interp, objc, objv, flags);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInvoke --
+ *
+ *	Invokes a Tcl command, given an objv/objc, from either the
+ *	exposed or the hidden sets of commands in the given interpreter.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInvoke(interp, objc, objv, flags)
+    Tcl_Interp *interp;		/* Interpreter in which command is
+				 * to be invoked. */
+    int objc;			/* Count of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument value objects; objv[0]
+				 * points to the name of the
+				 * command to invoke. */
+    int flags;			/* Combination of flags controlling
+                                 * the call: TCL_INVOKE_HIDDEN and
+                                 * TCL_INVOKE_NO_UNKNOWN. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
+    char *cmdName;		/* Name of the command from objv[0]. */
+    register Tcl_HashEntry *hPtr;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    int localObjc;		/* Used to invoke "unknown" if the */
+    Tcl_Obj **localObjv = NULL;	/* command is not found. */
+    register int i;
+    int length, result;
+    char *bytes;
+
+    if (interp == (Tcl_Interp *) NULL) {
+        return TCL_ERROR;
+    }
+
+    if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "illegal argument vector", -1);
+        return TCL_ERROR;
+    }
+
+    /*
+     * THE FOLLOWING CODE FAILS IF THE STRING REP CONTAINS NULLS.
+     */
+    
+    cmdName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+    if (flags & TCL_INVOKE_HIDDEN) {
+        /*
+         * Find the table of hidden commands; error out if none.
+         */
+
+        hTblPtr = (Tcl_HashTable *)
+	        Tcl_GetAssocData(interp, "tclHiddenCmds", NULL);
+        if (hTblPtr == (Tcl_HashTable *) NULL) {
+            badHiddenCmdName:
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		     "invalid hidden command name \"", cmdName, "\"",
+		     (char *) NULL);
+            return TCL_ERROR;
+        }
+        hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
+
+        /*
+         * We never invoke "unknown" for hidden commands.
+         */
+        
+        if (hPtr == NULL) {
+            goto badHiddenCmdName;
+        }
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
     } else {
+	cmdPtr = NULL;
+	cmd = Tcl_FindCommand(interp, cmdName,
+	        (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+        if (cmd != (Tcl_Command) NULL) {
+	    cmdPtr = (Command *) cmd;
+        }
+	if (cmdPtr == NULL) {
+            if (!(flags & TCL_INVOKE_NO_UNKNOWN)) {
+		cmd = Tcl_FindCommand(interp, "unknown",
+                        (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+		if (cmd != (Tcl_Command) NULL) {
+	            cmdPtr = (Command *) cmd;
+                }
+                if (cmdPtr != NULL) {
+                    localObjc = (objc + 1);
+                    localObjv = (Tcl_Obj **)
+			ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc));
+		    localObjv[0] = Tcl_NewStringObj("unknown", -1);
+		    Tcl_IncrRefCount(localObjv[0]);
+                    for (i = 0;  i < objc;  i++) {
+                        localObjv[i+1] = objv[i];
+                    }
+                    objc = localObjc;
+                    objv = localObjv;
+                }
+            }
+
+            /*
+             * Check again if we found the command. If not, "unknown" is
+             * not present and we cannot help, or the caller said not to
+             * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
+             */
+
+            if (cmdPtr == NULL) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"invalid command name \"",  cmdName, "\"", 
+			 (char *) NULL);
+                return TCL_ERROR;
+            }
+        }
+    }
+
+    /*
+     * Invoke the command procedure. First reset the interpreter's string
+     * and object results to their default empty values since they could
+     * have gotten changed by earlier invocations.
+     */
+
+    Tcl_ResetResult(interp);
+    iPtr->cmdCount++;
+    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+
+    /*
+     * If an error occurred, record information about what was being
+     * executed when the error occurred.
+     */
+
+    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+        Tcl_DString ds;
+        
+        Tcl_DStringInit(&ds);
+        if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+            Tcl_DStringAppend(&ds, "\n    while invoking\n\"", -1);
+        } else {
+            Tcl_DStringAppend(&ds, "\n    invoked from within\n\"", -1);
+        }
+        for (i = 0;  i < objc;  i++) {
+	    bytes = Tcl_GetStringFromObj(objv[i], &length);
+            Tcl_DStringAppend(&ds, bytes, length);
+            if (i < (objc - 1)) {
+                Tcl_DStringAppend(&ds, " ", -1);
+            } else if (Tcl_DStringLength(&ds) > 100) {
+                Tcl_DStringSetLength(&ds, 100);
+                Tcl_DStringAppend(&ds, "...", -1);
+                break;
+            }
+        }
+        
+        Tcl_DStringAppend(&ds, "\"", -1);
+        Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1);
+        Tcl_DStringFree(&ds);
 	iPtr->flags &= ~ERR_ALREADY_LOGGED;
     }
-    iPtr->termPtr = termPtr;
+
+    /*
+     * Free any locally allocated storage used to call "unknown".
+     */
+
+    if (localObjv != (Tcl_Obj **) NULL) {
+        ckfree((char *) localObjv);
+    }
+    return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprString --
+ *
+ *	Evaluate an expression in a string and return its value in string
+ *	form.
+ *
+ * Results:
+ *	A standard Tcl result. If the result is TCL_OK, then the
+ *	interpreter's result is set to the string value of the
+ *	expression. If the result is TCL_OK, then interp->result
+ *	contains an error message.
+ *
+ * Side effects:
+ *	A Tcl object is allocated to hold a copy of the expression string.
+ *	This expression object is passed to Tcl_ExprObj and then
+ *	deallocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprString(interp, string)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    char *string;		/* Expression to evaluate. */
+{
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    char buf[100];
+    int result = TCL_OK;
+
+    if (length > 0) {
+	TclNewObj(exprPtr);
+	TclInitStringRep(exprPtr, string, length);
+	Tcl_DecrRefCount(exprPtr);
+
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Set the interpreter's string result from the result object.
+	     */
+	    
+	    if (resultPtr->typePtr == &tclIntType) {
+		sprintf(buf, "%ld", resultPtr->internalRep.longValue);
+		Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    } else if (resultPtr->typePtr == &tclDoubleType) {
+		Tcl_PrintDouble((Tcl_Interp *) NULL,
+		        resultPtr->internalRep.doubleValue, buf);
+		Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    } else {
+		/*
+		 * Set interpreter's string result from the result object.
+		 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+		 */
+	    
+		Tcl_SetResult(interp,
+	                TclGetStringFromObj(resultPtr, (int *) NULL),
+	                TCL_VOLATILE);
+	    }
+	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	} else {
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+	    
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+			    (int *) NULL),
+	            TCL_VOLATILE);
+	}
+	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the interpreter's result to 0.
+	 */
+	
+	Tcl_SetResult(interp, "0", TCL_VOLATILE);
+    }
+    return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprObj --
+ *
+ *	Evaluate an expression in a Tcl_Obj.
+ *
+ * Results:
+ *	A standard Tcl object result. If the result is other than TCL_OK,
+ *	then the interpreter's result contains an error message. If the
+ *	result is TCL_OK, then a pointer to the expression's result value
+ *	object is stored in resultPtrPtr. In that case, the object's ref
+ *	count is incremented to reflect the reference returned to the
+ *	caller; the caller is then responsible for the resulting object
+ *	and must, for example, decrement the ref count when it is finished
+ *	with the object.
+ *
+ * Side effects:
+ *	Any side effects caused by subcommands in the expression, if any.
+ *	The interpreter result is not modified unless there is an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprObj(interp, objPtr, resultPtrPtr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    register Tcl_Obj *objPtr;	/* Points to Tcl object containing
+				 * expression to evaluate. */
+    Tcl_Obj **resultPtrPtr;	/* Where the Tcl_Obj* that is the expression
+				 * result is stored if no errors occur. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CompileEnv compEnv;		/* Compilation environment structure
+				 * allocated in frame. */
+    register ByteCode *codePtr = NULL;
+    				/* Tcl Internal type of bytecode.
+				 * Initialized to avoid compiler warning. */
+    AuxData *auxDataPtr;
+    Interp dummy;
+    Tcl_Obj *saveObjPtr;
+    char *string;
+    int result = TCL_OK;
+    int i;
+
+    /*
+     * Get the ByteCode from the object. If it exists, make sure it hasn't
+     * been invalidated by, e.g., someone redefining a command with a
+     * compile procedure (this might make the compiled code wrong). If
+     * necessary, convert the object to be a ByteCode object and compile it.
+     * Also, if the code was compiled in/for a different interpreter, we
+     * recompile it.
+     * THIS FAILS IF THE OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    if (objPtr->typePtr == &tclByteCodeType) {
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	if ((codePtr->iPtr != iPtr)
+	        || (codePtr->compileEpoch != iPtr->compileEpoch)) {
+	    tclByteCodeType.freeIntRepProc(objPtr);
+	    objPtr->typePtr = (Tcl_ObjType *) NULL;
+	}
+    }
+    if (objPtr->typePtr != &tclByteCodeType) {
+	int length;
+	string = Tcl_GetStringFromObj(objPtr, &length);
+	TclInitCompileEnv(interp, &compEnv, string);
+	result = TclCompileExpr(interp, string, string + length,
+		/*flags*/ 0, &compEnv);
+	if (result == TCL_OK) {
+	    /*
+	     * If the expression yielded no instructions (e.g., was empty),
+	     * push an integer zero object as the expressions's result.
+	     */
+	    
+	    if (compEnv.codeNext == NULL) {
+		int objIndex = TclObjIndexForString("0", 0,
+			/*allocStrRep*/ 0, /*inHeap*/ 0, &compEnv);
+		Tcl_Obj *objPtr = compEnv.objArrayPtr[objIndex];
+
+		Tcl_InvalidateStringRep(objPtr);
+		objPtr->internalRep.longValue = 0;
+		objPtr->typePtr = &tclIntType;
+		
+		TclEmitPush(objIndex, &compEnv);
+	    }
+	    
+	    /*
+	     * Add done instruction at the end of the instruction sequence.
+	     */
+	    
+	    TclEmitOpcode(INST_DONE, &compEnv);
+	    
+	    TclInitByteCodeObj(objPtr, &compEnv);
+	    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	    if (tclTraceCompile == 2) {
+		TclPrintByteCodeObj(interp, objPtr);
+	    }
+	    TclFreeCompileEnv(&compEnv);
+	} else {
+	    /*
+	     * Compilation errors. Decrement the ref counts on any objects
+	     * in the object array before freeing the compilation
+	     * environment.
+	     */
+	    
+	    for (i = 0;  i < compEnv.objArrayNext;  i++) {
+		Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
+		Tcl_DecrRefCount(elemPtr);
+	    }
+
+	    auxDataPtr = compEnv.auxDataArrayPtr;
+	    for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
+		if (auxDataPtr->freeProc != NULL) {
+		    auxDataPtr->freeProc(auxDataPtr->clientData);
+		}
+		auxDataPtr++;
+	    }
+	    TclFreeCompileEnv(&compEnv);
+	    return result;
+	}
+    }
+
+    /*
+     * Execute the expression after first saving the interpreter's result.
+     */
+    
+    dummy.objResultPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(dummy.objResultPtr);
+    if (interp->freeProc == 0) {
+	dummy.freeProc = (Tcl_FreeProc *) 0;
+	dummy.result = "";
+	Tcl_SetResult((Tcl_Interp *) &dummy, interp->result,
+	        TCL_VOLATILE);
+    } else {
+	dummy.freeProc = interp->freeProc;
+	dummy.result = interp->result;
+	interp->freeProc = (Tcl_FreeProc *) 0;
+    }
+    
+    saveObjPtr = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(saveObjPtr);
+    
+    /*
+     * Increment the code's ref count while it is being executed. If
+     * afterwards no references to it remain, free the code.
+     */
+    
+    codePtr->refCount++;
+    result = TclExecuteByteCode(interp, codePtr);
+    codePtr->refCount--;
+    if (codePtr->refCount <= 0) {
+	TclCleanupByteCode(codePtr);
+    }
+    
+    /*
+     * If the expression evaluated successfully, store a pointer to its
+     * value object in resultPtrPtr then restore the old interpreter result.
+     * We increment the object's ref count to reflect the reference that we
+     * are returning to the caller. We also decrement the ref count of the
+     * interpreter's result object after calling Tcl_SetResult since we
+     * next store into that field directly.
+     */
+    
+    if (result == TCL_OK) {
+	*resultPtrPtr = iPtr->objResultPtr;
+	Tcl_IncrRefCount(iPtr->objResultPtr);
+	
+	Tcl_SetResult(interp, dummy.result,
+	        ((dummy.freeProc == 0) ? TCL_VOLATILE : dummy.freeProc));
+	Tcl_DecrRefCount(iPtr->objResultPtr);
+	iPtr->objResultPtr = saveObjPtr;
+    } else {
+	Tcl_DecrRefCount(saveObjPtr);
+	Tcl_FreeResult((Tcl_Interp *) &dummy);
+    }
+
+    Tcl_DecrRefCount(dummy.objResultPtr);
+    dummy.objResultPtr = NULL;
     return result;
 }
 
@@ -1587,16 +3739,27 @@ Tcl_Eval(interp, cmd)
 
 Tcl_Trace
 Tcl_CreateTrace(interp, level, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter in which to create the trace. */
-    int level;			/* Only call proc for commands at nesting level
-				 * <= level (1 => top level). */
+    Tcl_Interp *interp;		/* Interpreter in which to create trace. */
+    int level;			/* Only call proc for commands at nesting
+				 * level<=argument level (1=>top level). */
     Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
 				 * command. */
-    ClientData clientData;	/* Arbitrary one-word value to pass to proc. */
+    ClientData clientData;	/* Arbitrary value word to pass to proc. */
 {
     register Trace *tracePtr;
     register Interp *iPtr = (Interp *) interp;
 
+    /*
+     * Invalidate existing compiled code for this interpreter and arrange
+     * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling
+     * new code, no commands will be compiled inline (i.e., into an inline
+     * sequence of instructions). We do this because commands that were
+     * compiled inline will never result in a command trace being called.
+     */
+
+    iPtr->compileEpoch++;
+    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+
     tracePtr = (Trace *) ckalloc(sizeof(Trace));
     tracePtr->level = level;
     tracePtr->proc = proc;
@@ -1643,10 +3806,18 @@ Tcl_DeleteTrace(interp, trace)
 	    if (tracePtr2->nextPtr == tracePtr) {
 		tracePtr2->nextPtr = tracePtr->nextPtr;
 		ckfree((char *) tracePtr);
-		return;
+		break;
 	    }
 	}
     }
+
+    if (iPtr->tracePtr == NULL) {
+	/*
+	 * When compiling new code, allow commands to be compiled inline.
+	 */
+
+	iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+    }
 }
 
 /*
@@ -1654,8 +3825,8 @@ Tcl_DeleteTrace(interp, trace)
  *
  * Tcl_AddErrorInfo --
  *
- *	Add information to a message being accumulated that describes
- *	the current error.
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error.
  *
  * Results:
  *	None.
@@ -1664,6 +3835,8 @@ Tcl_DeleteTrace(interp, trace)
  *	The contents of message are added to the "errorInfo" variable.
  *	If Tcl_Eval has been called since the current value of errorInfo
  *	was set, errorInfo is cleared before adding the new message.
+ *	If we are just starting to log an error, errorInfo is initialized
+ *	from the error message in the interpreter's result.
  *
  *----------------------------------------------------------------------
  */
@@ -1674,21 +3847,64 @@ Tcl_AddErrorInfo(interp, message)
 				 * pertains. */
     char *message;		/* Message to record. */
 {
-    register Interp *iPtr = (Interp *) interp;
+    Tcl_AddObjErrorInfo(interp, message, -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddObjErrorInfo --
+ *
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error. This routine differs from Tcl_AddErrorInfo by
+ *	taking a byte pointer and length.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"length" bytes from "message" are added to the "errorInfo" variable.
+ *	If "length" is negative, use bytes up to the first NULL byte.
+ *	If Tcl_EvalObj has been called since the current value of errorInfo
+ *	was set, errorInfo is cleared before adding the new message.
+ *	If we are just starting to log an error, errorInfo is initialized
+ *	from the error message in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
 
+void
+Tcl_AddObjErrorInfo(interp, message, length)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    char *message;		/* Points to the first byte of an array of
+				 * bytes of the message. */
+    register int length;	/* The number of bytes in the message.
+				 * If < 0, then append all bytes up to a
+				 * NULL byte. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *namePtr, *messagePtr;
+    
     /*
-     * If an error is already being logged, then the new errorInfo
-     * is the concatenation of the old info and the new message.
-     * If this is the first piece of info for the error, then the
-     * new errorInfo is the concatenation of the message in
-     * interp->result and the new message.
+     * If we are just starting to log an error, errorInfo is initialized
+     * from the error message in the interpreter's result.
      */
 
-    if (!(iPtr->flags & ERR_IN_PROGRESS)) {
-	Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
-		TCL_GLOBAL_ONLY);
+    namePtr = Tcl_NewStringObj("errorInfo", -1);
+    Tcl_IncrRefCount(namePtr);
+    
+    if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
 	iPtr->flags |= ERR_IN_PROGRESS;
 
+	if (iPtr->result[0] == 0) {
+	    (void) Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL,
+	            iPtr->objResultPtr, TCL_GLOBAL_ONLY);
+	} else {		/* use the string result */
+	    Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
+		    TCL_GLOBAL_ONLY);
+	}
+
 	/*
 	 * If the errorCode variable wasn't set by the code that generated
 	 * the error, set it to "NONE".
@@ -1699,8 +3915,18 @@ Tcl_AddErrorInfo(interp, message)
 		    TCL_GLOBAL_ONLY);
 	}
     }
-    Tcl_SetVar2(interp, "errorInfo", (char *) NULL, message,
-	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
+
+    /*
+     * Now append "message" to the end of errorInfo.
+     */
+
+    messagePtr = Tcl_NewStringObj(message, length);
+    Tcl_IncrRefCount(messagePtr);
+    Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, messagePtr,
+	    (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
+    Tcl_DecrRefCount(messagePtr); /* free msg object appended above */
+    
+    Tcl_DecrRefCount(namePtr);    /* free the name object */
 }
 
 /*
@@ -1792,6 +4018,51 @@ Tcl_GlobalEval(interp, command)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_GlobalEvalObj --
+ *
+ *	Execute Tcl commands stored in a Tcl object at global level in
+ *	an interpreter. These commands are compiled into bytecodes if
+ *	necessary.
+ *
+ * Results:
+ *	A standard Tcl result is returned, and the interpreter's result
+ *	contains a Tcl object value to supplement the return code.
+ *
+ * Side effects:
+ *	The object is converted, if necessary, to a ByteCode object that
+ *	holds the bytecode instructions for the commands. Executing the
+ *	commands will almost certainly have side effects that depend on
+ *	those commands.
+ *
+ *	The commands are executed in interp, and the execution
+ *	is carried out in the variable context of global level (no
+ *	procedures active), just as if an "uplevel #0" command were
+ *	being executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GlobalEvalObj(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate
+				 * commands. */
+    Tcl_Obj *objPtr;		/* Pointer to object containing commands
+				 * to execute. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = Tcl_EvalObj(interp, objPtr);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_SetRecursionLimit --
  *
  *	Set the maximum number of recursive calls that may be active
@@ -1850,3 +4121,4 @@ Tcl_AllowExceptions(interp)
 
     iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
 }
+
diff --git a/contrib/tcl/generic/tclBinary.c b/contrib/tcl/generic/tclBinary.c
new file mode 100644
index 0000000..28190cc
--- /dev/null
+++ b/contrib/tcl/generic/tclBinary.c
@@ -0,0 +1,977 @@
+/* 
+ * tclBinary.c --
+ *
+ *	This file contains the implementation of the "binary" Tcl built-in
+ *	command .
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclBinary.c 1.16 97/05/19 10:29:18
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following constants are used by GetFormatSpec to indicate various
+ * special conditions in the parsing of a format specifier.
+ */
+
+#define BINARY_ALL -1		/* Use all elements in the argument. */
+#define BINARY_NOCOUNT -2	/* No count was specified in format. */
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int		GetFormatSpec _ANSI_ARGS_((char **formatPtr,
+			    char *cmdPtr, int *countPtr));
+static int		FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
+			    Tcl_Obj *src, char **cursorPtr));
+static Tcl_Obj *	ScanNumber _ANSI_ARGS_((char *buffer, int type));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_BinaryObjCmd --
+ *
+ *	This procedure implements the "binary" Tcl command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_BinaryObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int arg;			/* Index of next argument to consume. */
+    int value = 0;		/* Current integer value to be packed.
+				 * Initialized to avoid compiler warning. */
+    char cmd;			/* Current format character. */
+    int count;			/* Count associated with current format
+				 * character. */
+    char *format;		/* Pointer to current position in format
+				 * string. */
+    char *cursor;		/* Current position within result buffer. */
+    char *maxPos;		/* Greatest position within result buffer that
+				 * cursor has visited.*/
+    char *buffer;		/* Start of data buffer. */
+    char *errorString, *errorValue, *str;
+    int offset, size, length;
+    Tcl_Obj *resultPtr;
+    
+    static char *subCmds[] = { "format", "scan", (char *) NULL };
+    enum { BinaryFormat, BinaryScan } index;
+
+    if (objc < 2) {
+    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
+	    (int *) &index) != TCL_OK) {
+    	return TCL_ERROR;
+    }
+
+    switch (index) {
+	case BinaryFormat:
+	    if (objc < 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
+		return TCL_ERROR;
+	    }
+	    /*
+	     * To avoid copying the data, we format the string in two passes.
+	     * The first pass computes the size of the output buffer.  The
+	     * second pass places the formatted data into the buffer.
+	     */
+
+	    format = Tcl_GetStringFromObj(objv[2], NULL);
+	    arg = 3;
+	    offset = length = 0;
+	    while (*format != 0) {
+		if (!GetFormatSpec(&format, &cmd, &count)) {
+		    break;
+		}
+		switch (cmd) {
+		    case 'a':
+		    case 'A':
+		    case 'b':
+		    case 'B':
+		    case 'h':
+		    case 'H':
+			/*
+			 * For string-type specifiers, the count corresponds
+			 * to the number of characters in a single argument.
+			 */
+
+			if (arg >= objc) {
+			    goto badIndex;
+			}
+			if (count == BINARY_ALL) {
+			    (void)Tcl_GetStringFromObj(objv[arg], &count);
+			} else if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			arg++;
+			if (cmd == 'a' || cmd == 'A') {
+			    offset += count;
+			} else if (cmd == 'b' || cmd == 'B') {
+			    offset += (count + 7) / 8;
+			} else {
+			    offset += (count + 1) / 2;
+			}
+			break;
+
+		    case 'c':
+			size = 1;
+			goto doNumbers;
+		    case 's':
+		    case 'S':
+			size = 2;
+			goto doNumbers;
+		    case 'i':
+		    case 'I':
+			size = 4;
+			goto doNumbers;
+		    case 'f':
+			size = sizeof(float);
+			goto doNumbers;
+		    case 'd':
+			size = sizeof(double);
+		    doNumbers:
+			if (arg >= objc) {
+			    goto badIndex;
+			}
+
+			/*
+			 * For number-type specifiers, the count corresponds
+			 * to the number of elements in the list stored in
+			 * a single argument.  If no count is specified, then
+			 * the argument is taken as a single non-list value.
+			 */
+
+			if (count == BINARY_NOCOUNT) {
+			    arg++;
+			    count = 1;
+			} else {
+			    int listc;
+			    Tcl_Obj **listv;
+			    if (Tcl_ListObjGetElements(interp, objv[arg++],
+				    &listc, &listv) != TCL_OK) {
+				return TCL_ERROR;
+			    }
+			    if (count == BINARY_ALL) {
+				count = listc;
+			    } else if (count > listc) {
+				errorString = "number of elements in list does not match count";
+				goto error;
+			    }
+			}
+			offset += count*size;
+			break;
+			
+		    case 'x':
+			if (count == BINARY_ALL) {
+			    errorString = "cannot use \"*\" in format string with \"x\"";
+			    goto error;
+			} else if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			offset += count;
+			break;
+		    case 'X':
+			if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			if ((count > offset) || (count == BINARY_ALL)) {
+			    count = offset;
+			}
+			if (offset > length) {
+			    length = offset;
+			}
+			offset -= count;
+			break;
+		    case '@':
+			if (offset > length) {
+			    length = offset;
+			}
+			if (count == BINARY_ALL) {
+			    offset = length;
+			} else if (count == BINARY_NOCOUNT) {
+			    goto badCount;
+			} else {
+			    offset = count;
+			}
+			break;
+		    default: {
+			char buf[2];
+			
+			Tcl_ResetResult(interp);
+			buf[0] = cmd;
+			buf[1] = '\0';
+			Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+				"bad field specifier \"", buf, "\"", NULL);
+			return TCL_ERROR;
+		    }
+		}
+	    }
+	    if (offset > length) {
+		length = offset;
+	    }
+	    if (length == 0) {
+		return TCL_OK;
+	    }
+
+	    /*
+	     * Prepare the result object by preallocating the caclulated
+	     * number of bytes and filling with nulls.
+	     */
+
+	    resultPtr = Tcl_GetObjResult(interp);
+	    Tcl_SetObjLength(resultPtr, length);
+	    buffer = Tcl_GetStringFromObj(resultPtr, NULL);
+	    memset(buffer, 0, (size_t) length);
+
+	    /*
+	     * Pack the data into the result object.  Note that we can skip
+	     * the error checking during this pass, since we have already
+	     * parsed the string once.
+	     */
+
+	    arg = 3;
+	    format = Tcl_GetStringFromObj(objv[2], NULL);
+	    cursor = buffer;
+	    maxPos = cursor;
+	    while (*format != 0) {
+		if (!GetFormatSpec(&format, &cmd, &count)) {
+		    break;
+		}
+		if ((count == 0) && (cmd != '@')) {
+		    arg++;
+		    continue;
+		}
+		switch (cmd) {
+		    case 'a':
+		    case 'A': {
+			char pad = (char) (cmd == 'a' ? '\0' : ' ');
+
+			str = Tcl_GetStringFromObj(objv[arg++], &length);
+
+			if (count == BINARY_ALL) {
+			    count = length;
+			} else if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			if (length >= count) {
+			    memcpy(cursor, str, (size_t) count);
+			} else {
+			    memcpy(cursor, str, (size_t) length);
+			    memset(cursor+length, pad,
+			            (size_t) (count - length));
+			}
+			cursor += count;
+			break;
+		    }
+		    case 'b':
+		    case 'B': {
+			char *last;
+			
+			str = Tcl_GetStringFromObj(objv[arg++], &length);
+			if (count == BINARY_ALL) {
+			    count = length;
+			} else if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			last = cursor + ((count + 7) / 8);
+			if (count > length) {
+			    count = length;
+			}
+			value = 0;
+			errorString = "binary";
+			if (cmd == 'B') {
+			    for (offset = 0; offset < count; offset++) {
+				value <<= 1;
+				if (str[offset] == '1') {
+				    value |= 1;
+				} else if (str[offset] != '0') {
+				    errorValue = str;
+				    goto badValue;
+				}
+				if (((offset + 1) % 8) == 0) {
+				    *cursor++ = (char)(value & 0xff);
+				    value = 0;
+				}
+			    }
+			} else {
+			    for (offset = 0; offset < count; offset++) {
+				value >>= 1;
+				if (str[offset] == '1') {
+				    value |= 128;
+				} else if (str[offset] != '0') {
+				    errorValue = str;
+				    goto badValue;
+				}
+				if (!((offset + 1) % 8)) {
+				    *cursor++ = (char)(value & 0xff);
+				    value = 0;
+				}
+			    }
+			}
+			if ((offset % 8) != 0) {
+			    if (cmd == 'B') {
+				value <<= 8 - (offset % 8);
+			    } else {
+				value >>= 8 - (offset % 8);
+			    }
+			    *cursor++ = (char)(value & 0xff);
+			}
+			while (cursor < last) {
+			    *cursor++ = '\0';
+			}
+			break;
+		    }
+		    case 'h':
+		    case 'H': {
+			char *last;
+			int c;
+			
+			str = Tcl_GetStringFromObj(objv[arg++], &length);
+			if (count == BINARY_ALL) {
+			    count = length;
+			} else if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			last = cursor + ((count + 1) / 2);
+			if (count > length) {
+			    count = length;
+			}
+			value = 0;
+			errorString = "hexadecimal";
+			if (cmd == 'H') {
+			    for (offset = 0; offset < count; offset++) {
+				value <<= 4;
+				c = tolower(((unsigned char *) str)[offset]);
+				if ((c >= 'a') && (c <= 'f')) {
+				    value |= ((c - 'a' + 10) & 0xf);
+				} else if ((c >= '0') && (c <= '9')) {
+				    value |= (c - '0') & 0xf;
+				} else {
+				    errorValue = str;
+				    goto badValue;
+				}
+				if (offset % 2) {
+				    *cursor++ = (char) value;
+				    value = 0;
+				}
+			    }
+			} else {
+			    for (offset = 0; offset < count; offset++) {
+				value >>= 4;
+				c = tolower(((unsigned char *) str)[offset]);
+				if ((c >= 'a') && (c <= 'f')) {
+				    value |= ((c - 'a' + 10) << 4) & 0xf0;
+				} else if ((c >= '0') && (c <= '9')) {
+				    value |= ((c - '0') << 4) & 0xf0;
+				} else {
+				    errorValue = str;
+				    goto badValue;
+				}
+				if (offset % 2) {
+				    *cursor++ = (char)(value & 0xff);
+				    value = 0;
+				}
+			    }
+			}
+			if (offset % 2) {
+			    if (cmd == 'H') {
+				value <<= 4;
+			    } else {
+				value >>= 4;
+			    }
+			    *cursor++ = (char) value;
+			}
+
+			while (cursor < last) {
+			    *cursor++ = '\0';
+			}
+			break;
+		    }
+		    case 'c':
+		    case 's':
+		    case 'S':
+		    case 'i':
+		    case 'I':
+		    case 'd':
+		    case 'f': {
+			int listc, i;
+			Tcl_Obj **listv;
+
+			if (count == BINARY_NOCOUNT) {
+			    /*
+			     * Note that we are casting away the const-ness of
+			     * objv, but this is safe since we aren't going to
+			     * modify the array.
+			     */
+
+			    listv = (Tcl_Obj**)(objv + arg);
+			    listc = 1;
+			    count = 1;
+			} else {
+			    Tcl_ListObjGetElements(interp, objv[arg],
+				    &listc, &listv);
+			    if (count == BINARY_ALL) {
+				count = listc;
+			    }
+			}
+			arg++;
+			for (i = 0; i < count; i++) {
+			    if (FormatNumber(interp, cmd, listv[i], &cursor)
+				    != TCL_OK) {
+				return TCL_ERROR;
+			    }
+			}
+			break;
+		    }
+		    case 'x':
+			if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			memset(cursor, 0, (size_t) count);
+			cursor += count;
+			break;
+		    case 'X':
+			if (cursor > maxPos) {
+			    maxPos = cursor;
+			}
+			if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			if ((count == BINARY_ALL)
+				|| (count > (cursor - buffer))) {
+			    cursor = buffer;
+			} else {
+			    cursor -= count;
+			}
+			break;
+		    case '@':
+			if (cursor > maxPos) {
+			    maxPos = cursor;
+			}
+			if (count == BINARY_ALL) {
+			    cursor = maxPos;
+			} else {
+			    cursor = buffer + count;
+			}
+			break;
+		}
+	    }
+	    break;
+	
+	case BinaryScan: {
+	    int i;
+	    Tcl_Obj *valuePtr, *elementPtr;
+
+	    if (objc < 4) {
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"value formatString ?varName varName ...?");
+		return TCL_ERROR;
+	    }
+	    buffer = Tcl_GetStringFromObj(objv[2], &length);
+	    format = Tcl_GetStringFromObj(objv[3], NULL);
+	    cursor = buffer;
+	    arg = 4;
+	    offset = 0;
+	    while (*format != 0) {
+		if (!GetFormatSpec(&format, &cmd, &count)) {
+		    goto done;
+		}
+		switch (cmd) {
+		    case 'a':
+		    case 'A':
+			if (arg >= objc) {
+			    goto badIndex;
+			}
+			if (count == BINARY_ALL) {
+			    count = length - offset;
+			} else {
+			    if (count == BINARY_NOCOUNT) {
+				count = 1;
+			    }
+			    if (count > (length - offset)) {
+				goto done;
+			    }
+			}
+
+			str = buffer + offset;
+			size = count;
+
+			/*
+			 * Trim trailing nulls and spaces, if necessary.
+			 */
+
+			if (cmd == 'A') {
+			    while (size > 0) {
+				if (str[size-1] != '\0' && str[size-1] != ' ') {
+				    break;
+				}
+				size--;
+			    }
+			}
+			valuePtr = Tcl_NewStringObj(str, size);
+			resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
+				valuePtr,
+				TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+			if (resultPtr == NULL) {
+			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
+			    return TCL_ERROR;
+			}
+			offset += count;
+			break;
+		    case 'b':
+		    case 'B': {
+			char *dest;
+
+			if (arg >= objc) {
+			    goto badIndex;
+			}
+			if (count == BINARY_ALL) {
+			    count = (length - offset)*8;
+			} else {
+			    if (count == BINARY_NOCOUNT) {
+				count = 1;
+			    }
+			    if (count > (length - offset)*8) {
+				goto done;
+			    }
+			}
+			str = buffer + offset;
+			valuePtr = Tcl_NewObj();
+			Tcl_SetObjLength(valuePtr, count);
+			dest = Tcl_GetStringFromObj(valuePtr, NULL);
+
+			if (cmd == 'b') {
+			    for (i = 0; i < count; i++) {
+				if (i % 8) {
+				    value >>= 1;
+				} else {
+				    value = *str++;
+				}
+				*dest++ = (char) ((value & 1) ? '1' : '0');
+			    }
+			} else {
+			    for (i = 0; i < count; i++) {
+				if (i % 8) {
+				    value <<= 1;
+				} else {
+				    value = *str++;
+				}
+				*dest++ = (char) ((value & 0x80) ? '1' : '0');
+			    }
+			}
+			
+			resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
+				valuePtr,
+				TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+			if (resultPtr == NULL) {
+			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
+			    return TCL_ERROR;
+			}
+			offset += (count + 7 ) / 8;
+			break;
+		    }
+		    case 'h':
+		    case 'H': {
+			char *dest;
+			int i;
+			static char hexdigit[] = "0123456789abcdef";
+
+			if (arg >= objc) {
+			    goto badIndex;
+			}
+			if (count == BINARY_ALL) {
+			    count = (length - offset)*2;
+			} else {
+			    if (count == BINARY_NOCOUNT) {
+				count = 1;
+			    }
+			    if (count > (length - offset)*2) {
+				goto done;
+			    }
+			}
+			str = buffer + offset;
+			valuePtr = Tcl_NewObj();
+			Tcl_SetObjLength(valuePtr, count);
+			dest = Tcl_GetStringFromObj(valuePtr, NULL);
+
+			if (cmd == 'h') {
+			    for (i = 0; i < count; i++) {
+				if (i % 2) {
+				    value >>= 4;
+				} else {
+				    value = *str++;
+				}
+				*dest++ = hexdigit[value & 0xf];
+			    }
+			} else {
+			    for (i = 0; i < count; i++) {
+				if (i % 2) {
+				    value <<= 4;
+				} else {
+				    value = *str++;
+				}
+				*dest++ = hexdigit[(value >> 4) & 0xf];
+			    }
+			}
+			
+			resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
+				valuePtr,
+				TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+			if (resultPtr == NULL) {
+			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
+			    return TCL_ERROR;
+			}
+			offset += (count + 1) / 2;
+			break;
+		    }
+		    case 'c':
+			size = 1;
+			goto scanNumber;
+		    case 's':
+		    case 'S':
+			size = 2;
+			goto scanNumber;
+		    case 'i':
+		    case 'I':
+			size = 4;
+			goto scanNumber;
+		    case 'f':
+			size = sizeof(float);
+			goto scanNumber;
+		    case 'd':
+			size = sizeof(double);
+			/* fall through */
+		    scanNumber:
+			if (arg >= objc) {
+			    goto badIndex;
+			}
+			if (count == BINARY_NOCOUNT) {
+			    if ((length - offset) < size) {
+				goto done;
+			    }
+			    valuePtr = ScanNumber(buffer+offset, cmd);
+			    offset += size;
+			} else {
+			    if (count == BINARY_ALL) {
+				count = (length - offset) / size;
+			    }
+			    if ((length - offset) < (count * size)) {
+				goto done;
+			    }
+			    valuePtr = Tcl_NewObj();
+			    str = buffer+offset;
+			    for (i = 0; i < count; i++) {
+				elementPtr = ScanNumber(str, cmd);
+				str += size;
+				Tcl_ListObjAppendElement(NULL, valuePtr,
+					elementPtr);
+			    }
+			    offset += count*size;
+			}
+
+			resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
+				valuePtr,
+				TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+			if (resultPtr == NULL) {
+			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
+			    return TCL_ERROR;
+			}
+			break;
+		    case 'x':
+			if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			if ((count == BINARY_ALL)
+				|| (count > (length - offset))) {
+			    offset = length;
+			} else {
+			    offset += count;
+			}
+			break;
+		    case 'X':
+			if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			if ((count == BINARY_ALL) || (count > offset)) {
+			    offset = 0;
+			} else {
+			    offset -= count;
+			}
+			break;
+		    case '@':
+			if (count == BINARY_NOCOUNT) {
+			    goto badCount;
+			}
+			if ((count == BINARY_ALL) || (count > length)) {
+			    offset = length;
+			} else {
+			    offset = count;
+			}
+			break;
+		    default: {
+			char buf[2];
+			
+			Tcl_ResetResult(interp);
+			buf[0] = cmd;
+			buf[1] = '\0';
+			Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+				"bad field specifier \"", buf, "\"", NULL);
+			return TCL_ERROR;
+		    }
+		}
+	    }
+
+	    /*
+	     * Set the result to the last position of the cursor.
+	     */
+
+	    done:
+	    Tcl_ResetResult(interp);
+	    Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
+	    break;
+	}
+    }
+    return TCL_OK;
+
+    badValue:
+    Tcl_ResetResult(interp);
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
+	    " string but got \"", errorValue, "\" instead", NULL);
+    return TCL_ERROR;
+
+    badCount:
+    errorString = "missing count for \"@\" field specifier";
+    goto error;
+
+    badIndex:
+    errorString = "not enough arguments for all format specifiers";
+    goto error;
+
+    error:
+    Tcl_ResetResult(interp);
+    Tcl_AppendToObj(Tcl_GetObjResult(interp), errorString, -1);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFormatSpec --
+ *
+ *	This function parses the format strings used in the binary
+ *	format and scan commands.
+ *
+ * Results:
+ *	Moves the formatPtr to the start of the next command. Returns
+ *	the current command character and count in cmdPtr and countPtr.
+ *	The count is set to BINARY_ALL if the count character was '*'
+ *	or BINARY_NOCOUNT if no count was specified.  Returns 1 on
+ *	success, or 0 if the string did not have a format specifier.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFormatSpec(formatPtr, cmdPtr, countPtr)
+    char **formatPtr;		/* Pointer to format string. */
+    char *cmdPtr;		/* Pointer to location of command char. */
+    int *countPtr;		/* Pointer to repeat count value. */
+{
+    /*
+     * Skip any leading blanks.
+     */
+
+    while (**formatPtr == ' ') {
+	(*formatPtr)++;
+    }
+
+    /*
+     * The string was empty, except for whitespace, so fail.
+     */
+
+    if (!(**formatPtr)) {
+	return 0;
+    }
+
+    /*
+     * Extract the command character and any trailing digits or '*'.
+     */
+
+    *cmdPtr = **formatPtr;
+    (*formatPtr)++;
+    if (**formatPtr == '*') {
+	(*formatPtr)++;
+	(*countPtr) = BINARY_ALL;
+    } else if (isdigit(**formatPtr)) {
+	(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
+    } else {
+	(*countPtr) = BINARY_NOCOUNT;
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatNumber --
+ *
+ *	This routine is called by Tcl_BinaryObjCmd to format a number
+ *	into a location pointed at by cursor.
+ *
+ * Results:
+ *	 A standard Tcl result.
+ *
+ * Side effects:
+ *	Moves the cursor to the next location to be written into.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FormatNumber(interp, type, src, cursorPtr)
+    Tcl_Interp *interp;		/* Current interpreter, used to report
+				 * errors. */
+    int type;			/* Type of number to format. */
+    Tcl_Obj *src;		/* Number to format. */
+    char **cursorPtr;		/* Pointer to index into destination buffer. */
+{
+    int value;
+    double dvalue;
+    char cmd = (char)type;
+
+    if (cmd == 'd' || cmd == 'f') {
+	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (cmd == 'd') {
+	    *((double *)(*cursorPtr)) = dvalue;
+	    (*cursorPtr) += sizeof(double);
+	} else {
+	    /*
+	     * Because some compilers will generate floating point exceptions
+	     * on an overflow cast (e.g. Borland), we restrict the values
+	     * to the valid range for float.
+	     */
+
+	    if (dvalue > FLT_MAX) {
+		*((float *)(*cursorPtr)) = FLT_MAX;
+	    } else if (dvalue < FLT_MIN) {
+		*((float *)(*cursorPtr)) = FLT_MIN;
+	    } else {
+		*((float *)(*cursorPtr)) = (float)dvalue;
+	    }
+	    (*cursorPtr) += sizeof(float);
+	}
+    } else {
+	if (Tcl_GetIntFromObj(interp, src, &value) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (cmd == 'c') {
+	    *(*cursorPtr)++ = (char)(value & 0xff);
+	} else if (cmd == 's') {
+	    *(*cursorPtr)++ = (char)(value & 0xff);
+	    *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
+	} else if (cmd == 'S') {
+	    *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
+	    *(*cursorPtr)++ = (char)(value & 0xff);
+	} else if (cmd == 'i') {
+	    *(*cursorPtr)++ = (char)(value & 0xff);
+	    *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
+	    *(*cursorPtr)++ = (char)((value >> 16) & 0xff);
+	    *(*cursorPtr)++ = (char)((value >> 24) & 0xff);
+	} else if (cmd == 'I') {
+	    *(*cursorPtr)++ = (char)((value >> 24) & 0xff);
+	    *(*cursorPtr)++ = (char)((value >> 16) & 0xff);
+	    *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
+	    *(*cursorPtr)++ = (char)(value & 0xff);
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScanNumber --
+ *
+ *	This routine is called by Tcl_BinaryObjCmd to scan a number
+ *	out of a buffer.
+ *
+ * Results:
+ *	Returns a newly created object containing the scanned number.
+ *	This object has a ref count of zero.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ScanNumber(buffer, type)
+    char *buffer;		/* Buffer to scan number from. */
+    int type;			/* Type of number to scan. */
+{
+    int c;
+
+    switch ((char) type) {
+	case 'c':
+	    /*
+	     * Characters need special handling.  We want to produce a
+	     * signed result, but on some platforms (such as AIX) chars
+	     * are unsigned.  To deal with this, check for a value that
+	     * should be negative but isn't.
+	     */
+
+	    c = buffer[0];
+	    if (c > 127) {
+		c -= 256;
+	    }
+	    return Tcl_NewIntObj(c);
+	case 's':
+	    return Tcl_NewIntObj((short)(((unsigned char)buffer[0])
+		    + ((unsigned char)buffer[1] << 8)));
+	case 'S':
+	    return Tcl_NewIntObj((short)(((unsigned char)buffer[1])
+		    + ((unsigned char)buffer[0] << 8)));
+	case 'i':
+	    return Tcl_NewIntObj((long) (((unsigned char)buffer[0])
+		    + ((unsigned char)buffer[1] << 8)
+		    + ((unsigned char)buffer[2] << 16)
+		    + ((unsigned char)buffer[3] << 24)));
+	case 'I':
+	    return Tcl_NewIntObj((long) (((unsigned char)buffer[3])
+		    + ((unsigned char)buffer[2] << 8)
+		    + ((unsigned char)buffer[1] << 16)
+		    + ((unsigned char)buffer[0] << 24)));
+	case 'f':
+	    return Tcl_NewDoubleObj(*(float*)buffer);
+	case 'd':
+	    return Tcl_NewDoubleObj(*(double*)buffer);
+    }
+    return NULL;
+}
diff --git a/contrib/tcl/generic/tclCkalloc.c b/contrib/tcl/generic/tclCkalloc.c
index 62744a6..e32eb3ac 100644
--- a/contrib/tcl/generic/tclCkalloc.c
+++ b/contrib/tcl/generic/tclCkalloc.c
@@ -12,19 +12,16 @@
  *
  * This code contributed by Karl Lehenbauer and Mark Diekhans
  *
- *
- * SCCS: @(#) tclCkalloc.c 1.20 96/06/06 13:48:27
+ * SCCS: @(#) tclCkalloc.c 1.28 97/04/30 12:09:04
  */
 
 #include "tclInt.h"
+#include "tclPort.h"
 
 #define FALSE	0
 #define TRUE	1
 
 #ifdef TCL_MEM_DEBUG
-#ifndef TCL_GENERIC_ONLY
-#include "tclPort.h"
-#endif
 
 /*
  * One of the following structures is allocated each time the
@@ -110,17 +107,20 @@ static int  init_malloced_bodies = TRUE;
 
 static int		MemoryCmd _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int argc, char **argv));
+static void		ValidateMemory _ANSI_ARGS_((
+			    struct mem_header *memHeaderP, char *file,
+			    int line, int nukeGuards));
 
 /*
  *----------------------------------------------------------------------
  *
- * dump_memory_info --
+ * TclDumpMemoryInfo --
  *     Display the global memory management statistics.
  *
  *----------------------------------------------------------------------
  */
-static void
-dump_memory_info(outFile) 
+void
+TclDumpMemoryInfo(outFile) 
     FILE *outFile;
 {
         fprintf(outFile,"total mallocs             %10d\n", 
@@ -146,7 +146,7 @@ dump_memory_info(outFile)
  *----------------------------------------------------------------------
  */
 static void
-ValidateMemory (memHeaderP, file, line, nukeGuards)
+ValidateMemory(memHeaderP, file, line, nukeGuards)
     struct mem_header *memHeaderP;
     char              *file;
     int                line;
@@ -161,18 +161,18 @@ ValidateMemory (memHeaderP, file, line, nukeGuards)
         byte = *(memHeaderP->low_guard + idx);
         if (byte != GUARD_VALUE) {
             guard_failed = TRUE;
-            fflush (stdout);
+            fflush(stdout);
 	    byte &= 0xff;
             fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", idx, byte,
 		    (isprint(UCHAR(byte)) ? byte : ' '));
         }
     }
     if (guard_failed) {
-        dump_memory_info (stderr);
-        fprintf (stderr, "low guard failed at %lx, %s %d\n",
+        TclDumpMemoryInfo (stderr);
+        fprintf(stderr, "low guard failed at %lx, %s %d\n",
                  (long unsigned int) memHeaderP->body, file, line);
-        fflush (stderr);  /* In case name pointer is bad. */
-        fprintf (stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
+        fflush(stderr);  /* In case name pointer is bad. */
+        fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
 		memHeaderP->file, memHeaderP->line);
         panic ("Memory validation failure");
     }
@@ -190,14 +190,14 @@ ValidateMemory (memHeaderP, file, line, nukeGuards)
     }
 
     if (guard_failed) {
-        dump_memory_info (stderr);
-        fprintf (stderr, "high guard failed at %lx, %s %d\n",
+        TclDumpMemoryInfo (stderr);
+        fprintf(stderr, "high guard failed at %lx, %s %d\n",
                  (long unsigned int) memHeaderP->body, file, line);
-        fflush (stderr);  /* In case name pointer is bad. */
-        fprintf (stderr, "%ld bytes allocated at (%s %d)\n",
+        fflush(stderr);  /* In case name pointer is bad. */
+        fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
 		memHeaderP->length, memHeaderP->file,
 		memHeaderP->line);
-        panic ("Memory validation failure");
+        panic("Memory validation failure");
     }
 
     if (nukeGuards) {
@@ -223,7 +223,7 @@ Tcl_ValidateAllMemory (file, line)
     struct mem_header *memScanP;
 
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
-        ValidateMemory (memScanP, file, line, FALSE);
+        ValidateMemory(memScanP, file, line, FALSE);
 
 }
 
@@ -252,7 +252,7 @@ Tcl_DumpActiveMemory (fileName)
 
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
         address = &memScanP->body [0];
-        fprintf (fileP, "%8lx - %8lx  %7ld @ %s %d %s",
+        fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
 		(long unsigned int) address,
                  (long unsigned int) address + memScanP->length - 1,
 		 memScanP->length, memScanP->file, memScanP->line,
@@ -292,11 +292,11 @@ Tcl_DbCkalloc(size, file, line)
     if (validate_memory)
         Tcl_ValidateAllMemory (file, line);
 
-    result = (struct mem_header *)malloc((unsigned)size + 
+    result = (struct mem_header *) TclpAlloc((unsigned)size + 
                               sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     if (result == NULL) {
         fflush(stdout);
-        dump_memory_info(stderr);
+        TclDumpMemoryInfo(stderr);
         panic("unable to alloc %d bytes, %s line %d", size, file, 
               line);
     }
@@ -401,9 +401,9 @@ Tcl_DbCkfree(ptr, file, line)
 		(long unsigned int) memp->body, memp->length, file, line);
 
     if (validate_memory)
-        Tcl_ValidateAllMemory (file, line);
+        Tcl_ValidateAllMemory(file, line);
 
-    ValidateMemory (memp, file, line, TRUE);
+    ValidateMemory(memp, file, line, TRUE);
     if (init_malloced_bodies) {
 	memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
     }
@@ -415,7 +415,7 @@ Tcl_DbCkfree(ptr, file, line)
     if (memp->tagPtr != NULL) {
 	memp->tagPtr->refCount--;
 	if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
-	    free((char *) memp->tagPtr);
+	    TclpFree((char *) memp->tagPtr);
 	}
     }
 
@@ -428,7 +428,7 @@ Tcl_DbCkfree(ptr, file, line)
         memp->blink->flink = memp->flink;
     if (allocHead == memp)
         allocHead = memp->flink;
-    free((char *) memp);
+    TclpFree((char *) memp);
     return 0;
 }
 
@@ -463,7 +463,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
 	    (((unsigned long) ptr) - BODY_OFFSET);
 
     copySize = size;
-    if (copySize > memp->length) {
+    if (copySize > (unsigned int) memp->length) {
 	copySize = memp->length;
     }
     new = Tcl_DbCkalloc(size, file, line);
@@ -571,19 +571,22 @@ MemoryCmd (clientData, interp, argc, argv)
 	return TCL_OK;
     }
     if (strcmp(argv[1],"break_on_malloc") == 0) {
-        if (argc != 3) 
+        if (argc != 3) {
             goto argError;
-        if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK)
-                return TCL_ERROR;
+	}
+        if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+	    return TCL_ERROR;
+	}
         return TCL_OK;
     }
     if (strcmp(argv[1],"info") == 0) {
-        dump_memory_info(stdout);
+        TclDumpMemoryInfo(stdout);
         return TCL_OK;
     }
     if (strcmp(argv[1],"init") == 0) {
-        if (argc != 3)
+        if (argc != 3) {
             goto bad_suboption;
+	}
         init_malloced_bodies = (strcmp(argv[2],"on") == 0);
         return TCL_OK;
     }
@@ -594,30 +597,34 @@ MemoryCmd (clientData, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
-	    free((char *) curTagPtr);
+	    TclpFree((char *) curTagPtr);
 	}
-	curTagPtr = (MemTag *) malloc(TAG_SIZE(strlen(argv[2])));
+	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
 	curTagPtr->refCount = 0;
 	strcpy(curTagPtr->string, argv[2]);
 	return TCL_OK;
     }
     if (strcmp(argv[1],"trace") == 0) {
-        if (argc != 3) 
+        if (argc != 3) {
             goto bad_suboption;
+	}
         alloc_tracing = (strcmp(argv[2],"on") == 0);
         return TCL_OK;
     }
 
     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
-        if (argc != 3) 
+        if (argc != 3) {
             goto argError;
-        if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK)
-                return TCL_ERROR;
-         return TCL_OK;
+	}
+        if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
     }
     if (strcmp(argv[1],"validate") == 0) {
-        if (argc != 3)
-             goto bad_suboption;
+        if (argc != 3) {
+	    goto bad_suboption;
+	}
         validate_memory = (strcmp(argv[2],"on") == 0);
         return TCL_OK;
     }
@@ -661,7 +668,7 @@ Tcl_InitMemory(interp)
  *----------------------------------------------------------------------
  *
  * Tcl_Alloc --
- *     Interface to malloc when TCL_MEM_DEBUG is disabled.  It does check
+ *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does check
  *     that memory was actually allocated.
  *
  *----------------------------------------------------------------------
@@ -673,7 +680,7 @@ Tcl_Alloc (size)
 {
         char *result;
 
-        result = malloc(size);
+        result = TclpAlloc(size);
         if (result == NULL) 
                 panic("unable to alloc %d bytes", size);
         return result;
@@ -687,7 +694,7 @@ Tcl_DbCkalloc(size, file, line)
 {
     char *result;
 
-    result = (char *) malloc(size);
+    result = (char *) TclpAlloc(size);
 
     if (result == NULL) {
         fflush(stdout);
@@ -702,8 +709,8 @@ Tcl_DbCkalloc(size, file, line)
  *----------------------------------------------------------------------
  *
  * Tcl_Realloc --
- *     Interface to realloc when TCL_MEM_DEBUG is disabled.  It does check
- *     that memory was actually allocated.
+ *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does 
+ *     check that memory was actually allocated.
  *
  *----------------------------------------------------------------------
  */
@@ -715,7 +722,7 @@ Tcl_Realloc(ptr, size)
 {
     char *result;
 
-    result = realloc(ptr, size);
+    result = TclpRealloc(ptr, size);
     if (result == NULL) 
 	panic("unable to realloc %d bytes", size);
     return result;
@@ -730,7 +737,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
 {
     char *result;
 
-    result = (char *) realloc(ptr, size);
+    result = (char *) TclpRealloc(ptr, size);
 
     if (result == NULL) {
         fflush(stdout);
@@ -744,8 +751,8 @@ Tcl_DbCkrealloc(ptr, size, file, line)
  *----------------------------------------------------------------------
  *
  * Tcl_Free --
- *     Interface to free when TCL_MEM_DEBUG is disabled.  Done here rather
- *     in the macro to keep some modules from being compiled with 
+ *     Interface to TclpFree when TCL_MEM_DEBUG is disabled.  Done here
+ *     rather in the macro to keep some modules from being compiled with 
  *     TCL_MEM_DEBUG enabled and some with it disabled.
  *
  *----------------------------------------------------------------------
@@ -755,7 +762,7 @@ void
 Tcl_Free (ptr)
     char *ptr;
 {
-        free (ptr);
+        TclpFree(ptr);
 }
 
 int
@@ -764,7 +771,7 @@ Tcl_DbCkfree(ptr, file, line)
     char     *file;
     int       line;
 {
-    free (ptr);
+    TclpFree(ptr);
     return 0;
 }
 
@@ -792,14 +799,14 @@ extern void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
 			    int line));
 
 int
-Tcl_DumpActiveMemory (fileName)
+Tcl_DumpActiveMemory(fileName)
     char *fileName;
 {
     return TCL_OK;
 }
 
 void
-Tcl_ValidateAllMemory (file, line)
+Tcl_ValidateAllMemory(file, line)
     char  *file;
     int    line;
 {
diff --git a/contrib/tcl/generic/tclClock.c b/contrib/tcl/generic/tclClock.c
index 3eaf99a..c6cb924 100644
--- a/contrib/tcl/generic/tclClock.c
+++ b/contrib/tcl/generic/tclClock.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclClock.c 1.20 96/07/23 16:14:45
+ * SCCS: @(#) tclClock.c 1.36 97/06/02 10:14:17
  */
 
 #include "tcl.h"
@@ -25,13 +25,11 @@
 static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
 			    unsigned long clockVal, int useGMT,
 			    char *format));
-static int		ParseTime _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *string, unsigned long *timePtr));
 
 /*
- *-----------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  *
- * Tcl_ClockCmd --
+ * Tcl_ClockObjCmd --
  *
  *	This procedure is invoked to process the "clock" Tcl command.
  *	See the user documentation for details on what it does.
@@ -42,211 +40,158 @@ static int		ParseTime _ANSI_ARGS_((Tcl_Interp *interp,
  * Side effects:
  *	See the user documentation.
  *
- *-----------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  */
 
 int
-Tcl_ClockCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
+Tcl_ClockObjCmd (client, interp, objc, objv)
+    ClientData client;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument values. */
 {
-    int c;
-    size_t length;
-    char **argPtr;
+    Tcl_Obj *resultPtr;
+    int index;
+    Tcl_Obj *CONST *objPtr;
     int useGMT = 0;
-    unsigned long clockVal;
+    char *format = "%a %b %d %X %Z %Y";
+    int dummy;
+    unsigned long baseClock, clockVal;
+    long zone;
+    Tcl_Obj *baseObjPtr = NULL;
+    char *scanStr;
     
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option ?arg ...?\"", (char *) NULL);
+    static char *switches[] =
+	    {"clicks", "format", "scan", "seconds", (char *) NULL};
+    static char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
+    static char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
+
+    resultPtr = Tcl_GetObjResult(interp);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
-    c = argv[1][0];
-    length = strlen(argv[1]);
-    if ((c == 'c') && (strncmp(argv[1], "clicks", length) == 0)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
-		    argv[0], " clicks\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	sprintf(interp->result, "%lu", TclpGetClicks());
-	return TCL_OK;
-    } else if ((c == 'f') && (strncmp(argv[1], "format", length) == 0)) {
-	char *format = "%a %b %d %X %Z %Y";
-	
-	if ((argc < 3) || (argc > 7)) {
-	    wrongFmtArgs:
-	    Tcl_AppendResult(interp, "wrong # args: ", argv [0], 
-		    " format clockval ?-format string? ?-gmt boolean?",
-		    (char *) NULL);
-	    return TCL_ERROR;
-	}
 
-	if (ParseTime(interp, argv[2], &clockVal) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch (index) {
+	case 0:			/* clicks */
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "clicks");
+		return TCL_ERROR;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
+	    return TCL_OK;
+	case 1:			/* format */
+	    if ((objc < 3) || (objc > 7)) {
+		wrongFmtArgs:
+		Tcl_WrongNumArgs(interp, 1, objv,
+			"format clockval ?-format string? ?-gmt boolean?");
+		return TCL_ERROR;
+	    }
 
-	argPtr = argv+3;
-	argc -= 3;
-	while ((argc > 1) && (argPtr[0][0] == '-')) {
-	    if (strcmp(argPtr[0], "-format") == 0) {
-	        format = argPtr[1];
-	    } else if (strcmp(argPtr[0], "-gmt") == 0) {
-		if (Tcl_GetBoolean(interp, argPtr[1], &useGMT) != TCL_OK) {
+	    if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal)
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+    
+	    objPtr = objv+3;
+	    objc -= 3;
+	    while (objc > 1) {
+		if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
+			"switch", 0, &index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-	    } else {
-		Tcl_AppendResult(interp, "bad option \"", argPtr[0],
-			"\": must be -format or -gmt", (char *) NULL);
+		switch (index) {
+		    case 0:		/* -format */
+			format = Tcl_GetStringFromObj(objPtr[1], &dummy);
+			break;
+		    case 1:		/* -gmt */
+			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
+				&useGMT) != TCL_OK) {
+			    return TCL_ERROR;
+			}
+			break;
+		}
+		objPtr += 2;
+		objc -= 2;
+	    }
+	    if (objc != 0) {
+		goto wrongFmtArgs;
+	    }
+	    return FormatClock(interp, (unsigned long) clockVal, useGMT,
+		    format);
+	case 2:			/* scan */
+	    if ((objc < 3) || (objc > 7)) {
+		wrongScanArgs:
+		Tcl_WrongNumArgs(interp, 1, objv,
+			"scan dateString ?-base clockValue? ?-gmt boolean?");
 		return TCL_ERROR;
 	    }
-	    argPtr += 2;
-	    argc -= 2;
-	}
-	if (argc != 0) {
-	    goto wrongFmtArgs;
-	}
-
-	return FormatClock(interp, clockVal, useGMT, format);
-    } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0)) {
-	unsigned long baseClock;
-	long zone;
-	char * baseStr = NULL;
 
-	if ((argc < 3) || (argc > 7)) {
-	    wrongScanArgs:
-	    Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
-		    " scan dateString ?-base clockValue? ?-gmt boolean?",
-		    (char *) NULL);
-	    return TCL_ERROR;
-	}
+	    objPtr = objv+3;
+	    objc -= 3;
+	    while (objc > 1) {
+		if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
+			"switch", 0, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		switch (index) {
+		    case 0:		/* -base */
+			baseObjPtr = objPtr[1];
+			break;
+		    case 1:		/* -gmt */
+			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
+				&useGMT) != TCL_OK) {
+			    return TCL_ERROR;
+			}
+			break;
+		}
+		objPtr += 2;
+		objc -= 2;
+	    }
+	    if (objc != 0) {
+		goto wrongScanArgs;
+	    }
 
-	argPtr = argv+3;
-	argc -= 3;
-	while ((argc > 1) && (argPtr[0][0] == '-')) {
-	    if (strcmp(argPtr[0], "-base") == 0) {
-	        baseStr = argPtr[1];
-	    } else if (strcmp(argPtr[0], "-gmt") == 0) {
-		if (Tcl_GetBoolean(interp, argPtr[1], &useGMT) != TCL_OK) {
+	    if (baseObjPtr != NULL) {
+		if (Tcl_GetLongFromObj(interp, baseObjPtr,
+			(long*) &baseClock) != TCL_OK) {
 		    return TCL_ERROR;
 		}
 	    } else {
-		Tcl_AppendResult(interp, "bad option \"", argPtr[0],
-			"\": must be -base or -gmt", (char *) NULL);
-		return TCL_ERROR;
+		baseClock = TclpGetSeconds();
 	    }
-	    argPtr += 2;
-	    argc -= 2;
-	}
-	if (argc != 0) {
-	    goto wrongScanArgs;
-	}
-	
-	if (baseStr != NULL) {
-	    if (ParseTime(interp, baseStr, &baseClock) != TCL_OK)
-		return TCL_ERROR;
-	} else {
-	    baseClock = TclpGetSeconds();
-	}
-
-	if (useGMT) {
-	    zone = -50000; /* Force GMT */
-	} else {
-	    zone = TclpGetTimeZone(baseClock);
-	}
-
-	if (TclGetDate(argv[2], baseClock, zone, &clockVal) < 0) {
-	    Tcl_AppendResult(interp, "unable to convert date-time string \"",
-		    argv[2], "\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-
-	sprintf(interp->result, "%lu", (long) clockVal);
-	return TCL_OK;
-    } else if ((c == 's') && (strncmp(argv[1], "seconds", length) == 0)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
-		    argv[0], " seconds\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	sprintf(interp->result, "%lu", TclpGetSeconds());
-	return TCL_OK;
-    } else {
-	Tcl_AppendResult(interp, "unknown option \"", argv[1],
-		"\": must be clicks, format, scan, or seconds",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * ParseTime --
- *
- *      Given a string, produce the corresponding time_t value.
- *
- * Results:
- *      The return value is normally TCL_OK;  in this case *timePtr
- *      will be set to the integer value equivalent to string.  If
- *      string is improperly formed then TCL_ERROR is returned and
- *      an error message will be left in interp->result.
- *
- * Side effects:
- *      None.
- *
- *-----------------------------------------------------------------------------
- */
 
-static int
-ParseTime(interp, string, timePtr)
-    Tcl_Interp *interp;
-    char *string;
-    unsigned long *timePtr;
-{
-    char *end, *p;
-    unsigned long  i;
+	    if (useGMT) {
+		zone = -50000; /* Force GMT */
+	    } else {
+		zone = TclpGetTimeZone((unsigned long) baseClock);
+	    }
 
-    /*
-     * Since some strtoul functions don't detect negative numbers, check
-     * in advance.
-     */
-    errno = 0;
-    for (p = (char *) string; isspace(UCHAR(*p)); p++) {
-        /* Empty loop body. */
-    }
-    if (*p == '+') {
-        p++;
-    }
-    i = strtoul(p, &end, 0);
-    if (end == p) {
-        goto badTime;
-    }
-    if (errno == ERANGE) {
-	interp->result = "integer value too large to represent";
-	Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-		interp->result, (char *) NULL);
-	return TCL_ERROR;
-    }
-    while ((*end != '\0') && isspace(UCHAR(*end))) {
-        end++;
-    }
-    if (*end != '\0') {
-        goto badTime;
-    }
+	    scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
+	    if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
+		    (unsigned long *) &clockVal) < 0) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"unable to convert date-time string \"",
+			scanStr, "\"", (char *) NULL);
+		return TCL_ERROR;
+	    }
 
-    *timePtr = (time_t) i;
-    if (*timePtr != i) {
-        goto badTime;
+	    Tcl_SetLongObj(resultPtr, (long) clockVal);
+	    return TCL_OK;
+	case 3:			/* seconds */
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "seconds");
+		return TCL_ERROR;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
+	    return TCL_OK;
+	default:
+	    return TCL_ERROR;	/* Should never be reached. */
     }
-    return TCL_OK;
-
-  badTime:
-    Tcl_AppendResult (interp, "expected unsigned time but got \"", 
-                      string, "\"", (char *) NULL);
-    return TCL_ERROR;
 }
 
 /*
@@ -281,7 +226,9 @@ FormatClock(interp, clockVal, useGMT, format)
     int savedTimeZone;
     char *savedTZEnv;
 #endif
+    Tcl_Obj *resultPtr;
 
+    resultPtr = Tcl_GetObjResult(interp);
 #ifdef HAVE_TZSET
     /*
      * Some systems forgot to call tzset in localtime, make sure its done.
@@ -323,7 +270,7 @@ FormatClock(interp, clockVal, useGMT, format)
      * based on the number of percents in the string.
      */
 
-    for (bufSize = 0, p = format; *p != '\0'; p++) {
+    for (bufSize = 1, p = format; *p != '\0'; p++) {
 	if (*p == '%') {
 	    bufSize += 40;
 	} else {
@@ -333,10 +280,10 @@ FormatClock(interp, clockVal, useGMT, format)
     Tcl_DStringInit(&buffer);
     Tcl_DStringSetLength(&buffer, bufSize);
 
-    if (TclStrftime(buffer.string, (unsigned int) bufSize, format,
-	    timeDataPtr) == 0) {
-	Tcl_DStringFree(&buffer);
-	Tcl_AppendResult(interp, "bad format string", (char *)NULL);
+    if ((TclStrftime(buffer.string, (unsigned int) bufSize, format,
+	    timeDataPtr) == 0) && (*format != '\0')) {
+	Tcl_AppendStringsToObj(resultPtr, "bad format string \"",
+		format, "\"", (char *) NULL);
 	return TCL_ERROR;
     }
 
@@ -353,7 +300,8 @@ FormatClock(interp, clockVal, useGMT, format)
     }
 #endif
 
-    Tcl_DStringResult(interp, &buffer);
+    Tcl_SetStringObj(resultPtr, buffer.string, -1);
+    Tcl_DStringFree(&buffer);
     return TCL_OK;
 }
 
diff --git a/contrib/tcl/generic/tclCmdAH.c b/contrib/tcl/generic/tclCmdAH.c
index 6b76d82..46384c9 100644
--- a/contrib/tcl/generic/tclCmdAH.c
+++ b/contrib/tcl/generic/tclCmdAH.c
@@ -6,12 +6,12 @@
  *	A to H.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclCmdAH.c 1.111 96/07/30 09:33:59
+ * SCCS: @(#) tclCmdAH.c 1.146 97/06/26 13:45:20
  */
 
 #include "tclInt.h"
@@ -33,6 +33,10 @@ static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
  *	This procedure is invoked to process the "break" Tcl command.
  *	See the user documentation for details on what it does.
  *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "break" or the name
+ *	to which "break" was renamed: e.g., "set z break; $z"
+ *
  * Results:
  *	A standard Tcl result.
  *
@@ -61,13 +65,13 @@ Tcl_BreakCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CaseCmd --
+ * Tcl_CaseObjCmd --
  *
  *	This procedure is invoked to process the "case" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -77,57 +81,64 @@ Tcl_BreakCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_CaseCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_CaseObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int i, result;
-    int body;
-    char *string;
-    int caseArgc, splitArgs;
-    char **caseArgv;
-
-    if (argc < 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " string ?in? patList body ... ?default body?\"",
-		(char *) NULL);
+    register int i;
+    int body, result;
+    char *string, *arg;
+    int argLen, caseObjc;
+    Tcl_Obj *CONST *caseObjv;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"string ?in? patList body ... ?default body?");
 	return TCL_ERROR;
     }
-    string = argv[1];
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    string = Tcl_GetStringFromObj(objv[1], &argLen);
     body = -1;
-    if (strcmp(argv[2], "in") == 0) {
+
+    arg = Tcl_GetStringFromObj(objv[2], &argLen);
+    if (strcmp(arg, "in") == 0) {
 	i = 3;
     } else {
 	i = 2;
     }
-    caseArgc = argc - i;
-    caseArgv = argv + i;
+    caseObjc = objc - i;
+    caseObjv = objv + i;
 
     /*
      * If all of the pattern/command pairs are lumped into a single
      * argument, split them out again.
+     * THIS FAILS IF THE ARG'S STRING REP CONTAINS A NULL
      */
 
-    splitArgs = 0;
-    if (caseArgc == 1) {
-	result = Tcl_SplitList(interp, caseArgv[0], &caseArgc, &caseArgv);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	splitArgs = 1;
+    if (caseObjc == 1) {
+	Tcl_Obj **newObjv;
+	
+	Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+	caseObjv = newObjv;
     }
 
-    for (i = 0; i < caseArgc; i += 2) {
-	int patArgc, j;
-	char **patArgv;
+    for (i = 0;  i < caseObjc;  i += 2) {
+	int patObjc, j;
+	char **patObjv;
+	char *pat;
 	register char *p;
 
-	if (i == (caseArgc-1)) {
-	    interp->result = "extra case pattern with no body";
-	    result = TCL_ERROR;
-	    goto cleanup;
+	if (i == (caseObjc-1)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "extra case pattern with no body", -1);
+	    return TCL_ERROR;
 	}
 
 	/*
@@ -135,79 +146,76 @@ Tcl_CaseCmd(dummy, interp, argc, argv)
 	 * no backslash sequences.
 	 */
 
-	for (p = caseArgv[i]; *p != 0; p++) {
+	pat = Tcl_GetStringFromObj(caseObjv[i], &argLen);
+	for (p = pat;  *p != 0;  p++) {	/* FAILS IF NULL BYTE */
 	    if (isspace(UCHAR(*p)) || (*p == '\\')) {
 		break;
 	    }
 	}
 	if (*p == 0) {
-	    if ((*caseArgv[i] == 'd')
-		    && (strcmp(caseArgv[i], "default") == 0)) {
+	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
 		body = i+1;
 	    }
-	    if (Tcl_StringMatch(string, caseArgv[i])) {
+	    if (Tcl_StringMatch(string, pat)) {
 		body = i+1;
 		goto match;
 	    }
 	    continue;
 	}
 
+
 	/*
 	 * Break up pattern lists, then check each of the patterns
 	 * in the list.
 	 */
 
-	result = Tcl_SplitList(interp, caseArgv[i], &patArgc, &patArgv);
+	result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
 	if (result != TCL_OK) {
-	    goto cleanup;
+	    return result;
 	}
-	for (j = 0; j < patArgc; j++) {
-	    if (Tcl_StringMatch(string, patArgv[j])) {
+	for (j = 0; j < patObjc; j++) {
+	    if (Tcl_StringMatch(string, patObjv[j])) {
 		body = i+1;
 		break;
 	    }
 	}
-	ckfree((char *) patArgv);
-	if (j < patArgc) {
+	ckfree((char *) patObjv);
+	if (j < patObjc) {
 	    break;
 	}
     }
 
     match:
     if (body != -1) {
-	result = Tcl_Eval(interp, caseArgv[body]);
+	result = Tcl_EvalObj(interp, caseObjv[body]);
 	if (result == TCL_ERROR) {
 	    char msg[100];
-	    sprintf(msg, "\n    (\"%.50s\" arm line %d)", caseArgv[body-1],
-		    interp->errorLine);
-	    Tcl_AddErrorInfo(interp, msg);
+	    
+	    arg = Tcl_GetStringFromObj(caseObjv[body-1], &argLen);
+	    sprintf(msg, "\n    (\"%.*s\" arm line %d)", argLen, arg,
+	            interp->errorLine);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
 	}
-	goto cleanup;
+	return result;
     }
 
     /*
-     * Nothing matched:  return nothing.
+     * Nothing matched: return nothing.
      */
 
-    result = TCL_OK;
-
-    cleanup:
-    if (splitArgs) {
-	ckfree((char *) caseArgv);
-    }
-    return result;
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CatchCmd --
+ * Tcl_CatchObjCmd --
  *
- *	This procedure is invoked to process the "catch" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "catch" Tcl 
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -217,29 +225,45 @@ Tcl_CaseCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_CatchCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_CatchObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int result;
 
-    if ((argc != 2) && (argc != 3)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " command ?varName?\"", (char *) NULL);
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
 	return TCL_ERROR;
     }
-    result = Tcl_Eval(interp, argv[1]);
-    if (argc == 3) {
-	if (Tcl_SetVar(interp, argv[2], interp->result, 0) == NULL) {
-	    Tcl_SetResult(interp, "couldn't save command result in variable",
-		    TCL_STATIC);
+
+    /*
+     * Save a pointer to the variable name object, if any, in case the
+     * Tcl_EvalObj reallocates the bytecode interpreter's evaluation
+     * stack rendering objv invalid.
+     */
+    
+    result = Tcl_EvalObj(interp, objv[1]);
+    if (objc == 3) {
+	if (Tcl_ObjSetVar2(interp, objv[2], NULL, Tcl_GetObjResult(interp),
+                    TCL_PARSE_PART1) == NULL) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),  
+	            "couldn't save command result in variable", -1);
 	    return TCL_ERROR;
 	}
     }
+
+    /*
+     * Set the interpreter's object result to an integer object holding the
+     * integer Tcl_EvalObj result. Note that we don't bother generating a
+     * string representation. We reset the interpreter's object result
+     * to an unshared empty object and then set it to be an integer object.
+     */
+
     Tcl_ResetResult(interp);
-    sprintf(interp->result, "%d", result);
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
     return TCL_OK;
 }
 
@@ -295,13 +319,13 @@ Tcl_CdCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ConcatCmd --
+ * Tcl_ConcatObjCmd --
  *
- *	This procedure is invoked to process the "concat" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "concat" Tcl
+ *	command. See the user documentation for details on what it does/
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -311,15 +335,14 @@ Tcl_CdCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ConcatCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ConcatObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    if (argc >= 2) {
-	interp->result = Tcl_Concat(argc-1, argv+1);
-	interp->freeProc = TCL_DYNAMIC;
+    if (objc >= 2) {
+	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
     }
     return TCL_OK;
 }
@@ -327,11 +350,15 @@ Tcl_ConcatCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ContinueCmd --
+ * Tcl_ContinueCmd -
  *
  *	This procedure is invoked to process the "continue" Tcl command.
  *	See the user documentation for details on what it does.
  *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "continue" or the name
+ *	to which "continue" was renamed: e.g., "set z continue; $z"
+ *
  * Results:
  *	A standard Tcl result.
  *
@@ -360,13 +387,13 @@ Tcl_ContinueCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ErrorCmd --
+ * Tcl_ErrorObjCmd --
  *
  *	This procedure is invoked to process the "error" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -376,42 +403,52 @@ Tcl_ContinueCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ErrorCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ErrorObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *namePtr;
+    char *info;
+    int infoLen;
 
-    if ((argc < 2) || (argc > 4)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" message ?errorInfo? ?errorCode?\"", (char *) NULL);
+    if ((objc < 2) || (objc > 4)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
 	return TCL_ERROR;
     }
-    if ((argc >= 3) && (argv[2][0] != 0)) {
-	Tcl_AddErrorInfo(interp, argv[2]);
-	iPtr->flags |= ERR_ALREADY_LOGGED;
+    
+    if (objc >= 3) {		/* process the optional info argument */
+	info = Tcl_GetStringFromObj(objv[2], &infoLen);
+	if (*info != 0) {
+	    Tcl_AddObjErrorInfo(interp, info, infoLen);
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
+	}
     }
-    if (argc == 4) {
-	Tcl_SetVar2(interp, "errorCode", (char *) NULL, argv[3],
+    
+    if (objc == 4) {
+	namePtr = Tcl_NewStringObj("errorCode", -1);
+	Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, objv[3],
 		TCL_GLOBAL_ONLY);
 	iPtr->flags |= ERROR_CODE_SET;
+	Tcl_DecrRefCount(namePtr); /* we're done with name object */
     }
-    Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
+    
+    Tcl_SetObjResult(interp, objv[1]);
     return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalCmd --
+ * Tcl_EvalObjCmd --
  *
- *	This procedure is invoked to process the "eval" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "eval" Tcl 
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -421,37 +458,36 @@ Tcl_ErrorCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_EvalCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_EvalObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int result;
-    char *cmd;
+    register Tcl_Obj *objPtr;
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" arg ?arg ...?\"", (char *) NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
 	return TCL_ERROR;
     }
-    if (argc == 2) {
-	result = Tcl_Eval(interp, argv[1]);
-    } else {
     
+    if (objc == 2) {
+	result = Tcl_EvalObj(interp, objv[1]);
+    } else {
 	/*
-	 * More than one argument:  concatenate them together with spaces
+	 * More than one argument: concatenate them together with spaces
 	 * between, then evaluate the result.
 	 */
     
-	cmd = Tcl_Concat(argc-1, argv+1);
-	result = Tcl_Eval(interp, cmd);
-	ckfree(cmd);
+	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+	result = Tcl_EvalObj(interp, objPtr);
+	TclDecrRefCount(objPtr);  /* we're done with the object */
     }
     if (result == TCL_ERROR) {
 	char msg[60];
 	sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
-	Tcl_AddErrorInfo(interp, msg);
+	Tcl_AddObjErrorInfo(interp, msg, -1);
     }
     return result;
 }
@@ -459,13 +495,13 @@ Tcl_EvalCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ExitCmd --
+ * Tcl_ExitObjCmd --
  *
  *	This procedure is invoked to process the "exit" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -475,22 +511,22 @@ Tcl_EvalCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ExitCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ExitObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int value;
 
-    if ((argc != 1) && (argc != 2)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" ?returnCode?\"", (char *) NULL);
+    if ((objc != 1) && (objc != 2)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
 	return TCL_ERROR;
     }
-    if (argc == 1) {
+    
+    if (objc == 1) {
 	value = 0;
-    } else if (Tcl_GetInt(interp, argv[1], &value) != TCL_OK) {
+    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
 	return TCL_ERROR;
     }
     Tcl_Exit(value);
@@ -501,13 +537,20 @@ Tcl_ExitCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ExprCmd --
+ * Tcl_ExprObjCmd --
  *
- *	This procedure is invoked to process the "expr" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "expr" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is called in two
+ *	circumstances: 1) to execute expr commands that are too complicated
+ *	or too unsafe to try compiling directly into an inline sequence of
+ *	instructions, and 2) to execute commands where the command name is
+ *	computed at runtime and is "expr" or the name to which "expr" was
+ *	renamed (e.g., "set z expr; $z 2+3")
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -517,42 +560,71 @@ Tcl_ExitCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ExprCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ExprObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    Tcl_DString buffer;
-    int i, result;
+    register Tcl_Obj *objPtr;
+    Tcl_Obj *resultPtr;
+    register char *bytes;
+    int length, i, result;
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" arg ?arg ...?\"", (char *) NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
 	return TCL_ERROR;
     }
 
-    if (argc == 2) {
-	return Tcl_ExprString(interp, argv[1]);
+    if (objc == 2) {
+	result = Tcl_ExprObj(interp, objv[1], &resultPtr);
+	if (result == TCL_OK) {
+	    Tcl_SetObjResult(interp, resultPtr);
+	    Tcl_DecrRefCount(resultPtr);  /* done with the result object */
+	}
     }
-    Tcl_DStringInit(&buffer);
-    Tcl_DStringAppend(&buffer, argv[1], -1);
-    for (i = 2; i < argc; i++) {
-	Tcl_DStringAppend(&buffer, " ", 1);
-	Tcl_DStringAppend(&buffer, argv[i], -1);
+
+    /*
+     * Create a new object holding the concatenated argument strings.
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    bytes = Tcl_GetStringFromObj(objv[1], &length);
+    objPtr = Tcl_NewStringObj(bytes, length);
+    Tcl_IncrRefCount(objPtr);
+    for (i = 2;  i < objc;  i++) {
+	Tcl_AppendToObj(objPtr, " ", 1);
+	bytes = Tcl_GetStringFromObj(objv[i], &length);
+	Tcl_AppendToObj(objPtr, bytes, length);
     }
-    result = Tcl_ExprString(interp, buffer.string);
-    Tcl_DStringFree(&buffer);
+
+    /*
+     * Evaluate the concatenated string object.
+     */
+
+    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result == TCL_OK) {
+	Tcl_SetObjResult(interp, resultPtr);
+	Tcl_DecrRefCount(resultPtr);  /* done with the result object */
+    }
+
+    /*
+     * Free allocated resources.
+     */
+    
+    TclDecrRefCount(objPtr);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FileCmd --
+ * Tcl_FileObjCmd --
  *
  *	This procedure is invoked to process the "file" Tcl command.
  *	See the user documentation for details on what it does.
+ *	PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH
+ *	EMBEDDED NULLS, WHICH COULD THEORETICALLY HAPPEN ON A MAC.
  *
  * Results:
  *	A standard Tcl result.
@@ -565,387 +637,492 @@ Tcl_ExprCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_FileCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_FileObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    char *fileName, *extension;
-    int c, statOp, result;
-    size_t length;
+    char *fileName, *extension, *errorString;
+    int statOp = 0;		/* Init. to avoid compiler warning. */
+    int length;
     int mode = 0;			/* Initialized only to prevent
 					 * compiler warning message. */
     struct stat statBuf;
     Tcl_DString buffer;
+    Tcl_Obj *resultPtr;
+    int index, result;
 
-    if (argc < 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option name ?arg ...?\"", (char *) NULL);
-	return TCL_ERROR;
+/*
+ * This list of constants should match the fileOption string array below.
+ */
+
+enum {FILE_ATIME, FILE_ATTRIBUTES, FILE_COPY, FILE_DELETE, FILE_DIRNAME,
+	FILE_EXECUTABLE, FILE_EXISTS, FILE_EXTENSION, FILE_ISDIRECTORY,
+	FILE_ISFILE, FILE_JOIN, FILE_LSTAT, FILE_MTIME, FILE_MKDIR,
+	FILE_NATIVENAME, FILE_OWNED, FILE_PATHTYPE, FILE_READABLE,
+	FILE_READLINK, FILE_RENAME, FILE_ROOTNAME, FILE_SIZE, FILE_SPLIT,
+	FILE_STAT, FILE_TAIL, FILE_TYPE, FILE_VOLUMES, FILE_WRITABLE};
+
+
+    static char *fileOptions[] = {"atime", "attributes", "copy", "delete", 
+    	    "dirname", "executable", "exists", "extension", "isdirectory", 
+    	    "isfile", "join", "lstat", "mtime", "mkdir", "nativename", 
+    	    "owned", "pathtype", "readable", "readlink", "rename",
+    	    "rootname", "size", "split", "stat", "tail", "type", "volumes", 
+    	    "writable", (char *) NULL};
+
+    if (objc < 2) {
+    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+        return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0, &index)
+	    != TCL_OK) {
+    	return TCL_ERROR;
     }
-    c = argv[1][0];
-    length = strlen(argv[1]);
+    
     result = TCL_OK;
+    /* 
+     * First, do the volumes command, since it is the only one that
+     * has objc == 2.
+     */
+	
+    if ( index == FILE_VOLUMES) {
+        if ( objc != 2 ) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "volumes");
+	    return TCL_ERROR;
+	}
+	result = TclpListVolumes(interp);
+	return result;
+    }
+    
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "name ?arg ...?");
+	return TCL_ERROR;
+    }
+
     Tcl_DStringInit(&buffer);
+    resultPtr = Tcl_GetObjResult(interp);
+    
 
     /*
-     * First handle operations on the file name.
+     * Handle operations on the file name.
      */
+    
+    switch (index) {
+        case FILE_ATTRIBUTES:
+            result = TclFileAttrsCmd(interp, objc - 2, objv + 2);
+    	    goto done;
+    	case FILE_DIRNAME:	{
+    	    int pargc;
+	    char **pargv;
+
+	    if (objc != 3) {
+	    	errorString = "dirname name";
+	    	goto not3Args;
+	    }
 
-    if ((c == 'd') && (strncmp(argv[1], "dirname", length) == 0)) {
-	int pargc;
-	char **pargv;
-
-	if (argc != 3) {
-	    argv[1] = "dirname";
-	    goto not3Args;
-	}
-
-	fileName = argv[2];
+	    fileName = Tcl_GetStringFromObj(objv[2], &length);
 
-	/*
-	 * If there is only one element, and it starts with a tilde,
-	 * perform tilde substitution and resplit the path.
-	 */
+	    /*
+	     * If there is only one element, and it starts with a tilde,
+	     * perform tilde substitution and resplit the path.
+	     */
 
-	Tcl_SplitPath(fileName, &pargc, &pargv);
-	if ((pargc == 1) && (*fileName == '~')) {
-	    ckfree((char*) pargv);
-	    fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
-	    if (fileName == NULL) {
-		result = TCL_ERROR;
-		goto done;
-	    }
 	    Tcl_SplitPath(fileName, &pargc, &pargv);
-	    Tcl_DStringSetLength(&buffer, 0);
-	}
+	    if ((pargc == 1) && (*fileName == '~')) {
+	        ckfree((char*) pargv);
+	        fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
+	        if (fileName == NULL) {
+		    result = TCL_ERROR;
+		    goto done;
+	        }
+	        Tcl_SplitPath(fileName, &pargc, &pargv);
+	        Tcl_DStringSetLength(&buffer, 0);
+	    }
 
-	/*
-	 * Return all but the last component.  If there is only one
-	 * component, return it if the path was non-relative, otherwise
-	 * return the current directory.
-	 */
+	    /*
+	     * Return all but the last component.  If there is only one
+	     * component, return it if the path was non-relative, otherwise
+	     * return the current directory.
+	     */
 
-	if (pargc > 1) {
-	    Tcl_JoinPath(pargc-1, pargv, &buffer);
-	    Tcl_DStringResult(interp, &buffer);
-	} else if ((pargc == 0)
-		|| (Tcl_GetPathType(pargv[0]) == TCL_PATH_RELATIVE)) {
-	    Tcl_SetResult(interp,
-		    (tclPlatform == TCL_PLATFORM_MAC) ? ":" : ".", TCL_STATIC);
-	} else {
-	    Tcl_SetResult(interp, pargv[0], TCL_VOLATILE);
+	    if (pargc > 1) {
+	    	Tcl_JoinPath(pargc-1, pargv, &buffer);
+	    	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buffer),
+	    		buffer.length);
+	    } else if ((pargc == 0)
+		    || (Tcl_GetPathType(pargv[0]) == TCL_PATH_RELATIVE)) {
+		Tcl_SetStringObj(resultPtr, (tclPlatform == TCL_PLATFORM_MAC)
+			? ":" : ".", 1);
+	    } else {
+	    	Tcl_SetStringObj(resultPtr, pargv[0], -1);	    }
+	    ckfree((char *)pargv);
+	    goto done;
 	}
-	ckfree((char *)pargv);
-	goto done;
+    	case FILE_TAIL: {
+	    int pargc;
+	    char **pargv;
 
-    } else if ((c == 't') && (strncmp(argv[1], "tail", length) == 0)
-	&& (length >= 2)) {
-	int pargc;
-	char **pargv;
+	    if (objc != 3) {
+	    	errorString = "tail name";
+	    	goto not3Args;
+	    }
+	    
+	    fileName = Tcl_GetStringFromObj(objv[2], &length);
 
-	if (argc != 3) {
-	    argv[1] = "tail";
-	    goto not3Args;
-	}
+	    /*
+	     * If there is only one element, and it starts with a tilde,
+	     * perform tilde substitution and resplit the path.
+	     */
 
-	fileName = argv[2];
+	    Tcl_SplitPath(fileName, &pargc, &pargv);
+	    if ((pargc == 1) && (*fileName == '~')) {
+	    	ckfree((char*) pargv);
+	    	fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
+	    	if (fileName == NULL) {
+		    result = TCL_ERROR;
+		    goto done;
+	        }
+	        Tcl_SplitPath(fileName, &pargc, &pargv);
+	        Tcl_DStringSetLength(&buffer, 0);
+	    }
 
-	/*
-	 * If there is only one element, and it starts with a tilde,
-	 * perform tilde substitution and resplit the path.
-	 */
+	    /*
+	     * Return the last component, unless it is the only component, and it
+	     * is the root of an absolute path.
+	     */
 
-	Tcl_SplitPath(fileName, &pargc, &pargv);
-	if ((pargc == 1) && (*fileName == '~')) {
-	    ckfree((char*) pargv);
-	    fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
-	    if (fileName == NULL) {
-		result = TCL_ERROR;
-		goto done;
+	    if (pargc > 0) {
+	    	if ((pargc > 1)
+		    	|| (Tcl_GetPathType(pargv[0]) == TCL_PATH_RELATIVE)) {
+		    Tcl_SetStringObj(resultPtr, pargv[pargc - 1], -1);
+	    	}
 	    }
-	    Tcl_SplitPath(fileName, &pargc, &pargv);
-	    Tcl_DStringSetLength(&buffer, 0);
+	    ckfree((char *)pargv);
+	    goto done;
 	}
-
-	/*
-	 * Return the last component, unless it is the only component, and it
-	 * is the root of an absolute path.
-	 */
-
-	if (pargc > 0) {
-	    if ((pargc > 1)
-		    || (Tcl_GetPathType(pargv[0]) == TCL_PATH_RELATIVE)) {
-		Tcl_SetResult(interp, pargv[pargc-1], TCL_VOLATILE);
+	case FILE_ROOTNAME: {
+	    char *fileName;
+	    
+	    if (objc != 3) {
+	    	errorString = "rootname name";
+	    	goto not3Args;
+	    }
+	    
+	    fileName = Tcl_GetStringFromObj(objv[2], &length);
+	    extension = TclGetExtension(fileName);
+	    if (extension == NULL) {
+	    	Tcl_SetObjResult(interp, objv[2]);
+	    } else {
+	        Tcl_SetStringObj(resultPtr, fileName,
+			(int) (length - strlen(extension)));
 	    }
+	    goto done;
 	}
-	ckfree((char *)pargv);
-	goto done;
+	case FILE_EXTENSION:
+	    if (objc != 3) {
+	    	errorString = "extension name";
+	    	goto not3Args;
+	    }
+	    extension = TclGetExtension(Tcl_GetStringFromObj(objv[2], &length));
 
-    } else if ((c == 'r') && (strncmp(argv[1], "rootname", length) == 0)
-	    && (length >= 2)) {
-	char tmp;
-	if (argc != 3) {
-	    argv[1] = "rootname";
-	    goto not3Args;
-	}
-	extension = TclGetExtension(argv[2]);
-	if (extension == NULL) {
-	    Tcl_SetResult(interp, argv[2], TCL_VOLATILE);
-	} else {
-	    tmp = *extension;
-	    *extension = 0;
-	    Tcl_SetResult(interp, argv[2], TCL_VOLATILE);
-	    *extension = tmp;
-	}
-	goto done;
-    } else if ((c == 'e') && (strncmp(argv[1], "extension", length) == 0)
-	    && (length >= 3)) {
-	if (argc != 3) {
-	    argv[1] = "extension";
-	    goto not3Args;
+	    if (extension != NULL) {
+	    	Tcl_SetStringObj(resultPtr, extension, (int) strlen(extension));
+	    }
+	    goto done;
+	case FILE_PATHTYPE:
+	    if (objc != 3) {
+	    	errorString = "pathtype name";
+	    	goto not3Args;
+	    }
+	    switch (Tcl_GetPathType(Tcl_GetStringFromObj(objv[2], &length))) {
+	    	case TCL_PATH_ABSOLUTE:
+	    	    Tcl_SetStringObj(resultPtr, "absolute", -1);
+		    break;
+	    	case TCL_PATH_RELATIVE:
+	    	    Tcl_SetStringObj(resultPtr, "relative", -1);
+	    	    break;
+	    	case TCL_PATH_VOLUME_RELATIVE:
+		    Tcl_SetStringObj(resultPtr, "volumerelative", -1);
+		    break;
+	    }
+	    goto done;
+	case FILE_SPLIT: {
+	    int pargc, i;
+	    char **pargvList;
+	    Tcl_Obj *listObjPtr;
+		
+	    if (objc != 3) {
+    	    	errorString = "split name";
+	    	goto not3Args;
+	    }
+		
+	    Tcl_SplitPath(Tcl_GetStringFromObj(objv[2], &length), &pargc,
+	    	    &pargvList);
+	    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+	    for (i = 0; i < pargc; i++) {
+	    	Tcl_ListObjAppendElement(interp, listObjPtr,
+			Tcl_NewStringObj(pargvList[i], -1));
+	    }
+	    ckfree((char *) pargvList);
+	    Tcl_SetObjResult(interp, listObjPtr);
+	    goto done;
 	}
-	extension = TclGetExtension(argv[2]);
-
-	if (extension != NULL) {
-	    Tcl_SetResult(interp, extension, TCL_VOLATILE);
+	case FILE_JOIN: {
+	    char **pargv = (char **) ckalloc((objc - 2) * sizeof(char *));
+	    int i;
+	    
+	    for (i = 2; i < objc; i++) {
+	    	pargv[i - 2] = Tcl_GetStringFromObj(objv[i], &length);
+	    }
+	    Tcl_JoinPath(objc - 2, pargv, &buffer);
+	    Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buffer), buffer.length);
+	    ckfree((char *) pargv);
+	    Tcl_DStringFree(&buffer);
+	    goto done;
 	}
-	goto done;
-    } else if ((c == 'p') && (strncmp(argv[1], "pathtype", length) == 0)) {
-	if (argc != 3) {
-	    argv[1] = "pathtype";
-	    goto not3Args;
+	case FILE_RENAME: {
+	    char **pargv = (char **) ckalloc(objc * sizeof(char *));
+	    int i;
+	    
+	    for (i = 0; i < objc; i++) {
+	    	pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+	    }
+	    result = TclFileRenameCmd(interp, objc, pargv);
+	    ckfree((char *) pargv);
+	    goto done;
 	}
-	switch (Tcl_GetPathType(argv[2])) {
-	    case TCL_PATH_ABSOLUTE:
-		Tcl_SetResult(interp, "absolute", TCL_STATIC);
-		break;
-	    case TCL_PATH_RELATIVE:
-		Tcl_SetResult(interp, "relative", TCL_STATIC);
-		break;
-	    case TCL_PATH_VOLUME_RELATIVE:
-		Tcl_SetResult(interp, "volumerelative", TCL_STATIC);
-		break;
+	case FILE_MKDIR: {
+	    char **pargv = (char **) ckalloc(objc * sizeof(char *));
+	    int i;
+	    
+	    for (i = 0; i < objc; i++) {
+	    	pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+	    }
+	    result = TclFileMakeDirsCmd(interp, objc, pargv);
+	    ckfree((char *) pargv);
+	    goto done;
 	}
-	goto done;
-    } else if ((c == 's') && (strncmp(argv[1], "split", length) == 0)
-	&& (length >= 2)) {
-	int pargc, i;
-	char **pargvList;
-
-	if (argc != 3) {
-	    argv[1] = "split";
-	    goto not3Args;
+	case FILE_DELETE: {
+	    char **pargv = (char **) ckalloc(objc * sizeof(char *));
+	    int i;
+	    
+	    for (i = 0; i < objc; i++) {
+	    	pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+	    }
+	    result = TclFileDeleteCmd(interp, objc, pargv);
+	    ckfree((char *) pargv);
+	    goto done;
 	}
-
-	Tcl_SplitPath(argv[2], &pargc, &pargvList);
-	for (i = 0; i < pargc; i++) {
-	    Tcl_AppendElement(interp, pargvList[i]);
+	case FILE_COPY: {
+	    char **pargv = (char **) ckalloc(objc * sizeof(char *));
+	    int i;
+	    
+	    for (i = 0; i < objc; i++) {
+	    	pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+	    }
+	    result = TclFileCopyCmd(interp, objc, pargv);
+	    ckfree((char *) pargv);
+	    goto done;
 	}
-	ckfree((char *) pargvList);
-	goto done;
-    } else if ((c == 'j') && (strncmp(argv[1], "join", length) == 0)) {
-	Tcl_JoinPath(argc-2, argv+2, &buffer);
-	Tcl_DStringResult(interp, &buffer);
-	goto done;
+	case FILE_NATIVENAME:
+	    fileName = Tcl_TranslateFileName(interp,
+	    	    Tcl_GetStringFromObj(objv[2], &length), &buffer);
+	    Tcl_SetStringObj(resultPtr, fileName, -1);
+	    goto done;
     }
-    
+
     /*
      * Next, handle operations that can be satisfied with the "access"
      * kernel call.
      */
 
-    fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
-    if (fileName == NULL) {
-	result = TCL_ERROR;
-	goto done;
-    }
-    if ((c == 'r') && (strncmp(argv[1], "readable", length) == 0)
-	    && (length >= 5)) {
-	if (argc != 3) {
-	    argv[1] = "readable";
-	    goto not3Args;
-	}
-	mode = R_OK;
-	checkAccess:
-	if (access(fileName, mode) == -1) {
-	    interp->result = "0";
-	} else {
-	    interp->result = "1";
-	}
-	goto done;
-    } else if ((c == 'w') && (strncmp(argv[1], "writable", length) == 0)) {
-	if (argc != 3) {
-	    argv[1] = "writable";
-	    goto not3Args;
-	}
-	mode = W_OK;
-	goto checkAccess;
-    } else if ((c == 'e') && (strncmp(argv[1], "executable", length) == 0)
-	    && (length >= 3)) {
-	if (argc != 3) {
-	    argv[1] = "executable";
-	    goto not3Args;
-	}
-	mode = X_OK;
-	goto checkAccess;
-    } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)
-	    && (length >= 3)) {
-	if (argc != 3) {
-	    argv[1] = "exists";
-	    goto not3Args;
-	}
-	mode = F_OK;
-	goto checkAccess;
+    fileName = Tcl_TranslateFileName(interp,
+	    Tcl_GetStringFromObj(objv[2], &length), &buffer);
+	
+    switch (index) {
+    	case FILE_READABLE:
+    	    if (objc != 3) {
+	    	errorString = "readable name";
+	    	goto not3Args;
+	    }
+	    mode = R_OK;
+checkAccess:
+	    Tcl_SetBooleanObj(resultPtr, !((fileName == NULL) 
+	    	    || (access(fileName, mode) == -1)));
+	    goto done;
+	  case FILE_WRITABLE:
+	    if (objc != 3) {
+	    	errorString = "writable name";
+	    	goto not3Args;
+	    }
+	    mode = W_OK;
+	    goto checkAccess;
+	  case FILE_EXECUTABLE:
+	    if (objc != 3) {
+	    	errorString = "executable name";
+	    	goto not3Args;
+	    }
+	    mode = X_OK;
+	    goto checkAccess;
+	  case FILE_EXISTS:
+	    if (objc != 3) {
+	    	errorString = "exists name";
+	    	goto not3Args;
+	    }
+	    mode = F_OK;
+	    goto checkAccess;
     }
 
+	
     /*
      * Lastly, check stuff that requires the file to be stat-ed.
      */
 
-    if ((c == 'a') && (strncmp(argv[1], "atime", length) == 0)) {
-	if (argc != 3) {
-	    argv[1] = "atime";
-	    goto not3Args;
-	}
-	if (stat(fileName, &statBuf) == -1) {
-	    goto badStat;
-	}
-	sprintf(interp->result, "%ld", (long) statBuf.st_atime);
+    if (fileName == NULL) {
+	result = TCL_ERROR;
 	goto done;
-    } else if ((c == 'i') && (strncmp(argv[1], "isdirectory", length) == 0)
-	    && (length >= 3)) {
-	if (argc != 3) {
-	    argv[1] = "isdirectory";
-	    goto not3Args;
-	}
-	statOp = 2;
-    } else if ((c == 'i') && (strncmp(argv[1], "isfile", length) == 0)
-	    && (length >= 3)) {
-	if (argc != 3) {
-	    argv[1] = "isfile";
-	    goto not3Args;
-	}
-	statOp = 1;
-    } else if ((c == 'l') && (strncmp(argv[1], "lstat", length) == 0)) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " lstat name varName\"", (char *) NULL);
-	    result = TCL_ERROR;
+    }
+    
+    switch (index) {
+    	case FILE_ATIME:
+    	    if (objc != 3) {
+	    	errorString = "atime name";
+	    	goto not3Args;
+	    }
+	    
+	    if (stat(fileName, &statBuf) == -1) {
+	    	goto badStat;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) statBuf.st_atime);
 	    goto done;
-	}
-
-	if (lstat(fileName, &statBuf) == -1) {
-	    Tcl_AppendResult(interp, "couldn't lstat \"", argv[2],
-		    "\": ", Tcl_PosixError(interp), (char *) NULL);
-	    result = TCL_ERROR;
+    	case FILE_ISDIRECTORY:
+    	    if (objc != 3) {
+    	    	errorString = "isdirectory name";
+    	    	goto not3Args;
+    	    }
+    	    statOp = 2;
+    	    break;
+    	case FILE_ISFILE:
+    	    if (objc != 3) {
+    	    	errorString = "isfile name";
+    	    	goto not3Args;
+    	    }
+    	    statOp = 1;
+    	    break;
+    	case FILE_LSTAT:
+    	    if (objc != 4) {
+    	    	Tcl_WrongNumArgs(interp, 1, objv, "lstat name varName");
+    	    	result = TCL_ERROR;
+    	    	goto done;
+    	    }
+    	    
+    	    if (lstat(fileName, &statBuf) == -1) {
+    	    	Tcl_AppendStringsToObj(resultPtr, "couldn't lstat \"",
+    	    		Tcl_GetStringFromObj(objv[2], &length), "\": ",
+    	    		Tcl_PosixError(interp), (char *) NULL);
+    	    	result = TCL_ERROR;
+    	    	goto done;
+    	    }
+    	    result = StoreStatData(interp, Tcl_GetStringFromObj(objv[3],
+    	    	    &length), &statBuf);
+    	    goto done;
+	case FILE_MTIME:
+	    if (objc != 3) {
+	    	errorString = "mtime name";
+	    	goto not3Args;
+	    }
+	    if (stat(fileName, &statBuf) == -1) {
+	    	goto badStat;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) statBuf.st_mtime);
 	    goto done;
-	}
-	result = StoreStatData(interp, argv[3], &statBuf);
-	goto done;
-    } else if ((c == 'm') && (strncmp(argv[1], "mtime", length) == 0)) {
-	if (argc != 3) {
-	    argv[1] = "mtime";
-	    goto not3Args;
-	}
-	if (stat(fileName, &statBuf) == -1) {
-	    goto badStat;
-	}
-	sprintf(interp->result, "%ld", (long) statBuf.st_mtime);
-	goto done;
-    } else if ((c == 'o') && (strncmp(argv[1], "owned", length) == 0)) {
-	if (argc != 3) {
-	    argv[1] = "owned";
-	    goto not3Args;
-	}
-	statOp = 0;
-    } else if ((c == 'r') && (strncmp(argv[1], "readlink", length) == 0)
-	    && (length >= 5)) {
-	char linkValue[MAXPATHLEN+1];
-	int linkLength;
-
-	if (argc != 3) {
-	    argv[1] = "readlink";
-	    goto not3Args;
-	}
+	case FILE_OWNED:
+	    if (objc != 3) {
+	    	errorString = "owned name";
+	    	goto not3Args;
+	    }	        	    
+    	    statOp = 0;
+    	    break;
+	case FILE_READLINK: {
+	    char linkValue[MAXPATHLEN + 1];
+	    int linkLength;
+		
+	    if (objc != 3) {
+	    	errorString = "readlink name";
+	        goto not3Args;
+	    }
 
-	/*
-	 * If S_IFLNK isn't defined it means that the machine doesn't
-	 * support symbolic links, so the file can't possibly be a
-	 * symbolic link.  Generate an EINVAL error, which is what
-	 * happens on machines that do support symbolic links when
-	 * you invoke readlink on a file that isn't a symbolic link.
-	 */
+	    /*
+	     * If S_IFLNK isn't defined it means that the machine doesn't
+	     * support symbolic links, so the file can't possibly be a
+	     * symbolic link.  Generate an EINVAL error, which is what
+	     * happens on machines that do support symbolic links when
+	     * you invoke readlink on a file that isn't a symbolic link.
+	     */
 
 #ifndef S_IFLNK
-	linkLength = -1;
-	errno = EINVAL;
+	    linkLength = -1;
+	    errno = EINVAL;
 #else
-	linkLength = readlink(fileName, linkValue, sizeof(linkValue) - 1);
+	    linkLength = readlink(fileName, linkValue, sizeof(linkValue) - 1);
 #endif /* S_IFLNK */
-	if (linkLength == -1) {
-	    Tcl_AppendResult(interp, "couldn't readlink \"", argv[2],
-		    "\": ", Tcl_PosixError(interp), (char *) NULL);
-	    result = TCL_ERROR;
+	    if (linkLength == -1) {
+	    	Tcl_AppendStringsToObj(resultPtr, "couldn't readlink \"", 
+	    		Tcl_GetStringFromObj(objv[2], &length), "\": ", 
+	    		Tcl_PosixError(interp), (char *) NULL);
+	    	result = TCL_ERROR;
+	    	goto done;
+	    }
+	    linkValue[linkLength] = 0;
+	    Tcl_SetStringObj(resultPtr, linkValue, linkLength);
 	    goto done;
 	}
-	linkValue[linkLength] = 0;
-	Tcl_SetResult(interp, linkValue, TCL_VOLATILE);
-	goto done;
-    } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 3) {
-	    argv[1] = "size";
-	    goto not3Args;
-	}
-	if (stat(fileName, &statBuf) == -1) {
-	    goto badStat;
-	}
-	sprintf(interp->result, "%lu", (unsigned long) statBuf.st_size);
-	goto done;
-    } else if ((c == 's') && (strncmp(argv[1], "stat", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " stat name varName\"", (char *) NULL);
-	    result = TCL_ERROR;
+	case FILE_SIZE:
+	    if (objc != 3) {
+	    	errorString = "size name";
+	    	goto not3Args;
+	    }
+	    if (stat(fileName, &statBuf) == -1) {
+	    	goto badStat;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) statBuf.st_size);
 	    goto done;
-	}
+	case FILE_STAT:
+	    if (objc != 4) {
+	    	Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
+	    	result = TCL_ERROR;
+	    	goto done;
+	    }
 
-	if (stat(fileName, &statBuf) == -1) {
-	    badStat:
-	    Tcl_AppendResult(interp, "couldn't stat \"", argv[2],
-		    "\": ", Tcl_PosixError(interp), (char *) NULL);
-	    result = TCL_ERROR;
+	    if (stat(fileName, &statBuf) == -1) {
+badStat:
+		Tcl_AppendStringsToObj(resultPtr, "couldn't stat \"", 
+			Tcl_GetStringFromObj(objv[2], &length),
+		    	"\": ", Tcl_PosixError(interp), (char *) NULL);
+	    	result = TCL_ERROR;
+	    	goto done;
+	    }
+	    result = StoreStatData(interp, Tcl_GetStringFromObj(objv[3],
+	    	    &length), &statBuf);
+	    goto done;
+	case FILE_TYPE:
+	    if (objc != 3) {
+	    	errorString = "type name";
+	    	goto not3Args;
+	    }
+	    if (lstat(fileName, &statBuf) == -1) {
+	    	goto badStat;
+	    }
+	    errorString = GetTypeFromMode((int) statBuf.st_mode);
+	    Tcl_SetStringObj(resultPtr, errorString, -1);
 	    goto done;
-	}
-	result = StoreStatData(interp, argv[3], &statBuf);
-	goto done;
-    } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 3) {
-	    argv[1] = "type";
-	    goto not3Args;
-	}
-	if (lstat(fileName, &statBuf) == -1) {
-	    goto badStat;
-	}
-	interp->result = GetTypeFromMode((int) statBuf.st_mode);
-	goto done;
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": should be atime, dirname, executable, exists, ",
-		"extension, isdirectory, isfile, join, ",
-		"lstat, mtime, owned, pathtype, readable, readlink, ",
-		"root, size, split, stat, tail, type, ",
-		"or writable",
-		(char *) NULL);
-	result = TCL_ERROR;
-	goto done;
     }
+
     if (stat(fileName, &statBuf) == -1) {
-	interp->result = "0";
+    	Tcl_SetBooleanObj(resultPtr, 0);
 	goto done;
     }
     switch (statOp) {
@@ -968,19 +1145,14 @@ Tcl_FileCmd(dummy, interp, argc, argv)
 	    mode = S_ISDIR(statBuf.st_mode);
 	    break;
     }
-    if (mode) {
-	interp->result = "1";
-    } else {
-	interp->result = "0";
-    }
+    Tcl_SetBooleanObj(resultPtr, mode);
 
-    done:
+done:
     Tcl_DStringFree(&buffer);
     return result;
 
-    not3Args:
-    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " name\"", (char *) NULL);
+not3Args:
+    Tcl_WrongNumArgs(interp, 1, objv, errorString);
     result = TCL_ERROR;
     goto done;
 }
@@ -1102,10 +1274,14 @@ GetTypeFromMode(mode)
 	return "blockSpecial";
     } else if (S_ISFIFO(mode)) {
 	return "fifo";
+#ifdef S_ISLNK
     } else if (S_ISLNK(mode)) {
 	return "link";
+#endif
+#ifdef S_ISSOCK
     } else if (S_ISSOCK(mode)) {
 	return "socket";
+#endif
     }
     return "unknown";
 }
@@ -1115,73 +1291,78 @@ GetTypeFromMode(mode)
  *
  * Tcl_ForCmd --
  *
- *	This procedure is invoked to process the "for" Tcl command.
- *	See the user documentation for details on what it does.
+ *      This procedure is invoked to process the "for" Tcl command.
+ *      See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "for" or the name
+ *	to which "for" was renamed: e.g.,
+ *	"set z for; $z {set i 0} {$i<100} {incr i} {puts $i}"
  *
  * Results:
- *	A standard Tcl result.
+ *      A standard Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *      See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
+        /* ARGSUSED */
 int
 Tcl_ForCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    ClientData dummy;                   /* Not used. */
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    int argc;                           /* Number of arguments. */
+    char **argv;                        /* Argument strings. */
 {
     int result, value;
 
     if (argc != 5) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" start test next command\"", (char *) NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " start test next command\"", (char *) NULL);
+        return TCL_ERROR;
     }
 
     result = Tcl_Eval(interp, argv[1]);
     if (result != TCL_OK) {
-	if (result == TCL_ERROR) {
-	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
-	}
-	return result;
+        if (result == TCL_ERROR) {
+            Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
+        }
+        return result;
     }
     while (1) {
-	result = Tcl_ExprBoolean(interp, argv[2], &value);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if (!value) {
-	    break;
-	}
-	result = Tcl_Eval(interp, argv[4]);
-	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
-	    if (result == TCL_ERROR) {
-		char msg[60];
-		sprintf(msg, "\n    (\"for\" body line %d)", interp->errorLine);
-		Tcl_AddErrorInfo(interp, msg);
-	    }
-	    break;
-	}
-	result = Tcl_Eval(interp, argv[3]);
+        result = Tcl_ExprBoolean(interp, argv[2], &value);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if (!value) {
+            break;
+        }
+        result = Tcl_Eval(interp, argv[4]);
+        if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+            if (result == TCL_ERROR) {
+                char msg[60];
+                sprintf(msg, "\n    (\"for\" body line %d)", interp->errorLine);
+                Tcl_AddErrorInfo(interp, msg);
+            }
+            break;
+        }
+        result = Tcl_Eval(interp, argv[3]);
 	if (result == TCL_BREAK) {
-	    break;
-	} else if (result != TCL_OK) {
-	    if (result == TCL_ERROR) {
-		Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
-	    }
-	    return result;
-	}
+            break;
+        } else if (result != TCL_OK) {
+            if (result == TCL_ERROR) {
+                Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
+            }
+            return result;
+        }
     }
     if (result == TCL_BREAK) {
-	result = TCL_OK;
+        result = TCL_OK;
     }
     if (result == TCL_OK) {
-	Tcl_ResetResult(interp);
+        Tcl_ResetResult(interp);
     }
     return result;
 }
@@ -1189,13 +1370,13 @@ Tcl_ForCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ForeachCmd --
+ * Tcl_ForeachObjCmd --
  *
- *	This procedure is invoked to process the "foreach" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "foreach" Tcl
+ *	command.  See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -1205,33 +1386,35 @@ Tcl_ForCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ForeachCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ForeachObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int result = TCL_OK;
     int i;			/* i selects a value list */
     int j, maxj;		/* Number of loop iterations */
     int v;			/* v selects a loop variable */
     int numLists;		/* Count of value lists */
+    Tcl_Obj *bodyPtr;
+	
 #define STATIC_SIZE 4
-    int indexArray[STATIC_SIZE];	/* Array of value list indices */
-    int varcListArray[STATIC_SIZE];	/* Number of loop variables per list */
-    char **varvListArray[STATIC_SIZE];	/* Array of variable name lists */
-    int argcListArray[STATIC_SIZE];	/* Array of value list sizes */
-    char **argvListArray[STATIC_SIZE];	/* Array of value lists */
+    int indexArray[STATIC_SIZE];	  /* Array of value list indices */
+    int varcListArray[STATIC_SIZE];	  /* # loop variables per list */
+    Tcl_Obj **varvListArray[STATIC_SIZE]; /* Array of variable name lists */
+    int argcListArray[STATIC_SIZE];	  /* Array of value list sizes */
+    Tcl_Obj **argvListArray[STATIC_SIZE]; /* Array of value lists */
 
     int *index = indexArray;
     int *varcList = varcListArray;
-    char ***varvList = varvListArray;
+    Tcl_Obj ***varvList = varvListArray;
     int *argcList = argcListArray;
-    char ***argvList = argvListArray;
+    Tcl_Obj ***argvList = argvListArray;
 
-    if (argc < 4 || (argc%2 != 0)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" varList list ?varList list ...? command\"", (char *) NULL);
+    if (objc < 4 || (objc%2 != 0)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"varList list ?varList list ...? command");
 	return TCL_ERROR;
     }
 
@@ -1243,36 +1426,47 @@ Tcl_ForeachCmd(dummy, interp, argc, argv)
      * index[i] is the current pointer into the value list argvList[i]
      */
 
-    numLists = (argc-2)/2;
+    numLists = (objc-2)/2;
     if (numLists > STATIC_SIZE) {
 	index = (int *) ckalloc(numLists * sizeof(int));
 	varcList = (int *) ckalloc(numLists * sizeof(int));
-	varvList = (char ***) ckalloc(numLists * sizeof(char **));
+	varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
 	argcList = (int *) ckalloc(numLists * sizeof(int));
-	argvList = (char ***) ckalloc(numLists * sizeof(char **));
+	argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
     }
-    for (i=0 ; i<numLists ; i++) {
+    for (i = 0;  i < numLists;  i++) {
 	index[i] = 0;
 	varcList[i] = 0;
-	varvList[i] = (char **)NULL;
+	varvList[i] = (Tcl_Obj **) NULL;
 	argcList[i] = 0;
-	argvList[i] = (char **)NULL;
+	argvList[i] = (Tcl_Obj **) NULL;
     }
 
     /*
      * Break up the value lists and variable lists into elements
+     * THIS FAILS IF THE OBJECT'S STRING REP HAS A NULL BYTE.
      */
 
     maxj = 0;
-    for (i=0 ; i<numLists ; i++) {
-	result = Tcl_SplitList(interp, argv[1+i*2], &varcList[i], &varvList[i]);
+    for (i = 0;  i < numLists;  i++) {
+	result = Tcl_ListObjGetElements(interp, objv[1+i*2],
+	        &varcList[i], &varvList[i]);
 	if (result != TCL_OK) {
-	    goto errorReturn;
+	    goto done;
+	}
+	if (varcList[i] < 1) {
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "foreach varlist is empty", -1);
+	    result = TCL_ERROR;
+	    goto done;
 	}
-	result = Tcl_SplitList(interp, argv[2+i*2], &argcList[i], &argvList[i]);
+	
+	result = Tcl_ListObjGetElements(interp, objv[2+i*2],
+	        &argcList[i], &argvList[i]);
 	if (result != TCL_OK) {
-	    goto errorReturn;
+	    goto done;
 	}
+	
 	j = argcList[i] / varcList[i];
 	if ((argcList[i] % varcList[i]) != 0) {
 	    j++;
@@ -1286,24 +1480,40 @@ Tcl_ForeachCmd(dummy, interp, argc, argv)
      * Iterate maxj times through the lists in parallel
      * If some value lists run out of values, set loop vars to ""
      */
-    for (j = 0; j < maxj; j++) {
-	for (i=0 ; i<numLists ; i++) {
-	    for (v=0 ; v<varcList[i] ; v++) {
+    
+    bodyPtr = objv[objc-1];
+    for (j = 0;  j < maxj;  j++) {
+	for (i = 0;  i < numLists;  i++) {
+	    for (v = 0;  v < varcList[i];  v++) {
 		int k = index[i]++;
-		char *value = "";
+		Tcl_Obj *valuePtr, *varValuePtr;
+		int isEmptyObj = 0;
+		
 		if (k < argcList[i]) {
-		    value = argvList[i][k];
+		    valuePtr = argvList[i][k];
+		} else {
+		    valuePtr = Tcl_NewObj(); /* empty string */
+		    isEmptyObj = 1;
 		}
-		if (Tcl_SetVar(interp, varvList[i][v], value, 0) == NULL) {
-		    Tcl_AppendResult(interp, "couldn't set loop variable: \"",
-			    varvList[i][v], "\"", (char *)NULL);
+		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL,
+			valuePtr, TCL_PARSE_PART1);
+		if (varValuePtr == NULL) {
+		    if (isEmptyObj) {
+			Tcl_DecrRefCount(valuePtr);
+		    }
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"couldn't set loop variable: \"",
+			Tcl_GetStringFromObj(varvList[i][v], (int *) NULL),
+			"\"", (char *) NULL);
 		    result = TCL_ERROR;
-		    goto errorReturn;
+		    goto done;
 		}
+
 	    }
 	}
 
-	result = Tcl_Eval(interp, argv[argc-1]);
+	result = Tcl_EvalObj(interp, bodyPtr);
 	if (result != TCL_OK) {
 	    if (result == TCL_CONTINUE) {
 		result = TCL_OK;
@@ -1314,7 +1524,7 @@ Tcl_ForeachCmd(dummy, interp, argc, argv)
 		char msg[100];
 		sprintf(msg, "\n    (\"foreach\" body line %d)",
 			interp->errorLine);
-		Tcl_AddErrorInfo(interp, msg);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
 		break;
 	    } else {
 		break;
@@ -1324,15 +1534,8 @@ Tcl_ForeachCmd(dummy, interp, argc, argv)
     if (result == TCL_OK) {
 	Tcl_ResetResult(interp);
     }
-errorReturn:
-    for (i=0 ; i<numLists ; i++) {
-	if (argvList[i] != (char **)NULL) {
-	    ckfree((char *) argvList[i]);
-	}
-	if (varvList[i] != (char **)NULL) {
-	    ckfree((char *) varvList[i]);
-	}
-    }
+
+    done:
     if (numLists > STATIC_SIZE) {
 	ckfree((char *) index);
 	ckfree((char *) varcList);
@@ -1340,8 +1543,8 @@ errorReturn:
 	ckfree((char *) varvList);
 	ckfree((char *) argvList);
     }
-#undef STATIC_SIZE
     return result;
+#undef STATIC_SIZE
 }
 
 /*
@@ -1534,7 +1737,7 @@ Tcl_FormatCmd(dummy, interp, argc, argv)
 	    width = 0;
 	}
 	if (width != 0) {
-	    sprintf(newPtr, "%d", width);
+	    TclFormatInt(newPtr, width);
 	    while (*newPtr != 0) {
 		newPtr++;
 	    }
@@ -1558,7 +1761,7 @@ Tcl_FormatCmd(dummy, interp, argc, argv)
 	    format++;
 	}
 	if (precision != 0) {
-	    sprintf(newPtr, "%d", precision);
+	    TclFormatInt(newPtr, precision);
 	    while (*newPtr != 0) {
 		newPtr++;
 	    }
@@ -1620,12 +1823,18 @@ Tcl_FormatCmd(dummy, interp, argc, argv)
 		}
 		break;
 	    case 0:
-		interp->result =
-			"format string ended in middle of field specifier";
+		Tcl_SetResult(interp,
+		        "format string ended in middle of field specifier",
+			TCL_STATIC);
 		goto fmtError;
 	    default:
-		sprintf(interp->result, "bad field specifier \"%c\"", *format);
-		goto fmtError;
+		{
+		    char buf[80];
+		    
+		    sprintf(buf, "bad field specifier \"%c\"", *format);
+		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    goto fmtError;
+		}
 	}
 	argIndex++;
 	format++;
@@ -1674,11 +1883,10 @@ Tcl_FormatCmd(dummy, interp, argc, argv)
 	}
     }
 
-    interp->result = dst;
     if (dstSpace != TCL_RESULT_SIZE) {
-	interp->freeProc = TCL_DYNAMIC;
+	Tcl_SetResult(interp, dst, TCL_DYNAMIC);
     } else {
-	interp->freeProc = 0;
+	Tcl_SetResult(interp, dst, TCL_STATIC);
     }
     return TCL_OK;
 
diff --git a/contrib/tcl/generic/tclCmdIL.c b/contrib/tcl/generic/tclCmdIL.c
index 0a3b25a..18342f3 100644
--- a/contrib/tcl/generic/tclCmdIL.c
+++ b/contrib/tcl/generic/tclCmdIL.c
@@ -7,12 +7,13 @@
  *	(i.e. those that don't depend much upon UNIX facilities).
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclCmdIL.c 1.120 96/07/10 17:16:03
+ * SCCS: @(#) tclCmdIL.c 1.163 97/06/13 18:16:52
  */
 
 #include "tclInt.h"
@@ -28,37 +29,126 @@
 char *tclExecutableName = NULL;
 
 /*
- * The variables below are used to implement the "lsort" command.
- * Unfortunately, this use of static variables prevents "lsort"
- * from being thread-safe, but there's no alternative given the
- * current implementation of qsort.  In a threaded environment
- * these variables should be made thread-local if possible, or else
- * "lsort" needs internal mutual exclusion.
+ * During execution of the "lsort" command, structures of the following
+ * type are used to arrange the objects being sorted into a collection
+ * of linked lists.
  */
 
-static Tcl_Interp *sortInterp = NULL;	/* Interpreter for "lsort" command. 
-					 * NULL means no lsort is active. */
-static enum {ASCII, INTEGER, REAL, COMMAND} sortMode;
-					/* Mode for sorting: compare as strings,
-					 * compare as numbers, or call
-					 * user-defined command for
-					 * comparison. */
-static Tcl_DString sortCmd;		/* Holds command if mode is COMMAND.
-					 * pre-initialized to hold base of
-					 * command. */
-static int sortIncreasing;		/* 0 means sort in decreasing order,
-					 * 1 means increasing order. */
-static int sortCode;			/* Anything other than TCL_OK means a
-					 * problem occurred while sorting; this
-					 * executing a comparison command, so
-					 * the sort was aborted. */
+typedef struct SortElement {
+    Tcl_Obj *objPtr;			/* Object being sorted. */
+    struct SortElement *nextPtr;        /* Next element in the list, or
+					 * NULL for end of list. */
+} SortElement;
+
+/*
+ * The "lsort" command needs to pass certain information down to the
+ * function that compares two list elements, and the comparison function
+ * needs to pass success or failure information back up to the top-level
+ * "lsort" command.  The following structure is used to pass this
+ * information.
+ */
+
+typedef struct SortInfo {
+    int isIncreasing;		/* Nonzero means sort in increasing order. */
+    int sortMode;		/* The sort mode.  One of SORTMODE_*
+				 * values defined below */
+    Tcl_DString compareCmd;	/* The Tcl comparison command when sortMode
+				 * is SORTMODE_COMMAND.  Pre-initialized to
+				 * hold base of command.*/
+    long index;			/* If the -index option was specified, this
+				 * holds the index of the list element
+				 * to extract for comparison.  If -index
+				 * wasn't specified, this is -1. */
+    Tcl_Interp *interp;		/* The interpreter in which the sortis
+				 * being done. */
+    int resultCode;		/* Completion code for the lsort command.
+				 * If an error occurs during the sort this
+				 * is changed from TCL_OK to  TCL_ERROR. */
+} SortInfo;
+
+/*
+ * The "sortMode" field of the SortInfo structure can take on any of the
+ * following values.
+ */
+
+#define SORTMODE_ASCII      0
+#define SORTMODE_INTEGER    1
+#define SORTMODE_REAL       2
+#define SORTMODE_COMMAND    3
+#define SORTMODE_DICTIONARY 4
 
 /*
  * Forward declarations for procedures defined in this file:
  */
 
-static int		SortCompareProc _ANSI_ARGS_((CONST VOID *first,
-			    CONST VOID *second));
+static int		DictionaryCompare _ANSI_ARGS_((char *left,
+			    char *right));
+static int		InfoArgsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoBodyCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoCmdCountCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoCommandsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoCompleteCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoDefaultCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoHostnameCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLevelCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLibraryCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLoadedCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoLocalsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoNameOfExecutableCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoPatchLevelCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoProcsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoScriptCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoSharedlibCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoTclVersionCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		InfoVarsCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static SortElement *    MergeSort _ANSI_ARGS_((SortElement *headPt,
+			    SortInfo *infoPtr));
+static SortElement *    MergeLists _ANSI_ARGS_((SortElement *leftPtr,
+			    SortElement *rightPtr, SortInfo *infoPtr));
+static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
+			    Tcl_Obj *second, SortInfo *infoPtr));
 
 /*
  *----------------------------------------------------------------------
@@ -68,6 +158,10 @@ static int		SortCompareProc _ANSI_ARGS_((CONST VOID *first,
  *	This procedure is invoked to process the "if" Tcl command.
  *	See the user documentation for details on what it does.
  *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "if" or the name
+ *	to which "if" was renamed: e.g., "set z if; $z 1 {puts foo}"
+ *
  * Results:
  *	A standard Tcl result.
  *
@@ -118,7 +212,7 @@ Tcl_IfCmd(dummy, interp, argc, argv)
 	if (value) {
 	    return Tcl_Eval(interp, argv[i]);
 	}
-
+	
 	/*
 	 * The expression evaluated to false.  Skip the command, then
 	 * see if there is an "else" or "elseif" clause.
@@ -161,6 +255,10 @@ Tcl_IfCmd(dummy, interp, argc, argv)
  *	This procedure is invoked to process the "incr" Tcl command.
  *	See the user documentation for details on what it does.
  *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "incr" or the name
+ *	to which "incr" was renamed: e.g., "set z incr; $z i -1"
+ *
  * Results:
  *	A standard Tcl result.
  *
@@ -209,19 +307,24 @@ Tcl_IncrCmd(dummy, interp, argc, argv)
 	}
 	value += increment;
     }
-    sprintf(newString, "%d", value);
+    TclFormatInt(newString, value);
     result = Tcl_SetVar(interp, argv[1], newString, TCL_LEAVE_ERR_MSG);
     if (result == NULL) {
 	return TCL_ERROR;
     }
-    interp->result = result;
+
+    /*
+     * Copy the result since the variable's value might change.
+     */
+    
+    Tcl_SetResult(interp, result, TCL_VOLATILE);
     return TCL_OK; 
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_InfoCmd --
+ * Tcl_InfoObjCmd --
  *
  *	This procedure is invoked to process the "info" Tcl command.
  *	See the user documentation for details on what it does.
@@ -237,434 +340,1394 @@ Tcl_IncrCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_InfoCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_InfoObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Arbitrary value passed to the command. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    static char *subCmds[] = {
+            "args", "body", "cmdcount", "commands",
+	     "complete", "default", "exists", "globals",
+	     "hostname", "level", "library", "loaded",
+	     "locals", "nameofexecutable", "patchlevel", "procs",
+	     "script", "sharedlibextension", "tclversion", "vars",
+	     (char *) NULL};
+    enum ISubCmdIdx {
+	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
+	    ICompleteIdx, IDefaultIdx, IExistsIdx, IGlobalsIdx,
+	    IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
+	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
+	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
+    } index;
+    int result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+        return TCL_ERROR;
+    }
+    
+    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
+	    (int *) &index);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    switch (index) {
+        case IArgsIdx:
+	    result = InfoArgsCmd(clientData, interp, objc, objv);
+            break;
+	case IBodyIdx:
+	    result = InfoBodyCmd(clientData, interp, objc, objv);
+	    break;
+	case ICmdCountIdx:
+	    result = InfoCmdCountCmd(clientData, interp, objc, objv);
+	    break;
+        case ICommandsIdx:
+	    result = InfoCommandsCmd(clientData, interp, objc, objv);
+	    break;
+        case ICompleteIdx:
+	    result = InfoCompleteCmd(clientData, interp, objc, objv);
+	    break;
+	case IDefaultIdx:
+	    result = InfoDefaultCmd(clientData, interp, objc, objv);
+	    break;
+	case IExistsIdx:
+	    result = InfoExistsCmd(clientData, interp, objc, objv);
+	    break;
+        case IGlobalsIdx:
+	    result = InfoGlobalsCmd(clientData, interp, objc, objv);
+	    break;
+        case IHostnameIdx:
+	    result = InfoHostnameCmd(clientData, interp, objc, objv);
+	    break;
+	case ILevelIdx:
+	    result = InfoLevelCmd(clientData, interp, objc, objv);
+	    break;
+	case ILibraryIdx:
+	    result = InfoLibraryCmd(clientData, interp, objc, objv);
+	    break;
+        case ILoadedIdx:
+	    result = InfoLoadedCmd(clientData, interp, objc, objv);
+	    break;
+        case ILocalsIdx:
+	    result = InfoLocalsCmd(clientData, interp, objc, objv);
+	    break;
+	case INameOfExecutableIdx:
+	    result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);
+	    break;
+	case IPatchLevelIdx:
+	    result = InfoPatchLevelCmd(clientData, interp, objc, objv);
+	    break;
+        case IProcsIdx:
+	    result = InfoProcsCmd(clientData, interp, objc, objv);
+	    break;
+        case IScriptIdx:
+	    result = InfoScriptCmd(clientData, interp, objc, objv);
+	    break;
+	case ISharedLibExtensionIdx:
+	    result = InfoSharedlibCmd(clientData, interp, objc, objv);
+	    break;
+	case ITclVersionIdx:
+	    result = InfoTclVersionCmd(clientData, interp, objc, objv);
+	    break;
+	case IVarsIdx:
+	    result = InfoVarsCmd(clientData, interp, objc, objv);
+	    break;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoArgsCmd --
+ *
+ *      Called to implement the "info args" command that returns the
+ *      argument list for a procedure. Handles the following syntax:
+ *
+ *          info args procName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoArgsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    size_t length;
-    int c;
-    Arg *argPtr;
+    char *name;
     Proc *procPtr;
-    Var *varPtr;
-    Command *cmdPtr;
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch search;
+    CompiledLocal *localPtr;
+    Tcl_Obj *listObjPtr;
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg ...?\"", (char *) NULL);
-	return TCL_ERROR;
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "args procname");
+        return TCL_ERROR;
     }
-    c = argv[1][0];
-    length = strlen(argv[1]);
-    if ((c == 'a') && (strncmp(argv[1], "args", length)) == 0) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " args procname\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	procPtr = TclFindProc(iPtr, argv[2]);
-	if (procPtr == NULL) {
-	    infoNoSuchProc:
-	    Tcl_AppendResult(interp, "\"", argv[2],
-		    "\" isn't a procedure", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	for (argPtr = procPtr->argPtr; argPtr != NULL;
-		argPtr = argPtr->nextPtr) {
-	    Tcl_AppendElement(interp, argPtr->name);
-	}
-	return TCL_OK;
-    } else if ((c == 'b') && (strncmp(argv[1], "body", length)) == 0) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " body procname\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	procPtr = TclFindProc(iPtr, argv[2]);
-	if (procPtr == NULL) {
-	    goto infoNoSuchProc;
-	}
-	iPtr->result = procPtr->command;
-	return TCL_OK;
-    } else if ((c == 'c') && (strncmp(argv[1], "cmdcount", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " cmdcount\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	sprintf(iPtr->result, "%d", iPtr->cmdCount);
-	return TCL_OK;
-    } else if ((c == 'c') && (strncmp(argv[1], "commands", length) == 0)
-	    && (length >= 4)) {
-	if (argc > 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " commands ?pattern?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	    char *name = Tcl_GetHashKey(&iPtr->commandTable, hPtr);
-	    if ((argc == 3) && !Tcl_StringMatch(name, argv[2])) {
-		continue;
-	    }
-	    Tcl_AppendElement(interp, name);
-	}
-	return TCL_OK;
-    } else if ((c == 'c') && (strncmp(argv[1], "complete", length) == 0)
-	    && (length >= 4)) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " complete command\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_CommandComplete(argv[2])) {
-	    interp->result = "1";
-	} else {
-	    interp->result = "0";
-	}
-	return TCL_OK;
-    } else if ((c == 'd') && (strncmp(argv[1], "default", length)) == 0) {
-	if (argc != 5) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " default procname arg varname\"",
-		    (char *) NULL);
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    procPtr = TclFindProc(iPtr, name);
+    if (procPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "\"", name, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Build a return list containing the arguments.
+     */
+    
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+            localPtr = localPtr->nextPtr) {
+        if (localPtr->isArg) {
+            Tcl_ListObjAppendElement(interp, listObjPtr,
+		    Tcl_NewStringObj(localPtr->name, -1));
+        }
+    }
+    Tcl_SetObjResult(interp, listObjPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoBodyCmd --
+ *
+ *      Called to implement the "info body" command that returns the body
+ *      for a procedure. Handles the following syntax:
+ *
+ *          info body procName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoBodyCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    char *name;
+    Proc *procPtr;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "body procname");
+        return TCL_ERROR;
+    }
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    procPtr = TclFindProc(iPtr, name);
+    if (procPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"\"", name, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, procPtr->bodyPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoCmdCountCmd --
+ *
+ *      Called to implement the "info cmdcount" command that returns the
+ *      number of commands that have been executed. Handles the following
+ *      syntax:
+ *
+ *          info cmdcount
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCmdCountCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "cmdcount");
+        return TCL_ERROR;
+    }
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoCommandsCmd --
+ *
+ *	Called to implement the "info commands" command that returns the
+ *	list of commands in the interpreter that match an optional pattern.
+ *	The pattern, if any, consists of an optional sequence of namespace
+ *	names separated by "::" qualifiers, which is followed by a
+ *	glob-style pattern that restricts which commands are returned.
+ *	Handles the following syntax:
+ *
+ *          info commands ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCommandsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *cmdName, *pattern, *simplePattern;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Namespace *nsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_Obj *listPtr, *elemObjPtr;
+    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
+    Tcl_Command cmd;
+    int result;
+
+    /*
+     * Get the pattern and find the "effective namespace" in which to
+     * list commands.
+     */
+
+    if (objc == 2) {
+        simplePattern = NULL;
+	nsPtr = currNsPtr;
+	specificNsInPattern = 0;
+    } else if (objc == 3) {
+	/*
+	 * From the pattern, get the effective namespace and the simple
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an
+	 * error was found while parsing the pattern, return it. Otherwise,
+	 * if the namespace wasn't found, just leave nsPtr NULL: we will
+	 * return an empty list since no commands there can be found.
+	 */
+
+	Namespace *dummy1NsPtr, *dummy2NsPtr;
+	
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+	result = TclGetNamespaceForQualName(interp, pattern,
+		(Namespace *) NULL, /*flags*/ TCL_LEAVE_ERR_MSG,
+		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+	if (result != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	procPtr = TclFindProc(iPtr, argv[2]);
-	if (procPtr == NULL) {
-	    goto infoNoSuchProc;
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
-	for (argPtr = procPtr->argPtr; ; argPtr = argPtr->nextPtr) {
-	    if (argPtr == NULL) {
-		Tcl_AppendResult(interp, "procedure \"", argv[2],
-			"\" doesn't have an argument \"", argv[3],
-			"\"", (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    if (strcmp(argv[3], argPtr->name) == 0) {
-		if (argPtr->defValue != NULL) {
-		    if (Tcl_SetVar((Tcl_Interp *) iPtr, argv[4],
-			    argPtr->defValue, 0) == NULL) {
-			defStoreError:
-			Tcl_AppendResult(interp,
-				"couldn't store default value in variable \"",
-				argv[4], "\"", (char *) NULL);
-			return TCL_ERROR;
-		    }
-		    iPtr->result = "1";
+    } else {
+        Tcl_WrongNumArgs(interp, 1, objv, "commands ?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the effective namespace's command table and create a
+     * list with all commands that match the pattern. If a specific
+     * namespace was requested in the pattern, qualify the command names
+     * with the namespace name.
+     */
+
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
+    if (nsPtr != NULL) {
+	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+	while (entryPtr != NULL) {
+	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
+	    if ((simplePattern == NULL)
+	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		if (specificNsInPattern) {
+		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+		    elemObjPtr = Tcl_NewObj();
+		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
 		} else {
-		    if (Tcl_SetVar((Tcl_Interp *) iPtr, argv[4], "", 0)
-			    == NULL) {
-			goto defStoreError;
-		    }
-		    iPtr->result = "0";
+		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
 		}
-		return TCL_OK;
+		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
 	    }
+	    entryPtr = Tcl_NextHashEntry(&search);
 	}
-    } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)) {
-	char *p;
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " exists varName\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	p = Tcl_GetVar((Tcl_Interp *) iPtr, argv[2], 0);
 
 	/*
-	 * The code below handles the special case where the name is for
-	 * an array:  Tcl_GetVar will reject this since you can't read
-	 * an array variable without an index.
+	 * If the effective namespace isn't the global :: namespace, and a
+	 * specific namespace wasn't requested in the pattern, then add in
+	 * all global :: commands that match the simple pattern. Of course,
+	 * we add in only those commands that aren't hidden by a command in
+	 * the effective namespace.
 	 */
-
-	if (p == NULL) {
-	    Tcl_HashEntry *hPtr;
-	    Var *varPtr;
-
-	    if (strchr(argv[2], '(') != NULL) {
-		noVar:
-		iPtr->result = "0";
-		return TCL_OK;
-	    }
-	    if (iPtr->varFramePtr == NULL) {
-		hPtr = Tcl_FindHashEntry(&iPtr->globalTable, argv[2]);
-	    } else {
-		hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, argv[2]);
-	    }
-	    if (hPtr == NULL) {
-		goto noVar;
-	    }
-	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	    if (varPtr->flags & VAR_UPVAR) {
-		varPtr = varPtr->value.upvarPtr;
-	    }
-	    if (!(varPtr->flags & VAR_ARRAY)) {
-		goto noVar;
+	
+	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
+	    while (entryPtr != NULL) {
+		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+		if ((simplePattern == NULL)
+	                || Tcl_StringMatch(cmdName, simplePattern)) {
+		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
+			Tcl_ListObjAppendElement(interp, listPtr,
+				Tcl_NewStringObj(cmdName, -1));
+		    }
+		}
+		entryPtr = Tcl_NextHashEntry(&search);
 	    }
 	}
-	iPtr->result = "1";
-	return TCL_OK;
-    } else if ((c == 'g') && (strncmp(argv[1], "globals", length) == 0)) {
-	char *name;
+    }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoCompleteCmd --
+ *
+ *      Called to implement the "info complete" command that determines
+ *      whether a string is a complete Tcl command. Handles the following
+ *      syntax:
+ *
+ *          info complete command
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (argc > 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " globals ?pattern?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	for (hPtr = Tcl_FirstHashEntry(&iPtr->globalTable, &search);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	    if (varPtr->flags & VAR_UNDEFINED) {
-		continue;
-	    }
-	    name = Tcl_GetHashKey(&iPtr->globalTable, hPtr);
-	    if ((argc == 3) && !Tcl_StringMatch(name, argv[2])) {
-		continue;
-	    }
-	    Tcl_AppendElement(interp, name);
-	}
-	return TCL_OK;
-    } else if ((c == 'h') && (strncmp(argv[1], "hostname", length) == 0)) {
-	if (argc > 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " hostname\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-        Tcl_AppendResult(interp, Tcl_GetHostName(), NULL);
+static int
+InfoCompleteCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *command;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "complete command");
+        return TCL_ERROR;
+    }
+
+    command = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    if (Tcl_CommandComplete(command)) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+    } else {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoDefaultCmd --
+ *
+ *      Called to implement the "info default" command that returns the
+ *      default value for a procedure argument. Handles the following
+ *      syntax:
+ *
+ *          info default procName arg varName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoDefaultCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *procName, *argName, *varName;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *valueObjPtr;
+
+    if (objc != 5) {
+        Tcl_WrongNumArgs(interp, 1, objv, "default procname arg varname");
+        return TCL_ERROR;
+    }
+
+    procName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    argName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+
+    procPtr = TclFindProc(iPtr, procName);
+    if (procPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"\"", procName, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+            localPtr = localPtr->nextPtr) {
+        if ((localPtr->isArg) && (strcmp(argName, localPtr->name) == 0)) {
+            if (localPtr->defValuePtr != NULL) {
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+                        localPtr->defValuePtr, 0);
+                if (valueObjPtr == NULL) {
+                    defStoreError:
+		    varName = Tcl_GetStringFromObj(objv[4], (int *) NULL);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	                    "couldn't store default value in variable \"",
+			    varName, "\"", (char *) NULL);
+                    return TCL_ERROR;
+                }
+		Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+            } else {
+                Tcl_Obj *nullObjPtr = Tcl_NewObj();
+                valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+                    nullObjPtr, 0);
+                if (valueObjPtr == NULL) {
+                    Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
+                    goto defStoreError;
+                }
+		Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+            }
+            return TCL_OK;
+        }
+    }
+
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	    "procedure \"", procName, "\" doesn't have an argument \"",
+	    argName, "\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoExistsCmd --
+ *
+ *      Called to implement the "info exists" command that determines
+ *      whether a variable exists. Handles the following syntax:
+ *
+ *          info exists varName
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoExistsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *varName;
+    Var *varPtr, *arrayPtr;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "exists varName");
+        return TCL_ERROR;
+    }
+
+    varName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    varPtr = TclLookupVar(interp, varName, (char *) NULL,
+            TCL_PARSE_PART1, "access",
+            /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+    } else {
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoGlobalsCmd --
+ *
+ *      Called to implement the "info globals" command that returns the list
+ *      of global variables matching an optional pattern. Handles the
+ *      following syntax:
+ *
+ *          info globals ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoGlobalsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *varName, *pattern;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 1, objv, "globals ?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the global :: namespace's variable table and create a
+     * list of all global variables that match the pattern.
+     */
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_NextHashEntry(&search)) {
+        varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+        if (TclIsVarUndefined(varPtr)) {
+            continue;
+        }
+        varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
+        if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+            Tcl_ListObjAppendElement(interp, listPtr,
+		    Tcl_NewStringObj(varName, -1));
+        }
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoHostnameCmd --
+ *
+ *      Called to implement the "info hostname" command that returns the
+ *      host name. Handles the following syntax:
+ *
+ *          info hostname
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoHostnameCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "hostname");
+        return TCL_ERROR;
+    }
+
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), Tcl_GetHostName(), -1);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLevelCmd --
+ *
+ *      Called to implement the "info level" command that returns
+ *      information about the call stack. Handles the following syntax:
+ *
+ *          info level ?number?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLevelCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int level;
+    CallFrame *framePtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {		/* just "info level" */
+        if (iPtr->varFramePtr == NULL) {
+            Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+        } else {
+            Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->varFramePtr->level);
+        }
         return TCL_OK;
-    } else if ((c == 'l') && (strncmp(argv[1], "level", length) == 0)
-	    && (length >= 2)) {
-	if (argc == 2) {
-	    if (iPtr->varFramePtr == NULL) {
-		iPtr->result = "0";
-	    } else {
-		sprintf(iPtr->result, "%d", iPtr->varFramePtr->level);
-	    }
-	    return TCL_OK;
-	} else if (argc == 3) {
-	    int level;
-	    CallFrame *framePtr;
+    } else if (objc == 3) {
+        if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (level <= 0) {
+            if (iPtr->varFramePtr == NULL) {
+                levelError:
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"bad level \"",
+			Tcl_GetStringFromObj(objv[2], (int *) NULL),
+			"\"", (char *) NULL);
+                return TCL_ERROR;
+            }
+            level += iPtr->varFramePtr->level;
+        }
+        for (framePtr = iPtr->varFramePtr;  framePtr != NULL;
+                framePtr = framePtr->callerVarPtr) {
+            if (framePtr->level == level) {
+                break;
+            }
+        }
+        if (framePtr == NULL) {
+            goto levelError;
+        }
+
+        listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+        Tcl_SetObjResult(interp, listPtr);
+        return TCL_OK;
+    }
 
-	    if (Tcl_GetInt(interp, argv[2], &level) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (level <= 0) {
-		if (iPtr->varFramePtr == NULL) {
-		    levelError:
-		    Tcl_AppendResult(interp, "bad level \"", argv[2],
-			    "\"", (char *) NULL);
-		    return TCL_ERROR;
-		}
-		level += iPtr->varFramePtr->level;
+    Tcl_WrongNumArgs(interp, 1, objv, "level ?number?");
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLibraryCmd --
+ *
+ *      Called to implement the "info library" command that returns the
+ *      library directory for the Tcl installation. Handles the following
+ *      syntax:
+ *
+ *          info library
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLibraryCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *libDirName;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "library");
+        return TCL_ERROR;
+    }
+
+    libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
+    if (libDirName != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);
+        return TCL_OK;
+    }
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
+            "no library has been specified for Tcl", -1);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLoadedCmd --
+ *
+ *      Called to implement the "info loaded" command that returns the
+ *      packages that have been loaded into an interpreter. Handles the
+ *      following syntax:
+ *
+ *          info loaded ?interp?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLoadedCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *interpName;
+    int result;
+
+    if ((objc != 2) && (objc != 3)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "loaded ?interp?");
+        return TCL_ERROR;
+    }
+
+    if (objc == 2) {		/* get loaded pkgs in all interpreters */
+	interpName = NULL;
+    } else {			/* get pkgs just in specified interp */
+	interpName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    }
+    result = TclGetLoadedPackages(interp, interpName);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoLocalsCmd --
+ *
+ *      Called to implement the "info locals" command to return a list of
+ *      local variables that match an optional pattern. Handles the
+ *      following syntax:
+ *
+ *          info locals ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoLocalsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr;
+    char *varName, *pattern;
+    int i, localVarCt;
+    Tcl_HashTable *localVarTablePtr;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 1, objv, "locals ?pattern?");
+        return TCL_ERROR;
+    }
+    
+    if (iPtr->varFramePtr == NULL) {
+        return TCL_OK;
+    }
+    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
+
+    /*
+     * Return a list containing names of first the compiled locals (i.e. the
+     * ones stored in the call frame), then the variables in the local hash
+     * table (if one exists).
+     */
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    
+    localVarCt = iPtr->varFramePtr->numCompiledLocals;
+    for (i = 0, varPtr = iPtr->varFramePtr->compiledLocals;
+            i < localVarCt;
+	    i++, varPtr++) {
+	if (!TclIsVarUndefined(varPtr)) {
+	    varName = varPtr->name;
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+		        Tcl_NewStringObj(varName, -1));
 	    }
-	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
-		    framePtr = framePtr->callerVarPtr) {
-		if (framePtr->level == level) {
-		    break;
+        }
+    }
+    
+    if (localVarTablePtr != NULL) {
+	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
+	        entryPtr != NULL;
+                entryPtr = Tcl_NextHashEntry(&search)) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr) && !TclIsVarLink(varPtr)) {
+		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
+		if ((pattern == NULL)
+		        || Tcl_StringMatch(varName, pattern)) {
+		    Tcl_ListObjAppendElement(interp, listPtr,
+			    Tcl_NewStringObj(varName, -1));
 		}
 	    }
-	    if (framePtr == NULL) {
-		goto levelError;
-	    }
-	    iPtr->result = Tcl_Merge(framePtr->argc, framePtr->argv);
-	    iPtr->freeProc = TCL_DYNAMIC;
-	    return TCL_OK;
 	}
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" level [number]\"", (char *) NULL);
-	return TCL_ERROR;
-    } else if ((c == 'l') && (strncmp(argv[1], "library", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " library\"", (char *) NULL);
+    }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoNameOfExecutableCmd --
+ *
+ *      Called to implement the "info nameofexecutable" command that returns
+ *      the name of the binary file running this application. Handles the
+ *      following syntax:
+ *
+ *          info nameofexecutable
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoNameOfExecutableCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "nameofexecutable");
+        return TCL_ERROR;
+    }
+    
+    if (tclExecutableName != NULL) {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp), tclExecutableName, -1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoPatchLevelCmd --
+ *
+ *      Called to implement the "info patchlevel" command that returns the
+ *      default value for an argument to a procedure. Handles the following
+ *      syntax:
+ *
+ *          info patchlevel
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoPatchLevelCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *patchlevel;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "patchlevel");
+        return TCL_ERROR;
+    }
+
+    patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
+            (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+    if (patchlevel != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);
+        return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoProcsCmd --
+ *
+ *      Called to implement the "info procs" command that returns the
+ *      procedures in the current namespace that match an optional pattern.
+ *      Handles the following syntax:
+ *
+ *          info procs ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoProcsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *cmdName, *pattern;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 1, objv, "procs ?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the current namespace's command table and return a list
+     * of all procs that match the pattern.
+     */
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (entryPtr = Tcl_FirstHashEntry(&currNsPtr->cmdTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_NextHashEntry(&search)) {
+        cmdName = Tcl_GetHashKey(&currNsPtr->cmdTable, entryPtr);
+        cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+        if (TclIsProc(cmdPtr)) {
+            if ((pattern == NULL) || Tcl_StringMatch(cmdName, pattern)) {
+                Tcl_ListObjAppendElement(interp, listPtr,
+		        Tcl_NewStringObj(cmdName, -1));
+            }
+        }
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoScriptCmd --
+ *
+ *      Called to implement the "info script" command that returns the
+ *      script file that is currently being evaluated. Handles the
+ *      following syntax:
+ *
+ *          info script
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoScriptCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "script");
+        return TCL_ERROR;
+    }
+
+    if (iPtr->scriptFile != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), iPtr->scriptFile, -1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoSharedlibCmd --
+ *
+ *      Called to implement the "info sharedlibextension" command that
+ *      returns the file extension used for shared libraries. Handles the
+ *      following syntax:
+ *
+ *          info sharedlibextension
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoSharedlibCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "sharedlibextension");
+        return TCL_ERROR;
+    }
+    
+#ifdef TCL_SHLIB_EXT
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);
+#endif
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoTclVersionCmd --
+ *
+ *      Called to implement the "info tclversion" command that returns the
+ *      version number for this Tcl library. Handles the following syntax:
+ *
+ *          info tclversion
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoTclVersionCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *version;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "tclversion");
+        return TCL_ERROR;
+    }
+
+    version = Tcl_GetVar(interp, "tcl_version",
+        (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+    if (version != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);
+        return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoVarsCmd --
+ *
+ *	Called to implement the "info vars" command that returns the
+ *	list of variables in the interpreter that match an optional pattern.
+ *	The pattern, if any, consists of an optional sequence of namespace
+ *	names separated by "::" qualifiers, which is followed by a
+ *	glob-style pattern that restricts which variables are returned.
+ *	Handles the following syntax:
+ *
+ *          info vars ?pattern?
+ *
+ * Results:
+ *      Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ *
+ * Side effects:
+ *      Returns a result in the interpreter's result object. If there is
+ *	an error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoVarsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *varName, *pattern, *simplePattern;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Var *varPtr, *localVarPtr;
+    Namespace *nsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_Obj *listPtr, *elemObjPtr;
+    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
+    int i, result;
+
+    /*
+     * Get the pattern and find the "effective namespace" in which to
+     * list variables. We only use this effective namespace if there's
+     * no active Tcl procedure frame.
+     */
+
+    if (objc == 2) {
+        simplePattern = NULL;
+	nsPtr = currNsPtr;
+	specificNsInPattern = 0;
+    } else if (objc == 3) {
+	/*
+	 * From the pattern, get the effective namespace and the simple
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an
+	 * error was found while parsing the pattern, return it. Otherwise,
+	 * if the namespace wasn't found, just leave nsPtr NULL: we will
+	 * return an empty list since no variables there can be found.
+	 */
+
+	Namespace *dummy1NsPtr, *dummy2NsPtr;
+
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+	result = TclGetNamespaceForQualName(interp, pattern,
+		(Namespace *) NULL, /*flags*/ TCL_LEAVE_ERR_MSG,
+		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+	if (result != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	interp->result = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
-	if (interp->result == NULL) {
-	    interp->result = "no library has been specified for Tcl";
-	    return TCL_ERROR;
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
+    } else {
+        Tcl_WrongNumArgs(interp, 1, objv, "vars ?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * If the namespace specified in the pattern wasn't found, just return.
+     */
+
+    if (nsPtr == NULL) {
 	return TCL_OK;
-    } else if ((c == 'l') && (strncmp(argv[1], "loaded", length) == 0)
-	    && (length >= 3)) {
-	if ((argc != 2) && (argc != 3)) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " loaded ?interp?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	return TclGetLoadedPackages(interp, argv[2]);
-    } else if ((c == 'l') && (strncmp(argv[1], "locals", length) == 0)
-	    && (length >= 3)) {
-	char *name;
-
-	if (argc > 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " locals ?pattern?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (iPtr->varFramePtr == NULL) {
-	    return TCL_OK;
-	}
-	for (hPtr = Tcl_FirstHashEntry(&iPtr->varFramePtr->varTable, &search);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	    if (varPtr->flags & (VAR_UNDEFINED|VAR_UPVAR)) {
-		continue;
-	    }
-	    name = Tcl_GetHashKey(&iPtr->varFramePtr->varTable, hPtr);
-	    if ((argc == 3) && !Tcl_StringMatch(name, argv[2])) {
-		continue;
+    }
+    
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    
+    if ((iPtr->varFramePtr == NULL)
+	    || !iPtr->varFramePtr->isProcCallFrame
+	    || specificNsInPattern) {
+	/*
+	 * There is no frame pointer, the frame pointer was pushed only
+	 * to activate a namespace, or we are in a procedure call frame
+	 * but a specific namespace was specified. Create a list containing
+	 * only the variables in the effective namespace's variable table.
+	 */
+	
+	entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
+	while (entryPtr != NULL) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr)) {
+		varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
+		if ((simplePattern == NULL)
+	                || Tcl_StringMatch(varName, simplePattern)) {
+		    if (specificNsInPattern) {
+			elemObjPtr = Tcl_NewObj();
+			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+			        elemObjPtr);
+		    } else {
+			elemObjPtr = Tcl_NewStringObj(varName, -1);
+		    }
+		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		}
 	    }
-	    Tcl_AppendElement(interp, name);
+	    entryPtr = Tcl_NextHashEntry(&search);
 	}
-	return TCL_OK;
-    } else if ((c == 'n') && (strncmp(argv[1], "nameofexecutable",
-	    length) == 0)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " nameofexecutable\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (tclExecutableName != NULL) {
-	    interp->result = tclExecutableName;
-	}
-	return TCL_OK;
-    } else if ((c == 'p') && (strncmp(argv[1], "patchlevel", length) == 0)
-	    && (length >= 2)) {
-	char *value;
 
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " patchlevel\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	value = Tcl_GetVar(interp, "tcl_patchLevel",
-		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
-	if (value == NULL) {
-	    return TCL_ERROR;
-	}
-	interp->result = value;
-	return TCL_OK;
-    } else if ((c == 'p') && (strncmp(argv[1], "procs", length) == 0)
-	    && (length >= 2)) {
-	if (argc > 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " procs ?pattern?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	    char *name = Tcl_GetHashKey(&iPtr->commandTable, hPtr);
+	/*
+	 * If the effective namespace isn't the global :: namespace, and a
+	 * specific namespace wasn't requested in the pattern (i.e., the
+	 * pattern only specifies variable names), then add in all global ::
+	 * variables that match the simple pattern. Of course, add in only
+	 * those variables that aren't hidden by a variable in the effective
+	 * namespace.
+	 */
 
-	    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
-	    if (!TclIsProc(cmdPtr)) {
-		continue;
-	    }
-	    if ((argc == 3) && !Tcl_StringMatch(name, argv[2])) {
-		continue;
+	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+	    while (entryPtr != NULL) {
+		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		if (!TclIsVarUndefined(varPtr)) {
+		    varName = Tcl_GetHashKey(&globalNsPtr->varTable,
+			    entryPtr);
+		    if ((simplePattern == NULL)
+	                    || Tcl_StringMatch(varName, simplePattern)) {
+			if (Tcl_FindHashEntry(&nsPtr->varTable, varName) == NULL) {
+			    Tcl_ListObjAppendElement(interp, listPtr,
+			            Tcl_NewStringObj(varName, -1));
+			}
+		    }
+		}
+		entryPtr = Tcl_NextHashEntry(&search);
 	    }
-	    Tcl_AppendElement(interp, name);
-	}
-	return TCL_OK;
-    } else if ((c == 's') && (strncmp(argv[1], "script", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " script\"", (char *) NULL);
-	    return TCL_ERROR;
 	}
-	if (iPtr->scriptFile != NULL) {
-	    /*
-	     * Can't depend on iPtr->scriptFile to be non-volatile:
-	     * if this command is returned as the result of the script,
-	     * then iPtr->scriptFile will go away.
-	     */
+    } else {
+	/*
+	 * We're in a local call frame and no specific namespace was
+	 * specific. Create a list that starts with the compiled locals
+	 * (i.e. the ones stored in the call frame).
+	 */
 
-	    Tcl_SetResult(interp, iPtr->scriptFile, TCL_VOLATILE);
-	}
-	return TCL_OK;
-    } else if ((c == 's') && (strncmp(argv[1], "sharedlibextension",
-	    length) == 0) && (length >= 2)) {
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " sharedlibextension\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-#ifdef TCL_SHLIB_EXT
-	interp->result = TCL_SHLIB_EXT;
-#endif
-	return TCL_OK;
-    } else if ((c == 't') && (strncmp(argv[1], "tclversion", length) == 0)) {
-	char *value;
+	CallFrame *varFramePtr = iPtr->varFramePtr;
+        int localVarCt = varFramePtr->numCompiledLocals;
+	Tcl_HashTable *varTablePtr = varFramePtr->varTablePtr;
+	
+        for (i = 0, localVarPtr = iPtr->varFramePtr->compiledLocals;
+                i < localVarCt;
+                i++, localVarPtr++) {
+            if (!TclIsVarUndefined(localVarPtr)) {
+                varName = localVarPtr->name;
+                if ((simplePattern == NULL)
+		        || Tcl_StringMatch(varName, simplePattern)) {
+                    Tcl_ListObjAppendElement(interp, listPtr,
+			    Tcl_NewStringObj(varName, -1));
+                }
+            }
+        }
 
-	if (argc != 2) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " tclversion\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	value = Tcl_GetVar(interp, "tcl_version",
-		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
-	if (value == NULL) {
-	    return TCL_ERROR;
-	}
-	interp->result = value;
-	return TCL_OK;
-    } else if ((c == 'v') && (strncmp(argv[1], "vars", length)) == 0) {
-	Tcl_HashTable *tablePtr;
-	char *name;
+	/*
+	 * Now add in the variables in the call frame's variable hash
+	 * table (if one exists).
+	 */
 
-	if (argc > 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " vars ?pattern?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (iPtr->varFramePtr == NULL) {
-	    tablePtr = &iPtr->globalTable;
-	} else {
-	    tablePtr = &iPtr->varFramePtr->varTable;
-	}
-	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	    if (varPtr->flags & VAR_UNDEFINED) {
-		continue;
-	    }
-	    name = Tcl_GetHashKey(tablePtr, hPtr);
-	    if ((argc == 3) && !Tcl_StringMatch(name, argv[2])) {
-		continue;
+	if (varTablePtr != NULL) {
+	    for (entryPtr = Tcl_FirstHashEntry(varTablePtr, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		if (!TclIsVarUndefined(varPtr)) {
+		    varName = Tcl_GetHashKey(varTablePtr, entryPtr);
+		    if ((simplePattern == NULL)
+		            || Tcl_StringMatch(varName, simplePattern)) {
+			Tcl_ListObjAppendElement(interp, listPtr,
+				Tcl_NewStringObj(varName, -1));
+		    }
+		}
 	    }
-	    Tcl_AppendElement(interp, name);
 	}
-	return TCL_OK;
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": should be args, body, cmdcount, commands, ",
-		"complete, default, ",
-		"exists, globals, hostname, level, library, loaded, locals, ",
-		"nameofexecutable, patchlevel, procs, script, ",
-		"sharedlibextension, tclversion, or vars",
-		(char *) NULL);
-	return TCL_ERROR;
     }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_JoinCmd --
+ * Tcl_JoinObjCmd --
  *
  *	This procedure is invoked to process the "join" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -674,50 +1737,63 @@ Tcl_InfoCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_JoinCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_JoinObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
 {
-    char *joinString;
-    char **listArgv;
-    int listArgc, i;
+    char *joinString, *bytes;
+    int joinLength, listLen, length, i, result;
+    Tcl_Obj **elemPtrs;
 
-    if (argc == 2) {
+    if (objc == 2) {
 	joinString = " ";
-    } else if (argc == 3) {
-	joinString = argv[2];
+	joinLength = 1;
+    } else if (objc == 3) {
+	joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
     } else {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" list ?joinString?\"", (char *) NULL);
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
 	return TCL_ERROR;
     }
 
-    if (Tcl_SplitList(interp, argv[1], &listArgc, &listArgv) != TCL_OK) {
-	return TCL_ERROR;
+    /*
+     * Make sure the list argument is a list object and get its length and
+     * a pointer to its array of element pointers.
+     */
+
+    result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
     }
-    for (i = 0; i < listArgc; i++) {
-	if (i == 0) {
-	    Tcl_AppendResult(interp, listArgv[0], (char *) NULL);
-	} else  {
-	    Tcl_AppendResult(interp, joinString, listArgv[i], (char *) NULL);
+
+    /*
+     * Now concatenate strings to form the "joined" result. We append
+     * directly into the interpreter's result object.
+     */
+
+    for (i = 0;  i < listLen;  i++) {
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
+	if (i > 0) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), joinString,
+		    bytes, (char *) NULL);
+	} else {
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), bytes, length);
 	}
     }
-    ckfree((char *) listArgv);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LindexCmd --
+ * Tcl_LindexObjCmd --
  *
- *	This procedure is invoked to process the "lindex" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "lindex" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -727,69 +1803,80 @@ Tcl_JoinCmd(dummy, interp, argc, argv)
 
     /* ARGSUSED */
 int
-Tcl_LindexCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_LindexObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    char *p, *element, *next;
-    int index, size, parenthesized, result, returnLast;
+    Tcl_Obj *listPtr;
+    Tcl_Obj **elemPtrs;
+    int listLen, index, result;
 
-    if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" list index\"", (char *) NULL);
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index");
 	return TCL_ERROR;
     }
-    if ((*argv[2] == 'e') && (strncmp(argv[2], "end", strlen(argv[2])) == 0)) {
-	returnLast = 1;
-	index = INT_MAX;
-    } else {
-	returnLast = 0;
-	if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+
+    /*
+     * Convert the first argument to a list if necessary.
+     */
+
+    listPtr = objv[1];
+    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Get the index from objv[2].
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &index);
+    if (result != TCL_OK) {
+	return result;
     }
-    if (index < 0) {
+    if ((index < 0) || (index >= listLen)) {
+	/*
+	 * The index is out of range: the result is an empty string object.
+	 */
+	
 	return TCL_OK;
     }
-    for (p = argv[1] ; index >= 0; index--) {
-	result = TclFindElement(interp, p, &element, &next, &size,
-		&parenthesized);
+
+    /*
+     * Make sure listPtr still refers to a list object. It might have been
+     * converted to an int above if the argument objects were shared.
+     */
+
+    if (listPtr->typePtr != &tclListType) {
+	result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+	        &elemPtrs);
 	if (result != TCL_OK) {
 	    return result;
 	}
-	if ((*next == 0) && returnLast) {
-	    break;
-	}
-	p = next;
-    }
-    if (size == 0) {
-	return TCL_OK;
-    }
-    if (size >= TCL_RESULT_SIZE) {
-	interp->result = (char *) ckalloc((unsigned) size+1);
-	interp->freeProc = TCL_DYNAMIC;
-    }
-    if (parenthesized) {
-	memcpy((VOID *) interp->result, (VOID *) element, (size_t) size);
-	interp->result[size] = 0;
-    } else {
-	TclCopyAndCollapse(size, element, interp->result);
     }
+
+    /*
+     * Set the interpreter's object result to the index-th list element.
+     */
+
+    Tcl_SetObjResult(interp, elemPtrs[index]);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LinsertCmd --
+ * Tcl_LinsertObjCmd --
  *
- *	This procedure is invoked to process the "linsert" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "linsert" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A new Tcl list object formed by inserting zero or more elements 
+ *	into a list.
  *
  * Side effects:
  *	See the user documentation.
@@ -799,70 +1886,75 @@ Tcl_LindexCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_LinsertCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_LinsertObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    register int objc;		/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    char *p, *element, savedChar;
-    int i, index, count, result, size;
+    Tcl_Obj *listPtr, *resultPtr;
+    int index, isDuplicate;
+    int result;
 
-    if (argc < 4) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" list index element ?element ...?\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-    if ((*argv[2] == 'e') && (strncmp(argv[2], "end", strlen(argv[2])) == 0)) {
-	index = INT_MAX;
-    } else if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
 	return TCL_ERROR;
     }
 
     /*
-     * Skip over the first "index" elements of the list, then add
-     * all of those elements to the result.
+     * Get the index first since, if a conversion to int is needed, it
+     * will invalidate the list's internal representation.
      */
 
-    size = 0;
-    element = argv[1];
-    for (count = 0, p = argv[1]; (count < index) && (*p != 0); count++) {
-	result = TclFindElement(interp, p, &element, &p, &size, (int *) NULL);
-	if (result != TCL_OK) {
-	    return result;
-	}
-    }
-    if (*p == 0) {
-	Tcl_AppendResult(interp, argv[1], (char *) NULL);
-    } else {
-	char *end;
-
-	end = element+size;
-	if (element != argv[1]) {
-	    while ((*end != 0) && !isspace(UCHAR(*end))) {
-		end++;
-	    }
-	}
-	savedChar = *end;
-	*end = 0;
-	Tcl_AppendResult(interp, argv[1], (char *) NULL);
-	*end = savedChar;
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ INT_MAX,
+	    &index);
+    if (result != TCL_OK) {
+	return result;
     }
 
     /*
-     * Add the new list elements.
+     * If the list object is unshared we can modify it directly. Otherwise
+     * we create a copy to modify: this is "copy on write". We create the
+     * duplicate directly in the interpreter's object result.
      */
-
-    for (i = 3; i < argc; i++) {
-	Tcl_AppendElement(interp, argv[i]);
+    
+    listPtr = objv[1];
+    isDuplicate = 0;
+    if (Tcl_IsShared(listPtr)) {
+	Tcl_ResetResult(interp);
+	resultPtr = Tcl_GetObjResult(interp);
+	if (listPtr->typePtr != NULL) {
+	    Tcl_InvalidateStringRep(resultPtr);
+	    listPtr->typePtr->dupIntRepProc(listPtr, resultPtr);
+	} else if (listPtr->bytes != NULL) {
+	    int len = listPtr->length;
+	    
+	    TclInitStringRep(resultPtr, listPtr->bytes, len);
+	}
+	listPtr = resultPtr;
+	isDuplicate = 1;
     }
+    
+    if ((objc == 4) && (index == INT_MAX)) {
+	/*
+	 * Special case: insert one element at the end of the list.
+	 */
 
+	result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
+    } else if (objc > 3) {
+	result = Tcl_ListObjReplace(interp, listPtr, index, 0,
+				    (objc-3), &(objv[3]));
+    }
+    if (result != TCL_OK) {
+	return result;
+    }
+    
     /*
-     * Append the remainder of the original list.
+     * Set the interpreter's object result.
      */
 
-    if (*p != 0) {
-	Tcl_AppendResult(interp, " ", p, (char *) NULL);
+    if (!isDuplicate) {
+	Tcl_SetObjResult(interp, listPtr);
     }
     return TCL_OK;
 }
@@ -870,13 +1962,13 @@ Tcl_LinsertCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ListCmd --
+ * Tcl_ListObjCmd --
  *
  *	This procedure is invoked to process the "list" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -886,15 +1978,19 @@ Tcl_LinsertCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ListCmd(dummy, interp, argc, argv)
+Tcl_ListObjCmd(dummy, interp, objc, objv)
     ClientData dummy;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    register int objc;			/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* The argument objects. */
 {
-    if (argc >= 2) {
-	interp->result = Tcl_Merge(argc-1, argv+1);
-	interp->freeProc = TCL_DYNAMIC;
+    /*
+     * If there are no list elements, the result is an empty object.
+     * Otherwise modify the interpreter's result object to be a list object.
+     */
+    
+    if (objc > 1) {
+	Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
     }
     return TCL_OK;
 }
@@ -902,13 +1998,13 @@ Tcl_ListCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LlengthCmd --
+ * Tcl_LlengthObjCmd --
  *
- *	This procedure is invoked to process the "llength" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "llength" Tcl
+ *	command.  See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -918,44 +2014,43 @@ Tcl_ListCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_LlengthCmd(dummy, interp, argc, argv)
+Tcl_LlengthObjCmd(dummy, interp, objc, objv)
     ClientData dummy;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int count, result;
-    char *element, *p;
+    int listLen, result;
 
-    if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" list\"", (char *) NULL);
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list");
 	return TCL_ERROR;
     }
-    for (count = 0, p = argv[1]; *p != 0 ; count++) {
-	result = TclFindElement(interp, p, &element, &p, (int *) NULL,
-		(int *) NULL);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if (*element == 0) {
-	    break;
-	}
+
+    result = Tcl_ListObjLength(interp, objv[1], &listLen);
+    if (result != TCL_OK) {
+	return result;
     }
-    sprintf(interp->result, "%d", count);
+
+    /*
+     * Set the interpreter's object result to an integer object holding the
+     * length. 
+     */
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LrangeCmd --
+ * Tcl_LrangeObjCmd --
  *
  *	This procedure is invoked to process the "lrange" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -965,103 +2060,92 @@ Tcl_LlengthCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_LrangeCmd(notUsed, interp, argc, argv)
+Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
     ClientData notUsed;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int first, last, result;
-    char *begin, *end, c, *dummy, *next;
-    int count, firstIsEnd;
+    Tcl_Obj *listPtr;
+    Tcl_Obj **elemPtrs;
+    int listLen, first, last, numElems, result;
 
-    if (argc != 4) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" list first last\"", (char *) NULL);
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
 	return TCL_ERROR;
     }
-    if ((*argv[2] == 'e') && (strncmp(argv[2], "end", strlen(argv[2])) == 0)) {
-	firstIsEnd = 1;
-	first = INT_MAX;
-    } else {
-	firstIsEnd = 0;
-	if (Tcl_GetInt(interp, argv[2], &first) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+
+    /*
+     * Make sure the list argument is a list object and get its length and
+     * a pointer to its array of element pointers.
+     */
+
+    listPtr = objv[1];
+    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Get the first and last indexes.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &first);
+    if (result != TCL_OK) {
+	return result;
     }
     if (first < 0) {
 	first = 0;
     }
-    if ((*argv[3] == 'e') && (strncmp(argv[3], "end", strlen(argv[3])) == 0)) {
-	last = INT_MAX;
-    } else {
-	if (Tcl_GetInt(interp, argv[3], &last) != TCL_OK) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "expected integer or \"end\" but got \"",
-		    argv[3], "\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
+
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+	    &last);
+    if (result != TCL_OK) {
+	return result;
     }
-    if ((first > last) && !firstIsEnd) {
-	return TCL_OK;
+    if (last >= listLen) {
+	last = (listLen - 1);
+    }
+    
+    if (first > last) {
+	return TCL_OK;		/* the result is an empty object */
     }
 
     /*
-     * Extract a range of fields.
-     */
-
-    for (count = 0, begin = argv[1]; count < first; begin = next, count++) {
-	result = TclFindElement(interp, begin, &dummy, &next, (int *) NULL,
-		(int *) NULL);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if (*next == 0) {
-	    if (firstIsEnd) {
-		first = count;
-	    } else {
-		begin = next;
-	    }
-	    break;
-	}
-    }
-    for (count = first, end = begin; (count <= last) && (*end != 0);
-	    count++) {
-	result = TclFindElement(interp, end, &dummy, &end, (int *) NULL,
-		(int *) NULL);
-	if (result != TCL_OK) {
-	    return result;
-	}
-    }
-    if (end == begin) {
-	return TCL_OK;
+     * Make sure listPtr still refers to a list object. It might have been
+     * converted to an int above if the argument objects were shared.
+     */  
+
+    if (listPtr->typePtr != &tclListType) {
+        result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+                &elemPtrs);
+        if (result != TCL_OK) {
+            return result;
+        }
     }
 
     /*
-     * Chop off trailing spaces.
+     * Extract a range of fields. We modify the interpreter's result object
+     * to be a list object containing the specified elements.
      */
 
-    while ((end != begin) && (isspace(UCHAR(end[-1])))
-	    && (((end-1) == begin) || (end[-2] != '\\'))) {
-	end--;
-    }
-    c = *end;
-    *end = 0;
-    Tcl_SetResult(interp, begin, TCL_VOLATILE);
-    *end = c;
+    numElems = (last - first + 1);
+    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LreplaceCmd --
+ * Tcl_LreplaceObjCmd --
  *
- *	This procedure is invoked to process the "lreplace" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "lreplace" 
+ *	Tcl command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A new Tcl list object formed by replacing zero or more elements of
+ *	a list.
  *
  * Side effects:
  *	See the user documentation.
@@ -1071,123 +2155,99 @@ Tcl_LrangeCmd(notUsed, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_LreplaceCmd(notUsed, interp, argc, argv)
-    ClientData notUsed;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    char *p1, *p2, *element, savedChar, *dummy, *next;
-    int i, first, last, count, result, size, firstIsEnd;
+    register Tcl_Obj *listPtr;
+    int createdNewObj, first, last, listLen, numToDelete, result;
 
-    if (argc < 4) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" list first last ?element element ...?\"", (char *) NULL);
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"list first last ?element element ...?");
 	return TCL_ERROR;
     }
-    if ((*argv[2] == 'e') && (strncmp(argv[2], "end", strlen(argv[2])) == 0)) {
-	firstIsEnd = 1;
-	first = INT_MAX;
-    } else {
-	firstIsEnd = 0;
-	if (Tcl_GetInt(interp, argv[2], &first) != TCL_OK) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad index \"", argv[2],
-		    "\": must be integer or \"end\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-    }
-    if ((*argv[3] == 'e') && (strncmp(argv[3], "end", strlen(argv[3])) == 0)) {
-	last = INT_MAX;
-    } else {
-	if (Tcl_GetInt(interp, argv[3], &last) != TCL_OK) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad index \"", argv[3],
-		    "\": must be integer or \"end\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-    }
-    if (first < 0) {
-	first = 0;
-    }
 
     /*
-     * Skip over the elements of the list before "first".
+     * If the list object is unshared we can modify it directly, otherwise
+     * we create a copy to modify: this is "copy on write".
      */
-
-    size = 0;
-    element = argv[1];
-    for (count = 0, p1 = argv[1]; (count < first) && (*p1 != 0); count++) {
-	result = TclFindElement(interp, p1, &element, &next, &size,
-		(int *) NULL);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if ((*next == 0) && firstIsEnd) {
-	    break;
-	}
-	p1 = next;
+    
+    listPtr = objv[1];
+    createdNewObj = 0;
+    if (Tcl_IsShared(listPtr)) {
+	listPtr = Tcl_DuplicateObj(listPtr);
+	createdNewObj = 1;
     }
-    if (*p1 == 0) {
-	Tcl_AppendResult(interp, "list doesn't contain element ",
-		argv[2], (char *) NULL);
-	return TCL_ERROR;
+    result = Tcl_ListObjLength(interp, listPtr, &listLen);
+    if (result != TCL_OK) {
+        errorReturn:
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+	}
+	return result;
     }
 
     /*
-     * Skip over the elements of the list up through "last".
+     * Get the first and last indexes.
      */
 
-    for (p2 = p1 ; (count <= last) && (*p2 != 0); count++) {
-	result = TclFindElement(interp, p2, &dummy, &p2, (int *) NULL,
-		(int *) NULL);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &first);
+    if (result != TCL_OK) {
+	goto errorReturn;
     }
 
-    /*
-     * Add the elements before "first" to the result. Remove any
-     * trailing white space, to make the result look as clean as
-     * possible (this matters primarily if the replacement string is
-     * empty).
-     */
-
-    while ((p1 != argv[1]) && (isspace(UCHAR(p1[-1])))
-	    && (((p1-1) == argv[1]) || (p1[-2] != '\\'))) {
-	p1--;
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+	    &last);
+    if (result != TCL_OK) {
+	goto errorReturn;
     }
-    savedChar = *p1;
-    *p1 = 0;
-    Tcl_AppendResult(interp, argv[1], (char *) NULL);
-    *p1 = savedChar;
 
-    /*
-     * Add the new list elements.
-     */
+    if (first < 0)  {
+    	first = 0;
+    }
+    if (first >= listLen) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"list doesn't contain element ",
+		Tcl_GetStringFromObj(objv[2], (int *) NULL), (int *) NULL);
+	result = TCL_ERROR;
+	goto errorReturn;
+    }
+    if (last >= listLen) {
+    	last = (listLen - 1);
+    }
+    if (first <= last) {
+	numToDelete = (last - first + 1);
+    } else {
+	numToDelete = 0;
+    }
 
-    for (i = 4; i < argc; i++) {
-	Tcl_AppendElement(interp, argv[i]);
+    if (objc > 4) {
+	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+	        (objc-4), &(objv[4]));
+    } else {
+	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+		0, NULL);
+    }
+    if (result != TCL_OK) {
+	goto errorReturn;
     }
 
     /*
-     * Append the remainder of the original list.
+     * Set the interpreter's object result. 
      */
 
-    if (*p2 != 0) {
-	if (*interp->result == 0) {
-	    Tcl_SetResult(interp, p2, TCL_VOLATILE);
-	} else {
-	    Tcl_AppendResult(interp, " ", p2, (char *) NULL);
-	}
-    }
+    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LsearchCmd --
+ * Tcl_LsearchObjCmd --
  *
  *	This procedure is invoked to process the "lsearch" Tcl command.
  *	See the user documentation for details on what it does.
@@ -1201,56 +2261,68 @@ Tcl_LreplaceCmd(notUsed, interp, argc, argv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_LsearchCmd(notUsed, interp, argc, argv)
-    ClientData notUsed;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_LsearchObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument values. */
 {
 #define EXACT	0
 #define GLOB	1
 #define REGEXP	2
-    int listArgc;
-    char **listArgv;
-    int i, match, mode, index;
+    char *bytes, *patternBytes;
+    int i, match, mode, index, result, listLen, length, elemLen;
+    Tcl_Obj **elemPtrs;
+    static char *switches[] =
+	    {"-exact", "-glob", "-regexp", (char *) NULL};
 
     mode = GLOB;
-    if (argc == 4) {
-	if (strcmp(argv[1], "-exact") == 0) {
-	    mode = EXACT;
-	} else if (strcmp(argv[1], "-glob") == 0) {
-	    mode = GLOB;
-	} else if (strcmp(argv[1], "-regexp") == 0) {
-	    mode = REGEXP;
-	} else {
-	    Tcl_AppendResult(interp, "bad search mode \"", argv[1],
-		    "\": must be -exact, -glob, or -regexp", (char *) NULL);
+    if (objc == 4) {
+	if (Tcl_GetIndexFromObj(interp, objv[1], switches,
+		"search mode", 0, &mode) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-    } else if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" ?mode? list pattern\"", (char *) NULL);
+    } else if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?mode? list pattern");
 	return TCL_ERROR;
     }
-    if (Tcl_SplitList(interp, argv[argc-2], &listArgc, &listArgv) != TCL_OK) {
-	return TCL_ERROR;
+
+    /*
+     * Make sure the list argument is a list object and get its length and
+     * a pointer to its array of element pointers.
+     */
+
+    result = Tcl_ListObjGetElements(interp, objv[objc-2], &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
     }
+
+    patternBytes = Tcl_GetStringFromObj(objv[objc-1], &length);
+ 
     index = -1;
-    for (i = 0; i < listArgc; i++) {
+    for (i = 0; i < listLen; i++) {
 	match = 0;
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
 	switch (mode) {
 	    case EXACT:
-		match = (strcmp(listArgv[i], argv[argc-1]) == 0);
+		if (length == elemLen) {
+		    match = (memcmp(bytes, patternBytes,
+			    (size_t) length) == 0);
+		}
 		break;
 	    case GLOB:
-		match = Tcl_StringMatch(listArgv[i], argv[argc-1]);
+		/*
+		 * WARNING: will not work with data containing NULLs.
+		 */
+		match = Tcl_StringMatch(bytes, patternBytes);
 		break;
 	    case REGEXP:
-		match = Tcl_RegExpMatch(interp, listArgv[i], argv[argc-1]);
+		/*
+		 * WARNING: will not work with data containing NULLs.
+		 */
+		match = Tcl_RegExpMatch(interp, bytes, patternBytes);
 		if (match < 0) {
-		    ckfree((char *) listArgv);
 		    return TCL_ERROR;
 		}
 		break;
@@ -1260,15 +2332,15 @@ Tcl_LsearchCmd(notUsed, interp, argc, argv)
 	    break;
 	}
     }
-    sprintf(interp->result, "%d", index);
-    ckfree((char *) listArgv);
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LsortCmd --
+ * Tcl_LsortObjCmd --
  *
  *	This procedure is invoked to process the "lsort" Tcl command.
  *	See the user documentation for details on what it does.
@@ -1282,29 +2354,29 @@ Tcl_LsearchCmd(notUsed, interp, argc, argv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_LsortCmd(notUsed, interp, argc, argv)
-    ClientData notUsed;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_LsortObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument values. */
 {
-    int listArgc, i, c;
-    size_t length;
-    char **listArgv;
-    char *command = NULL;		/* Initialization needed only to
-					 * prevent compiler warning. */
-
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" ?-ascii? ?-integer? ?-real? ?-increasing? ?-decreasing?",
-		" ?-command string? list\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-
-    if (sortInterp != NULL) {
-	interp->result = "can't invoke \"lsort\" recursively";
+    int i, index, dummy;
+    Tcl_Obj *resultPtr;
+    int length;
+    Tcl_Obj *cmdPtr, **listObjPtrs;
+    SortElement *elementArray;
+    SortElement *elementPtr;        
+    SortInfo sortInfo;                  /* Information about this sort that
+                                         * needs to be passed to the 
+                                         * comparison function */
+    static char *switches[] =
+	    {"-ascii", "-command", "-decreasing", "-dictionary",
+	    "-increasing", "-index", "-integer", "-real", (char *) NULL};
+
+    resultPtr = Tcl_GetObjResult(interp);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
 	return TCL_ERROR;
     }
 
@@ -1312,87 +2384,244 @@ Tcl_LsortCmd(notUsed, interp, argc, argv)
      * Parse arguments to set up the mode for the sort.
      */
 
-    sortInterp = interp;
-    sortMode = ASCII;
-    sortIncreasing = 1;
-    sortCode = TCL_OK;
-    for (i = 1; i < argc-1; i++) {
-	length = strlen(argv[i]);
-	if (length < 2) {
-	    badSwitch:
-	    Tcl_AppendResult(interp, "bad switch \"", argv[i],
-		    "\": must be -ascii, -integer, -real, -increasing",
-		    " -decreasing, or -command", (char *) NULL);
-	    sortCode = TCL_ERROR;
-	    goto done;
+    sortInfo.isIncreasing = 1;
+    sortInfo.sortMode = SORTMODE_ASCII;
+    sortInfo.index = -1;
+    sortInfo.interp = interp;
+    sortInfo.resultCode = TCL_OK;
+    cmdPtr = NULL;
+    for (i = 1; i < objc-1; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
+		!= TCL_OK) {
+	    return TCL_ERROR;
 	}
-	c = argv[i][1];
-	if ((c == 'a') && (strncmp(argv[i], "-ascii", length) == 0)) {
-	    sortMode = ASCII;
-	} else if ((c == 'c') && (strncmp(argv[i], "-command", length) == 0)) {
-	    if (i == argc-2) {
-		Tcl_AppendResult(interp, "\"-command\" must be",
-			" followed by comparison command", (char *) NULL);
-		sortCode = TCL_ERROR;
-		goto done;
-	    }
-	    sortMode = COMMAND;
-	    command = argv[i+1];
-	    i++;
-	} else if ((c == 'd')
-		&& (strncmp(argv[i], "-decreasing", length) == 0)) {
-	    sortIncreasing = 0;
-	} else if ((c == 'i') && (length >= 4)
-		&& (strncmp(argv[i], "-increasing", length) == 0)) {
-	    sortIncreasing = 1;
-	} else if ((c == 'i') && (length >= 4)
-		&& (strncmp(argv[i], "-integer", length) == 0)) {
-	    sortMode = INTEGER;
-	} else if ((c == 'r')
-		&& (strncmp(argv[i], "-real", length) == 0)) {
-	    sortMode = REAL;
-	} else {
-	    goto badSwitch;
+	switch (index) {
+	    case 0:			/* -ascii */
+		sortInfo.sortMode = SORTMODE_ASCII;
+		break;
+	    case 1:			/* -command */
+		if (i == (objc-2)) {
+		    Tcl_AppendToObj(resultPtr,
+			    "\"-command\" option must be followed by comparison command",
+			    -1);
+		    return TCL_ERROR;
+		}
+		sortInfo.sortMode = SORTMODE_COMMAND;
+		cmdPtr = objv[i+1];
+		i++;
+		break;
+	    case 2:			/* -decreasing */
+		sortInfo.isIncreasing = 0;
+		break;
+	    case 3:			/* -dictionary */
+		sortInfo.sortMode = SORTMODE_DICTIONARY;
+		break;
+	    case 4:			/* -increasing */
+		sortInfo.isIncreasing = 1;
+		break;
+	    case 5:			/* -index */
+		if (i == (objc-2)) {
+		    Tcl_AppendToObj(resultPtr,
+			    "\"-index\" option must be followed by list index",
+			    -1);
+		    return TCL_ERROR;
+		}
+		if (Tcl_GetLongFromObj(interp, objv[i+1], &sortInfo.index)
+			!= TCL_OK) {
+		    if (strcmp("end", Tcl_GetStringFromObj(objv[i+1], &dummy))
+			    == 0) {
+			sortInfo.index = -2;
+		    } else {
+			return TCL_ERROR;
+		    }
+		}
+		cmdPtr = objv[i+1];
+		i++;
+		break;
+	    case 6:			/* -integer */
+		sortInfo.sortMode = SORTMODE_INTEGER;
+		break;
+	    case 7:			/* -real */
+		sortInfo.sortMode = SORTMODE_REAL;
+		break;
 	}
     }
-    if (sortMode == COMMAND) {
-	Tcl_DStringInit(&sortCmd);
-	Tcl_DStringAppend(&sortCmd, command, -1);
+    if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_DStringInit(&sortInfo.compareCmd);
+	Tcl_DStringAppend(&sortInfo.compareCmd,
+		Tcl_GetStringFromObj(cmdPtr, &dummy), -1);
     }
 
-    if (Tcl_SplitList(interp, argv[argc-1], &listArgc, &listArgv) != TCL_OK) {
-	sortCode = TCL_ERROR;
+    sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
+	    &length, &listObjPtrs);
+    if (sortInfo.resultCode != TCL_OK) {
 	goto done;
     }
-    qsort((VOID *) listArgv, (size_t) listArgc, sizeof (char *),
-	    SortCompareProc);
-    if (sortCode == TCL_OK) {
-	Tcl_ResetResult(interp);
-	interp->result = Tcl_Merge(listArgc, listArgv);
-	interp->freeProc = TCL_DYNAMIC;
+    if (length <= 0) {
+        return TCL_OK;
+    }
+    elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
+    for (i=0; i < length; i++){
+	elementArray[i].objPtr = listObjPtrs[i];
+	elementArray[i].nextPtr = &elementArray[i+1];
     }
-    if (sortMode == COMMAND) {
-	Tcl_DStringFree(&sortCmd);
+    elementArray[length-1].nextPtr = NULL;
+    elementPtr = MergeSort(elementArray, &sortInfo);
+    if (sortInfo.resultCode == TCL_OK) {
+	/*
+	 * Note: must clear the interpreter's result object: it could
+	 * have been set by the -command script.
+	 */
+
+	Tcl_ResetResult(interp);
+	resultPtr = Tcl_GetObjResult(interp);
+	for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+	    Tcl_ListObjAppendElement(interp, resultPtr, elementPtr->objPtr);
+	}
     }
-    ckfree((char *) listArgv);
+    ckfree((char*) elementArray);
 
     done:
-    sortInterp = NULL;
-    return sortCode;
+    if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_DStringFree(&sortInfo.compareCmd);
+    }
+    return sortInfo.resultCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MergeSort -
+ *
+ *	This procedure sorts a linked list of SortElement structures
+ *	use the merge-sort algorithm.
+ *
+ * Results:
+ *      A pointer to the head of the list after sorting is returned.
+ *
+ * Side effects:
+ *	None, unless a user-defined comparison command does something
+ *	weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SortElement *
+MergeSort(headPtr, infoPtr)
+    SortElement *headPtr;               /* First element on the list */
+    SortInfo *infoPtr;                  /* Information needed by the
+                                         * comparison operator */
+{
+    /*
+     * The subList array below holds pointers to temporary lists built
+     * during the merge sort.  Element i of the array holds a list of
+     * length 2**i.
+     */
+
+#   define NUM_LISTS 30
+    SortElement *subList[NUM_LISTS];
+    SortElement *elementPtr;
+    int i;
+
+    for(i = 0; i < NUM_LISTS; i++){
+        subList[i] = NULL;
+    }
+    while (headPtr != NULL) {
+	elementPtr = headPtr;
+	headPtr = headPtr->nextPtr;
+	elementPtr->nextPtr = 0;
+	for (i = 0; (i < NUM_LISTS) && (subList[i] != NULL); i++){
+	    elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+	    subList[i] = NULL;
+	}
+	if (i >= NUM_LISTS) {
+	    i = NUM_LISTS-1;
+	}
+	subList[i] = elementPtr;
+    }
+    elementPtr = NULL;
+    for (i = 0; i < NUM_LISTS; i++){
+        elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+    }
+    return elementPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SortCompareProc --
+ * MergeLists -
+ *
+ *	This procedure combines two sorted lists of SortElement structures
+ *	into a single sorted list.
+ *
+ * Results:
+ *      The unified list of SortElement structures.
+ *
+ * Side effects:
+ *	None, unless a user-defined comparison command does something
+ *	weird.
  *
- *	This procedure is invoked by qsort to determine the proper
+ *----------------------------------------------------------------------
+ */
+
+static SortElement *
+MergeLists(leftPtr, rightPtr, infoPtr)
+    SortElement *leftPtr;               /* First list to be merged; may be
+					 * NULL. */
+    SortElement *rightPtr;              /* Second list to be merged; may be
+					 * NULL. */
+    SortInfo *infoPtr;                  /* Information needed by the
+                                         * comparison operator. */
+{
+    SortElement *headPtr;
+    SortElement *tailPtr;
+
+    if (leftPtr == NULL) {
+        return rightPtr;
+    }
+    if (rightPtr == NULL) {
+        return leftPtr;
+    }
+    if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+	tailPtr = rightPtr;
+	rightPtr = rightPtr->nextPtr;
+    } else {
+	tailPtr = leftPtr;
+	leftPtr = leftPtr->nextPtr;
+    }
+    headPtr = tailPtr;
+    while ((leftPtr != NULL) && (rightPtr != NULL)) {
+	if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+	    tailPtr->nextPtr = rightPtr;
+	    tailPtr = rightPtr;
+	    rightPtr = rightPtr->nextPtr;
+	} else {
+	    tailPtr->nextPtr = leftPtr;
+	    tailPtr = leftPtr;
+	    leftPtr = leftPtr->nextPtr;
+	}
+    }
+    if (leftPtr != NULL) {
+       tailPtr->nextPtr = leftPtr;
+    } else {
+       tailPtr->nextPtr = rightPtr;
+    }
+    return headPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SortCompare --
+ *
+ *	This procedure is invoked by MergeLists to determine the proper
  *	ordering between two elements.
  *
  * Results:
- *	< 0 means first is "smaller" than "second", > 0 means "first"
- *	is larger than "second", and 0 means they should be treated
- *	as equal.
+ *      A negative results means the the first element comes before the
+ *      second, and a positive results means that the second element
+ *      should come first.  A result of zero means the two elements
+ *      are equal and it doesn't matter which comes first.
  *
  * Side effects:
  *	None, unless a user-defined comparison command does something
@@ -1402,15 +2631,17 @@ Tcl_LsortCmd(notUsed, interp, argc, argv)
  */
 
 static int
-SortCompareProc(first, second)
-    CONST VOID *first, *second;		/* Elements to be compared. */
+SortCompare(objPtr1, objPtr2, infoPtr)
+    Tcl_Obj *objPtr1, *objPtr2;		/* Values to be compared. */
+    SortInfo *infoPtr;                  /* Information passed from the
+                                         * top-level "lsort" command */
 {
-    int order;
-    char *firstString = *((char **) first);
-    char *secondString = *((char **) second);
+    int order, dummy, listLen, index;
+    Tcl_Obj *objPtr;
+    char buffer[30];
 
     order = 0;
-    if (sortCode != TCL_OK) {
+    if (infoPtr->resultCode != TCL_OK) {
 	/*
 	 * Once an error has occurred, skip any future comparisons
 	 * so as to preserve the error message in sortInterp->result.
@@ -1418,16 +2649,77 @@ SortCompareProc(first, second)
 
 	return order;
     }
-    if (sortMode == ASCII) {
-	order = strcmp(firstString, secondString);
-    } else if (sortMode == INTEGER) {
+    if (infoPtr->index != -1) {
+	/*
+	 * The "-index" option was specified.  Treat each object as a
+	 * list, extract the requested element from each list, and
+	 * compare the elements, not the lists.  The special index "end"
+	 * is signaled here with a large negative index.
+	 */
+
+	if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (infoPtr->index < -1) {
+	    index = listLen - 1;
+	} else {
+	    index = infoPtr->index;
+	}
+
+	if (Tcl_ListObjIndex(infoPtr->interp, objPtr1, index, &objPtr)
+		!= TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (objPtr == NULL) {
+	    objPtr = objPtr1;
+	    missingElement:
+	    sprintf(buffer, "%ld", infoPtr->index);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+			"element ", buffer, " missing from sublist \"",
+			Tcl_GetStringFromObj(objPtr, (int *) NULL),
+			"\"", (char *) NULL);
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	objPtr1 = objPtr;
+
+	if (Tcl_ListObjLength(infoPtr->interp, objPtr2, &listLen) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (infoPtr->index < -1) {
+	    index = listLen - 1;
+	} else {
+	    index = infoPtr->index;
+	}
+
+	if (Tcl_ListObjIndex(infoPtr->interp, objPtr2, index, &objPtr)
+		!= TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (objPtr == NULL) {
+	    objPtr = objPtr2;
+	    goto missingElement;
+	}
+	objPtr2 = objPtr;
+    }
+    if (infoPtr->sortMode == SORTMODE_ASCII) {
+	order = strcmp(Tcl_GetStringFromObj(objPtr1, &dummy),
+		Tcl_GetStringFromObj(objPtr2, &dummy));
+    } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
+	order = DictionaryCompare(
+		Tcl_GetStringFromObj(objPtr1, &dummy),
+		Tcl_GetStringFromObj(objPtr2, &dummy));
+    } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
 	int a, b;
 
-	if ((Tcl_GetInt(sortInterp, firstString, &a) != TCL_OK)
-		|| (Tcl_GetInt(sortInterp, secondString, &b) != TCL_OK)) {
-	    Tcl_AddErrorInfo(sortInterp,
-		    "\n    (converting list element from string to integer)");
-	    sortCode = TCL_ERROR;
+	if ((Tcl_GetIntFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
+		|| (Tcl_GetIntFromObj(infoPtr->interp, objPtr2, &b)
+		!= TCL_OK)) {
+	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
 	if (a > b) {
@@ -1435,14 +2727,13 @@ SortCompareProc(first, second)
 	} else if (b > a) {
 	    order = -1;
 	}
-    } else if (sortMode == REAL) {
+    } else if (infoPtr->sortMode == SORTMODE_REAL) {
 	double a, b;
 
-	if ((Tcl_GetDouble(sortInterp, firstString, &a) != TCL_OK)
-		|| (Tcl_GetDouble(sortInterp, secondString, &b) != TCL_OK)) {
-	    Tcl_AddErrorInfo(sortInterp,
-		    "\n    (converting list element from string to real)");
-	    sortCode = TCL_ERROR;
+	if ((Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
+	      || (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr2, &b)
+		      != TCL_OK)) {
+	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
 	if (a > b) {
@@ -1452,21 +2743,23 @@ SortCompareProc(first, second)
 	}
     } else {
 	int oldLength;
-	char *end;
 
 	/*
 	 * Generate and evaluate a command to determine which string comes
 	 * first.
 	 */
 
-	oldLength = Tcl_DStringLength(&sortCmd);
-	Tcl_DStringAppendElement(&sortCmd, firstString);
-	Tcl_DStringAppendElement(&sortCmd, secondString);
-	sortCode = Tcl_Eval(sortInterp, Tcl_DStringValue(&sortCmd));
-	Tcl_DStringTrunc(&sortCmd, oldLength);
-	if (sortCode != TCL_OK) {
-	    Tcl_AddErrorInfo(sortInterp,
-		    "\n    (user-defined comparison command)");
+	oldLength = Tcl_DStringLength(&infoPtr->compareCmd);
+	Tcl_DStringAppendElement(&infoPtr->compareCmd,
+		Tcl_GetStringFromObj(objPtr1, &dummy));
+	Tcl_DStringAppendElement(&infoPtr->compareCmd,
+		Tcl_GetStringFromObj(objPtr2, &dummy));
+	infoPtr->resultCode = Tcl_Eval(infoPtr->interp, 
+		Tcl_DStringValue(&infoPtr->compareCmd));
+	Tcl_DStringTrunc(&infoPtr->compareCmd, oldLength);
+	if (infoPtr->resultCode != TCL_OK) {
+	    Tcl_AddErrorInfo(infoPtr->interp,
+		    "\n    (-compare command)");
 	    return order;
 	}
 
@@ -1474,18 +2767,137 @@ SortCompareProc(first, second)
 	 * Parse the result of the command.
 	 */
 
-	order = strtol(sortInterp->result, &end, 0);
-	if ((end == sortInterp->result) || (*end != 0)) {
-	    Tcl_ResetResult(sortInterp);
-	    Tcl_AppendResult(sortInterp,
-		    "comparison command returned non-numeric result",
-		    (char *) NULL);
-	    sortCode = TCL_ERROR;
+	if (Tcl_GetIntFromObj(infoPtr->interp,
+		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
+	    Tcl_ResetResult(infoPtr->interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp),
+		    "-compare command returned non-numeric result", -1);
+	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
     }
-    if (!sortIncreasing) {
+    if (!infoPtr->isIncreasing) {
 	order = -order;
     }
     return order;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictionaryCompare
+ *
+ *	This function compares two strings as if they were being used in
+ *	an index or card catalog.  The case of alphabetic characters is
+ *	ignored, except to break ties.  Thus "B" comes before "b" but
+ *	after "a".  Also, integers embedded in the strings compare in
+ *	numerical order.  In other words, "x10y" comes after "x9y", not
+ *      before it as it would when using strcmp().
+ *
+ * Results:
+ *      A negative result means that the first element comes before the
+ *      second, and a positive result means that the second element
+ *      should come first.  A result of zero means the two elements
+ *      are equal and it doesn't matter which comes first.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictionaryCompare(left, right)
+    char *left, *right;          /* The strings to compare */
+{
+    int diff, zeros;
+    int secondaryDiff = 0;
+
+    while (1) {
+	if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
+	    /*
+	     * There are decimal numbers embedded in the two
+	     * strings.  Compare them as numbers, rather than
+	     * strings.  If one number has more leading zeros than
+	     * the other, the number with more leading zeros sorts
+	     * later, but only as a secondary choice.
+	     */
+
+	    zeros = 0;
+	    while (*right == '0') {
+		right++;
+		zeros--;
+	    }
+	    while (*left == '0') {
+		left++;
+		zeros++;
+	    }
+	    if (secondaryDiff == 0) {
+		secondaryDiff = zeros;
+	    }
+
+	    /*
+	     * The code below compares the numbers in the two
+	     * strings without ever converting them to integers.  It
+	     * does this by first comparing the lengths of the
+	     * numbers and then comparing the digit values.
+	     */
+
+	    diff = 0;
+	    while (1) {
+		if (diff == 0) {
+		    diff = *left - *right;
+		}
+		right++;
+		left++;
+		if (!isdigit(UCHAR(*right))) {
+		    if (isdigit(UCHAR(*left))) {
+			return 1;
+		    } else {
+			/*
+			 * The two numbers have the same length. See
+			 * if their values are different.
+			 */
+
+			if (diff != 0) {
+			    return diff;
+			}
+			break;
+		    }
+		} else if (!isdigit(UCHAR(*left))) {
+		    return -1;
+		}
+	    }
+	    continue;
+	}
+        diff = *left - *right;
+        if (diff) {
+            if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
+                diff = tolower(*left) - *right;
+                if (diff) {
+		    return diff;
+                } else if (secondaryDiff == 0) {
+		    secondaryDiff = -1;
+                }
+            } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
+                diff = *left - tolower(UCHAR(*right));
+                if (diff) {
+		    return diff;
+                } else if (secondaryDiff == 0) {
+		    secondaryDiff = 1;
+                }
+            } else {
+                return diff;
+            }
+        }
+        if (*left == 0) {
+	    break;
+	}
+        left++;
+        right++;
+    }
+    if (diff == 0) {
+	diff = secondaryDiff;
+    }
+    return diff;
+}
diff --git a/contrib/tcl/generic/tclCmdMZ.c b/contrib/tcl/generic/tclCmdMZ.c
index 5158dde..ec1f737 100644
--- a/contrib/tcl/generic/tclCmdMZ.c
+++ b/contrib/tcl/generic/tclCmdMZ.c
@@ -7,16 +7,17 @@
  *	those that don't depend much upon UNIX facilities).
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclCmdMZ.c 1.66 96/07/23 16:15:55
+ * SCCS: @(#) tclCmdMZ.c 1.99 97/05/19 17:37:17
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
+#include "tclCompile.h"
 
 /*
  * Structure used to hold information about variable traces:
@@ -80,7 +81,7 @@ Tcl_PwdCmd(dummy, interp, argc, argv)
     if (dirName == NULL) {
 	return TCL_ERROR;
     }
-    interp->result = dirName;
+    Tcl_SetResult(interp, dirName, TCL_VOLATILE);
     return TCL_OK;
 }
 
@@ -191,7 +192,7 @@ Tcl_RegexpCmd(dummy, interp, argc, argv)
 	return TCL_ERROR;
     }
     if (!match) {
-	interp->result = "0";
+	Tcl_SetResult(interp, "0", TCL_STATIC);
 	return TCL_OK;
     }
 
@@ -221,10 +222,14 @@ Tcl_RegexpCmd(dummy, interp, argc, argv)
 
 		first = argPtr[1] + (start - string);
 		last = argPtr[1] + (end - string);
-		savedChar = *last;
-		*last = 0;
-		result = Tcl_SetVar(interp, argPtr[i+2], first, 0);
-		*last = savedChar;
+		if (first == last) { /* don't modify argument */
+		    result = Tcl_SetVar(interp, argPtr[i+2], "", 0);
+		} else {
+		    savedChar = *last;
+		    *last = 0;
+		    result = Tcl_SetVar(interp, argPtr[i+2], first, 0);
+		    *last = savedChar;
+		}
 	    }
 	}
 	if (result == NULL) {
@@ -233,7 +238,7 @@ Tcl_RegexpCmd(dummy, interp, argc, argv)
 	    return TCL_ERROR;
 	}
     }
-    interp->result = "1";
+    Tcl_SetResult(interp, "1", TCL_STATIC);
     return TCL_OK;
 }
 
@@ -264,11 +269,11 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 {
     int noCase = 0, all = 0;
     Tcl_RegExp regExpr;
-    char *string, *pattern, *p, *firstChar, *newValue, **argPtr;
-    int match, flags, code, numMatches;
+    char *string, *pattern, *p, *firstChar, **argPtr;
+    int match, code, numMatches;
     char *start, *end, *subStart, *subEnd;
     register char *src, c;
-    Tcl_DString stringDString, patternDString;
+    Tcl_DString stringDString, patternDString, resultDString;
 
     if (argc < 5) {
 	wrongNumArgs:
@@ -324,6 +329,7 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 	pattern = argPtr[0];
 	string = argPtr[1];
     }
+    Tcl_DStringInit(&resultDString);
     regExpr = Tcl_RegExpCompile(interp, pattern);
     if (regExpr == NULL) {
 	code = TCL_ERROR;
@@ -337,7 +343,6 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
      * then the loop body only gets executed once.
      */
 
-    flags = 0;
     numMatches = 0;
     for (p = string; *p != 0; ) {
 	match = Tcl_RegExpExec(interp, regExpr, p, string);
@@ -356,20 +361,7 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 	 */
 
 	Tcl_RegExpRange(regExpr, 0, &start, &end);
-	src = argPtr[1] + (start - string);
-	c = *src;
-	*src = 0;
-	newValue = Tcl_SetVar(interp, argPtr[3], argPtr[1] + (p - string),
-		flags);
-	*src = c;
-	flags = TCL_APPEND_VALUE;
-	if (newValue == NULL) {
-	    cantSet:
-	    Tcl_AppendResult(interp, "couldn't set variable \"",
-		    argPtr[3], "\"", (char *) NULL);
-	    code = TCL_ERROR;
-	    goto done;
-	}
+	Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), start - p);
     
 	/*
 	 * Append the subSpec argument to the variable, making appropriate
@@ -390,13 +382,9 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 		} else if ((c == '\\') || (c == '&')) {
 		    *src = c;
 		    src[1] = 0;
-		    newValue = Tcl_SetVar(interp, argPtr[3], firstChar,
-			    TCL_APPEND_VALUE);
+		    Tcl_DStringAppend(&resultDString, firstChar, -1);
 		    *src = '\\';
 		    src[1] = c;
-		    if (newValue == NULL) {
-			goto cantSet;
-		    }
 		    firstChar = src+2;
 		    src++;
 		    continue;
@@ -409,12 +397,8 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 	    if (firstChar != src) {
 		c = *src;
 		*src = 0;
-		newValue = Tcl_SetVar(interp, argPtr[3], firstChar,
-			TCL_APPEND_VALUE);
+		Tcl_DStringAppend(&resultDString, firstChar, -1);
 		*src = c;
-		if (newValue == NULL) {
-		    goto cantSet;
-		}
 	    }
 	    Tcl_RegExpRange(regExpr, index, &subStart, &subEnd);
 	    if ((subStart != NULL) && (subEnd != NULL)) {
@@ -424,12 +408,8 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 		last = argPtr[1] + (subEnd - string);
 		saved = *last;
 		*last = 0;
-		newValue = Tcl_SetVar(interp, argPtr[3], first,
-			TCL_APPEND_VALUE);
+		Tcl_DStringAppend(&resultDString, first, -1);
 		*last = saved;
-		if (newValue == NULL) {
-		    goto cantSet;
-		}
 	    }
 	    if (*src == '\\') {
 		src++;
@@ -437,25 +417,16 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 	    firstChar = src+1;
 	}
 	if (firstChar != src) {
-	    if (Tcl_SetVar(interp, argPtr[3], firstChar,
-		    TCL_APPEND_VALUE) == NULL) {
-		goto cantSet;
-	    }
+	    Tcl_DStringAppend(&resultDString, firstChar, -1);
 	}
 	if (end == p) {
-	    char tmp[2];
 
 	    /*
 	     * Always consume at least one character of the input string
 	     * in order to prevent infinite loops.
 	     */
 
-	    tmp[0] = argPtr[1][p - string];
-	    tmp[1] = 0;
-	    newValue = Tcl_SetVar(interp, argPtr[3], tmp, flags);
-	    if (newValue == NULL) {
-		goto cantSet;
-	    }
+	    Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), 1);
 	    p = end + 1;
 	} else {
 	    p = end;
@@ -471,32 +442,41 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
      */
 
     if ((*p != 0) || (numMatches == 0)) {
-	if (Tcl_SetVar(interp, argPtr[3], argPtr[1] + (p - string), 
-		flags) == NULL) {
-	    goto cantSet;
-	}
+	Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), -1);
+    }
+    if (Tcl_SetVar(interp, argPtr[3], Tcl_DStringValue(&resultDString), 0)
+	     == NULL) {
+	Tcl_AppendResult(interp,
+		"couldn't set variable \"", argPtr[3], "\"",
+		(char *) NULL);
+	code = TCL_ERROR;
+    } else {
+	char buf[40];
+	
+	TclFormatInt(buf, numMatches);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	code = TCL_OK;
     }
-    sprintf(interp->result, "%d", numMatches);
-    code = TCL_OK;
 
     done:
     if (noCase) {
 	Tcl_DStringFree(&stringDString);
 	Tcl_DStringFree(&patternDString);
     }
+    Tcl_DStringFree(&resultDString);
     return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_RenameCmd --
+ * Tcl_RenameObjCmd --
  *
  *	This procedure is invoked to process the "rename" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -506,114 +486,34 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_RenameCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_RenameObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Arbitrary value passed to the command. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    register Command *cmdPtr;
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr;
-    int new;
-    char *srcName, *dstName;
-
-    if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" oldName newName\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-    if (argv[2][0] == '\0') {
-	if (Tcl_DeleteCommand(interp, argv[1]) != 0) {
-	    Tcl_AppendResult(interp, "can't delete \"", argv[1],
-		    "\": command doesn't exist", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	return TCL_OK;
-    }
-
-    srcName = argv[1];
-    dstName = argv[2];
-    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, dstName);
-    if (hPtr != NULL) {
-	Tcl_AppendResult(interp, "can't rename to \"", argv[2],
-		"\": command already exists", (char *) NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * The code below was added in 11/95 to preserve backwards compatibility
-     * when "tkerror" was renamed "bgerror":  we guarantee that the hash
-     * table entries for both commands refer to a single shared Command
-     * structure.  This code should eventually become unnecessary.
-     */
-
-    if ((srcName[0] == 't') && (strcmp(srcName, "tkerror") == 0)) {
-	srcName = "bgerror";
-    }
-    dstName = argv[2];
-    if ((dstName[0] == 't') && (strcmp(dstName, "tkerror") == 0)) {
-	dstName = "bgerror";
-    }
-
-    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, srcName);
-    if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "can't rename \"", argv[1],
-		"\": command doesn't exist", (char *) NULL);
-	return TCL_ERROR;
-    }
-    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
-
-    /*
-     * Prevent formation of alias loops through renaming.
-     */
+    char *oldName, *newName;
     
-    if (TclPreventAliasLoop(interp, interp, dstName, cmdPtr->proc,
-            cmdPtr->clientData) != TCL_OK) {
-        return TCL_ERROR;
-    }
-
-    Tcl_DeleteHashEntry(hPtr);
-    hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, dstName, &new);
-    Tcl_SetHashValue(hPtr, cmdPtr);
-    cmdPtr->hPtr = hPtr;
-
-    /*
-     * The code below provides more backwards compatibility for the
-     * "tkerror" => "bgerror" renaming.  As with the other compatibility
-     * code above, it should eventually be removed.
-     */
-
-    if ((dstName[0] == 'b') && (strcmp(dstName, "bgerror") == 0)) {
-	/*
-	 * The destination command is "bgerror";  create a "tkerror"
-	 * command that shares the same Command structure.
-	 */
-
-	hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, "tkerror", &new);
-	Tcl_SetHashValue(hPtr, cmdPtr);
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
+	return TCL_ERROR;
     }
-    if ((srcName[0] == 'b') && (strcmp(srcName, "bgerror") == 0)) {
-	/*
-	 * The source command is "bgerror":  delete the hash table
-	 * entry for "tkerror" if it exists.
-	 */
 
-	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&iPtr->commandTable, "tkerror"));
-    }
-    return TCL_OK;
+    oldName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    newName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    return TclRenameCommand(interp, oldName, newName);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ReturnCmd --
+ * Tcl_ReturnObjCmd --
  *
- *	This procedure is invoked to process the "return" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "return" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -623,14 +523,14 @@ Tcl_RenameCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ReturnCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ReturnObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    int c, code;
+    int optionLen, argLen, code, result;
 
     if (iPtr->errorInfo != NULL) {
 	ckfree(iPtr->errorInfo);
@@ -641,41 +541,64 @@ Tcl_ReturnCmd(dummy, interp, argc, argv)
 	iPtr->errorCode = NULL;
     }
     code = TCL_OK;
-    for (argv++, argc--; argc > 1; argv += 2, argc -= 2) {
-	if (strcmp(argv[0], "-code") == 0) {
-	    c = argv[1][0];
-	    if ((c == 'o') && (strcmp(argv[1], "ok") == 0)) {
+
+   /*
+    * THIS FAILS IF AN OBJECT CONTAINS AN EMBEDDED NULL.
+    */
+    
+    for (objv++, objc--;  objc > 1;  objv += 2, objc -= 2) {
+	char *option = Tcl_GetStringFromObj(objv[0], &optionLen);
+	char *arg = Tcl_GetStringFromObj(objv[1], &argLen);
+    	
+	if (strcmp(option, "-code") == 0) {
+	    register int c = arg[0];
+	    if ((c == 'o') && (strcmp(arg, "ok") == 0)) {
 		code = TCL_OK;
-	    } else if ((c == 'e') && (strcmp(argv[1], "error") == 0)) {
+	    } else if ((c == 'e') && (strcmp(arg, "error") == 0)) {
 		code = TCL_ERROR;
-	    } else if ((c == 'r') && (strcmp(argv[1], "return") == 0)) {
+	    } else if ((c == 'r') && (strcmp(arg, "return") == 0)) {
 		code = TCL_RETURN;
-	    } else if ((c == 'b') && (strcmp(argv[1], "break") == 0)) {
+	    } else if ((c == 'b') && (strcmp(arg, "break") == 0)) {
 		code = TCL_BREAK;
-	    } else if ((c == 'c') && (strcmp(argv[1], "continue") == 0)) {
+	    } else if ((c == 'c') && (strcmp(arg, "continue") == 0)) {
 		code = TCL_CONTINUE;
-	    } else if (Tcl_GetInt(interp, argv[1], &code) != TCL_OK) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "bad completion code \"",
-			argv[1], "\": must be ok, error, return, break, ",
-			"continue, or an integer", (char *) NULL);
-		return TCL_ERROR;
+	    } else {
+		result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objv[1],
+		        &code);
+		if (result != TCL_OK) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			    "bad completion code \"",
+			    Tcl_GetStringFromObj(objv[1], (int *) NULL),
+			    "\": must be ok, error, return, break, ",
+			    "continue, or an integer", (char *) NULL);
+		    return result;
+		}
 	    }
-	} else if (strcmp(argv[0], "-errorinfo") == 0) {
-	    iPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(argv[1]) + 1));
-	    strcpy(iPtr->errorInfo, argv[1]);
-	} else if (strcmp(argv[0], "-errorcode") == 0) {
-	    iPtr->errorCode = (char *) ckalloc((unsigned) (strlen(argv[1]) + 1));
-	    strcpy(iPtr->errorCode, argv[1]);
+	} else if (strcmp(option, "-errorinfo") == 0) {
+	    iPtr->errorInfo =
+		(char *) ckalloc((unsigned) (strlen(arg) + 1));
+	    strcpy(iPtr->errorInfo, arg);
+	} else if (strcmp(option, "-errorcode") == 0) {
+	    iPtr->errorCode =
+		(char *) ckalloc((unsigned) (strlen(arg) + 1));
+	    strcpy(iPtr->errorCode, arg);
 	} else {
-	    Tcl_AppendResult(interp, "bad option \"", argv[0],
-		    ": must be -code, -errorcode, or -errorinfo",
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "bad option \"", option,
+		    "\": must be -code, -errorcode, or -errorinfo",
 		    (char *) NULL);
 	    return TCL_ERROR;
 	}
     }
-    if (argc == 1) {
-	Tcl_SetResult(interp, argv[0], TCL_VOLATILE);
+    
+    if (objc == 1) {
+	/*
+	 * Set the interpreter's object result. An inline version of
+	 * Tcl_SetObjResult.
+	 */
+
+	Tcl_SetObjResult(interp, objv[0]);
     }
     iPtr->returnCode = code;
     return TCL_RETURN;
@@ -728,6 +651,7 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
     int numScanned;			/* sscanf's result. */
     register char *fmt;
     int i, widthSpecified, length, code;
+    char buf[40];
 
     /*
      * The variables below are used to hold a copy of the format
@@ -799,7 +723,7 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 	    continue;
 	}
 	if (numFields == MAX_FIELDS) {
-	    interp->result = "too many fields to scan";
+	    Tcl_SetResult(interp, "too many fields to scan", TCL_STATIC);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -826,8 +750,9 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 
 	    case 'c':
                 if (widthSpecified) {
-                    interp->result = 
-                         "field width may not be specified in %c conversion";
+		    Tcl_SetResult(interp,
+		            "field width may not be specified in %c conversion",
+			    TCL_STATIC);
 		    code = TCL_ERROR;
 		    goto done;
                 }
@@ -851,7 +776,8 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 		do {
 		    fmt++;
 		    if (*fmt == 0) {
-			interp->result = "unmatched [ in format string";
+			Tcl_SetResult(interp,
+			        "unmatched [ in format string", TCL_STATIC);
 			code = TCL_ERROR;
 			goto done;
 		    }
@@ -861,10 +787,14 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 		break;
 
 	    default:
-		sprintf(interp->result, "bad scan conversion character \"%c\"",
-			*fmt);
-		code = TCL_ERROR;
-		goto done;
+		{
+		    char buf[50];
+
+		    sprintf(buf, "bad scan conversion character \"%c\"", *fmt);
+		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    code = TCL_ERROR;
+		    goto done;
+		}
 	}
 	curField->size = TCL_ALIGN(curField->size);
 	totalSize += curField->size;
@@ -872,8 +802,9 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
     *dst = 0;
 
     if (numFields != (argc-3)) {
-	interp->result =
-		"different numbers of variable names and field specifiers";
+	Tcl_SetResult(interp,
+		"different numbers of variable names and field specifiers",
+		TCL_STATIC);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -924,7 +855,7 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 	    char string[TCL_DOUBLE_SPACE];
 
 	    case 'd':
-		sprintf(string, "%d", *((int *) curField->location));
+		TclFormatInt(string, *((int *) curField->location));
 		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
 		    storeError:
 		    Tcl_AppendResult(interp,
@@ -943,7 +874,7 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 		break;
 
 	    case 'c':
-		sprintf(string, "%d", *((char *) curField->location) & 0xff);
+		TclFormatInt(string, *((char *) curField->location) & 0xff);
 		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
 		    goto storeError;
 		}
@@ -957,15 +888,16 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 		break;
 
 	    case 'f':
-		Tcl_PrintDouble(interp, *((double *) curField->location),
-			string);
+		Tcl_PrintDouble((Tcl_Interp *) NULL,
+			*((double *) curField->location), string);
 		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
 		    goto storeError;
 		}
 		break;
 	}
     }
-    sprintf(interp->result, "%d", numScanned);
+    TclFormatInt(buf, numScanned);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
     done:
     if (results != NULL) {
 	ckfree(results);
@@ -979,13 +911,13 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SourceCmd --
+ * Tcl_SourceObjCmd --
  *
  *	This procedure is invoked to process the "source" Tcl command.
  *	See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -995,18 +927,27 @@ Tcl_ScanCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_SourceCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_SourceObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" fileName\"", (char *) NULL);
+    char *bytes;
+    int result;
+    
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
 	return TCL_ERROR;
     }
-    return Tcl_EvalFile(interp, argv[1]);
+
+    /*
+     * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS A NULL.
+     */
+
+    bytes = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    result = Tcl_EvalFile(interp, bytes);
+    return result;
 }
 
 /*
@@ -1088,7 +1029,7 @@ Tcl_SplitCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_StringCmd --
+ * Tcl_StringObjCmd --
  *
  *	This procedure is invoked to process the "string" Tcl command.
  *	See the user documentation for details on what it does.
@@ -1104,312 +1045,338 @@ Tcl_SplitCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_StringCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_StringObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    size_t length;
-    register char *p;
-    int match, c, first;
-    int left = 0, right = 0;
-
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option arg ?arg ...?\"", (char *) NULL);
+    int index, first, left, right;
+    Tcl_Obj *resultPtr;
+    char *string1, *string2;
+    int length1, length2;
+    static char *options[] = {
+	"compare",	"first",	"index",	"last",
+	"length",	"match",	"range",	"tolower",
+	"toupper",	"trim",		"trimleft",	"trimright",
+	"wordend",	"wordstart",	NULL
+    };
+    enum options {
+	STR_COMPARE,	STR_FIRST,	STR_INDEX,	STR_LAST,
+	STR_LENGTH,	STR_MATCH,	STR_RANGE,	STR_TOLOWER,
+	STR_TOUPPER,	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
+	STR_WORDEND,	STR_WORDSTART
+    };	  
+	    
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
 	return TCL_ERROR;
     }
-    c = argv[1][0];
-    length = strlen(argv[1]);
-    if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " compare string1 string2\"", (char *) NULL);
-	    return TCL_ERROR;
+    
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_GetObjResult(interp);
+    switch ((enum options) index) {
+	case STR_COMPARE: {
+	    int match, length;
+
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+
+	    length = (length1 < length2) ? length1 : length2;
+	    match = memcmp(string1, string2, (unsigned) length);
+	    if (match == 0) {
+	        match = length1 - length2;
+	    }
+	    Tcl_SetIntObj(resultPtr, (match > 0) ? 1 : (match < 0) ? -1 : 0);
+	    break;
 	}
-	match = strcmp(argv[2], argv[3]);
-	if (match > 0) {
-	    interp->result = "1";
-	} else if (match < 0) {
-	    interp->result = "-1";
-	} else {
-	    interp->result = "0";
+	case STR_FIRST: {
+	    first = 1;
+	    goto firstlast;
 	}
-	return TCL_OK;
-    } else if ((c == 'f') && (strncmp(argv[1], "first", length) == 0)) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " first string1 string2\"", (char *) NULL);
-	    return TCL_ERROR;
+	case STR_INDEX: {
+	    int index;
+
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if ((index >= 0) && (index < length1)) {
+	        Tcl_SetStringObj(resultPtr, string1 + index, 1);
+	    }
+	    break;
 	}
-	first = 1;
+	case STR_LAST: {
+	    char *p, *end;
+	    int match;
 
-	firstLast:
-	match = -1;
-	c = *argv[2];
-	length = strlen(argv[2]);
-	for (p = argv[3]; *p != 0; p++) {
-	    if (*p != c) {
-		continue;
+	    first = 0;
+
+	    firstlast:
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+		return TCL_ERROR;
 	    }
-	    if (strncmp(argv[2], p, length) == 0) {
-		match = p-argv[3];
-		if (first) {
-		    break;
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    match = -1;
+	    end = string2 + length2 - length1 + 1;
+	    for (p = string2; p < end; p++) {
+		if (memcmp(string1, p, (unsigned) length1) == 0) {
+		    match = p - string2;
+		    if (first) {
+		        break;
+		    }
 		}
 	    }
+	    Tcl_SetIntObj(resultPtr, match);
+	    break;
 	}
-	sprintf(interp->result, "%d", match);
-	return TCL_OK;
-    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)) {
-	int index;
+	case STR_LENGTH: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
+	    }
 
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " index string charIndex\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetInt(interp, argv[3], &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if ((index >= 0) && (index < (int) strlen(argv[2]))) {
-	    interp->result[0] = argv[2][index];
-	    interp->result[1] = 0;
-	}
-	return TCL_OK;
-    } else if ((c == 'l') && (strncmp(argv[1], "last", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " last string1 string2\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	first = 0;
-	goto firstLast;
-    } else if ((c == 'l') && (strncmp(argv[1], "length", length) == 0)
-	    && (length >= 2)) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " length string\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	sprintf(interp->result, "%d", strlen(argv[2]));
-	return TCL_OK;
-    } else if ((c == 'm') && (strncmp(argv[1], "match", length) == 0)) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " match pattern string\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_StringMatch(argv[3], argv[2]) != 0) {
-	    interp->result = "1";
-	} else {
-	    interp->result = "0";
+	    (void) Tcl_GetStringFromObj(objv[2], &length1);
+	    Tcl_SetIntObj(resultPtr, length1);
+	    break;
 	}
-	return TCL_OK;
-    } else if ((c == 'r') && (strncmp(argv[1], "range", length) == 0)) {
-	int first, last, stringLength;
+	case STR_MATCH: {
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "pattern string");
+		return TCL_ERROR;
+	    }
 
-	if (argc != 5) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " range string first last\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	stringLength = strlen(argv[2]);
-	if (Tcl_GetInt(interp, argv[3], &first) != TCL_OK) {
-	    return TCL_ERROR;
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    Tcl_SetBooleanObj(resultPtr, Tcl_StringMatch(string2, string1));
+	    break;
 	}
-	if ((*argv[4] == 'e')
-		&& (strncmp(argv[4], "end", strlen(argv[4])) == 0)) {
-	    last = stringLength-1;
-	} else {
-	    if (Tcl_GetInt(interp, argv[4], &last) != TCL_OK) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp,
-			"expected integer or \"end\" but got \"",
-			argv[4], "\"", (char *) NULL);
+	case STR_RANGE: {
+	    int first, last;
+
+	    if (objc != 5) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
 		return TCL_ERROR;
 	    }
-	}
-	if (first < 0) {
-	    first = 0;
-	}
-	if (last >= stringLength) {
-	    last = stringLength-1;
-	}
-	if (last >= first) {
-	    char saved, *p;
 
-	    p = argv[2] + last + 1;
-	    saved = *p;
-	    *p = 0;
-	    Tcl_SetResult(interp, argv[2] + first, TCL_VOLATILE);
-	    *p = saved;
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (TclGetIntForIndex(interp, objv[3], length1 - 1,
+		    &first) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (TclGetIntForIndex(interp, objv[4], length1 - 1,
+		    &last) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (first < 0) {
+		first = 0;
+	    }
+	    if (last >= length1 - 1) {
+		last = length1 - 1;
+	    }
+	    if (last >= first) {
+	        Tcl_SetStringObj(resultPtr, string1 + first, last - first + 1);
+	    }
+	    break;
 	}
-	return TCL_OK;
-    } else if ((c == 't') && (strncmp(argv[1], "tolower", length) == 0)
-	    && (length >= 3)) {
-	register char *p;
+	case STR_TOLOWER: {
+	    char *p, *end;
 
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " tolower string\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetResult(interp, argv[2], TCL_VOLATILE);
-	for (p = interp->result; *p != 0; p++) {
-	    if (isupper(UCHAR(*p))) {
-		*p = (char)tolower(UCHAR(*p));
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
 	    }
-	}
-	return TCL_OK;
-    } else if ((c == 't') && (strncmp(argv[1], "toupper", length) == 0)
-	    && (length >= 3)) {
-	register char *p;
 
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " toupper string\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetResult(interp, argv[2], TCL_VOLATILE);
-	for (p = interp->result; *p != 0; p++) {
-	    if (islower(UCHAR(*p))) {
-		*p = (char) toupper(UCHAR(*p));
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+
+	    /*
+	     * Since I know resultPtr is not a shared object, I can reach
+	     * in and diddle the bytes in its string rep to convert them in
+	     * place to lower case.
+	     */
+
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    string1 = Tcl_GetStringFromObj(resultPtr, &length1);
+	    end = string1 + length1;
+	    for (p = string1; p < end; p++) {
+		if (isupper(UCHAR(*p))) {
+		    *p = (char) tolower(UCHAR(*p));
+		}
 	    }
+	    break;
 	}
-	return TCL_OK;
-    } else if ((c == 't') && (strncmp(argv[1], "trim", length) == 0)
-	    && (length == 4)) {
-	char *trimChars;
-	register char *p, *checkPtr;
-
-	left = right = 1;
-
-	trim:
-	if (argc == 4) {
-	    trimChars = argv[3];
-	} else if (argc == 3) {
-	    trimChars = " \t\n\r";
-	} else {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " ", argv[1], " string ?chars?\"", (char *) NULL);
-	    return TCL_ERROR;
+	case STR_TOUPPER: {
+	    char *p, *end;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+
+	    /*
+	     * Since I know resultPtr is not a shared object, I can reach
+	     * in and diddle the bytes in its string rep to convert them in
+	     * place to upper case.
+	     */
+
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    string1 = Tcl_GetStringFromObj(resultPtr, &length1);
+	    end = string1 + length1;
+	    for (p = string1; p < end; p++) {
+		if (islower(UCHAR(*p))) {
+		    *p = (char) toupper(UCHAR(*p));
+		}
+	    }
+	    break;
 	}
-	p = argv[2];
-	if (left) {
-	    for (c = *p; c != 0; p++, c = *p) {
-		for (checkPtr = trimChars; *checkPtr != c; checkPtr++) {
-		    if (*checkPtr == 0) {
-			goto doneLeft;
+	case STR_TRIM: {
+	    char ch;
+	    char *p, *end, *check, *checkEnd;
+
+	    left = 1;
+	    right = 1;
+
+	    trim:
+	    if (objc == 4) {
+		string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    } else if (objc == 3) {
+		string2 = " \t\n\r";
+		length2 = strlen(string2);
+	    } else {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
+		return TCL_ERROR;
+	    }
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    checkEnd = string2 + length2;
+
+	    if (left) {
+		end = string1 + length1;
+		for (p = string1; p < end; p++) {
+		    ch = *p;
+		    for (check = string2; ; check++) {
+			if (check >= checkEnd) {
+			    p = end;
+			    break;
+			}
+			if (ch == *check) {
+			    length1--;
+			    string1++;
+			    break;
+			}
 		    }
 		}
 	    }
-	}
-	doneLeft:
-	Tcl_SetResult(interp, p, TCL_VOLATILE);
-	if (right) {
-	    char *donePtr;
-
-	    p = interp->result + strlen(interp->result) - 1;
-	    donePtr = &interp->result[-1];
-	    for (c = *p; p != donePtr; p--, c = *p) {
-		for (checkPtr = trimChars; *checkPtr != c; checkPtr++) {
-		    if (*checkPtr == 0) {
-			goto doneRight;
+	    if (right) {
+	        end = string1;
+		for (p = string1 + length1; p > end; ) {
+		    p--;
+		    ch = *p;
+		    for (check = string2; ; check++) {
+		        if (check >= checkEnd) {
+			    p = end;
+			    break;
+			}
+			if (ch == *check) {
+			    length1--;
+			    break;
+			}
 		    }
 		}
 	    }
-	    doneRight:
-	    p[1] = 0;
-	}
-	return TCL_OK;
-    } else if ((c == 't') && (strncmp(argv[1], "trimleft", length) == 0)
-	    && (length > 4)) {
-	left = 1;
-	argv[1] = "trimleft";
-	goto trim;
-    } else if ((c == 't') && (strncmp(argv[1], "trimright", length) == 0)
-	    && (length > 4)) {
-	right = 1;
-	argv[1] = "trimright";
-	goto trim;
-    } else if ((c == 'w') && (strncmp(argv[1], "wordend", length) == 0)
-	    && (length > 4)) {
-	int length, index, cur;
-	char *string;
-
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " ", argv[1], " string index\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	string = argv[2];
-	if (Tcl_GetInt(interp, argv[3], &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	length = strlen(argv[2]);
-	if (index < 0) {
-	    index = 0;
-	}
-	if (index >= length) {
-	    cur = length;
-	    goto wordendDone;
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    break;
 	}
-	for (cur = index ; cur < length; cur++) {
-	    c = UCHAR(string[cur]);
-	    if (!isalnum(c) && (c != '_')) {
-		break;
+	case STR_TRIMLEFT: {
+	    left = 1;
+	    right = 0;
+	    goto trim;
+	}
+	case STR_TRIMRIGHT: {
+	    left = 0;
+	    right = 1;
+	    goto trim;
+	}
+	case STR_WORDEND: {
+	    int cur, c;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
+		return TCL_ERROR;
 	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+	        return TCL_ERROR;
+	    }
+	    if (index < 0) {
+		index = 0;
+	    }
+	    cur = length1;
+	    if (index < length1) {
+		for (cur = index; cur < length1; cur++) {
+		    c = UCHAR(string1[cur]);
+		    if (!isalnum(c) && (c != '_')) {
+			break;
+		    }
+		}
+		if (cur == index) {
+		    cur = index + 1;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, cur);
+	    break;
 	}
-	if (cur == index) {
-	    cur = index+1;
-	}
-	wordendDone:
-	sprintf(interp->result, "%d", cur);
-	return TCL_OK;
-    } else if ((c == 'w') && (strncmp(argv[1], "wordstart", length) == 0)
-	    && (length > 4)) {
-	int length, index, cur;
-	char *string;
-
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " ", argv[1], " string index\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	string = argv[2];
-	if (Tcl_GetInt(interp, argv[3], &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	length = strlen(argv[2]);
-	if (index >= length) {
-	    index = length-1;
-	}
-	if (index <= 0) {
+	case STR_WORDSTART: {
+	    int cur, c;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (index >= length1) {
+		index = length1 - 1;
+	    }
 	    cur = 0;
-	    goto wordstartDone;
-	}
-	for (cur = index ; cur >= 0; cur--) {
-	    c = UCHAR(string[cur]);
-	    if (!isalnum(c) && (c != '_')) {
-		break;
+	    if (index > 0) {
+	        for (cur = index; cur >= 0; cur--) {
+		    c = UCHAR(string1[cur]);
+		    if (!isalnum(c) && (c != '_')) {
+			break;
+		    }
+		}
+		if (cur != index) {
+		    cur += 1;
+		}
 	    }
+	    Tcl_SetIntObj(resultPtr, cur);
+	    break;
 	}
-	if (cur != index) {
-	    cur += 1;
-	}
-	wordstartDone:
-	sprintf(interp->result, "%d", cur);
-	return TCL_OK;
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": should be compare, first, index, last, length, match, ",
-		"range, tolower, toupper, trim, trimleft, trimright, ",
-		"wordend, or wordstart", (char *) NULL);
-	return TCL_ERROR;
     }
+    return TCL_OK;
 }
 
 /*
@@ -1532,7 +1499,7 @@ Tcl_SubstCmd(dummy, interp, argc, argv)
 			Tcl_DStringFree(&result);
 			return code;
 		    }
-		    old = p = iPtr->termPtr+1;
+		    old = p = (p+1 + iPtr->termOffset+1);
 		    Tcl_DStringAppend(&result, iPtr->result, -1);
 		    Tcl_ResetResult(interp);
 		} else {
@@ -1555,13 +1522,13 @@ Tcl_SubstCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SwitchCmd --
+ * Tcl_SwitchObjCmd --
  *
- *	This procedure is invoked to process the "switch" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "switch" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -1571,96 +1538,121 @@ Tcl_SubstCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_SwitchCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_SwitchObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
 #define EXACT	0
 #define GLOB	1
 #define REGEXP	2
-    int i, code, mode, matched;
-    int body;
-    char *string;
-    int switchArgc, splitArgs;
-    char **switchArgv;
-
-    switchArgc = argc-1;
-    switchArgv = argv+1;
+    int switchObjc, index;
+    Tcl_Obj *CONST *switchObjv;
+    Tcl_Obj *patternObj, *bodyObj;
+    char *string, *pattern, *body;
+    int splitObjs, length, patternLen, i, code, mode, matched, bodyIdx;
+    static char *switches[] =
+	    {"-exact", "-glob", "-regexp", "--", (char *) NULL};
+
+    switchObjc = objc-1;
+    switchObjv = objv+1;
     mode = EXACT;
-    while ((switchArgc > 0) && (*switchArgv[0] == '-')) {
-	if (strcmp(*switchArgv, "-exact") == 0) {
-	    mode = EXACT;
-	} else if (strcmp(*switchArgv, "-glob") == 0) {
-	    mode = GLOB;
-	} else if (strcmp(*switchArgv, "-regexp") == 0) {
-	    mode = REGEXP;
-	} else if (strcmp(*switchArgv, "--") == 0) {
-	    switchArgc--;
-	    switchArgv++;
-	    break;
-	} else {
-	    Tcl_AppendResult(interp, "bad option \"", switchArgv[0],
-		    "\": should be -exact, -glob, -regexp, or --",
-		    (char *) NULL);
+    
+    string = Tcl_GetStringFromObj(switchObjv[0], &length);
+    while ((switchObjc > 0) && (*string == '-')) {
+	if (Tcl_GetIndexFromObj(interp, switchObjv[0], switches,
+		"option", 0, &index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	switchArgc--;
-	switchArgv++;
+	switch (index) {
+	    case 0:			/* -exact */
+		mode = EXACT;
+		break;
+	    case 1:			/* -glob */
+		mode = GLOB;
+		break;
+	    case 2:			/* -regexp */
+		mode = REGEXP;
+		break;
+	    case 3:			/* -- */
+		switchObjc--;
+		switchObjv++;
+		goto doneWithSwitches;
+	}
+	switchObjc--;
+	switchObjv++;
+	string = Tcl_GetStringFromObj(switchObjv[0], &length);
     }
-    if (switchArgc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " ?switches? string pattern body ... ?default body?\"",
-		(char *) NULL);
+
+    doneWithSwitches:
+    if (switchObjc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?switches? string pattern body ... ?default body?");
 	return TCL_ERROR;
     }
-    string = *switchArgv;
-    switchArgc--;
-    switchArgv++;
+    
+    string = Tcl_GetStringFromObj(switchObjv[0], &length);
+    switchObjc--;
+    switchObjv++;
 
     /*
      * If all of the pattern/command pairs are lumped into a single
      * argument, split them out again.
      */
 
-    splitArgs = 0;
-    if (switchArgc == 1) {
-	code = Tcl_SplitList(interp, switchArgv[0], &switchArgc, &switchArgv);
+    splitObjs = 0;
+    if (switchObjc == 1) {
+	code = Tcl_ListObjLength(interp, switchObjv[0], &switchObjc);
 	if (code != TCL_OK) {
 	    return code;
 	}
-	splitArgs = 1;
+	splitObjs = 1;
     }
 
-    for (i = 0; i < switchArgc; i += 2) {
-	if (i == (switchArgc-1)) {
-	    interp->result = "extra switch pattern with no body";
+    for (i = 0;  i < switchObjc;  i += 2) {
+	if (i == (switchObjc-1)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "extra switch pattern with no body", -1);
 	    code = TCL_ERROR;
-	    goto cleanup;
+	    goto done;
 	}
 
 	/*
 	 * See if the pattern matches the string.
 	 */
 
+	if (splitObjs) {
+	    code = Tcl_ListObjIndex(interp, switchObjv[0], i, &patternObj);
+	    if (code != TCL_OK) {
+		return code;
+	    }
+	    pattern = Tcl_GetStringFromObj(patternObj, &patternLen);
+	} else {
+	    pattern = Tcl_GetStringFromObj(switchObjv[i], &patternLen);
+	}
+
 	matched = 0;
-	if ((*switchArgv[i] == 'd') && (i == switchArgc-2)
-		&& (strcmp(switchArgv[i], "default") == 0)) {
+	if ((*pattern == 'd') && (i == switchObjc-2)
+		&& (strcmp(pattern, "default") == 0)) {
 	    matched = 1;
 	} else {
+	    /*
+	     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL.
+	     */
 	    switch (mode) {
 		case EXACT:
-		    matched = (strcmp(string, switchArgv[i]) == 0);
+		    matched = (strcmp(string, pattern) == 0);
 		    break;
 		case GLOB:
-		    matched = Tcl_StringMatch(string, switchArgv[i]);
+		    matched = Tcl_StringMatch(string, pattern);
 		    break;
 		case REGEXP:
-		    matched = Tcl_RegExpMatch(interp, string, switchArgv[i]);
+		    matched = Tcl_RegExpMatch(interp, string, pattern);
 		    if (matched < 0) {
 			code = TCL_ERROR;
-			goto cleanup;
+			goto done;
 		    }
 		    break;
 	    }
@@ -1670,29 +1662,44 @@ Tcl_SwitchCmd(dummy, interp, argc, argv)
 	}
 
 	/*
-	 * We've got a match.  Find a body to execute, skipping bodies
+	 * We've got a match. Find a body to execute, skipping bodies
 	 * that are "-".
 	 */
 
-	for (body = i+1; ; body += 2) {
-	    if (body >= switchArgc) {
-		Tcl_AppendResult(interp, "no body specified for pattern \"",
-			switchArgv[i], "\"", (char *) NULL);
+	for (bodyIdx = i+1;  ;  bodyIdx += 2) {
+	    if (bodyIdx >= switchObjc) {
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"no body specified for pattern \"", pattern,
+			"\"", (char *) NULL);
 		code = TCL_ERROR;
-		goto cleanup;
+		goto done;
+	    }
+	    
+	    if (splitObjs) {
+		code = Tcl_ListObjIndex(interp, switchObjv[0], bodyIdx,
+		        &bodyObj);
+		if (code != TCL_OK) {
+		    return code;
+		}
+	    } else {
+		bodyObj = switchObjv[bodyIdx];
 	    }
-	    if ((switchArgv[body][0] != '-') || (switchArgv[body][1] != 0)) {
+	    /*
+	     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL.
+	     */
+	    body = Tcl_GetStringFromObj(bodyObj, &length);
+	    if ((length != 1) || (body[0] != '-')) {
 		break;
 	    }
 	}
-	code = Tcl_Eval(interp, switchArgv[body]);
+	code = Tcl_EvalObj(interp, bodyObj);
 	if (code == TCL_ERROR) {
 	    char msg[100];
-	    sprintf(msg, "\n    (\"%.50s\" arm line %d)", switchArgv[i],
+	    sprintf(msg, "\n    (\"%.50s\" arm line %d)", pattern,
 		    interp->errorLine);
-	    Tcl_AddErrorInfo(interp, msg);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
 	}
-	goto cleanup;
+	goto done;
     }
 
     /*
@@ -1701,23 +1708,23 @@ Tcl_SwitchCmd(dummy, interp, argc, argv)
 
     code = TCL_OK;
 
-    cleanup:
-    if (splitArgs) {
-	ckfree((char *) switchArgv);
-    }
+    done:
     return code;
+#undef EXACT
+#undef GLOB
+#undef REGEXP
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_TimeCmd --
+ * Tcl_TimeObjCmd --
  *
- *	This procedure is invoked to process the "time" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "time" Tcl
+ *	command.  See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -1727,45 +1734,48 @@ Tcl_SwitchCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_TimeCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_TimeObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int count, i, result;
-    double timePer;
+    register Tcl_Obj *objPtr;
+    register int i, result;
+    int count;
+    double totalMicroSec;
     Tcl_Time start, stop;
+    char buf[100];
 
-    if (argc == 2) {
+    if (objc == 2) {
 	count = 1;
-    } else if (argc == 3) {
-	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
-	    return TCL_ERROR;
+    } else if (objc == 3) {
+	result = Tcl_GetIntFromObj(interp, objv[2], &count);
+	if (result != TCL_OK) {
+	    return result;
 	}
     } else {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" command ?count?\"", (char *) NULL);
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
 	return TCL_ERROR;
     }
+    
+    objPtr = objv[1];
+    i = count;
     TclpGetTime(&start);
-    for (i = count ; i > 0; i--) {
-	result = Tcl_Eval(interp, argv[1]);
+    while (i-- > 0) {
+	result = Tcl_EvalObj(interp, objPtr);
 	if (result != TCL_OK) {
-	    if (result == TCL_ERROR) {
-		char msg[60];
-		sprintf(msg, "\n    (\"time\" body line %d)",
-			interp->errorLine);
-		Tcl_AddErrorInfo(interp, msg);
-	    }
 	    return result;
 	}
     }
     TclpGetTime(&stop);
-    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    
+    totalMicroSec =
+	(stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    sprintf(buf, "%.0f microseconds per iteration",
+	((count <= 0) ? 0 : totalMicroSec/count));
     Tcl_ResetResult(interp);
-    sprintf(interp->result, "%.0f microseconds per iteration",
-	(count <= 0) ? 0 : timePer/count);
+    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
     return TCL_OK;
 }
 
@@ -1975,11 +1985,13 @@ TraceVarProc(clientData, interp, name1, name2, flags)
     int flags;			/* OR-ed bits giving operation and other
 				 * information. */
 {
+    Interp *iPtr = (Interp *) interp;
     TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
     char *result;
     int code;
     Interp dummy;
     Tcl_DString cmd;
+    Tcl_Obj *saveObjPtr, *oldObjResultPtr;
 
     result = NULL;
     if (tvarPtr->errMsg != NULL) {
@@ -2011,29 +2023,54 @@ TraceVarProc(clientData, interp, name1, name2, flags)
 	}
 
 	/*
-	 * Execute the command.  Be careful to save and restore the
-	 * result from the interpreter used for the command.
+	 * Execute the command.  Be careful to save and restore both the
+	 * string and object results from the interpreter used for
+	 * the command. We discard any object result the command returns.
 	 */
 
+	dummy.objResultPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(dummy.objResultPtr);
 	if (interp->freeProc == 0) {
 	    dummy.freeProc = (Tcl_FreeProc *) 0;
 	    dummy.result = "";
-	    Tcl_SetResult((Tcl_Interp *) &dummy, interp->result, TCL_VOLATILE);
+	    Tcl_SetResult((Tcl_Interp *) &dummy, interp->result,
+		    TCL_VOLATILE);
 	} else {
 	    dummy.freeProc = interp->freeProc;
 	    dummy.result = interp->result;
 	    interp->freeProc = (Tcl_FreeProc *) 0;
 	}
+	
+	saveObjPtr = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(saveObjPtr);
+	
 	code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
-	Tcl_DStringFree(&cmd);
-	if (code != TCL_OK) {
-	    tvarPtr->errMsg = (char *) ckalloc((unsigned) (strlen(interp->result) + 1));
+	if (code != TCL_OK) {	     /* copy error msg to result */
+	    tvarPtr->errMsg = (char *)
+		    ckalloc((unsigned) (strlen(interp->result) + 1));
 	    strcpy(tvarPtr->errMsg, interp->result);
 	    result = tvarPtr->errMsg;
-	    Tcl_ResetResult(interp);		/* Must clear error state. */
+	    Tcl_ResetResult(interp); /* must clear error state. */
 	}
+
+	/*
+	 * Restore the interpreter's string result.
+	 */
+	
 	Tcl_SetResult(interp, dummy.result,
 		(dummy.freeProc == 0) ? TCL_VOLATILE : dummy.freeProc);
+
+	/*
+	 * Restore the interpreter's object result from saveObjPtr.
+	 */
+
+	oldObjResultPtr = iPtr->objResultPtr;
+	iPtr->objResultPtr = saveObjPtr;  /* was incremented above */
+	TclDecrRefCount(oldObjResultPtr);
+
+	Tcl_DecrRefCount(dummy.objResultPtr);
+	dummy.objResultPtr = NULL;
+	Tcl_DStringFree(&cmd);
     }
     if (flags & TCL_TRACE_DESTROYED) {
 	result = NULL;
@@ -2050,58 +2087,63 @@ TraceVarProc(clientData, interp, name1, name2, flags)
  *
  * Tcl_WhileCmd --
  *
- *	This procedure is invoked to process the "while" Tcl command.
- *	See the user documentation for details on what it does.
+ *      This procedure is invoked to process the "while" Tcl command.
+ *      See the user documentation for details on what it does.
+ *
+ *	With the bytecode compiler, this procedure is only called when
+ *	a command name is computed at runtime, and is "while" or the name
+ *	to which "while" was renamed: e.g., "set z while; $z {$i<100} {}"
  *
  * Results:
- *	A standard Tcl result.
+ *      A standard Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *      See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
+        /* ARGSUSED */
 int
 Tcl_WhileCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    ClientData dummy;                   /* Not used. */
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    int argc;                           /* Number of arguments. */
+    char **argv;                        /* Argument strings. */
 {
     int result, value;
 
     if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " test command\"", (char *) NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # args: should be \"",
+                argv[0], " test command\"", (char *) NULL);
+        return TCL_ERROR;
     }
 
     while (1) {
-	result = Tcl_ExprBoolean(interp, argv[1], &value);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if (!value) {
-	    break;
-	}
-	result = Tcl_Eval(interp, argv[2]);
-	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
-	    if (result == TCL_ERROR) {
-		char msg[60];
-		sprintf(msg, "\n    (\"while\" body line %d)",
-			interp->errorLine);
-		Tcl_AddErrorInfo(interp, msg);
-	    }
-	    break;
-	}
+        result = Tcl_ExprBoolean(interp, argv[1], &value);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if (!value) {
+            break;
+        }
+        result = Tcl_Eval(interp, argv[2]);
+        if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+            if (result == TCL_ERROR) {
+                char msg[60];
+                sprintf(msg, "\n    (\"while\" body line %d)",
+                        interp->errorLine);
+                Tcl_AddErrorInfo(interp, msg);
+            }
+            break;
+        }
     }
     if (result == TCL_BREAK) {
-	result = TCL_OK;
+        result = TCL_OK;
     }
     if (result == TCL_OK) {
-	Tcl_ResetResult(interp);
+        Tcl_ResetResult(interp);
     }
     return result;
 }
+
diff --git a/contrib/tcl/generic/tclCompExpr.c b/contrib/tcl/generic/tclCompExpr.c
new file mode 100644
index 0000000..4113879
--- /dev/null
+++ b/contrib/tcl/generic/tclCompExpr.c
@@ -0,0 +1,2290 @@
+/* 
+ * tclCompExpr.c --
+ *
+ *	This file contains the code to compile Tcl expressions.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclCompExpr.c 1.30 97/06/13 18:17:20
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used in
+ * environments that include no UNIX, i.e. no errno: just arrange to use
+ * the errno from tclExecute.c here.
+ */
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+extern int errno;			/* Use errno from tclExecute.c. */
+#define ERANGE 34
+#endif
+
+/*
+ * Boolean variable that controls whether expression compilation tracing
+ * is enabled.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static int traceCompileExpr = 0;
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * The ExprInfo structure describes the state of compiling an expression.
+ * A pointer to an ExprInfo record is passed among the routines in
+ * this module.
+ */
+
+typedef struct ExprInfo {
+    int token;			/* Type of the last token parsed in expr.
+				 * See below for definitions. Corresponds
+				 * to the characters just before next. */
+    int objIndex;		/* If token is a literal value, the index of
+				 * an object holding the value in the code's
+				 * object table; otherwise is NULL. */
+    char *funcName;		/* If the token is FUNC_NAME, points to the
+				 * first character of the math function's
+				 * name; otherwise is NULL. */
+    char *next;			/* Position of the next character to be
+				 * scanned in the expression string. */
+    char *originalExpr;		/* The entire expression that was originally
+				 * passed to Tcl_ExprString et al. */
+    char *lastChar;		/* Pointer to terminating null in
+				 * originalExpr. */
+    int hasOperators;		/* Set 1 if the expr has operators; 0 if
+				 * expr is only a primary. If 1 after
+				 * compiling an expr, a tryCvtToNumeric
+				 * instruction is emitted to convert the
+				 * primary to a number if possible. */
+    int exprIsJustVarRef;	/* Set 1 if the expr consists of just a
+				 * variable reference as in the expression
+				 * of "if $b then...". Otherwise 0. Used
+				 * to implement expr's 2 level substitution
+				 * semantics properly. */
+} ExprInfo;
+
+/*
+ * Definitions of the different tokens that appear in expressions. The order
+ * of these must match the corresponding entries in the operatorStrings
+ * array below.
+ */
+
+#define LITERAL		0
+#define FUNC_NAME	(LITERAL + 1)
+#define OPEN_BRACKET	(LITERAL + 2)
+#define CLOSE_BRACKET	(LITERAL + 3)
+#define OPEN_PAREN	(LITERAL + 4)
+#define CLOSE_PAREN	(LITERAL + 5)
+#define DOLLAR		(LITERAL + 6)
+#define QUOTE		(LITERAL + 7)
+#define COMMA		(LITERAL + 8)
+#define END		(LITERAL + 9)
+#define UNKNOWN		(LITERAL + 10)
+
+/*
+ * Binary operators:
+ */
+
+#define MULT		(UNKNOWN + 1)
+#define DIVIDE		(MULT + 1)
+#define MOD		(MULT + 2)
+#define PLUS		(MULT + 3)
+#define MINUS		(MULT + 4)
+#define LEFT_SHIFT	(MULT + 5)
+#define RIGHT_SHIFT	(MULT + 6)
+#define LESS		(MULT + 7)
+#define GREATER		(MULT + 8)
+#define LEQ		(MULT + 9)
+#define GEQ		(MULT + 10)
+#define EQUAL		(MULT + 11)
+#define NEQ		(MULT + 12)
+#define BIT_AND		(MULT + 13)
+#define BIT_XOR		(MULT + 14)
+#define BIT_OR		(MULT + 15)
+#define AND		(MULT + 16)
+#define OR		(MULT + 17)
+#define QUESTY		(MULT + 18)
+#define COLON		(MULT + 19)
+
+/*
+ * Unary operators. Unary minus and plus are represented by the (binary)
+ * tokens MINUS and PLUS.
+ */
+
+#define NOT		(COLON + 1)
+#define BIT_NOT		(NOT + 1)
+
+/*
+ * Mapping from tokens to strings; used for debugging messages. These
+ * entries must match the order and number of the token definitions above.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static char *tokenStrings[] = {
+    "LITERAL", "FUNCNAME",
+    "[", "]", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
+    "*", "/", "%", "+", "-",
+    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
+    "&", "^", "|", "&&", "||", "?", ":",
+    "!", "~"
+};
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Declarations for local procedures to this file:
+ */
+
+static int		CompileAddExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileBitAndExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileBitOrExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileBitXorExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileCondExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileEqualityExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileLandExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileLorExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileMathFuncCall _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileMultiplyExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompilePrimaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileRelationalExpr _ANSI_ARGS_((
+    			    Tcl_Interp *interp, ExprInfo *infoPtr,
+			    int flags, CompileEnv *envPtr));
+static int		CompileShiftExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		CompileUnaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, int flags,
+			    CompileEnv *envPtr));
+static int		GetToken _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExprInfo *infoPtr, CompileEnv *envPtr));
+
+/*
+ * Macro used to debug the execution of the recursive descent parser used
+ * to compile expressions.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+#define HERE(production, level) \
+    if (traceCompileExpr) { \
+	fprintf(stderr, "%*s%s: token=%s, next=\"%.20s\"\n", \
+		(level), " ", (production), tokenStrings[infoPtr->token], \
+		infoPtr->next); \
+    }
+#else
+#define HERE(production, level)
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExpr --
+ *
+ *	This procedure compiles a string containing a Tcl expression into
+ *	Tcl bytecodes. This procedure is the top-level interface to the
+ *	the expression compilation module, and is used by such public
+ *	procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
+ *	Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
+ *
+ *	Note that the topmost recursive-descent parsing routine used by
+ *	TclCompileExpr to compile expressions is called "CompileCondExpr"
+ *	and not, e.g., "CompileExpr". This is done to avoid an extra
+ *	procedure call since such a procedure would only return the result
+ *	of calling CompileCondExpr. Other recursive-descent procedures
+ *	that need to parse expressions also call CompileCondExpr.
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed; this might
+ *	be the offset of the ']' (if flags & TCL_BRACKET_TERM), or the
+ *	offset of the '\0' at the end of the string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ *	envPtr->exprIsJustVarRef is set 1 if the expression consisted of
+ *	a single variable reference as in the expression of "if $b then...".
+ *	Otherwise it is set 0. This is used to implement Tcl's two level
+ *	expression substitution semantics properly.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileExpr(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ExprInfo info;
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+#ifdef TCL_COMPILE_DEBUG
+    if (traceCompileExpr) {
+	fprintf(stderr, "expr: string=\"%.30s\"\n", string);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    /*
+     * Register the builtin math functions the first time an expression is
+     * compiled.
+     */
+
+    if (!(iPtr->flags & EXPR_INITIALIZED)) {
+	BuiltinFunc *funcPtr;
+	Tcl_HashEntry *hPtr;
+	MathFunc *mathFuncPtr;
+	int i;
+
+	iPtr->flags |= EXPR_INITIALIZED;
+	i = 0;
+	for (funcPtr = builtinFuncTable; funcPtr->name != NULL; funcPtr++) {
+	    Tcl_CreateMathFunc(interp, funcPtr->name,
+		    funcPtr->numArgs, funcPtr->argTypes,
+		    (Tcl_MathProc *) NULL, (ClientData) 0);
+	    
+	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcPtr->name);
+	    if (hPtr == NULL) {
+		panic("TclCompileExpr: Tcl_CreateMathFunc incorrectly registered '%s'", funcPtr->name);
+		return TCL_ERROR;
+	    }
+	    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+	    mathFuncPtr->builtinFuncIndex = i;
+	    i++;
+	}
+    }
+
+    info.token = UNKNOWN;
+    info.objIndex = -1;
+    info.funcName = NULL;
+    info.next = string;
+    info.originalExpr = string;
+    info.lastChar = lastChar;
+    info.hasOperators = 0;
+    info.exprIsJustVarRef = 1;	/* will be set 0 if anything else is seen */
+
+    /*
+     * Get the first token then compile an expression.
+     */
+
+    result = GetToken(interp, &info, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    
+    result = CompileCondExpr(interp, &info, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (info.token != END) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"syntax error in expression \"", string, "\"", (char *) NULL);
+	result = TCL_ERROR;
+	goto done;
+    }
+    if (!info.hasOperators) {
+	/*
+	 * Attempt to convert the primary's object to an int or double.
+	 * This is done in order to support Tcl's policy of interpreting
+	 * operands if at all possible as first integers, else
+	 * floating-point numbers.
+	 */
+	
+	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    done:
+    envPtr->termOffset = (info.next - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileCondExpr --
+ *
+ *	This procedure compiles a Tcl conditional expression:
+ *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
+ *
+ *	Note that this is the topmost recursive-descent parsing routine used
+ *	by TclCompileExpr to compile expressions. It does not call an
+ *	separate, higher-level "CompileExpr" procedure. This avoids an extra
+ *	procedure call since such a procedure would only return the result
+ *	of calling CompileCondExpr. Other recursive-descent procedures that
+ *	need to parse expressions also call CompileCondExpr.
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileCondExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
+				/* Used to update or replace one-byte jumps
+				 * around the then and else expressions when
+				 * their target PCs are determined. */
+    int elseCodeOffset, currCodeOffset, jumpDist, result;
+    
+    HERE("condExpr", 1);
+    result = CompileLorExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    if (infoPtr->token == QUESTY) {
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '?' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	/*
+	 * Emit the jump around the "then" clause to the "else" condExpr if
+	 * the test was false. We emit a one byte (relative) jump here, and
+	 * replace it later with a four byte jump if the jump target is more
+	 * than 127 bytes away.
+	 */
+
+	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
+
+	/*
+	 * Compile the "then" expression. Note that if a subexpression
+	 * is only a primary, we need to try to convert it to numeric.
+	 * This is done in order to support Tcl's policy of interpreting
+	 * operands if at all possible as first integers, else
+	 * floating-point numbers.
+	 */
+
+	infoPtr->hasOperators = 0;
+	infoPtr->exprIsJustVarRef = 0;
+	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	if (infoPtr->token != COLON) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "syntax error in expression \"", infoPtr->originalExpr,
+		    "\"", (char *) NULL);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	if (!infoPtr->hasOperators) {
+	    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+	}
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the ':' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	/*
+	 * Emit an unconditional jump around the "else" condExpr.
+	 */
+
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+	        &jumpAroundElseFixup);
+
+	/*
+	 * Compile the "else" expression.
+	 */
+
+	infoPtr->hasOperators = 0;
+	elseCodeOffset = TclCurrCodeOffset();
+	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	if (!infoPtr->hasOperators) {
+	    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+	}
+
+	/*
+	 * Fix up the second jump: the unconditional jump around the "else"
+	 * expression. If the distance is too great (> 127 bytes), replace
+	 * it with a four byte instruction and move the instructions after
+	 * the jump down.
+	 */
+
+	currCodeOffset = TclCurrCodeOffset();
+	jumpDist = (currCodeOffset - jumpAroundElseFixup.codeOffset);
+	if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, jumpDist, 127)) {
+	    /*
+	     * Update the else expression's starting code offset since it
+	     * moved down 3 bytes too.
+	     */
+	    
+	    elseCodeOffset += 3;
+	}
+	
+	/*
+	 * Now fix up the first branch: the jumpFalse after the test. If the
+	 * distance is too great, replace it with a four byte instruction
+	 * and update the code offsets for the commands in both the "then"
+	 * and "else" expressions.
+	 */
+
+	jumpDist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
+	TclFixupForwardJump(envPtr, &jumpAroundThenFixup, jumpDist, 127);
+
+	infoPtr->hasOperators = 1;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileLorExpr --
+ *
+ *	This procedure compiles a Tcl logical or expression:
+ *	lorExpr ::= landExpr {'||' landExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileLorExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    JumpFixupArray jumpFixupArray;
+				/* Used to fix up the forward "short
+				 * circuit" jump after each or-ed
+				 * subexpression to just after the last
+				 * subexpression. */
+    JumpFixup jumpTrueFixup, jumpFixup;
+    				/* Used to emit the jumps in the code to
+				 * convert the first operand to a 0 or 1. */
+    int fixupIndex, jumpDist, currCodeOffset, objIndex, j, result;
+    Tcl_Obj *objPtr;
+    
+    HERE("lorExpr", 2);
+    result = CompileLandExpr(interp, infoPtr, flags, envPtr);
+    if ((result != TCL_OK) || (infoPtr->token != OR)) {
+	return result;		/* envPtr->maxStackDepth is already set */
+    }
+
+    infoPtr->hasOperators = 1;
+    infoPtr->exprIsJustVarRef = 0;
+    maxDepth = envPtr->maxStackDepth;
+    TclInitJumpFixupArray(&jumpFixupArray);
+    while (infoPtr->token == OR) {
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '||' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	if (jumpFixupArray.next == 0) {
+	    /*
+	     * Just the first "lor" operand is on the stack. The following
+	     * is slightly ugly: we need to convert that first "lor" operand
+	     * to a "0" or "1" to get the correct result if it is nonzero.
+	     * Eventually we'll use a new instruction for this.
+	     */
+
+	    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpTrueFixup);
+	    
+	    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0,
+					    /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 0;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
+		panic("CompileLorExpr: bad jump distance %d\n", jumpDist);
+	    }
+	    objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
+				            /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 1;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+		panic("CompileLorExpr: bad jump distance %d\n", jumpDist);
+	    }
+	}
+
+	/*
+	 * Duplicate the value on top of the stack to prevent the jump from
+	 * consuming it.
+	 */
+
+	TclEmitOpcode(INST_DUP, envPtr);
+
+	/*
+	 * Emit the "short circuit" jump around the rest of the lorExp if
+	 * the previous expression was true. We emit a one byte (relative)
+	 * jump here, and replace it later with a four byte jump if the jump
+	 * target is more than 127 bytes away.
+	 */
+
+	if (jumpFixupArray.next == jumpFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpFixupArray);
+	}
+	fixupIndex = jumpFixupArray.next;
+	jumpFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
+	        &(jumpFixupArray.fixup[fixupIndex]));
+	
+	/*
+	 * Compile the subexpression.
+	 */
+
+	result = CompileLandExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	/*
+	 * Emit a "logical or" instruction. This does not try to "short-
+	 * circuit" the evaluation of both operands of a Tcl "||" operator,
+	 * but instead ensures that we either have a "1" or a "0" result.
+	 */
+
+	TclEmitOpcode(INST_LOR, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the forward jumps, update the jumps
+     * with the correct distance. Also, if the distance is too great (> 127
+     * bytes), replace the jump with a four byte instruction and move the
+     * instructions after the jump down.
+     */
+    
+    for (j = jumpFixupArray.next;  j > 0;  j--) {
+	fixupIndex = (j - 1);	/* process closest jump first */
+	currCodeOffset = TclCurrCodeOffset();
+	jumpDist = (currCodeOffset - jumpFixupArray.fixup[fixupIndex].codeOffset);
+	TclFixupForwardJump(envPtr, &(jumpFixupArray.fixup[fixupIndex]), jumpDist, 127);
+    }
+
+    done:
+    TclFreeJumpFixupArray(&jumpFixupArray);
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileLandExpr --
+ *
+ *	This procedure compiles a Tcl logical and expression:
+ *	landExpr ::= bitOrExpr {'&&' bitOrExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileLandExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    JumpFixupArray jumpFixupArray;
+				/* Used to fix up the forward "short
+				 * circuit" jump after each and-ed
+				 * subexpression to just after the last
+				 * subexpression. */
+    JumpFixup jumpTrueFixup, jumpFixup;
+    				/* Used to emit the jumps in the code to
+				 * convert the first operand to a 0 or 1. */
+    int fixupIndex, jumpDist, currCodeOffset, objIndex, j, result;
+    Tcl_Obj *objPtr;
+
+    HERE("landExpr", 3);
+    result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
+    if ((result != TCL_OK) || (infoPtr->token != AND)) {
+	return result;		/* envPtr->maxStackDepth is already set */
+    }
+
+    infoPtr->hasOperators = 1;
+    infoPtr->exprIsJustVarRef = 0;
+    maxDepth = envPtr->maxStackDepth;
+    TclInitJumpFixupArray(&jumpFixupArray);
+    while (infoPtr->token == AND) {
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '&&' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	if (jumpFixupArray.next == 0) {
+	    /*
+	     * Just the first "land" operand is on the stack. The following
+	     * is slightly ugly: we need to convert the first "land" operand
+	     * to a "0" or "1" to get the correct result if it is
+	     * nonzero. Eventually we'll use a new instruction.
+	     */
+
+	    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpTrueFixup);
+	     
+	    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0,
+				            /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 0;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
+		panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+	    }
+	    objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
+				            /*inHeap*/ 0, envPtr);
+	    objPtr = envPtr->objArrayPtr[objIndex];
+
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = 1;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    TclEmitPush(objIndex, envPtr);
+
+	    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+		panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+	    }
+	}
+
+	/*
+	 * Duplicate the value on top of the stack to prevent the jump from
+	 * consuming it.
+	 */
+
+	TclEmitOpcode(INST_DUP, envPtr);
+
+	/*
+	 * Emit the "short circuit" jump around the rest of the landExp if
+	 * the previous expression was false. We emit a one byte (relative)
+	 * jump here, and replace it later with a four byte jump if the jump
+	 * target is more than 127 bytes away.
+	 */
+
+	if (jumpFixupArray.next == jumpFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpFixupArray);
+	}
+	fixupIndex = jumpFixupArray.next;
+	jumpFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+		&(jumpFixupArray.fixup[fixupIndex]));
+	
+	/*
+	 * Compile the subexpression.
+	 */
+
+	result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	/*
+	 * Emit a "logical and" instruction. This does not try to "short-
+	 * circuit" the evaluation of both operands of a Tcl "&&" operator,
+	 * but instead ensures that we either have a "1" or a "0" result.
+	 */
+
+	TclEmitOpcode(INST_LAND, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the forward jumps, update the jumps
+     * with the correct distance. Also, if the distance is too great (> 127
+     * bytes), replace the jump with a four byte instruction and move the
+     * instructions after the jump down.
+     */
+    
+    for (j = jumpFixupArray.next;  j > 0;  j--) {
+	fixupIndex = (j - 1);	/* process closest jump first */
+	currCodeOffset = TclCurrCodeOffset();
+	jumpDist = (currCodeOffset - jumpFixupArray.fixup[fixupIndex].codeOffset);
+	TclFixupForwardJump(envPtr, &(jumpFixupArray.fixup[fixupIndex]), jumpDist, 127);
+    }
+
+    done:
+    TclFreeJumpFixupArray(&jumpFixupArray);
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileBitOrExpr --
+ *
+ *	This procedure compiles a Tcl bitwise or expression:
+ *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileBitOrExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+    HERE("bitOrExpr", 4);
+    result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    while (infoPtr->token == BIT_OR) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '|' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	
+	TclEmitOpcode(INST_BITOR, envPtr);
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileBitXorExpr --
+ *
+ *	This procedure compiles a Tcl bitwise exclusive or expression:
+ *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileBitXorExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+    HERE("bitXorExpr", 5);
+    result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    while (infoPtr->token == BIT_XOR) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '^' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	
+	TclEmitOpcode(INST_BITXOR, envPtr);
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileBitAndExpr --
+ *
+ *	This procedure compiles a Tcl bitwise and expression:
+ *	bitAndExpr ::= equalityExpr {'&' equalityExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileBitAndExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int result;
+
+    HERE("bitAndExpr", 6);
+    result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    
+    while (infoPtr->token == BIT_AND) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '&' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	
+	TclEmitOpcode(INST_BITAND, envPtr);
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileEqualityExpr --
+ *
+ *	This procedure compiles a Tcl equality (inequality) expression:
+ *	equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileEqualityExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("equalityExpr", 7);
+    result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == EQUAL) || (op == NEQ)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over == or != */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == EQUAL) {
+	    TclEmitOpcode(INST_EQ, envPtr);
+	} else {
+	    TclEmitOpcode(INST_NEQ, envPtr);
+	}
+	
+	op = infoPtr->token;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileRelationalExpr --
+ *
+ *	This procedure compiles a Tcl relational expression:
+ *	relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileRelationalExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("relationalExpr", 8);
+    result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == LESS) || (op == GREATER) || (op == LEQ) || (op == GEQ)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	switch (op) {
+	case LESS:
+	    TclEmitOpcode(INST_LT, envPtr);
+	    break;
+	case GREATER:
+	    TclEmitOpcode(INST_GT, envPtr);
+	    break;
+	case LEQ:
+	    TclEmitOpcode(INST_LE, envPtr);
+	    break;
+	case GEQ:
+	    TclEmitOpcode(INST_GE, envPtr);
+	    break;
+	}
+
+	op = infoPtr->token;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileShiftExpr --
+ *
+ *	This procedure compiles a Tcl shift expression:
+ *	shiftExpr ::= addExpr {('<<' | '>>') addExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileShiftExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("shiftExpr", 9);
+    result = CompileAddExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == LEFT_SHIFT) || (op == RIGHT_SHIFT)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over << or >> */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileAddExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == LEFT_SHIFT) {
+	    TclEmitOpcode(INST_LSHIFT, envPtr);
+	} else {
+	    TclEmitOpcode(INST_RSHIFT, envPtr);
+	}
+
+	op = infoPtr->token;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileAddExpr --
+ *
+ *	This procedure compiles a Tcl addition expression:
+ *	addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileAddExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("addExpr", 10);
+    result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == PLUS) || (op == MINUS)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over + or - */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == PLUS) {
+	    TclEmitOpcode(INST_ADD, envPtr);
+	} else {
+	    TclEmitOpcode(INST_SUB, envPtr);
+	}
+
+	op = infoPtr->token;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileMultiplyExpr --
+ *
+ *	This procedure compiles a Tcl multiply expression:
+ *	multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileMultiplyExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("multiplyExpr", 11);
+    result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    op = infoPtr->token;
+    while ((op == MULT) || (op == DIVIDE) || (op == MOD)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over * or / */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+
+	if (op == MULT) {
+	    TclEmitOpcode(INST_MULT, envPtr);
+	} else if (op == DIVIDE) {
+	    TclEmitOpcode(INST_DIV, envPtr);
+	} else {
+	    TclEmitOpcode(INST_MOD, envPtr);
+	}
+
+	op = infoPtr->token;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileUnaryExpr --
+ *
+ *	This procedure compiles a Tcl unary expression:
+ *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileUnaryExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int op, result;
+
+    HERE("unaryExpr", 12);
+    op = infoPtr->token;
+    if ((op == PLUS) || (op == MINUS) || (op == BIT_NOT) || (op == NOT)) {
+	infoPtr->hasOperators = 1;
+	infoPtr->exprIsJustVarRef = 0;
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+
+	result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+
+	switch (op) {
+	case PLUS:
+	    TclEmitOpcode(INST_UPLUS, envPtr);
+	    break;
+	case MINUS:
+	    TclEmitOpcode(INST_UMINUS, envPtr);
+	    break;
+	case BIT_NOT:
+	    TclEmitOpcode(INST_BITNOT, envPtr);
+	    break;
+	case NOT:
+	    TclEmitOpcode(INST_LNOT, envPtr);
+	    break;
+	}
+    } else {			/* must be a primaryExpr */
+	result = CompilePrimaryExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompilePrimaryExpr --
+ *
+ *	This procedure compiles a Tcl primary expression:
+ *	primaryExpr ::= literal | varReference | quotedString |
+ *			'[' command ']' | mathFuncCall | '(' condExpr ')'
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the expression.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompilePrimaryExpr(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int theToken;
+    char *dollarPtr, *quotePtr, *cmdPtr, *termPtr;
+    int result = TCL_OK;
+
+    /*
+     * We emit tryCvtToNumeric instructions after most of these primary
+     * expressions in order to support Tcl's policy of interpreting operands
+     * as first integers if possible, otherwise floating-point numbers if
+     * possible.
+     */
+
+    HERE("primaryExpr", 13);
+    theToken = infoPtr->token;
+
+    if (theToken != DOLLAR) {
+	infoPtr->exprIsJustVarRef = 0;
+    }
+    switch (theToken) {
+    case LITERAL:		/* int, double, or string in braces */
+	TclEmitPush(infoPtr->objIndex, envPtr);
+	maxDepth = 1;
+	break;
+	
+    case DOLLAR:		/* $var variable reference */
+	dollarPtr = (infoPtr->next - 1);
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileDollarVar(interp, dollarPtr,
+		infoPtr->lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	infoPtr->next = (dollarPtr + envPtr->termOffset);
+	break;
+	
+    case QUOTE:			/* quotedString */
+	quotePtr = infoPtr->next;
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileQuotes(interp, quotePtr,
+		infoPtr->lastChar, '"', flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	infoPtr->next = (quotePtr + envPtr->termOffset);
+	break;
+	
+    case OPEN_BRACKET:		/* '[' command ']' */
+	cmdPtr = infoPtr->next;
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileString(interp, cmdPtr,
+		infoPtr->lastChar, (flags | TCL_BRACKET_TERM), envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	termPtr = (cmdPtr + envPtr->termOffset);
+	if (*termPtr == ']') {
+	    infoPtr->next = (termPtr + 1); /* advance over the ']'. */
+	} else if (termPtr == infoPtr->lastChar) {
+	    /*
+	     * Missing ] at end of nested command.
+	     */
+	    
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "missing close-bracket", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	} else {
+	    panic("CompilePrimaryExpr: unexpected termination char '%c' for nested command\n", *termPtr);
+	}
+	maxDepth = envPtr->maxStackDepth;
+	break;
+	
+    case FUNC_NAME:
+	result = CompileMathFuncCall(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	break;
+	
+    case OPEN_PAREN:
+	result = GetToken(interp, infoPtr, envPtr); /* skip over the '(' */
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = envPtr->maxStackDepth;
+	if (infoPtr->token != CLOSE_PAREN) {
+	    goto syntaxError;
+	}
+	break;
+	
+    default:
+	goto syntaxError;
+    }
+
+    if (theToken != FUNC_NAME) {
+	/*
+	 * Advance to the next token before returning.
+	 */
+	
+	result = GetToken(interp, infoPtr, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+
+    syntaxError:
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	    "syntax error in expression \"", infoPtr->originalExpr,
+	    "\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileMathFuncCall --
+ *
+ *	This procedure compiles a call on a math function in an expression:
+ *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the function.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the math function at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileMathFuncCall(interp, infoPtr, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    MathFunc *mathFuncPtr;	/* Info about math function. */
+    int objIndex;		/* The object array index for an object
+				 * holding the function name if it is not
+				 * builtin. */
+    Tcl_HashEntry *hPtr;
+    char *p, *funcName;
+    char savedChar;
+    int result, i;
+
+    /*
+     * infoPtr->funcName points to the first character of the math
+     * function's name. Look for the end of its name and look up the
+     * MathFunc record for the function.
+     */
+
+    funcName = p = infoPtr->funcName;
+    while (isalnum(UCHAR(*p)) || (*p == '_')) {
+	p++;
+    }
+    infoPtr->next = p;
+    
+    result = GetToken(interp, infoPtr, envPtr); /* skip over func name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (infoPtr->token != OPEN_PAREN) {
+	goto syntaxError;
+    }
+    result = GetToken(interp, infoPtr, envPtr); /* skip over '(' */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    
+    savedChar = *p;
+    *p = 0;
+    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
+    if (hPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown math function \"", funcName, "\"", (char *) NULL);
+	result = TCL_ERROR;
+	*p = savedChar;
+	goto done;
+    }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * If not a builtin function, push an object with the function's name.
+     */
+
+    if (mathFuncPtr->builtinFuncIndex < 0) {   /* not builtin */
+	objIndex = TclObjIndexForString(funcName, -1, /*allocStrRep*/ 1,
+				        /*inHeap*/ 0, envPtr);
+	TclEmitPush(objIndex, envPtr);
+	maxDepth = 1;
+    }
+
+    /*
+     * Restore the saved character after the function name.
+     */
+
+    *p = savedChar;
+
+    /*
+     * Compile the arguments for the function, if there are any.
+     */
+
+    if (mathFuncPtr->numArgs > 0) {
+	for (i = 0;  ;  i++) {
+	    result = CompileCondExpr(interp, infoPtr, flags, envPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+    
+	    /*
+	     * Check for a ',' between arguments or a ')' ending the
+	     * argument list.
+	     */
+    
+	    if (i == (mathFuncPtr->numArgs-1)) {
+		if (infoPtr->token == CLOSE_PAREN) {
+		    break;	/* exit the argument parsing loop */
+		} else if (infoPtr->token == COMMA) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "too many arguments for math function", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		} else {
+		    goto syntaxError;
+		}
+	    }
+	    if (infoPtr->token != COMMA) {
+		if (infoPtr->token == CLOSE_PAREN) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "too few arguments for math function", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		} else {
+		    goto syntaxError;
+		}
+	    }
+	    result = GetToken(interp, infoPtr, envPtr); /* skip over , */
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth++;
+	}
+    }
+
+    if (infoPtr->token != CLOSE_PAREN) {
+	goto syntaxError;
+    }
+    result = GetToken(interp, infoPtr, envPtr); /* skip over ')' */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    
+    /*
+     * Compile the call on the math function. Note that the "objc" argument
+     * count for non-builtin functions is incremented by 1 to include the
+     * the function name itself.
+     */
+
+    if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
+	TclEmitInstUInt1(INST_CALL_BUILTIN_FUNC1,
+			mathFuncPtr->builtinFuncIndex, envPtr);
+    } else {
+	TclEmitInstUInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
+    }
+
+    done:
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+
+    syntaxError:
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"syntax error in expression \"", infoPtr->originalExpr,
+		"\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetToken --
+ *
+ *	Lexical scanner used to compile expressions: parses a single 
+ *	operator or other syntactic element from an expression string.
+ *
+ * Results:
+ *	TCL_OK is returned unless an error occurred. In that case a standard
+ *	Tcl error is returned, using the interpreter's result to hold an
+ *	error message. TCL_ERROR is returned if an integer overflow, or a
+ *	floating-point overflow or underflow occurred while reading in a
+ *	number. If the lexical analysis is successful, infoPtr->token refers
+ *	to the next symbol in the expression string, and infoPtr->next is
+ *	advanced past the token. Also, if the token is a integer, double, or
+ *	string literal, then infoPtr->objIndex the index of an object
+ *	holding the value in the code's object table; otherwise is NULL.
+ *
+ * Side effects:
+ *	Object are added to envPtr to hold the values of scanned literal
+ *	integers, doubles, or strings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetToken(interp, infoPtr, envPtr)
+    Tcl_Interp *interp;			/* Interpreter to use for error
+					 * reporting. */
+    register ExprInfo *infoPtr;         /* Describes the state of the
+					 * compiling the expression,
+					 * including the resulting token. */
+    CompileEnv *envPtr;			/* Holds objects that store literal
+					 * values that are scanned. */
+{
+    register char *src;		/* Points to current source char. */
+    register char c;		/* The current char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    char *termPtr;		/* Points to char terminating a literal. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during processing of
+				 * literal tokens. */
+    int objIndex;		/* The object array index for an object
+				 * holding a scanned literal. */
+    long longValue;		/* Value of a scanned integer literal. */
+    double doubleValue;		/* Value of a scanned double literal. */
+    Tcl_Obj *objPtr;
+
+    /*
+     * First initialize the scanner's "result" fields to default values.
+     */
+    
+    infoPtr->token = UNKNOWN;
+    infoPtr->objIndex = -1;
+    infoPtr->funcName = NULL;
+
+    /*
+     * Scan over leading white space at the start of a token. Note that a
+     * backslash-newline is treated as a space.
+     */
+
+    src = infoPtr->next;
+    c = *src;
+    type = CHAR_TYPE(src, infoPtr->lastChar);
+    while ((type & (TCL_SPACE | TCL_BACKSLASH)) || (c == '\n')) {
+	if (type == TCL_BACKSLASH) {
+	    if (src[1] == '\n') {
+		src += 2;
+	    } else {
+		break;	/* no longer white space */
+	    }
+	} else {
+	    src++;
+	}
+	c = *src;
+	type = CHAR_TYPE(src, infoPtr->lastChar);
+    }
+    if (src == infoPtr->lastChar) {
+	infoPtr->token = END;
+	infoPtr->next = src;
+	return TCL_OK;
+    }
+
+    /*
+     * Try to parse the token first as an integer or floating-point
+     * number. Don't check for a number if the first character is "+" or
+     * "-". If we did, we might treat a binary operator as unary by mistake,
+     * which would eventually cause a syntax error.
+     */
+
+    if ((*src != '+') && (*src != '-')) {
+	int startsWithDigit = isdigit(UCHAR(*src));
+	
+	if (startsWithDigit && TclLooksLikeInt(src)) {
+	    errno = 0;
+	    longValue = strtoul(src, &termPtr, 0);
+	    if (errno == ERANGE) {
+		char *s = "integer value too large to represent";
+		
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
+			(char *) NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Find/create an object in envPtr's object array that contains
+	     * the integer.
+	     */
+	    
+	    savedChar = *termPtr;
+	    *termPtr = '\0';
+	    objIndex = TclObjIndexForString(src, termPtr - src,
+		    /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
+	    *termPtr = savedChar;  /* restore the saved char */
+
+	    objPtr = envPtr->objArrayPtr[objIndex];
+	    Tcl_InvalidateStringRep(objPtr);
+	    objPtr->internalRep.longValue = longValue;
+	    objPtr->typePtr = &tclIntType;
+	    
+	    infoPtr->token = LITERAL;
+	    infoPtr->objIndex = objIndex;
+	    infoPtr->next = termPtr;
+	    return TCL_OK;
+	} else if (startsWithDigit || (*src == '.')
+	        || (*src == 'n') || (*src == 'N')) {
+	    errno = 0;
+	    doubleValue = strtod(src, &termPtr);
+	    if (termPtr != src) {
+		if (errno != 0) {
+		    TclExprFloatError(interp, doubleValue);
+		    return TCL_ERROR;
+		}
+
+		/*
+		 * Find/create an object in the object array containing the
+		 * double.
+		 */
+		
+		savedChar = *termPtr;
+		*termPtr = '\0';
+		objIndex = TclObjIndexForString(src, termPtr - src,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		*termPtr = savedChar;  /* restore the saved char */
+		
+		objPtr = envPtr->objArrayPtr[objIndex];
+		objPtr->internalRep.doubleValue = doubleValue;
+		objPtr->typePtr = &tclDoubleType;
+		
+		infoPtr->token = LITERAL;
+		infoPtr->objIndex = objIndex;
+		infoPtr->next = termPtr;
+		return TCL_OK;
+	    }
+	}
+    }
+
+    /*
+     * Not an integer or double literal. Check next for a string literal
+     * in braces.
+     */
+
+    if (*src == '{') {
+	int level = 0;		 /* The {} nesting level. */
+	int hasBackslashNL = 0;  /* Nonzero if '\newline' was found. */
+	char *string = src+1;	 /* Points just after the starting '{'. */
+	char *last;		 /* Points just before terminating '}'. */
+	int numChars;		 /* Number of chars in braced string. */
+	char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null char
+				  * during braced string processing. */
+	int numRead;
+
+	/*
+	 * Check first for any backslash-newlines, since we must treat
+	 * backslash-newlines specially (they must be replaced by spaces).
+	 */
+	
+	while (1) {
+	    if (src == infoPtr->lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-brace", -1);
+		return TCL_ERROR;
+	    } else if (CHAR_TYPE(src, infoPtr->lastChar) == TCL_NORMAL) {
+		src++;
+		continue;
+	    }
+	    c = *src++;
+	    if (c == '{') {
+		level++;
+	    } else if (c == '}') {
+		--level;
+		if (level == 0) {
+		    last = (src - 2); /* i.e. just before terminating } */
+		    break;
+		}
+	    } else if (c == '\\') {
+		if (*src == '\n') {
+		    hasBackslashNL = 1;
+		}
+		(void) Tcl_Backslash(src-1, &numRead);
+		src += numRead - 1;
+	    }
+	}
+
+	/*
+	 * Create a string object for the braced string. This starts at
+	 * "string" and ends just after "last" (which points to the final
+	 * character before the terminating '}'). If backslash-newlines were
+	 * found, we copy characters one at a time into a heap-allocated
+	 * buffer and do backslash-newline substitutions.
+	 */
+	
+	numChars = (last - string + 1);
+	savedChar = string[numChars];
+	string[numChars] = '\0';
+	if (hasBackslashNL && (numChars > 0)) {
+	    char *buffer = ckalloc((unsigned) numChars + 1);
+	    register char *dst = buffer;
+	    register char *p = string;
+	    while (p <= last) {
+		c = *dst++ = *p++;
+		if (c == '\\') {
+		    if (*p == '\n') {
+			dst[-1] = Tcl_Backslash(p-1, &numRead);
+			p += numRead - 1;
+		    } else {
+			(void) Tcl_Backslash(p-1, &numRead);
+			while (numRead > 1) {
+			    *dst++ = *p++;
+			    numRead--;
+			}
+		    }
+		}
+	    }
+	    *dst = '\0';
+	    objIndex = TclObjIndexForString(buffer, dst - buffer,
+		    /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+	} else {
+	    objIndex = TclObjIndexForString(string, numChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	}
+	string[numChars] = savedChar;   /* restore the saved char */
+
+	infoPtr->token = LITERAL;
+	infoPtr->objIndex = objIndex;
+	infoPtr->next = src;
+	return TCL_OK;
+    }
+
+    /*
+     * Not an literal value.
+     */
+
+    infoPtr->next = src+1;   /* assume a 1 char token and advance over it */
+    switch (*src) {
+	case '[':
+	    infoPtr->token = OPEN_BRACKET;
+	    return TCL_OK;
+
+	case ']':
+	    infoPtr->token = CLOSE_BRACKET;
+	    return TCL_OK;
+
+	case '(':
+	    infoPtr->token = OPEN_PAREN;
+	    return TCL_OK;
+
+	case ')':
+	    infoPtr->token = CLOSE_PAREN;
+	    return TCL_OK;
+
+	case '$':
+	    infoPtr->token = DOLLAR;
+	    return TCL_OK;
+
+	case '"':
+	    infoPtr->token = QUOTE;
+	    return TCL_OK;
+
+	case ',':
+	    infoPtr->token = COMMA;
+	    return TCL_OK;
+
+	case '*':
+	    infoPtr->token = MULT;
+	    return TCL_OK;
+
+	case '/':
+	    infoPtr->token = DIVIDE;
+	    return TCL_OK;
+
+	case '%':
+	    infoPtr->token = MOD;
+	    return TCL_OK;
+
+	case '+':
+	    infoPtr->token = PLUS;
+	    return TCL_OK;
+
+	case '-':
+	    infoPtr->token = MINUS;
+	    return TCL_OK;
+
+	case '?':
+	    infoPtr->token = QUESTY;
+	    return TCL_OK;
+
+	case ':':
+	    infoPtr->token = COLON;
+	    return TCL_OK;
+
+	case '<':
+	    switch (src[1]) {
+		case '<':
+		    infoPtr->next = src+2;
+		    infoPtr->token = LEFT_SHIFT;
+		    break;
+		case '=':
+		    infoPtr->next = src+2;
+		    infoPtr->token = LEQ;
+		    break;
+		default:
+		    infoPtr->token = LESS;
+		    break;
+	    }
+	    return TCL_OK;
+
+	case '>':
+	    switch (src[1]) {
+		case '>':
+		    infoPtr->next = src+2;
+		    infoPtr->token = RIGHT_SHIFT;
+		    break;
+		case '=':
+		    infoPtr->next = src+2;
+		    infoPtr->token = GEQ;
+		    break;
+		default:
+		    infoPtr->token = GREATER;
+		    break;
+	    }
+	    return TCL_OK;
+
+	case '=':
+	    if (src[1] == '=') {
+		infoPtr->next = src+2;
+		infoPtr->token = EQUAL;
+	    } else {
+		infoPtr->token = UNKNOWN;
+	    }
+	    return TCL_OK;
+
+	case '!':
+	    if (src[1] == '=') {
+		infoPtr->next = src+2;
+		infoPtr->token = NEQ;
+	    } else {
+		infoPtr->token = NOT;
+	    }
+	    return TCL_OK;
+
+	case '&':
+	    if (src[1] == '&') {
+		infoPtr->next = src+2;
+		infoPtr->token = AND;
+	    } else {
+		infoPtr->token = BIT_AND;
+	    }
+	    return TCL_OK;
+
+	case '^':
+	    infoPtr->token = BIT_XOR;
+	    return TCL_OK;
+
+	case '|':
+	    if (src[1] == '|') {
+		infoPtr->next = src+2;
+		infoPtr->token = OR;
+	    } else {
+		infoPtr->token = BIT_OR;
+	    }
+	    return TCL_OK;
+
+	case '~':
+	    infoPtr->token = BIT_NOT;
+	    return TCL_OK;
+
+	default:
+	    if (isalpha(UCHAR(*src))) {
+		infoPtr->token = FUNC_NAME;
+		infoPtr->funcName = src;
+		while (isalnum(UCHAR(*src)) || (*src == '_')) {
+		    src++;
+		}
+		infoPtr->next = src;
+		return TCL_OK;
+	    }
+	    infoPtr->next = src+1;
+	    infoPtr->token = UNKNOWN;
+	    return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateMathFunc --
+ *
+ *	Creates a new math function for expressions in a given
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The function defined by "name" is created or redefined. If the
+ *	function already exists then its definition is replaced; this
+ *	includes the builtin functions. Redefining a builtin function forces
+ *	all existing code to be invalidated since that code may be compiled
+ *	using an instruction specific to the replaced function. In addition,
+ *	redefioning a non-builtin function will force existing code to be
+ *	invalidated if the number of arguments has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
+    Tcl_Interp *interp;			/* Interpreter in which function is
+					 * to be available. */
+    char *name;				/* Name of function (e.g. "sin"). */
+    int numArgs;			/* Nnumber of arguments required by
+					 * function. */
+    Tcl_ValueType *argTypes;		/* Array of types acceptable for
+					 * each argument. */
+    Tcl_MathProc *proc;			/* Procedure that implements the
+					 * math function. */
+    ClientData clientData;		/* Additional value to pass to the
+					 * function. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    MathFunc *mathFuncPtr;
+    int new, i;
+
+    hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
+    if (new) {
+	Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
+    }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+
+    if (!new) {	
+	if (mathFuncPtr->builtinFuncIndex >= 0) {
+	    /*
+	     * We are redefining a builtin math function. Invalidate the
+             * interpreter's existing code by incrementing its
+             * compileEpoch member. This field is checked in Tcl_EvalObj
+             * and ObjInterpProc, and code whose compilation epoch doesn't
+             * match is recompiled. Newly compiled code will no longer
+             * treat the function as builtin.
+	     */
+
+	    iPtr->compileEpoch++;
+	} else {
+	    /*
+	     * A non-builtin function is being redefined. We must invalidate
+             * existing code if the number of arguments has changed. This
+	     * is because existing code was compiled assuming that number.
+	     */
+
+	    if (numArgs != mathFuncPtr->numArgs) {
+		iPtr->compileEpoch++;
+	    }
+	}
+    }
+    
+    mathFuncPtr->builtinFuncIndex = -1;	/* can't be a builtin function */
+    if (numArgs > MAX_MATH_ARGS) {
+	numArgs = MAX_MATH_ARGS;
+    }
+    mathFuncPtr->numArgs = numArgs;
+    for (i = 0;  i < numArgs;  i++) {
+	mathFuncPtr->argTypes[i] = argTypes[i];
+    }
+    mathFuncPtr->proc = proc;
+    mathFuncPtr->clientData = clientData;
+}
diff --git a/contrib/tcl/generic/tclCompile.c b/contrib/tcl/generic/tclCompile.c
new file mode 100644
index 0000000..e8aa99c
--- /dev/null
+++ b/contrib/tcl/generic/tclCompile.c
@@ -0,0 +1,7464 @@
+/* 
+ * tclCompile.c --
+ *
+ *	This file contains procedures that compile Tcl commands or parts
+ *	of commands (like quoted strings or nested sub-commands) into a
+ *	sequence of instructions ("bytecodes"). 
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclCompile.c 1.61 97/06/23 18:43:46
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * Variable that controls whether compilation tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no compilation tracing
+ *    1: summarize compilation of top level cmds and proc bodies
+ *    2: display all instructions of each ByteCode compiled
+ * This variable is linked to the Tcl variable "tcl_traceCompile".
+ */
+
+int tclTraceCompile = 0;
+static int traceInitialized = 0;
+
+/*
+ * Count of the number of compilations.
+ */
+
+#ifdef TCL_COMPILE_STATS
+long tclNumCompilations = 0;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * A table describing the Tcl bytecode instructions. The entries in this
+ * table must correspond to the list of instructions in tclInt.h. The names
+ * "op1" and "op4" refer to an instruction's one or four byte first operand.
+ * Similarly, "stktop" and "stknext" refer to the topmost and next to
+ * topmost stack elements.
+ *
+ * Note that the load, store, and incr instructions do not distinguish local
+ * from global variables; the bytecode interpreter at runtime uses the
+ * existence of a procedure call frame to distinguish these.
+ */
+
+InstructionDesc instructionTable[] = {
+   /* Name	      Bytes #Opnds Operand types        Stack top, next   */
+    {"done",	          1,   0,   {OPERAND_NONE}},
+        /* Finish ByteCode execution and return stktop (top stack item) */
+    {"push1",	          2,   1,   {OPERAND_UINT1}},
+        /* Push object at ByteCode objArray[op1] */
+    {"push4",	          5,   1,   {OPERAND_UINT4}},
+        /* Push object at ByteCode objArray[op4] */
+    {"pop",	          1,   0,   {OPERAND_NONE}},
+        /* Pop the topmost stack object */
+    {"dup",	          1,   0,   {OPERAND_NONE}},
+        /* Duplicate the topmost stack object and push the result */
+    {"concat1",	          2,   1,   {OPERAND_UINT1}},
+        /* Concatenate the top op1 items and push result */
+    {"invokeStk1",        2,   1,   {OPERAND_UINT1}},
+        /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
+    {"invokeStk4",        5,   1,   {OPERAND_UINT4}},
+        /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
+    {"evalStk",           1,   0,   {OPERAND_NONE}},
+        /* Evaluate command in stktop using Tcl_EvalObj. */
+    {"exprStk",           1,   0,   {OPERAND_NONE}},
+        /* Execute expression in stktop using Tcl_ExprStringObj. */
+    
+    {"loadScalar1",       2,   1,   {OPERAND_UINT1}},
+        /* Load scalar variable at index op1 <= 255 in call frame */
+    {"loadScalar4",       5,   1,   {OPERAND_UINT4}},
+        /* Load scalar variable at index op1 >= 256 in call frame */
+    {"loadScalarStk",     1,   0,   {OPERAND_NONE}},
+        /* Load scalar variable; scalar's name is stktop */
+    {"loadArray1",        2,   1,   {OPERAND_UINT1}},
+        /* Load array element; array at slot op1<=255, element is stktop */
+    {"loadArray4",        5,   1,   {OPERAND_UINT4}},
+        /* Load array element; array at slot op1 > 255, element is stktop */
+    {"loadArrayStk",      1,   0,   {OPERAND_NONE}},
+        /* Load array element; element is stktop, array name is stknext */
+    {"loadStk",           1,   0,   {OPERAND_NONE}},
+        /* Load general variable; unparsed variable name is stktop */
+    {"storeScalar1",      2,   1,   {OPERAND_UINT1}},
+        /* Store scalar variable at op1<=255 in frame; value is stktop */
+    {"storeScalar4",      5,   1,   {OPERAND_UINT4}},
+        /* Store scalar variable at op1 > 255 in frame; value is stktop */
+    {"storeScalarStk",    1,   0,   {OPERAND_NONE}},
+        /* Store scalar; value is stktop, scalar name is stknext */
+    {"storeArray1",       2,   1,   {OPERAND_UINT1}},
+        /* Store array element; array at op1<=255, value is top then elem */
+    {"storeArray4",       5,   1,   {OPERAND_UINT4}},
+        /* Store array element; array at op1>=256, value is top then elem */
+    {"storeArrayStk",     1,   0,   {OPERAND_NONE}},
+        /* Store array element; value is stktop, then elem, array names */
+    {"storeStk",          1,   0,   {OPERAND_NONE}},
+        /* Store general variable; value is stktop, then unparsed name */
+    
+    {"incrScalar1",       2,   1,   {OPERAND_UINT1}},
+        /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
+    {"incrScalarStk",     1,   0,   {OPERAND_NONE}},
+        /* Incr scalar; incr amount is stktop, scalar's name is stknext */
+    {"incrArray1",        2,   1,   {OPERAND_UINT1}},
+        /* Incr array elem; arr at slot op1<=255, amount is top then elem */
+    {"incrArrayStk",      1,   0,   {OPERAND_NONE}},
+        /* Incr array element; amount is top then elem then array names */
+    {"incrStk",           1,   0,   {OPERAND_NONE}},
+        /* Incr general variable; amount is stktop then unparsed var name */
+    {"incrScalar1Imm",    3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
+        /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
+    {"incrScalarStkImm",  2,   1,   {OPERAND_INT1}},
+        /* Incr scalar; scalar name is stktop; incr amount is op1 */
+    {"incrArray1Imm",     3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
+        /* Incr array elem; array at slot op1 <= 255, elem is stktop,
+	 * amount is 2nd operand byte */
+    {"incrArrayStkImm",   2,   1,   {OPERAND_INT1}},
+        /* Incr array element; elem is top then array name, amount is op1 */
+    {"incrStkImm",        2,   1,   {OPERAND_INT1}},
+        /* Incr general variable; unparsed name is top, amount is op1 */
+    
+    {"jump1",             2,   1,   {OPERAND_INT1}},
+        /* Jump relative to (pc + op1) */
+    {"jump4",             5,   1,   {OPERAND_INT4}},
+        /* Jump relative to (pc + op4) */
+    {"jumpTrue1",         2,   1,   {OPERAND_INT1}},
+        /* Jump relative to (pc + op1) if stktop expr object is true */
+    {"jumpTrue4",         5,   1,   {OPERAND_INT4}},
+        /* Jump relative to (pc + op4) if stktop expr object is true */
+    {"jumpFalse1",        2,   1,   {OPERAND_INT1}},
+        /* Jump relative to (pc + op1) if stktop expr object is false */
+    {"jumpFalse4",        5,   1,   {OPERAND_INT4}},
+        /* Jump relative to (pc + op4) if stktop expr object is false */
+
+    {"lor",               1,   0,   {OPERAND_NONE}},
+        /* Logical or:	push (stknext || stktop) */
+    {"land",              1,   0,   {OPERAND_NONE}},
+        /* Logical and:	push (stknext && stktop) */
+    {"bitor",             1,   0,   {OPERAND_NONE}},
+        /* Bitwise or:	push (stknext | stktop) */
+    {"bitxor",            1,   0,   {OPERAND_NONE}},
+        /* Bitwise xor	push (stknext ^ stktop) */
+    {"bitand",            1,   0,   {OPERAND_NONE}},
+        /* Bitwise and:	push (stknext & stktop) */
+    {"eq",                1,   0,   {OPERAND_NONE}},
+        /* Equal:	push (stknext == stktop) */
+    {"neq",               1,   0,   {OPERAND_NONE}},
+        /* Not equal:	push (stknext != stktop) */
+    {"lt",                1,   0,   {OPERAND_NONE}},
+        /* Less:	push (stknext < stktop) */
+    {"gt",                1,   0,   {OPERAND_NONE}},
+        /* Greater:	push (stknext || stktop) */
+    {"le",                1,   0,   {OPERAND_NONE}},
+        /* Logical or:	push (stknext || stktop) */
+    {"ge",                1,   0,   {OPERAND_NONE}},
+        /* Logical or:	push (stknext || stktop) */
+    {"lshift",            1,   0,   {OPERAND_NONE}},
+        /* Left shift:	push (stknext << stktop) */
+    {"rshift",            1,   0,   {OPERAND_NONE}},
+        /* Right shift:	push (stknext >> stktop) */
+    {"add",               1,   0,   {OPERAND_NONE}},
+        /* Add:		push (stknext + stktop) */
+    {"sub",               1,   0,   {OPERAND_NONE}},
+        /* Sub:		push (stkext - stktop) */
+    {"mult",              1,   0,   {OPERAND_NONE}},
+        /* Multiply:	push (stknext * stktop) */
+    {"div",               1,   0,   {OPERAND_NONE}},
+        /* Divide:	push (stknext / stktop) */
+    {"mod",               1,   0,   {OPERAND_NONE}},
+        /* Mod:		push (stknext % stktop) */
+    {"uplus",             1,   0,   {OPERAND_NONE}},
+        /* Unary plus:	push +stktop */
+    {"uminus",            1,   0,   {OPERAND_NONE}},
+        /* Unary minus:	push -stktop */
+    {"bitnot",            1,   0,   {OPERAND_NONE}},
+        /* Bitwise not:	push ~stktop */
+    {"not",               1,   0,   {OPERAND_NONE}},
+        /* Logical not:	push !stktop */
+    {"callBuiltinFunc1",  2,   1,   {OPERAND_UINT1}},
+        /* Call builtin math function with index op1; any args are on stk */
+    {"callFunc1",         2,   1,   {OPERAND_UINT1}},
+        /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
+    {"tryCvtToNumeric",   1,   0,   {OPERAND_NONE}},
+        /* Try converting stktop to first int then double if possible. */
+
+    {"break",             1,   0,   {OPERAND_NONE}},
+        /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
+    {"continue",          1,   0,   {OPERAND_NONE}},
+        /* Skip to next iteration of closest enclosing loop; if none,
+	 * return TCL_CONTINUE code. */
+
+    {"foreach_start4",    5,   1,   {OPERAND_UINT4}},
+        /* Initialize execution of a foreach loop. Operand is aux data index
+	 * of the ForeachInfo structure for the foreach command. */
+    {"foreach_step4",     5,   1,   {OPERAND_UINT4}},
+        /* "Step" or begin next iteration of foreach loop. Push 0 if to
+	 *  terminate loop, else push 1. */
+
+    {"beginCatch4",	  5,   1,   {OPERAND_UINT4}},
+        /* Record start of catch with the operand's exception range index.
+	 * Push the current stack depth onto a special catch stack. */
+    {"endCatch",	  1,   0,   {OPERAND_NONE}},
+        /* End of last catch. Pop the bytecode interpreter's catch stack. */
+    {"pushResult",	  1,   0,   {OPERAND_NONE}},
+        /* Push the interpreter's object result onto the stack. */
+    {"pushReturnCode",	  1,   0,   {OPERAND_NONE}},
+        /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
+	 * a new object onto the stack. */
+    {0}
+};
+
+/*
+ * The following table assigns a type to each character. Only types
+ * meaningful to Tcl parsing are represented here. The table is
+ * designed to be referenced with either signed or unsigned characters,
+ * so it has 384 entries. The first 128 entries correspond to negative
+ * character values, the next 256 correspond to positive character
+ * values. The last 128 entries are identical to the first 128. The
+ * table is always indexed with a 128-byte offset (the 128th entry
+ * corresponds to a 0 character value).
+ */
+
+unsigned char tclTypeTable[] = {
+    /*
+     * Negative character values, from -128 to -1:
+     */
+
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+
+    /*
+     * Positive character values, from 0-127:
+     */
+
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
+    TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
+    TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
+    TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
+    TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
+
+    /*
+     * Large unsigned character values, from 128-255:
+     */
+
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
+};
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		AdvanceToNextWord _ANSI_ARGS_((char *string,
+			    CompileEnv *envPtr));
+static int		CollectArgInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    ArgInfo *argInfoPtr));
+static int		CompileBraces _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+static int		CompileCmdWordInline _ANSI_ARGS_((
+    			    Tcl_Interp *interp, char *string,
+			    char *lastChar, int flags, CompileEnv *envPtr));
+static int		CompileExprWord _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags, 
+			    CompileEnv *envPtr));
+static int		CompileMultipartWord _ANSI_ARGS_((
+    			    Tcl_Interp *interp, char *string,
+			    char *lastChar, int flags, CompileEnv *envPtr));
+static int		CompileWord _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags, 
+			    CompileEnv *envPtr));
+static int		CreateExceptionRange _ANSI_ARGS_((
+			    ExceptionRangeType type, CompileEnv *envPtr));
+static void		DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static ClientData	DupForeachInfo _ANSI_ARGS_((ClientData clientData));
+static void		EnterCmdExtentData _ANSI_ARGS_((
+    			    CompileEnv *envPtr, int cmdNumber,
+			    int numSrcChars, int numCodeBytes));
+static void		EnterCmdStartData _ANSI_ARGS_((
+    			    CompileEnv *envPtr, int cmdNumber,
+			    int srcOffset, int codeOffset));
+static void		ExpandObjectArray _ANSI_ARGS_((CompileEnv *envPtr));
+static void		FreeForeachInfo _ANSI_ARGS_((
+			    ClientData clientData));
+static void		FreeByteCodeInternalRep _ANSI_ARGS_((
+    			    Tcl_Obj *objPtr));
+static void		FreeArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
+static void		InitArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
+static int		LookupCompiledLocal _ANSI_ARGS_((
+        		    char *name, int nameChars, int createIfNew,
+			    int flagsIfCreated, Proc *procPtr));
+static int		SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfByteCode _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines the bytecode Tcl object type by
+ * means of procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclByteCodeType = {
+    "bytecode",			/* name */
+    FreeByteCodeInternalRep,	/* freeIntRepProc */
+    DupByteCodeInternalRep,	/* dupIntRepProc */
+    UpdateStringOfByteCode,	/* updateStringProc */
+    SetByteCodeFromAny		/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintByteCodeObj --
+ *
+ *	This procedure prints ("disassembles") the instructions of a
+ *	bytecode object to stdout.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintByteCodeObj(interp, objPtr)
+    Tcl_Interp *interp;		/* Used only for Tcl_GetStringFromObj. */
+    Tcl_Obj *objPtr;		/* The bytecode object to disassemble. */
+{
+    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+    Proc *procPtr;
+    CmdLocation *mapPtr;
+    ExceptionRange *excRangeArrayPtr;
+    unsigned char *codeStart, *codeLimit, *pc, *start;
+    int numCmds, numRanges, cmd, maxChars, i;
+    char *source;
+
+    if (codePtr->refCount <= 0) {
+	return;			/* already freed */
+    }
+
+    codeStart = codePtr->codeStart;
+    codeLimit = (codeStart + codePtr->numCodeBytes);
+    source = codePtr->source;
+    procPtr = codePtr->procPtr;
+    numCmds  = codePtr->numCommands;
+    numRanges = codePtr->numExcRanges;
+    mapPtr = codePtr->cmdMapPtr;
+    excRangeArrayPtr = codePtr->excRangeArrayPtr;
+
+    fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x, interp epoch %u\n",
+	    (unsigned int) codePtr, codePtr->refCount,
+	    codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
+	    codePtr->iPtr->compileEpoch);
+    if (procPtr != NULL) {
+	int numCompiledLocals = procPtr->numCompiledLocals;
+	fprintf(stdout,
+	        "  Proc 0x%x, ref ct=%d, %d args, %d compiled locals\n",
+		(unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
+		numCompiledLocals);
+	if (numCompiledLocals > 0) {
+	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
+	    for (i = 0;  i < numCompiledLocals;  i++) {
+		fprintf(stdout, "      %d: frame index=%d, flags=0x%x%s%s",
+			i, localPtr->frameIndex, localPtr->flags,
+			(localPtr->isArg?  ", arg"  : ""),
+			(localPtr->isTemp? ", temp" : ""));
+		if (localPtr->isTemp) {
+		    fprintf(stdout,	"\n");
+		} else {
+		    fprintf(stdout,	", name=\"%s\"\n", localPtr->name);
+		}
+		localPtr = localPtr->nextPtr;
+	    }
+	}
+    }
+    fprintf(stdout, "  Source: ");
+    TclPrintSource(stdout, source, TclMin(codePtr->numSrcChars, 70));
+    fprintf(stdout, "\n  Chars=%d, bytes=%u, objs=%u, stk depth=%u, exc depth=%d, aux items=%d\n",
+	    codePtr->numSrcChars, codePtr->numCodeBytes,
+	    codePtr->numObjects, codePtr->maxStackDepth,
+	    codePtr->maxExcRangeDepth, codePtr->numAuxDataItems);
+
+    /*
+     * If there were no commands (e.g., an expression or an empty string
+     * was compiled), just print all instructions.
+     */
+
+    if (numCmds == 0) {
+	start = codeStart;
+	pc = start;
+	while (pc < codeLimit) {
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
+	}
+	return;
+    }
+    
+    /*
+     * Print table giving the source and object locations for each command.
+     */
+
+    fprintf(stdout, "  Commands=%d\n", numCmds);
+    for (i = 0;  i < numCmds;  i++) {
+	fprintf(stdout,	"      %d: source=%d-%d, code=%d-%d\n",
+		(i+1), mapPtr[i].srcOffset,
+		(mapPtr[i].srcOffset + mapPtr[i].numSrcChars - 1),
+		mapPtr[i].codeOffset,
+		(mapPtr[i].codeOffset + mapPtr[i].numCodeBytes - 1));
+    }
+    
+    /*
+     * Print the ExceptionRange array.
+     */
+
+    fprintf(stdout, "  Exception ranges=%d\n", numRanges);
+    for (i = 0;  i < numRanges;  i++) {
+	ExceptionRange *rangePtr = &(excRangeArrayPtr[i]);
+	fprintf(stdout, "      %d: level=%d, type=%s, pc range=%d-%d, ",
+		i, rangePtr->nestingLevel,
+		((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop" : "catch"),
+		rangePtr->codeOffset,
+		(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
+	switch (rangePtr->type) {
+	case LOOP_EXCEPTION_RANGE:
+	    fprintf(stdout,	"continue=%d, break=%d\n",
+		    rangePtr->continueOffset, rangePtr->breakOffset);
+	    break;
+	case CATCH_EXCEPTION_RANGE:
+	    fprintf(stdout,	"catch=%d\n", rangePtr->catchOffset);
+	    break;
+	default:
+	    fprintf(stdout,	"unrecognized ExceptionRange type %d\n",
+		    rangePtr->type);
+	}
+    }
+    
+    /*
+     * Print each instruction. If the instruction corresponds to the start
+     * of a command, print the command's source.
+     */
+
+    start = codeStart;
+    cmd = 0;
+    pc = start;
+    while (pc < codeLimit) {
+	int pcOffset = (pc - start);
+	while ((cmd < numCmds) && (pcOffset >= mapPtr[cmd].codeOffset)) {
+            /*
+	     * The start of the command with index cmd.
+	     */
+	    
+	    maxChars = TclMin(mapPtr[cmd].numSrcChars, 70);
+	    fprintf(stdout, "  Command %d: ", (cmd+1));
+	    TclPrintSource(stdout, (source + mapPtr[cmd].srcOffset),
+			   maxChars);
+	    fprintf(stdout, "\n");
+	    cmd++;
+	}
+	fprintf(stdout, "    ");
+	pc += TclPrintInstruction(codePtr, pc);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ *	This procedure prints ("disassembles") one instruction from a
+ *	bytecode object to stdout.
+ *
+ * Results:
+ *	Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(codePtr, pc)
+    ByteCode* codePtr;		/* Bytecode containing the instruction. */
+    unsigned char *pc;		/* Points to first byte of instruction. */
+{
+    Proc *procPtr = codePtr->procPtr;
+    unsigned char opCode = *pc;
+    register InstructionDesc *instDesc = &instructionTable[opCode];
+    unsigned char *codeStart = codePtr->codeStart;
+    unsigned int pcOffset = (pc - codeStart);
+    int opnd, elemLen, i, j;
+    Tcl_Obj *elemPtr;
+    char *string;
+    
+    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
+    for (i = 0;  i < instDesc->numOperands;  i++) {
+	switch (instDesc->opTypes[i]) {
+	case OPERAND_INT1:
+	    opnd = TclGetInt1AtPc(pc+1+i);
+	    if ((i == 0) && ((opCode == INST_JUMP1)
+			     || (opCode == INST_JUMP_TRUE1)
+		             || (opCode == INST_JUMP_FALSE1))) {
+		fprintf(stdout, "%d	# pc %u", opnd, (pcOffset + opnd));
+	    } else {
+		fprintf(stdout, "%d", opnd);
+	    }
+	    break;
+	case OPERAND_INT4:
+	    opnd = TclGetInt4AtPc(pc+1+i);
+	    if ((i == 0) && ((opCode == INST_JUMP4)
+			     || (opCode == INST_JUMP_TRUE4)
+		             || (opCode == INST_JUMP_FALSE4))) {
+		fprintf(stdout, "%d	# pc %u", opnd, (pcOffset + opnd));
+	    } else {
+		fprintf(stdout, "%d", opnd);
+	    }
+	    break;
+	case OPERAND_UINT1:
+	    opnd = TclGetUInt1AtPc(pc+1+i);
+	    if ((i == 0) && (opCode == INST_PUSH1)) {
+		elemPtr = codePtr->objArrayPtr[opnd];
+		string = Tcl_GetStringFromObj(elemPtr, &elemLen);
+		fprintf(stdout, "%u  	# ", (unsigned int) opnd);
+		TclPrintSource(stdout, string, TclMin(elemLen, 40));
+	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
+				    || (opCode == INST_LOAD_ARRAY1)
+				    || (opCode == INST_STORE_SCALAR1)
+				    || (opCode == INST_STORE_ARRAY1))) {
+		int localCt = procPtr->numCompiledLocals;
+		CompiledLocal *localPtr = procPtr->firstLocalPtr;
+		if (opnd >= localCt) {
+		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
+			     (unsigned int) opnd, localCt);
+		    return instDesc->numBytes;
+		}
+		for (j = 0;  j < opnd;  j++) {
+		    localPtr = localPtr->nextPtr;
+		}
+		if (localPtr->isTemp) {
+		    fprintf(stdout, "%u	# temp var %u",
+			    (unsigned int) opnd, (unsigned int) opnd);
+		} else {
+		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
+		    TclPrintSource(stdout, localPtr->name, 40);
+		}
+	    } else {
+		fprintf(stdout, "%u ", (unsigned int) opnd);
+	    }
+	    break;
+	case OPERAND_UINT4:
+	    opnd = TclGetUInt4AtPc(pc+1+i);
+	    if (opCode == INST_PUSH4) {
+		elemPtr = codePtr->objArrayPtr[opnd];
+		string = Tcl_GetStringFromObj(elemPtr, &elemLen);
+		fprintf(stdout, "%u  	# ", opnd);
+		TclPrintSource(stdout, string, TclMin(elemLen, 40));
+	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
+				    || (opCode == INST_LOAD_ARRAY4)
+				    || (opCode == INST_STORE_SCALAR4)
+				    || (opCode == INST_STORE_ARRAY4))) {
+		int localCt = procPtr->numCompiledLocals;
+		CompiledLocal *localPtr = procPtr->firstLocalPtr;
+		if (opnd >= localCt) {
+		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
+			     (unsigned int) opnd, localCt);
+		    return instDesc->numBytes;
+		}
+		for (j = 0;  j < opnd;  j++) {
+		    localPtr = localPtr->nextPtr;
+		}
+		if (localPtr->isTemp) {
+		    fprintf(stdout, "%u	# temp var %u",
+			    (unsigned int) opnd, (unsigned int) opnd);
+		} else {
+		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
+		    TclPrintSource(stdout, localPtr->name, 40);
+		}
+	    } else {
+		fprintf(stdout, "%u ", (unsigned int) opnd);
+	    }
+	    break;
+	case OPERAND_NONE:
+	default:
+	    break;
+	}
+    }
+    fprintf(stdout, "\n");
+    return instDesc->numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ *	This procedure prints up to a specified number of characters from
+ *	the argument string to a specified file. It tries to produce legible
+ *	output by adding backslashes as necessary.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(outFile, string, maxChars)
+    FILE *outFile;		/* The file to print the source to. */
+    char *string;		/* The string to print. */
+    int maxChars;		/* Maximum number of chars to print. */
+{
+    register char *p;
+    register int i = 0;
+
+    if (string == NULL) {
+	fprintf(outFile, "\"\"");
+	return;
+    }
+
+    fprintf(outFile, "\"");
+    p = string;
+    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
+	switch (*p) {
+	    case '"':
+		fprintf(outFile, "\\\"");
+		continue;
+	    case '\f':
+		fprintf(outFile, "\\f");
+		continue;
+	    case '\n':
+		fprintf(outFile, "\\n");
+		continue;
+            case '\r':
+		fprintf(outFile, "\\r");
+		continue;
+	    case '\t':
+		fprintf(outFile, "\\t");
+		continue;
+            case '\v':
+		fprintf(outFile, "\\v");
+		continue;
+	    default:
+		fprintf(outFile, "%c", *p);
+		continue;
+	}
+    }
+    fprintf(outFile, "\"");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeByteCodeInternalRep --
+ *
+ *	Part of the bytecode Tcl object type implementation. Frees the
+ *	storage associated with a bytecode object's internal representation
+ *	unless its code is actively being executed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The bytecode object's internal rep is marked invalid and its
+ *	code gets freed unless the code is actively being executed.
+ *	In that case the cleanup is delayed until the last execution
+ *	of the code completes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeByteCodeInternalRep(objPtr)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to free. */
+{
+    register ByteCode *codePtr =
+	    (ByteCode *) objPtr->internalRep.otherValuePtr;
+
+    codePtr->refCount--;
+    if (codePtr->refCount <= 0) {
+	TclCleanupByteCode(codePtr);
+    }
+    objPtr->typePtr = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupByteCode --
+ *
+ *	This procedure does all the real work of freeing up a bytecode
+ *	object's ByteCode structure. It's called only when the structure's
+ *	reference count becomes zero.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees objPtr's bytecode internal representation and sets
+ *	its type and objPtr->internalRep.otherValuePtr NULL. Also
+ *	decrements the ref counts on each object in its object array,
+ *	and frees its auxiliary data items.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCleanupByteCode(codePtr)
+    ByteCode *codePtr;		/* ByteCode to free. */
+{
+    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
+    int numObjects = codePtr->numObjects;
+    int numAuxDataItems = codePtr->numAuxDataItems;
+    register AuxData *auxDataPtr;
+    register Tcl_Obj *elemPtr;
+    register int i;
+
+    /*
+     * A single heap object holds the ByteCode structure and its code,
+     * object, command location, and auxiliary data arrays. This means we
+     * only need to 1) decrement the ref counts on the objects in its
+     * object array, 2) call the free procs for the auxiliary data items,
+     * and 3) free the ByteCode structure's heap object.
+     */
+
+    for (i = 0;  i < numObjects;  i++) {
+	elemPtr = objArrayPtr[i];
+	TclDecrRefCount(elemPtr);
+    }
+
+    auxDataPtr = codePtr->auxDataArrayPtr;
+    for (i = 0;  i < numAuxDataItems;  i++) {
+	if (auxDataPtr->freeProc != NULL) {
+	    auxDataPtr->freeProc(auxDataPtr->clientData);
+	}
+	auxDataPtr++;
+    }
+    
+    ckfree((char *) codePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupByteCodeInternalRep --
+ *
+ *	Part of the bytecode Tcl object type implementation. Initializes the
+ *	internal representation of a bytecode Tcl_Obj to a copy of the
+ *	internal representation of an existing bytecode object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the bytecode sequence
+ *	corresponding to "srcPtr"s internal rep. Ref counts for objects
+ *	in the existing bytecode object's  object array are incremented
+ *	the bytecode copy now also refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupByteCodeInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+{
+    ByteCode *codePtr = (ByteCode *) srcPtr->internalRep.otherValuePtr;
+    register ByteCode *dupPtr;
+    int codeBytes = codePtr->numCodeBytes;
+    int numObjects = codePtr->numObjects;
+    int numAuxDataItems = codePtr->numAuxDataItems;
+    register AuxData *srcAuxDataPtr, *dupAuxDataPtr;
+    size_t objArrayBytes, rangeArrayBytes, cmdLocBytes, auxDataBytes;
+    register size_t size;
+    register char *p;
+    int i;
+
+    /*
+     * Allocate a single heap object to hold the copied ByteCode structure
+     * and its code, object, command location, and auxiliary data arrays.
+     */
+
+    objArrayBytes = numObjects * sizeof(Tcl_Obj *);
+    rangeArrayBytes = (codePtr->numExcRanges * sizeof(ExceptionRange));
+    cmdLocBytes = codePtr->numCommands * sizeof(CmdLocation);
+    auxDataBytes = numAuxDataItems * sizeof(AuxData);
+
+    size = TCL_ALIGN(sizeof(ByteCode));
+    size += TCL_ALIGN(codeBytes);
+    size += TCL_ALIGN(objArrayBytes);
+    size += TCL_ALIGN(rangeArrayBytes);
+    size += TCL_ALIGN(cmdLocBytes);
+    size += TCL_ALIGN(auxDataBytes);
+    
+    p = (char *) ckalloc(size);
+    dupPtr = (ByteCode *) p;
+    memcpy((VOID *) dupPtr, (VOID *) codePtr, size);
+
+    p += TCL_ALIGN(sizeof(ByteCode));
+    dupPtr->codeStart = (unsigned char *) p;
+    
+    p += TCL_ALIGN(codeBytes);
+    dupPtr->objArrayPtr = (Tcl_Obj **) p;
+    
+    p += TCL_ALIGN(objArrayBytes);
+    dupPtr->excRangeArrayPtr = (ExceptionRange *) p;
+    
+    p += TCL_ALIGN(rangeArrayBytes);
+    dupPtr->cmdMapPtr = (CmdLocation *) p;
+    
+    p += TCL_ALIGN(cmdLocBytes);
+    dupPtr->auxDataArrayPtr = (AuxData *) p;
+    
+    /*
+     * Increment the ref counts for objects in the object array since we are
+     * creating new references for them in the copied object array.
+     */
+
+    for (i = 0;  i < numObjects;  i++) {
+        Tcl_IncrRefCount(dupPtr->objArrayPtr[i]);
+    }
+
+    /*
+     * Duplicate any auxiliary data items.
+     */
+
+    srcAuxDataPtr = codePtr->auxDataArrayPtr;
+    dupAuxDataPtr = dupPtr->auxDataArrayPtr;
+    for (i = 0;  i < numAuxDataItems;  i++) {
+	if (srcAuxDataPtr->dupProc != NULL) {
+	    dupAuxDataPtr->clientData =
+		srcAuxDataPtr->dupProc(srcAuxDataPtr->clientData);
+	} else {
+	    dupAuxDataPtr->clientData = srcAuxDataPtr->clientData;
+	}
+	srcAuxDataPtr++;
+	dupAuxDataPtr++;
+    }
+
+    copyPtr->internalRep.otherValuePtr = (VOID *) dupPtr;
+    copyPtr->typePtr = &tclByteCodeType;
+}
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * SetByteCodeFromAny --
+ *
+ *	Part of the bytecode Tcl object type implementation. Attempts to
+ *	generate an byte code internal form for the Tcl object "objPtr" by
+ *	compiling its string representation.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during compilation, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	Frees the old internal representation. If no error occurs, then the
+ *	compiled code is stored as "objPtr"s bytecode representation.
+ *	Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
+ *	used to trace compilations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetByteCodeFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* The interpreter for which the code is
+				 * compiled. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *string;
+    CompileEnv compEnv;		/* Compilation environment structure
+				 * allocated in frame. */
+    AuxData *auxDataPtr;
+    register int i;
+    int length, result;
+
+    if (!traceInitialized) {
+        if (Tcl_LinkVar(interp, "tcl_traceCompile",
+	            (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
+            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
+        }
+        traceInitialized = 1;
+    }
+    
+#ifdef TCL_COMPILE_STATS
+    tclNumCompilations++;
+#endif /* TCL_COMPILE_STATS */
+
+    string = Tcl_GetStringFromObj(objPtr, &length);
+    TclInitCompileEnv(interp, &compEnv, string);
+    result = TclCompileString(interp, string, string+length,
+	    iPtr->evalFlags, &compEnv);
+    if (result == TCL_OK) {
+	/*
+	 * Add a "done" instruction at the end of the instruction sequence.
+	 */
+    
+	TclEmitOpcode(INST_DONE, &compEnv);
+	
+	/*
+	 * Convert the object to a ByteCode object.
+	 */
+
+	TclInitByteCodeObj(objPtr, &compEnv);
+    } else {
+	/*
+	 * Compilation errors. Decrement the ref counts on any objects in
+	 * the object array and free any aux data items prior to freeing
+	 * the compilation environment.
+	 */
+	
+	for (i = 0;  i < compEnv.objArrayNext;  i++) {
+	    Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
+	    Tcl_DecrRefCount(elemPtr);
+	}
+
+	auxDataPtr = compEnv.auxDataArrayPtr;
+	for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
+	    if (auxDataPtr->freeProc != NULL) {
+		auxDataPtr->freeProc(auxDataPtr->clientData);
+	    }
+	    auxDataPtr++;
+	}
+    }
+    TclFreeCompileEnv(&compEnv);
+
+    if (result == TCL_OK) {
+	if (tclTraceCompile == 2) {
+	    TclPrintByteCodeObj(interp, objPtr);
+	}
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfByteCode --
+ *
+ *	Part of the bytecode Tcl object type implementation. Called to
+ *	update the string representation for a byte code object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Generates a panic. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfByteCode(objPtr)
+    register Tcl_Obj *objPtr;	/* ByteCode object with string rep that 
+				 * needs updating. */
+{
+    /*
+     * This procedure is never invoked since the internal representation of
+     * a bytecode object is never modified.
+     */
+
+    panic("UpdateStringOfByteCode should never be called.");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitCompileEnv --
+ *
+ *	Initializes a CompileEnv compilation environment structure for the
+ *	compilation of a string in an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The CompileEnv structure is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitCompileEnv(interp, envPtr, string)
+    Tcl_Interp *interp;		 /* The interpreter for which a CompileEnv
+				  * structure is initialized. */
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure to
+				  * initialize. */
+    char *string;		 /* The source string to be compiled. */
+{
+    Interp *iPtr = (Interp *) interp;
+    
+    envPtr->iPtr = iPtr;
+    envPtr->source = string;
+    envPtr->procPtr = iPtr->compiledProcPtr;
+    envPtr->numCommands = 0;
+    envPtr->excRangeDepth = 0;
+    envPtr->maxExcRangeDepth = 0;
+    envPtr->maxStackDepth = 0;
+    Tcl_InitHashTable(&(envPtr->objTable), TCL_STRING_KEYS);
+    envPtr->pushSimpleWords = 1;
+    envPtr->wordIsSimple = 0;
+    envPtr->numSimpleWordChars = 0;
+    envPtr->exprIsJustVarRef = 0;
+    envPtr->termOffset = 0;
+
+    envPtr->codeStart = envPtr->staticCodeSpace;
+    envPtr->codeNext = envPtr->codeStart;
+    envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
+    envPtr->mallocedCodeArray = 0;
+
+    envPtr->objArrayPtr = envPtr->staticObjArraySpace;
+    envPtr->objArrayNext = 0;
+    envPtr->objArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
+    envPtr->mallocedObjArray = 0;
+    
+    envPtr->excRangeArrayPtr = envPtr->staticExcRangeArraySpace;
+    envPtr->excRangeArrayNext = 0;
+    envPtr->excRangeArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
+    envPtr->mallocedExcRangeArray = 0;
+    
+    envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
+    envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
+    envPtr->mallocedCmdMap = 0;
+    
+    envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
+    envPtr->auxDataArrayNext = 0;
+    envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
+    envPtr->mallocedAuxDataArray = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeCompileEnv --
+ *
+ *	Free the storage allocated in a CompileEnv compilation environment
+ *	structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated storage in the CompileEnv structure is freed. Note that
+ *	ref counts for Tcl objects in its object table are not decremented.
+ *	In addition, any storage referenced by any auxiliary data items
+ *	in the CompileEnv structure are not freed either. The expectation
+ *	is that when compilation is successful, "ownership" (i.e., the
+ *	pointers to) these objects and aux data items will just be handed
+ *	over to the corresponding ByteCode structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeCompileEnv(envPtr)
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
+{
+    Tcl_DeleteHashTable(&(envPtr->objTable));
+    if (envPtr->mallocedCodeArray) {
+	ckfree((char *) envPtr->codeStart);
+    }
+    if (envPtr->mallocedObjArray) {
+	ckfree((char *) envPtr->objArrayPtr);
+    }
+    if (envPtr->mallocedExcRangeArray) {
+	ckfree((char *) envPtr->excRangeArrayPtr);
+    }
+    if (envPtr->mallocedCmdMap) {
+	ckfree((char *) envPtr->cmdMapPtr);
+    }
+    if (envPtr->mallocedAuxDataArray) {
+	ckfree((char *) envPtr->auxDataArrayPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitByteCodeObj --
+ *
+ *	Create a ByteCode structure and initialize it from a CompileEnv
+ *	compilation environment structure. The ByteCode structure is
+ *	smaller and contains just that information needed to execute
+ *	the bytecode instructions resulting from compiling a Tcl script.
+ *	The resulting structure is placed in the specified object.
+ *
+ * Results:
+ *	A newly constructed ByteCode object is stored in the internal
+ *	representation of the objPtr.
+ *
+ * Side effects:
+ *	A single heap object is allocated to hold the new ByteCode structure
+ *	and its code, object, command location, and aux data arrays. Note
+ *	that "ownership" (i.e., the pointers to) the Tcl objects and aux
+ *	data items will be handed over to the new ByteCode structure from
+ *	the CompileEnv structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitByteCodeObj(objPtr, envPtr)
+    Tcl_Obj *objPtr;		/* Points object that should be
+				 * initialized, and whose string rep
+				 * contains the source code. */
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure from
+				  * which to create a ByteCode structure. */
+{
+    register ByteCode *codePtr;
+    size_t codeBytes, objArrayBytes, rangeArrayBytes, cmdLocBytes;
+    size_t auxDataArrayBytes;
+    register size_t size;
+    register char *p;
+
+    codeBytes = envPtr->codeNext - envPtr->codeStart;
+    objArrayBytes = envPtr->objArrayNext * sizeof(Tcl_Obj *);
+    rangeArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
+    cmdLocBytes = envPtr->numCommands * sizeof(CmdLocation);
+    auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
+    
+    size = TCL_ALIGN(sizeof(ByteCode));
+    size += TCL_ALIGN(codeBytes);
+    size += TCL_ALIGN(objArrayBytes);
+    size += TCL_ALIGN(rangeArrayBytes);
+    size += TCL_ALIGN(cmdLocBytes);
+    size += TCL_ALIGN(auxDataArrayBytes);
+    
+    p = (char *) ckalloc(size);
+    codePtr = (ByteCode *) p;
+    codePtr->iPtr = envPtr->iPtr;
+    codePtr->compileEpoch = envPtr->iPtr->compileEpoch;
+    codePtr->refCount = 1;
+    codePtr->source = envPtr->source;
+    codePtr->procPtr = envPtr->procPtr;
+    codePtr->numCommands = envPtr->numCommands;
+    codePtr->numSrcChars = envPtr->termOffset;
+    codePtr->numCodeBytes = codeBytes;
+    codePtr->numObjects = envPtr->objArrayNext;
+    codePtr->numExcRanges = envPtr->excRangeArrayNext;
+    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
+    codePtr->maxExcRangeDepth = envPtr->maxExcRangeDepth;
+    codePtr->maxStackDepth = envPtr->maxStackDepth;
+    
+    p += TCL_ALIGN(sizeof(ByteCode));
+    codePtr->codeStart = (unsigned char *) p;
+    memcpy((VOID *) p, (VOID *) envPtr->codeStart, codeBytes);
+    
+    p += TCL_ALIGN(codeBytes);
+    codePtr->objArrayPtr = (Tcl_Obj **) p;
+    memcpy((VOID *) p, (VOID *) envPtr->objArrayPtr, objArrayBytes);
+    
+    p += TCL_ALIGN(objArrayBytes);
+    codePtr->excRangeArrayPtr = (ExceptionRange *) p;
+    memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr, rangeArrayBytes);
+
+    p += TCL_ALIGN(rangeArrayBytes);
+    codePtr->cmdMapPtr = (CmdLocation *) p;
+    memcpy((VOID *) p, (VOID *) envPtr->cmdMapPtr, cmdLocBytes);
+
+    p += TCL_ALIGN(cmdLocBytes);
+    codePtr->auxDataArrayPtr = (AuxData *) p;
+    memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr, auxDataArrayBytes);
+
+    /*
+     * Free the old internal rep then convert the object to a
+     * bytecode object by making its internal rep point to the just
+     * compiled ByteCode.
+     */
+	    
+    if ((objPtr->typePtr != NULL) &&
+	    (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
+    objPtr->typePtr = &tclByteCodeType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileString --
+ *
+ *	Compile a Tcl script in a null-terminated binary string.
+ *
+ * Results:
+ *	The return value is TCL_OK on a successful compilation and TCL_ERROR
+ *	on failure. If TCL_ERROR is returned, then the interpreter's result
+ *	contains an error message.
+ *
+ *	envPtr->termOffset and interp->termOffset are filled in with the
+ *	offset of the character in the string just after the last one
+ *	successfully processed; this might be the offset of the ']' (if
+ *	flags & TCL_BRACKET_TERM), or the offset of the '\0' at the end of
+ *	the string. Also updates envPtr->maxStackDepth with the maximum
+ *	number of stack elements needed to execute the string's commands.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the string at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileString(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char *src = string;/* Points to current source char. */
+    register char c = *src;	/* The current char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    char termChar = (char)((flags & TCL_BRACKET_TERM)? ']' : '\0');
+				/* Return when this character is found
+				 * (either ']' or '\0'). Zero means newlines
+				 * terminate cmds. */
+    int isFirstCmd = 1;		/* 1 if compiling the first cmd. */
+    char *cmdSrcStart = NULL;	/* Points to first non-blank char in each
+ 				 * command. Initialized to avoid compiler
+ 				 * warning. */
+    int cmdIndex = -1;		/* The index of the current command in the
+ 				 * compilation environment's command
+ 				 * location table. Initialized to avoid
+ 				 * compiler warning. */
+    int cmdCodeOffset = -1;	/* Offset of first byte of current command's
+ 				 * code. Initialized to avoid compiler
+ 				 * warning. */
+    int cmdCodeBytes;		/* Number of code bytes for current
+				 * command. */
+    int cmdWords;		/* Number of words in current command. */
+    Tcl_Command cmd;		/* Used to search for commands. */
+    Command *cmdPtr;		/* Points to command's Command structure if
+				 * first word is simple and command was
+				 * found; else NULL. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute all cmds. */
+    char *termPtr;		/* Points to char that terminated word. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null character
+				 * during processing of words. */
+    int objIndex = -1;		/* The object array index for a pushed
+ 				 * object holding a word or word part
+ 				 * Initialized to avoid compiler warning. */
+    unsigned char *entryCodeNext = envPtr->codeNext;
+    				/* Value of envPtr's current instruction
+				 * pointer at entry. Used to tell if any
+				 * instructions generated. */
+    char *ellipsis = "";	/* Used to set errorInfo variable; "..."
+				 * indicates that not all of offending
+				 * command is included in errorInfo. ""
+				 * means that the command is all there. */
+    Tcl_Obj *objPtr;
+    int numChars;
+    int result = TCL_OK;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * commands: command {(';' | '\n') command}
+     */
+
+    while ((src != lastChar) && (c != termChar)) {
+	/*
+	 * Skip white space, semicolons, backslash-newlines (treated as
+	 * spaces), and comments before command.
+	 */
+
+	type = CHAR_TYPE(src, lastChar);
+	while ((type & (TCL_SPACE | TCL_BACKSLASH))
+	        || (c == '\n') || (c == ';')) {
+	    if (type == TCL_BACKSLASH) {
+		if (src[1] == '\n') {
+		    src += 2;
+		} else {
+		    break;	/* no longer white space */
+		}
+	    } else {
+		src++;
+	    }
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	}
+
+	if (c == '#') {
+	    while (src != lastChar) {
+		if (c == '\\') {
+		    int numRead;
+		    Tcl_Backslash(src, &numRead);
+		    src += numRead;
+		} else if (c == '\n') {
+		    src++;
+		    c = *src;
+		    envPtr->termOffset = (src - string);
+		    break;
+		} else {
+		    src++;
+		}
+		c = *src;
+	    }
+	    continue;	/* end of comment, restart outer command loop */
+	}
+
+	/*
+	 * Compile one command: zero or more words terminated by a '\n',
+	 * ';', ']' (if command is terminated by close bracket), or
+	 * the end of string.
+	 *
+	 * command: word*
+	 */
+
+	type = CHAR_TYPE(src, lastChar);
+	if ((type == TCL_COMMAND_END) 
+	        && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
+	    continue;  /* ignore empty command; restart outer cmd loop */
+	}
+
+	/*
+	 * If not the first command, discard the previous command's result.
+	 */
+	
+	if (!isFirstCmd) {
+	    TclEmitOpcode(INST_POP, envPtr);
+	    if (!(flags & TCL_BRACKET_TERM)) {
+		/*
+		 * We are compiling a top level command. Update the number
+		 * of code bytes for the last command to account for the pop
+		 * instruction we just emitted.
+		 */
+		
+		int lastCmdIndex = (envPtr->numCommands - 1);
+		cmdCodeBytes =
+		    (envPtr->codeNext - envPtr->codeStart - cmdCodeOffset);
+	        (envPtr->cmdMapPtr[lastCmdIndex]).numCodeBytes =
+		    cmdCodeBytes;
+	    }
+	}
+
+	/*
+	 * Compile the words of the command. Process the first word
+	 * specially, since it is the name of a command. If it is a "simple"
+	 * string (just a sequence of characters), look it up in the table
+	 * of compilation procedures. If a word other than the first is
+	 * simple and represents an integer whose formatted representation
+	 * is the same as the word, just push an integer object. Also record
+	 * starting source and object information for the command if we are
+	 * at the top level (i.e. we were called directly from
+	 * SetByteCodeFromAny and are not compiling a substring enclosed in
+	 * square brackets).
+	 */
+
+	cmdSrcStart = src;
+	cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	cmdWords = 0;
+	if (!(flags & TCL_BRACKET_TERM)) {
+	    envPtr->numCommands++;
+	    cmdIndex = (envPtr->numCommands - 1);
+	    EnterCmdStartData(envPtr, cmdIndex,
+		    (cmdSrcStart - envPtr->source), cmdCodeOffset);
+	    
+	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+		/*
+		 * Display a line summarizing the top level command we
+		 * are about to compile.
+		 */
+		
+		char *p = cmdSrcStart;
+		int numChars;
+		char *ellipsis = "";
+
+		while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+			|| ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+		    p++;
+		}
+		numChars = (p - cmdSrcStart);
+		if (numChars > 60) {
+		    numChars = 60;
+		    ellipsis = " ...";
+		} else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+		    ellipsis = " ...";
+		}
+		fprintf(stdout, "Compiling: %.*s%s\n",
+			numChars, cmdSrcStart, ellipsis);
+	    }
+	}
+	
+	while ((type != TCL_COMMAND_END)
+	        || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
+	    /*
+	     * Skip any leading white space at the start of a word. Note
+	     * that a backslash-newline is treated as a space.
+	     */
+
+	    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
+		if (type == TCL_BACKSLASH) {
+		    if (src[1] == '\n') {
+			src += 2;
+		    } else {
+			break;	/* no longer white space */
+		    }
+		} else {
+		    src++;
+		}
+		c = *src;
+		type = CHAR_TYPE(src, lastChar);
+	    }
+	    if ((type == TCL_COMMAND_END) 
+	            && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
+		break;		/* no words remain for command. */
+	    }
+
+	    /*
+	     * Compile one word. We use an inline version of CompileWord to
+	     * avoid an extra procedure call.
+	     */
+
+	    envPtr->pushSimpleWords = 0;   /* we will handle simple words */
+	    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+		src++;		/* advance over the " or { */
+		if (type == TCL_QUOTE) {
+		    result = TclCompileQuotes(interp, src, lastChar,
+			    '"', flags, envPtr);
+		} else {
+		    result = CompileBraces(interp, src, lastChar,
+			    flags, envPtr);
+		}
+		termPtr = (src + envPtr->termOffset);
+		if (result != TCL_OK) {
+		    src = termPtr;
+		    goto done;
+		}
+
+		/*
+		 * Make sure terminating character of the quoted or braced
+		 * string is the end of word.
+		 */
+		
+		c = *termPtr;
+		if ((c == '\\') && (*(termPtr+1) == '\n')) {
+		    /*
+		     * Line is continued on next line; the backslash-
+		     * newline turns into space, which terminates the word.
+		     */
+		} else {
+		    type = CHAR_TYPE(termPtr, lastChar);
+		    if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
+			Tcl_ResetResult(interp);
+			if (*(src-1) == '"') {
+			    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+				    "extra characters after close-quote", -1);
+			} else {
+			    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+				    "extra characters after close-brace", -1);
+			}
+			result = TCL_ERROR;
+		    }
+		}
+	    } else {
+		result = CompileMultipartWord(interp, src, lastChar,
+			flags, envPtr);
+		termPtr = (src + envPtr->termOffset);
+	    }
+	    if (result != TCL_OK) {
+		ellipsis = "...";
+		src = termPtr;
+		goto done;
+	    }
+	    
+	    if (envPtr->wordIsSimple) {
+		/*
+		 * A simple word. Temporarily replace the terminating
+		 * character with a null character.
+		 */
+		
+		numChars = envPtr->numSimpleWordChars;
+		savedChar = src[numChars];
+		src[numChars] = '\0';
+
+		if ((cmdWords == 0)
+		        && (!(iPtr->flags & DONT_COMPILE_CMDS_INLINE))) {
+		    /*
+		     * The first word of a command and inline command
+		     * compilation has not been disabled (e.g., by command
+		     * traces). Look up the first word in the interpreter's
+		     * hashtable of commands. If a compilation procedure is
+		     * found, let it compile the command after resetting
+		     * error logging information.
+		     */
+
+		    cmdPtr = NULL;
+		    cmd = Tcl_FindCommand(interp, src,
+			    (Tcl_Namespace *) NULL, /*flags*/ 0);
+                    if (cmd != (Tcl_Command) NULL) {
+                        cmdPtr = (Command *) cmd;
+                    }
+		    if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)) {
+			char *firstArg = termPtr;
+			src[numChars] = savedChar; /* restore chr */
+			iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
+					 | ERROR_CODE_SET);
+			result = (*(cmdPtr->compileProc))(interp,
+				firstArg, lastChar, flags, envPtr);
+			if (result == TCL_OK) {
+			    src = (firstArg + envPtr->termOffset);
+			    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+			    goto finishCommand;  /* done with command */
+			} else if (result == TCL_OUT_LINE_COMPILE) {
+			    result = TCL_OK;     /* reset result */
+			    src[numChars] = '\0';
+			} else {
+			    src = firstArg;
+			    goto done;           /* an error */
+			}
+		    }
+
+		    /*
+		     * No compile procedure was found for the command: push
+		     * the word and continue to compile the remaining
+		     * words. If a hashtable entry was found for the
+		     * command, push a CmdName object instead to avoid
+		     * runtime lookups. If necessary, convert the pushed
+		     * object to be a CmdName object. If this is the first
+		     * CmdName object in this code unit that refers to the
+		     * command, increment the reference count in the
+		     * Command structure to reflect the new reference from
+		     * the CmdName object and, if the command is deleted
+		     * later, to keep the Command structure from being freed
+		     * until TclExecuteByteCode has a chance to recognize
+		     * that the command was deleted.
+		     */
+
+		    objIndex = TclObjIndexForString(src, numChars,
+			    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		    if (cmdPtr != NULL) {
+			objPtr = envPtr->objArrayPtr[objIndex];
+			if ((objPtr->typePtr != &tclCmdNameType)
+			        && (objPtr->bytes != NULL)) {
+			    ResolvedCmdName *resPtr = (ResolvedCmdName *)
+                                    ckalloc(sizeof(ResolvedCmdName));
+                            Namespace *nsPtr = (Namespace *) 
+				    Tcl_GetCurrentNamespace(interp);
+
+                            resPtr->cmdPtr = cmdPtr;
+                            resPtr->refNsPtr = nsPtr;
+			    resPtr->refNsId = nsPtr->nsId;
+                            resPtr->refNsCmdEpoch = nsPtr->cmdRefEpoch;
+                            resPtr->cmdEpoch = cmdPtr->cmdEpoch;
+                            resPtr->refCount = 1;
+                            objPtr->internalRep.otherValuePtr =
+                                (VOID *) resPtr;
+                            objPtr->typePtr = &tclCmdNameType;
+			    cmdPtr->refCount++;
+			}
+		    }
+		} else {
+		    /*
+		     * See if the word represents an integer whose formatted
+		     * representation is the same as the word (e.g., this is
+		     * true for 123 and -1 but not for 00005). If so, just
+		     * push an integer object.
+		     */
+
+		    int isCompilableInt = 0;
+		    long n;
+		    char buf[40];
+		    
+		    if (TclLooksLikeInt(src)) {
+			if (TclGetLong(interp, src, &n) == TCL_OK) {
+			    TclFormatInt(buf, n);
+			    if (strcmp(src, buf) == 0) {
+				isCompilableInt = 1;
+				objIndex = TclObjIndexForString(src,
+					numChars, /*allocStrRep*/ 0,
+					/*inHeap*/ 0, envPtr);
+				objPtr = envPtr->objArrayPtr[objIndex];
+
+				Tcl_InvalidateStringRep(objPtr);
+				objPtr->internalRep.longValue = n;
+				objPtr->typePtr = &tclIntType;
+			    }
+			}
+		    }
+		    if (!isCompilableInt) {
+			objIndex = TclObjIndexForString(src, numChars,
+			        /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		    }
+		}
+		src[numChars] = savedChar;  /* restore the saved char */
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = TclMax((cmdWords + 1), maxDepth);
+	    } else {		/* not a simple word */
+		maxDepth = TclMax((cmdWords + envPtr->maxStackDepth),
+			       maxDepth);
+	    }
+	    src = termPtr;
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	    cmdWords++;
+	}
+	
+	/*
+	 * Emit an invoke instruction for the command. If a compile command
+	 * was found for the command we called it and skipped this.
+	 */
+
+#ifdef TCL_COMPILE_DEBUG
+	if ((cmdWords < 0) || (cmdWords > 10000)) {
+	    fprintf(stderr, "\nTclCompileString: bad cmdWords value %d\n",
+		    cmdWords);
+	    panic("TclCompileString: bad cmdWords value %d");
+	}
+#endif /*TCL_COMPILE_DEBUG*/
+	if (cmdWords > 0) {
+	    if (cmdWords <= 255) {
+	        TclEmitInstUInt1(INST_INVOKE_STK1, cmdWords, envPtr);
+            } else {
+	        TclEmitInstUInt4(INST_INVOKE_STK4, cmdWords, envPtr);
+            }
+	}
+
+	/*
+	 * Update the compilation environment structure. Record
+	 * source/object information for the command if we are at the top
+	 * level (i.e. we we called directly from SetByteCodeFromAny and are
+	 * not compiling a substring enclosed in square brackets).
+	 */
+
+        finishCommand:
+	if (!(flags & TCL_BRACKET_TERM)) {
+	    int cmdSrcChars = (src - cmdSrcStart);
+	    cmdCodeBytes =
+		    (envPtr->codeNext - envPtr->codeStart - cmdCodeOffset);
+	    EnterCmdExtentData(envPtr, cmdIndex, cmdSrcChars, cmdCodeBytes);
+	}
+	isFirstCmd = 0;
+	envPtr->termOffset = (src - string);
+	c = *src;
+    }
+
+    done:
+    if (result == TCL_OK) {
+	/*
+	 * If the source string yielded no instructions (e.g., if it was
+	 * empty), push an empty string object as the command's result.
+	 */
+    
+	if (entryCodeNext == envPtr->codeNext) {
+	    int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
+                                                /*inHeap*/ 0, envPtr);
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;	/* we pushed 1 word for the empty string */
+	}
+    } else {
+	/*
+	 * Add additional error information. First compute the line number
+	 * where the error occurred.
+	 */
+
+	int numChars;
+	register char *p;
+	char buf[200];
+
+	iPtr->errorLine = 1;
+	for (p = string;  p != cmdSrcStart;  p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
+	    }
+	}
+	for (  ; isspace(UCHAR(*p)) || (*p == ';');  p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
+	    }
+	}
+
+	/*
+	 * Figure out how much of the command to print (up to a certain
+	 * number of characters, or up to the first newline).
+	 */
+
+	numChars = (src - cmdSrcStart);
+	if (numChars > 150) {
+	    numChars = 150;
+	    ellipsis = " ...";
+	}
+	sprintf(buf, "\n    while compiling\n\"%.*s%s\"",
+		numChars, cmdSrcStart, ellipsis);
+	Tcl_AddObjErrorInfo(interp, buf, -1);
+    } 
+	
+    envPtr->termOffset = (src - string);
+    iPtr->termOffset = envPtr->termOffset;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileWord --
+ *
+ *	This procedure compiles one word from a command string. It skips
+ *	any leading white space.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
+ *	procedure emits push and other instructions to compute the
+ *	word on the Tcl evaluation stack at execution time. If a caller sets
+ *	envPtr->pushSimpleWords to 0, CompileWord will _not_ compile
+ *	"simple" words: words that are just a sequence of characters without
+ *	backslashes. It will leave their compilation up to the caller.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs, an
+ *	error message is left in the interpreter's result.
+ *	
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed in the last
+ *	word. This is normally the character just after the last one in a
+ *	word (perhaps the command terminator), or the vicinity of an error
+ *	(if the result is not TCL_OK).
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslashes. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to compute and push the word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileWord(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* First character of word. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same values
+				 * passed to Tcl_EvalObj). */
+    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+{
+    /*
+     * Compile one word: approximately
+     *
+     * word:             quoted_string | braced_string | multipart_word
+     * quoted_string:    '"' char* '"'
+     * braced_string:    '{' char* '}'
+     * multipart_word    (see CompileMultipartWord below)
+     */
+    
+    register char *src = string; /* Points to current source char. */
+    register int type = CHAR_TYPE(src, lastChar);
+				 /* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		 /* Maximum number of stack elements needed
+				  * to compute and push the word. */
+    char *termPtr = src;	 /* Points to the character that terminated
+				  * the word. */
+    int result = TCL_OK;
+
+    /*
+     * Skip any leading white space at the start of a word. Note that a
+     * backslash-newline is treated as a space.
+     */
+
+    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
+	if (type == TCL_BACKSLASH) {
+	    if (src[1] == '\n') {
+		src += 2;
+	    } else {
+		break;		/* no longer white space */
+	    }
+	} else {
+	    src++;
+	}
+	type = CHAR_TYPE(src, lastChar);
+    }
+    if (type == TCL_COMMAND_END) {
+	goto done;
+    }
+
+    /*
+     * Compile the word. Handle quoted and braced string words here in order
+     * to avoid an extra procedure call.
+     */
+
+    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	src++;			/* advance over the " or { */
+	if (type == TCL_QUOTE) {
+	    result = TclCompileQuotes(interp, src, lastChar, '"', flags,
+		    envPtr);
+	} else {
+	    result = CompileBraces(interp, src, lastChar, flags, envPtr);
+	}
+	termPtr = (src + envPtr->termOffset);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	
+	/*
+	 * Make sure terminating character of the quoted or braced string is
+	 * the end of word.
+	 */
+	
+	if ((*termPtr == '\\') && (*(termPtr+1) == '\n')) {
+	    /*
+	     * Line is continued on next line; the backslash-newline turns
+	     * into space, which terminates the word.
+	     */
+	} else {
+	    type = CHAR_TYPE(termPtr, lastChar);
+	    if (!(type & (TCL_SPACE | TCL_COMMAND_END))) {
+		Tcl_ResetResult(interp);
+		if (*(src-1) == '"') {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "extra characters after close-quote", -1);
+		} else {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			    "extra characters after close-brace", -1);
+		}
+		result = TCL_ERROR;
+		goto done;
+	    }
+	}
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	result = CompileMultipartWord(interp, src, lastChar, flags, envPtr);
+	termPtr = (src + envPtr->termOffset);
+	maxDepth = envPtr->maxStackDepth;
+    }
+
+    /*
+     * Done processing the word. The values of envPtr->wordIsSimple and
+     * envPtr->numSimpleWordChars are left at the values returned by
+     * TclCompileQuotes/Braces/MultipartWord.
+     */
+    
+    done:
+    envPtr->termOffset = (termPtr - string);
+    envPtr->maxStackDepth = maxDepth;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileMultipartWord --
+ *
+ *	This procedure compiles one multipart word: a word comprised of some
+ *	number of nested commands, variable references, or arbitrary
+ *	characters. This procedure assumes that quoted string and braced
+ *	string words and the end of command have already been handled by its
+ *	caller. It also assumes that any leading white space has already
+ *	been consumed.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
+ *	procedure emits push and other instructions to compute the word on
+ *	the Tcl evaluation stack at execution time. If a caller sets
+ *	envPtr->pushSimpleWords to 0, it will _not_ compile "simple" words:
+ *	words that are just a sequence of characters without backslashes.
+ *	It will leave their compilation up to the caller. This is done, for
+ *	example, to provide special support for the first word of commands,
+ *	which are almost always the (simple) name of a command.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs, an
+ *	error message is left in the interpreter's result.
+ *	
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed in the last
+ *	word. This is normally the character just after the last one in a
+ *	word (perhaps the command terminator), or the vicinity of an error
+ *	(if the result is not TCL_OK).
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslashes. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to compute and push the word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileMultipartWord(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* First character of word. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same values
+				 * passed to Tcl_EvalObj). */
+    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+{
+    /*
+     * Compile one multi_part word:
+     *
+     * multi_part_word:  word_part+
+     * word_part:        nested_cmd | var_reference | char+
+     * nested_cmd:       '[' command ']'
+     * var_reference:    '$' name | '$' name '(' index_string ')' |
+     *                   '$' '{' braced_name '}')
+     * name:             (letter | digit | underscore)+
+     * braced_name:      (non_close_brace_char)*
+     * index_string:     (non_close_paren_char)*
+     */
+    
+    register char *src = string; /* Points to current source char. */
+    register char c = *src;	/* The current char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int bracketNormal = !(flags & TCL_BRACKET_TERM);
+    int simpleWord = 0;		/* Set 1 if word is simple. */
+    int numParts = 0;		/* Count of word_part objs pushed. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to compute and push the word. */
+    char *start;		/* Starting position of char+ word_part. */
+    int hasBackslash;		/* Nonzero if '\' in char+ word_part. */
+    int numChars;		/* Number of chars in char+ word_part. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null character
+				 * during word_part processing. */
+    int objIndex;		/* The object array index for a pushed
+				 * object holding a word_part. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int result = TCL_OK;
+    int numRead;
+
+    type = CHAR_TYPE(src, lastChar);
+    while (1) {
+	/*
+	 * Process a word_part: a sequence of chars, a var reference, or
+	 * a nested command.
+	 */
+
+	if ((type & (TCL_NORMAL | TCL_CLOSE_BRACE | TCL_BACKSLASH |
+		     TCL_QUOTE | TCL_OPEN_BRACE)) ||
+	    ((c == ']') && bracketNormal)) {
+	    /*
+	     * A char+ word part. Scan first looking for any backslashes.
+	     * Note that a backslash-newline must be treated as a word
+	     * separator, as if the backslash-newline had been collapsed
+	     * before command parsing began.
+	     */
+	    
+	    start = src;
+	    hasBackslash = 0;
+	    do {
+		if (type == TCL_BACKSLASH) {
+		    hasBackslash = 1;
+		    Tcl_Backslash(src, &numRead);
+		    if (src[1] == '\n') {
+			src += numRead;
+			type = TCL_SPACE; /* force word end */
+			break;	/* exit loop: \newline is word separator */
+		    }
+		    src += numRead;
+		} else {
+		    src++;
+		}
+		c = *src;
+		type = CHAR_TYPE(src, lastChar);
+	    } while (type & (TCL_NORMAL | TCL_BACKSLASH | TCL_QUOTE |
+			    TCL_OPEN_BRACE | TCL_CLOSE_BRACE)
+			    || ((c == ']') && bracketNormal));
+
+	    if ((numParts == 0) && !hasBackslash
+		    && (type & (TCL_SPACE | TCL_COMMAND_END))) {
+		/*
+		 * The word is "simple": just a sequence of characters
+		 * without backslashes terminated by a TCL_SPACE or
+		 * TCL_COMMAND_END. Just return if we are not to compile
+		 * simple words.
+		 */
+
+		simpleWord = 1;
+		if (!envPtr->pushSimpleWords) {
+		    envPtr->wordIsSimple = 1;
+		    envPtr->numSimpleWordChars = (src - string);
+		    envPtr->termOffset = envPtr->numSimpleWordChars;
+		    envPtr->pushSimpleWords = savePushSimpleWords;
+		    return TCL_OK;
+		}
+	    }
+
+	    /*
+	     * Create and push a string object for the char+ word_part,
+	     * which starts at "start" and ends at the char just before
+	     * src. If backslashes were found, copy the word_part's
+	     * characters with substituted backslashes into a heap-allocated
+	     * buffer and use it to create the string object. Temporarily
+	     * replace the terminating character with a null character.
+	     */
+
+	    numChars = (src - start);
+	    savedChar = start[numChars];
+	    start[numChars] = '\0';
+	    if ((numChars > 0) && (hasBackslash)) {
+		char *buffer = ckalloc((unsigned) numChars + 1);
+		register char *dst = buffer;
+		register char *p = start;
+		while (p < src) {
+		    if (*p == '\\') {	
+			*dst = Tcl_Backslash(p, &numRead);
+			if (p[1] == '\n') {
+			    break; /* end of word */
+			}
+			p += numRead;
+			dst++;
+		    } else {
+			*dst++ = *p++;
+		    }
+		}
+		*dst = '\0';
+		objIndex = TclObjIndexForString(buffer, dst-buffer,
+			/*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+	    } else {
+		objIndex = TclObjIndexForString(start, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    }
+	    start[numChars] = savedChar;   /* restore the saved char */
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = TclMax((numParts + 1), maxDepth);
+	} else if (type == TCL_DOLLAR) {
+	    result = TclCompileDollarVar(interp, src, lastChar,
+		    flags, envPtr);
+	    src += envPtr->termOffset;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	} else if (type == TCL_OPEN_BRACKET) {
+	    char *termPtr;
+	    envPtr->pushSimpleWords = 1;
+	    src++;
+	    result = TclCompileString(interp, src, lastChar,
+				      (flags | TCL_BRACKET_TERM), envPtr);
+	    termPtr = (src + envPtr->termOffset);
+	    if (*termPtr == ']') {
+		termPtr++;		/* advance over the ']'. */
+	    } else if (*termPtr == '\0') {
+		/*
+		 * Missing ] at end of nested command.
+		 */
+		
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket", -1);
+		result = TCL_ERROR;
+	    }
+	    src = termPtr;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+	    type = CHAR_TYPE(src, lastChar);
+	} else if (type & (TCL_SPACE | TCL_COMMAND_END)) {
+	    goto wordEnd;
+	}
+	numParts++;
+    } /* end of infinite loop */
+
+    wordEnd:
+    /*
+     * End of a non-simple word: TCL_SPACE, TCL_COMMAND_END, or
+     * backslash-newline. Concatenate the word_parts if necessary.
+     */
+
+    while (numParts > 255) {
+	TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
+	numParts -= 254;  /* concat pushes 1 obj, the result */
+    }
+    if (numParts > 1) {
+	TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
+    }
+
+    done:
+    if (simpleWord) {
+	envPtr->wordIsSimple = 1;
+	envPtr->numSimpleWordChars = (src - string);
+    } else {
+	envPtr->wordIsSimple = 0;
+	envPtr->numSimpleWordChars = 0;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileQuotes --
+ *
+ *	This procedure compiles a double-quoted string such as a quoted Tcl
+ *	command argument or a quoted value in a Tcl expression. This
+ *	procedure is also used to compile array element names within
+ *	parentheses (where the termChar will be ')' instead of '"'), or
+ *	anything else that needs the substitutions that happen in quotes.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and
+ *	TclCompileQuotes always emits push and other instructions to compute
+ *	the word on the Tcl evaluation stack at execution time. If a caller
+ *	sets envPtr->pushSimpleWords to 0, TclCompileQuotes will not compile
+ *	"simple" words: words that are just a sequence of characters without
+ *	backslashes. It will leave their compilation up to the caller. This
+ *	is done to provide special support for the first word of commands,
+ *	which are almost always the (simple) name of a command.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing the quoted string. If an error
+ *	occurs then the interpreter's result contains a standard error
+ *	message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed; this is
+ *	usually the character just after the matching close-quote.
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslashes. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to push the quoted-string
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
+    Tcl_Interp *interp;		 /* Interpreter to use for nested command
+				  * evaluations and error messages. */
+    char *string;		 /* Points to the character just after
+				  * the opening '"' or '('. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int termChar;		 /* Character that terminates the "quoted"
+				  * string (usually double-quote, but might
+				  * be right-paren or something else). */
+    int flags;			 /* Flags to control compilation (same 
+				  * values passed to Tcl_Eval). */
+    CompileEnv *envPtr;		 /* Holds the resulting instructions. */
+{
+    register char *src = string; /* Points to current source char. */
+    register char c = *src;	 /* The current char. */
+    int simpleWord = 0;		 /* Set 1 if a simple quoted string word. */
+    char *start;		 /* Start position of char+ string_part. */
+    int hasBackslash; 	         /* 1 if '\' found in char+ string_part. */
+    int numRead;		 /* Count of chars read by Tcl_Backslash. */
+    int numParts = 0;	         /* Count of string_part objs pushed. */
+    int maxDepth = 0;		 /* Maximum number of stack elements needed
+				  * to compute and push the string. */
+    char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null 
+				  * char during string_part processing. */
+    int objIndex;		 /* The object array index for a pushed
+				  * object holding a string_part. */
+    int numChars;		 /* Number of chars in string_part. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int result = TCL_OK;
+    
+    /*
+     * quoted_string: '"' string_part* '"'   (or termChar instead of ")
+     * string_part:   var_reference | nested_cmd | char+
+     */
+
+
+    while ((src != lastChar) && (c != termChar)) {
+	if (c == '$') {
+	    result = TclCompileDollarVar(interp, src, lastChar, flags,
+		    envPtr);
+	    src += envPtr->termOffset;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+        } else if (c == '[') {
+	    char *termPtr;
+	    envPtr->pushSimpleWords = 1;
+	    src++;
+	    result = TclCompileString(interp, src, lastChar,
+				      (flags | TCL_BRACKET_TERM), envPtr);
+	    termPtr = (src + envPtr->termOffset);
+	    if (*termPtr == ']') {
+		termPtr++;		/* advance over the ']'. */
+	    }
+	    src = termPtr;
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    if (termPtr == lastChar) {
+		/*
+		 * Missing ] at end of nested command.
+		 */
+		
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
+	    c = *src;
+        } else {
+	    /*
+	     * Start of a char+ string_part. Scan first looking for any
+	     * backslashes.
+	     */
+
+	    start = src;
+	    hasBackslash = 0;
+	    do {
+		if (c == '\\') {
+		    hasBackslash = 1;
+		    Tcl_Backslash(src, &numRead);
+		    src += numRead;
+		} else {
+		    src++;
+		}
+		c = *src;
+            } while ((src != lastChar) && (c != '$') && (c != '[')
+		    && (c != termChar));
+	    
+	    if ((numParts == 0) && !hasBackslash
+		    && ((src == lastChar) && (c == termChar))) {
+		/*
+		 * The quoted string is "simple": just a sequence of
+		 * characters without backslashes terminated by termChar or
+		 * a null character. Just return if we are not to compile
+		 * simple words.
+		 */
+
+		simpleWord = 1;
+		if (!envPtr->pushSimpleWords) {
+		    if ((src == lastChar) && (termChar != '\0')) {
+			char buf[40];
+			sprintf(buf, "missing %c", termChar);
+			Tcl_ResetResult(interp);
+			Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+			result = TCL_ERROR;
+		    } else {
+			src++;	/* advance over termChar */
+		    }
+		    envPtr->wordIsSimple = 1;
+		    envPtr->numSimpleWordChars = (src - string - 1);
+		    envPtr->termOffset = (src - string);
+		    envPtr->pushSimpleWords = savePushSimpleWords;
+		    return result;
+		}
+	    }
+
+	    /*
+	     * Create and push a string object for the char+ string_part
+	     * that starts at "start" and ends at the char just before
+	     * src. If backslashes were found, copy the string_part's
+	     * characters with substituted backslashes into a heap-allocated
+	     * buffer and use it to create the string object. Temporarily
+	     * replace the terminating character with a null character.
+	     */
+	    
+	    numChars = (src - start);
+	    savedChar = start[numChars];
+	    start[numChars] = '\0';
+	    if ((numChars > 0) && (hasBackslash)) {
+		char *buffer = ckalloc((unsigned) numChars + 1);
+		register char *dst = buffer;
+		register char *p = start;
+		while (p < src) {
+		    if (*p == '\\') {
+			*dst++ = Tcl_Backslash(p, &numRead);
+			p += numRead;
+		    } else {
+			*dst++ = *p++;
+		    }
+		}
+		*dst = '\0';
+		objIndex = TclObjIndexForString(buffer, (dst - buffer),
+			/*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+	    } else {
+		objIndex = TclObjIndexForString(start, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    }
+	    start[numChars] = savedChar;   /* restore the saved char */
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = TclMax((numParts + 1), maxDepth);
+        }
+	numParts++;
+    } 
+	    
+    /*
+     * End of the quoted string: src points at termChar or '\0'. If
+     * necessary, concatenate the string_part objects on the stack.
+     */
+
+    if ((src == lastChar) && (termChar != '\0')) {
+	char buf[40];
+	sprintf(buf, "missing %c", termChar);
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	result = TCL_ERROR;
+	goto done;
+    } else {
+	src++;			/* advance over termChar */
+    }
+
+    if (numParts == 0) {
+	/*
+	 * The quoted string was empty. Push an empty string object.
+	 */
+
+	int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
+                                            /*inHeap*/ 0, envPtr);
+	TclEmitPush(objIndex, envPtr);
+    } else {
+	/*
+	 * Emit any needed concat instructions.
+	 */
+	
+	while (numParts > 255) {
+	    TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
+	    numParts -= 254;  /* concat pushes 1 obj, the result */
+	}
+	if (numParts > 1) {
+	    TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
+	}
+    }
+
+    done:
+    if (simpleWord) {
+	envPtr->wordIsSimple = 1;
+	envPtr->numSimpleWordChars = (src - string - 1);
+    } else {
+	envPtr->wordIsSimple = 0;
+	envPtr->numSimpleWordChars = 0;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CompileBraces --
+ *
+ *	This procedure compiles characters between matching curly braces.
+ *
+ *	Ordinarily, callers set envPtr->pushSimpleWords to 1 and
+ *	CompileBraces always emits a push instruction to compute the word on
+ *	the Tcl evaluation stack at execution time. However, if a caller
+ *	sets envPtr->pushSimpleWords to 0, CompileBraces will _not_ compile
+ *	"simple" words: words that are just a sequence of characters without
+ *	backslash-newlines. It will leave their compilation up to the
+ *	caller.
+ *
+ *	As an important special case, if the word is simple, this procedure
+ *	sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
+ *	number of characters in the simple word. This allows the caller to
+ *	process these words specially.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed. This is
+ *	usually the character just after the matching close-brace.
+ *
+ *	envPtr->wordIsSimple is set 1 if the word is simple: just a
+ *	sequence of characters without backslash-newlines. If so, the word's
+ *	characters are the envPtr->numSimpleWordChars characters starting 
+ *	at string.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to evaluate the word. This is not changed if
+ *	the word is simple and envPtr->pushSimpleWords was 0 (false).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to push the braced string
+ *	at runtime.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CompileBraces(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		 /* Interpreter to use for nested command
+				  * evaluations and error messages. */
+    char *string;		 /* Character just after opening bracket. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			 /* Flags to control compilation (same 
+				  * values passed to Tcl_Eval). */
+    CompileEnv *envPtr;		 /* Holds the resulting instructions. */
+{
+    register char *src = string; /* Points to current source char. */
+    register char c;		 /* The current char. */
+    int simpleWord = 0;		 /* Set 1 if a simple braced string word. */
+    int level = 1;		 /* {} nesting level. Initially 1 since {
+				  * was parsed before we were called. */
+    int hasBackslashNewline = 0; /* Nonzero if '\' found. */
+    char *last;			 /* Points just before terminating '}'. */
+    int numChars;		 /* Number of chars in braced string. */
+    char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null 
+				  * char during braced string processing. */
+    int objIndex;		 /* The object array index for a pushed
+				  * object holding a braced string. */
+    int numRead;
+    int result = TCL_OK;
+
+    /*
+     * Check for any backslash-newlines, since we must treat
+     * backslash-newlines specially (they must be replaced by spaces).
+     */
+
+    while (1) {
+	c = *src;
+	if (src == lastChar) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "missing close-brace", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	if (CHAR_TYPE(src, lastChar) != TCL_NORMAL) {
+	    if (c == '{') {
+		level++;
+	    } else if (c == '}') {
+		--level;
+		if (level == 0) {
+		    src++;
+		    last = (src - 2); /* i.e. point just before
+				       * terminating } */
+		    break;
+		}
+	    } else if (c == '\\') {
+		if (*(src+1) == '\n') {
+		    hasBackslashNewline = 1;
+		}
+		(void) Tcl_Backslash(src, &numRead);
+		src += numRead - 1;
+	    }
+	}
+	src++;
+    }
+
+    if (!hasBackslashNewline) {
+	/*
+	 * The braced word is "simple": just a sequence of characters
+	 * without backslash-newlines. Just return if we are not to compile
+	 * simple words.
+	 */
+
+	simpleWord = 1;
+	if (!envPtr->pushSimpleWords) {
+	    envPtr->wordIsSimple = 1;
+	    envPtr->numSimpleWordChars = (src - string - 1);
+	    envPtr->termOffset = (src - string);
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Create and push a string object for the braced string. This starts at
+     * "string" and ends just after "last" (which points to the final
+     * character before the terminating '}'). If backslash-newlines were
+     * found, we copy characters one at a time into a heap-allocated buffer
+     * and do backslash-newline substitutions.
+     */
+
+    numChars = (last - string + 1);
+    savedChar = string[numChars];
+    string[numChars] = '\0';
+    if ((numChars > 0) && (hasBackslashNewline)) {
+	char *buffer = ckalloc((unsigned) numChars + 1);
+	register char *dst = buffer;
+	register char *p = string;
+	while (p <= last) {
+	    c = *dst++ = *p++;
+	    if (c == '\\') {
+		if (*p == '\n') {
+		    dst[-1] = Tcl_Backslash(p-1, &numRead);
+		    p += numRead - 1;
+		} else {
+		    (void) Tcl_Backslash(p-1, &numRead);
+		    while (numRead > 1) {
+			*dst++ = *p++;
+			numRead--;
+		    }
+		}
+	    }
+	}
+	*dst = '\0';
+	objIndex = TclObjIndexForString(buffer, (dst - buffer),
+		/*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
+    } else {
+	objIndex = TclObjIndexForString(string, numChars, /*allocStrRep*/ 1,
+                                        /*inHeap*/ 0, envPtr);
+    }
+    string[numChars] = savedChar;   /* restore the saved char */
+    TclEmitPush(objIndex, envPtr);
+
+    done:
+    if (simpleWord) {
+	envPtr->wordIsSimple = 1;
+	envPtr->numSimpleWordChars = (src - string - 1);
+    } else {
+	envPtr->wordIsSimple = 0;
+	envPtr->numSimpleWordChars = 0;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = 1;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileDollarVar --
+ *
+ *	Given a string starting with a $ sign, parse a variable name
+ *	and compile instructions to push its value. If the variable
+ *	reference is just a '$' (i.e. the '$' isn't followed by anything
+ *	that could possibly be a variable name), just push a string object
+ *	containing '$'.
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs
+ *	then an error message is left in the interpreter's result.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one in the variable reference.
+ *
+ *	envPtr->wordIsSimple is set 0 (false) because the word is not
+ *	simple: it is not just a sequence of characters without backslashes.
+ *	For the same reason, envPtr->numSimpleWordChars is set 0.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the string's commands.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to look up the variable and
+ *	push its value at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+    
+int
+TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		 /* Interpreter to use for nested command
+				  * evaluations and error messages. */
+    char *string;		 /* First char (i.e. $) of var reference. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			 /* Flags to control compilation (same
+				  * values passed to Tcl_Eval). */
+    CompileEnv *envPtr;		 /* Holds the resulting instructions. */
+{
+    register char *src = string; /* Points to current source char. */
+    register char c;		 /* The current char. */
+    char *name;			 /* Start of 1st part of variable name. */
+    int nameChars;		 /* Count of chars in name. */
+    int nameHasNsSeparators = 0; /* Set 1 if name contains "::"s. */
+    char savedChar;		 /* Holds the character from string
+				  * termporarily replaced by a null 
+				  * char during name processing. */
+    int objIndex;		 /* The object array index for a pushed
+				  * object holding a name part. */
+    int isArrayRef = 0;		 /* 1 if reference to array element. */
+    int localIndex = -1;	 /* Frame index of local if found.  */
+    int maxDepth = 0;		 /* Maximum number of stack elements needed
+				  * to push the variable. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int result = TCL_OK;
+
+    /*
+     * var_reference: '$' '{' braced_name '}' |
+     *                '$' name ['(' index_string ')']
+     *
+     * There are three cases:
+     * 1. The $ sign is followed by an open curly brace. Then the variable
+     *    name is everything up to the next close curly brace, and the
+     *    variable is a scalar variable.
+     * 2. The $ sign is not followed by an open curly brace. Then the
+     *    variable name is everything up to the next character that isn't
+     *    a letter, digit, underscore, or a "::" namespace separator. If the
+     *    following character is an open parenthesis, then the information
+     *    between parentheses is the array element name, which can include
+     *    any of the substitutions permissible between quotes.
+     * 3. The $ sign is followed by something that isn't a letter, digit,
+     *    underscore, or a "::" namespace separator: in this case,
+     *    there is no variable name, and "$" is pushed.
+     */
+
+    src++;			/* advance over the '$'. */
+
+    /*
+     * Collect the first part of the variable's name into "name" and
+     * determine if it is an array reference and if it contains any
+     * namespace separator (::'s).
+     */
+    
+    if (*src == '{') {
+        /*
+	 * A scalar name in braces.
+	 */
+
+	char *p;
+
+	src++;			/* advance over the '{'. */
+        name = src;
+        c = *src;
+	while (c != '}') {
+	    if (src == lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			"missing close-brace for variable name", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    src++;
+	    c = *src;
+	}
+	nameChars = (src - name);
+	for (p = name;  p < src;  p++) {
+	    if ((*p == ':') && (*(p+1) == ':')) {
+		nameHasNsSeparators = 1;
+		break;
+	    }
+	}
+	src++;			/* advance over the '}'. */
+    } else {
+	/*
+	 * Scalar name or array reference not in braces.
+	 */
+	
+        name = src;
+        c = *src;
+        while (isalnum(UCHAR(c)) || (c == '_') || (c == ':')) {
+	    if (c == ':') {
+                if (*(src+1) == ':') {
+		    nameHasNsSeparators = 1;
+                    src += 2;	 /* skip over the initial :: */
+		    while (*src == ':') {
+			src++;	 /* skip over a subsequent : */
+		    }
+                    c = *src;
+                } else {
+                    break;	/* : by itself */
+                }
+            } else {
+                src++;
+                c = *src;
+            }
+	}
+	if (src == name) {
+	    /*
+	     * A '$' by itself, not a name reference. Push a "$" string.
+	     */
+
+	    objIndex = TclObjIndexForString("$", 1, /*allocStrRep*/ 1,
+                                            /*inHeap*/ 0, envPtr);
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	    goto done;
+	}
+	nameChars = (src - name);
+	isArrayRef = (c == '(');
+    }
+
+    /*
+     * Now emit instructions to load the variable. First either push the
+     * name of the scalar or array, or determine its index in the array of
+     * local variables in a procedure frame. Push the name if we are not
+     * compiling a procedure body or if the name has namespace
+     * qualifiers ("::"s).
+     */
+    
+    if (!isArrayRef) {		/* scalar reference */
+	if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];  /* save char just after name */
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;  /* restore the saved char */
+	    TclEmitPush(objIndex, envPtr);
+	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstUInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
+		} else {
+		    TclEmitInstUInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
+		}
+		maxDepth = 0;
+	    } else {
+		savedChar = name[nameChars];  /* save char after name */
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;  /* restore the saved char */
+		TclEmitPush(objIndex, envPtr); 
+		TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+		maxDepth = 1;
+	    }
+	}
+    } else {			/* array reference */
+	if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];  /* save char after name */
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;  /* restore the saved char */
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if (localIndex < 0) {
+		savedChar = name[nameChars];  /* save char after name */
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;  /* restore the saved char */
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    }
+	}
+
+	/*
+	 * Parse and push the array element. Perform substitutions on it,
+	 * just as is done for quoted strings.
+	 */
+
+	src++;			   /* advance over the '(' */
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileQuotes(interp, src, lastChar, ')', flags,
+		envPtr);
+	src += envPtr->termOffset; /* advance beyond the terminating ) */
+	if (result != TCL_OK) {
+	    char msg[200];
+	    sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+		    (nameChars > 100? 100 : nameChars), name);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	    goto done;
+	}
+	maxDepth += envPtr->maxStackDepth;
+
+	/*
+	 * Now emit the appropriate load instruction for the array element.
+	 */
+
+	if (localIndex < 0) {	/* a global or an unknown local */
+	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+	} else {
+	    if (localIndex <= 255) {
+		TclEmitInstUInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
+	    } else {
+		TclEmitInstUInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
+	    }
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->wordIsSimple = 0;
+    envPtr->numSimpleWordChars = 0;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileBreakCmd --
+ *
+ *	Procedure called to compile the "break" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "break" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileBreakCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int result = TCL_OK;
+    
+    /*
+     * There should be no argument after the "break".
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "wrong # args: should be \"break\"", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+    }
+
+    /*
+     * Emit a break instruction.
+     */
+
+    TclEmitOpcode(INST_BREAK, envPtr);
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = 0;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileCatchCmd --
+ *
+ *	Procedure called to compile the "catch" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK if
+ *	compilation was successful. If an error occurs then the
+ *	interpreter's result contains a standard error message and TCL_ERROR
+ *	is returned. If compilation failed because the command is too
+ *	complex for TclCompileCatchCmd, TCL_OUT_LINE_COMPILE is returned
+ *	indicating that the catch command should be compiled "out of line"
+ *	by emitting code to invoke its command procedure at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "catch" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    				/* Points to structure describing procedure
+				 * containing the catch cmd, else NULL. */
+    int maxDepth = 0;           /* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int range = -1;		/* If we compile the catch command, the
+				 * index for its catch range record in the
+				 * ExceptionRange array. -1 if we are not
+				 * compiling the command. */
+    char *name;			/* If a var name appears for a scalar local
+				 * to a procedure, this points to the name's
+				 * 1st char and nameChars is its length. */
+    int nameChars;		/* Length of the variable name, if any. */
+    int localIndex = -1;        /* Index of the variable in the current
+				 * procedure's array of local variables.
+				 * Otherwise -1 if not in a procedure or
+				 * the variable wasn't found. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null character
+				 * during processing of words. */
+    JumpFixup jumpFixup;	/* Used to emit the jump after the "no
+				 * errors" epilogue code. */
+    int numWords, objIndex, jumpDist, result;
+    char *bodyStart, *bodyEnd;
+    Tcl_Obj *objPtr;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if ((numWords != 1) && (numWords != 2)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"catch command ?varName?\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If a variable was specified and the catch command is at global level
+     * (not in a procedure), don't compile it inline: the payoff is
+     * too small.
+     */
+
+    if ((numWords == 2) && (procPtr == NULL)) {
+	result = TCL_OUT_LINE_COMPILE;
+        goto done;
+    }
+
+    /*
+     * Make sure the variable name, if any, has no substitutions and just
+     * refers to a local scaler.
+     */
+
+    if (numWords == 2) {
+	char *firstChar = argInfo.startArray[1];
+	char *lastChar  = argInfo.endArray[1];
+	
+	if (*firstChar == '{') {
+	    if (*lastChar != '}') {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "extra characters after close-brace", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    firstChar++;
+	    lastChar--;
+	}
+
+	nameChars = (lastChar - firstChar + 1);
+	if (nameChars > 0) {
+	    char *p = firstChar;
+	    while (p != lastChar) {
+		if (CHAR_TYPE(p, lastChar) != TCL_NORMAL) {
+		    result = TCL_OUT_LINE_COMPILE;
+		    goto done;
+		}
+		if (*p == '(') {
+		    if (*lastChar == ')') { /* we have an array element */
+			result = TCL_OUT_LINE_COMPILE;
+			goto done;   /* only scalar loop vars for now */
+		    }
+		}
+		p++;
+	    }
+	}
+
+	name = firstChar;
+	localIndex = LookupCompiledLocal(name, nameChars,
+                    /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR,
+		    procPtr);
+    }
+
+    /*
+     *==== At this point we believe we can compile the catch command ====
+     */
+
+    /*
+     * Create and initialize a ExceptionRange record to hold information
+     * about this catch command.
+     */
+    
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+    range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
+
+    /*
+     * Emit the instruction to mark the start of the catch command.
+     */
+    
+    TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
+    
+    /*
+     * Inline compile the catch's body word: the command it controls. Also
+     * register the body's starting PC offset and byte length in the
+     * ExceptionRange record.
+     */
+
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+
+    bodyStart = argInfo.startArray[0];
+    bodyEnd   = argInfo.endArray[0];
+    savedChar = *(bodyEnd+1);      /* save char after body */
+    *(bodyEnd+1) = '\0';
+    result = CompileCmdWordInline(interp, bodyStart, (bodyEnd+1),
+	    flags, envPtr);
+    *(bodyEnd+1) = savedChar;      /* restore the saved char */
+    
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"catch\" body line %d)",
+		    interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range].numCodeBytes =
+	TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+    /*
+     * Now emit the "no errors" epilogue code for the catch. First, if a
+     * variable was specified, store the body's result into the
+     * variable; otherwise, just discard the body's result. Then push
+     * a "0" object as the catch command's "no error" TCL_OK result,
+     * and jump around the "error case" epilogue code.
+     */
+
+    if (localIndex != -1) {
+	if (localIndex <= 255) {
+	    TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+	} else {
+	    TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	}
+    }
+    TclEmitOpcode(INST_POP, envPtr); /* pop the result */
+
+    objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0, /*inHeap*/ 0,
+	    envPtr);
+    objPtr = envPtr->objArrayPtr[objIndex];
+    
+    Tcl_InvalidateStringRep(objPtr);
+    objPtr->internalRep.longValue = 0;
+    objPtr->typePtr = &tclIntType;
+    
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;	/* since we just pushed one object */
+    }
+    
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+    /*
+     * Now emit the "error case" epilogue code. First, if a variable was
+     * specified, emit instructions to push the interpreter's object result
+     * and store it into the variable. Then emit an instruction to push the
+     * nonzero error result. Note that the initial PC offset here is the
+     * catch's error target.
+     */
+
+#ifdef TCL_COMPILE_DEBUG
+    if (envPtr->excRangeArrayPtr[range].type != CATCH_EXCEPTION_RANGE) {
+	panic("TclCompileCatchCmd: bad body ExceptionRange type %d\n",
+	      envPtr->excRangeArrayPtr[range].type);
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+
+    if (localIndex != -1) {
+	TclEmitOpcode(INST_PUSH_RESULT, envPtr);
+	if (localIndex <= 255) {
+	    TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+	} else {
+	    TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	}
+	TclEmitOpcode(INST_POP, envPtr); /* pop the result */
+    }
+    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+
+    /*
+     * Now that we know the target of the jump after the "no errors"
+     * epilogue, update it with the correct distance. This is less
+     * than 127 bytes.
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+	panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
+    }
+
+    /*
+     * Emit the instruction to mark the end of the catch command.
+     */
+
+    TclEmitOpcode(INST_END_CATCH, envPtr);
+
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    if (range != -1) {		/* we compiled the catch command */
+	envPtr->excRangeDepth--;
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileContinueCmd --
+ *
+ *	Procedure called to compile the "continue" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "continue" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileContinueCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int result = TCL_OK;
+    
+    /*
+     * There should be no argument after the "continue".
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "wrong # args: should be \"continue\"", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+    }
+
+    /*
+     * Emit a continue instruction.
+     */
+
+    TclEmitOpcode(INST_CONTINUE, envPtr);
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = 0;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExprCmd --
+ *
+ *	Procedure called to compile the "expr" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK
+ *	unless there was an error while parsing string. If an error occurs
+ *	then the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "expr" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "expr" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    Tcl_DString buffer;		/* Holds the concatenated expr command
+				 * argument words. */
+    int firstWord;		/* 1 if processing the first word; 0 if
+				 * processing subsequent words. */
+    char *first, *last;		/* Points to the first and last significant
+				 * chars of the concatenated expression. */
+    int inlineCode;		/* 1 if inline "optimistic" code is
+				 * emitted for the expression; else 0. */
+    int range = -1;		/* If we inline compile the concatenated
+				 * expression, the index for its catch range
+				 * record in the ExceptionRange array.
+				 * Initialized to avoid compile warning. */
+    JumpFixup jumpFixup;	/* Used to emit the "success" jump after
+				 * the inline concat. expression's code. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during compilation
+				 * of the concatenated expression. */
+    int numWords, objIndex, i, result;
+    char *wordStart, *wordEnd, *p;
+    char c;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (numWords == 0) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"expr arg ?arg ...?\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If there is a single argument word and it is enclosed in {}s, we may
+     * strip them off and safely compile the expr command into an inline
+     * sequence of instructions using TclCompileExpr. We know these
+     * instructions will have the right Tcl7.x expression semantics.
+     *
+     * Otherwise, if the word is not enclosed in {}s, or there are multiple
+     * words, we may need to call the expr command (Tcl_ExprObjCmd) at
+     * runtime. This recompiles the expression each time (typically) and so
+     * is slow. However, there are some circumstances where we can still
+     * compile inline instructions "optimistically" and check, during their
+     * execution, for double substitutions (these appear as nonnumeric
+     * operands). We check for any backslash or command substitutions. If
+     * none appear, and only variable substitutions are found, we generate
+     * inline instructions. If there is a compilation error, we must emit
+     * instructions that return the error at runtime, since this is when
+     * scripts in Tcl7.x would "see" the error.
+     *
+     * For now, if there are multiple words, or the single argument word is
+     * not in {}s, we concatenate the argument words and strip off any
+     * enclosing {}s or ""s. We call the expr command at runtime if
+     * either command or backslash substitutions appear (but not if
+     * only variable substitutions appear).
+     */
+
+    if (numWords == 1) {
+	wordStart = argInfo.startArray[0]; /* start of 1st arg word */
+	wordEnd   = argInfo.endArray[0];   /* last char of 1st arg word */
+	if ((*wordStart == '{') && (*wordEnd == '}')) {
+	    /*
+	     * Simple case: a single argument word in {}'s. 
+	     */
+
+	    *wordEnd = '\0';	/* temporarily replace the '}' by a null */
+	    result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
+		    flags, envPtr);
+	    *wordEnd = '}';	/* restore the '}' */
+	    
+	    envPtr->termOffset = (wordEnd + 1) - string;
+	    envPtr->pushSimpleWords = savePushSimpleWords;
+	    FreeArgInfo(&argInfo);
+	    return result;
+	}
+    }
+	
+    /*
+     * There are multiple words or no braces around the single word.
+     * Concatenate the expression's argument words while stripping off
+     * any enclosing {}s or ""s.
+     */
+    
+    Tcl_DStringInit(&buffer);
+    firstWord = 1;
+    for (i = 0;  i < numWords;  i++) {
+	wordStart = argInfo.startArray[i];
+	wordEnd   = argInfo.endArray[i];
+	if (((*wordStart == '{') && (*wordEnd == '}'))
+	        || ((*wordStart == '"') && (*wordEnd == '"'))) {
+	    wordStart++;
+	    wordEnd--;
+	}
+	if (!firstWord) {
+	    Tcl_DStringAppend(&buffer, " ", 1);
+	}
+	firstWord = 0;
+	if (wordEnd >= wordStart) {
+	    Tcl_DStringAppend(&buffer, wordStart, (wordEnd-wordStart+1));
+	}
+    }
+
+    /*
+     * Scan the concatenated expression's characters looking for any
+     * '['s or (for now) '\'s. If any are found, just call the expr cmd
+     * at runtime.
+     */
+    
+    inlineCode = 1;
+    first = Tcl_DStringValue(&buffer);
+    last = first + (Tcl_DStringLength(&buffer) - 1);
+    for (p = first;  p <= last;  p++) {
+	c = *p;
+	if ((c == '[') || (c == '\\')) {
+	    inlineCode = 0;
+	    break;
+	}
+    }
+
+    if (inlineCode) {
+	/*
+	 * Inline compile the concatenated expression inside a "catch"
+	 * so that a runtime error will back off to a (slow) call on expr.
+	 */
+	
+	int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	int startRangeNext = envPtr->excRangeArrayNext;
+	
+	/*
+	 * Create a ExceptionRange record to hold information about the
+	 * "catch" range for the expression's inline code. Also emit the
+	 * instruction to mark the start of the range.
+	 */
+	
+	envPtr->excRangeDepth++;
+	envPtr->maxExcRangeDepth =
+	    TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+	range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
+	TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
+	
+	/*
+	 * Inline compile the concatenated expression.
+	 */
+	
+	envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+	savedChar = *(last + 1);
+	*(last + 1) = '\0';      /* replace term. char with null */
+	result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
+	*(last + 1) = savedChar; /* restore the saved char */
+	
+	maxDepth = envPtr->maxStackDepth;
+	envPtr->excRangeArrayPtr[range].numCodeBytes =
+	    TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+	
+	if ((envPtr->exprIsJustVarRef) || (result != TCL_OK)) {
+	    /*
+	     * We must call the expr command at runtime since the expression
+	     * consisted of just a single variable reference (and a second
+	     * round of substitutions might be needed) or there was a
+	     * compilation error. Delete the inline code by backing up the
+	     * code pc and catch index. Note that if there was a compilation
+	     * error, we can't report the error yet since the expression
+	     * might be valid after the second round of substitutions.
+	     */
+	    
+	    envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
+	    envPtr->excRangeArrayNext = startRangeNext;
+	    inlineCode = 0;
+	} else {
+	    TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+	    envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+	    TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
+	}
+    }
+	    
+    /*
+     * Emit code for the (slow) call on the expr command at runtime.
+     * Generate code to concatenate the (already substituted once)
+     * expression words with a space between each word.
+     */
+    
+    for (i = 0;  i < numWords;  i++) {
+	wordStart = argInfo.startArray[i];
+	wordEnd   = argInfo.endArray[i];
+	savedChar = *(wordEnd + 1);
+	*(wordEnd + 1) = '\0';      /* replace term. char with null */
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, wordStart, wordEnd+1, flags, envPtr);
+	*(wordEnd + 1) = savedChar; /* restore the saved char */
+	if (result != TCL_OK) {
+	    break;
+	}
+	if (i != (numWords - 1)) {
+	    objIndex = TclObjIndexForString(" ", 1, /*allocStrRep*/ 1,
+					    /*inHeap*/ 0, envPtr);
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+	} else {
+	    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	}
+    }
+    if (result == TCL_OK) {
+	int concatItems = 2*numWords - 1;
+	while (concatItems > 255) {
+	    TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
+	    concatItems -= 254;  /* concat pushes 1 obj, the result */
+	}
+	if (concatItems > 1) {
+	    TclEmitInstUInt1(INST_CONCAT1, concatItems, envPtr);
+	}
+	TclEmitOpcode(INST_EXPR_STK, envPtr);
+    }
+    
+    /*
+     * If emitting inline code, update the target of the jump after
+     * that inline code.
+     */
+    
+    if (inlineCode) {
+	int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+	    /*
+	     * Update the inline expression code's catch ExceptionRange
+	     * target since it, being after the jump, also moved down.
+	     */
+	    
+#ifdef TCL_COMPILE_DEBUG
+	    if (envPtr->excRangeArrayPtr[range].type != CATCH_EXCEPTION_RANGE) {
+		panic("TclCompileExprCmd: bad body ExceptionRange type %d\n",
+		      envPtr->excRangeArrayPtr[range].type);
+	    }
+#endif /* TCL_COMPILE_DEBUG */
+	    
+	    envPtr->excRangeArrayPtr[range].catchOffset += 3;
+	}
+    }
+    Tcl_DStringFree(&buffer);
+    
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    if (range != -1) {		/* we inline compiled the expr */
+	envPtr->excRangeDepth--;
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+    envPtr->maxStackDepth = maxDepth;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileForCmd --
+ *
+ *	Procedure called to compile the "for" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "for" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileForCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int range1, range2;		/* Indexes in the ExceptionRange array of
+				 * the loop ranges for this loop: one for
+				 * its body and one for its "next" cmd. */
+    JumpFixup jumpFalseFixup;	/* Used to update or replace the ifFalse
+				 * jump after the "for" test when its target
+				 * PC is determined. */
+    int jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist, objIndex;
+    unsigned char *jumpPc;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int numWords, result;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if (numWords != 4) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"for start test next command\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the test expression is enclosed in quotes (""s), don't compile
+     * the for inline. As a result of Tcl's two level substitution
+     * semantics for expressions, the expression might have a constant
+     * value that results in the loop never executing, or executing forever.
+     * Consider "set x 0; for {} "$x > 5" {incr x} {}": the loop body 
+     * should never be executed.
+     */
+
+    if (*(argInfo.startArray[1]) == '"') {
+	result = TCL_OUT_LINE_COMPILE;
+        goto done;
+    }
+
+    /*
+     * Create a ExceptionRange record for the for loop's body. This is used
+     * to implement break and continue commands inside the body.
+     * Then create a second ExceptionRange record for the "next" command in 
+     * order to implement break (but not continue) inside it. The second,
+     * "next" ExceptionRange will always have a -1 continueOffset.
+     */
+
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+    range1 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+    range2 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+
+    /*
+     * Compile inline the next word: the initial command.
+     */
+
+    result = CompileCmdWordInline(interp, argInfo.startArray[0],
+	    (argInfo.endArray[0] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+            Tcl_AddObjErrorInfo(interp, "\n    (\"for\" initial command)", -1);
+        }
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+
+    /*
+     * Discard the start command's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+
+    /*
+     * Compile the next word: the test expression.
+     */
+
+    testCodeOffset = TclCurrCodeOffset();
+    envPtr->pushSimpleWords = 1;    /* process words normally */
+    result = CompileExprWord(interp, argInfo.startArray[1],
+	    (argInfo.endArray[1] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+            Tcl_AddObjErrorInfo(interp, "\n    (\"for\" test expression)", -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+    /*
+     * Emit the jump that terminates the for command if the test was
+     * false. We emit a one byte (relative) jump here, and replace it later
+     * with a four byte jump if the jump target is > 127 bytes away.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+
+    /*
+     * Compile the loop body word inline. Also register the loop body's
+     * starting PC offset and byte length in the its ExceptionRange record.
+     */
+
+    envPtr->excRangeArrayPtr[range1].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, argInfo.startArray[3],
+	    (argInfo.endArray[3] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"for\" body line %d)", interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range1].numCodeBytes =
+	(TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range1].codeOffset);
+
+    /*
+     * Discard the loop body's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+
+    /*
+     * Finally, compile the "next" subcommand word inline.
+     */
+
+    envPtr->excRangeArrayPtr[range1].continueOffset = TclCurrCodeOffset();
+    envPtr->excRangeArrayPtr[range2].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, argInfo.startArray[2],
+	    (argInfo.endArray[2] + 1), flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    Tcl_AddObjErrorInfo(interp, "\n    (\"for\" loop-end command)", -1);
+	}
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range2].numCodeBytes =
+	TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range2].codeOffset;
+
+    /*
+     * Discard the "next" subcommand's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+	
+    /*
+     * Emit the unconditional jump back to the test at the top of the for
+     * loop. We generate a four byte jump if the distance to the test is
+     * greater than 120 bytes. This is conservative, and ensures that we
+     * won't have to replace this unconditional jump if we later need to
+     * replace the ifFalse jump with a four-byte jump.
+     */
+
+    jumpBackOffset = TclCurrCodeOffset();
+    jumpBackDist = (jumpBackOffset - testCodeOffset);
+#ifdef TCL_COMPILE_DEBUG
+    if (jumpBackDist > MAX_JUMP_DIST) {
+	fprintf(stderr, "\nTclCompileForCmd: bad distance %u for unconditional jump\n",
+		jumpBackDist);
+	panic("TclCompileForCmd: bad distance for unconditional jump");
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    if (jumpBackDist > 120) {
+	TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the jumpFalse after the test, update
+     * it with the correct distance. If the distance is too great (more
+     * than 127 bytes), replace that jump with a four byte instruction and
+     * move the instructions after the jump down.
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+	/*
+	 * Update the loop body's ExceptionRange record since it moved down:
+	 * i.e., increment both its start and continue PC offsets. Also,
+	 * update the "next" command's start PC offset in its ExceptionRange
+	 * record since it also moved down.
+	 */
+
+#ifdef TCL_COMPILE_DEBUG
+	if (envPtr->excRangeArrayPtr[range1].type != LOOP_EXCEPTION_RANGE) {
+	    panic("TclCompileForCmd: bad body ExceptionRange type %d\n",
+		  envPtr->excRangeArrayPtr[range1].type);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+	envPtr->excRangeArrayPtr[range1].codeOffset += 3;
+	envPtr->excRangeArrayPtr[range1].continueOffset += 3;
+	envPtr->excRangeArrayPtr[range2].codeOffset += 3;
+
+	/*
+	 * Update the distance for the unconditional jump back to the test
+	 * at the top of the loop since it moved down 3 bytes too.
+	 */
+
+	jumpBackOffset += 3;
+	jumpPc = (envPtr->codeStart + jumpBackOffset);
+	if (jumpBackDist > 120) {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	} else {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	}
+    }
+    
+    /*
+     * The current PC offset (after the loop's body and "next" subcommand)
+     * is the loop's break target.
+     */
+
+#ifdef TCL_COMPILE_DEBUG
+    if (envPtr->excRangeArrayPtr[range1].type != LOOP_EXCEPTION_RANGE) {
+	panic("TclCompileForCmd: bad body ExceptionRange type %d\n",
+	      envPtr->excRangeArrayPtr[range1].type);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+    envPtr->excRangeArrayPtr[range1].breakOffset =
+	envPtr->excRangeArrayPtr[range2].breakOffset = TclCurrCodeOffset();
+    
+    /*
+     * Push an empty string object as the for command's result.
+     */
+
+    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
+				    envPtr);
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;		/* since we just pushed one object */
+    }
+
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->excRangeDepth--;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileForeachCmd --
+ *
+ *	Procedure called to compile the "foreach" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK if
+ *	compilation was successful. If an error occurs then the
+ *	interpreter's result contains a standard error message and TCL_ERROR
+ *	is returned. If complation failed because the command is too complex
+ *	for TclCompileForeachCmd, TCL_OUT_LINE_COMPILE is returned
+ *	indicating that the foreach command should be compiled "out of line"
+ *	by emitting code to invoke its command procedure at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "while" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "foreach" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    				/* Points to structure describing procedure
+				 * containing foreach command, else NULL. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int numLists = 0;		/* Count of variable (and value) lists. */
+    int range;			/* Index in the ExceptionRange array of the
+				 * ExceptionRange record for this loop. */
+    ForeachInfo *infoPtr;	/* Points to the structure describing this
+				 * foreach command. Stored in a AuxData
+				 * record in the ByteCode. */
+    JumpFixup jumpFalseFixup;	/* Used to update or replace the ifFalse
+				 * jump after test when its target PC is
+				 * determined. */
+    char savedChar;		/* Holds the char from string termporarily
+				 * replaced by a null character during
+				 * processing of argument words. */
+    int firstListTmp = -1;	/* If we decide to compile this foreach
+				 * command, this is the index or "slot
+				 * number" for the first temp var allocated
+				 * in the proc frame that holds a pointer to
+				 * a value list. Initialized to avoid a
+				 * compiler warning. */
+    int loopIterNumTmp;		/* If we decide to compile this foreach
+				 * command, the index for the temp var that
+				 * holds the current iteration count.  */
+    char *varListStart, *varListEnd, *valueListStart, *bodyStart, *bodyEnd;
+    unsigned char *jumpPc;
+    int jumpDist, jumpBackDist, jumpBackOffset;
+    int numWords, numVars, infoIndex, tmpIndex, objIndex, i, j, result;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * We parse the variable list argument words and create two arrays:
+     *    varcList[i] gives the number of variables in the i-th var list
+     *    varvList[i] points to an array of the names in the i-th var list
+     * These are initially allocated on the stack, and are allocated on
+     * the heap if necessary.
+     */
+
+#define STATIC_VAR_LIST_SIZE 4
+    int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
+    char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
+
+    int *varcList = varcListStaticSpace;
+    char ***varvList = varvListStaticSpace;
+
+    /*
+     * If the foreach command is at global level (not in a procedure),
+     * don't compile it inline: the payoff is too small.
+     */
+
+    if (procPtr == NULL) {
+	return TCL_OUT_LINE_COMPILE;
+    }
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if ((numWords < 3) || (numWords%2 != 1)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Initialize the varcList and varvList arrays; allocate heap storage,
+     * if necessary, for them. Also make sure the variable names
+     * have no substitutions: that they're just "var" or "var(elem)"
+     */
+
+    numLists = (numWords - 1)/2;
+    if (numLists > STATIC_VAR_LIST_SIZE) {
+        varcList = (int *) ckalloc(numLists * sizeof(int));
+        varvList = (char ***) ckalloc(numLists * sizeof(char **));
+    }
+    for (i = 0;  i < numLists;  i++) {
+        varcList[i] = 0;
+        varvList[i] = (char **) NULL;
+    }
+    for (i = 0;  i < numLists;  i++) {
+	/*
+	 * Break each variable list into its component variables. If the
+	 * lists is enclosed in {}s or ""s, strip them off first.
+	 */
+
+	varListStart = argInfo.startArray[i*2];
+	varListEnd   = argInfo.endArray[i*2];
+	if ((*varListStart == '{') || (*varListStart == '"')) {
+	    if ((*varListEnd != '}') && (*varListEnd != '"')) {
+		Tcl_ResetResult(interp);
+		if (*varListStart == '"') {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			    "extra characters after close-quote", -1);
+		} else {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "extra characters after close-brace", -1);
+		}
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    varListStart++;
+	    varListEnd--;
+	}
+	    
+	/*
+	 * NOTE: THIS NEEDS TO BE CONVERTED TO AN OBJECT LIST.
+	 */
+
+	savedChar = *(varListEnd+1);  /* save char after var list */
+	*(varListEnd+1) = '\0';
+	result = Tcl_SplitList(interp, varListStart,
+			       &varcList[i], &varvList[i]);
+	*(varListEnd+1) = savedChar;  /* restore the saved char */
+        if (result != TCL_OK) {
+            goto done;
+        }
+
+	/*
+	 * Check that each variable name has no substitutions and that
+	 * it is a scalar name.
+	 */
+
+	numVars = varcList[i];
+	for (j = 0;  j < numVars;  j++) {
+	    char *varName = varvList[i][j];
+	    char *p = varName;
+	    while (*p != '\0') {
+		if (CHAR_TYPE(p, p+1) != TCL_NORMAL) {
+		    result = TCL_OUT_LINE_COMPILE;
+		    goto done;
+		}
+		if (*p == '(') {
+		    char *q = p;
+		    do {
+			q++;
+		    } while (*q != '\0');
+		    q--;
+		    if (*q == ')') { /* we have an array element */
+			result = TCL_OUT_LINE_COMPILE;
+			goto done;   /* only scalar loop vars for now */
+		    }
+		}
+		p++;
+	    }
+	}
+    }
+
+    /*
+     *==== At this point we believe we can compile the foreach command ====
+     */
+
+    /*
+     * Create and initialize a ExceptionRange record to hold information
+     * about this loop. This is used to implement break and continue.
+     */
+    
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+    range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+    
+    /*
+     * Reserve (numLists + 1) temporary variables:
+     *    - numLists temps for each value list
+     *    - a temp for the "next value" index into each value list
+     * At this time we don't try to reuse temporaries; if there are two
+     * nonoverlapping foreach loops, they don't share any temps.
+     */
+
+    for (i = 0;  i < numLists;  i++) {
+	tmpIndex = LookupCompiledLocal(NULL, /*nameChars*/ 0,
+		/*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
+	if (i == 0) {
+	    firstListTmp = tmpIndex;
+	}
+    }
+    loopIterNumTmp = LookupCompiledLocal(NULL, /*nameChars*/ 0,
+	    /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
+    
+    /*
+     * Create and initialize the ForeachInfo and ForeachVarList data
+     * structures describing this command. Then create a AuxData record
+     * pointing to the ForeachInfo structure in the compilation environment.
+     */
+
+    infoPtr = (ForeachInfo *) ckalloc((unsigned)
+	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+    infoPtr->numLists = numLists;
+    infoPtr->firstListTmp = firstListTmp;
+    infoPtr->loopIterNumTmp = loopIterNumTmp;
+    for (i = 0;  i < numLists;  i++) {
+	ForeachVarList *varListPtr;
+	numVars = varcList[i];
+	varListPtr = (ForeachVarList *) ckalloc((unsigned)
+	        sizeof(ForeachVarList) + numVars*sizeof(int));
+	varListPtr->numVars = numVars;
+	for (j = 0;  j < numVars;  j++) {
+	    char *varName = varvList[i][j];
+	    int nameChars = strlen(varName);
+	    varListPtr->varIndexes[j] = LookupCompiledLocal(varName,
+		    nameChars, /*createIfNew*/ 1,
+                    /*flagsIfCreated*/ VAR_SCALAR, procPtr);
+	}
+	infoPtr->varLists[i] = varListPtr;
+    }
+    infoIndex = TclCreateAuxData((ClientData) infoPtr,
+            DupForeachInfo, FreeForeachInfo, envPtr);
+
+    /*
+     * Emit code to store each value list into the associated temporary.
+     */
+
+    for (i = 0;  i < numLists;  i++) {
+	valueListStart = argInfo.startArray[2*i + 1];
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, valueListStart, lastChar, flags,
+		envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+	tmpIndex = (firstListTmp + i);
+	if (tmpIndex <= 255) {
+	    TclEmitInstUInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
+	} else {
+	    TclEmitInstUInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
+	}
+	TclEmitOpcode(INST_POP, envPtr); /* no longer need list on the stk */
+    }
+
+    /*
+     * Emit the instruction to initialize the foreach loop's index temp var.
+     */
+
+    TclEmitInstUInt4(INST_FOREACH_START4, infoIndex, envPtr);
+    
+    /*
+     * Emit the top of loop code that assigns each loop variable and checks
+     * whether to terminate the loop.
+     */
+
+    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
+    TclEmitInstUInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+
+    /*
+     * Emit the ifFalse jump that terminates the foreach if all value lists
+     * are exhausted. We emit a one byte (relative) jump here, and replace
+     * it later with a four byte jump if the jump target is more than
+     * 127 bytes away.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+    
+    /*
+     * Compile the loop body word inline. Also register the loop body's
+     * starting PC offset and byte length in the ExceptionRange record.
+     */
+
+    bodyStart = argInfo.startArray[numWords - 1];
+    bodyEnd   = argInfo.endArray[numWords - 1];
+    savedChar = *(bodyEnd+1);      /* save char after body */
+    *(bodyEnd+1) = '\0';
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, bodyStart, bodyEnd+1, flags,
+	    envPtr);
+    *(bodyEnd+1) = savedChar;      /* restore the saved char */
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"foreach\" body line %d)",
+		    interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    envPtr->excRangeArrayPtr[range].numCodeBytes =
+	TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+    /*
+     * Discard the loop body's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+	
+    /*
+     * Emit the unconditional jump back to the test at the top of the
+     * loop. We generate a four byte jump if the distance to the to of
+     * the foreach is greater than 120 bytes. This is conservative and
+     * ensures that we won't have to replace this unconditional jump if
+     * we later need to replace the ifFalse jump with a four-byte jump.
+     */
+
+    jumpBackOffset = TclCurrCodeOffset();
+    jumpBackDist =
+	(jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
+#ifdef TCL_COMPILE_DEBUG
+    if (jumpBackDist > MAX_JUMP_DIST) {
+	fprintf(stderr, "\nTclCompileForeachCmd: bad distance %u for unconditional jump\n", jumpBackDist);
+	panic("TclCompileForeachCmd: bad distance for unconditional jump");
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    if (jumpBackDist > 120) {
+	TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the jumpFalse after the foreach_step
+     * test, update it with the correct distance. If the distance is too
+     * great (more than 127 bytes), replace that jump with a four byte
+     * instruction and move the instructions after the jump down.
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+	/*
+	 * Update the loop body's starting PC offset since it moved down.
+	 */
+
+#ifdef TCL_COMPILE_DEBUG
+	if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+	    panic("TclCompileForeachCmd: bad body ExceptionRange type %d\n",
+		  envPtr->excRangeArrayPtr[range].type);
+	}
+#endif /*TCL_COMPILE_DEBUG*/
+	envPtr->excRangeArrayPtr[range].codeOffset += 3;
+
+	/*
+	 * Update the distance for the unconditional jump back to the test
+	 * at the top of the loop since it moved down 3 bytes too.
+	 */
+
+	jumpBackOffset += 3;
+	jumpPc = (envPtr->codeStart + jumpBackOffset);
+	if (jumpBackDist > 120) {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	} else {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	}
+    }
+
+    /*
+     * The current PC offset (after the loop's body) is the loop's
+     * break target.
+     */
+
+#ifdef TCL_COMPILE_DEBUG
+    if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+	panic("TclCompileForeachCmd: bad body ExceptionRange type %d\n",
+	      envPtr->excRangeArrayPtr[range].type);
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
+    
+    /*
+     * Push an empty string object as the foreach command's result.
+     */
+
+    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
+				    envPtr);
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;		/* since we just pushed one object */
+    }
+
+    done:
+    for (i = 0;  i < numLists;  i++) {
+        if (varvList[i] != (char **) NULL) {
+            ckfree((char *) varvList[i]);
+        }
+    }
+    if (varcList != varcListStaticSpace) {
+	ckfree((char *) varcList);
+        ckfree((char *) varvList);
+    }
+    envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->excRangeDepth--;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupForeachInfo --
+ *
+ *	This procedure duplicates a ForeachInfo structure created as
+ *	auxiliary data during the compilation of a foreach command.
+ *
+ * Results:
+ *	A pointer to a newly allocated copy of the existing ForeachInfo
+ *	structure is returned.
+ *
+ * Side effects:
+ *	Storage for the copied ForeachInfo record is allocated. If the
+ *	original ForeachInfo structure pointed to any ForeachVarList
+ *	records, these structures are also copied and pointers to them
+ *	are stored in the new ForeachInfo record.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupForeachInfo(clientData)
+    ClientData clientData;	/* The foreach command's compilation
+				 * auxiliary data to duplicate. */
+{
+    register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
+    ForeachInfo *dupPtr;
+    register ForeachVarList *srcListPtr, *dupListPtr;
+    int numLists = srcPtr->numLists;
+    int numVars, i, j;
+    
+    dupPtr = (ForeachInfo *) ckalloc((unsigned)
+	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+    dupPtr->numLists = numLists;
+    dupPtr->firstListTmp = srcPtr->firstListTmp;
+    dupPtr->loopIterNumTmp = srcPtr->loopIterNumTmp;
+    
+    for (i = 0;  i < numLists;  i++) {
+	srcListPtr = srcPtr->varLists[i];
+	numVars = srcListPtr->numVars;
+	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
+	        sizeof(ForeachVarList) + numVars*sizeof(int));
+	dupListPtr->numVars = numVars;
+	for (j = 0;  j < numVars;  j++) {
+	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
+	}
+	dupPtr->varLists[i] = dupListPtr;
+    }
+    return (ClientData) dupPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeForeachInfo --
+ *
+ *	Procedure to free a ForeachInfo structure created as auxiliary data
+ *	during the compilation of a foreach command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Storage for the ForeachInfo structure pointed to by the ClientData
+ *	argument is freed as is any ForeachVarList record pointed to by the
+ *	ForeachInfo structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeForeachInfo(clientData)
+    ClientData clientData;	/* The foreach command's compilation
+				 * auxiliary data to free. */
+{
+    register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
+    register ForeachVarList *listPtr;
+    int numLists = infoPtr->numLists;
+    register int i;
+
+    for (i = 0;  i < numLists;  i++) {
+	listPtr = infoPtr->varLists[i];
+	ckfree((char *) listPtr);
+    }
+    ckfree((char *) infoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIfCmd --
+ *
+ *	Procedure called to compile the "if" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "if" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    JumpFixupArray jumpFalseFixupArray;
+    				/* Used to fix up the ifFalse jump after
+				 * each "if"/"elseif" test when its target
+				 * PC is determined. */
+    JumpFixupArray jumpEndFixupArray;
+				/* Used to fix up the unconditional jump
+				 * after each "then" command to the end of
+				 * the "if" when that PC is determined. */
+    char *testSrcStart;
+    int jumpDist, jumpFalseDist, jumpIndex, objIndex, j, result;
+    unsigned char *ifFalsePc;
+    unsigned char opCode;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * Loop compiling "expr then body" clauses after an "if" or "elseif".
+     */
+
+    TclInitJumpFixupArray(&jumpFalseFixupArray);
+    TclInitJumpFixupArray(&jumpEndFixupArray);
+    while (1) {	
+	/*
+	 * At this point in the loop, we have an expression to test, either
+	 * the main expression or an expression following an "elseif".
+	 * The arguments after the expression must be "then" (optional) and
+	 * a script to execute if the expression is true.
+	 */
+
+	AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type == TCL_COMMAND_END) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "wrong # args: no expression after \"if\" argument", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+
+	/*
+	 * Compile the "if"/"elseif" test expression.
+	 */
+	
+	testSrcStart = src;
+	envPtr->pushSimpleWords = 1;    /* process words normally */
+	result = CompileExprWord(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp,
+		        "\n    (\"if\" test expression)", -1);
+	    }
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	src += envPtr->termOffset;
+
+	/*
+	 * Emit the ifFalse jump around the "then" part if the test was
+	 * false. We emit a one byte (relative) jump here, and replace it
+	 * later with a four byte jump if the jump target is more than 127
+	 * bytes away. 
+	 */
+
+	if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpFalseFixupArray);
+	}
+	jumpIndex = jumpFalseFixupArray.next;
+	jumpFalseFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+		&(jumpFalseFixupArray.fixup[jumpIndex]));
+	
+	/*
+	 * Skip over the optional "then" before the then clause.
+	 */
+
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type == TCL_COMMAND_END) {
+	    char buf[100];
+	    sprintf(buf, "wrong # args: no script following \"%.20s\" argument", testSrcStart);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	if ((*src == 't') && (strncmp(src, "then", 4) == 0)) {
+	    type = CHAR_TYPE(src+4, lastChar);
+	    if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
+		src += 4;		/* skip over the "then" */
+		AdvanceToNextWord(src, envPtr); 
+		src += envPtr->termOffset;
+		type = CHAR_TYPE(src, lastChar);
+		if (type == TCL_COMMAND_END) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "wrong # args: no script following \"then\" argument", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+	    }
+	}
+
+	/*
+	 * Compile the "then" command word inline.
+	 */
+
+	result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp, "\n    (\"if\" body script)", -1);
+	    }
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	src += envPtr->termOffset;
+
+	/*
+	 * Emit an unconditional jump to the end of the "if" command. We
+	 * emit a one byte jump here, and replace it later with a four byte
+	 * jump if the jump target is more than 127 bytes away. Note that
+	 * both the jumpFalseFixupArray and the jumpEndFixupArray are
+	 * indexed by the same index, "jumpIndex".
+	 */
+
+	if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
+	    TclExpandJumpFixupArray(&jumpEndFixupArray);
+	}
+	jumpEndFixupArray.next++;
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+		&(jumpEndFixupArray.fixup[jumpIndex]));
+
+ 	/*
+	 * Now that we know the target of the jumpFalse after the if test,
+         * update it with the correct distance. We generate a four byte
+	 * jump if the distance is greater than 120 bytes. This is
+	 * conservative, and ensures that we won't have to replace this
+	 * jump if we later also need to replace the preceeding
+	 * unconditional jump to the end of the "if" with a four-byte jump.
+         */
+
+	jumpDist = (TclCurrCodeOffset() - jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
+	if (TclFixupForwardJump(envPtr,
+	        &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
+	    /*
+	     * Adjust the code offset for the unconditional jump at the end
+	     * of the last "then" clause.
+	     */
+
+	    jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+	}
+
+	/*
+	 * Check now for a "elseif" word. If we find one, keep looping.
+	 */
+
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if ((type != TCL_COMMAND_END)
+	        && ((*src == 'e') && (strncmp(src, "elseif", 6) == 0))) {
+	    type = CHAR_TYPE(src+6, lastChar);
+	    if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
+		src += 6;	   /* skip over the "elseif" */
+		AdvanceToNextWord(src, envPtr); 
+		src += envPtr->termOffset;
+		type = CHAR_TYPE(src, lastChar);
+		if (type == TCL_COMMAND_END) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "wrong # args: no expression after \"elseif\" argument", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+		continue;	  /* continue the "expr then body" loop */
+	    }
+	}
+	break;		  /* exit the loop */
+    } /* end of the "expr then body" loop */
+
+    /*
+     * No more "elseif expr then body" clauses. Check now for an "else"
+     * clause. If there is another word, we are at its start.
+     */
+
+    if (type != TCL_COMMAND_END) {
+	if ((*src == 'e') && (strncmp(src, "else", 4) == 0)) {
+	    type = CHAR_TYPE(src+4, lastChar);
+	    if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
+		src += 4;	   /* skip over the "else" */
+		AdvanceToNextWord(src, envPtr); 
+		src += envPtr->termOffset;
+		type = CHAR_TYPE(src, lastChar);
+		if (type == TCL_COMMAND_END) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "wrong # args: no script following \"else\" argument", -1);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+	    }
+	}
+
+	/*
+	 * Compile the "else" command word inline.
+	 */
+
+	result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp, "\n    (\"if\" else script)", -1);
+	    }
+	    goto done;
+	}
+	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+	src += envPtr->termOffset;
+    
+	/*
+	 * Skip over white space until the end of the command.
+	 */
+	
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    AdvanceToNextWord(src, envPtr);
+	    src += envPtr->termOffset;
+	    type = CHAR_TYPE(src, lastChar);
+	    if (type != TCL_COMMAND_END) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	}
+    } else {
+	/*
+	 * The "if" command has no "else" clause: push an empty string
+	 * object as its result.
+	 */
+
+	objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
+		/*inHeap*/ 0, envPtr);
+	TclEmitPush(objIndex, envPtr);
+	maxDepth = TclMax(1, maxDepth);
+    }
+
+    /*
+     * Now that we know the target of the unconditional jumps to the end of
+     * the "if" command, update them with the correct distance. If the
+     * distance is too great (> 127 bytes), replace the jump with a four
+     * byte instruction and move instructions after the jump down.
+     */
+    
+    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
+	jumpIndex = (j - 1);	/* i.e. process the closest jump first */
+	jumpDist = (TclCurrCodeOffset() - jumpEndFixupArray.fixup[jumpIndex].codeOffset);
+	if (TclFixupForwardJump(envPtr,
+	        &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
+	    /*
+	     * Adjust the jump distance for the "ifFalse" jump that
+	     * immediately preceeds this jump. We've moved it's target
+	     * (just after this unconditional jump) three bytes down.
+	     */
+
+	    ifFalsePc = (envPtr->codeStart + jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
+	    opCode = *ifFalsePc;
+	    if (opCode == INST_JUMP_FALSE1) {
+		jumpFalseDist = TclGetInt1AtPc(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclUpdateInt1AtPc(jumpFalseDist, (ifFalsePc + 1));
+	    } else if (opCode == INST_JUMP_FALSE4) {
+		jumpFalseDist = TclGetInt4AtPc(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclUpdateInt4AtPc(jumpFalseDist, (ifFalsePc + 1));
+	    } else {
+		panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
+	    }
+	}
+    }
+	
+    /*
+     * Free the jumpFixupArray array if malloc'ed storage was used.
+     */
+
+    done:
+    TclFreeJumpFixupArray(&jumpFalseFixupArray);
+    TclFreeJumpFixupArray(&jumpEndFixupArray);
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIncrCmd --
+ *
+ *	Procedure called to compile the "incr" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while parsing string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "incr" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "incr" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    				/* Points to structure describing procedure
+				 * containing incr command, else NULL. */
+    register char *src = string;
+    				/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int simpleVarName;		/* 1 if name is just sequence of chars with
+                                 * an optional element name in parens. */
+    char *name = NULL;		/* If simpleVarName, points to first char of
+				 * variable name and nameChars is length.
+				 * Otherwise NULL. */
+    char *elName = NULL;	/* If simpleVarName, points to first char of
+				 * element name and elNameChars is length.
+				 * Otherwise NULL. */
+    int nameChars = 0;		/* Length of the var name. Initialized to
+				 * avoid a compiler warning. */
+    int elNameChars = 0;	/* Length of array's element name, if any.
+				 * Initialized to avoid a compiler
+				 * warning. */
+    int incrementGiven;		/* 1 if an increment amount was given. */
+    int isImmIncrValue = 0;	/* 1 if increment amount is a literal
+				 * integer in [-127..127]. */
+    int immIncrValue = 0;	/* if isImmIncrValue is 1, the immediate
+				 * integer value. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    int localIndex = -1;	/* Index of the variable in the current
+				 * procedure's array of local variables.
+				 * Otherwise -1 if not in a procedure or
+				 * the variable wasn't found. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null char
+				 * during name processing. */
+    int objIndex;		/* The object array index for a pushed
+				 * object holding a name part. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    char *p;
+    int i, result;
+
+    /*
+     * Parse the next word: the variable name. If it is "simple" (requires
+     * no substitutions at runtime), divide it up into a simple "name" plus
+     * an optional "elName". Otherwise, if not simple, just push the name.
+     */
+
+    AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	badArgs:
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"incr varName ?increment?\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+    
+    envPtr->pushSimpleWords = 0;  /* we will process the varName */
+    result = CompileWord(interp, src, lastChar, flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    simpleVarName = envPtr->wordIsSimple;
+    if (simpleVarName) {
+	name = src;
+	nameChars = envPtr->numSimpleWordChars;
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    name++;		/* advance over the " or { */
+	}
+	elName = NULL;
+	elNameChars = 0;
+	p = name;
+	for (i = 0;  i < nameChars;  i++) {
+	    if (*p == '(') {
+		char *openParen = p;
+		p = (src + nameChars-1);	
+		if (*p == ')') { /* last char is ')' => array reference */
+		    nameChars = (openParen - name);
+		    elName = openParen+1;
+		    elNameChars = (p - elName);
+		}
+		break;
+	    }
+	    p++;
+	}
+    } else {
+        maxDepth = envPtr->maxStackDepth;
+    }
+    src += envPtr->termOffset;
+
+    /*
+     * See if there is a next word. If so, we are incrementing the variable
+     * by that value (which must be an integer).
+     */
+
+    incrementGiven = 0;
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	incrementGiven = (type != TCL_COMMAND_END);
+    }
+
+    /*
+     * Non-simple names have already been pushed. If this is a simple
+     * variable, either push its name (if a global or an unknown local
+     * variable) or look up the variable's local frame index. If a local is
+     * not found, push its name and do the lookup at runtime. If this is an
+     * array reference, also push the array element.
+     */
+
+    if (simpleVarName) {
+	if (procPtr == NULL) {
+	    savedChar = name[nameChars];      /* save char after name */
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;      /* restore the saved char */
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if ((localIndex < 0) || (localIndex > 255)) {
+		if (localIndex > 255) {	      /* we'll push the name */
+		    localIndex = -1;
+		}
+		savedChar = name[nameChars];  /* save char after name */
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;  /* restore the saved char */
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    } else {
+		maxDepth = 0;
+	    }
+	}
+	
+	if (elName != NULL) {
+	    /*
+	     * Parse and push the array element's name. Perform
+	     * substitutions on it, just as is done for quoted strings.
+	     */
+
+	    savedChar = elName[elNameChars];  /* save char after elName */
+	    elName[elNameChars] = '\0';
+	    envPtr->pushSimpleWords = 1;
+	    result = TclCompileQuotes(interp, elName, elName+elNameChars,
+		    0, flags, envPtr);
+	    elName[elNameChars] = savedChar;  /* restore the saved char */
+	    if (result != TCL_OK) {
+		char msg[200];
+		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+			TclMin(nameChars, 100), name);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		goto done;
+	    }
+	    maxDepth += envPtr->maxStackDepth;
+	}
+    }
+
+    /*
+     * If an increment was given, push the new value.
+     */
+    
+    if (incrementGiven) {
+	type = CHAR_TYPE(src, lastChar);
+	envPtr->pushSimpleWords = 0; /* we will handle simple words */
+	result = CompileWord(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp,
+		        "\n    (reading increment)", -1);
+	    }
+	    goto done;
+	}
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    src++;		     /* advance over the " or { */
+	}
+	if (envPtr->wordIsSimple) {
+	    /*
+	     * See if the word represents an integer whose formatted
+	     * representation is the same as the word (e.g., this is
+	     * true for 123 and -1 but not for 00005). If so, just
+	     * push an integer object.
+	     */
+	    
+	    int isCompilableInt = 0;
+	    int numChars = envPtr->numSimpleWordChars;
+	    char savedChar = src[numChars];
+	    char buf[40];
+	    Tcl_Obj *objPtr;
+	    long n;
+
+	    src[numChars] = '\0';
+	    if (TclLooksLikeInt(src)) {
+		if (TclGetLong(interp, src, &n) == TCL_OK) {
+		    if ((-127 <= n) && (n <= 127)) {
+			isCompilableInt = 1;
+			isImmIncrValue = 1;
+			immIncrValue = n;
+		    } else {
+			TclFormatInt(buf, n);
+			if (strcmp(src, buf) == 0) {
+			    isCompilableInt = 1;
+			    isImmIncrValue = 0;
+			    objIndex = TclObjIndexForString(src, numChars,
+                                /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
+			    objPtr = envPtr->objArrayPtr[objIndex];
+
+			    Tcl_InvalidateStringRep(objPtr);
+			    objPtr->internalRep.longValue = n;
+			    objPtr->typePtr = &tclIntType;
+			    
+			    TclEmitPush(objIndex, envPtr);
+			    maxDepth += 1;
+			}
+		    }
+		}
+	    }
+	    if (!isCompilableInt) {
+		objIndex = TclObjIndexForString(src, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		TclEmitPush(objIndex, envPtr);
+		maxDepth += 1;
+	    }
+	    src[numChars] = savedChar;  /* restore the saved char */
+	} else {
+	    maxDepth += envPtr->maxStackDepth;
+	}
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    src += (envPtr->termOffset - 1); /* already advanced 1 above */
+	} else {
+	    src += envPtr->termOffset;
+	}
+    } else {			/* no incr amount given so use 1 */
+	isImmIncrValue = 1;
+	immIncrValue = 1;
+    }
+    
+    /*
+     * Now emit instructions to increment the variable.
+     */
+
+    if ((localIndex >= 0) && (localIndex > 255)) {
+	panic("TclCompileIncrCmd: bad localIndex %d\n", localIndex);
+	return TCL_ERROR;
+    }
+    if (simpleVarName) {
+	if (elName == NULL) {  /* scalar */
+	    if (localIndex >= 0) {
+		if (isImmIncrValue) {
+		    TclEmitInstUInt1(INST_INCR_SCALAR1_IMM, localIndex,
+				    envPtr);
+		    TclEmitInt1(immIncrValue, envPtr);
+		} else {
+		    TclEmitInstUInt1(INST_INCR_SCALAR1, localIndex, envPtr);
+		}
+	    } else {
+		if (isImmIncrValue) {
+		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immIncrValue,
+				   envPtr);
+		} else {
+		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
+		}
+	    }
+	} else {		/* array */
+	    if (localIndex >= 0) {
+		if (isImmIncrValue) {
+		    TclEmitInstUInt1(INST_INCR_ARRAY1_IMM, localIndex,
+				    envPtr);
+		    TclEmitInt1(immIncrValue, envPtr);
+		} else {
+		    TclEmitInstUInt1(INST_INCR_ARRAY1, localIndex, envPtr);
+		}
+	    } else {
+		if (isImmIncrValue) {
+		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immIncrValue,
+				   envPtr);
+		} else {
+		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
+		}
+	    }
+	}
+    } else {			/* non-simple variable name */
+	if (isImmIncrValue) {
+	    TclEmitInstInt1(INST_INCR_STK_IMM, immIncrValue, envPtr);
+	} else {
+	    TclEmitOpcode(INST_INCR_STK, envPtr);
+	}
+    }
+	
+    /*
+     * Skip over white space until the end of the command.
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    goto badArgs;	/* too many arguments */
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSetCmd --
+ *
+ *	Procedure called to compile the "set" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is normally TCL_OK
+ *	unless there was an error while parsing string. If an error occurs
+ *	then the interpreter's result contains a standard error message. If
+ *	complation fails because the set command requires a second level of
+ *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ *	set command should be compiled "out of line" by emitting code to
+ *	invoke its command procedure (Tcl_SetCmd) at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the incr command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "set" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+				/* Points to structure describing procedure
+				 * containing the set command, else NULL. */
+    ArgInfo argInfo;		/* Structure holding information about the
+				 * start and end of each argument word. */
+    int simpleVarName;		/* 1 if name is just sequence of chars with
+                                 * an optional element name in parens. */
+    char *elName = NULL;	/* If simpleVarName, points to first char of
+				 * element name and elNameChars is length.
+				 * Otherwise NULL. */
+    int isAssignment;		/* 1 if assigning value to var, else 0. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    int localIndex = -1;	/* Index of the variable in the current
+				 * procedure's array of local variables.
+				 * Otherwise -1 if not in a procedure, the
+				 * name contains "::"s, or the variable
+				 * wasn't found. */
+    char savedChar;		/* Holds the character from string
+				 * termporarily replaced by a null char
+				 * during name processing. */
+    int objIndex = -1;		/* The object array index for a pushed
+				 * object holding a name part. Initialized
+				 * to avoid a compiler warning. */
+    char *wordStart, *p;
+    int numWords, isCompilableInt, i, result;
+    Tcl_Obj *objPtr;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    /*
+     * Scan the words of the command and record the start and finish of
+     * each argument word.
+     */
+
+    InitArgInfo(&argInfo);
+    result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
+    numWords = argInfo.numArgs;	  /* i.e., the # after the command name */
+    if (result != TCL_OK) {
+	goto done;
+    }
+    if ((numWords < 1) || (numWords > 2)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"set varName ?newValue?\"", -1);
+        result = TCL_ERROR;
+	goto done;
+    }
+    isAssignment = (numWords == 2);
+
+    /*
+     * Parse the next word: the variable name. If the name is enclosed in
+     * quotes or braces, we return TCL_OUT_LINE_COMPILE and call the set
+     * command procedure at runtime since this makes sure that a second
+     * round of substitutions is done properly. 
+     */
+
+    wordStart = argInfo.startArray[0]; /* start of 1st arg word: varname */
+    if ((*wordStart == '{') || (*wordStart == '"')) {
+	result = TCL_OUT_LINE_COMPILE;
+	goto done;
+    }
+
+    /*
+     * Check whether the name is "simple": requires no substitutions at
+     * runtime.
+     */
+    
+    envPtr->pushSimpleWords = 0;       /* we will process the varName */
+    result = CompileWord(interp, wordStart, argInfo.endArray[0] + 1,
+	    flags, envPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+    simpleVarName = envPtr->wordIsSimple;
+    
+    if (!simpleVarName) {
+	/*
+	 * The name isn't simple. CompileWord already pushed it.
+	 */
+	
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	char *name;		/* If simpleVarName, points to first char of
+				 * variable name and nameChars is length.
+				 * Otherwise NULL. */
+	int nameChars;		/* Length of the var name. */
+	int nameHasNsSeparators = 0;
+				/* Set 1 if name contains "::"s. */
+	int elNameChars;	/* Length of array's element name if any. */
+
+	/*
+	 * A simple name. First divide it up into "name" plus "elName"
+	 * for an array element name, if any.
+	 */
+	
+	name = wordStart;
+	nameChars = envPtr->numSimpleWordChars;
+	elName = NULL;
+	elNameChars = 0;
+	
+	p = name;
+	for (i = 0;  i < nameChars;  i++) {
+	    if (*p == '(') {
+		char *openParen = p;
+		p = (name + nameChars-1);	
+		if (*p == ')') { /* last char is ')' => array reference */
+		    nameChars = (openParen - name);
+		    elName = openParen+1;
+		    elNameChars = (p - elName);
+		}
+		break;
+	    }
+	    p++;
+	}
+
+	/*
+	 * Determine if name has any namespace separators (::'s).
+	 */
+
+	p = name;
+	for (i = 0;  i < nameChars;  i++) {
+	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
+		nameHasNsSeparators = 1;
+		break;
+	    }
+	    p++;
+	}
+
+	/*
+	 * Now either push the name or determine its index in the array of
+	 * local variables in a procedure frame. Note that if we are
+	 * compiling a procedure the variable must be local unless its
+	 * name has namespace separators ("::"s). Note also that global
+	 * variables are implemented by a local variable that "points" to
+	 * the real global. There are two cases:
+	 *   1) We are not compiling a procedure body. Push the global
+	 *      variable's name and do the lookup at runtime.
+	 *   2) We are compiling a procedure and the name has "::"s.
+	 *	Push the namespace variable's name and do the lookup at
+	 *	runtime.
+	 *   3) We are compiling a procedure and the name has no "::"s.
+	 *	If the variable has already been allocated an local index,
+	 *	just look it up. If the variable is unknown and we are
+	 *	doing an assignment, allocate a new index. Otherwise,
+	 *	push the name and try to do the lookup at runtime.
+	 */
+
+	if ((procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];  /* save char after name */
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;  /* restore the saved char */
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ isAssignment,
+                    /*flagsIfCreated*/
+			((elName == NULL)? VAR_SCALAR : VAR_ARRAY),
+		    envPtr->procPtr);
+	    if (localIndex >= 0) {
+		maxDepth = 0;
+	    } else {
+		savedChar = name[nameChars];  /* save char after name */
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;  /* restore the saved char */
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    }
+	}
+
+	/*
+	 * If we are dealing with a reference to an array element, push the
+	 * array element. Perform substitutions on it, just as is done
+	 * for quoted strings.
+	 */
+	
+	if (elName != NULL) {
+	    savedChar = elName[elNameChars];  /* save char after elName */
+	    elName[elNameChars] = '\0';
+	    envPtr->pushSimpleWords = 1;
+	    result = TclCompileQuotes(interp, elName, elName+elNameChars,
+		    0, flags, envPtr);
+	    elName[elNameChars] = savedChar;  /* restore the saved char */
+	    if (result != TCL_OK) {
+		char msg[200];
+		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+			TclMin(nameChars, 100), name);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		goto done;
+	    }
+	    maxDepth += envPtr->maxStackDepth;
+	}
+    }
+
+    /*
+     * If we are doing an assignment, push the new value.
+     */
+    
+    if (isAssignment) {
+	wordStart = argInfo.startArray[1]; /* start of 2nd arg word */
+	envPtr->pushSimpleWords = 0;       /* we will handle simple words */
+	result = CompileWord(interp, wordStart,	argInfo.endArray[1] + 1,
+		flags, envPtr);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	if (!envPtr->wordIsSimple) {
+	    /*
+	     * The value isn't simple. CompileWord already pushed it.
+	     */
+
+	    maxDepth += envPtr->maxStackDepth;
+	} else {
+	    /*
+	     * The value is simple. See if the word represents an integer
+	     * whose formatted representation is the same as the word (e.g.,
+	     * this is true for 123 and -1 but not for 00005). If so, just
+	     * push an integer object.
+	     */
+	    
+	    char buf[40];
+	    long n;
+
+	    p = wordStart;
+	    if ((*wordStart == '"') || (*wordStart == '{')) {
+		p++;		/* advance over the " or { */
+	    }
+	    savedChar = p[envPtr->numSimpleWordChars];
+	    p[envPtr->numSimpleWordChars] = '\0';
+	    isCompilableInt = 0;
+	    if (TclLooksLikeInt(p)) {
+		if (TclGetLong(interp, p, &n) == TCL_OK) {
+		    TclFormatInt(buf, n);
+		    if (strcmp(p, buf) == 0) {
+			isCompilableInt = 1;
+			objIndex = TclObjIndexForString(p,
+				envPtr->numSimpleWordChars,
+                                /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
+			objPtr = envPtr->objArrayPtr[objIndex];
+
+			Tcl_InvalidateStringRep(objPtr);
+			objPtr->internalRep.longValue = n;
+			objPtr->typePtr = &tclIntType;
+		    }
+		}
+	    }
+	    if (!isCompilableInt) {
+		objIndex = TclObjIndexForString(p,
+			envPtr->numSimpleWordChars, /*allocStrRep*/ 1,
+			/*inHeap*/ 0, envPtr);
+	    }
+	    p[envPtr->numSimpleWordChars] = savedChar; /* restore char */
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth += 1;
+	}
+    }
+    
+    /*
+     * Now emit instructions to set/retrieve the variable.
+     */
+
+    if (simpleVarName) {
+	if (elName == NULL) {  /* scalar */
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstUInt1((isAssignment?
+			     INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+			localIndex, envPtr);
+		} else {
+		    TclEmitInstUInt4((isAssignment?
+			     INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+			localIndex, envPtr);
+		}
+	    } else {
+		TclEmitOpcode((isAssignment?
+			     INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
+			    envPtr);
+	    }
+	} else {		/* array */
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstUInt1((isAssignment?
+			     INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+			localIndex, envPtr);
+		} else {
+		    TclEmitInstUInt4((isAssignment?
+			     INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+			localIndex, envPtr);
+		}
+	    } else {
+		TclEmitOpcode((isAssignment?
+			     INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
+			    envPtr);
+	    }
+	}
+    } else {			/* non-simple variable name */
+	TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
+    }
+	
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    FreeArgInfo(&argInfo);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileWhileCmd --
+ *
+ *	Procedure called to compile the "while" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK if
+ *	compilation was successful. If an error occurs then the
+ *	interpreter's result contains a standard error message and TCL_ERROR
+ *	is returned. If compilation failed because the command is too
+ *	complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
+ *	indicating that the while command should be compiled "out of line"
+ *	by emitting code to invoke its command procedure at runtime.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "while" command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the "while" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    int range;			/* Index in the ExceptionRange array of the
+				 * ExceptionRange record for this loop. */
+    JumpFixup jumpFalseFixup;	/* Used to update or replace the ifFalse
+				 * jump after test when its target PC is
+				 * determined. */
+    unsigned char *jumpPc;
+    int jumpDist, jumpBackDist, jumpBackOffset, objIndex, result;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+
+    envPtr->excRangeDepth++;
+    envPtr->maxExcRangeDepth =
+	TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+
+    /*
+     * Create and initialize a ExceptionRange record to hold information
+     * about this loop. This is used to implement break and continue.
+     */
+
+    range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
+
+    AdvanceToNextWord(src, envPtr); /* make sure there is a next word */
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	badArgs:
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"while test command\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the test expression is enclosed in quotes (""s), don't compile
+     * the while inline. As a result of Tcl's two level substitution
+     * semantics for expressions, the expression might have a constant
+     * value that results in the loop never executing, or executing forever.
+     * Consider "set x 0; while "$x < 5" {incr x}": the loop body should
+     * never be executed.
+     */
+
+    if (*src == '"') {
+	result = TCL_OUT_LINE_COMPILE;
+        goto done;
+    }
+
+    /*
+     * Compile the next word: the test expression.
+     */
+
+    envPtr->pushSimpleWords = 1;    /* process words normally */
+    result = CompileExprWord(interp, src, lastChar, flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+            Tcl_AddObjErrorInfo(interp, "\n    (\"while\" test expression)", -1);
+        }
+	goto done;
+    }
+    maxDepth = envPtr->maxStackDepth;
+    src += envPtr->termOffset;
+
+    /*
+     * Emit the ifFalse jump that terminates the while if the test was
+     * false. We emit a one byte (relative) jump here, and replace it
+     * later with a four byte jump if the jump target is more than
+     * 127 bytes away.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+    
+    /*
+     * Compile the loop body word inline. Also register the loop body's
+     * starting PC offset and byte length in the its ExceptionRange record.
+     */
+
+    AdvanceToNextWord(src, envPtr);  /* make sure there is a next word */
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	goto badArgs;
+    }
+
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, src, lastChar,
+	    flags, envPtr);
+    if (result != TCL_OK) {
+	if (result == TCL_ERROR) {
+	    char msg[60];
+	    sprintf(msg, "\n    (\"while\" body line %d)", interp->errorLine);
+            Tcl_AddObjErrorInfo(interp, msg, -1);
+        }
+	goto done;
+    }
+    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+    src += envPtr->termOffset;
+    envPtr->excRangeArrayPtr[range].numCodeBytes =
+	(TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset);
+
+    /*
+     * Discard the loop body's result.
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+	
+    /*
+     * Emit the unconditional jump back to the test at the top of the
+     * loop. We generate a four byte jump if the distance to the while's
+     * test is greater than 120 bytes. This is conservative, and ensures
+     * that we won't have to replace this unconditional jump if we later
+     * need to replace the ifFalse jump with a four-byte jump.
+     */
+
+    jumpBackOffset = TclCurrCodeOffset();
+    jumpBackDist =
+	(jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
+#ifdef TCL_COMPILE_DEBUG
+    if (jumpBackDist > MAX_JUMP_DIST) {
+	fprintf(stderr, "\nTclCompileWhileCmd: bad distance %u for unconditional jump\n", jumpBackDist);
+	panic("TclCompileWhileCmd: bad distance for unconditional jump");
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    if (jumpBackDist > 120) {
+	TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+    } else {
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
+    }
+
+    /*
+     * Now that we know the target of the jumpFalse after the test, update
+     * it with the correct distance. If the distance is too great (more
+     * than 127 bytes), replace that jump with a four byte instruction and
+     * move the instructions after the jump down. 
+     */
+
+    jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+	/*
+	 * Update the loop body's starting PC offset since it moved down.
+	 */
+
+#ifdef TCL_COMPILE_DEBUG
+	if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+	    panic("TclCompileWhileCmd: bad body ExceptionRange type %d\n",
+		  envPtr->excRangeArrayPtr[range].type);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+	envPtr->excRangeArrayPtr[range].codeOffset += 3;
+
+	/*
+	 * Update the distance for the unconditional jump back to the test
+	 * at the top of the loop since it moved down 3 bytes too.
+	 */
+
+	jumpBackOffset += 3;
+	jumpPc = (envPtr->codeStart + jumpBackOffset);
+	if (jumpBackDist > 120) {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	} else {
+	    jumpBackDist += 3;
+	    TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
+				   jumpPc);
+	}
+    }
+
+    /*
+     * The current PC offset (after the loop's body) is the loop's
+     * break target.
+     */
+
+#ifdef TCL_COMPILE_DEBUG
+    if (envPtr->excRangeArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+	panic("TclCompileWhileCmd: bad body ExceptionRange type %d\n",
+	      envPtr->excRangeArrayPtr[range].type);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+    envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
+    
+    /*
+     * Push an empty string object as the while command's result.
+     */
+
+    objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
+				    envPtr);
+    TclEmitPush(objIndex, envPtr);
+    if (maxDepth == 0) {
+	maxDepth = 1;		/* since we just pushed one object */
+    }
+
+    /*
+     * Skip over white space until the end of the command.
+     */
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type != TCL_COMMAND_END) {
+	AdvanceToNextWord(src, envPtr);
+	src += envPtr->termOffset;
+	type = CHAR_TYPE(src, lastChar);
+	if (type != TCL_COMMAND_END) {
+	    goto badArgs;  	    /* too many arguments */
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->excRangeDepth--;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileExprWord --
+ *
+ *	Procedure that compiles a Tcl expression in a command word.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while compiling string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the "expr" word.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to evaluate the expression word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileExprWord(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;          /* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute the expression. */
+    int nestedCmd = (flags & TCL_BRACKET_TERM);
+				/* 1 if script being compiled is a nested
+				 * command and is terminated by a ']';
+				 * otherwise 0. */
+    char *first, *last;		/* Points to the first and last significant
+				 * characters of the word. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during compilation
+				 * of the expression. */
+    int inlineCode;		/* 1 if inline "optimistic" code is
+				 * emitted for the expression; else 0. */
+    int range = -1;		/* If we inline compile an un-{}'d
+				 * expression, the index for its catch range
+				 * record in the ExceptionRange array.
+				 * Initialized to avoid compile warning. */
+    JumpFixup jumpFixup;	/* Used to emit the "success" jump after
+				 * the inline expression code. */
+    char *p;
+    char c;
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
+    int numChars, result;
+
+    /*
+     * Skip over leading white space.
+     */
+
+    AdvanceToNextWord(src, envPtr);
+    src += envPtr->termOffset;
+    type = CHAR_TYPE(src, lastChar);
+    if (type == TCL_COMMAND_END) {
+	badArgs:
+	Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "malformed expression word", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the word is enclosed in {}s, we may strip them off and safely
+     * compile the expression into an inline sequence of instructions using
+     * TclCompileExpr. We know these instructions will have the right Tcl7.x
+     * expression semantics.
+     *
+     * Otherwise, if the word is not enclosed in {}s, we may need to call
+     * the expr command (Tcl_ExprObjCmd) at runtime. This recompiles the
+     * expression each time (typically) and so is slow. However, there are
+     * some circumstances where we can still compile inline instructions
+     * "optimistically" and check, during their execution, for double
+     * substitutions (these appear as nonnumeric operands). We check for any
+     * backslash or command substitutions. If none appear, and only variable
+     * substitutions are found, we generate inline instructions.
+     *
+     * For now, if the expression is not enclosed in {}s, we call the expr
+     * command at runtime if either command or backslash substitutions
+     * appear (but not if only variable substitutions appear).
+     */
+
+    if (*src == '{') {
+	/*
+	 * Inline compile the expression inside {}s.
+	 */
+	
+	first = src+1;
+	src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	if (*src == 0) {	     /* word doesn't end properly. */
+	    goto badArgs;
+	}
+	if (*src != '}') {
+	    goto badArgs;
+	}
+	last = (src-1);
+
+	numChars = (last - first + 1);
+	savedChar = first[numChars];
+	first[numChars] = '\0';	     /* replace term. char with null */
+	result = TclCompileExpr(interp, first, first+numChars,
+		flags, envPtr);
+	first[numChars] = savedChar; /* restore the saved char */
+
+	src++;			     /* advance src after terminating '}' */
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	/*
+	 * No braces. If the expression is enclosed in '"'s, call the expr
+	 * cmd at runtime. Otherwise, scan the word's characters looking for
+	 * any '['s or (for now) '\'s. If any are found, just call expr cmd
+	 * at runtime.
+	 */
+
+	first = src;
+	last = TclWordEnd(first, lastChar, nestedCmd, NULL);
+	if (*last == 0) {	/* word doesn't end properly. */
+	    src = last;
+	    goto badArgs;
+	}
+
+	inlineCode = 1;
+	if ((*first == '"') && (*last == '"')) {
+	    inlineCode = 0;
+	} else {
+	    for (p = first;  p <= last;  p++) {
+		c = *p;
+		if ((c == '[') || (c == '\\')) {
+		    inlineCode = 0;
+		    break;
+		}
+	    }
+	}
+	
+	if (inlineCode) {
+	    /*
+	     * Inline compile the expression inside a "catch" so that a
+	     * runtime error will back off to make a (slow) call on expr.
+	     */
+
+	    int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	    int startRangeNext = envPtr->excRangeArrayNext;
+
+	    /*
+	     * Create a ExceptionRange record to hold information about
+	     * the "catch" range for the expression's inline code. Also
+	     * emit the instruction to mark the start of the range.
+	     */
+
+	    envPtr->excRangeDepth++;
+	    envPtr->maxExcRangeDepth =
+		TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+	    range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
+	    TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
+
+	    /*
+	     * Inline compile the expression.
+	     */
+
+	    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+	    numChars = (last - first + 1);
+	    savedChar = first[numChars];
+	    first[numChars] = '\0';      /* replace term. char with null */
+	    result = TclCompileExpr(interp, first, first + numChars,
+		    flags, envPtr);
+	    first[numChars] = savedChar; /* restore the saved char */
+	    
+	    envPtr->excRangeArrayPtr[range].numCodeBytes =
+		TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+	    if ((envPtr->exprIsJustVarRef) || (result != TCL_OK)) {
+		/*
+		 * We must call the expr command at runtime since the
+		 * expression consisted of just a single variable reference
+		 * (and a second round of substitutions might be needed) or
+		 * there was a compilation error. Delete the inline code by
+		 * backing up the code pc and catch index. Note that if
+		 * there was a compilation error, we can't report the error
+		 * yet since the expression might be valid after the second
+		 * round of substitutions.
+		 */
+		
+		envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
+		envPtr->excRangeArrayNext = startRangeNext;
+		inlineCode = 0;
+	    } else {
+		TclEmitOpcode(INST_END_CATCH, envPtr);
+		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+		envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+	    }
+	}
+	    
+	/*
+	 * Arrange to call expr at runtime with the (already substituted
+	 * once) expression word on the stack.
+	 */
+
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, first, lastChar, flags, envPtr);
+	src += envPtr->termOffset;
+	maxDepth = envPtr->maxStackDepth;
+	if (result == TCL_OK) {
+	    TclEmitOpcode(INST_EXPR_STK, envPtr);
+	}
+
+	/*
+	 * If emitting inline code for this non-{}'d expression, update
+	 * the target of the jump after that inline code.
+	 */
+
+	if (inlineCode) {
+	    int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+	    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+		/*
+		 * Update the inline expression code's catch ExceptionRange
+		 * target since it, being after the jump, also moved down.
+		 */
+
+#ifdef TCL_COMPILE_DEBUG
+		if (envPtr->excRangeArrayPtr[range].type != CATCH_EXCEPTION_RANGE) {
+		    panic("CompileExprWord: bad body ExceptionRange type %d\n",
+			  envPtr->excRangeArrayPtr[range].type);
+		}
+#endif /* TCL_COMPILE_DEBUG */
+		
+		envPtr->excRangeArrayPtr[range].catchOffset += 3;
+	    }
+	}
+    } /* if expression isn't in {}s */
+    
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileCmdWordInline --
+ *
+ *	Procedure that compiles a Tcl command word inline. If the word is
+ *	enclosed in quotes or braces, we call TclCompileString to compile it
+ *	after stripping them off. Otherwise, we normally push the word's
+ *	value and call eval at runtime, but if the word is just a sequence
+ *	of alphanumeric characters, we emit an invoke instruction
+ *	directly. This procedure assumes that string points to the start of
+ *	the word to compile.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while compiling string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ *	envPtr->termOffset is filled in with the offset of the character in
+ *	"string" just after the last one successfully processed.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the command word
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* The source string to compile. */
+    char *lastChar;		/* Pointer to terminating character of
+				 * string. */
+    int flags;			/* Flags to control compilation (same as
+				 * passed to Tcl_Eval). */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char *src = string;/* Points to current source char. */
+    register int type;          /* Current char's CHAR_TYPE type. */
+    int maxDepth = 0;		/* Maximum number of stack elements needed
+				 * to execute cmd. */
+    char *termPtr;		/* Points to char that terminated braced
+				 * string. */
+    char savedChar;		/* Holds the character termporarily replaced
+				 * by a null character during compilation
+				 * of the command. */
+    int savePushSimpleWords = envPtr->pushSimpleWords;
+    int objIndex;
+    int result = TCL_OK;
+    register char c;
+
+    type = CHAR_TYPE(src, lastChar);
+    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	src++;			     /* advance over the " or { */
+	envPtr->pushSimpleWords = 0; /* we process a simple word below */
+	if (type == TCL_QUOTE) {
+	    result = TclCompileQuotes(interp, src, lastChar,
+		    '"', flags, envPtr);
+	} else {
+	    result = CompileBraces(interp, src, lastChar, flags, envPtr);
+	}
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	
+	/*
+	 * Make sure the terminating character is the end of word.
+	 */
+	
+	termPtr = (src + envPtr->termOffset);
+	c = *termPtr;
+	if ((c == '\\') && (*(termPtr+1) == '\n')) {
+	    /*
+	     * Line is continued on next line; the backslash-newline turns
+	     * into space, which terminates the word.
+	     */
+	} else {
+	    type = CHAR_TYPE(termPtr, lastChar);
+	    if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
+		Tcl_ResetResult(interp);
+		if (*(src-1) == '"') {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			    "extra characters after close-quote", -1);
+		} else {
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "extra characters after close-brace", -1);
+		}
+		result = TCL_ERROR;
+		goto done;
+	    }
+	}
+	
+	if (envPtr->wordIsSimple) {
+	    /*
+	     * A simple word enclosed in "" or {}s. Call TclCompileString to
+	     * compile it inline. Add a null character after the end of the
+	     * quoted or braced string: i.e., at the " or }. Turn the
+	     * flag bit TCL_BRACKET_TERM off since the recursively
+	     * compiled subcommand is now terminated by a null character.
+	     */
+	    char *closeCharPos = (termPtr - 1);
+	    
+	    savedChar = *closeCharPos;
+	    *closeCharPos = '\0';
+	    result = TclCompileString(interp, src, closeCharPos,
+		    (flags & ~TCL_BRACKET_TERM), envPtr);
+	    *closeCharPos = savedChar;   /* restore the saved char */
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	} else {
+            /*
+	     * The braced string contained a backslash-newline. Call eval
+	     * at runtime.
+	     */
+	    TclEmitOpcode(INST_EVAL_STK, envPtr);
+	}
+	src = termPtr;
+	maxDepth = envPtr->maxStackDepth;
+    } else {
+	/*
+	 * Not a braced or quoted string. We normally push the word's
+	 * value and call eval at runtime. However, if the word is just
+	 * a sequence of alphanumeric characters, we call its compile
+	 * procedure, if any, or otherwise just emit an invoke instruction.
+	 */
+
+	char *p = src;
+	c = *p;
+	while (isalnum(UCHAR(c)) || (c == '_')) {
+            p++;
+            c = *p;
+        }
+	type = CHAR_TYPE(p, lastChar);
+        if ((p > src) && (type == TCL_COMMAND_END)) {
+            /*
+	     * Look for a compile procedure and call it. Otherwise emit an
+	     * invoke instruction to call the command at runtime.
+	     */
+
+	    Tcl_Command cmd;
+	    Command *cmdPtr = NULL;
+	    int wasCompiled = 0;      /* set 1 if word has compile proc. */
+
+	    savedChar = *p;
+	    *p = '\0';
+
+	    cmd = Tcl_FindCommand(interp, src, (Tcl_Namespace *) NULL,
+		    /*flags*/ 0);
+	    if (cmd != (Tcl_Command) NULL) {
+                cmdPtr = (Command *) cmd;
+            }
+	    if (cmdPtr != NULL && cmdPtr->compileProc != NULL) {
+		*p = savedChar;   /* restore the saved char */
+		src = p;
+		iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
+				 | ERROR_CODE_SET);
+		result = (*(cmdPtr->compileProc))(interp, src, lastChar, flags, envPtr);
+		if (result != TCL_OK) {
+		    goto done;
+		}
+		wasCompiled = 1;
+		src += envPtr->termOffset;
+		maxDepth = envPtr->maxStackDepth;
+	    }
+	    if (!wasCompiled) {
+		objIndex = TclObjIndexForString(src, p-src,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		*p = savedChar;	     /* restore the saved char */
+		TclEmitPush(objIndex, envPtr);
+		TclEmitInstUInt1(INST_INVOKE_STK1, 1, envPtr);
+		src = p;
+		maxDepth = 1;
+	    }
+        } else {
+	    /*
+	     * Push the word and call eval at runtime.
+	     */
+
+	    envPtr->pushSimpleWords = 1;    /* process words normally */
+	    result = CompileWord(interp, src, lastChar, flags, envPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    TclEmitOpcode(INST_EVAL_STK, envPtr);
+	    src += envPtr->termOffset;
+	    maxDepth = envPtr->maxStackDepth;
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LookupCompiledLocal --
+ *
+ *	This procedure is called at compile time to look up and optionally
+ *	allocate an entry ("slot") for a variable in a procedure's array of
+ *	local variables. If the variable's name is NULL, a new temporary
+ *	variable is always created. (Such temporary variables can only be
+ *	referenced using their slot index.)
+ *
+ * Results:
+ *	If createIfNew is 0 (false) and the name is non-NULL, then if the
+ *	variable is found, the index of its entry in the procedure's array
+ *	of local variables is returned; otherwise -1 is returned.
+ *	If name is NULL, the index of a new temporary variable is returned.
+ *	Finally, if createIfNew is 1 and name is non-NULL, the index of a
+ *	new entry is returned.
+ *
+ * Side effects:
+ *	Creates and registers a new local variable if createIfNew is 1 and
+ *	the variable is unknown, or if the name is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
+    register char *name;	/* Points to first character of the name of
+				 * a scalar or array variable. If NULL, a
+				 * temporary var should be created. */
+    int nameChars;		/* The length of the name excluding the
+				 * terminating null character. */
+    int createIfNew;		/* 1 to allocate a local frame entry for the
+				 * variable if it is new. */
+    int flagsIfCreated;		/* Flag bits for the compiled local if
+				 * created. Only VAR_SCALAR, VAR_ARRAY, and
+				 * VAR_LINK make sense. */
+    register Proc *procPtr;	/* Points to structure describing procedure
+				 * containing the variable reference. */
+{
+    register CompiledLocal *localPtr;
+    int localIndex = -1;
+    register int i;
+
+    /*
+     * If not creating a temporary, does a local variable of the specified
+     * name already exist?
+     */
+
+    if (name != NULL) {	
+	int localCt = procPtr->numCompiledLocals;
+	localPtr = procPtr->firstLocalPtr;
+	for (i = 0;  i < localCt;  i++) {
+	    if (!localPtr->isTemp) {
+		char *localName = localPtr->name;
+		if ((name[0] == localName[0])
+	                && (nameChars == localPtr->nameLength)
+	                && (strncmp(name, localName, (unsigned) nameChars) == 0)) {
+		    return i;
+		}
+	    }
+	    localPtr = localPtr->nextPtr;
+	}
+    }
+
+    /*
+     * Create a new variable if appropriate.
+     */
+    
+    if (createIfNew || (name == NULL)) {
+	localIndex = procPtr->numCompiledLocals;
+	localPtr = (CompiledLocal *) ckalloc((unsigned) 
+	        (sizeof(CompiledLocal) - sizeof(localPtr->name)
+		+ nameChars+1));
+	if (procPtr->firstLocalPtr == NULL) {
+	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
+	} else {
+	    procPtr->lastLocalPtr->nextPtr = localPtr;
+	    procPtr->lastLocalPtr = localPtr;
+	}
+	localPtr->nextPtr = NULL;
+	localPtr->nameLength = nameChars;
+	localPtr->frameIndex = localIndex;
+	localPtr->isArg  = 0;
+	localPtr->isTemp = (name == NULL);
+	localPtr->flags = flagsIfCreated;
+	localPtr->defValuePtr = NULL;
+	if (name != NULL) {
+	    strncpy(localPtr->name, name, (unsigned) nameChars);
+	}
+	localPtr->name[nameChars] = '\0';
+	procPtr->numCompiledLocals++;
+    }
+    return localIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdvanceToNextWord --
+ *
+ *	This procedure is called to skip over any leading white space at the
+ *	start of a word. Note that a backslash-newline is treated as a
+ *	space.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Updates envPtr->termOffset with the offset of the first
+ *	character in "string" that was not white space or a
+ *	backslash-newline. This might be the offset of the character that
+ *	ends the command: a newline, null, semicolon, or close-bracket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdvanceToNextWord(string, envPtr)
+    char *string;		/* The source string to compile. */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+{
+    register char *src;		/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    
+    src = string;
+    type = CHAR_TYPE(src, src+1);
+    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
+	if (type == TCL_BACKSLASH) {
+	    if (src[1] == '\n') {
+		src += 2;
+	    } else {
+		break;		/* exit loop; no longer white space */
+	    }
+	} else {
+	    src++;
+	}
+	type = CHAR_TYPE(src, src+1);
+    }
+    envPtr->termOffset = (src - string);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Backslash --
+ *
+ *	Figure out how to handle a backslash sequence.
+ *
+ * Results:
+ *	The return value is the character that should be substituted
+ *	in place of the backslash sequence that starts at src.  If
+ *	readPtr isn't NULL then it is filled in with a count of the
+ *	number of characters in the backslash sequence.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char
+Tcl_Backslash(src, readPtr)
+    char *src;			/* Points to the backslash character of
+				 * a backslash sequence. */
+    int *readPtr;		/* Fill in with number of characters read
+				 * from src, unless NULL. */
+{
+    register char *p = src+1;
+    char result;
+    int count;
+
+    count = 2;
+
+    switch (*p) {
+	/*
+         * Note: in the conversions below, use absolute values (e.g.,
+         * 0xa) rather than symbolic values (e.g. \n) that get converted
+         * by the compiler.  It's possible that compilers on some
+         * platforms will do the symbolic conversions differently, which
+         * could result in non-portable Tcl scripts.
+         */
+
+        case 'a':
+            result = 0x7;
+            break;
+        case 'b':
+            result = 0x8;
+            break;
+        case 'f':
+            result = 0xc;
+            break;
+        case 'n':
+            result = 0xa;
+            break;
+        case 'r':
+            result = 0xd;
+            break;
+        case 't':
+            result = 0x9;
+            break;
+        case 'v':
+            result = 0xb;
+            break;
+        case 'x':
+            if (isxdigit(UCHAR(p[1]))) {
+                char *end;
+
+                result = (char) strtoul(p+1, &end, 16);
+                count = end - src;
+            } else {
+                count = 2;
+                result = 'x';
+            }
+            break;
+        case '\n':
+            do {
+                p++;
+            } while ((*p == ' ') || (*p == '\t'));
+            result = ' ';
+            count = p - src;
+            break;
+        case 0:
+            result = '\\';
+            count = 1;
+            break;
+	default:
+	    if (isdigit(UCHAR(*p))) {
+		result = (char)(*p - '0');
+		p++;
+		if (!isdigit(UCHAR(*p))) {
+		    break;
+		}
+		count = 3;
+		result = (char)((result << 3) + (*p - '0'));
+		p++;
+		if (!isdigit(UCHAR(*p))) {
+		    break;
+		}
+		count = 4;
+		result = (char)((result << 3) + (*p - '0'));
+		break;
+	    }
+	    result = *p;
+	    count = 2;
+	    break;
+    }
+
+    if (readPtr != NULL) {
+	*readPtr = count;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjIndexForString --
+ *
+ *	Procedure to find, or if necessary create, an object in a
+ *	CompileEnv's object array that has a string representation
+ *	matching the argument string.
+ *
+ * Results:
+ *	The index in the CompileEnv's object array of an object with a
+ *	string representation matching the argument "string". The object is
+ *	created if necessary. If inHeap is 1, then string is heap allocated
+ *	and ownership of the string is passed to TclObjIndexForString;
+ *	otherwise, the string is owned by the caller and must not be
+ *	modified or freed by TclObjIndexForString. Typically, a caller sets
+ *	inHeap 1 if string is an already heap-allocated buffer holding the
+ *	result of backslash substitutions.
+ *
+ * Side effects:
+ *	A new Tcl object will be created if no existing object matches the
+ *	input string. If allocStrRep is 1 then if a new object is created,
+ *	its string representation is allocated in the heap, else it is left
+ *	NULL. If inHeap is 1, this procedure is given ownership of the
+ * 	string: if an object is created and allocStrRep is 1 then its
+ *	string representation is set directly from string, otherwise
+ *	the string is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
+    register char *string;	/* Points to string for which an object is
+				 * found or created in CompileEnv's object
+				 * array. */
+    int length;			/* Length of string. */
+    int allocStrRep;		/* If 1 then the object's string rep should
+				 * be allocated in the heap. */
+    int inHeap;			/* If 1 then string is heap allocated and
+				 * its ownership is passed to
+				 * TclObjIndexForString. */
+    CompileEnv *envPtr;		/* Points to the CompileEnv in whose object
+				 * array an object is found or created. */
+{
+    register Tcl_Obj *objPtr;	/* Points to the object created for
+				 * the string, if one was created. */
+    int objIndex;		/* Index of matching object. */
+    Tcl_HashEntry *hPtr;
+    int strLength, new;
+    
+    /*
+     * Look up the string in the code's object hashtable. If found, just
+     * return the associated object array index.  Note that if the string
+     * has embedded nulls, we don't create a hash table entry.  This
+     * should be fixed, but we need to update hash tables, first.
+     */
+
+    strLength = strlen(string);
+    if (length == -1) {
+	length = strLength;
+    }
+    if (strLength != length) {
+	hPtr = NULL;
+    } else {
+	hPtr = Tcl_CreateHashEntry(&envPtr->objTable, string, &new);
+	if (!new) {		/* already in object table and array */
+	    objIndex = (int) Tcl_GetHashValue(hPtr);
+	    if (inHeap) {
+		ckfree(string);	/* since we own the string */
+	    }
+	    return objIndex;
+	}
+    }    
+
+    /*
+     * Create a new object holding the string, add it to the object array,
+     * and register its index in the object hashtable.
+     */
+
+    objPtr = Tcl_NewObj();
+    if (allocStrRep) {
+	if (inHeap) {		/* use input string for obj's string rep */
+	    objPtr->bytes = string;
+	} else {		/* must allocate string rep */
+	    if (length > 0) {
+		objPtr->bytes = ckalloc((unsigned) length + 1);
+		memcpy(objPtr->bytes, string, (size_t) length);
+		objPtr->bytes[length] = '\0';
+	    }
+	}
+	objPtr->length = length;
+    } else {			/* leave the string rep NULL */
+	if (inHeap) {
+	    ckfree(string);	/* since we own the string */
+	}
+    }
+
+    if (envPtr->objArrayNext >= envPtr->objArrayEnd) {
+        ExpandObjectArray(envPtr);
+    }
+    objIndex = envPtr->objArrayNext;
+    envPtr->objArrayPtr[objIndex] = objPtr;
+    Tcl_IncrRefCount(objPtr);	/* since obj array now has a reference */
+    envPtr->objArrayNext++;
+
+    if (hPtr) {
+	Tcl_SetHashValue(hPtr, objIndex);
+    }
+    return objIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExpandCodeArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *	CompileEnv's code array.
+ *
+ * Results:
+ *	None. 
+ *
+ * Side effects:
+ *	The byte code array in *envPtr is reallocated to a new array of
+ *	double the size, and if envPtr->mallocedCodeArray is non-zero the
+ *	old array is freed. Byte codes are copied from the old array to the
+ *	new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExpandCodeArray(envPtr)
+    CompileEnv *envPtr;		/* Points to the CompileEnv whose code array
+				 * must be enlarged. */
+{
+    /*
+     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
+     * code bytes are stored between envPtr->codeStart and
+     * (envPtr->codeNext - 1) [inclusive].
+     */
+    
+    size_t currBytes = TclCurrCodeOffset();
+    size_t newBytes  = 2*(envPtr->codeEnd  - envPtr->codeStart);
+    unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy from old code array to new, free old code array if needed, and
+     * mark new code array as malloced.
+     */
+ 
+    memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
+    if (envPtr->mallocedCodeArray) {
+        ckfree((char *) envPtr->codeStart);
+    }
+    envPtr->codeStart = newPtr;
+    envPtr->codeNext = (newPtr + currBytes);
+    envPtr->codeEnd  = (newPtr + newBytes);
+    envPtr->mallocedCodeArray = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExpandObjectArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *	CompileEnv's object array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object array in *envPtr is reallocated to a new array of
+ *	double the size, and if envPtr->mallocedObjArray is non-zero the
+ *	old array is freed. Tcl_Obj pointers are copied from the old array
+ *	to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ExpandObjectArray(envPtr)
+    CompileEnv *envPtr;		/* Points to the CompileEnv whose object
+				 * array must be enlarged. */
+{
+    /*
+     * envPtr->objArrayNext is equal to envPtr->objArrayEnd. The currently
+     * allocated Tcl_Obj pointers are stored between elements
+     * 0 and (envPtr->objArrayNext - 1) [inclusive] in the object array
+     * pointed to by objArrayPtr.
+     */
+
+    size_t currBytes = envPtr->objArrayNext * sizeof(Tcl_Obj *);
+    int newElems = 2*envPtr->objArrayEnd;
+    size_t newBytes = newElems * sizeof(Tcl_Obj *);
+    Tcl_Obj **newPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy from old object array to new, free old object array if needed,
+     * and mark new object array as malloced.
+     */
+ 
+    memcpy((VOID *) newPtr, (VOID *) envPtr->objArrayPtr, currBytes);
+    if (envPtr->mallocedObjArray) {
+	ckfree((char *) envPtr->objArrayPtr);
+    }
+    envPtr->objArrayPtr = (Tcl_Obj **) newPtr;
+    envPtr->objArrayEnd = newElems;
+    envPtr->mallocedObjArray = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EnterCmdStartData --
+ *
+ *	Registers the starting source and bytecode location of a
+ *	command. This information is used at runtime to map between
+ *	instruction pc and source locations.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Inserts source and code location information into the compilation
+ *	environment envPtr for the command at index cmdIndex. The
+ *	compilation environment's CmdLocation array is grown if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
+    CompileEnv *envPtr;		/* Points to the compilation environment
+				 * structure in which to enter command
+				 * location information. */
+    int cmdIndex;		/* Index of the command whose start data
+				 * is being set. */
+    int srcOffset;		/* Offset of first char of the command. */
+    int codeOffset;		/* Offset of first byte of command code. */
+{
+    CmdLocation *cmdLocPtr;
+    
+    if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
+	panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+    }
+    
+    if (cmdIndex >= envPtr->cmdMapEnd) {
+	/*
+	 * Expand the command location array by allocating more storage from
+	 * the heap. The currently allocated CmdLocation entries are stored
+	 * from cmdMapPtr[0] up to cmdMapPtr[envPtr->cmdMapEnd] (inclusive).
+	 */
+
+	size_t currElems = envPtr->cmdMapEnd;
+	size_t newElems  = 2*currElems;
+	size_t currBytes = currElems * sizeof(CmdLocation);
+	size_t newBytes  = newElems  * sizeof(CmdLocation);
+	CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
+	
+	/*
+	 * Copy from old command location array to new, free old command
+	 * location array if needed, and mark new array as malloced.
+	 */
+	
+	memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
+	if (envPtr->mallocedCmdMap) {
+	    ckfree((char *) envPtr->cmdMapPtr);
+	}
+	envPtr->cmdMapPtr = (CmdLocation *) newPtr;
+	envPtr->cmdMapEnd = newElems;
+	envPtr->mallocedCmdMap = 1;
+    }
+
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr->srcOffset = srcOffset;
+    cmdLocPtr->numSrcChars = -1;
+    cmdLocPtr->codeOffset = codeOffset;
+    cmdLocPtr->numCodeBytes = -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EnterCmdExtentData --
+ *
+ *	Registers the source and bytecode length of a command. This
+ *	information is used at runtime to map between instruction pc and
+ *	source locations.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Inserts source and code length information into the compilation
+ *	environment envPtr for the command at index cmdIndex. Starting
+ *	source and bytecode information for the command must already
+ *	have been registered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EnterCmdExtentData(envPtr, cmdIndex, numSrcChars, numCodeBytes)
+    CompileEnv *envPtr;		/* Points to the compilation environment
+				 * structure in which to enter command
+				 * location information. */
+    int cmdIndex;		/* Index of the command whose source and
+				 * code length data is being set. */
+    int numSrcChars;		/* Number of command source chars. */
+    int numCodeBytes;		/* Offset of last byte of command code. */
+{
+    CmdLocation *cmdLocPtr;
+
+    if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
+	panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+    }
+    
+    if (cmdIndex > envPtr->cmdMapEnd) {
+	panic("EnterCmdStartData: no start data registered for command with index %d\n", cmdIndex);
+    }
+
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr->numSrcChars = numSrcChars;
+    cmdLocPtr->numCodeBytes = numCodeBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitArgInfo --
+ *
+ *	Initializes a ArgInfo structure to hold information about
+ *	some number of argument words in a command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The ArgInfo structure is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitArgInfo(argInfoPtr)
+    register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
+				   * to initialize. */
+{
+    argInfoPtr->numArgs = 0;
+    argInfoPtr->startArray = argInfoPtr->staticStartSpace;
+    argInfoPtr->endArray   = argInfoPtr->staticEndSpace;
+    argInfoPtr->allocArgs = ARGINFO_INIT_ENTRIES;
+    argInfoPtr->mallocedArrays = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CollectArgInfo --
+ *
+ *	Procedure to scan the argument words of a command and record the
+ *	start and finish of each argument word in a ArgInfo structure.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is TCL_OK unless
+ *	there was an error while scanning string. If an error occurs then
+ *	the interpreter's result contains a standard error message.
+ *
+ * Side effects:
+ *	If necessary, the argument start and end arrays in *argInfoPtr
+ *	are grown and reallocated to a new arrays of double the size, and
+ *	if argInfoPtr->mallocedArray is non-zero the old arrays are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
+    Tcl_Interp *interp;         /* Used for error reporting. */
+    char *string;               /* The source command string to scan. */
+    char *lastChar;		 /* Pointer to terminating character of
+				  * string. */
+    int flags;                  /* Flags to control compilation (same as
+                                 * passed to Tcl_Eval). */
+    register ArgInfo *argInfoPtr;
+				/* Points to the ArgInfo structure in which
+				 * to record the arg word information. */
+{
+    register char *src = string;/* Points to current source char. */
+    register int type;		/* Current char's CHAR_TYPE type. */
+    int nestedCmd = (flags & TCL_BRACKET_TERM);
+                                /* 1 if string being scanned is a nested
+				 * command and is terminated by a ']';
+				 * otherwise 0. */
+    int scanningArgs;           /* 1 if still scanning argument words to
+				 * determine their start and end. */
+    char *wordStart, *wordEnd;  /* Points to the first and last significant
+				 * characters of each word. */
+    CompileEnv tempCompEnv;	/* Only used to hold the termOffset field
+				 * updated by AdvanceToNextWord. */
+    char *prev;
+
+    argInfoPtr->numArgs = 0;
+    scanningArgs = 1;
+    while (scanningArgs) {
+	AdvanceToNextWord(src, &tempCompEnv);
+	src += tempCompEnv.termOffset;
+	type = CHAR_TYPE(src, lastChar);
+
+	if ((type == TCL_COMMAND_END) && ((*src != ']') || nestedCmd)) {
+	    break;		    /* done collecting argument words */
+	} else if (*src == '"') {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    if (src == lastChar) { /* word doesn't end properly. */
+	        badStringTermination:
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	                "quoted string doesn't terminate properly", -1);
+		return TCL_ERROR;
+	    }
+	    prev = (src-1);
+	    if (*src == '"') {
+		wordEnd = src;
+		src++;		     /* skip over terminating '"' */
+	    } else if ((*src == ';') && (*prev == '"')) {
+		scanningArgs = 0;   /* found a terminating ';' */
+		wordEnd = prev;
+	    } else {
+		goto badStringTermination;
+	    }
+	} else if (*src == '{') {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    if (src == lastChar) { /* word doesn't end properly. */
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-brace", -1);
+		return TCL_ERROR;
+	    }
+	    prev = (src-1);
+	    if (*src == '}') {
+		wordEnd = src;
+		src++;		     /* skip over terminating '}' */
+	    } else if ((*src == ';') && (*prev == '}')) {
+		scanningArgs = 0;   /* found a terminating ';' */
+		wordEnd = prev;
+	    } else {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	                "argument word in braces doesn't terminate properly", -1);
+		return TCL_ERROR;
+	    }
+	} else {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    prev = (src-1);
+	    if (src == lastChar) { /* word doesn't end properly. */
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket or close-brace", -1);
+		return TCL_ERROR;
+	    } else if (*src == ';') {
+		scanningArgs = 0;   /* found a terminating ';' */
+		wordEnd = prev;
+	    } else {
+		wordEnd = src;
+		src++;		     /* advance to char after word */
+		if ((src == lastChar) || (*src == '\n')
+	                || ((*src == ']') && nestedCmd)) {
+		    scanningArgs = 0;
+		}
+	    }
+	} /* end of test on each kind of word */
+
+	if (argInfoPtr->numArgs == argInfoPtr->allocArgs) {
+	    int newArgs = 2*argInfoPtr->numArgs;
+	    size_t currBytes = argInfoPtr->numArgs * sizeof(char *);
+	    size_t newBytes  = newArgs * sizeof(char *);
+	    char **newStartArrayPtr =
+		    (char **) ckalloc((unsigned) newBytes);
+	    char **newEndArrayPtr =
+		    (char **) ckalloc((unsigned) newBytes);
+	    
+	    /*
+	     * Copy from the old arrays to the new, free the old arrays if
+	     * needed, and mark the new arrays as malloc'ed.
+	     */
+	    
+	    memcpy((VOID *) newStartArrayPtr,
+	            (VOID *) argInfoPtr->startArray, currBytes);
+	    memcpy((VOID *) newEndArrayPtr,
+		    (VOID *) argInfoPtr->endArray, currBytes);
+	    if (argInfoPtr->mallocedArrays) {
+		ckfree((char *) argInfoPtr->startArray);
+		ckfree((char *) argInfoPtr->endArray);
+	    }
+	    argInfoPtr->startArray = newStartArrayPtr;
+	    argInfoPtr->endArray   = newEndArrayPtr;
+	    argInfoPtr->allocArgs = newArgs;
+	    argInfoPtr->mallocedArrays = 1;
+	}
+	argInfoPtr->startArray[argInfoPtr->numArgs] = wordStart;
+	argInfoPtr->endArray[argInfoPtr->numArgs]   = wordEnd;
+	argInfoPtr->numArgs++;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeArgInfo --
+ *
+ *	Free any storage allocated in a ArgInfo structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated storage in the ArgInfo structure is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeArgInfo(argInfoPtr)
+    register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
+				   * to free. */
+{
+    if (argInfoPtr->mallocedArrays) {
+	ckfree((char *) argInfoPtr->startArray);
+	ckfree((char *) argInfoPtr->endArray);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateLoopExceptionRange --
+ *
+ *	Procedure that allocates and initializes a new ExceptionRange
+ *	structure of the specified kind in a CompileEnv's ExceptionRange
+ *	array.
+ *
+ * Results:
+ *	Returns the index for the newly created ExceptionRange.
+ *
+ * Side effects:
+ *	If there is not enough room in the CompileEnv's ExceptionRange
+ *	array, the array in expanded: a new array of double the size is
+ *	allocated, if envPtr->mallocedExcRangeArray is non-zero the old
+ *	array is freed, and ExceptionRange entries are copied from the old
+ *	array to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateExceptionRange(type, envPtr)
+    ExceptionRangeType type;	/* The kind of ExceptionRange desired. */
+    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
+				 * loop ExceptionRange structure is to be
+				 * allocated. */
+{
+    int index;			/* Index for the newly-allocated
+				 * ExceptionRange structure. */
+    register ExceptionRange *rangePtr;
+    				/* Points to the new ExceptionRange
+				 * structure */
+    
+    index = envPtr->excRangeArrayNext;
+    if (index >= envPtr->excRangeArrayEnd) {
+        /*
+	 * Expand the ExceptionRange array. The currently allocated entries
+	 * are stored between elements 0 and (envPtr->excRangeArrayNext - 1)
+	 * [inclusive].
+	 */
+	
+	size_t currBytes =
+	        envPtr->excRangeArrayNext * sizeof(ExceptionRange);
+	int newElems = 2*envPtr->excRangeArrayEnd;
+	size_t newBytes = newElems * sizeof(ExceptionRange);
+	ExceptionRange *newPtr = (ExceptionRange *)
+	        ckalloc((unsigned) newBytes);
+	
+	/*
+	 * Copy from old ExceptionRange array to new, free old
+	 * ExceptionRange array if needed, and mark the new ExceptionRange
+	 * array as malloced.
+	 */
+	
+	memcpy((VOID *) newPtr, (VOID *) envPtr->excRangeArrayPtr,
+	        currBytes);
+	if (envPtr->mallocedExcRangeArray) {
+	    ckfree((char *) envPtr->excRangeArrayPtr);
+	}
+	envPtr->excRangeArrayPtr = (ExceptionRange *) newPtr;
+	envPtr->excRangeArrayEnd = newElems;
+	envPtr->mallocedExcRangeArray = 1;
+    }
+    envPtr->excRangeArrayNext++;
+    
+    rangePtr = &(envPtr->excRangeArrayPtr[index]);
+    rangePtr->type = type;
+    rangePtr->nestingLevel = envPtr->excRangeDepth;
+    rangePtr->codeOffset = -1;
+    rangePtr->numCodeBytes = -1;
+    rangePtr->breakOffset = -1;
+    rangePtr->continueOffset = -1;
+    rangePtr->catchOffset = -1;
+    return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateAuxData --
+ *
+ *	Procedure that allocates and initializes a new AuxData structure in
+ *	a CompileEnv's array of compilation auxiliary data records. These
+ *	AuxData records hold information created during compilation by
+ *	CompileProcs and used by instructions during execution.
+ *
+ * Results:
+ *	Returns the index for the newly created AuxData structure.
+ *
+ * Side effects:
+ *	If there is not enough room in the CompileEnv's AuxData array,
+ *	the AuxData array in expanded: a new array of double the size
+ *	is allocated, if envPtr->mallocedAuxDataArray is non-zero
+ *	the old array is freed, and AuxData entries are copied from
+ *	the old array to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCreateAuxData(clientData, dupProc, freeProc, envPtr)
+    ClientData clientData;	/* The compilation auxiliary data to store
+				 * in the new aux data record. */
+    AuxDataDupProc *dupProc;	/* Procedure to call to duplicate the
+				 * compilation aux data when the containing
+				 * ByteCode structure is duplicated. */
+    AuxDataFreeProc *freeProc;	/* Procedure to call to free the
+				 * compilation aux data when the containing
+				 * ByteCode structure is freed.  */
+    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
+				 * aux data structure is to be allocated. */
+{
+    int index;			/* Index for the new AuxData structure. */
+    register AuxData *auxDataPtr;
+    				/* Points to the new AuxData structure */
+    
+    index = envPtr->auxDataArrayNext;
+    if (index >= envPtr->auxDataArrayEnd) {
+        /*
+	 * Expand the AuxData array. The currently allocated entries are
+	 * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
+	 * [inclusive].
+	 */
+	
+	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
+	int newElems = 2*envPtr->auxDataArrayEnd;
+	size_t newBytes = newElems * sizeof(AuxData);
+	AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
+	
+	/*
+	 * Copy from old AuxData array to new, free old AuxData array if
+	 * needed, and mark the new AuxData array as malloced.
+	 */
+	
+	memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr,
+	        currBytes);
+	if (envPtr->mallocedAuxDataArray) {
+	    ckfree((char *) envPtr->auxDataArrayPtr);
+	}
+	envPtr->auxDataArrayPtr = newPtr;
+	envPtr->auxDataArrayEnd = newElems;
+	envPtr->mallocedAuxDataArray = 1;
+    }
+    envPtr->auxDataArrayNext++;
+    
+    auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
+    auxDataPtr->clientData = clientData;
+    auxDataPtr->dupProc  = dupProc;
+    auxDataPtr->freeProc = freeProc;
+    return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitJumpFixupArray --
+ *
+ *	Initializes a JumpFixupArray structure to hold some number of
+ *	jump fixup entries.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The JumpFixupArray structure is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to initialize. */
+{
+    fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
+    fixupArrayPtr->next = 0;
+    fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
+    fixupArrayPtr->mallocedArray = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExpandJumpFixupArray --
+ *
+ *	Procedure that uses malloc to allocate more storage for a
+ *      jump fixup array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The jump fixup array in *fixupArrayPtr is reallocated to a new array
+ *	of double the size, and if fixupArrayPtr->mallocedArray is non-zero
+ *	the old array is freed. Jump fixup structures are copied from the
+ *	old array to the new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExpandJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to enlarge. */
+{
+    /*
+     * The currently allocated jump fixup entries are stored from fixup[0]
+     * up to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
+     * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
+     */
+
+    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
+    int newElems = 2*(fixupArrayPtr->end + 1);
+    size_t newBytes = newElems * sizeof(JumpFixup);
+    JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy from the old array to new, free the old array if needed,
+     * and mark the new array as malloced.
+     */
+ 
+    memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
+    if (fixupArrayPtr->mallocedArray) {
+	ckfree((char *) fixupArrayPtr->fixup);
+    }
+    fixupArrayPtr->fixup = (JumpFixup *) newPtr;
+    fixupArrayPtr->end = newElems;
+    fixupArrayPtr->mallocedArray = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeJumpFixupArray --
+ *
+ *	Free any storage allocated in a jump fixup array structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated storage in the JumpFixupArray structure is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to free. */
+{
+    if (fixupArrayPtr->mallocedArray) {
+	ckfree((char *) fixupArrayPtr->fixup);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEmitForwardJump --
+ *
+ *	Procedure to emit a two-byte forward jump of kind "jumpType". Since
+ *	the jump may later have to be grown to five bytes if the jump target
+ *	is more than, say, 127 bytes away, this procedure also initializes a
+ *	JumpFixup record with information about the jump. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The JumpFixup record pointed to by "jumpFixupPtr" is initialized
+ *	with information needed later if the jump is to be grown. Also,
+ *	a two byte jump of the designated type is emitted at the current
+ *	point in the bytecode stream.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
+    CompileEnv *envPtr;		/* Points to the CompileEnv structure that
+				 * holds the resulting instruction. */
+    TclJumpType jumpType;	/* Indicates the kind of jump: if true or
+				 * false or unconditional. */
+    JumpFixup *jumpFixupPtr;	/* Points to the JumpFixup structure to
+				 * initialize with information about this
+				 * forward jump. */
+{
+    /*
+     * Initialize the JumpFixup structure:
+     *    - codeOffset is offset of first byte of jump below
+     *    - cmdIndex is index of the command after the current one
+     *    - excRangeIndex is the index of the first ExceptionRange after
+     *      the current one.
+     */
+    
+    jumpFixupPtr->jumpType = jumpType;
+    jumpFixupPtr->codeOffset = TclCurrCodeOffset();
+    jumpFixupPtr->cmdIndex = envPtr->numCommands;
+    jumpFixupPtr->excRangeIndex = envPtr->excRangeArrayNext;
+    
+    switch (jumpType) {
+    case TCL_UNCONDITIONAL_JUMP:
+	TclEmitInstInt1(INST_JUMP1, /*offset*/ 0, envPtr);
+	break;
+    case TCL_TRUE_JUMP:
+	TclEmitInstInt1(INST_JUMP_TRUE1, /*offset*/ 0, envPtr);
+	break;
+    default:
+	TclEmitInstInt1(INST_JUMP_FALSE1, /*offset*/ 0, envPtr);
+	break;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFixupForwardJump --
+ *
+ *	Procedure that updates a previously-emitted forward jump to jump
+ *	a specified number of bytes, "jumpDist". If necessary, the jump is
+ *      grown from two to five bytes; this is done if the jump distance is
+ *	greater than "distThreshold" (normally 127 bytes). The jump is
+ *	described by a JumpFixup record previously initialized by
+ *	TclEmitForwardJump.
+ *
+ * Results:
+ *	1 if the jump was grown and subsequent instructions had to be moved;
+ *	otherwise 0. This result is returned to allow callers to update
+ *	any additional code offsets they may hold.
+ *
+ * Side effects:
+ *	The jump may be grown and subsequent instructions moved. If this
+ *	happens, the code offsets for any commands and any ExceptionRange
+ *	records	between the jump and the current code address will be
+ *	updated to reflect the moved code. Also, the bytecode instruction
+ *	array in the CompileEnv structure may be grown and reallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
+    CompileEnv *envPtr;		/* Points to the CompileEnv structure that
+				 * holds the resulting instruction. */
+    JumpFixup *jumpFixupPtr;    /* Points to the JumpFixup structure that
+				 * describes the forward jump. */
+    int jumpDist;		/* Jump distance to set in jump
+				 * instruction. */
+    int distThreshold;		/* Maximum distance before the two byte
+				 * jump is grown to five bytes. */
+{
+    unsigned char *jumpPc, *p;
+    int firstCmd, lastCmd, firstRange, lastRange, k;
+    unsigned int numBytes;
+    
+#ifdef TCL_COMPILE_DEBUG
+    if (jumpDist > MAX_JUMP_DIST) {
+	fprintf(stderr, "\nTclFixupForwardJump: bad jump distance %u\n", jumpDist);
+	panic("TclFixupForwardJump: bad jump distance");
+    }
+#endif /*TCL_COMPILE_DEBUG*/
+    
+    if (jumpDist <= distThreshold) {
+	jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
+	switch (jumpFixupPtr->jumpType) {
+	case TCL_UNCONDITIONAL_JUMP:
+	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
+	    break;
+	case TCL_TRUE_JUMP:
+	    TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc);
+	    break;
+	default:
+	    TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
+	    break;
+	}
+	return 0;		/* no need to grow the jump */
+    }
+
+    /*
+     * We must grow the jump then move subsequent instructions down.
+     */
+    
+    TclEnsureCodeSpace(3, envPtr);  /* NB: might change code addresses! */
+    jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
+    for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
+	    numBytes > 0;  numBytes--, p--) {
+	p[3] = p[0];
+    }
+    envPtr->codeNext += 3;
+    jumpDist += 3;
+    switch (jumpFixupPtr->jumpType) {
+    case TCL_UNCONDITIONAL_JUMP:
+	TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc);
+	break;
+    case TCL_TRUE_JUMP:
+	TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc);
+	break;
+    default:
+	TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc);
+	break;
+    }
+    
+    /*
+     * Adjust the code offsets for any commands and any ExceptionRange
+     * records between the jump and the current code address.
+     */
+    
+    firstCmd = jumpFixupPtr->cmdIndex;
+    lastCmd  = (envPtr->numCommands - 1);
+    if (firstCmd < lastCmd) {
+	for (k = firstCmd;  k <= lastCmd;  k++) {
+	    (envPtr->cmdMapPtr[k]).codeOffset += 3;
+	}
+    }
+    
+    firstRange = jumpFixupPtr->excRangeIndex;
+    lastRange  = (envPtr->excRangeArrayNext - 1);
+    for (k = firstRange;  k <= lastRange;  k++) {
+	ExceptionRange *rangePtr = &(envPtr->excRangeArrayPtr[k]);
+	rangePtr->codeOffset += 3;
+	
+	switch (rangePtr->type) {
+	case LOOP_EXCEPTION_RANGE:
+	    rangePtr->breakOffset += 3;
+	    if (rangePtr->continueOffset != -1) {
+		rangePtr->continueOffset += 3;
+	    }
+	    break;
+	case CATCH_EXCEPTION_RANGE:
+	    rangePtr->catchOffset += 3;
+	    break;
+	default:
+	    panic("TclFixupForwardJump: unrecognized ExceptionRange type %d\n", rangePtr->type);
+	}
+    }
+    return 1;			/* the jump was grown */
+}
+
+
diff --git a/contrib/tcl/generic/tclCompile.h b/contrib/tcl/generic/tclCompile.h
new file mode 100644
index 0000000..65bbe42
--- /dev/null
+++ b/contrib/tcl/generic/tclCompile.h
@@ -0,0 +1,950 @@
+/*
+ * tclCompile.h --
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclCompile.h 1.33 97/05/02 13:12:43
+ */
+
+#ifndef _TCLCOMPILATION
+#define _TCLCOMPILATION 1
+
+#ifndef _TCLINT
+#include "tclInt.h"
+#endif /* _TCLINT */
+
+/*
+ *------------------------------------------------------------------------
+ * Variables related to compilation. These are used in tclCompile.c,
+ * tclExecute.c, tclBasic.c, and their clients.
+ *------------------------------------------------------------------------
+ */
+
+/*
+ * Variable that denotes the command name Tcl object type. Objects of this
+ * type cache the Command pointer that results from looking up command names
+ * in the command hashtable.
+ */
+
+extern Tcl_ObjType	tclCmdNameType;
+
+/*
+ * Variable that controls whether compilation tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no compilation tracing
+ *    1: summarize compilation of top level cmds and proc bodies
+ *    2: display all instructions of each ByteCode compiled
+ * This variable is linked to the Tcl variable "tcl_traceCompile".
+ */
+
+extern int 		tclTraceCompile;
+
+/*
+ * Variable that controls whether execution tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no execution tracing
+ *    1: trace invocations of Tcl procs only
+ *    2: trace invocations of all (not compiled away) commands
+ *    3: display each instruction executed
+ * This variable is linked to the Tcl variable "tcl_traceExec".
+ */
+
+extern int 		tclTraceExec;
+
+/*
+ * The number of bytecode compilations.
+ */
+
+#ifdef TCL_COMPILE_STATS
+extern long		tclNumCompilations;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ *------------------------------------------------------------------------
+ * Data structures related to compilation.
+ *------------------------------------------------------------------------
+ */
+
+/*
+ * The structure used to implement Tcl "exceptions" (exceptional returns):
+ * for example, those generated in loops by the break and continue commands,
+ * and those generated by scripts and caught by the catch command. This
+ * ExceptionRange structure describes a range of code (e.g., a loop body),
+ * the kind of exceptions (e.g., a break or continue) that might occur, and
+ * the PC offsets to jump to if a matching exception does occur. Exception
+ * ranges can nest so this structure includes a nesting level that is used
+ * at runtime to find the closest exception range surrounding a PC. For
+ * example, when a break command is executed, the ExceptionRange structure
+ * for the most deeply nested loop, if any, is found and used. These
+ * structures are also generated for the "next" subcommands of for loops
+ * since a break there terminates the for command. This means a for command
+ * actually generates two LoopInfo structures.
+ */
+
+typedef enum {
+    LOOP_EXCEPTION_RANGE,	/* Code range is part of a loop command.
+				 * break and continue "exceptions" cause
+				 * jumps to appropriate PC offsets. */
+    CATCH_EXCEPTION_RANGE	/* Code range is controlled by a catch
+				 * command. Errors in the range cause a
+				 * jump to a particular PC offset. */
+} ExceptionRangeType;
+
+typedef struct ExceptionRange {
+    ExceptionRangeType type;	/* The kind of ExceptionRange. */
+    int nestingLevel;		/* Static depth of the exception range.
+				 * Used to find the most deeply-nested
+				 * range surrounding a PC at runtime. */
+    int codeOffset;		/* Offset of the first instruction byte of
+				 * the code range. */
+    int numCodeBytes;		/* Number of bytes in the code range. */
+    int breakOffset;		/* If a LOOP_EXCEPTION_RANGE, the target
+				 * PC offset for a break command in the
+				 * range. */
+    int continueOffset;		/* If a LOOP_EXCEPTION_RANGE and not -1,
+				 * the target PC offset for a continue
+				 * command in the code range. Otherwise,
+				 * ignore this range when processing a
+				 * continue command. */
+    int catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
+				 * offset for an "exception" in range. */
+} ExceptionRange;
+
+/*
+ * Structure used to map between instruction pc and source locations. It
+ * defines for each compiled Tcl command the starting and ending offsets for
+ * its source and code.
+ */
+
+typedef struct CmdLocation {
+    int srcOffset;		/* Offset of first char of the command. */
+    int numSrcChars;		/* Number of command source chars. */
+    int codeOffset;		/* Offset of first byte of command code. */
+    int numCodeBytes;		/* Number of code bytes for command code. */
+} CmdLocation;
+
+/*
+ * CompileProcs need the ability to record information during compilation
+ * that can be used by bytecode instructions during execution. The AuxData
+ * structure provides this "auxiliary data" mechanism. An arbitrary number
+ * of these structures can be stored in the ByteCode record (during
+ * compilation they are stored in a CompileEnv structure). Each AuxData
+ * record holds one word of client-specified data (often a pointer) and is
+ * given an index that instructions can later use to look up the structure
+ * and its data.
+ *
+ * The following definitions declare the types of procedures that are called
+ * to duplicate or free this auxiliary data when the containing ByteCode
+ * objects are duplicated and freed. Pointers to these procedures are kept
+ * in the AuxData structure.
+ */
+
+typedef ClientData (AuxDataDupProc)  _ANSI_ARGS_((ClientData clientData));
+typedef void       (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The definition of the AuxData structure that holds information created
+ * during compilation by CompileProcs and used by instructions during
+ * execution.
+ */
+
+typedef struct AuxData {
+    ClientData clientData;	/* The compilation data itself. */
+    AuxDataDupProc *dupProc;	/* Callback procedure to invoke when the
+				 * aux data is duplicated (e.g., when the
+				 * ByteCode structure containing the aux
+				 * data is duplicated). NULL means just
+				 * copy the source clientData bits; no
+				 * proc need be called. */
+    AuxDataFreeProc *freeProc;	/* Callback procedure to invoke when the
+				 * aux data is freed. NULL means no
+				 * proc need be called. */
+} AuxData;
+
+/*
+ * Structure defining the compilation environment. After compilation, fields
+ * describing bytecode instructions are copied out into the more compact
+ * ByteCode structure defined below.
+ */
+
+#define COMPILEENV_INIT_CODE_BYTES    250
+#define COMPILEENV_INIT_NUM_OBJECTS    40
+#define COMPILEENV_INIT_EXCEPT_RANGES   5
+#define COMPILEENV_INIT_CMD_MAP_SIZE   40
+#define COMPILEENV_INIT_AUX_DATA_SIZE   5
+
+typedef struct CompileEnv {
+    Interp *iPtr;		/* Interpreter containing the code being
+				 * compiled. Commands and their compile
+				 * procs are specific to an interpreter so
+				 * the code emitted will depend on the
+				 * interpreter. */
+    char *source;		/* The source string being compiled by
+				 * SetByteCodeFromAny. This pointer is not
+				 * owned by the CompileEnv and must not be
+				 * freed or changed by it. */
+    Proc *procPtr;		/* If a procedure is being compiled, a
+				 * pointer to its Proc structure; otherwise
+				 * NULL. Used to compile local variables.
+				 * Set from information provided by
+				 * ObjInterpProc in tclProc.c. */
+    int numCommands;		/* Number of commands compiled. */
+    int excRangeDepth;		/* Current exception range nesting level;
+				 * -1 if not in any range currently. */
+    int maxExcRangeDepth;	/* Max nesting level of exception ranges;
+				 * -1 if no ranges have been compiled. */
+    int maxStackDepth;		/* Maximum number of stack elements needed
+				 * to execute the code. Set by compilation
+				 * procedures before returning. */
+    Tcl_HashTable objTable;	/* Contains all Tcl objects referenced by
+				 * the compiled code. Indexed by the string
+				 * representations of the objects. Used to
+				 * avoid creating duplicate objects. */
+    int pushSimpleWords;	/* Set 1 by callers of compilation routines
+				 * if they should emit instructions to push
+				 * "simple" command words (those that are
+				 * just a sequence of characters). If 0, the
+				 * callers are responsible for compiling
+				 * simple words. */
+    int wordIsSimple;		/* Set 1 by compilation procedures before
+				 * returning if the previous command word
+				 * was just a sequence of characters,
+				 * otherwise 0. Used to help determine the
+				 * command being compiled. */
+    int numSimpleWordChars;	/* If wordIsSimple is 1 then the number of
+				 * characters in the simple word, else 0. */
+    int exprIsJustVarRef;	/* Set 1 if the expression last compiled by
+				 * TclCompileExpr consisted of just a
+				 * variable reference as in the expression
+				 * of "if $b then...". Otherwise 0. Used
+				 * to implement expr's 2 level substitution
+				 * semantics properly. */
+    int termOffset;		/* Offset of character just after the last
+				 * one compiled. Set by compilation
+				 * procedures before returning. */
+    unsigned char *codeStart;	/* Points to the first byte of the code. */
+    unsigned char *codeNext;	/* Points to next code array byte to use. */
+    unsigned char *codeEnd;	/* Points just after the last allocated
+				 * code array byte. */
+    int mallocedCodeArray;      /* Set 1 if code array was expanded 
+				 * and codeStart points into the heap.*/
+    Tcl_Obj **objArrayPtr;	/* Points to start of object array. */
+    int objArrayNext;		/* Index of next free object array entry. */
+    int objArrayEnd;		/* Index just after last obj array entry. */
+    int mallocedObjArray;       /* 1 if object array was expanded and
+                                 * objArray points into the heap, else 0. */
+    ExceptionRange *excRangeArrayPtr;
+    				/* Points to start of the ExceptionRange
+				 * array. */
+    int excRangeArrayNext;	/* Next free ExceptionRange array index.
+				 * excRangeArrayNext is the number of ranges
+				 * and (excRangeArrayNext-1) is the index of
+				 * the current range's array entry. */
+    int excRangeArrayEnd;	/* Index after the last ExceptionRange
+				 * array entry. */
+    int mallocedExcRangeArray;	/* 1 if ExceptionRange array was expanded
+				 * and excRangeArrayPtr points in heap,
+				 * else 0. */
+    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
+				 * numCommands is the index of the next
+				 * entry to use; (numCommands-1) is the
+				 * entry index for the last command. */
+    int cmdMapEnd;		/* Index after last CmdLocation entry. */
+    int mallocedCmdMap;		/* 1 if command map array was expanded and
+				 * cmdMapPtr points in the heap, else 0. */
+    AuxData *auxDataArrayPtr;   /* Points to auxiliary data array start. */
+    int auxDataArrayNext;	/* Next free compile aux data array index.
+				 * auxDataArrayNext is the number of aux
+				 * data items and (auxDataArrayNext-1) is
+				 * index of current aux data array entry. */
+    int auxDataArrayEnd;	/* Index after last aux data array entry. */
+    int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
+				 * auxDataArrayPtr points in heap else 0. */
+    unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
+                                /* Initial storage for code. */
+    Tcl_Obj *staticObjArraySpace[COMPILEENV_INIT_NUM_OBJECTS];
+                                /* Initial storage for object array. */
+    ExceptionRange staticExcRangeArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+                                /* Initial ExceptionRange array storage. */
+    CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
+                                /* Initial storage for cmd location map. */
+    AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
+                                /* Initial storage for aux data array. */
+} CompileEnv;
+
+/*
+ * The structure defining the bytecode instructions resulting from compiling
+ * a Tcl script. Note that this structure is variable length: a single heap
+ * object is allocated to hold the ByteCode structure immediately followed
+ * by the code bytes, the object array, the ExceptionRange array, the
+ * CmdLocation map, and the compilation AuxData array.
+ */
+
+typedef struct ByteCode {
+    Interp *iPtr;		/* Interpreter containing the code being
+				 * compiled. Commands and their compile
+				 * procs are specific to an interpreter so
+				 * the code emitted will depend on the
+				 * interpreter. */
+    int compileEpoch;		/* Value of iPtr->compileEpoch when this
+				 * ByteCode was compiled. Used to invalidate
+				 * code when, e.g., commands with compile
+				 * procs are redefined. */
+    int refCount;		/* Reference count: set 1 when created
+				 * plus 1 for each execution of the code
+				 * currently active. This structure can be
+				 * freed when refCount becomes zero. */
+    char *source;		/* The source string from which this
+				 * ByteCode was compiled. Note that this
+				 * pointer is not owned by the ByteCode and
+				 * must not be freed or modified by it. */
+    Proc *procPtr;		/* If the ByteCode was compiled from a
+				 * procedure body, this is a pointer to its
+				 * Proc structure; otherwise NULL. This
+				 * pointer is also not owned by the ByteCode
+				 * and must not be freed by it. Used for
+				 * debugging. */
+    int numCommands;		/* Number of commands compiled. */
+    int numSrcChars;		/* Number of source chars compiled. */
+    int numCodeBytes;		/* Number of code bytes. */
+    int numObjects;		/* Number of Tcl objects in object array. */
+    int numExcRanges;		/* Number of ExceptionRange array elems. */
+    int numAuxDataItems;	/* Number of AuxData items. */
+    int maxExcRangeDepth;	/* Maximum nesting level of ExceptionRanges;
+				 * -1 if no ranges were compiled. */
+    int maxStackDepth;		/* Maximum number of stack elements needed
+				 * to execute the code. */
+    unsigned char *codeStart;	/* Points to the first byte of the code.
+				 * This is just after the final ByteCode
+				 * member cmdMapPtr. */
+    Tcl_Obj **objArrayPtr;	/* Points to the start of the object array.
+				 * This is just after the last code byte. */
+    ExceptionRange *excRangeArrayPtr;
+    				/* Points to the start of the ExceptionRange
+				 * array. This is just after the last
+				 * object in the object array. */
+    CmdLocation *cmdMapPtr;	/* Points to pc <-> source map: an array of
+				 * numCommands CmdLocation structures. This
+				 * is just after the last entry in the
+				 * ExceptionRange array. */
+    AuxData *auxDataArrayPtr;   /* Points to the start of the auxiliary data
+				 * array. This is just after the last entry
+				 * in the CmdLocation array. */
+} ByteCode;
+
+/*
+ * Opcodes for the Tcl bytecode instructions. These opcodes must correspond
+ * to the entries in the table of instruction descriptions in tclCompile.c.
+ * Also, the order and number of the expression opcodes (e.g., INST_LOR)
+ * must match the entries in the array operatorStrings in tclExecute.c.
+ */
+
+/* Opcodes 0 to 9 */
+#define INST_DONE			0
+#define INST_PUSH1			(INST_DONE + 1)
+#define INST_PUSH4			(INST_DONE + 2)
+#define INST_POP			(INST_DONE + 3)
+#define INST_DUP			(INST_DONE + 4)
+#define INST_CONCAT1			(INST_DONE + 5)
+#define INST_INVOKE_STK1		(INST_DONE + 6)
+#define INST_INVOKE_STK4		(INST_DONE + 7)
+#define INST_EVAL_STK			(INST_DONE + 8)
+#define INST_EXPR_STK			(INST_DONE + 9)
+
+/* Opcodes 10 to 23 */
+#define INST_LOAD_SCALAR1		(INST_EXPR_STK + 1)
+#define INST_LOAD_SCALAR4		(INST_LOAD_SCALAR1 + 1)
+#define INST_LOAD_SCALAR_STK		(INST_LOAD_SCALAR1 + 2)
+#define INST_LOAD_ARRAY1		(INST_LOAD_SCALAR1 + 3)
+#define INST_LOAD_ARRAY4		(INST_LOAD_SCALAR1 + 4)
+#define INST_LOAD_ARRAY_STK		(INST_LOAD_SCALAR1 + 5)
+#define INST_LOAD_STK			(INST_LOAD_SCALAR1 + 6)
+#define INST_STORE_SCALAR1		(INST_LOAD_SCALAR1 + 7)
+#define INST_STORE_SCALAR4		(INST_LOAD_SCALAR1 + 8)
+#define INST_STORE_SCALAR_STK		(INST_LOAD_SCALAR1 + 9)
+#define INST_STORE_ARRAY1		(INST_LOAD_SCALAR1 + 10)
+#define INST_STORE_ARRAY4		(INST_LOAD_SCALAR1 + 11)
+#define INST_STORE_ARRAY_STK		(INST_LOAD_SCALAR1 + 12)
+#define INST_STORE_STK			(INST_LOAD_SCALAR1 + 13)
+
+/* Opcodes 24 to 33 */
+#define INST_INCR_SCALAR1		(INST_STORE_STK + 1)
+#define INST_INCR_SCALAR_STK		(INST_INCR_SCALAR1 + 1)
+#define INST_INCR_ARRAY1		(INST_INCR_SCALAR1 + 2)
+#define INST_INCR_ARRAY_STK		(INST_INCR_SCALAR1 + 3)
+#define INST_INCR_STK			(INST_INCR_SCALAR1 + 4)
+#define INST_INCR_SCALAR1_IMM		(INST_INCR_SCALAR1 + 5)
+#define INST_INCR_SCALAR_STK_IMM	(INST_INCR_SCALAR1 + 6)
+#define INST_INCR_ARRAY1_IMM		(INST_INCR_SCALAR1 + 7)
+#define INST_INCR_ARRAY_STK_IMM		(INST_INCR_SCALAR1 + 8)
+#define INST_INCR_STK_IMM		(INST_INCR_SCALAR1 + 9)
+
+/* Opcodes 34 to 39 */
+#define INST_JUMP1			(INST_INCR_STK_IMM + 1)
+#define INST_JUMP4			(INST_JUMP1 + 1)
+#define INST_JUMP_TRUE1			(INST_JUMP1 + 2)
+#define INST_JUMP_TRUE4			(INST_JUMP1 + 3)
+#define INST_JUMP_FALSE1		(INST_JUMP1 + 4)
+#define INST_JUMP_FALSE4	        (INST_JUMP1 + 5)
+
+/* Opcodes 40 to 64 */
+#define INST_LOR			(INST_JUMP_FALSE4 + 1)
+#define INST_LAND			(INST_LOR + 1)
+#define INST_BITOR			(INST_LOR + 2)
+#define INST_BITXOR			(INST_LOR + 3)
+#define INST_BITAND			(INST_LOR + 4)
+#define INST_EQ				(INST_LOR + 5)
+#define INST_NEQ			(INST_LOR + 6)
+#define INST_LT				(INST_LOR + 7)
+#define INST_GT				(INST_LOR + 8)
+#define INST_LE				(INST_LOR + 9)
+#define INST_GE				(INST_LOR + 10)
+#define INST_LSHIFT			(INST_LOR + 11)
+#define INST_RSHIFT			(INST_LOR + 12)
+#define INST_ADD			(INST_LOR + 13)
+#define INST_SUB			(INST_LOR + 14)
+#define INST_MULT			(INST_LOR + 15)
+#define INST_DIV			(INST_LOR + 16)
+#define INST_MOD			(INST_LOR + 17)
+#define INST_UPLUS			(INST_LOR + 18)
+#define INST_UMINUS			(INST_LOR + 19)
+#define INST_BITNOT			(INST_LOR + 20)
+#define INST_LNOT			(INST_LOR + 21)
+#define INST_CALL_BUILTIN_FUNC1		(INST_LOR + 22)
+#define INST_CALL_FUNC1			(INST_LOR + 23)
+#define INST_TRY_CVT_TO_NUMERIC		(INST_LOR + 24)
+
+/* Opcodes 65 to 66 */
+#define INST_BREAK			(INST_TRY_CVT_TO_NUMERIC + 1)
+#define INST_CONTINUE			(INST_BREAK + 1)
+
+/* Opcodes 67 to 68 */
+#define INST_FOREACH_START4		(INST_CONTINUE + 1)
+#define INST_FOREACH_STEP4		(INST_FOREACH_START4 + 1)
+
+/* Opcodes 69 to 72 */
+#define INST_BEGIN_CATCH4		(INST_FOREACH_STEP4 + 1)
+#define INST_END_CATCH			(INST_BEGIN_CATCH4 + 1)
+#define INST_PUSH_RESULT		(INST_BEGIN_CATCH4 + 2)
+#define INST_PUSH_RETURN_CODE		(INST_BEGIN_CATCH4 + 3)
+
+/* The last opcode */
+#define LAST_INST_OPCODE        	INST_PUSH_RETURN_CODE
+
+/*
+ * Table describing the Tcl bytecode instructions: their name (for
+ * displaying code), total number of code bytes required (including
+ * operand bytes), and a description of the type of each operand.
+ * These operand types include signed and unsigned integers of length
+ * one and four bytes. The unsigned integers are used for indexes or
+ * for, e.g., the count of objects to push in a "push" instruction.
+ */
+
+#define MAX_INSTRUCTION_OPERANDS 2
+
+typedef enum InstOperandType {
+    OPERAND_NONE,
+    OPERAND_INT1,		/* One byte signed integer. */
+    OPERAND_INT4,		/* Four byte signed integer. */
+    OPERAND_UINT1,		/* One byte unsigned integer. */
+    OPERAND_UINT4		/* Four byte unsigned integer. */
+} InstOperandType;
+
+typedef struct InstructionDesc {
+    char *name;			/* Name of instruction. */
+    int numBytes;		/* Total number of bytes for instruction. */
+    int numOperands;		/* Number of operands. */
+    InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
+				/* The type of each operand. */
+} InstructionDesc;
+
+extern InstructionDesc instructionTable[];
+
+/*
+ * Definitions of the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte. Each value denotes a builtin Tcl math function. These
+ * values must correspond to the entries in the builtinFuncTable array
+ * below and to the values stored in the tclInt.h MathFunc structure's
+ * builtinFuncIndex field.
+ */
+
+#define BUILTIN_FUNC_ACOS		0
+#define BUILTIN_FUNC_ASIN		1
+#define BUILTIN_FUNC_ATAN		2
+#define BUILTIN_FUNC_ATAN2		3
+#define BUILTIN_FUNC_CEIL		4
+#define BUILTIN_FUNC_COS		5
+#define BUILTIN_FUNC_COSH		6
+#define BUILTIN_FUNC_EXP		7
+#define BUILTIN_FUNC_FLOOR		8
+#define BUILTIN_FUNC_FMOD		9
+#define BUILTIN_FUNC_HYPOT		10
+#define BUILTIN_FUNC_LOG		11
+#define BUILTIN_FUNC_LOG10		12
+#define BUILTIN_FUNC_POW		13
+#define BUILTIN_FUNC_SIN		14
+#define BUILTIN_FUNC_SINH		15
+#define BUILTIN_FUNC_SQRT		16
+#define BUILTIN_FUNC_TAN		17
+#define BUILTIN_FUNC_TANH		18
+#define BUILTIN_FUNC_ABS		19
+#define BUILTIN_FUNC_DOUBLE		20
+#define BUILTIN_FUNC_INT		21
+#define BUILTIN_FUNC_RAND		22
+#define BUILTIN_FUNC_ROUND		23
+#define BUILTIN_FUNC_SRAND		24
+
+#define LAST_BUILTIN_FUNC        	BUILTIN_FUNC_SRAND
+
+/*
+ * Table describing the built-in math functions. Entries in this table are
+ * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte.
+ */
+
+typedef int (CallBuiltinFuncProc) _ANSI_ARGS_((Tcl_Interp *interp,
+        ExecEnv *eePtr, ClientData clientData));
+
+typedef struct {
+    char *name;			/* Name of function. */
+    int numArgs;		/* Number of arguments for function. */
+    Tcl_ValueType argTypes[MAX_MATH_ARGS];
+				/* Acceptable types for each argument. */
+    CallBuiltinFuncProc *proc;	/* Procedure implementing this function. */
+    ClientData clientData;	/* Additional argument to pass to the
+				 * function when invoking it. */
+} BuiltinFunc;
+
+extern BuiltinFunc builtinFuncTable[];
+
+/*
+ * The structure used to hold information about the start and end of each
+ * argument word in a command. 
+ */
+
+#define ARGINFO_INIT_ENTRIES 5
+
+typedef struct ArgInfo {
+    int numArgs;		/* Number of argument words in command. */
+    char **startArray;		/* Array of pointers to the first character
+				 * of each argument word. */
+    char **endArray;		/* Array of pointers to the last character
+				 * of each argument word. */
+    int allocArgs;		/* Number of array entries currently
+				 * allocated. */
+    int mallocedArrays;		/* 1 if the arrays were expanded and
+				 * wordStartArray/wordEndArray point into
+				 * the heap, else 0. */
+    char *staticStartSpace[ARGINFO_INIT_ENTRIES];
+                                /* Initial storage for word start array. */
+    char *staticEndSpace[ARGINFO_INIT_ENTRIES];
+                                /* Initial storage for word end array. */
+} ArgInfo;
+
+/*
+ * Compilation of some Tcl constructs such as if commands and the logical or
+ * (||) and logical and (&&) operators in expressions requires the
+ * generation of forward jumps. Since the PC target of these jumps isn't
+ * known when the jumps are emitted, we record the offset of each jump in an
+ * array of JumpFixup structures. There is one array for each sequence of
+ * jumps to one target PC. When we learn the target PC, we update the jumps
+ * with the correct distance. Also, if the distance is too great (> 127
+ * bytes), we replace the single-byte jump with a four byte jump
+ * instruction, move the instructions after the jump down, and update the
+ * code offsets for any commands between the jump and the target.
+ */
+
+typedef enum {
+    TCL_UNCONDITIONAL_JUMP,
+    TCL_TRUE_JUMP,
+    TCL_FALSE_JUMP
+} TclJumpType;
+
+typedef struct JumpFixup {
+    TclJumpType jumpType;	/* Indicates the kind of jump. */
+    int codeOffset;		/* Offset of the first byte of the one-byte
+				 * forward jump's code. */
+    int cmdIndex;		/* Index of the first command after the one
+				 * for which the jump was emitted. Used to
+				 * update the code offsets for subsequent
+				 * commands if the two-byte jump at jumpPc
+				 * must be replaced with a five-byte one. */
+    int excRangeIndex;		/* Index of the first range entry in the
+				 * ExceptionRange array after the current
+				 * one. This field is used to adjust the
+				 * code offsets in subsequent ExceptionRange
+				 * records when a jump is grown from 2 bytes
+				 * to 5 bytes. */
+} JumpFixup;
+
+#define JUMPFIXUP_INIT_ENTRIES    10
+
+typedef struct JumpFixupArray {
+    JumpFixup *fixup;		/* Points to start of jump fixup array. */
+    int next;			/* Index of next free array entry. */
+    int end;			/* Index of last usable entry in array. */
+    int mallocedArray;		/* 1 if array was expanded and fixups points
+				 * into the heap, else 0. */
+    JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
+				/* Initial storage for jump fixup array. */
+} JumpFixupArray;
+
+/*
+ * The structure describing one variable list of a foreach command. Note
+ * that only foreach commands inside procedure bodies are compiled inline so
+ * a ForeachVarList structure always describes local variables. Furthermore,
+ * only scalar variables are supported for inline-compiled foreach loops.
+ */
+
+typedef struct ForeachVarList {
+    int numVars;		/* The number of variables in the list. */
+    int varIndexes[1];		/* An array of the indexes ("slot numbers")
+				 * for each variable in the procedure's
+				 * array of local variables. Only scalar
+				 * variables are supported. The actual
+				 * size of this field will be large enough
+				 * to numVars indexes. THIS MUST BE THE
+				 * LAST FIELD IN THE STRUCTURE! */
+} ForeachVarList;
+
+/*
+ * Structure used to hold information about a foreach command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct ForeachInfo {
+    int numLists;		/* The number of both the variable and value
+				 * lists of the foreach command. */
+    int firstListTmp;		/* The slot number of the first temporary
+				 * variable holding the lists themselves. */
+    int loopIterNumTmp;		/* The slot number of the temp var holding
+				 * the count of times the loop body has been
+				 * executed. This is used to determine which
+				 * list element to assign each loop var. */
+    ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
+				 * structures describing each var list. The
+				 * actual size of this field will be large
+				 * enough to numVars indexes. THIS MUST BE
+				 * THE LAST FIELD IN THE STRUCTURE! */
+} ForeachInfo;
+
+/*
+ * Structure containing a cached pointer to a command that is the result
+ * of resolving the command's name in some namespace. It is the internal
+ * representation for a cmdName object. It contains the pointer along
+ * with some information that is used to check the pointer's validity.
+ */
+
+typedef struct ResolvedCmdName {
+    Command *cmdPtr;		/* A cached Command pointer. */
+    Namespace *refNsPtr;	/* Points to the namespace containing the
+				 * reference (not the namespace that
+				 * contains the referenced command). */
+    long refNsId;		/* refNsPtr's unique namespace id. Used to
+				 * verify that refNsPtr is still valid
+				 * (e.g., it's possible that the cmd's
+				 * containing namespace was deleted and a
+				 * new one created at the same address). */
+    int refNsCmdEpoch;		/* Value of the referencing namespace's
+				 * cmdRefEpoch when the pointer was cached.
+				 * Before using the cached pointer, we check
+				 * if the namespace's epoch was incremented;
+				 * if so, this cached pointer is invalid. */
+    int cmdEpoch;		/* Value of the command's cmdEpoch when this
+				 * pointer was cached. Before using the
+				 * cached pointer, we check if the cmd's
+				 * epoch was incremented; if so, the cmd was
+				 * renamed, deleted, hidden, or exposed, and
+				 * so the pointer is invalid. */
+    int refCount;		/* Reference count: 1 for each cmdName
+				 * object that has a pointer to this
+				 * ResolvedCmdName structure as its internal
+				 * rep. This structure can be freed when
+				 * refCount becomes zero. */
+} ResolvedCmdName;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl bytecode compilation and execution
+ * modules but not used outside:
+ *----------------------------------------------------------------
+ */
+
+EXTERN void		TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
+EXTERN int		TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+EXTERN int		TclCompileQuotes _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int termChar,
+			    int flags, CompileEnv *envPtr));
+EXTERN int		TclCompileString _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+EXTERN int		TclCompileDollarVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *lastChar, int flags,
+			    CompileEnv *envPtr));
+EXTERN int		TclCreateAuxData _ANSI_ARGS_((
+			    ClientData clientData, AuxDataDupProc *dupProc,
+			    AuxDataFreeProc *freeProc, CompileEnv *envPtr));
+EXTERN ExecEnv *	TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
+EXTERN void		TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
+			    TclJumpType jumpType, JumpFixup *jumpFixupPtr));
+EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
+			    unsigned char *pc, int catchOnly,
+			    ByteCode* codePtr));
+EXTERN int		TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
+			    ByteCode *codePtr));
+EXTERN void		TclExpandCodeArray _ANSI_ARGS_((
+                            CompileEnv *envPtr));
+EXTERN void		TclExpandJumpFixupArray _ANSI_ARGS_((
+                            JumpFixupArray *fixupArrayPtr));
+EXTERN int		TclFixupForwardJump _ANSI_ARGS_((
+			    CompileEnv *envPtr, JumpFixup *jumpFixupPtr,
+			    int jumpDist, int distThreshold));
+EXTERN void		TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr));
+EXTERN void		TclFreeJumpFixupArray _ANSI_ARGS_((
+  			    JumpFixupArray *fixupArrayPtr));
+EXTERN int		TclGetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
+        		    ByteCode* codePtr));
+EXTERN void		TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    CompileEnv *envPtr));
+EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
+			    CompileEnv *envPtr, char *string));
+EXTERN void		TclInitJumpFixupArray _ANSI_ARGS_((
+			    JumpFixupArray *fixupArrayPtr));
+EXTERN int		TclObjIndexForString _ANSI_ARGS_((char *start,
+			    int length, int allocStrRep, int inHeap,
+			    CompileEnv *envPtr));
+EXTERN int		TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
+			    unsigned char *pc));
+EXTERN void		TclPrintSource _ANSI_ARGS_((FILE *outFile,
+			    char *string, int maxChars));
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by Tcl bytecode compilation and execution modules
+ * inside the Tcl core but not used outside.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Macros to ensure there is enough room in a CompileEnv's code array.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclEnsureCodeSpace1 _ANSI_ARGS_((CompileEnv *envPtr));
+ * EXTERN void	TclEnsureCodeSpace _ANSI_ARGS_((int nBytes,
+ *		    CompileEnv *envPtr));
+ */
+
+#define TclEnsureCodeSpace1(envPtr) \
+    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
+        TclExpandCodeArray(envPtr)
+
+#define TclEnsureCodeSpace(nBytes, envPtr) \
+    if (((envPtr)->codeNext + nBytes) > (envPtr)->codeEnd) \
+        TclExpandCodeArray(envPtr)
+
+/*
+ * Macro to emit an opcode byte into a CompileEnv's code array.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void	TclEmitOpcode _ANSI_ARGS_((unsigned char op,
+ *		    CompileEnv *envPtr));
+ */
+
+#define TclEmitOpcode(op, envPtr) \
+    TclEnsureCodeSpace1(envPtr); \
+    *(envPtr)->codeNext++ = (unsigned char) (op)
+
+/*
+ * Macros to emit a (signed or unsigned) int operand. The two variants
+ * depend on the number of bytes needed for the int. Four byte integers
+ * are stored in "big-endian" order with the high order byte stored at
+ * the lowest address. The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ * EXTERN void	TclEmitInt4 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ */
+
+#define TclEmitInt1(i, envPtr) \
+    TclEnsureCodeSpace(1, (envPtr)); \
+    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+
+#define TclEmitInt4(i, envPtr) \
+    TclEnsureCodeSpace(4, (envPtr)); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 24); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 16); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >>  8); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i)      )
+
+/*
+ * Macros to emit an instruction with signed or unsigned int operands.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i, 
+ *		    CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i, 
+ *		    CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstUInt1 _ANSI_ARGS_((unsigned char op,
+ *		    unsigned int i, CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstUInt4 _ANSI_ARGS_((unsigned char op,
+ *		    unsigned int i, CompileEnv *envPtr));
+ */
+
+#define TclEmitInstInt1(op, i, envPtr) \
+    TclEnsureCodeSpace(2, (envPtr)); \
+    *(envPtr)->codeNext++ = (unsigned char) (op); \
+    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+
+#define TclEmitInstInt4(op, i, envPtr) \
+    TclEnsureCodeSpace(5, (envPtr)); \
+    *(envPtr)->codeNext++ = (unsigned char) (op); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 24); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 16); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >>  8); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i)      )
+    
+#define TclEmitInstUInt1(op, i, envPtr) \
+    TclEmitInstInt1((op), (i), (envPtr))
+
+#define TclEmitInstUInt4(op, i, envPtr) \
+    TclEmitInstInt4((op), (i), (envPtr))
+    
+/*
+ * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
+ * object's one or four byte array index into the CompileEnv's code
+ * array. These support, respectively, a maximum of 256 (2^8) and 2^32
+ * objects in a CompileEnv. The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void	TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr));
+ */
+
+#define TclEmitPush(objIndex, envPtr) \
+    if ((objIndex) <= 255) { \
+	TclEmitInstUInt1(INST_PUSH1, (objIndex), (envPtr)); \
+    } else { \
+	TclEmitInstUInt4(INST_PUSH4, (objIndex), (envPtr)); \
+    }
+
+/*
+ * Macros to update a (signed or unsigned) integer starting at a bytecode
+ * pc. The two variants depend on the number of bytes. The ANSI C
+ * "prototypes" for these macros are:
+ *
+ * EXTERN void	TclUpdateInt1AtPc _ANSI_ARGS_((int i, unsigned char *pc));
+ * EXTERN void	TclUpdateInt4AtPc _ANSI_ARGS_((int i, unsigned char *pc));
+ */
+    
+#define TclUpdateInt1AtPc(i, pc) \
+    *(pc)   = (unsigned char) ((unsigned int) (i))
+    
+#define TclUpdateInt4AtPc(i, pc) \
+    *(pc)   = (unsigned char) ((unsigned int) (i) >> 24); \
+    *(pc+1) = (unsigned char) ((unsigned int) (i) >> 16); \
+    *(pc+2) = (unsigned char) ((unsigned int) (i) >>  8); \
+    *(pc+3) = (unsigned char) ((unsigned int) (i)      )
+
+/*
+ * Macros to update instructions at a particular pc with a new op code
+ * and a (signed or unsigned) int operand. The ANSI C "prototypes" for
+ * these macros are:
+ *
+ * EXTERN void	TclUpdateInstInt1AtPc _ANSI_ARGS_((unsigned char op, int i,
+ *		    unsigned char *pc));
+ * EXTERN void	TclUpdateInstInt4AtPc _ANSI_ARGS_((unsigned char op, int i,
+ *		    unsigned char *pc));
+ */
+
+#define TclUpdateInstInt1AtPc(op, i, pc) \
+    *(pc) = (unsigned char) (op); \
+    TclUpdateInt1AtPc((i), ((pc)+1))
+
+#define TclUpdateInstInt4AtPc(op, i, pc) \
+    *(pc) = (unsigned char) (op); \
+    TclUpdateInt4AtPc((i), ((pc)+1))
+    
+/*
+ * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
+ * (GET_UINT{1,2}) from a code pc pointer. There are two variants for each
+ * return type that depend on the number of bytes fetched from the code
+ * sequence. The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int	        TclGetInt1AtPc  _ANSI_ARGS_((unsigned char *pc));
+ * EXTERN int	        TclGetInt4AtPc  _ANSI_ARGS_((unsigned char *pc));
+ * EXTERN unsigned int	TclGetUInt1AtPc _ANSI_ARGS_((unsigned char *pc));
+ * EXTERN unsigned int	TclGetUInt4AtPc _ANSI_ARGS_((unsigned char *pc));
+ */
+
+/*
+ * The TclGetInt1AtPc macro is tricky because we want to do sign
+ * extension on the 1-byte value. Unfortunately the "char" type isn't
+ * signed on all platforms so sign-extension doesn't always happen
+ * automatically.  Sometimes we can explicitly declare the pointer to be
+ * signed, but other times we have to explicitly sign-extend the value
+ * in software.
+ */
+
+#ifndef __CHAR_UNSIGNED__
+#   define TclGetInt1AtPc(pc) ((int) *((char *) pc))
+#else
+#   ifdef HAVE_SIGNED_CHAR
+#	define TclGetInt1AtPc(pc) ((int) *((signed char *) pc))
+#    else
+#	define TclGetInt1AtPc(pc) (((int) *((char *) pc)) \
+		| ((*(pc) & 0200) ? (-256) : 0))
+#    endif
+#endif
+
+#define TclGetInt4AtPc(pc) (((int) TclGetInt1AtPc(pc) << 24) | \
+		                  (*((pc)+1) << 16) | \
+				  (*((pc)+2) <<  8) | \
+				  (*((pc)+3)))
+
+#define TclGetUInt1AtPc(pc) ((unsigned int) *(pc))
+#define TclGetUInt4AtPc(pc) ((unsigned int) (*(pc)     << 24) | \
+		                            (*((pc)+1) << 16) | \
+				            (*((pc)+2) <<  8) | \
+				            (*((pc)+3)))
+
+/*
+ * Macros used to compute the minimum and maximum of two integers.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int  TclMin _ANSI_ARGS_((int i, int j));
+ * EXTERN int  TclMax _ANSI_ARGS_((int i, int j));
+ */
+
+#define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
+#define TclMax(i, j)   ((((int) i) > ((int) j))? (i) : (j))
+
+/*
+ * Macro used to compute the offset of the current instruction in the
+ * bytecode instruction stream. The ANSI C "prototypes" for this macro is:
+ *
+ * EXTERN int  TclCurrCodeOffset _ANSI_ARGS_((void));
+ */
+
+#define TclCurrCodeOffset()  ((envPtr)->codeNext - (envPtr)->codeStart)
+
+/*
+ * Upper bound for legal jump distances. Checked during compilation if
+ * debugging.
+ */
+
+#define MAX_JUMP_DIST   5000
+
+#endif /* _TCLCOMPILATION */
+
diff --git a/contrib/tcl/generic/tclDate.c b/contrib/tcl/generic/tclDate.c
index abcafcb..51f7475 100644
--- a/contrib/tcl/generic/tclDate.c
+++ b/contrib/tcl/generic/tclDate.c
@@ -2,15 +2,15 @@
  * tclDate.c --
  *
  *	This file is generated from a yacc grammar defined in
- *	the file tclGetDate.y
+ *	the file tclGetDate.y.  It should not be edited directly.
  *
  * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * @(#) tclDate.c 1.25 96/07/23 16:10:50
+ * @(#) tclDate.c 1.32 97/02/03 14:54:37
  */
 
 #include "tclInt.h"
@@ -26,6 +26,15 @@
 #   define END_OF_TIME     2037
 #endif
 
+/*
+ * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
+ * I don't know how universal this is; K&R II, the NetBSD manpages, and
+ * ../compat/strftime.c all agree that tm_year is the year-1900.  However,
+ * some systems may have a different value.  This #define should be the
+ * same as in ../compat/strftime.c.
+ */
+#define TM_YEAR_BASE 1900
+
 #define HOUR(x)         ((int) (60 * x))
 #define SECSPERDAY      (24L * 60L * 60L)
 
@@ -85,44 +94,19 @@ static time_t   TclDateRelSeconds;
 /*
  * Prototypes of internal functions.
  */
-static void
-TclDateerror _ANSI_ARGS_((char *s));
-
-static time_t
-ToSeconds _ANSI_ARGS_((time_t      Hours,
-                       time_t      Minutes,
-                       time_t      Seconds,
-                       MERIDIAN    Meridian));
-
-static int
-Convert _ANSI_ARGS_((time_t      Month,
-                     time_t      Day,
-                     time_t      Year,
-                     time_t      Hours,
-                     time_t      Minutes,
-                     time_t      Seconds,
-                     MERIDIAN    Meridia,
-                     DSTMODE     DSTmode,
-                     time_t     *TimePtr));
-
-static time_t
-DSTcorrect _ANSI_ARGS_((time_t      Start,
-                        time_t      Future));
-
-static time_t
-RelativeDate _ANSI_ARGS_((time_t      Start,
-                          time_t      DayOrdinal,
-                          time_t      DayNumber));
-
-static int
-RelativeMonth _ANSI_ARGS_((time_t      Start,
-                           time_t      RelMonth,
-                           time_t     *TimePtr));
-static int
-LookupWord _ANSI_ARGS_((char  *buff));
-
-static int
-TclDatelex _ANSI_ARGS_((void));
+static void	TclDateerror _ANSI_ARGS_((char *s));
+static time_t	ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes,
+		    time_t Seconds, MERIDIAN Meridian));
+static int	Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year,
+		    time_t Hours, time_t Minutes, time_t Seconds,
+		    MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr));
+static time_t	DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future));
+static time_t	RelativeDate _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
+		    time_t DayNumber));
+static int	RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth,
+		    time_t *TimePtr));
+static int	LookupWord _ANSI_ARGS_((char *buff));
+static int	TclDatelex _ANSI_ARGS_((void));
 
 int
 TclDateparse _ANSI_ARGS_((void));
@@ -431,14 +415,10 @@ Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
     static int  DaysInMonth[12] = {
         31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
     };
-    time_t      tod;
-    time_t      Julian;
-    int         i;
-
-    if (Year < 0)
-        Year = -Year;
-    if (Year < 100)
-        Year += 1900;
+    time_t tod;
+    time_t Julian;
+    int i;
+
     DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0)
                     ? 29 : 28;
     if (Month < 1 || Month > 12
@@ -501,27 +481,44 @@ RelativeDate(Start, DayOrdinal, DayNumber)
 
 static int
 RelativeMonth(Start, RelMonth, TimePtr)
-    time_t      Start;
-    time_t      RelMonth;
-    time_t     *TimePtr;
+    time_t Start;
+    time_t RelMonth;
+    time_t *TimePtr;
 {
-    struct tm   *tm;
-    time_t      Month;
-    time_t      Year;
-    time_t      Julian;
+    struct tm *tm;
+    time_t Month;
+    time_t Year;
+    time_t Julian;
+    int result;
 
     if (RelMonth == 0) {
         *TimePtr = 0;
         return 0;
     }
     tm = TclpGetDate(&Start, 0);
-    Month = 12 * tm->tm_year + tm->tm_mon + RelMonth;
+    Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
     Year = Month / 12;
     Month = Month % 12 + 1;
-    if (Convert(Month, (time_t)tm->tm_mday, Year,
-                (time_t)tm->tm_hour, (time_t)tm->tm_min, (time_t)tm->tm_sec,
-                MER24, DSTmaybe, &Julian) < 0)
-        return -1;
+    result = Convert(Month, (time_t) tm->tm_mday, Year,
+	    (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
+	    MER24, DSTmaybe, &Julian);
+    /*
+     * The following iteration takes into account the case were we jump
+     * into a "short month".  Far example, "one month from Jan 31" will
+     * fail because there is no Feb 31.  The code below will reduce the
+     * day and try converting the date until we succed or the date equals
+     * 28 (which always works unless the date is bad in another way).
+     */
+
+    while ((result != 0) && (tm->tm_mday > 28)) {
+	tm->tm_mday--;
+	result = Convert(Month, (time_t) tm->tm_mday, Year,
+		(time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
+		MER24, DSTmaybe, &Julian);
+    }
+    if (result != 0) {
+	return -1;
+    }
     *TimePtr = DSTcorrect(Start, Julian);
     return 0;
 }
@@ -531,18 +528,18 @@ static int
 LookupWord(buff)
     char                *buff;
 {
-    register char       *p;
-    register char       *q;
-    register TABLE      *tp;
-    int                 i;
-    int                 abbrev;
+    register char *p;
+    register char *q;
+    register TABLE *tp;
+    int i;
+    int abbrev;
 
     /*
      * Make it lowercase.
      */
     for (p = buff; *p; p++) {
-        if (isupper(*p)) {
-            *p = (char) tolower(*p);
+        if (isupper(UCHAR(*p))) {
+            *p = (char) tolower(UCHAR(*p));
 	}
     }
 
@@ -617,7 +614,7 @@ LookupWord(buff)
     /*
      * Military timezones.
      */
-    if (buff[1] == '\0' && isalpha(*buff)) {
+    if (buff[1] == '\0' && isalpha(UCHAR(*buff))) {
         for (tp = MilitaryTable; tp->name; tp++) {
             if (strcmp(buff, tp->name) == 0) {
                 TclDatelval.Number = tp->value;
@@ -630,19 +627,21 @@ LookupWord(buff)
      * Drop out any periods and try the timezone table again.
      */
     for (i = 0, p = q = buff; *q; q++)
-        if (*q != '.')
+        if (*q != '.') {
             *p++ = *q;
-        else
+        } else {
             i++;
+	}
     *p = '\0';
-    if (i)
+    if (i) {
         for (tp = TimezoneTable; tp->name; tp++) {
             if (strcmp(buff, tp->name) == 0) {
                 TclDatelval.Number = tp->value;
                 return tp->type;
             }
 	}
-
+    }
+    
     return tID;
 }
 
@@ -682,7 +681,7 @@ TclDatelex()
 	    }
             return sign ? tSNUMBER : tUNUMBER;
         }
-        if (isalpha(c)) {
+        if (isalpha(UCHAR(c))) {
             for (p = buff; isalpha(c = *TclDateInput++) || c == '.'; ) {
                 if (p < &buff[sizeof buff - 1]) {
                     *p++ = c;
@@ -715,19 +714,21 @@ TclDatelex()
 
 int
 TclGetDate(p, now, zone, timePtr)
-    char          *p;
-    unsigned long  now;
-    long           zone;
+    char *p;
+    unsigned long now;
+    long zone;
     unsigned long *timePtr;
 {
-    struct tm           *tm;
-    time_t              Start;
-    time_t              Time;
-    time_t              tod;
+    struct tm *tm;
+    time_t Start;
+    time_t Time;
+    time_t tod;
+    int thisyear;
 
     TclDateInput = p;
     tm = TclpGetDate((time_t *) &now, 0);
-    TclDateYear = tm->tm_year;
+    thisyear = tm->tm_year + TM_YEAR_BASE;
+    TclDateYear = thisyear;
     TclDateMonth = tm->tm_mon + 1;
     TclDateDay = tm->tm_mday;
     TclDateTimezone = zone;
@@ -755,14 +756,35 @@ TclGetDate(p, now, zone, timePtr)
     }
     
     if (TclDateHaveDate || TclDateHaveTime || TclDateHaveDay) {
-        if (Convert(TclDateMonth, TclDateDay, TclDateYear, TclDateHour, TclDateMinutes, TclDateSeconds,
-                    TclDateMeridian, TclDateDSTmode, &Start) < 0)
+	if (TclDateYear < 0) {
+	    TclDateYear = -TclDateYear;
+	}
+	/*
+	 * The following line handles years that are specified using
+	 * only two digits.  The line of code below implements a policy
+	 * defined by the X/Open workgroup on the millinium rollover.
+	 * Note: some of those dates may not actually be valid on some
+	 * platforms.  The POSIX standard startes that the dates 70-99
+	 * shall refer to 1970-1999 and 00-38 shall refer to 2000-2038.
+	 * This later definition should work on all platforms.
+	 */
+
+	if (TclDateYear < 100) {
+	    if (TclDateYear >= 69) {
+		TclDateYear += 1900;
+	    } else {
+		TclDateYear += 2000;
+	    }
+	}
+	if (Convert(TclDateMonth, TclDateDay, TclDateYear, TclDateHour, TclDateMinutes, TclDateSeconds,
+		TclDateMeridian, TclDateDSTmode, &Start) < 0) {
             return -1;
-    }
-    else {
+	}
+    } else {
         Start = now;
-        if (!TclDateHaveRel)
+        if (!TclDateHaveRel) {
             Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec;
+	}
     }
 
     Start += TclDateRelSeconds;
@@ -1589,22 +1611,21 @@ case 37:{
             TclDateRelMonth += TclDatepvt[-0].Number;
         } break;
 case 38:{
-            if (TclDateHaveTime && TclDateHaveDate && !TclDateHaveRel)
-                TclDateYear = TclDatepvt[-0].Number;
-            else {
-                TclDateHaveTime++;
-                if (TclDatepvt[-0].Number < 100) {
-                    TclDateHour = TclDatepvt[-0].Number;
-                    TclDateMinutes = 0;
-                }
-                else {
-                    TclDateHour = TclDatepvt[-0].Number / 100;
-                    TclDateMinutes = TclDatepvt[-0].Number % 100;
-                }
-                TclDateSeconds = 0;
-                TclDateMeridian = MER24;
-            }
-        } break;
+	if (TclDateHaveTime && TclDateHaveDate && !TclDateHaveRel) {
+	    TclDateYear = TclDatepvt[-0].Number;
+	} else {
+	    TclDateHaveTime++;
+	    if (TclDatepvt[-0].Number < 100) {
+		TclDateHour = 0;
+		TclDateMinutes = TclDatepvt[-0].Number;
+	    } else {
+		TclDateHour = TclDatepvt[-0].Number / 100;
+		TclDateMinutes = TclDatepvt[-0].Number % 100;
+	    }
+	    TclDateSeconds = 0;
+	    TclDateMeridian = MER24;
+	}
+    } break;
 case 39:{
             TclDateval.Meridian = MER24;
         } break;
diff --git a/contrib/tcl/generic/tclEnv.c b/contrib/tcl/generic/tclEnv.c
index cfffefe..f619769 100644
--- a/contrib/tcl/generic/tclEnv.c
+++ b/contrib/tcl/generic/tclEnv.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclEnv.c 1.37 96/07/23 16:28:26
+ * SCCS: @(#) tclEnv.c 1.43 97/05/21 17:10:56
  */
 
 /*
@@ -40,7 +40,7 @@ typedef struct EnvInterp {
 				 * or zero. */
 } EnvInterp;
 
-static EnvInterp *firstInterpPtr;
+static EnvInterp *firstInterpPtr = NULL;
 				/* First in list of all managed interpreters,
 				 * or NULL if none. */
 
@@ -96,7 +96,9 @@ TclSetupEnv(interp)
 				 * managed. */
 {
     EnvInterp *eiPtr;
-    int i;
+    char *p, *p2;
+    Tcl_DString ds;
+    int i, sz;
 
     /*
      * First, initialize our environment-related information, if
@@ -108,6 +110,13 @@ TclSetupEnv(interp)
     }
 
     /*
+     * Next, initialize the DString we are going to use for copying
+     * the names of the environment variables.
+     */
+
+    Tcl_DStringInit(&ds);
+    
+    /*
      * Next, add the interpreter to the list of those that we manage.
      */
 
@@ -124,22 +133,38 @@ TclSetupEnv(interp)
 
     (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
     for (i = 0; ; i++) {
-	char *p, *p2;
-
 	p = environ[i];
 	if (p == NULL) {
 	    break;
 	}
 	for (p2 = p; *p2 != '='; p2++) {
-	    /* Empty loop body. */
+	    if (*p2 == 0) {
+		/*
+		 * This condition doesn't seem like it should ever happen,
+		 * but it does seem to happen occasionally under some
+		 * versions of Solaris; ignore the entry.
+		 */
+
+		goto nextEntry;
+	    }
 	}
-	*p2 = 0;
-	(void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
-	*p2 = '=';
+        sz = p2 - p;
+        Tcl_DStringSetLength(&ds, 0);
+        Tcl_DStringAppend(&ds, p, sz);
+	(void) Tcl_SetVar2(interp, "env", Tcl_DStringValue(&ds),
+                p2+1, TCL_GLOBAL_ONLY);
+	nextEntry:
+	continue;
     }
     Tcl_TraceVar2(interp, "env", (char *) NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
 	    EnvTraceProc, (ClientData) NULL);
+
+    /*
+     * Finally clean up the DString.
+     */
+
+    Tcl_DStringFree(&ds);
 }
 
 /*
@@ -557,9 +582,10 @@ EnvInit()
 #ifdef MAC_TCL
     environSize = TclMacCreateEnv();
 #else
-    char **newEnviron;
+    char **newEnviron, **oldEnviron;
     int i, length;
 
+    oldEnviron = environ;
     if (environSize != 0) {
 	return;
     }
@@ -575,7 +601,7 @@ EnvInit()
     }
     newEnviron[length] = NULL;
     environ = newEnviron;
-    Tcl_CreateExitHandler(EnvExitProc, (ClientData) NULL);
+    Tcl_CreateExitHandler(EnvExitProc, (ClientData) oldEnviron);
 #endif
 }
 
@@ -598,9 +624,10 @@ EnvInit()
 
 static void
 EnvExitProc(clientData)
-    ClientData clientData;		/* Not  used. */
+    ClientData clientData;	/* Old environment pointer -- restore this. */
 {
     char **p;
+    EnvInterp *eiPtr, *nextPtr;
 
     for (p = environ; *p != NULL; p++) {
 	ckfree(*p);
@@ -612,5 +639,12 @@ EnvExitProc(clientData)
      * doesn't choke on exit.
      */
 
-    environ = NULL;
+    environ = (char **) clientData;
+    environSize = 0;
+
+    for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = nextPtr) {
+	nextPtr = eiPtr->nextPtr;
+	ckfree((char *) eiPtr);
+    }
+    firstInterpPtr = NULL;
 }
diff --git a/contrib/tcl/generic/tclEvent.c b/contrib/tcl/generic/tclEvent.c
index 7a081c7..a503df7 100644
--- a/contrib/tcl/generic/tclEvent.c
+++ b/contrib/tcl/generic/tclEvent.c
@@ -1,177 +1,23 @@
 /* 
  * tclEvent.c --
  *
- *	This file provides basic event-managing facilities for Tcl,
- *	including an event queue, and mechanisms for attaching
- *	callbacks to certain events.
- *
- *	It also contains the command procedures for the commands
- *	"after", "vwait", and "update".
+ *	This file implements some general event related interfaces including
+ *	background errors, exit handlers, and the "vwait" and "update"
+ *	command procedures. 
  *
  * Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclEvent.c 1.128 96/07/23 16:12:34
+ * SCCS: @(#) tclEvent.c 1.152 97/05/21 07:06:19
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
 /*
- * For each file registered in a call to Tcl_CreateFileHandler,
- * there is one record of the following type.  All of these records
- * are chained together into a single list.
- */
-
-typedef struct FileHandler {
-    Tcl_File file;		/* Generic file handle for file. */
-    int mask;			/* Mask of desired events: TCL_READABLE, etc. */
-    int readyMask;		/* Events that were ready the last time that
-				 * FileHandlerCheckProc checked this file. */
-    Tcl_FileProc *proc;		/* Procedure to call, in the style of
-				 * Tcl_CreateFileHandler.  This is NULL
-				 * if the handler was created by
-				 * Tcl_CreateFileHandler2. */
-    ClientData clientData;	/* Argument to pass to proc. */
-    struct FileHandler *nextPtr;/* Next in list of all files we care
-				 * about (NULL for end of list). */
-} FileHandler;
-
-static FileHandler *firstFileHandlerPtr = (FileHandler *) NULL;
-				/* List of all file handlers. */
-static int fileEventSourceCreated = 0;
-				/* Non-zero means that the file event source
-				 * hasn't been registerd with the Tcl
-				 * notifier yet. */
-
-/*
- * The following structure is what is added to the Tcl event queue when
- * file handlers are ready to fire.
- */
-
-typedef struct FileHandlerEvent {
-    Tcl_Event header;		/* Information that is standard for
-				 * all events. */
-    Tcl_File file;		/* File descriptor that is ready.  Used
-				 * to find the FileHandler structure for
-				 * the file (can't point directly to the
-				 * FileHandler structure because it could
-				 * go away while the event is queued). */
-} FileHandlerEvent;
-
-/*
- * For each timer callback that's pending (either regular or "modal"),
- * there is one record of the following type.  The normal handlers
- * (created by Tcl_CreateTimerHandler) are chained together in a
- * list sorted by time (earliest event first).
- */
-
-typedef struct TimerHandler {
-    Tcl_Time time;			/* When timer is to fire. */
-    Tcl_TimerProc *proc;		/* Procedure to call. */
-    ClientData clientData;		/* Argument to pass to proc. */
-    Tcl_TimerToken token;		/* Identifies event so it can be
-					 * deleted.  Not used in modal
-					 * timeouts. */
-    struct TimerHandler *nextPtr;	/* Next event in queue, or NULL for
-					 * end of queue. */
-} TimerHandler;
-
-static TimerHandler *firstTimerHandlerPtr = NULL;
-					/* First event in queue. */
-static int timerEventSourceCreated = 0;	/* 0 means that the timer event source
-					 * hasn't yet been registered with the
-					 * Tcl notifier. */
-
-/*
- * The information below describes a stack of modal timeouts managed by
- * Tcl_CreateModalTimer and Tcl_DeleteModalTimer.  Only the first element
- * in the list is used at any given time.
- */
-
-static TimerHandler *firstModalHandlerPtr = NULL;
-
-/*
- * The following structure is what's added to the Tcl event queue when
- * timer handlers are ready to fire.
- */
-
-typedef struct TimerEvent {
-    Tcl_Event header;			/* Information that is standard for
-					 * all events. */
-    Tcl_Time time;			/* All timer events that specify this
-					 * time or earlier are ready
-                                         * to fire. */
-} TimerEvent;
-
-/*
- * There is one of the following structures for each of the
- * handlers declared in a call to Tcl_DoWhenIdle.  All of the
- * currently-active handlers are linked together into a list.
- */
-
-typedef struct IdleHandler {
-    Tcl_IdleProc (*proc);	/* Procedure to call. */
-    ClientData clientData;	/* Value to pass to proc. */
-    int generation;		/* Used to distinguish older handlers from
-				 * recently-created ones. */
-    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
-} IdleHandler;
-
-static IdleHandler *idleList = NULL;
-				/* First in list of all idle handlers. */
-static IdleHandler *lastIdlePtr = NULL;
-				/* Last in list (or NULL for empty list). */
-static int idleGeneration = 0;	/* Used to fill in the "generation" fields
-				 * of IdleHandler structures.  Increments
-				 * each time Tcl_DoOneEvent starts calling
-				 * idle handlers, so that all old handlers
-				 * can be called without calling any of the
-				 * new ones created by old ones. */
-
-/*
- * The data structure below is used by the "after" command to remember
- * the command to be executed later.  All of the pending "after" commands
- * for an interpreter are linked together in a list.
- */
-
-typedef struct AfterInfo {
-    struct AfterAssocData *assocPtr;
-				/* Pointer to the "tclAfter" assocData for
-				 * the interp in which command will be
-				 * executed. */
-    char *command;		/* Command to execute.  Malloc'ed, so must
-				 * be freed when structure is deallocated. */
-    int id;			/* Integer identifier for command;  used to
-				 * cancel it. */
-    Tcl_TimerToken token;	/* Used to cancel the "after" command.  NULL
-				 * means that the command is run as an
-				 * idle handler rather than as a timer
-				 * handler.  NULL means this is an "after
-				 * idle" handler rather than a
-                                 * timer handler. */
-    struct AfterInfo *nextPtr;	/* Next in list of all "after" commands for
-				 * this interpreter. */
-} AfterInfo;
-
-/*
- * One of the following structures is associated with each interpreter
- * for which an "after" command has ever been invoked.  A pointer to
- * this structure is stored in the AssocData for the "tclAfter" key.
- */
-
-typedef struct AfterAssocData {
-    Tcl_Interp *interp;		/* The interpreter for which this data is
-				 * registered. */
-    AfterInfo *firstAfterPtr;	/* First in list of all "after" commands
-				 * still pending for this interpreter, or
-				 * NULL if none. */
-} AfterAssocData;
-
-/*
  * The data structure below is used to report background errors.  One
  * such structure is allocated for each error;  it holds information
  * about the interpreter and the error until bgerror can be invoked
@@ -225,25 +71,6 @@ static ExitHandler *firstExitPtr = NULL;
 				 * application. */
 
 /*
- * Structures of the following type are used during the execution
- * of Tcl_WaitForFile, to keep track of the file and timeout.
- */
-
-typedef struct FileWait {
-    Tcl_File file;		/* File to wait on. */
-    int mask;			/* Conditions to wait for (TCL_READABLE,
-				 * etc.) */
-    int timeout;		/* Original "timeout" argument to
-				 * Tcl_WaitForFile. */
-    Tcl_Time abortTime;		/* Time at which to abort the wait. */
-    int present;		/* Conditions present on the file during
-				 * the last time through the event loop. */
-    int done;			/* Non-zero means we're done:  either one of
-				 * the desired conditions is present or the
-				 * timeout period has elapsed. */
-} FileWait;
-
-/*
  * The following variable is a "secret" indication to Tcl_Exit that
  * it should dump out the state of memory before exiting.  If the
  * value is non-NULL, it gives the name of the file in which to
@@ -253,969 +80,26 @@ typedef struct FileWait {
 char *tclMemDumpFileName = NULL;
 
 /*
+ * This variable is set to 1 when Tcl_Exit is called, and at the end of
+ * its work, it is reset to 0. The variable is checked by TclInExit() to
+ * allow different behavior for exit-time processing, e.g. in closing of
+ * files and pipes.
+ */
+
+static int tclInExit = 0;
+
+/*
  * Prototypes for procedures referenced only in this file:
  */
 
-static void		AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp));
-static void		AfterProc _ANSI_ARGS_((ClientData clientData));
 static void		BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp));
-static void		FileHandlerCheckProc _ANSI_ARGS_((
-			    ClientData clientData, int flags));
-static int		FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
-			    int flags));
-static void		FileHandlerExitProc _ANSI_ARGS_((ClientData data));
-static void		FileHandlerSetupProc _ANSI_ARGS_((
-			    ClientData clientData, int flags));
-static void		FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
-static AfterInfo *	GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
-			    char *string));
 static void		HandleBgErrors _ANSI_ARGS_((ClientData clientData));
-static void		TimerHandlerCheckProc _ANSI_ARGS_((
-			    ClientData clientData, int flags));
-static int		TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
-			    int flags));
-static void		TimerHandlerExitProc _ANSI_ARGS_((ClientData data));
-static void		TimerHandlerSetupProc _ANSI_ARGS_((
-			    ClientData clientData, int flags));
 static char *		VwaitVarProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, char *name1, char *name2,
 			    int flags));
 
 /*
- *--------------------------------------------------------------
- *
- * Tcl_CreateFileHandler --
- *
- *	Arrange for a given procedure to be invoked whenever
- *	a given file becomes readable or writable.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	From now on, whenever the I/O channel given by file becomes
- *	ready in the way indicated by mask, proc will be invoked.
- *	See the manual entry for details on the calling sequence
- *	to proc.  If file is already registered then the old mask
- *	and proc and clientData values will be replaced with
- *	new ones.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_CreateFileHandler(file, mask, proc, clientData)
-    Tcl_File file;		/* Handle of stream to watch. */
-    int mask;			/* OR'ed combination of TCL_READABLE,
-				 * TCL_WRITABLE, and TCL_EXCEPTION:
-				 * indicates conditions under which
-				 * proc should be called. */
-    Tcl_FileProc *proc;		/* Procedure to call for each
-				 * selected event. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
-{
-    register FileHandler *filePtr;
-
-    if (!fileEventSourceCreated) {
-	fileEventSourceCreated = 1;
-	Tcl_CreateEventSource(FileHandlerSetupProc, FileHandlerCheckProc,
-		(ClientData) NULL);
-        Tcl_CreateExitHandler(FileHandlerExitProc, (ClientData) NULL);
-    }
-
-    /*
-     * Make sure the file isn't already registered.  Create a
-     * new record in the normal case where there's no existing
-     * record.
-     */
-
-    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
-	    filePtr = filePtr->nextPtr) {
-	if (filePtr->file == file) {
-	    break;
-	}
-    }
-    if (filePtr == NULL) {
-	filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
-	filePtr->file = file;
-	filePtr->nextPtr = firstFileHandlerPtr;
-	firstFileHandlerPtr = filePtr;
-    }
-
-    /*
-     * The remainder of the initialization below is done regardless
-     * of whether or not this is a new record or a modification of
-     * an old one.
-     */
-
-    filePtr->mask = mask;
-    filePtr->readyMask = 0;
-    filePtr->proc = proc;
-    filePtr->clientData = clientData;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_DeleteFileHandler --
- *
- *	Cancel a previously-arranged callback arrangement for
- *	a file.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If a callback was previously registered on file, remove it.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_DeleteFileHandler(file)
-    Tcl_File file;		/* Stream id for which to remove
-				 * callback procedure. */
-{
-    FileHandler *filePtr, *prevPtr;
-
-    /*
-     * Find the entry for the given file (and return if there
-     * isn't one).
-     */
-
-    for (prevPtr = NULL, filePtr = firstFileHandlerPtr; ;
-	    prevPtr = filePtr, filePtr = filePtr->nextPtr) {
-	if (filePtr == NULL) {
-	    return;
-	}
-	if (filePtr->file == file) {
-	    break;
-	}
-    }
-
-    /*
-     * Clean up information in the callback record.
-     */
-
-    if (prevPtr == NULL) {
-	firstFileHandlerPtr = filePtr->nextPtr;
-    } else {
-	prevPtr->nextPtr = filePtr->nextPtr;
-    }
-    ckfree((char *) filePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileHandlerExitProc --
- *
- *	Cleanup procedure to delete the file event source during exit
- *	cleanup.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Destroys the file event source.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static void
-FileHandlerExitProc(clientData)
-    ClientData clientData;		/* Not used. */
-{
-    Tcl_DeleteEventSource(FileHandlerSetupProc, FileHandlerCheckProc,
-            (ClientData) NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileHandlerSetupProc --
- *
- *	This procedure is part of the "event source" for file handlers.
- *	It is invoked by Tcl_DoOneEvent before it calls select (or
- *	whatever it uses to wait).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Tells the notifier which files should be waited for.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileHandlerSetupProc(clientData, flags)
-    ClientData clientData;		/* Not used. */
-    int flags;				/* Flags passed to Tk_DoOneEvent:
-					 * if it doesn't include
-					 * TCL_FILE_EVENTS then we do
-					 * nothing. */
-{
-    FileHandler *filePtr;
-
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return;
-    }
-    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
-	    filePtr = filePtr->nextPtr) {
-	if (filePtr->mask != 0) {
-	    Tcl_WatchFile(filePtr->file, filePtr->mask);
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileHandlerCheckProc --
- *
- *	This procedure is the second part of the "event source" for
- *	file handlers.  It is invoked by Tcl_DoOneEvent after it calls
- *	select (or whatever it uses to wait for events).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Makes entries on the Tcl event queue for each file that is
- *	now ready.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileHandlerCheckProc(clientData, flags)
-    ClientData clientData;		/* Not used. */
-    int flags;				/* Flags passed to Tk_DoOneEvent:
-					 * if it doesn't include 
-					 * TCL_FILE_EVENTS then we do
-					 * nothing. */
-{
-    FileHandler *filePtr;
-    FileHandlerEvent *fileEvPtr;
-
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return;
-    }
-    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
-	    filePtr = filePtr->nextPtr) {
-	if (filePtr->mask != 0) {
-	    filePtr->readyMask = Tcl_FileReady(filePtr->file, filePtr->mask);
-	    if (filePtr->readyMask != 0) {
-		fileEvPtr = (FileHandlerEvent *) ckalloc(
-			sizeof(FileHandlerEvent));
-		fileEvPtr->header.proc = FileHandlerEventProc;
-		fileEvPtr->file = filePtr->file;
-		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
-	    }
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileHandlerEventProc --
- *
- *	This procedure is called by Tcl_DoOneEvent when a file event
- *	reaches the front of the event queue.  This procedure is responsible
- *	for actually handling the event by invoking the callback for the
- *	file handler.
- *
- * Results:
- *	Returns 1 if the event was handled, meaning it should be removed
- *	from the queue.  Returns 0 if the event was not handled, meaning
- *	it should stay on the queue.  The only time the event isn't
- *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
- *
- * Side effects:
- *	Whatever the file handler's callback procedure does
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileHandlerEventProc(evPtr, flags)
-    Tcl_Event *evPtr;		/* Event to service. */
-    int flags;			/* Flags that indicate what events to
-				 * handle, such as TCL_FILE_EVENTS. */
-{
-    FileHandler *filePtr;
-    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
-    int mask;
-
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return 0;
-    }
-
-    /*
-     * Search through the file handlers to find the one whose handle matches
-     * the event.  We do this rather than keeping a pointer to the file
-     * handler directly in the event, so that the handler can be deleted
-     * while the event is queued without leaving a dangling pointer.
-     */
-
-    for (filePtr = firstFileHandlerPtr; filePtr != NULL;
-	    filePtr = filePtr->nextPtr) {
-	if (filePtr->file != fileEvPtr->file) {
-	    continue;
-	}
-
-	/*
-	 * The code is tricky for two reasons:
-	 * 1. The file handler's desired events could have changed
-	 *    since the time when the event was queued, so AND the
-	 *    ready mask with the desired mask.
-	 * 2. The file could have been closed and re-opened since
-	 *    the time when the event was queued.  This is why the
-	 *    ready mask is stored in the file handler rather than
-	 *    the queued event:  it will be zeroed when a new
-	 *    file handler is created for the newly opened file.
-	 */
-
-	mask = filePtr->readyMask & filePtr->mask;
-	filePtr->readyMask = 0;
-	if (mask != 0) {
-	    (*filePtr->proc)(filePtr->clientData, mask);
-	}
-	break;
-    }
-    return 1;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_CreateTimerHandler --
- *
- *	Arrange for a given procedure to be invoked at a particular
- *	time in the future.
- *
- * Results:
- *	The return value is a token for the timer event, which
- *	may be used to delete the event before it fires.
- *
- * Side effects:
- *	When milliseconds have elapsed, proc will be invoked
- *	exactly once.
- *
- *--------------------------------------------------------------
- */
-
-Tcl_TimerToken
-Tcl_CreateTimerHandler(milliseconds, proc, clientData)
-    int milliseconds;		/* How many milliseconds to wait
-				 * before invoking proc. */
-    Tcl_TimerProc *proc;	/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
-{
-    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
-    static int id = 0;
-
-    if (!timerEventSourceCreated) {
-	timerEventSourceCreated = 1;
-	Tcl_CreateEventSource(TimerHandlerSetupProc, TimerHandlerCheckProc,
-		(ClientData) NULL);
-        Tcl_CreateExitHandler(TimerHandlerExitProc, (ClientData) NULL);
-    }
-
-    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
-
-    /*
-     * Compute when the event should fire.
-     */
-
-    TclpGetTime(&timerHandlerPtr->time);
-    timerHandlerPtr->time.sec += milliseconds/1000;
-    timerHandlerPtr->time.usec += (milliseconds%1000)*1000;
-    if (timerHandlerPtr->time.usec >= 1000000) {
-	timerHandlerPtr->time.usec -= 1000000;
-	timerHandlerPtr->time.sec += 1;
-    }
-    
-    /*
-     * Fill in other fields for the event.
-     */
-
-    timerHandlerPtr->proc = proc;
-    timerHandlerPtr->clientData = clientData;
-    id++;
-    timerHandlerPtr->token = (Tcl_TimerToken) id;
-
-    /*
-     * Add the event to the queue in the correct position
-     * (ordered by event firing time).
-     */
-
-    for (tPtr2 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
-	    prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
-	if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
-		|| ((tPtr2->time.sec == timerHandlerPtr->time.sec)
-		&& (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
-	    break;
-	}
-    }
-    timerHandlerPtr->nextPtr = tPtr2;
-    if (prevPtr == NULL) {
-	firstTimerHandlerPtr = timerHandlerPtr;
-    } else {
-	prevPtr->nextPtr = timerHandlerPtr;
-    }
-    return timerHandlerPtr->token;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_DeleteTimerHandler --
- *
- *	Delete a previously-registered timer handler.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Destroy the timer callback identified by TimerToken,
- *	so that its associated procedure will not be called.
- *	If the callback has already fired, or if the given
- *	token doesn't exist, then nothing happens.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_DeleteTimerHandler(token)
-    Tcl_TimerToken token;	/* Result previously returned by
-				 * Tcl_DeleteTimerHandler. */
-{
-    register TimerHandler *timerHandlerPtr, *prevPtr;
-
-    for (timerHandlerPtr = firstTimerHandlerPtr, prevPtr = NULL;
-	    timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
-	    timerHandlerPtr = timerHandlerPtr->nextPtr) {
-	if (timerHandlerPtr->token != token) {
-	    continue;
-	}
-	if (prevPtr == NULL) {
-	    firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
-	} else {
-	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
-	}
-	ckfree((char *) timerHandlerPtr);
-	return;
-    }
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_CreateModalTimeout --
- *
- *	Arrange for a given procedure to be invoked at a particular
- *	time in the future, independently of all other timer events.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	When milliseconds have elapsed, proc will be invoked
- *	exactly once.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_CreateModalTimeout(milliseconds, proc, clientData)
-    int milliseconds;		/* How many milliseconds to wait
-				 * before invoking proc. */
-    Tcl_TimerProc *proc;	/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
-{
-    TimerHandler *timerHandlerPtr;
-
-    if (!timerEventSourceCreated) {
-	timerEventSourceCreated = 1;
-	Tcl_CreateEventSource(TimerHandlerSetupProc, TimerHandlerCheckProc,
-		(ClientData) NULL);
-        Tcl_CreateExitHandler(TimerHandlerExitProc, (ClientData) NULL);
-    }
-
-    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
-
-    /*
-     * Compute when the timeout should fire and fill in the other fields
-     * of the handler.
-     */
-
-    TclpGetTime(&timerHandlerPtr->time);
-    timerHandlerPtr->time.sec += milliseconds/1000;
-    timerHandlerPtr->time.usec += (milliseconds%1000)*1000;
-    if (timerHandlerPtr->time.usec >= 1000000) {
-	timerHandlerPtr->time.usec -= 1000000;
-	timerHandlerPtr->time.sec += 1;
-    }
-    timerHandlerPtr->proc = proc;
-    timerHandlerPtr->clientData = clientData;
-
-    /*
-     * Push the handler on the top of the modal stack.
-     */
-
-    timerHandlerPtr->nextPtr = firstModalHandlerPtr;
-    firstModalHandlerPtr = timerHandlerPtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_DeleteModalTimeout --
- *
- *	Remove the topmost modal timer handler from the stack of
- *	modal  handlers.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Destroys the topmost modal timeout handler, which must
- *	match proc and clientData.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_DeleteModalTimeout(proc, clientData)
-    Tcl_TimerProc *proc;	/* Callback procedure for the timeout. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
-{
-    TimerHandler *timerHandlerPtr;
-
-    timerHandlerPtr = firstModalHandlerPtr;
-    firstModalHandlerPtr = timerHandlerPtr->nextPtr;
-    if ((timerHandlerPtr->proc != proc)
-	    || (timerHandlerPtr->clientData != clientData)) {
-	panic("Tcl_DeleteModalTimeout found timeout stack corrupted");
-    }
-    ckfree((char *) timerHandlerPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerHandlerSetupProc --
- *
- *	This procedure is part of the "event source" for timers.
- *	It is invoked by Tcl_DoOneEvent before it calls select (or
- *	whatever it uses to wait).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Tells the notifier how long to sleep if it decides to block.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TimerHandlerSetupProc(clientData, flags)
-    ClientData clientData;		/* Not used. */
-    int flags;				/* Flags passed to Tk_DoOneEvent:
-					 * if it doesn't include
-					 * TCL_TIMER_EVENTS then we only
-					 * consider modal timers. */
-{
-    TimerHandler *timerHandlerPtr, *tPtr2;
-    Tcl_Time blockTime;
-
-    /*
-     * Find the timer handler (regular or modal) that fires first.
-     */
-
-    timerHandlerPtr = firstTimerHandlerPtr;
-    if (!(flags & TCL_TIMER_EVENTS)) {
-	timerHandlerPtr = NULL;
-    }
-    if (timerHandlerPtr != NULL) {
-	tPtr2 = firstModalHandlerPtr;
-	if (tPtr2 != NULL) {
-	    if ((timerHandlerPtr->time.sec > tPtr2->time.sec)
-		    || ((timerHandlerPtr->time.sec == tPtr2->time.sec)
-		    && (timerHandlerPtr->time.usec > tPtr2->time.usec))) {
-		timerHandlerPtr = tPtr2;
-	    }
-	}
-    } else {
-	timerHandlerPtr = firstModalHandlerPtr;
-    }
-    if (timerHandlerPtr == NULL) {
-	return;
-    }
-
-    TclpGetTime(&blockTime);
-    blockTime.sec = timerHandlerPtr->time.sec - blockTime.sec;
-    blockTime.usec = timerHandlerPtr->time.usec - blockTime.usec;
-    if (blockTime.usec < 0) {
-	blockTime.sec -= 1;
-	blockTime.usec += 1000000;
-    }
-    if (blockTime.sec < 0) {
-	blockTime.sec = 0;
-	blockTime.usec = 0;
-    }
-    Tcl_SetMaxBlockTime(&blockTime);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerHandlerCheckProc --
- *
- *	This procedure is the second part of the "event source" for
- *	file handlers.  It is invoked by Tcl_DoOneEvent after it calls
- *	select (or whatever it uses to wait for events).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Makes entries on the Tcl event queue for each file that is
- *	now ready.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TimerHandlerCheckProc(clientData, flags)
-    ClientData clientData;		/* Not used. */
-    int flags;				/* Flags passed to Tk_DoOneEvent:
-					 * if it doesn't include 
-					 * TCL_TIMER_EVENTS then we only
-					 * consider modal timeouts. */
-{
-    TimerHandler *timerHandlerPtr;
-    TimerEvent *timerEvPtr;
-    int triggered, gotTime;
-    Tcl_Time curTime;
-
-    triggered = 0;
-    gotTime = 0;
-    timerHandlerPtr = firstTimerHandlerPtr;
-    if ((flags & TCL_TIMER_EVENTS) && (timerHandlerPtr != NULL)) {
-	TclpGetTime(&curTime);
-	gotTime = 1;
-	if ((timerHandlerPtr->time.sec < curTime.sec)
-		|| ((timerHandlerPtr->time.sec == curTime.sec)
-		&& (timerHandlerPtr->time.usec <= curTime.usec))) {
-	    triggered = 1;
-	}
-    }
-    timerHandlerPtr = firstModalHandlerPtr;
-    if (timerHandlerPtr != NULL) {
-	if (!gotTime) {
-	    TclpGetTime(&curTime);
-	}
-	if ((timerHandlerPtr->time.sec < curTime.sec)
-		|| ((timerHandlerPtr->time.sec == curTime.sec)
-		&& (timerHandlerPtr->time.usec <= curTime.usec))) {
-	    triggered = 1;
-	}
-    }
-    if (triggered) {
-	timerEvPtr = (TimerEvent *) ckalloc(sizeof(TimerEvent));
-	timerEvPtr->header.proc = TimerHandlerEventProc;
-	timerEvPtr->time.sec = curTime.sec;
-	timerEvPtr->time.usec = curTime.usec;
-	Tcl_QueueEvent((Tcl_Event *) timerEvPtr, TCL_QUEUE_TAIL);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerHandlerExitProc --
- *
- *	Callback invoked during exit cleanup to destroy the timer event
- *	source.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Destroys the timer event source.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static void
-TimerHandlerExitProc(clientData)
-    ClientData clientData;		/* Not used. */
-{
-    Tcl_DeleteEventSource(TimerHandlerSetupProc, TimerHandlerCheckProc,
-            (ClientData) NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerHandlerEventProc --
- *
- *	This procedure is called by Tcl_DoOneEvent when a timer event
- *	reaches the front of the event queue.  This procedure handles
- *	the event by invoking the callbacks for all timers that are
- *	ready.
- *
- * Results:
- *	Returns 1 if the event was handled, meaning it should be removed
- *	from the queue.  Returns 0 if the event was not handled, meaning
- *	it should stay on the queue.  The only time the event isn't
- *	handled is if the TCL_TIMER_EVENTS flag bit isn't set.
- *
- * Side effects:
- *	Whatever the timer handler callback procedures do.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TimerHandlerEventProc(evPtr, flags)
-    Tcl_Event *evPtr;		/* Event to service. */
-    int flags;			/* Flags that indicate what events to
-				 * handle, such as TCL_FILE_EVENTS. */
-{
-    TimerHandler *timerHandlerPtr;
-    TimerEvent *timerEvPtr = (TimerEvent *) evPtr;
-
-    /*
-     * Invoke the current modal timeout first, if there is one and
-     * it has triggered.
-     */
-
-    timerHandlerPtr = firstModalHandlerPtr;
-    if (firstModalHandlerPtr != NULL) {
-	if ((timerHandlerPtr->time.sec < timerEvPtr->time.sec)
-		|| ((timerHandlerPtr->time.sec == timerEvPtr->time.sec)
-		&& (timerHandlerPtr->time.usec <= timerEvPtr->time.usec))) {
-	    (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
-	}
-    }
-
-    /*
-     * Invoke any normal timers that have fired.
-     */
-
-    if (!(flags & TCL_TIMER_EVENTS)) {
-	return 1;
-    }
-
-    while (1) {
-	timerHandlerPtr = firstTimerHandlerPtr;
-	if (timerHandlerPtr == NULL) {
-	    break;
-	}
-	if ((timerHandlerPtr->time.sec > timerEvPtr->time.sec)
-		|| ((timerHandlerPtr->time.sec == timerEvPtr->time.sec)
-		&& (timerHandlerPtr->time.usec >= timerEvPtr->time.usec))) {
-	    break;
-	}
-
-	/*
-	 * Remove the handler from the queue before invoking it,
-	 * to avoid potential reentrancy problems.
-	 */
-
-	firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
-	(*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
-	ckfree((char *) timerHandlerPtr);
-    }
-    return 1;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_DoWhenIdle --
- *
- *	Arrange for proc to be invoked the next time the system is
- *	idle (i.e., just before the next time that Tcl_DoOneEvent
- *	would have to wait for something to happen).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Proc will eventually be called, with clientData as argument.
- *	See the manual entry for details.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_DoWhenIdle(proc, clientData)
-    Tcl_IdleProc *proc;		/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
-{
-    register IdleHandler *idlePtr;
-
-    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
-    idlePtr->proc = proc;
-    idlePtr->clientData = clientData;
-    idlePtr->generation = idleGeneration;
-    idlePtr->nextPtr = NULL;
-    if (lastIdlePtr == NULL) {
-	idleList = idlePtr;
-    } else {
-	lastIdlePtr->nextPtr = idlePtr;
-    }
-    lastIdlePtr = idlePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CancelIdleCall --
- *
- *	If there are any when-idle calls requested to a given procedure
- *	with given clientData, cancel all of them.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If the proc/clientData combination were on the when-idle list,
- *	they are removed so that they will never be called.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_CancelIdleCall(proc, clientData)
-    Tcl_IdleProc *proc;		/* Procedure that was previously registered. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
-{
-    register IdleHandler *idlePtr, *prevPtr;
-    IdleHandler *nextPtr;
-
-    for (prevPtr = NULL, idlePtr = idleList; idlePtr != NULL;
-	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
-	while ((idlePtr->proc == proc)
-		&& (idlePtr->clientData == clientData)) {
-	    nextPtr = idlePtr->nextPtr;
-	    ckfree((char *) idlePtr);
-	    idlePtr = nextPtr;
-	    if (prevPtr == NULL) {
-		idleList = idlePtr;
-	    } else {
-		prevPtr->nextPtr = idlePtr;
-	    }
-	    if (idlePtr == NULL) {
-		lastIdlePtr = prevPtr;
-		return;
-	    }
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclIdlePending --
- *
- *	This function is called by the notifier subsystem to determine
- *	whether there are any idle handlers currently scheduled.
- *
- * Results:
- *	Returns 0 if the idle list is empty, otherwise it returns 1.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclIdlePending()
-{
-    return (idleList == NULL) ? 0 : 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclServiceIdle --
- *
- *	This procedure is invoked by the notifier when it becomes idle.
- *
- * Results:
- *	The return value is 1 if the procedure actually found an idle
- *	handler to invoke.  If no handler was found then 0 is returned.
- *
- * Side effects:
- *	Invokes all pending idle handlers.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclServiceIdle()
-{
-    IdleHandler *idlePtr;
-    int oldGeneration;
-    int foundIdle;
-
-    if (idleList == NULL) {
-	return 0;
-    }
-    
-    foundIdle = 0;
-    oldGeneration = idleGeneration;
-    idleGeneration++;
-
-    /*
-     * The code below is trickier than it may look, for the following
-     * reasons:
-     *
-     * 1. New handlers can get added to the list while the current
-     *    one is being processed.  If new ones get added, we don't
-     *    want to process them during this pass through the list (want
-     *    to check for other work to do first).  This is implemented
-     *    using the generation number in the handler:  new handlers
-     *    will have a different generation than any of the ones currently
-     *    on the list.
-     * 2. The handler can call Tcl_DoOneEvent, so we have to remove
-     *    the handler from the list before calling it. Otherwise an
-     *    infinite loop could result.
-     * 3. Tcl_CancelIdleCall can be called to remove an element from
-     *    the list while a handler is executing, so the list could
-     *    change structure during the call.
-     */
-
-    for (idlePtr = idleList;
-	    ((idlePtr != NULL)
-		    && ((oldGeneration - idlePtr->generation) >= 0));
-	    idlePtr = idleList) {
-	idleList = idlePtr->nextPtr;
-	if (idleList == NULL) {
-	    lastIdlePtr = NULL;
-	}
-	foundIdle = 1;
-	(*idlePtr->proc)(idlePtr->clientData);
-	ckfree((char *) idlePtr);
-    }
-
-    return foundIdle;
-}
-
-/*
  *----------------------------------------------------------------------
  *
  * Tcl_BackgroundError --
@@ -1241,7 +125,7 @@ Tcl_BackgroundError(interp)
 				 * occurred. */
 {
     BgError *errPtr;
-    char *varValue;
+    char *errResult, *varValue;
     ErrAssocData *assocPtr;
 
     /*
@@ -1253,11 +137,13 @@ Tcl_BackgroundError(interp)
      */
 
     Tcl_AddErrorInfo(interp, "");
+
+    errResult = TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL);
+	
     errPtr = (BgError *) ckalloc(sizeof(BgError));
     errPtr->interp = interp;
-    errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(interp->result)
-	    + 1));
-    strcpy(errPtr->errorMsg, interp->result);
+    errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(errResult) + 1));
+    strcpy(errPtr->errorMsg, errResult);
     varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
     if (varValue == NULL) {
 	varValue = errPtr->errorMsg;
@@ -1327,10 +213,12 @@ HandleBgErrors(clientData)
     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
     Tcl_Channel errChannel;
 
+    Tcl_Preserve((ClientData) assocPtr);
+    
     while (assocPtr->firstBgPtr != NULL) {
 	interp = assocPtr->firstBgPtr->interp;
 	if (interp == NULL) {
-	    goto doneWithReport;
+	    goto doneWithInterp;
 	}
 
 	/*
@@ -1357,6 +245,45 @@ HandleBgErrors(clientData)
 	if (code == TCL_ERROR) {
 
             /*
+             * If the interpreter is safe, we look for a hidden command
+             * named "bgerror" and call that with the error information.
+             * Otherwise, simply ignore the error. The rationale is that
+             * this could be an error caused by a malicious applet trying
+             * to cause an infinite barrage of error messages. The hidden
+             * "bgerror" command can be used by a security policy to
+             * interpose on such attacks and e.g. kill the applet after a
+             * few attempts.
+             */
+
+            if (Tcl_IsSafe(interp)) {
+                Tcl_HashTable *hTblPtr;
+                Tcl_HashEntry *hPtr;
+
+                hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
+                        "tclHiddenCmds", NULL);
+                if (hTblPtr == (Tcl_HashTable *) NULL) {
+                    goto doneWithInterp;
+                }
+                hPtr = Tcl_FindHashEntry(hTblPtr, "bgerror");
+                if (hPtr == (Tcl_HashEntry *) NULL) {
+                    goto doneWithInterp;
+                }
+
+                /*
+                 * OK, the hidden command "bgerror" exists, invoke it.
+                 */
+
+                argv[0] = "bgerror";
+                argv[1] = ckalloc((unsigned)
+                        strlen(assocPtr->firstBgPtr->errorMsg));
+                strcpy(argv[1], assocPtr->firstBgPtr->errorMsg);
+                (void) TclInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
+                ckfree(argv[1]);
+
+                goto doneWithInterp;
+            } 
+
+            /*
              * We have to get the error output channel at the latest possible
              * time, because the eval (above) might have changed the channel.
              */
@@ -1397,21 +324,28 @@ HandleBgErrors(clientData)
 	    }
 	}
 
-        Tcl_Release((ClientData) interp);
-
 	/*
 	 * Discard the command and the information about the error report.
 	 */
 
-	doneWithReport:
-	ckfree(assocPtr->firstBgPtr->errorMsg);
-	ckfree(assocPtr->firstBgPtr->errorInfo);
-	ckfree(assocPtr->firstBgPtr->errorCode);
-	errPtr = assocPtr->firstBgPtr->nextPtr;
-	ckfree((char *) assocPtr->firstBgPtr);
-	assocPtr->firstBgPtr = errPtr;
+doneWithInterp:
+
+	if (assocPtr->firstBgPtr) {
+	    ckfree(assocPtr->firstBgPtr->errorMsg);
+	    ckfree(assocPtr->firstBgPtr->errorInfo);
+	    ckfree(assocPtr->firstBgPtr->errorCode);
+	    errPtr = assocPtr->firstBgPtr->nextPtr;
+	    ckfree((char *) assocPtr->firstBgPtr);
+	    assocPtr->firstBgPtr = errPtr;
+	}
+        
+        if (interp != NULL) {
+            Tcl_Release((ClientData) interp);
+        }
     }
     assocPtr->lastBgPtr = NULL;
+
+    Tcl_Release((ClientData) assocPtr);
 }
 
 /*
@@ -1450,8 +384,8 @@ BgErrorDeleteProc(clientData, interp)
 	ckfree(errPtr->errorCode);
 	ckfree((char *) errPtr);
     }
-    ckfree((char *) assocPtr);
     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
+    Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
 }
 
 /*
@@ -1549,415 +483,82 @@ Tcl_Exit(status)
     int status;			/* Exit status for application;  typically
 				 * 0 for normal return, 1 for error return. */
 {
-    ExitHandler *exitPtr;
-
-    for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
-	/*
-	 * Be careful to remove the handler from the list before invoking
-	 * its callback.  This protects us against double-freeing if the
-	 * callback should call Tcl_DeleteExitHandler on itself.
-	 */
-
-	firstExitPtr = exitPtr->nextPtr;
-	(*exitPtr->proc)(exitPtr->clientData);
-	ckfree((char *) exitPtr);
-    }
+    Tcl_Finalize();
 #ifdef TCL_MEM_DEBUG
     if (tclMemDumpFileName != NULL) {
 	Tcl_DumpActiveMemory(tclMemDumpFileName);
     }
 #endif
-    
     TclPlatformExit(status);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AfterCmd --
+ * Tcl_Finalize --
  *
- *	This procedure is invoked to process the "after" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tcl_AfterCmd(clientData, interp, argc, argv)
-    ClientData clientData;	/* Points to the "tclAfter" assocData for
-				 * this interpreter, or NULL if the assocData
-				 * hasn't been created yet.*/
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int argc;			/* Number of arguments. */
-    char **argv;		/* Argument strings. */
-{
-    /*
-     * The variable below is used to generate unique identifiers for
-     * after commands.  This id can wrap around, which can potentially
-     * cause problems.  However, there are not likely to be problems
-     * in practice, because after commands can only be requested to
-     * about a month in the future, and wrap-around is unlikely to
-     * occur in less than about 1-10 years.  Thus it's unlikely that
-     * any old ids will still be around when wrap-around occurs.
-     */
-
-    static int nextId = 1;
-    int ms;
-    AfterInfo *afterPtr;
-    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
-    Tcl_CmdInfo cmdInfo;
-    size_t length;
-
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option ?arg arg ...?\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Create the "after" information associated for this interpreter,
-     * if it doesn't already exist.  Associate it with the command too,
-     * so that it will be passed in as the ClientData argument in the
-     * future.
-     */
-
-    if (assocPtr == NULL) {
-	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
-	assocPtr->interp = interp;
-	assocPtr->firstAfterPtr = NULL;
-	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
-		(ClientData) assocPtr);
-	cmdInfo.proc = Tcl_AfterCmd;
-	cmdInfo.clientData = (ClientData) assocPtr;
-	cmdInfo.deleteProc = NULL;
-	cmdInfo.deleteData = (ClientData) assocPtr;
-	Tcl_SetCommandInfo(interp, argv[0], &cmdInfo);
-    }
-
-    /*
-     * Parse the command.
-     */
-
-    length = strlen(argv[1]);
-    if (isdigit(UCHAR(argv[1][0]))) {
-	if (Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (ms < 0) {
-	    ms = 0;
-	}
-	if (argc == 2) {
-	    Tcl_Sleep(ms);
-	    return TCL_OK;
-	}
-	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
-	afterPtr->assocPtr = assocPtr;
-	if (argc == 3) {
-	    afterPtr->command = (char *) ckalloc((unsigned)
-		    (strlen(argv[2]) + 1));
-	    strcpy(afterPtr->command, argv[2]);
-	} else {
-	    afterPtr->command = Tcl_Concat(argc-2, argv+2);
-	}
-	afterPtr->id = nextId;
-	nextId += 1;
-	afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
-		(ClientData) afterPtr);
-	afterPtr->nextPtr = assocPtr->firstAfterPtr;
-	assocPtr->firstAfterPtr = afterPtr;
-	sprintf(interp->result, "after#%d", afterPtr->id);
-    } else if (strncmp(argv[1], "cancel", length) == 0) {
-	char *arg;
-
-	if (argc < 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " cancel id|command\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (argc == 3) {
-	    arg = argv[2];
-	} else {
-	    arg = Tcl_Concat(argc-2, argv+2);
-	}
-	for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
-		afterPtr = afterPtr->nextPtr) {
-	    if (strcmp(afterPtr->command, arg) == 0) {
-		break;
-	    }
-	}
-	if (afterPtr == NULL) {
-	    afterPtr = GetAfterEvent(assocPtr, arg);
-	}
-	if (arg != argv[2]) {
-	    ckfree(arg);
-	}
-	if (afterPtr != NULL) {
-	    if (afterPtr->token != NULL) {
-		Tcl_DeleteTimerHandler(afterPtr->token);
-	    } else {
-		Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
-	    }
-	    FreeAfterPtr(afterPtr);
-	}
-    } else if ((strncmp(argv[1], "idle", length) == 0)
-	     && (length >= 2)) {
-	if (argc < 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " idle script script ...\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
-	afterPtr->assocPtr = assocPtr;
-	if (argc == 3) {
-	    afterPtr->command = (char *) ckalloc((unsigned)
-		    (strlen(argv[2]) + 1));
-	    strcpy(afterPtr->command, argv[2]);
-	} else {
-	    afterPtr->command = Tcl_Concat(argc-2, argv+2);
-	}
-	afterPtr->id = nextId;
-	nextId += 1;
-	afterPtr->token = NULL;
-	afterPtr->nextPtr = assocPtr->firstAfterPtr;
-	assocPtr->firstAfterPtr = afterPtr;
-	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
-	sprintf(interp->result, "after#%d", afterPtr->id);
-    } else if ((strncmp(argv[1], "info", length) == 0)
-	     && (length >= 2)) {
-	if (argc == 2) {
-	    char buffer[30];
-	    
-	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
-		    afterPtr = afterPtr->nextPtr) {
-		if (assocPtr->interp == interp) {
-		    sprintf(buffer, "after#%d", afterPtr->id);
-		    Tcl_AppendElement(interp, buffer);
-		}
-	    }
-	    return TCL_OK;
-	}
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " info ?id?\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	afterPtr = GetAfterEvent(assocPtr, argv[2]);
-	if (afterPtr == NULL) {
-	    Tcl_AppendResult(interp, "event \"", argv[2],
-		    "\" doesn't exist", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_AppendElement(interp, afterPtr->command);
-	Tcl_AppendElement(interp,
-		(afterPtr->token == NULL) ? "idle" : "timer");
-    } else {
-	Tcl_AppendResult(interp, "bad argument \"", argv[1],
-		"\": must be cancel, idle, info, or a number",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetAfterEvent --
- *
- *	This procedure parses an "after" id such as "after#4" and
- *	returns a pointer to the AfterInfo structure.
- *
- * Results:
- *	The return value is either a pointer to an AfterInfo structure,
- *	if one is found that corresponds to "string" and is for interp,
- *	or NULL if no corresponding after event can be found.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static AfterInfo *
-GetAfterEvent(assocPtr, string)
-    AfterAssocData *assocPtr;	/* Points to "after"-related information for
-				 * this interpreter. */
-    char *string;		/* Textual identifier for after event, such
-				 * as "after#6". */
-{
-    AfterInfo *afterPtr;
-    int id;
-    char *end;
-
-    if (strncmp(string, "after#", 6) != 0) {
-	return NULL;
-    }
-    string += 6;
-    id = strtoul(string, &end, 10);
-    if ((end == string) || (*end != 0)) {
-	return NULL;
-    }
-    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
-	    afterPtr = afterPtr->nextPtr) {
-	if (afterPtr->id == id) {
-	    return afterPtr;
-	}
-    }
-    return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AfterProc --
- *
- *	Timer callback to execute commands registered with the
- *	"after" command.
+ *	Runs the exit handlers to allow Tcl to clean up its state prior
+ *	to being unloaded. Called by Tcl_Exit and when Tcl was dynamically
+ *	loaded and is now being unloaded.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Executes whatever command was specified.  If the command
- *	returns an error, then the command "bgerror" is invoked
- *	to process the error;  if bgerror fails then information
- *	about the error is output on stderr.
+ *	Whatever the exit handlers do. Also frees up storage associated
+ *	with the Tcl object type table.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-AfterProc(clientData)
-    ClientData clientData;	/* Describes command to execute. */
+void
+Tcl_Finalize()
 {
-    AfterInfo *afterPtr = (AfterInfo *) clientData;
-    AfterAssocData *assocPtr = afterPtr->assocPtr;
-    AfterInfo *prevPtr;
-    int result;
-    Tcl_Interp *interp;
-
-    /*
-     * First remove the callback from our list of callbacks;  otherwise
-     * someone could delete the callback while it's being executed, which
-     * could cause a core dump.
-     */
+    ExitHandler *exitPtr;
+    
+    tclInExit = 1;
+    for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
+	/*
+	 * Be careful to remove the handler from the list before invoking
+	 * its callback.  This protects us against double-freeing if the
+	 * callback should call Tcl_DeleteExitHandler on itself.
+	 */
 
-    if (assocPtr->firstAfterPtr == afterPtr) {
-	assocPtr->firstAfterPtr = afterPtr->nextPtr;
-    } else {
-	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
-		prevPtr = prevPtr->nextPtr) {
-	    /* Empty loop body. */
-	}
-	prevPtr->nextPtr = afterPtr->nextPtr;
+	firstExitPtr = exitPtr->nextPtr;
+	(*exitPtr->proc)(exitPtr->clientData);
+	ckfree((char *) exitPtr);
     }
 
     /*
-     * Execute the callback.
+     * Uninitialize everything associated with the compile and execute
+     * environment. This *must* be done at the latest possible time.
      */
-
-    interp = assocPtr->interp;
-    Tcl_Preserve((ClientData) interp);
-    result = Tcl_GlobalEval(interp, afterPtr->command);
-    if (result != TCL_OK) {
-	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
-	Tcl_BackgroundError(interp);
-    }
-    Tcl_Release((ClientData) interp);
     
-    /*
-     * Free the memory for the callback.
-     */
-
-    ckfree(afterPtr->command);
-    ckfree((char *) afterPtr);
+    TclFinalizeCompExecEnv();
+    firstExitPtr = NULL;
+    tclInExit = 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * FreeAfterPtr --
+ * TclInExit --
  *
- *	This procedure removes an "after" command from the list of
- *	those that are pending and frees its resources.  This procedure
- *	does *not* cancel the timer handler;  if that's needed, the
- *	caller must do it.
+ *	Determines if we are in the middle of exit-time cleanup.
  *
  * Results:
- *	None.
+ *	If we are in the middle of exiting, 1, otherwise 0.
  *
  * Side effects:
- *	The memory associated with afterPtr is released.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeAfterPtr(afterPtr)
-    AfterInfo *afterPtr;		/* Command to be deleted. */
-{
-    AfterInfo *prevPtr;
-    AfterAssocData *assocPtr = afterPtr->assocPtr;
-
-    if (assocPtr->firstAfterPtr == afterPtr) {
-	assocPtr->firstAfterPtr = afterPtr->nextPtr;
-    } else {
-	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
-		prevPtr = prevPtr->nextPtr) {
-	    /* Empty loop body. */
-	}
-	prevPtr->nextPtr = afterPtr->nextPtr;
-    }
-    ckfree(afterPtr->command);
-    ckfree((char *) afterPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AfterCleanupProc --
- *
- *	This procedure is invoked whenever an interpreter is deleted
- *	to cleanup the AssocData for "tclAfter".
- *
- * Results:
  *	None.
  *
- * Side effects:
- *	After commands are removed.
- *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static void
-AfterCleanupProc(clientData, interp)
-    ClientData clientData;	/* Points to AfterAssocData for the
-				 * interpreter. */
-    Tcl_Interp *interp;		/* Interpreter that is being deleted. */
+int
+TclInExit()
 {
-    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
-    AfterInfo *afterPtr;
-
-    while (assocPtr->firstAfterPtr != NULL) {
-	afterPtr = assocPtr->firstAfterPtr;
-	assocPtr->firstAfterPtr = afterPtr->nextPtr;
-	if (afterPtr->token != NULL) {
-	    Tcl_DeleteTimerHandler(afterPtr->token);
-	} else {
-	    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
-	}
-	ckfree(afterPtr->command);
-	ckfree((char *) afterPtr);
-    }
-    ckfree((char *) assocPtr);
+    return tclInExit;
 }
 
 /*
@@ -1992,13 +593,15 @@ Tcl_VwaitCmd(clientData, interp, argc, argv)
 		argv[0], " name\"", (char *) NULL);
 	return TCL_ERROR;
     }
-    Tcl_TraceVar(interp, argv[1],
+    if (Tcl_TraceVar(interp, argv[1],
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    VwaitVarProc, (ClientData) &done);
+	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
+	return TCL_ERROR;
+    };
     done = 0;
     foundEvent = 1;
     while (!done && foundEvent) {
-	foundEvent = Tcl_DoOneEvent(0);
+	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
     }
     Tcl_UntraceVar(interp, argv[1],
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
@@ -2058,8 +661,7 @@ Tcl_UpdateCmd(clientData, interp, argc, argv)
     int argc;			/* Number of arguments. */
     char **argv;		/* Argument strings. */
 {
-    int flags = 0;		/* Initialization needed only to stop
-				 * compiler warnings. */
+    int flags;
 
     if (argc == 1) {
 	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
@@ -2069,7 +671,7 @@ Tcl_UpdateCmd(clientData, interp, argc, argv)
 		    "\": must be idletasks", (char *) NULL);
 	    return TCL_ERROR;
 	}
-	flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+	flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
     } else {
 	Tcl_AppendResult(interp, "wrong # args: should be \"",
 		argv[0], " ?idletasks?\"", (char *) NULL);
@@ -2088,100 +690,3 @@ Tcl_UpdateCmd(clientData, interp, argc, argv)
     Tcl_ResetResult(interp);
     return TCL_OK;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWaitForFile --
- *
- *	This procedure waits synchronously for a file to become readable
- *	or writable, with an optional timeout.
- *
- * Results:
- *	The return value is an OR'ed combination of TCL_READABLE,
- *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions
- *	that are present on file at the time of the return.  This
- *	procedure will not return until either "timeout" milliseconds
- *	have elapsed or at least one of the conditions given by mask
- *	has occurred for file (a return value of 0 means that a timeout
- *	occurred).  No normal events will be serviced during the
- *	execution of this procedure.
- *
- * Side effects:
- *	Time passes.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclWaitForFile(file, mask, timeout)
-    Tcl_File file;		/* Handle for file on which to wait. */
-    int mask;			/* What to wait for: OR'ed combination of
-				 * TCL_READABLE, TCL_WRITABLE, and
-				 * TCL_EXCEPTION. */
-    int timeout;		/* Maximum amount of time to wait for one
-				 * of the conditions in mask to occur, in
-				 * milliseconds.  A value of 0 means don't
-				 * wait at all, and a value of -1 means
-				 * wait forever. */
-{
-    Tcl_Time abortTime, now, blockTime;
-    int present;
-
-    /*
-     * If there is a non-zero finite timeout, compute the time when
-     * we give up.
-     */
-
-    if (timeout > 0) {
-	TclpGetTime(&now);
-	abortTime.sec = now.sec + timeout/1000;
-	abortTime.usec = now.usec + (timeout%1000)*1000;
-	if (abortTime.usec >= 1000000) {
-	    abortTime.usec -= 1000000;
-	    abortTime.sec += 1;
-	}
-    }
-
-    /*
-     * Loop in a mini-event loop of our own, waiting for either the
-     * file to become ready or a timeout to occur.
-     */
-
-    while (1) {
-	Tcl_WatchFile(file, mask);
-	if (timeout > 0) {
-	    blockTime.sec = abortTime.sec - now.sec;
-	    blockTime.usec = abortTime.usec - now.usec;
-	    if (blockTime.usec < 0) {
-		blockTime.sec -= 1;
-		blockTime.usec += 1000000;
-	    }
-	    if (blockTime.sec < 0) {
-		blockTime.sec = 0;
-		blockTime.usec = 0;
-	    }
-	    Tcl_WaitForEvent(&blockTime);
-	} else if (timeout == 0) {
-	    blockTime.sec = 0;
-	    blockTime.usec = 0;
-	    Tcl_WaitForEvent(&blockTime);
-	} else {
-	    Tcl_WaitForEvent((Tcl_Time *) NULL);
-	}
-	present = Tcl_FileReady(file, mask);
-	if (present != 0) {
-	    break;
-	}
-	if (timeout == 0) {
-	    break;
-	}
-	TclpGetTime(&now);
-	if ((abortTime.sec < now.sec)
-		|| ((abortTime.sec == now.sec)
-		&& (abortTime.usec <= now.usec))) {
-	    break;
-	}
-    }
-    return present;
-}
diff --git a/contrib/tcl/generic/tclExecute.c b/contrib/tcl/generic/tclExecute.c
new file mode 100644
index 0000000..111cf4b
--- /dev/null
+++ b/contrib/tcl/generic/tclExecute.c
@@ -0,0 +1,4660 @@
+/* 
+ * tclExecute.c --
+ *
+ *	This file contains procedures that execute byte-compiled Tcl
+ *	commands.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclExecute.c 1.81 97/06/26 13:50:03
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+#ifdef NO_FLOAT_H
+#   include "../compat/float.h"
+#else
+#   include <float.h>
+#endif
+#ifndef TCL_NO_MATH
+#include <math.h>
+#endif
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used
+ * in environments that include no UNIX, i.e. no errno.  Just define
+ * errno here.
+ */
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+int errno;
+#define EDOM 33
+#define ERANGE 34
+#endif
+
+/*
+ * Boolean flag indicating whether the Tcl bytecode interpreter has been
+ * initialized.
+ */
+
+static int execInitialized = 0;
+
+/*
+ * Variable that controls whether execution tracing is enabled and, if so,
+ * what level of tracing is desired:
+ *    0: no execution tracing
+ *    1: trace invocations of Tcl procs only
+ *    2: trace invocations of all (not compiled away) commands
+ *    3: display each instruction executed
+ * This variable is linked to the Tcl variable "tcl_traceExec".
+ */
+
+int tclTraceExec = 0;
+
+/*
+ * The following global variable is use to signal matherr that Tcl
+ * is responsible for the arithmetic, so errors can be handled in a
+ * fashion appropriate for Tcl.  Zero means no Tcl math is in
+ * progress;  non-zero means Tcl is doing math.
+ */
+
+int tcl_MathInProgress = 0;
+
+/*
+ * The variable below serves no useful purpose except to generate
+ * a reference to matherr, so that the Tcl version of matherr is
+ * linked in rather than the system version. Without this reference
+ * the need for matherr won't be discovered during linking until after
+ * libtcl.a has been processed, so Tcl's version won't be used.
+ */
+
+#ifdef NEED_MATHERR
+extern int matherr();
+int (*tclMatherrPtr)() = matherr;
+#endif
+
+/*
+ * Array of instruction names.
+ */
+
+static char *opName[256];
+
+/*
+ * Mapping from expression instruction opcodes to strings; used for error
+ * messages. Note that these entries must match the order and number of the
+ * expression opcodes (e.g., INST_LOR) in tclCompile.h.
+ */
+
+static char *operatorStrings[] = {
+    "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
+    "+", "-", "*", "/", "%", "+", "-", "~", "!",
+    "BUILTIN FUNCTION", "FUNCTION"
+};
+    
+/*
+ * Mapping from Tcl result codes to strings; used for error and debugging
+ * messages. 
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static char *resultStrings[] = {
+    "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
+};
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * The following are statistics-related variables that record information
+ * about the bytecode compiler and interpreter's operation. This includes
+ * an array that records for each instruction how often it is executed.
+ */
+
+#ifdef TCL_COMPILE_STATS
+static int instructionCount[256];
+static long numExecutions = 0;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * Macros for testing floating-point values for certain special cases. Test
+ * for not-a-number by comparing a value against itself; test for infinity
+ * by comparing against the largest floating-point value.
+ */
+
+#define IS_NAN(v) ((v) != (v))
+#ifdef DBL_MAX
+#   define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
+#else
+#   define IS_INF(v) 0
+#endif
+
+/*
+ * Macro to adjust the program counter and restart the instruction execution
+ * loop after each instruction is executed.
+ */
+
+#define ADJUST_PC(instBytes) \
+    pc += instBytes;  continue
+
+/*
+ * Macros used to cache often-referenced Tcl evaluation stack information
+ * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
+ * pair must surround any call inside TclExecuteByteCode (and a few other
+ * procedures that use this scheme) that could result in a recursive call
+ * to TclExecuteByteCode.
+ */
+
+#define CACHE_STACK_INFO() \
+    stackPtr = eePtr->stackPtr; \
+    stackTop = eePtr->stackTop
+
+#define DECACHE_STACK_INFO() \
+    eePtr->stackTop = stackTop
+
+/*
+ * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
+ * increments the object's ref count since it makes the stack have another
+ * reference pointing to the object. However, POP_OBJECT does not decrement
+ * the ref count. This is because the stack may hold the only reference to
+ * the object, so the object would be destroyed if its ref count were
+ * decremented before the caller had a chance to, e.g., store it in a
+ * variable. It is the caller's responsibility to decrement the ref count
+ * when it is finished with an object.
+ */
+
+#define STK_ITEM(offset)    (stackPtr[stackTop + (offset)])
+#define STK_OBJECT(offset)  (STK_ITEM(offset).o)
+#define STK_INT(offset)     (STK_ITEM(offset).i)
+#define STK_POINTER(offset) (STK_ITEM(offset).p)
+
+/*
+ * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
+ * macro. The actual parameter might be an expression with side effects,
+ * and this ensures that it will be executed only once. 
+ */
+    
+#define PUSH_OBJECT(objPtr) \
+    Tcl_IncrRefCount(stackPtr[++stackTop].o = (objPtr))
+    
+#define POP_OBJECT() \
+    (stackPtr[stackTop--].o)
+
+/*
+ * Macros used to trace instruction execution. The macros TRACE,
+ * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
+ * O2S is only used in TRACE* calls to get a string from an object.
+ * 
+ * NOTE THAT CLIENTS OF O2S ARE LIKELY TO FAIL IF THE OBJECT'S
+ * STRING REP CONTAINS NULLS. 
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+	
+#define O2S(objPtr) \
+    Tcl_GetStringFromObj((objPtr), &length)
+	
+#ifdef TCL_COMPILE_STATS
+#define TRACE(a) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
+	       stackTop, (tclObjsAlloced - tclObjsFreed), \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+        fflush(stdout); \
+    }
+#define TRACE_WITH_OBJ(a, objPtr) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
+	       stackTop, (tclObjsAlloced - tclObjsFreed), \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+	bytes = Tcl_GetStringFromObj((objPtr), &length); \
+        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
+        fprintf(stdout, "\n"); \
+        fflush(stdout); \
+    }
+#else  /* not TCL_COMPILE_STATS */
+#define TRACE(a) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+        fflush(stdout); \
+    }
+#define TRACE_WITH_OBJ(a, objPtr) \
+    if (traceInstructions) { \
+        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
+	       (unsigned int)(pc - codePtr->codeStart)); \
+	printf a; \
+	bytes = Tcl_GetStringFromObj((objPtr), &length); \
+        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
+        fprintf(stdout, "\n"); \
+        fflush(stdout); \
+    }
+#endif /* TCL_COMPILE_STATS */
+
+#else  /* not TCL_COMPILE_DEBUG */
+	
+#define TRACE(a)
+#define TRACE_WITH_OBJ(a, objPtr)
+#define O2S(objPtr)
+	
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Declarations for local procedures to this file:
+ */
+
+static void		CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
+			    Trace *tracePtr, Command *cmdPtr,
+			    char *command, int numChars,
+			    int objc, Tcl_Obj *objv[]));
+static void		DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr));
+static int		ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprCallMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, int objc, Tcl_Obj **objv));
+static int		ExprDoubleFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprIntFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprRandFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+static int		ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
+			    ExecEnv *eePtr, ClientData clientData));
+#ifdef TCL_COMPILE_STATS
+static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
+                            Tcl_Interp *interp, int argc, char **argv));
+#endif /* TCL_COMPILE_STATS */
+static void		FreeCmdNameInternalRep _ANSI_ARGS_((
+    			    Tcl_Obj *objPtr));
+static void		GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
+static void		IllegalExprOperandType _ANSI_ARGS_((
+			    Tcl_Interp *interp, unsigned int opCode,
+			    Tcl_Obj *opndPtr));
+static void		InitByteCodeExecution _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+static int		SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+#ifdef TCL_COMPILE_DEBUG
+static char *		StringForResultCode _ANSI_ARGS_((int result));
+#endif /* TCL_COMPILE_DEBUG */
+static void		UpdateStringOfCmdName _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * Table describing the built-in math functions. Entries in this table are
+ * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte.
+ */
+
+BuiltinFunc builtinFuncTable[] = {
+#ifndef TCL_NO_MATH
+    {"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
+    {"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
+    {"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
+    {"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
+    {"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
+    {"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
+    {"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
+    {"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
+    {"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
+    {"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
+    {"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
+    {"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
+    {"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
+    {"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
+    {"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
+    {"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
+    {"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
+    {"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
+    {"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
+#endif
+    {"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
+    {"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
+    {"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
+    {"rand", 0, {TCL_EITHER}, ExprRandFunc, 0},	/* NOTE: rand takes no args. */
+    {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
+    {"srand", 1, {TCL_INT}, ExprSrandFunc, 0},
+    {0},
+};
+
+/*
+ * The structure below defines the command name Tcl object type by means of
+ * procedures that can be invoked by generic object code. Objects of this
+ * type cache the Command pointer that results from looking up command names
+ * in the command hashtable. Such objects appear as the zeroth ("command
+ * name") argument in a Tcl command.
+ */
+
+Tcl_ObjType tclCmdNameType = {
+    "cmdName",				/* name */
+    FreeCmdNameInternalRep,		/* freeIntRepProc */
+    DupCmdNameInternalRep,		/* dupIntRepProc */
+    UpdateStringOfCmdName,		/* updateStringProc */
+    SetCmdNameFromAny			/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitByteCodeExecution --
+ *
+ *	This procedure is called once to initialize the Tcl bytecode
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	This procedure initializes the array of instruction names. If
+ *	compiling with the TCL_COMPILE_STATS flag, it initializes the
+ *	array that counts the executions of each instruction and it
+ *	creates the "evalstats" command. It also registers the command name
+ *	Tcl_ObjType. It also establishes the link between the Tcl
+ *	"tcl_traceExec" and C "tclTraceExec" variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitByteCodeExecution(interp)
+    Tcl_Interp *interp;		/* Interpreter for which the Tcl variable
+				 * "tcl_traceExec" is linked to control
+				 * instruction tracing. */
+{
+    int i;
+    
+    Tcl_RegisterObjType(&tclCmdNameType);
+
+    (VOID *) memset(opName, 0, sizeof(opName));
+    for (i = 0;  instructionTable[i].name != NULL;  i++) {
+	opName[i] = instructionTable[i].name;
+    }
+
+#ifdef TCL_COMPILE_STATS    
+    (VOID *) memset(instructionCount, 0, sizeof(instructionCount));
+    Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
+		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+#endif /* TCL_COMPILE_STATS */
+    
+    if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
+		    TCL_LINK_INT) != TCL_OK) {
+	panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateExecEnv --
+ *
+ *	This procedure creates a new execution environment for Tcl bytecode
+ *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv
+ *	is typically created once for each Tcl interpreter (Interp
+ *	structure) and recursively passed to TclExecuteByteCode to execute
+ *	ByteCode sequences for nested commands.
+ *
+ * Results:
+ *	A newly allocated ExecEnv is returned. This points to an empty
+ *	evaluation stack of the standard initial size.
+ *
+ * Side effects:
+ *	The bytecode interpreter is also initialized here, as this
+ *	procedure will be called before any call to TclExecuteByteCode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_STACK_INITIAL_SIZE 2000
+
+ExecEnv *
+TclCreateExecEnv(interp)
+    Tcl_Interp *interp;		/* Interpreter for which the execution
+				 * environment is being created. */
+{
+    ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
+
+    eePtr->stackPtr = (StackItem *)
+	ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(StackItem)));
+    eePtr->stackTop = -1;
+    eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);
+
+    if (!execInitialized) {
+	InitByteCodeExecution(interp);
+	execInitialized = 1;
+    }
+
+    return eePtr;
+}
+#undef TCL_STACK_INITIAL_SIZE
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteExecEnv --
+ *
+ *	Frees the storage for an ExecEnv.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Storage for an ExecEnv and its contained storage (e.g. the
+ *	evaluation stack) is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteExecEnv(eePtr)
+    ExecEnv *eePtr;		/* Execution environment to free. */
+{
+    ckfree((char *) eePtr->stackPtr);
+    ckfree((char *) eePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeExecEnv --
+ *
+ *	Finalizes the execution environment setup so that it can be
+ *	later reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	After this call, the next time TclCreateExecEnv will be called
+ *	it will call InitByteCodeExecution.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeExecEnv()
+{
+    execInitialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrowEvaluationStack --
+ *
+ *	This procedure grows a Tcl evaluation stack stored in an ExecEnv.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The size of the evaluation stack is doubled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GrowEvaluationStack(eePtr)
+    register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
+			      * stack to enlarge. */
+{
+    /*
+     * The current Tcl stack elements are stored from eePtr->stackPtr[0]
+     * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
+     */
+
+    int currElems = (eePtr->stackEnd + 1);
+    int newElems  = 2*currElems;
+    int currBytes = currElems * sizeof(StackItem);
+    int newBytes  = 2*currBytes;
+    StackItem *newStackPtr = (StackItem *) ckalloc((unsigned) newBytes);
+
+    /*
+     * Copy the existing stack items to the new stack space, free the old
+     * storage if appropriate, and mark new space as malloc'ed.
+     */
+ 
+    memcpy((VOID *) newStackPtr, (VOID *) eePtr->stackPtr,
+	   (size_t) currBytes);
+    ckfree((char *) eePtr->stackPtr);
+    eePtr->stackPtr = newStackPtr;
+    eePtr->stackEnd = (newElems - 1); /* i.e. index of last usable item */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExecuteByteCode --
+ *
+ *	This procedure executes the instructions of a ByteCode structure.
+ *	It returns when a "done" instruction is executed or an error occurs.
+ *
+ * Results:
+ *	The return value is one of the return codes defined in tcl.h
+ *	(such as TCL_OK), and interp->objResultPtr refers to a Tcl object
+ *	that either contains the result of executing the code or an
+ *	error message.
+ *
+ * Side effects:
+ *	Almost certainly, depending on the ByteCode's instructions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclExecuteByteCode(interp, codePtr)
+    Tcl_Interp *interp;		/* Token for command interpreter. */
+    ByteCode *codePtr;		/* The bytecode sequence to interpret. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    				/* Points to the execution environment. */
+    register StackItem *stackPtr = eePtr->stackPtr;
+    				/* Cached evaluation stack base pointer. */
+    register int stackTop = eePtr->stackTop;
+    				/* Cached top index of evaluation stack. */
+    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
+    				/* Points to the ByteCode's object array. */
+    unsigned char *pc = codePtr->codeStart;
+				/* The current program counter. */
+    unsigned char opCode;	/* The current instruction code. */
+    int opnd;			/* Current instruction's operand byte. */
+    int pcAdjustment;		/* Hold pc adjustment after instruction. */
+    int initStackTop = stackTop;/* Stack top at start of execution. */
+    ExceptionRange *rangePtr;	/* Points to closest loop or catch exception
+				 * range enclosing the pc. Used by various
+				 * instructions and processCatch to
+				 * process break, continue, and errors. */
+    int result = TCL_OK;	/* Return code returned after execution. */
+    int traceInstructions = (tclTraceExec == 3);
+    Tcl_Obj *valuePtr, *value2Ptr, *namePtr, *objPtr;
+    char *bytes;
+    int length;
+    long i;
+    Tcl_DString command;	/* Used for debugging. If tclTraceExec >= 2
+				 * holds a string representing the last
+				 * command invoked. */
+
+    /*
+     * This procedure uses a stack to hold information about catch commands.
+     * This information is the current operand stack top when starting to
+     * execute the code for each catch command. It starts out with stack-
+     * allocated space but uses dynamically-allocated storage if needed.
+     */
+
+#define STATIC_CATCH_STACK_SIZE 5
+    int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
+    int *catchStackPtr = catchStackStorage;
+    int catchTop = -1;
+
+    /*
+     * THIS PROC FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    if (tclTraceExec >= 2) {
+	Proc *procPtr = codePtr->procPtr;
+	fprintf(stdout, "\nExecuting ByteCode 0x%x, ref ct %u, epoch %u, cmds %u, interp 0x%x, interp epoch %u\n",
+	        (unsigned int) codePtr, codePtr->refCount,
+		codePtr->compileEpoch, codePtr->numCommands,
+		(unsigned int) codePtr->iPtr, codePtr->iPtr->compileEpoch);
+	if (procPtr != NULL) {
+	    fprintf(stdout,
+	            "  Proc 0x%x, ref ct=%d, %d args, %d compiled locals\n",
+		    (unsigned int) procPtr, procPtr->refCount,
+		    procPtr->numArgs, procPtr->numCompiledLocals);
+	}
+	fprintf(stdout, "  Source: ");
+	TclPrintSource(stdout, codePtr->source, 70);
+	fprintf(stdout, "\n");
+	fprintf(stdout, "  Chars=%d, bytes=%u, objs=%u, stk depth=%u, exc depth=%d, aux items=%d\n",
+		codePtr->numSrcChars, codePtr->numCodeBytes,
+		codePtr->numObjects, codePtr->maxStackDepth,
+		codePtr->maxExcRangeDepth, codePtr->numAuxDataItems);
+#ifdef TCL_COMPILE_STATS
+	fprintf(stdout, "  Starting stack top=%d, system objects=%ld\n",
+		eePtr->stackTop, (tclObjsAlloced - tclObjsFreed));
+#else
+	fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
+#endif /* TCL_COMPILE_STATS */
+	fflush(stdout);
+    }
+
+#ifdef TCL_COMPILE_STATS
+    numExecutions++;
+#endif /* TCL_COMPILE_STATS */
+
+    /*
+     * Make sure the catch stack is large enough to hold the maximum number
+     * of catch commands that could ever be executing at the same time. This
+     * will be no more than the exception range array's depth.
+     */
+
+    if (codePtr->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
+	catchStackPtr = (int *)
+	        ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
+    }
+
+    /*
+     * Make sure the stack has enough room to execute this ByteCode.
+     */
+
+    while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
+        GrowEvaluationStack(eePtr); 
+        stackPtr = eePtr->stackPtr;
+    }
+
+    /*
+     * Initialize the buffer that holds a string containing the name and
+     * arguments for the last invoked command.
+     */
+
+    Tcl_DStringInit(&command);
+
+    /*
+     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
+     * or some error.
+     */
+
+    for (;;) {
+        opCode = *pc;
+
+#ifdef TCL_COMPILE_DEBUG
+	if (((unsigned int) pc < (unsigned int) codePtr->codeStart)
+	        || ((unsigned int) pc > (unsigned int) (codePtr->codeStart + codePtr->numCodeBytes))) {
+	    fprintf(stderr,
+		    "\nTclExecuteByteCode: bad instruction pc 0x%x\n",
+		    (unsigned int) pc);
+	    panic("TclExecuteByteCode execution failure: bad pc");
+	}
+	if ((unsigned int) opCode > LAST_INST_OPCODE) {
+	    fprintf(stderr,
+		    "\nTclExecuteByteCode: bad opcode %d at pc %u\n",
+		    (unsigned int) opCode,
+		    (unsigned int)(pc - codePtr->codeStart));
+	    panic("TclExecuteByteCode execution failure: bad opcode");
+	}
+	if ((stackTop < initStackTop) || (stackTop > eePtr->stackEnd)) {
+	    int cmdIndex = TclGetSrcInfoForPc(pc, codePtr);
+	    fprintf(stderr,
+		    "\nTclExecuteByteCode: bad stack top %d at pc %u",
+	            stackTop, (unsigned int)(pc - codePtr->codeStart));
+	    if (cmdIndex != -1) {
+		CmdLocation *locPtr = &(codePtr->cmdMapPtr[cmdIndex]);
+		char *ellipsis = "";
+		int numChars = locPtr->numSrcChars;
+		if (numChars > 100) {
+		    numChars = 100;
+		    ellipsis = "...";
+		}
+		fprintf(stderr, "\n executing %.*s%s\n", numChars,
+			(codePtr->source + locPtr->srcOffset), ellipsis);
+	    } else {
+		fprintf(stderr, "\n");
+	    }
+	    panic("TclExecuteByteCode execution failure: bad stack top");
+	}
+#else /* not TCL_COMPILE_DEBUG - print generic trace if so requested */
+	if (traceInstructions) {
+#ifdef TCL_COMPILE_STATS
+	    fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
+		    (tclObjsAlloced - tclObjsFreed));
+#else /* TCL_COMPILE_STATS */
+	    fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
+#endif /* TCL_COMPILE_STATS */
+	    TclPrintInstruction(codePtr, pc);
+	    fflush(stdout);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+	
+#ifdef TCL_COMPILE_STATS    
+	instructionCount[opCode]++;
+#endif /* TCL_COMPILE_STATS */
+	
+        switch (opCode) {
+	case INST_DONE:
+	    /*
+	     * Pop the topmost object from the stack, set the interpreter's
+	     * object result to point to it, and return.
+	     */
+	    valuePtr = POP_OBJECT();
+	    Tcl_SetObjResult(interp, valuePtr);
+	    TclDecrRefCount(valuePtr); /* done with valuePtr */
+	    if (stackTop != initStackTop) {
+		fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d != entry stack top %d\n",
+			(unsigned int)(pc - codePtr->codeStart),
+			(unsigned int) stackTop,
+			(unsigned int) initStackTop);
+		fprintf(stderr, "  Source: ");
+		TclPrintSource(stderr, codePtr->source, 150);
+		panic("TclExecuteByteCode execution failure: end stack top != start stack top");
+	    }
+	    TRACE_WITH_OBJ(("done => return code=%d, result is ", result),
+		    iPtr->objResultPtr);
+	    goto done;
+	    
+	case INST_PUSH1:
+	    valuePtr = objArrayPtr[TclGetUInt1AtPc(pc+1)];
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPc(pc+1)),
+	            valuePtr);
+	    ADJUST_PC(2);
+	    
+	case INST_PUSH4:
+	    valuePtr = objArrayPtr[TclGetUInt4AtPc(pc+1)];
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPc(pc+1)),
+		    valuePtr);
+	    ADJUST_PC(5);
+	    
+	case INST_POP:
+	    valuePtr = POP_OBJECT();
+	    TRACE_WITH_OBJ(("pop => discarding "), valuePtr);
+	    TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
+	    ADJUST_PC(1);
+
+	case INST_DUP:
+	    valuePtr = stackPtr[stackTop].o;
+	    PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
+	    TRACE_WITH_OBJ(("dup => "), valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_CONCAT1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    {
+		Tcl_Obj *concatObjPtr;
+		int totalLen = 0;
+
+		/*
+		 * Concatenate strings (with no separators) from the top
+		 * opnd items on the stack starting with the deepest item.
+		 * First, determine how many characters are needed.
+		 */
+
+		for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
+		    valuePtr = stackPtr[i].o;
+		    bytes = TclGetStringFromObj(valuePtr, &length);
+		    if (bytes != NULL) {
+			totalLen += length;
+		    }
+                }
+
+		/*
+		 * Initialize the new append string object by appending the
+		 * strings of the opnd stack objects. Also pop the objects. 
+		 */
+
+		TclNewObj(concatObjPtr);
+		if (totalLen > 0) {
+		    char *p = (char *) ckalloc((unsigned) (totalLen + 1));
+		    concatObjPtr->bytes = p;
+		    concatObjPtr->length = totalLen;
+		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
+			valuePtr = stackPtr[i].o;
+			bytes = TclGetStringFromObj(valuePtr, &length);
+			if (bytes != NULL) {
+			    memcpy((VOID *) p, (VOID *) bytes,
+			            (size_t) length);
+			    p += length;
+			}
+			TclDecrRefCount(valuePtr);
+		    }
+		    *p = '\0';
+		} else {
+		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
+			valuePtr = stackPtr[i].o;
+			Tcl_DecrRefCount(valuePtr);
+		    }
+		}
+		stackTop -= opnd;
+		
+		PUSH_OBJECT(concatObjPtr);
+		TRACE_WITH_OBJ(("concat %u => ", opnd), concatObjPtr);
+		ADJUST_PC(2);
+            }
+	    
+	case INST_INVOKE_STK4:
+	    opnd = TclGetUInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doInvocation;
+
+	case INST_INVOKE_STK1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doInvocation:
+	    {
+		char *cmdName;
+		Command *cmdPtr;   /* Points to command's Command struct. */
+		int objc = opnd;   /* The number of arguments. */
+		Tcl_Obj **objv;	   /* The array of argument objects. */
+		Tcl_Obj *objv0Ptr; /* Holds objv[0], the command name. */
+		int newPcOffset = 0;
+				   /* Instruction offset computed during
+				    * break, continue, error processing.
+				    * Init. to avoid compiler warning. */
+		Trace *tracePtr;
+		Tcl_Command cmd;
+#ifdef TCL_COMPILE_DEBUG
+		int isUnknownCmd = 0;
+		char cmdNameBuf[30];
+#endif /* TCL_COMPILE_DEBUG */
+		
+		/*
+		 * If the interpreter was deleted, return an error.
+		 */
+		
+		if (iPtr->flags & DELETED) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		            "attempt to call eval in deleted interpreter", -1);
+		    Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+			    "attempt to call eval in deleted interpreter",
+			    (char *) NULL);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+    
+		objv = &(stackPtr[stackTop - (objc-1)].o);
+		objv0Ptr = objv[0];
+		cmdName = TclGetStringFromObj(objv0Ptr, (int *) NULL);
+		
+		/*
+		 * Find the procedure to execute this command. If there
+		 * isn't one, then see if there is a command "unknown". If
+		 * so, invoke it, passing it the original command words as
+		 * arguments.
+		 *
+		 * We convert the objv[0] object to be a CmdName object.
+		 * This caches a pointer to the Command structure for the
+		 * command; this pointer is held in a ResolvedCmdName
+		 * structure the object's internal rep. points to.
+		 */
+
+		cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
+		cmdPtr = (Command *) cmd;
+		
+		/*
+		 * If the command is still not found, handle it with the
+		 * "unknown" proc.
+		 */
+
+		if (cmdPtr == NULL) {
+		    cmd = Tcl_FindCommand(interp, "unknown",
+                            (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+                    if (cmd == (Tcl_Command) NULL) {
+			Tcl_ResetResult(interp);
+			Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			        "invalid command name \"", cmdName, "\"",
+				(char *) NULL);
+			TRACE(("%s %u => unknown proc not found: ",
+			       opName[opCode], objc));
+			result = TCL_ERROR;
+			goto checkForCatch;
+		    }
+		    cmdPtr = (Command *) cmd;
+#ifdef TCL_COMPILE_DEBUG
+		    isUnknownCmd = 1;
+#endif /*TCL_COMPILE_DEBUG*/			
+		    stackTop++; /* need room for new inserted objv[0] */
+		    for (i = objc;  i >= 0;  i--) {
+			objv[i+1] = objv[i];
+		    }
+		    objc++;
+		    objv[0] = Tcl_NewStringObj("unknown", -1);
+		    Tcl_IncrRefCount(objv[0]);
+		}
+		
+		/*
+		 * Call any trace procedures.
+		 */
+		
+		for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
+		         tracePtr = tracePtr->nextPtr) {
+		    if (iPtr->numLevels <= tracePtr->level) {
+			int cmdIndex = TclGetSrcInfoForPc(pc, codePtr);
+			if (cmdIndex != -1) {
+			    CmdLocation *locPtr =
+				    &(codePtr->cmdMapPtr[cmdIndex]);
+			    char *command =
+				    (codePtr->source + locPtr->srcOffset);
+			    int numChars = locPtr->numSrcChars;
+			    DECACHE_STACK_INFO();
+			    CallTraceProcedure(interp, tracePtr, cmdPtr,
+			            command, numChars, objc, objv);
+			    CACHE_STACK_INFO();
+			}
+		    }
+		}
+		
+		/*
+		 * Finally, invoke the command's Tcl_ObjCmdProc. First reset
+		 * the interpreter's string and object results to their
+		 * default empty values since they could have gotten changed
+		 * by earlier invocations.
+		 */
+		
+		Tcl_ResetResult(interp);
+
+		if (tclTraceExec >= 2) {
+		    char buffer[50];
+
+		    sprintf(buffer, "%d: (%u) invoking ", iPtr->numLevels,
+			    (unsigned int)(pc - codePtr->codeStart));
+		    Tcl_DStringAppend(&command, buffer, -1);
+		    
+#ifdef TCL_COMPILE_DEBUG
+		    if (traceInstructions) { /* tclTraceExec == 3 */
+			strncpy(cmdNameBuf, cmdName, 20);
+			TRACE(("%s %u => call ", opName[opCode],
+			       (isUnknownCmd? objc-1 : objc)));
+		    } else {
+			fprintf(stdout, "%s", buffer);
+		    }
+#else /* TCL_COMPILE_DEBUG */
+		    fprintf(stdout, "%s", buffer);
+#endif /*TCL_COMPILE_DEBUG*/
+
+		    for (i = 0;  i < objc;  i++) {
+			bytes = TclGetStringFromObj(objv[i], &length);
+			TclPrintSource(stdout, bytes, TclMin(length, 15));
+			fprintf(stdout, " ");
+
+			sprintf(buffer, "\"%.*s\" ", TclMin(length, 15), bytes);
+			Tcl_DStringAppend(&command, buffer, -1);
+		    }
+		    fprintf(stdout, "\n");
+		    fflush(stdout);
+
+		    Tcl_DStringFree(&command);
+		}
+
+		iPtr->cmdCount++;
+		DECACHE_STACK_INFO();
+		result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+					    objc, objv);
+		if (Tcl_AsyncReady()) {
+		    result = Tcl_AsyncInvoke(interp, result);
+		}
+		CACHE_STACK_INFO();
+
+		/*
+		 * If the interpreter has a non-empty string result, the
+		 * result object is either empty or stale because some
+		 * procedure set interp->result directly. If so, move the
+		 * string result to the result object, then reset the
+		 * string result.
+		 */
+
+		if (*(iPtr->result) != 0) {
+		    (void) Tcl_GetObjResult(interp);
+		}
+		
+		/*
+		 * Pop the objc top stack elements and decrement their ref
+		 * counts. 
+		 */
+		
+		i = (stackTop - (objc-1));
+		while (i <= stackTop) {
+		    valuePtr = stackPtr[i].o;
+		    TclDecrRefCount(valuePtr);
+		    i++;
+		}
+		stackTop -= objc;
+
+		/*
+		 * Process the result of the Tcl_ObjCmdProc call.
+		 */
+		
+		switch (result) {
+		case TCL_OK:
+		    /*
+		     * Push the call's object result and continue execution
+		     * with the next instruction.
+		     */
+		    PUSH_OBJECT(Tcl_GetObjResult(interp));
+		    TRACE_WITH_OBJ(("%s %u => ...after \"%.20s\", result=",
+		            opName[opCode], objc, cmdNameBuf),
+			    Tcl_GetObjResult(interp));
+		    ADJUST_PC(pcAdjustment);
+		    
+		case TCL_BREAK:
+		case TCL_CONTINUE:
+		    /*
+		     * The invoked command requested a break or continue.
+		     * Find the closest enclosing loop or catch exception
+		     * range, if any. If a loop is found, terminate its
+		     * execution or skip to its next iteration. If the
+		     * closest is a catch exception range, jump to its
+		     * catchOffset. If no enclosing range is found, stop
+		     * execution and return the TCL_BREAK or TCL_CONTINUE.
+		     */
+		    rangePtr = TclGetExceptionRangeForPc(pc,
+                            /*catchOnly*/ 0, codePtr);
+		    if (rangePtr == NULL) {
+		        TRACE(("%s %u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
+		                opName[opCode], objc, cmdNameBuf,
+			        StringForResultCode(result)));
+			goto abnormalReturn; /* no catch exists to check */
+		    }
+		    switch (rangePtr->type) {
+		    case LOOP_EXCEPTION_RANGE:
+			if (result == TCL_BREAK) {
+			    newPcOffset = rangePtr->breakOffset;
+			} else if (rangePtr->continueOffset == -1) {
+			    TRACE(("%s %u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
+				   opName[opCode], objc, cmdNameBuf,
+				   StringForResultCode(result)));
+			    goto checkForCatch;
+			} else {
+			    newPcOffset = rangePtr->continueOffset;
+			}
+			TRACE(("%s %u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
+			       opName[opCode], objc, cmdNameBuf,
+			       StringForResultCode(result),
+			       rangePtr->codeOffset, newPcOffset));
+			break;
+		    case CATCH_EXCEPTION_RANGE:
+			TRACE(("%s %u => ... after \"%.20s\", %s...\n",
+			       opName[opCode], objc, cmdNameBuf,
+			       StringForResultCode(result)));
+			goto processCatch; /* it will use rangePtr */
+		    default:
+			panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+		    }
+		    result = TCL_OK;
+		    pc = (codePtr->codeStart + newPcOffset);
+		    continue;	/* restart outer instruction loop at pc */
+		    
+		case TCL_ERROR:
+		    /*
+		     * The invoked command returned an error. Record
+		     * information about what was being executed when the
+		     * error occurred, then look for an enclosing catch
+		     * exception range, if any.
+		     */
+		    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", TCL_ERROR ",
+		            opName[opCode], objc, cmdNameBuf),
+			    Tcl_GetObjResult(interp));
+		    if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                        char buf[200];
+                        int cmdIndex = TclGetSrcInfoForPc(pc, codePtr);
+                        if (cmdIndex != -1) {
+                            CmdLocation *locPtr =
+                                &(codePtr->cmdMapPtr[cmdIndex]);
+                            char *ellipsis = "";
+                            int numChars = locPtr->numSrcChars;
+                            if (numChars > 150) {
+                                numChars = 150;
+                                ellipsis = "...";
+                            }
+                            if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+                                sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+                                        numChars,
+                                        (codePtr->source + locPtr->srcOffset),
+                                        ellipsis);
+                            } else {
+                                sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+                                        numChars, 
+                                        (codePtr->source + locPtr->srcOffset),
+                                        ellipsis);
+                            }
+                            Tcl_AddObjErrorInfo(interp, buf, -1);
+                            iPtr->flags |= ERR_ALREADY_LOGGED;
+                        }
+                    }
+		    goto checkForCatch;
+
+		case TCL_RETURN:
+		    /*
+		     * The invoked command requested that the current
+		     * procedure stop execution and return. First check
+		     * for an enclosing catch exception range, if any.
+		     */
+		    TRACE(("%s %u => ... after \"%.20s\", TCL_RETURN\n",
+		            opName[opCode], objc, cmdNameBuf));
+		    goto checkForCatch;
+
+		default:
+		    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", OTHER RETURN CODE %d ",
+		            opName[opCode], objc, cmdNameBuf, result),
+			    Tcl_GetObjResult(interp));
+		    goto checkForCatch;
+		} /* end of switch on result from invoke instruction */
+	    }
+	    
+	case INST_EVAL_STK:
+	    objPtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    result = Tcl_EvalObj(interp, objPtr);
+	    CACHE_STACK_INFO();
+	    if (result == TCL_OK) {
+		/*
+		 * Normal return; push the eval's object result.
+		 */
+		
+		PUSH_OBJECT(Tcl_GetObjResult(interp));
+		TRACE_WITH_OBJ(("evalStk \"%.30s\" => ", O2S(objPtr)),
+			Tcl_GetObjResult(interp));
+		TclDecrRefCount(objPtr);    /* done with popped object */
+		ADJUST_PC(1);
+	    } else if ((result == TCL_BREAK) || (result == TCL_CONTINUE)) {
+		/*
+		 * Find the closest enclosing loop or catch exception range,
+		 * if any. If a loop is found, terminate its execution or
+		 * skip to its next iteration. If the closest is a catch
+		 * exception range, jump to its catchOffset. If no enclosing
+		 * range is found, stop execution and return that same
+		 * TCL_BREAK or TCL_CONTINUE.
+		 */
+
+		int newPcOffset = 0; /* Pc offset computed during break,
+				      * continue, error processing. Init.
+				      * to avoid compiler warning. */
+
+		rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+			codePtr);
+		if (rangePtr == NULL) {
+		    TRACE(("evalStk \"%.30s\" => no encl. loop or catch, returning %s\n",
+			    O2S(objPtr), StringForResultCode(result)));
+		    Tcl_DecrRefCount(objPtr); /* done with popped obj */
+		    goto abnormalReturn;    /* no catch exists to check */
+		}
+		switch (rangePtr->type) {
+		case LOOP_EXCEPTION_RANGE:
+		    if (result == TCL_BREAK) {
+			newPcOffset = rangePtr->breakOffset;
+		    } else if (rangePtr->continueOffset == -1) {
+			TRACE(("evalStk \"%.30s\" => %s, loop w/o continue, checking for catch\n",
+			       O2S(objPtr), StringForResultCode(result)));
+			Tcl_DecrRefCount(objPtr); /* done with popped obj */
+			goto checkForCatch;
+		    } else {
+			newPcOffset = rangePtr->continueOffset;
+		    }
+		    result = TCL_OK;
+		    TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s, range at %d, new pc %d ",
+			    O2S(objPtr), StringForResultCode(result),
+			    rangePtr->codeOffset, newPcOffset), valuePtr);
+		    break;
+		case CATCH_EXCEPTION_RANGE:
+		    TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s ",
+			    O2S(objPtr), StringForResultCode(result)),
+			    valuePtr);
+		    Tcl_DecrRefCount(objPtr); /* done with popped obj */
+		    goto processCatch;  /* it will use rangePtr */
+		default:
+		    panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+		}
+		Tcl_DecrRefCount(objPtr);	/* done with popped obj */
+		pc = (codePtr->codeStart + newPcOffset);
+		continue;	/* restart outer instruction loop at pc */
+	    } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
+		TRACE_WITH_OBJ(("evalStk \"%.30s\" => ERROR: ", O2S(objPtr)),
+		        Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(objPtr);	 /* done with popped obj */
+		goto checkForCatch;
+	    }
+
+	case INST_EXPR_STK:
+	    objPtr = POP_OBJECT();
+	    Tcl_ResetResult(interp);
+	    DECACHE_STACK_INFO();
+	    result = Tcl_ExprObj(interp, objPtr, &valuePtr);
+	    CACHE_STACK_INFO();
+	    if (result != TCL_OK) {
+		TRACE_WITH_OBJ(("exprStk \"%.30s\" => ERROR: ", 
+		        O2S(objPtr)), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(objPtr); /* done with popped object */
+		goto checkForCatch;
+	    }
+	    stackPtr[++stackTop].o = valuePtr; /* already has right refct */
+	    TRACE_WITH_OBJ(("exprStk \"%.30s\" => ", O2S(objPtr)), valuePtr);
+	    TclDecrRefCount(objPtr);     /* done with popped object */
+	    ADJUST_PC(1);
+
+	case INST_LOAD_SCALAR4:
+	    opnd = TclGetInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doLoadScalar;
+
+	case INST_LOAD_SCALAR1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doLoadScalar:
+	    DECACHE_STACK_INFO();
+	    valuePtr = TclGetIndexedScalar(interp, opnd,
+					   /*leaveErrorMsg*/ 1);
+	    CACHE_STACK_INFO();
+	    if (valuePtr == NULL) {
+		TRACE_WITH_OBJ(("%s %u => ERROR: ", opName[opCode], opnd),
+			Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		goto checkForCatch;
+            }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("%s %u => ", opName[opCode], opnd), valuePtr);
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_LOAD_SCALAR_STK:
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, (Tcl_Obj *) NULL, 
+				      TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (valuePtr == NULL) {
+		TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ERROR: ",
+		        O2S(namePtr)), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr); /* done with popped name. */
+		result = TCL_ERROR;
+		goto checkForCatch;
+            }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ",
+		    O2S(namePtr)), valuePtr);
+	    TclDecrRefCount(namePtr);     /* done with popped name. */
+	    ADJUST_PC(1);
+
+	case INST_LOAD_ARRAY4:
+	    opnd = TclGetUInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doLoadArray;
+
+	case INST_LOAD_ARRAY1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doLoadArray:
+	    {
+		Tcl_Obj *elemPtr = POP_OBJECT();
+		
+		DECACHE_STACK_INFO();
+		valuePtr = TclGetElementOfIndexedArray(interp, opnd,
+	                elemPtr, /*leaveErrorMsg*/ 1);
+		CACHE_STACK_INFO();
+		if (valuePtr == NULL) {
+		    TRACE_WITH_OBJ(("%s %u \"%.30s\" => ERROR: ",
+			    opName[opCode], opnd, O2S(elemPtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr); /* done with element name. */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(valuePtr);
+		TRACE_WITH_OBJ(("%s %u \"%.30s\" => ",
+		        opName[opCode], opnd, O2S(elemPtr)), valuePtr);
+		TclDecrRefCount(elemPtr);      /* done with element name. */
+	    }
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_LOAD_ARRAY_STK:
+	    {
+		Tcl_Obj *elemPtr = POP_OBJECT();
+		
+		namePtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		valuePtr = Tcl_ObjGetVar2(interp, namePtr, elemPtr,
+		        TCL_LEAVE_ERR_MSG);
+		CACHE_STACK_INFO();
+		if (valuePtr == NULL) {
+		    TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr); /* done with array name */
+		    Tcl_DecrRefCount(elemPtr); /* and element name. */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(valuePtr);
+		TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ",
+		        O2S(namePtr), O2S(elemPtr)), valuePtr);
+		TclDecrRefCount(namePtr);     /* done with array name */
+		TclDecrRefCount(elemPtr);     /* and element name. */
+	    }
+	    ADJUST_PC(1);
+
+	case INST_LOAD_STK:
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL,
+		    TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (valuePtr == NULL) {
+		TRACE_WITH_OBJ(("loadStk \"%.30s\" => ERROR: ",
+		        O2S(namePtr)), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr); /* done with popped name. */
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("loadStk \"%.30s\" => ", O2S(namePtr)),
+		    valuePtr);
+	    TclDecrRefCount(namePtr);     /* done with popped name. */
+	    ADJUST_PC(1);
+	    
+	case INST_STORE_SCALAR4:
+	    opnd = TclGetUInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doStoreScalar;
+
+	case INST_STORE_SCALAR1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	  doStoreScalar:
+	    valuePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclSetIndexedScalar(interp, opnd, valuePtr,
+					      /*leaveErrorMsg*/ 1);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ERROR: ",
+			opName[opCode], opnd, O2S(valuePtr)),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(valuePtr); /* done with popped value. */
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ",
+		    opName[opCode], opnd, O2S(valuePtr)), value2Ptr);
+	    TclDecrRefCount(valuePtr);      /* done with popped value. */
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_STORE_SCALAR_STK:
+	    valuePtr = POP_OBJECT();
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
+	            TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(
+			("storeScalarStk \"%.30s\" <- \"%.30s\" => ERROR: ",
+		        O2S(namePtr), O2S(valuePtr)),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);  /* done with popped name. */
+		Tcl_DecrRefCount(valuePtr); /* done with popped value. */
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(
+		    ("storeScalarStk \"%.30s\" <- \"%.30s\" => ",
+		    O2S(namePtr),
+		    O2S(valuePtr)),
+		    value2Ptr);
+	    TclDecrRefCount(namePtr);      /* done with popped name. */
+	    TclDecrRefCount(valuePtr);     /* done with popped value. */
+	    ADJUST_PC(1);
+
+	case INST_STORE_ARRAY4:
+	    opnd = TclGetUInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doStoreArray;
+
+	case INST_STORE_ARRAY1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doStoreArray:
+	    {
+		Tcl_Obj *elemPtr;
+
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = TclSetElementOfIndexedArray(interp, opnd,
+		        elemPtr, valuePtr, TCL_LEAVE_ERR_MSG);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(
+			    ("%s %u \"%.30s\" <- \"%.30s\" => ERROR: ",
+			    opName[opCode], opnd, O2S(elemPtr),
+			    O2S(valuePtr)), Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr);  /* done with element name */
+		    Tcl_DecrRefCount(valuePtr); /* done with popped value */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("%s %u \"%.30s\" <- \"%.30s\" => ",
+		        opName[opCode], opnd, O2S(elemPtr), O2S(valuePtr)),
+		        value2Ptr);
+		TclDecrRefCount(elemPtr);       /* done with element name */
+		TclDecrRefCount(valuePtr);      /* done with popped value */
+	    }
+	    ADJUST_PC(pcAdjustment);
+
+	case INST_STORE_ARRAY_STK:
+	    {
+		Tcl_Obj *elemPtr;
+
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		namePtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = Tcl_ObjSetVar2(interp, namePtr, elemPtr,
+		        valuePtr, TCL_LEAVE_ERR_MSG);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);  /* done with array name, */
+		    Tcl_DecrRefCount(elemPtr);  /* the element name, */
+		    Tcl_DecrRefCount(valuePtr); /* and the popped value. */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ",
+		        O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			value2Ptr);
+		TclDecrRefCount(namePtr);       /* done with array name, */
+		TclDecrRefCount(elemPtr);       /* the element name, */
+		TclDecrRefCount(valuePtr);      /* and popped value. */
+	    }
+	    ADJUST_PC(1);
+
+	case INST_STORE_STK:
+	    valuePtr = POP_OBJECT();
+	    namePtr = POP_OBJECT();
+	    DECACHE_STACK_INFO();
+	    value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
+		    TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ERROR: ",
+		        O2S(namePtr), O2S(valuePtr)),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);  /* done with popped name. */
+		Tcl_DecrRefCount(valuePtr); /* and popped value. */
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ",
+		    O2S(namePtr), O2S(valuePtr)), value2Ptr);
+	    TclDecrRefCount(namePtr);       /* done with popped name */
+	    TclDecrRefCount(valuePtr);      /* and popped value. */
+	    ADJUST_PC(1);
+
+	case INST_INCR_SCALAR1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    valuePtr = POP_OBJECT(); 
+	    if (valuePtr->typePtr != &tclIntType) {
+		result = tclIntType.setFromAnyProc(interp, valuePtr);
+		if (result != TCL_OK) {
+		    TRACE_WITH_OBJ(("incrScalar1 %u (by %s) => ERROR converting increment amount to int: ",
+		            opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(valuePtr);  /* done with incr amount */
+		    goto checkForCatch;
+		}
+	    }
+	    i = valuePtr->internalRep.longValue;
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ERROR: ",
+		        opnd, i), Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(valuePtr);      /* done with incr amount */
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ", opnd, i),
+		    value2Ptr);
+	    TclDecrRefCount(valuePtr);           /* done with incr amount */
+	    ADJUST_PC(2);
+
+	case INST_INCR_SCALAR_STK:
+	case INST_INCR_STK:
+	    valuePtr = POP_OBJECT();
+	    namePtr = POP_OBJECT();
+	    if (valuePtr->typePtr != &tclIntType) {
+		result = tclIntType.setFromAnyProc(interp, valuePtr);
+		if (result != TCL_OK) {
+		    TRACE_WITH_OBJ(("%s \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
+		            opName[opCode], O2S(namePtr), O2S(valuePtr)),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);   /* done with var name */
+		    Tcl_DecrRefCount(valuePtr);  /* done with incr amount */
+		    goto checkForCatch;
+		}
+	    }
+	    i = valuePtr->internalRep.longValue;
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
+	        /*part1NotParsed*/ (opCode == INST_INCR_STK));
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ERROR: ",
+		        opName[opCode], O2S(namePtr), i),
+			Tcl_GetObjResult(interp));
+		Tcl_DecrRefCount(namePtr);       /* done with var name */
+		Tcl_DecrRefCount(valuePtr);      /* done with incr amount */
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ",
+	            opName[opCode], O2S(namePtr), i), value2Ptr);
+	    Tcl_DecrRefCount(namePtr);           /* done with var name */
+	    Tcl_DecrRefCount(valuePtr);          /* done with incr amount */
+	    ADJUST_PC(1);
+
+	case INST_INCR_ARRAY1:
+	    {
+		Tcl_Obj *elemPtr;
+
+		opnd = TclGetUInt1AtPc(pc+1);
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		if (valuePtr->typePtr != &tclIntType) {
+		    result = tclIntType.setFromAnyProc(interp, valuePtr);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
+		                opnd, O2S(elemPtr), O2S(valuePtr)),
+			        Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(elemPtr);  /* done w elem name */
+			Tcl_DecrRefCount(valuePtr); /* done w incr amount */
+			goto checkForCatch;
+		    }
+		}
+		i = valuePtr->internalRep.longValue;
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
+		        elemPtr, i);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ERROR: ",
+		            opnd, O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr);   /* done w element name */
+		    Tcl_DecrRefCount(valuePtr);  /* done w incr amount */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ",
+	                opnd, O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(elemPtr);       /* done w element name */
+		Tcl_DecrRefCount(valuePtr);      /* done w incr amount */
+	    }
+	    ADJUST_PC(2);
+	    
+	case INST_INCR_ARRAY_STK:
+	    {
+		Tcl_Obj *elemPtr;
+
+		valuePtr = POP_OBJECT();
+		elemPtr = POP_OBJECT();
+		namePtr = POP_OBJECT();
+		if (valuePtr->typePtr != &tclIntType) {
+		    result = tclIntType.setFromAnyProc(interp, valuePtr);
+		    if (result != TCL_OK) {
+		        TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
+		                O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			        Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(namePtr);  /* done w array name */
+			Tcl_DecrRefCount(elemPtr);  /* done w elem name */
+			Tcl_DecrRefCount(valuePtr); /* done w incr amount */
+			goto checkForCatch;
+		    }
+		}
+		i = valuePtr->internalRep.longValue;
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
+					/*part1NotParsed*/ 0);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr);      /* done w array name */
+		    Tcl_DecrRefCount(elemPtr);      /* done w elem name */
+		    Tcl_DecrRefCount(valuePtr);     /* done w incr amount */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ",
+	                O2S(namePtr), O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(namePtr);          /* done w array name */
+		Tcl_DecrRefCount(elemPtr);          /* done w elem name */
+		Tcl_DecrRefCount(valuePtr);         /* done w incr amount */
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_INCR_SCALAR1_IMM:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    i = TclGetInt1AtPc(pc+2);
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ERROR: ",
+		        opnd, i), Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ", opnd, i),
+		    value2Ptr);
+	    ADJUST_PC(3);
+
+	case INST_INCR_SCALAR_STK_IMM:
+	case INST_INCR_STK_IMM:
+	    namePtr = POP_OBJECT();
+	    i = TclGetInt1AtPc(pc+1);
+	    DECACHE_STACK_INFO();
+	    value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
+		    /*part1NotParsed*/ (opCode == INST_INCR_STK_IMM));
+	    CACHE_STACK_INFO();
+	    if (value2Ptr == NULL) {
+		TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ERROR: ",
+		        opName[opCode], O2S(namePtr), i),
+			Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		Tcl_DecrRefCount(namePtr);  /* done with var name */
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ",
+	            opName[opCode], O2S(namePtr), i), value2Ptr);
+	    TclDecrRefCount(namePtr);       /* done with var name */
+	    ADJUST_PC(2);
+
+	case INST_INCR_ARRAY1_IMM:
+	    {
+		Tcl_Obj *elemPtr;
+
+		opnd = TclGetUInt1AtPc(pc+1);
+		i = TclGetInt1AtPc(pc+2);
+		elemPtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
+		        elemPtr, i);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ERROR: ",
+		            opnd, O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(elemPtr); /* done with element name */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ",
+	                opnd, O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(elemPtr);     /* done with element name */
+	    }
+	    ADJUST_PC(3);
+	    
+	case INST_INCR_ARRAY_STK_IMM:
+	    {
+		Tcl_Obj *elemPtr;
+
+		i = TclGetInt1AtPc(pc+1);
+		elemPtr = POP_OBJECT();
+		namePtr = POP_OBJECT();
+		DECACHE_STACK_INFO();
+		value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
+		        /*part1NotParsed*/ 0);
+		CACHE_STACK_INFO();
+		if (value2Ptr == NULL) {
+		    TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ERROR: ",
+		            O2S(namePtr), O2S(elemPtr), i),
+			    Tcl_GetObjResult(interp));
+		    Tcl_DecrRefCount(namePtr); /* done with array name */
+		    Tcl_DecrRefCount(elemPtr); /* done with element name */
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ",
+	                O2S(namePtr), O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(namePtr);     /* done with array name */
+		Tcl_DecrRefCount(elemPtr);     /* done with element name */
+	    }
+	    ADJUST_PC(2);
+
+	case INST_JUMP1:
+	    opnd = TclGetInt1AtPc(pc+1);
+	    TRACE(("jump1 %d => new pc %u\n", opnd,
+		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    ADJUST_PC(opnd);
+
+	case INST_JUMP4:
+	    opnd = TclGetInt4AtPc(pc+1);
+	    TRACE(("jump4 %d => new pc %u\n", opnd,
+		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    ADJUST_PC(opnd);
+
+	case INST_JUMP_TRUE4:
+	    opnd = TclGetInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doJumpTrue;
+
+	case INST_JUMP_TRUE1:
+	    opnd = TclGetInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doJumpTrue:
+	    {
+		int b;
+		
+		valuePtr = POP_OBJECT();
+		if (valuePtr->typePtr == &tclIntType) {
+		    b = (valuePtr->internalRep.longValue != 0);
+		} else if (valuePtr->typePtr == &tclDoubleType) {
+		    b = (valuePtr->internalRep.doubleValue != 0.0);
+		} else {
+		    result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
+				opnd), Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(valuePtr); /* done w popped obj */
+			goto checkForCatch;
+		    }
+		}
+		if (b) {
+		    TRACE(("%s %d => %.20s true, new pc %u\n",
+			    opName[opCode], opnd, O2S(valuePtr),
+		            (unsigned int)(pc+opnd - codePtr->codeStart)));
+		    TclDecrRefCount(valuePtr); /* done with popped obj */
+		    ADJUST_PC(opnd);
+		} else {
+		    TRACE(("%s %d => %.20s false\n", opName[opCode], opnd,
+		            O2S(valuePtr)));
+		    TclDecrRefCount(valuePtr); /* done with popped obj */
+		    ADJUST_PC(pcAdjustment);
+		}
+	    }
+	    
+	case INST_JUMP_FALSE4:
+	    opnd = TclGetInt4AtPc(pc+1);
+	    pcAdjustment = 5;
+	    goto doJumpFalse;
+
+	case INST_JUMP_FALSE1:
+	    opnd = TclGetInt1AtPc(pc+1);
+	    pcAdjustment = 2;
+	    
+	    doJumpFalse:
+	    {
+		int b;
+		
+		valuePtr = POP_OBJECT();
+		if (valuePtr->typePtr == &tclIntType) {
+		    b = (valuePtr->internalRep.longValue != 0);
+		} else if (valuePtr->typePtr == &tclDoubleType) {
+		    b = (valuePtr->internalRep.doubleValue != 0.0);
+		} else {
+		    result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
+				opnd), Tcl_GetObjResult(interp));
+			Tcl_DecrRefCount(valuePtr); /* done w popped obj */
+			goto checkForCatch;
+		    }
+		}
+		if (b) {
+		    TRACE(("%s %d => %.20s true\n", opName[opCode], opnd,
+		            O2S(valuePtr)));
+		    TclDecrRefCount(valuePtr); /* done with popped obj */
+		    ADJUST_PC(pcAdjustment);
+		} else {
+		    TRACE(("%s %d => %.20s false, new pc %u\n",
+			    opName[opCode], opnd, O2S(valuePtr),
+			   (unsigned int)(pc + opnd - codePtr->codeStart)));
+		    TclDecrRefCount(valuePtr); /* done with popped obj */
+		    ADJUST_PC(opnd);
+		}
+	    }
+	    
+	case INST_LOR:
+	case INST_LAND:
+	    {
+		/*
+		 * Operands must be numeric, but no int->double conversions
+		 * are performed.
+		 */
+		
+		long i2, iResult;
+		double d1;
+		char *s;
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if (t1Ptr == &tclIntType) {
+		    i = (valuePtr->internalRep.longValue != 0);
+		} else if (t1Ptr == &tclDoubleType) {
+		    i = (valuePtr->internalRep.doubleValue != 0.0);
+		} else {	/* FAILS IF NULL STRING REP */
+		    s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+			i = (valuePtr->internalRep.longValue != 0);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d1);
+			i = (valuePtr->internalRep.doubleValue != 0.0);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
+			        opName[opCode], O2S(valuePtr),
+			        (t1Ptr? t1Ptr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		}
+		
+		if (t2Ptr == &tclIntType) {
+		    i2 = (value2Ptr->internalRep.longValue != 0);
+		} else if (t2Ptr == &tclDoubleType) {
+		    i2 = (value2Ptr->internalRep.doubleValue != 0.0);
+		} else {	/* FAILS IF NULL STRING REP */
+		    s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+			i2 = (value2Ptr->internalRep.longValue != 0);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &d1);
+			i2 = (value2Ptr->internalRep.doubleValue != 0.0);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
+			        opName[opCode], O2S(value2Ptr),
+			        (t2Ptr? t2Ptr->name : "null")));
+			IllegalExprOperandType(interp, opCode, value2Ptr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		}
+		
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+
+		if (opCode == INST_LOR) {
+		    iResult = (i || i2);
+		} else {
+		    iResult = (i && i2);
+		}
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %.20s %.20s => %ld\n", opName[opCode],
+			   O2S(valuePtr), O2S(value2Ptr), iResult));
+		    TclDecrRefCount(valuePtr);    /* done with object */
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %.20s %.20s => %ld\n", 
+			   opName[opCode], /* NB: stack top is off by 1 */
+			   O2S(valuePtr), O2S(value2Ptr), iResult));
+		    Tcl_SetLongObj(valuePtr, iResult);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);   /* done with object */
+	    }
+	    ADJUST_PC(1);
+
+	case INST_EQ:
+	case INST_NEQ:
+	case INST_LT:
+	case INST_GT:
+	case INST_LE:
+	case INST_GE:
+	    {
+		/*
+		 * Any type is allowed but the two operands must have the
+	         * same type. We will compute value op value2.
+		 */
+
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		char *s1 = NULL;   /* Init. avoids compiler warning. */
+		char *s2 = NULL;   /* Init. avoids compiler warning. */
+		long i2 = 0;	   /* Init. avoids compiler warning. */
+		double d1 = 0.0;   /* Init. avoids compiler warning. */
+		double d2 = 0.0;   /* Init. avoids compiler warning. */
+		long iResult = 0;  /* Init. avoids compiler warning. */
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
+		    s1 = Tcl_GetStringFromObj(valuePtr, &length);
+		    if (TclLooksLikeInt(s1)) { /* FAILS IF NULLS */
+			(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d1);
+		    }
+		    t1Ptr = valuePtr->typePtr;
+		}
+		if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
+		    s2 = Tcl_GetStringFromObj(value2Ptr, &length);
+		    if (TclLooksLikeInt(s2)) { /* FAILS IF NULLS */
+			(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+		    } else {
+			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &d2);
+		    }
+		    t2Ptr = value2Ptr->typePtr;
+		}
+
+		if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
+		        || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
+		    /*
+		     * One operand is not numeric. Compare as strings.
+		     * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
+		     */
+		    int cmpValue;
+		    s1 = TclGetStringFromObj(valuePtr, &length);
+		    s2 = TclGetStringFromObj(value2Ptr, &length);
+		    cmpValue = strcmp(s1, s2);
+		    switch (opCode) {
+		    case INST_EQ:
+			iResult = (cmpValue == 0);
+			break;
+		    case INST_NEQ:
+			iResult = (cmpValue != 0);
+			break;
+		    case INST_LT:
+			iResult = (cmpValue < 0);
+			break;
+		    case INST_GT:
+			iResult = (cmpValue > 0);
+			break;
+		    case INST_LE:
+			iResult = (cmpValue <= 0);
+			break;
+		    case INST_GE:
+			iResult = (cmpValue >= 0);
+			break;
+		    }
+		} else if ((t1Ptr == &tclDoubleType)
+		        || (t2Ptr == &tclDoubleType)) {
+		    /*
+		     * Compare as doubles.
+		     */
+		    if (t1Ptr == &tclDoubleType) {
+			d1 = valuePtr->internalRep.doubleValue;
+			if (t2Ptr == &tclIntType) {
+			    d2 = value2Ptr->internalRep.longValue;
+			} else {
+			    d2 = value2Ptr->internalRep.doubleValue;
+			}
+		    } else {	/* t1Ptr is int, t2Ptr is double */
+			d1 = valuePtr->internalRep.longValue;
+			d2 = value2Ptr->internalRep.doubleValue;
+		    }
+		    switch (opCode) {
+		    case INST_EQ:
+			iResult = d1 == d2;
+			break;
+		    case INST_NEQ:
+			iResult = d1 != d2;
+			break;
+		    case INST_LT:
+			iResult = d1 < d2;
+			break;
+		    case INST_GT:
+			iResult = d1 > d2;
+			break;
+		    case INST_LE:
+			iResult = d1 <= d2;
+			break;
+		    case INST_GE:
+			iResult = d1 >= d2;
+			break;
+		    }
+		} else {
+		    /*
+		     * Compare as ints.
+		     */
+		    i  = valuePtr->internalRep.longValue;
+		    i2 = value2Ptr->internalRep.longValue;
+		    switch (opCode) {
+		    case INST_EQ:
+			iResult = i == i2;
+			break;
+		    case INST_NEQ:
+			iResult = i != i2;
+			break;
+		    case INST_LT:
+			iResult = i < i2;
+			break;
+		    case INST_GT:
+			iResult = i > i2;
+			break;
+		    case INST_LE:
+			iResult = i <= i2;
+			break;
+		    case INST_GE:
+			iResult = i >= i2;
+			break;
+		    }
+		}
+
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %.20s %.20s => %ld\n", opName[opCode],
+		        O2S(valuePtr), O2S(value2Ptr), iResult));
+		    TclDecrRefCount(valuePtr);    /* done with object */
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %.20s %.20s => %ld\n",
+			opName[opCode], /* NB: stack top is off by 1 */
+		        O2S(valuePtr), O2S(value2Ptr), iResult));
+		    Tcl_SetLongObj(valuePtr, iResult);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);   /* done with object */
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_MOD:
+	case INST_LSHIFT:
+	case INST_RSHIFT:
+	case INST_BITOR:
+	case INST_BITXOR:
+	case INST_BITAND:
+	    {
+		/*
+		 * Only integers are allowed. We compute value op value2.
+		 */
+
+		long i2, rem, negative;
+		long iResult = 0; /* Init. avoids compiler warning. */
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT(); 
+		if (valuePtr->typePtr == &tclIntType) {
+		    i = valuePtr->internalRep.longValue;
+		} else {	/* try to convert to int */
+		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+			    valuePtr, &i);
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
+			      opName[opCode], O2S(valuePtr), O2S(value2Ptr),
+			      (valuePtr->typePtr?
+				   valuePtr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		}
+		if (value2Ptr->typePtr == &tclIntType) {
+		    i2 = value2Ptr->internalRep.longValue;
+		} else {
+		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+			    value2Ptr, &i2);
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+			      opName[opCode], O2S(valuePtr), O2S(value2Ptr),
+			      (value2Ptr->typePtr?
+				   value2Ptr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, value2Ptr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		}
+
+		switch (opCode) {
+		case INST_MOD:
+		    /*
+		     * This code is tricky: C doesn't guarantee much about
+		     * the quotient or remainder, but Tcl does. The
+		     * remainder always has the same sign as the divisor and
+		     * a smaller absolute value.
+		     */
+		    if (i2 == 0) {
+			TRACE(("mod %ld %ld => DIVIDE BY ZERO\n", i, i2));
+			Tcl_DecrRefCount(valuePtr);   /* done with object */
+			Tcl_DecrRefCount(value2Ptr);  /* done with object */
+			goto divideByZero;
+		    }
+		    negative = 0;
+		    if (i2 < 0) {
+			i2 = -i2;
+			i = -i;
+			negative = 1;
+		    }
+		    rem  = i % i2;
+		    if (rem < 0) {
+			rem += i2;
+		    }
+		    if (negative) {
+			rem = -rem;
+		    }
+		    iResult = rem;
+		    break;
+		case INST_LSHIFT:
+		    iResult = i << i2;
+		    break;
+		case INST_RSHIFT:
+		    /*
+		     * The following code is a bit tricky: it ensures that
+		     * right shifts propagate the sign bit even on machines
+		     * where ">>" won't do it by default.
+		     */
+		    if (i < 0) {
+			iResult = ~((~i) >> i2);
+		    } else {
+			iResult = i >> i2;
+		    }
+		    break;
+		case INST_BITOR:
+		    iResult = i | i2;
+		    break;
+		case INST_BITXOR:
+		    iResult = i ^ i2;
+		    break;
+		case INST_BITAND:
+		    iResult = i & i2;
+		    break;
+		}
+
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
+			   iResult));
+		    TclDecrRefCount(valuePtr);    /* done with object */
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
+		        iResult)); /* NB: stack top is off by 1 */
+		    Tcl_SetLongObj(valuePtr, iResult);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);   /* done with object */
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_ADD:
+	case INST_SUB:
+	case INST_MULT:
+	case INST_DIV:
+	    {
+		/*
+		 * Operands must be numeric and ints get converted to floats
+		 * if necessary. We compute value op value2.
+		 */
+
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		long i2, quot, rem;
+		double d1, d2;
+		long iResult = 0;     /* Init. avoids compiler warning. */
+		double dResult = 0.0; /* Init. avoids compiler warning. */
+		int doDouble = 0;     /* 1 if doing floating arithmetic */
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if (t1Ptr == &tclIntType) {
+		    i  = valuePtr->internalRep.longValue;
+		} else if (t1Ptr == &tclDoubleType) {
+		    d1 = valuePtr->internalRep.doubleValue;
+		} else {	     /* try to convert; FAILS IF NULLS */
+		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d1);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
+			       opName[opCode], s, O2S(value2Ptr),
+			       (valuePtr->typePtr?
+				    valuePtr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		    t1Ptr = valuePtr->typePtr;
+		}
+		
+		if (t2Ptr == &tclIntType) {
+		    i2 = value2Ptr->internalRep.longValue;
+		} else if (t2Ptr == &tclDoubleType) {
+		    d2 = value2Ptr->internalRep.doubleValue;
+		} else {	     /* try to convert; FAILS IF NULLS */
+		    char *s = Tcl_GetStringFromObj(value2Ptr, &length);
+		    if (TclLooksLikeInt(s)) {
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &d2);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+			       opName[opCode], O2S(valuePtr), s,
+			       (value2Ptr->typePtr?
+				    value2Ptr->typePtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, value2Ptr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		    t2Ptr = value2Ptr->typePtr;
+		}
+
+		if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
+		    /*
+		     * Do double arithmetic.
+		     */
+		    doDouble = 1;
+		    if (t1Ptr == &tclIntType) {
+			d1 = i;       /* promote value 1 to double */
+		    } else if (t2Ptr == &tclIntType) {
+			d2 = i2;      /* promote value 2 to double */
+		    }
+		    switch (opCode) {
+		    case INST_ADD:
+			dResult = d1 + d2;
+			break;
+		    case INST_SUB:
+			dResult = d1 - d2;
+			break;
+		    case INST_MULT:
+			dResult = d1 * d2;
+			break;
+		    case INST_DIV:
+			if (d2 == 0.0) {
+			    TRACE(("div %.6g %.6g => DIVIDE BY ZERO\n",
+				   d1, d2));
+			    Tcl_DecrRefCount(valuePtr);  /* done with obj */
+			    Tcl_DecrRefCount(value2Ptr); /* done with obj */
+			    goto divideByZero;
+			}
+			dResult = d1 / d2;
+			break;
+		    }
+		    
+		    /*
+		     * Check now for IEEE floating-point error.
+		     */
+		    
+		    if (IS_NAN(dResult) || IS_INF(dResult)) {
+			TRACE(("%s %.20s %.20s => IEEE FLOATING PT ERROR\n",
+			       opName[opCode], O2S(valuePtr), O2S(value2Ptr)));
+			TclExprFloatError(interp, dResult);
+			result = TCL_ERROR;
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			Tcl_DecrRefCount(value2Ptr); /* done with object */
+			goto checkForCatch;
+		    }
+		} else {
+		    /*
+		     * Do integer arithmetic.
+		     */
+		    switch (opCode) {
+		    case INST_ADD:
+			iResult = i + i2;
+			break;
+		    case INST_SUB:
+			iResult = i - i2;
+			break;
+		    case INST_MULT:
+			iResult = i * i2;
+			break;
+		    case INST_DIV:
+			/*
+			 * This code is tricky: C doesn't guarantee much
+			 * about the quotient or remainder, but Tcl does.
+			 * The remainder always has the same sign as the
+			 * divisor and a smaller absolute value.
+			 */
+			if (i2 == 0) {
+			    TRACE(("div %ld %ld => DIVIDE BY ZERO\n",
+				    i, i2));
+			    Tcl_DecrRefCount(valuePtr);  /* done with obj */
+			    Tcl_DecrRefCount(value2Ptr); /* done with obj */
+			    goto divideByZero;
+			}
+			if (i2 < 0) {
+			    i2 = -i2;
+			    i = -i;
+			}
+			quot = i / i2;
+			rem  = i % i2;
+			if (rem < 0) {
+			    quot -= 1;
+			}
+			iResult = quot;
+			break;
+		    }
+		}
+
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    if (doDouble) {
+			PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+			TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
+			       d1, d2, dResult));
+		    } else {
+			PUSH_OBJECT(Tcl_NewLongObj(iResult));
+			TRACE(("%s %ld %ld => %ld\n", opName[opCode],
+			       i, i2, iResult));
+		    } 
+		    TclDecrRefCount(valuePtr);    /* done with object */
+		} else {	    /* reuse the valuePtr object */
+		    if (doDouble) { /* NB: stack top is off by 1 */
+			TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
+			       d1, d2, dResult));
+			Tcl_SetDoubleObj(valuePtr, dResult);
+		    } else {
+			TRACE(("%s %ld %ld => %ld\n", opName[opCode],
+			       i, i2, iResult));
+			Tcl_SetLongObj(valuePtr, iResult);
+		    }
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+		TclDecrRefCount(value2Ptr);   /* done with object */
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_UPLUS:
+	    {
+	        /*
+	         * Operand must be numeric.
+	         */
+
+		double d;
+		Tcl_ObjType *tPtr;
+		
+		valuePtr = stackPtr[stackTop].o;
+		tPtr = valuePtr->typePtr;
+		if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
+		    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d);
+		    }
+		    if (result != TCL_OK) { 
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
+			        opName[opCode], s,
+			        (tPtr? tPtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			goto checkForCatch;
+		    }
+		}
+		TRACE_WITH_OBJ(("uplus %s => ", O2S(valuePtr)), valuePtr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_UMINUS:
+	case INST_LNOT:
+	    {
+		/*
+		 * The operand must be numeric. If the operand object is
+		 * unshared modify it directly, otherwise create a copy to
+		 * modify: this is "copy on write". free any old string
+		 * representation since it is now invalid.
+		 */
+		
+		double d;
+		Tcl_ObjType *tPtr;
+		
+		valuePtr = POP_OBJECT();
+		tPtr = valuePtr->typePtr;
+		if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
+		    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d);
+		    }
+		    if (result != TCL_OK) {
+			TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s\n",
+			        opName[opCode], s,
+			       (tPtr? tPtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			goto checkForCatch;
+		    }
+		    tPtr = valuePtr->typePtr;
+		}
+		
+		if (Tcl_IsShared(valuePtr)) {
+		    /*
+		     * Create a new object.
+		     */
+		    if (tPtr == &tclIntType) {
+			i = valuePtr->internalRep.longValue;
+			objPtr = Tcl_NewLongObj(
+			        (opCode == INST_UMINUS)? -i : !i);
+			TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
+		                objPtr); /* NB: stack top is off by 1 */
+		    } else {
+			d = valuePtr->internalRep.doubleValue;
+			if (opCode == INST_UMINUS) {
+			    objPtr = Tcl_NewDoubleObj(-d);
+			} else {
+			    /*
+			     * Should be able to use "!d", but apparently
+			     * some compilers can't handle it.
+			     */
+			    objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
+			}
+			TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
+		                objPtr); /* NB: stack top is off by 1 */
+		    }
+		    PUSH_OBJECT(objPtr);
+		    TclDecrRefCount(valuePtr); /* done with popped obj */
+		} else {
+		    /*
+		     * valuePtr is unshared. Modify it directly.
+		     */
+		    if (tPtr == &tclIntType) {
+			i = valuePtr->internalRep.longValue;
+			Tcl_SetLongObj(valuePtr,
+			        (opCode == INST_UMINUS)? -i : !i);
+			TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
+		                valuePtr); /* NB: stack top is off by 1 */
+		    } else {
+			d = valuePtr->internalRep.doubleValue;
+			if (opCode == INST_UMINUS) {
+			    Tcl_SetDoubleObj(valuePtr, -d);
+			} else {
+			    /*
+			     * Should be able to use "!d", but apparently
+			     * some compilers can't handle it.
+			     */
+			    Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
+			}
+			TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
+		                valuePtr); /* NB: stack top is off by 1 */
+		    }
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		}
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_BITNOT:
+	    {
+		/*
+		 * The operand must be an integer. If the operand object is
+		 * unshared modify it directly, otherwise modify a copy. 
+		 * Free any old string representation since it is now
+		 * invalid.
+		 */
+		
+		Tcl_ObjType *tPtr;
+		
+		valuePtr = POP_OBJECT();
+		tPtr = valuePtr->typePtr;
+		if (tPtr != &tclIntType) {
+		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+			    valuePtr, &i);
+		    if (result != TCL_OK) {   /* try to convert to double */
+			TRACE(("bitnot \"%.20s\" => ILLEGAL TYPE %s\n",
+			       O2S(valuePtr), (tPtr? tPtr->name : "null")));
+			IllegalExprOperandType(interp, opCode, valuePtr);
+			Tcl_DecrRefCount(valuePtr);  /* done with object */
+			goto checkForCatch;
+		    }
+		}
+		
+		i = valuePtr->internalRep.longValue;
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(~i));
+		    TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
+		    TclDecrRefCount(valuePtr);  /* done with popped obj */
+		} else {
+		    /*
+		     * valuePtr is unshared. Modify it directly.
+		     */
+		    Tcl_SetLongObj(valuePtr, ~i);
+		    ++stackTop; /* valuePtr now on stk top has right r.c. */
+		    TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
+		}
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_CALL_BUILTIN_FUNC1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    {
+		/*
+		 * Call one of the built-in Tcl math functions.
+		 */
+
+		BuiltinFunc *mathFuncPtr;
+
+		if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
+		    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
+		    panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
+		}
+		mathFuncPtr = &(builtinFuncTable[opnd]);
+		DECACHE_STACK_INFO();
+		tcl_MathInProgress++;
+		result = (*mathFuncPtr->proc)(interp, eePtr,
+		        mathFuncPtr->clientData);
+		tcl_MathInProgress--;
+		CACHE_STACK_INFO();
+		if (result != TCL_OK) {
+		    goto checkForCatch;
+		}
+		TRACE_WITH_OBJ(("callBuiltinFunc1 %d => ", opnd),
+		        stackPtr[stackTop].o);
+	    }
+	    ADJUST_PC(2);
+		    
+	case INST_CALL_FUNC1:
+	    opnd = TclGetUInt1AtPc(pc+1);
+	    {
+		/*
+		 * Call a non-builtin Tcl math function previously
+		 * registered by a call to Tcl_CreateMathFunc.
+		 */
+		
+		int objc = opnd;   /* Number of arguments. The function name
+				    * is the 0-th argument. */
+		Tcl_Obj **objv;	   /* The array of arguments. The function
+				    * name is objv[0]. */
+		
+		objv = &(stackPtr[stackTop - (objc-1)].o); /* "objv[0]" */
+		DECACHE_STACK_INFO();
+		tcl_MathInProgress++;
+		result = ExprCallMathFunc(interp, eePtr, objc, objv);
+		tcl_MathInProgress--;
+		CACHE_STACK_INFO();
+		if (result != TCL_OK) {
+		    goto checkForCatch;
+		}
+		TRACE_WITH_OBJ(("callFunc1 %d => ", objc),
+		        stackPtr[stackTop].o);
+		ADJUST_PC(2);
+	    }
+
+	case INST_TRY_CVT_TO_NUMERIC:
+	    {
+		/*
+		 * Try to convert the topmost stack object to an int or
+		 * double object. This is done in order to support Tcl's
+		 * policy of interpreting operands if at all possible as
+		 * first integers, else floating-point numbers.
+		 */
+		
+		double d;
+		char *s;
+		Tcl_ObjType *tPtr;
+		int converted, shared;
+
+		valuePtr = stackPtr[stackTop].o;
+		tPtr = valuePtr->typePtr;
+		converted = 0;
+		if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
+		    s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+		    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i);
+		    } else {
+			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d);
+		    }
+		    if (result == TCL_OK) {
+			converted = 1;
+		    }
+		    result = TCL_OK; /* reset the result variable */
+		    tPtr = valuePtr->typePtr;
+		}
+
+		/*
+		 * Ensure that the topmost stack object, if numeric, has a
+		 * string rep the same as the formatted version of its
+		 * internal rep. This is used, e.g., to make sure that "expr
+		 * {0001}" yields "1", not "0001". We implement this by
+		 * _discarding_ the string rep since we know it will be
+		 * regenerated, if needed later, by formatting the internal
+		 * rep's value. Also check if there has been an IEEE
+		 * floating point error.
+		 */
+
+		if ((tPtr == &tclIntType) || (tPtr == &tclDoubleType)) {
+		    shared = 0;
+		    if (Tcl_IsShared(valuePtr)) {
+			shared = 1;
+			if (tPtr == &tclIntType) {
+			    i = valuePtr->internalRep.longValue;
+			    objPtr = Tcl_NewLongObj(i);
+			} else {
+			    d = valuePtr->internalRep.doubleValue;
+			    objPtr = Tcl_NewDoubleObj(d);
+			}
+			Tcl_IncrRefCount(objPtr);
+			TclDecrRefCount(valuePtr); /* done with object */
+			valuePtr = objPtr;
+			tPtr = valuePtr->typePtr;
+		    } else {
+			Tcl_InvalidateStringRep(valuePtr);
+		    }
+		    stackPtr[stackTop].o = valuePtr;
+		
+		    if (tPtr == &tclDoubleType) {
+			d = valuePtr->internalRep.doubleValue;
+			if (IS_NAN(d) || IS_INF(d)) {
+			    TRACE(("tryCvtToNumeric \"%.20s\" => IEEE FLOATING PT ERROR\n",
+			           O2S(valuePtr)));
+			    TclExprFloatError(interp, d);
+			    result = TCL_ERROR;
+			    goto checkForCatch;
+			}
+		    }
+		    TRACE(("tryCvtToNumeric \"%.20s\" => numeric, %s, %s\n",
+			   O2S(valuePtr),
+			   (converted? "converted" : "not converted"),
+			   (shared? "shared" : "not shared")));
+		} else {
+		    TRACE(("tryCvtToNumeric \"%.20s\" => not numeric\n",
+			   O2S(valuePtr)));
+		}
+	    }
+	    ADJUST_PC(1);
+
+	case INST_BREAK:
+	    /*
+	     * First reset the interpreter's result. Then find the closest
+	     * enclosing loop or catch exception range, if any. If a loop is
+	     * found, terminate its execution. If the closest is a catch
+	     * exception range, jump to its catchOffset. If no enclosing
+	     * range is found, stop execution and return TCL_BREAK.
+	     */
+
+	    Tcl_ResetResult(interp);
+	    rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+		    codePtr);
+	    if (rangePtr == NULL) {
+		TRACE(("break => no encl. loop or catch, returning TCL_BREAK\n"));
+		result = TCL_BREAK;
+		goto abnormalReturn; /* no catch exists to check */
+	    }
+	    switch (rangePtr->type) {
+	    case LOOP_EXCEPTION_RANGE:
+		result = TCL_OK;
+		TRACE(("break => range at %d, new pc %d\n",
+		       rangePtr->codeOffset, rangePtr->breakOffset));
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		result = TCL_BREAK;
+		TRACE(("break => ...\n"));
+		goto processCatch; /* it will use rangePtr */
+	    default:
+		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+	    }
+	    pc = (codePtr->codeStart + rangePtr->breakOffset);
+	    continue;	/* restart outer instruction loop at pc */
+
+	case INST_CONTINUE:
+            /*
+	     * Find the closest enclosing loop or catch exception range,
+	     * if any. If a loop is found, skip to its next iteration.
+	     * If the closest is a catch exception range, jump to its
+	     * catchOffset. If no enclosing range is found, stop
+	     * execution and return TCL_CONTINUE.
+	     */
+
+	    Tcl_ResetResult(interp);
+	    rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+		    codePtr);
+	    if (rangePtr == NULL) {
+		TRACE(("continue => no encl. loop or catch, returning TCL_CONTINUE\n"));
+		result = TCL_CONTINUE;
+		goto abnormalReturn; /* no catch exists to check */
+	    }
+	    switch (rangePtr->type) {
+	    case LOOP_EXCEPTION_RANGE:
+		if (rangePtr->continueOffset == -1) {
+		    TRACE(("continue => loop w/o continue, checking for catch\n"));
+		    goto checkForCatch;
+		} else {
+		    result = TCL_OK;
+		    TRACE(("continue => range at %d, new pc %d\n",
+			   rangePtr->codeOffset, rangePtr->continueOffset));
+		}
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		result = TCL_CONTINUE;
+		TRACE(("continue => ...\n"));
+		goto processCatch; /* it will use rangePtr */
+	    default:
+		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+	    }
+	    pc = (codePtr->codeStart + rangePtr->continueOffset);
+	    continue;	/* restart outer instruction loop at pc */
+
+	case INST_FOREACH_START4:
+	    opnd = TclGetUInt4AtPc(pc+1);
+	    {
+	        /*
+		 * Initialize the temporary local var that holds the count
+		 * of the number of iterations of the loop body to -1.
+		 */
+
+		ForeachInfo *infoPtr = (ForeachInfo *)
+		    codePtr->auxDataArrayPtr[opnd].clientData;
+		int iterTmpIndex = infoPtr->loopIterNumTmp;
+		CallFrame *varFramePtr = iPtr->varFramePtr;
+		Var *compiledLocals = varFramePtr->compiledLocals;
+		Var *iterVarPtr;
+		Tcl_Obj *oldValuePtr;
+
+		iterVarPtr = &(compiledLocals[iterTmpIndex]);
+		oldValuePtr = iterVarPtr->value.objPtr;
+#ifdef TCL_COMPILE_DEBUG		
+		if (TclIsVarLink(iterVarPtr)) {
+		    panic("TclExecuteByteCode execution failure: foreach loop iter temp %d is link\n", iterTmpIndex);
+		}
+		if ((oldValuePtr != NULL) && Tcl_IsShared(oldValuePtr)) {
+		    panic("TclExecuteByteCode execution failure: foreach loop iter temp %d has shared object\n", iterTmpIndex);
+		}
+#endif /* TCL_COMPILE_DEBUG */
+		
+		if (oldValuePtr == NULL) {
+		    iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
+		    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
+		    if (oldValuePtr != NULL) {
+			Tcl_DecrRefCount(oldValuePtr); /* free old value */
+		    }
+		} else {	/* update object in place */
+		    Tcl_SetLongObj(oldValuePtr, -1);
+		}
+		TclSetVarScalar(iterVarPtr);
+		TclClearVarUndefined(iterVarPtr);
+		TRACE(("foreach_start4 %u => loop iter count temp %d\n", 
+		        opnd, iterTmpIndex));
+	    }
+	    ADJUST_PC(5);
+	
+	case INST_FOREACH_STEP4:
+	    opnd = TclGetUInt4AtPc(pc+1);
+	    {
+	        /*
+		 * "Step" a foreach loop (i.e., begin its next iteration) by
+		 * assigning the next value list element to each loop var.
+		 */
+
+		ForeachInfo *infoPtr = (ForeachInfo *)
+		    codePtr->auxDataArrayPtr[opnd].clientData;
+		ForeachVarList *varListPtr;
+		int numLists = infoPtr->numLists;
+		int iterTmpIndex = infoPtr->loopIterNumTmp;
+		CallFrame *varFramePtr = iPtr->varFramePtr;
+		Var *compiledLocals = varFramePtr->compiledLocals;
+		int iterNum, listTmpIndex, listLen, numVars;
+		int varIndex, valIndex, j;
+		Tcl_Obj *listPtr, *elemPtr, *oldValuePtr;
+		List *listRepPtr;
+		Var *iterVarPtr, *listVarPtr;
+		int continueLoop = 0;
+
+		/*
+		 * Increment the temp holding the loop iteration number.
+		 */
+
+		iterVarPtr = &(compiledLocals[iterTmpIndex]);
+		oldValuePtr = iterVarPtr->value.objPtr;
+#ifdef TCL_COMPILE_DEBUG
+		if (TclIsVarLink(iterVarPtr) || TclIsVarUndefined(iterVarPtr)
+		        || !TclIsVarScalar(iterVarPtr)) {
+		    panic("TclExecuteByteCode execution failure: foreach loop iter temp %d is link, undefined, or array\n", iterTmpIndex);
+		}
+		if ((oldValuePtr == NULL)
+		        || (oldValuePtr->typePtr != &tclIntType)
+		        || (oldValuePtr->bytes != NULL)
+		        || Tcl_IsShared(oldValuePtr)) {
+		    panic("TclExecuteByteCode execution failure: foreach loop iter count object is bad\n");
+		}
+#endif /* TCL_COMPILE_DEBUG */
+		iterNum = (oldValuePtr->internalRep.longValue + 1);
+		Tcl_SetLongObj(oldValuePtr, iterNum);
+		
+		/*
+		 * Check whether all value lists are exhausted and we should
+		 * stop the loop.
+		 */
+
+		listTmpIndex = infoPtr->firstListTmp;
+		for (i = 0;  i < numLists;  i++) {
+		    varListPtr = infoPtr->varLists[i];
+		    numVars = varListPtr->numVars;
+
+		    listVarPtr = &(compiledLocals[listTmpIndex]);
+		    listPtr = listVarPtr->value.objPtr;
+#ifdef TCL_COMPILE_DEBUG
+		    if (TclIsVarLink(listVarPtr) || TclIsVarUndefined(listVarPtr)
+		            || !TclIsVarScalar(listVarPtr)) {
+			panic("TclExecuteByteCode execution failure: foreach loop list temp %d is link, undefined, or array\n", listTmpIndex);
+		    }
+		    if (listPtr == NULL) {
+			panic("TclExecuteByteCode execution failure: NULL foreach list temp %d: \"%s\"\n",
+			      listTmpIndex,
+			      Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length));
+		    }
+#endif /* TCL_COMPILE_DEBUG */
+		    result = Tcl_ListObjLength(interp, listPtr, &listLen);
+		    if (result != TCL_OK) {
+			TRACE_WITH_OBJ(("foreach_step4 %u => ERROR converting list %ld, \"%s\": ",
+			        opnd, i, O2S(listPtr)),
+				Tcl_GetObjResult(interp));
+			goto checkForCatch;
+		    }
+		    if (listLen > (iterNum * numVars)) {
+			continueLoop = 1;
+		    }
+		    listTmpIndex++;
+		}
+
+		/*
+		 * If some var in some var list still has a remaining list
+		 * element iterate one more time. Assign to var the next
+		 * element from its value list. We already checked above
+		 * that each list temp holds a valid list object.
+		 */
+		
+		if (continueLoop) {
+		    listTmpIndex = infoPtr->firstListTmp;
+		    for (i = 0;  i < numLists;  i++) {
+			varListPtr = infoPtr->varLists[i];
+			numVars = varListPtr->numVars;
+
+			listVarPtr = &(compiledLocals[listTmpIndex]);
+			listPtr = listVarPtr->value.objPtr;
+			listRepPtr = (List *)
+			        listPtr->internalRep.otherValuePtr;
+			listLen = listRepPtr->elemCount;
+			
+			valIndex = (iterNum * numVars);
+			for (j = 0;  j < numVars;  j++) {
+			    int setEmptyStr = 0;
+			    if (valIndex >= listLen) {
+				setEmptyStr = 1;
+				elemPtr = Tcl_NewObj();  /* set to "" */
+			    } else {
+				elemPtr = listRepPtr->elements[valIndex];
+			    }
+			    
+			    varIndex = varListPtr->varIndexes[j];
+			    DECACHE_STACK_INFO();
+			    value2Ptr = TclSetIndexedScalar(interp,
+			           varIndex, elemPtr, /*leaveErrorMsg*/ 1);
+			    CACHE_STACK_INFO();
+			    if (value2Ptr == NULL) {
+				TRACE_WITH_OBJ(("foreach_step4 %u => ERROR init. index temp %d: ",
+				       opnd, varIndex),
+				       Tcl_GetObjResult(interp));
+				if (setEmptyStr) {
+				    Tcl_DecrRefCount(elemPtr); /* unneeded */
+				}
+				result = TCL_ERROR;
+				goto checkForCatch;
+			    }
+			    valIndex++;
+			}
+			listTmpIndex++;
+		    }
+		}
+		
+		/*
+		 * Now push a "1" object if at least one value list had a
+		 * remaining element and the loop should continue.
+		 * Otherwise push "0".
+		 */
+
+		PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
+		TRACE(("foreach_step4 %u => %d lists, iter %d, %s loop\n", 
+		        opnd, numLists, iterNum,
+		        (continueLoop? "continue" : "exit")));
+	    }
+	    ADJUST_PC(5);
+
+	case INST_BEGIN_CATCH4:
+	    /*
+	     * Record start of the catch command with exception range index
+	     * equal to the operand. Push the current stack depth onto the
+	     * special catch stack.
+	     */
+	    catchStackPtr[++catchTop] = stackTop;
+	    TRACE(("beginCatch4 %u => catchTop=%d, stackTop=%d\n",
+		    TclGetUInt4AtPc(pc+1), catchTop, stackTop));
+	    ADJUST_PC(5);
+
+	case INST_END_CATCH:
+	    catchTop--;
+	    result = TCL_OK;
+	    TRACE(("endCatch => catchTop=%d\n", catchTop));
+	    ADJUST_PC(1);
+
+	case INST_PUSH_RESULT:
+	    PUSH_OBJECT(Tcl_GetObjResult(interp));
+	    TRACE_WITH_OBJ(("pushResult => "), Tcl_GetObjResult(interp));
+	    ADJUST_PC(1);
+
+	case INST_PUSH_RETURN_CODE:
+	    PUSH_OBJECT(Tcl_NewLongObj(result)); /* i.e., the return code */
+	    TRACE(("pushReturnCode => %u\n", result));
+	    ADJUST_PC(1);
+
+	default:
+	    TRACE(("UNRECOGNIZED INSTRUCTION %u\n", opCode));
+	    panic("TclExecuteByteCode: unrecognized opCode %u", opCode);
+	} /* end of switch on opCode */
+
+	/*
+	 * Division by zero in an expression. Control only reaches this
+	 * point by "goto divideByZero".
+	 */
+	
+        divideByZero:
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
+	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
+			 (char *) NULL);
+	result = TCL_ERROR;
+	
+	/*
+	 * Execution has generated an "exceptional return" (or "exception")
+	 * such as TCL_ERROR. Look for the closest enclosing catch exception
+	 * range, if any. If no enclosing catch range is found, stop
+	 * execution and return the "exceptional return" code.
+	 */
+	
+        checkForCatch:
+	rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+	if (rangePtr == NULL) {
+	    TRACE(("   ... no enclosing catch, returning %s\n",
+		    StringForResultCode(result)));
+	    goto abnormalReturn; /* no catch exists to check */
+	}
+
+	/*
+	 * A catch exception range (rangePtr) has been to handle an
+	 * "exception". It was found either by checkForCatch just above or
+	 * by an instruction during break, continue, or error processing.
+	 * Jump to its catchOffset after unwinding the operand stack to
+	 * the depth it had when starting to execute the range's catch
+	 * command. Also, if the exception is an error, record information
+	 * about what was being executed when the error occurred.
+	 */
+
+        processCatch:
+	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	    char buf[200];
+	    int cmdIndex = TclGetSrcInfoForPc(pc, codePtr);
+	    
+	    /*
+	     * Compute the line number where the error occurred.
+	     */
+	    
+	    iPtr->errorLine = 1; /* no correct line # information yet */
+
+	    /*
+	     * Print the command in the error message (up to a certain
+	     * number of characters, or up to the first new-line).
+	     */
+	    
+	    if (cmdIndex != -1) {
+		CmdLocation *locPtr = &(codePtr->cmdMapPtr[cmdIndex]);
+		char *ellipsis = "";
+		int numChars = locPtr->numSrcChars;
+		if (numChars > 150) {
+		    numChars = 150;
+		    ellipsis = "...";
+		}
+		if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+		    sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+			    numChars, (codePtr->source + locPtr->srcOffset),
+			    ellipsis);
+		} else {
+		    sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+			    numChars, (codePtr->source + locPtr->srcOffset),
+			    ellipsis);
+		}
+		Tcl_AddObjErrorInfo(interp, buf, -1);
+		iPtr->flags |= ERR_ALREADY_LOGGED;
+	    }
+	}
+	
+	while (stackTop > catchStackPtr[catchTop]) {
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+	}
+	TRACE(("  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
+	        rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
+	        (unsigned int)(rangePtr->catchOffset)));
+	pc = (codePtr->codeStart + rangePtr->catchOffset);
+	continue;		/* restart the execution loop at pc */
+    } /* end of infinite loop dispatching on instructions */
+
+    /*
+     * Abnormal return code. Restore the stack to state it had when starting
+     * to execute the ByteCode.
+     */
+
+    abnormalReturn:
+    while (stackTop > initStackTop) {
+	valuePtr = POP_OBJECT();
+	Tcl_DecrRefCount(valuePtr);
+    }
+
+    /*
+     * Free the catch stack array if malloc'ed storage was used.
+     */
+
+    done:
+    if (catchStackPtr != catchStackStorage) {
+	ckfree((char *) catchStackPtr);
+    }
+    eePtr->stackTop = initStackTop;
+    return result;
+#undef STATIC_CATCH_STACK_SIZE
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IllegalExprOperandType --
+ *
+ *	Used by TclExecuteByteCode to add an error message to errorInfo
+ *	when an illegal operand type is detected by an expression
+ *	instruction. The argument opCode holds the failing instruction's
+ *	opcode and opndPtr holds the operand object in error.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An error message is appended to errorInfo.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IllegalExprOperandType(interp, opCode, opndPtr)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    unsigned int opCode;	/* The instruction opcode being executed
+				 * when the illegal type was found. */
+    Tcl_Obj *opndPtr;		/* Points to the operand holding the value
+				 * with the illegal type. */
+{
+    Tcl_ResetResult(interp);
+    if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't use empty string as operand of \"",
+		operatorStrings[opCode - INST_BITOR], "\"", (char *) NULL);
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't use ", ((opndPtr->typePtr == &tclDoubleType) ?
+		"floating-point value" : "non-numeric string"),
+		" as operand of \"", operatorStrings[opCode - INST_BITOR],
+		"\"", (char *) NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallTraceProcedure --
+ *
+ *	Invokes a trace procedure registered with an interpreter. These
+ *	procedures trace command execution. Currently this trace procedure
+ *	is called with the address of the string-based Tcl_CmdProc for the
+ *	command, not the Tcl_ObjCmdProc.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Those side effects made by the trace procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
+    Tcl_Interp *interp;		/* The current interpreter. */
+    register Trace *tracePtr;	/* Describes the trace procedure to call. */
+    Command *cmdPtr;		/* Points to command's Command struct. */
+    char *command;		/* Points to the first character of the
+				 * command's source before substitutions. */
+    int numChars;		/* The number of characters in the
+				 * command's source. */
+    register int objc;		/* Number of arguments for the command. */
+    Tcl_Obj *objv[];		/* Pointers to Tcl_Obj of each argument. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char **argv;
+    register int i;
+    int length;
+    char *p;
+
+    /*
+     * Get the string rep from the objv argument objects and place their
+     * pointers in argv. First make sure argv is large enough to hold the
+     * objc args plus 1 extra word for the zero end-of-argv word.
+     * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
+     */
+    
+    argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+    for (i = 0;  i < objc;  i++) {
+	argv[i] = Tcl_GetStringFromObj(objv[i], &length);
+    }
+    argv[objc] = 0;
+
+    /*
+     * Copy the command characters into a new string.
+     */
+
+    p = (char *) ckalloc((unsigned) (numChars + 1));
+    strncpy(p, command, (size_t) numChars);
+    p[numChars] = '\0';
+    
+    /*
+     * Call the trace procedure then free allocated storage.
+     */
+    
+    (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
+                      p, cmdPtr->proc, cmdPtr->clientData, objc, argv);
+
+    ckfree((char *) argv);
+    ckfree((char *) p);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetSrcInfoForPc --
+ *
+ *	Procedure that given a program counter value, returns an index
+ *	of the closest command's element in the bytecode code unit's
+ *	CmdLocation array. This element provides information about that
+ *	command's source: a pointer to its first byte and the number
+ *	of its characters.
+ *
+ * Results:
+ *	If a command in the bytecode code unit is found that encloses
+ *	the program counter value, the index of the command's element
+ *	in the CmdLocation array is returned. If multiple commands
+ *	resulted in code at pc, the index for the command with code that
+ *	starts closest to pc is returned. If no matching command is
+ *	found, -1 is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetSrcInfoForPc(pc, codePtr)
+    unsigned char *pc;		/* The program counter value for which to
+				 * return the closest command's source info.
+				 * This points to a bytecode instruction
+				 * in codePtr's code. */
+    ByteCode* codePtr;		/* The bytecode sequence in which to look
+				 * up the command source for the pc. */
+{
+    int codeOffset = (pc - codePtr->codeStart);
+    int numCommands = codePtr->numCommands;
+    CmdLocation *cmdMapPtr = codePtr->cmdMapPtr;
+    register CmdLocation *locPtr;
+    int bestCmd = -1;		/* Index of current candidate for closest
+				 * command. */
+    int bestDist = INT_MAX;	/* Distance of pc to bestCmd's start pc. */
+    int startOffset, endOffset, dist;
+    register int i;
+
+    for (i = 0;  i < numCommands;  i++) {
+	locPtr = &(cmdMapPtr[i]);
+	startOffset = locPtr->codeOffset;
+	endOffset = (startOffset + locPtr->numCodeBytes - 1);
+	if ((startOffset <= codeOffset) && (codeOffset <= endOffset)) {
+	    dist = (codeOffset - startOffset);
+	    if (dist <= bestDist) {
+		bestCmd = i;
+		bestDist = dist;
+	    }
+	}
+    }
+    return bestCmd;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetExceptionRangeForPc --
+ *
+ *	Procedure that given a program counter value, returns the closest
+ *	enclosing ExceptionRange that matches the kind requested.
+ *
+ * Results:
+ *	In the normal case, catchOnly is 0 (false) and this procedure
+ *	returns a pointer to the most closely enclosing ExceptionRange
+ *	structure regardless of whether it is a loop or catch exception
+ *	range. This is appropriate when processing a TCL_BREAK or
+ *	TCL_CONTINUE, which will be "handled" either by a loop exception
+ *	range or a closer catch range. If catchOnly is nonzero (true), this
+ *	procedure ignores loop exception ranges and returns a pointer to the
+ *	closest catch range. If no matching ExceptionRange is found that
+ *	encloses pc, a NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ExceptionRange *
+TclGetExceptionRangeForPc(pc, catchOnly, codePtr)
+    unsigned char *pc;		/* The program counter value for which to
+				 * search for a closest enclosing exception
+				 * range. This points to a bytecode
+				 * instruction in codePtr's code. */
+    int catchOnly;		/* If 0, consider either loop or catch
+				 * ExceptionRanges in search. Otherwise
+				 * consider only catch ranges (and ignore
+				 * any closer loop ranges). */
+    ByteCode* codePtr;		/* Points to the ByteCode in which to search
+				 * for the enclosing ExceptionRange. */
+{
+    ExceptionRange *rangeArrayPtr = codePtr->excRangeArrayPtr;
+    int numRanges = codePtr->numExcRanges;
+    register ExceptionRange *rangePtr;
+    int codeOffset = (pc - codePtr->codeStart);
+    register int i, level;
+
+    for (level = codePtr->maxExcRangeDepth;  level >= 0;  level--) {
+	for (i = 0;  i < numRanges;  i++) {
+	    rangePtr = &(rangeArrayPtr[i]);
+	    if (rangePtr->nestingLevel == level) {
+		int start = rangePtr->codeOffset;
+		int end   = (start + rangePtr->numCodeBytes);
+		if ((start <= codeOffset) && (codeOffset < end)) {
+		    if ((!catchOnly)
+			    || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+			return rangePtr;
+		    }
+		}
+	    }
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Math Functions --
+ *
+ *	This page contains the procedures that implement all of the
+ *	built-in math functions for expressions.
+ *
+ * Results:
+ *	Each procedure returns TCL_OK if it succeeds and pushes an
+ *	Tcl object holding the result. If it fails it returns TCL_ERROR
+ *	and leaves an error message in the interpreter's result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprUnaryFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Contains the address of a procedure that
+				 * takes one double argument and returns a
+				 * double result. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    double d, dResult;
+    long i;
+    int result = TCL_OK;
+    
+    double (*func) _ANSI_ARGS_((double)) =
+	(double (*)_ANSI_ARGS_((double))) clientData;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the function's argument from the evaluation stack. Convert it
+     * to a double if necessary.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	d = (double) valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    d = (double) valuePtr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+    }
+
+    errno = 0;
+    dResult = (*func)(d);
+    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
+	TclExprFloatError(interp, dResult);
+	result = TCL_ERROR;
+	goto done;
+    }
+    
+    /*
+     * Push a Tcl object holding the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);  /* done with popped obj */
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprBinaryFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Contains the address of a procedure that
+				 * takes two double arguments and
+				 * returns a double result. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr, *value2Ptr;
+    Tcl_ObjType *tPtr;
+    double d1, d2, dResult;
+    long i;
+    char *s;
+    int result = TCL_OK;
+    
+    double (*func) _ANSI_ARGS_((double, double))
+	= (double (*)_ANSI_ARGS_((double, double))) clientData;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the function's two arguments from the evaluation stack. Convert
+     * them to doubles if necessary.
+     */
+
+    value2Ptr = POP_OBJECT();
+    valuePtr  = POP_OBJECT();
+
+    tPtr = valuePtr->typePtr;
+    if (tPtr == &tclIntType) {
+	d1 = (double) valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d1 = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    d1 = (double) valuePtr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1);
+	}
+	if (result != TCL_OK) {
+            badArg:
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+    }
+
+    tPtr = value2Ptr->typePtr;
+    if (tPtr == &tclIntType) {
+	d2 = value2Ptr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d2 = value2Ptr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i);
+	    d2 = (double) value2Ptr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2);
+	}
+	if (result != TCL_OK) {
+	    goto badArg;
+	}
+    }
+
+    errno = 0;
+    dResult = (*func)(d1, d2);
+    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
+	TclExprFloatError(interp, dResult);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Push a Tcl object holding the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);   /* done with popped obj */
+    Tcl_DecrRefCount(value2Ptr);  /* done with popped obj */
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprAbsFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i, iResult;
+    double d, dResult;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+	tPtr = valuePtr->typePtr;
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+    
+    if (tPtr == &tclIntType) {
+	if (i < 0) {
+	    iResult = -i;
+	    if (iResult < 0) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "integer value too large to represent", -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			"integer value too large to represent", (char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	} else {
+	    iResult = i;
+	}	    
+	PUSH_OBJECT(Tcl_NewLongObj(iResult));
+    } else {
+	if (d < 0.0) {
+	    dResult = -d;
+	} else {
+	    dResult = d;
+	}
+	if (IS_NAN(dResult) || IS_INF(dResult)) {
+	    TclExprFloatError(interp, dResult);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    }
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);  /* done with popped obj */
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprDoubleFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    double dResult;
+    long i;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    if (valuePtr->typePtr == &tclIntType) {
+	dResult = (double) valuePtr->internalRep.longValue;
+    } else if (valuePtr->typePtr == &tclDoubleType) {
+	dResult = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    dResult = (double) valuePtr->internalRep.longValue;
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr,
+		    &dResult);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);  /* done with popped obj */
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprIntFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i = 0;			/* Initialized to avoid compiler warning. */
+    long iResult;
+    double d;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+	tPtr = valuePtr->typePtr;
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+    
+    if (tPtr == &tclIntType) {
+	iResult = i;
+    } else {
+	if (d < 0.0) {
+	    if (d < (double) (long) LONG_MIN) {
+		tooLarge:
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "integer value too large to represent", -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			"integer value too large to represent", (char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	} else {
+	    if (d > (double) LONG_MAX) {
+		goto tooLarge;
+	    }
+	}
+	if (IS_NAN(d) || IS_INF(d)) {
+	    TclExprFloatError(interp, d);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	iResult = (long) d;
+    }
+    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);  /* done with popped obj */
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprRandFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    Interp *iPtr = (Interp *) interp;
+    double dResult;
+    int tmp;
+
+    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
+	iPtr->flags |= RAND_SEED_INITIALIZED;
+	iPtr->randSeed = TclpGetClicks();
+    }
+    
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Generate the random number using the linear congruential
+     * generator defined by the following recurrence:
+     *		seed = ( IA * seed ) mod IM
+     * where IA is 16807 and IM is (2^31) - 1.  In order to avoid
+     * potential problems with integer overflow, the  code uses
+     * additional constants IQ and IR such that
+     *		IM = IA*IQ + IR
+     * For details on how this algorithm works, refer to the following
+     * papers: 
+     *
+     *	S.K. Park & K.W. Miller, "Random number generators: good ones
+     *	are hard to find," Comm ACM 31(10):1192-1201, Oct 1988
+     *
+     *	W.H. Press & S.A. Teukolsky, "Portable random number
+     *	generators," Computers in Physics 6(5):522-524, Sep/Oct 1992.
+     */
+
+#define RAND_IA		16807
+#define RAND_IM		2147483647
+#define RAND_IQ		127773
+#define RAND_IR		2836
+#define RAND_MASK	123459876
+
+    if (iPtr->randSeed == 0) {
+	/*
+	 * Don't allow a 0 seed, since it breaks the generator.  Shift
+	 * it to some other value.
+	 */
+
+	iPtr->randSeed = 123459876;
+    }
+    tmp = iPtr->randSeed/RAND_IQ;
+    iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
+    if (iPtr->randSeed < 0) {
+	iPtr->randSeed += RAND_IM;
+    }
+    dResult = iPtr->randSeed * (1.0/RAND_IM);
+
+    /*
+     * Push a Tcl object with the result.
+     */
+
+    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
+    
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    DECACHE_STACK_INFO();
+    return TCL_OK;
+}
+
+static int
+ExprRoundFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i = 0;			/* Initialized to avoid compiler warning. */
+    long iResult;
+    double d, temp;
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else if (tPtr == &tclDoubleType) {
+	d = valuePtr->internalRep.doubleValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	
+	if (TclLooksLikeInt(s)) {
+	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	} else {
+	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+	}
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "argument to math function didn't have numeric value", -1);
+	    goto done;
+	}
+	tPtr = valuePtr->typePtr;
+    }
+
+    /*
+     * Push a Tcl object with the result.
+     */
+    
+    if (tPtr == &tclIntType) {
+	iResult = i;
+    } else {
+	if (d < 0.0) {
+	    if (d <= (((double) (long) LONG_MIN) - 0.5)) {
+		tooLarge:
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "integer value too large to represent", -1);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			"integer value too large to represent",
+			(char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    temp = (long) (d - 0.5);
+	} else {
+	    if (d >= (((double) LONG_MAX + 0.5))) {
+		goto tooLarge;
+	    }
+	    temp = (long) (d + 0.5);
+	}
+	if (IS_NAN(temp) || IS_INF(temp)) {
+	    TclExprFloatError(interp, temp);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	iResult = (long) temp;
+    }
+    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    Tcl_DecrRefCount(valuePtr);  /* done with popped obj */
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+static int
+ExprSrandFunc(interp, eePtr, clientData)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    ClientData clientData;	/* Ignored. */
+{
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i = 0;			/* Initialized to avoid compiler warning. */
+    int result = TCL_OK;
+
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Pop the argument from the evaluation stack.  Use the value
+     * to reset the random number seed.
+     */
+
+    valuePtr = POP_OBJECT();
+    tPtr = valuePtr->typePtr;
+    
+    if (tPtr == &tclIntType) {
+	i = valuePtr->internalRep.longValue;
+    } else {			/* FAILS IF STRING REP HAS NULLS */
+	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	if (result != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
+		    ((tPtr == &tclDoubleType)? "floating-point value" : "non-numeric string"),
+		    " as argument to srand", (char *) NULL);
+	    Tcl_DecrRefCount(valuePtr);  /* done with popped obj */
+	    DECACHE_STACK_INFO();
+	    return result;
+	}
+    }
+    
+    /*
+     * Reset the seed.
+     */
+
+    iPtr->flags |= RAND_SEED_INITIALIZED;
+    iPtr->randSeed = i;
+
+    /*
+     * To avoid duplicating the random number generation code we simply
+     * clean up our state and call the real random number function. That
+     * function will always succeed.
+     */
+    
+    Tcl_DecrRefCount(valuePtr);
+    DECACHE_STACK_INFO();
+
+    ExprRandFunc(interp, eePtr, clientData);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExprCallMathFunc --
+ *
+ *	This procedure is invoked to call a non-builtin math function
+ *	during the execution of an expression. 
+ *
+ * Results:
+ *	TCL_OK is returned if all went well and the function's value
+ *	was computed successfully. If an error occurred, TCL_ERROR
+ *	is returned and an error message is left in the interpreter's
+ *	result.	After a successful return this procedure pushes a Tcl object
+ *	holding the result. 
+ *
+ * Side effects:
+ *	None, unless the called math function has side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprCallMathFunc(interp, eePtr, objc, objv)
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * function. */
+    ExecEnv *eePtr;		/* Points to the environment for executing
+				 * the function. */
+    int objc;			/* Number of arguments. The function name is
+				 * the 0-th argument. */
+    Tcl_Obj **objv;		/* The array of arguments. The function name
+				 * is objv[0]. */
+{
+    Interp *iPtr = (Interp *) interp;
+    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
+    register int stackTop;	/* Cached top index of evaluation stack. */
+    char *funcName;
+    Tcl_HashEntry *hPtr;
+    MathFunc *mathFuncPtr;	/* Information about math function. */
+    Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
+    Tcl_Value funcResult;	/* Result of function call as Tcl_Value. */
+    register Tcl_Obj *valuePtr;
+    Tcl_ObjType *tPtr;
+    long i;
+    double d;
+    int j, k, result;
+    
+    Tcl_ResetResult(interp);
+    
+    /*
+     * Set stackPtr and stackTop from eePtr.
+     */
+    
+    CACHE_STACK_INFO();
+
+    /*
+     * Look up the MathFunc record for the function.
+     * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
+     */
+
+    funcName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
+    if (hPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown math function \"", funcName, "\"", (char *) NULL);
+	result = TCL_ERROR;
+	goto done;
+    }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+    if (mathFuncPtr->numArgs != (objc-1)) {
+	panic("ExprCallMathFunc: expected number of args %d != actual number %d",
+	        mathFuncPtr->numArgs, objc);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Collect the arguments for the function, if there are any, into the
+     * array "args". Note that args[0] will have the Tcl_Value that
+     * corresponds to objv[1].
+     */
+
+    for (j = 1, k = 0;  j < objc;  j++, k++) {
+	valuePtr = objv[j];
+	tPtr = valuePtr->typePtr;
+	
+	if (tPtr == &tclIntType) {
+	    i = valuePtr->internalRep.longValue;
+	} else if (tPtr == &tclDoubleType) {
+	    d = valuePtr->internalRep.doubleValue;
+	} else {
+	    /*
+	     * Try to convert to int first then double.
+	     * FAILS IF STRING REP HAS NULLS.
+	     */
+	    
+	    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+	    
+	    if (TclLooksLikeInt(s)) {
+		result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
+	    } else {
+		result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+			valuePtr, &d);
+	    }
+	    if (result != TCL_OK) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			"argument to math function didn't have numeric value", -1);
+		goto done;
+	    }
+	    tPtr = valuePtr->typePtr;
+	}
+
+	/*
+	 * Copy the object's numeric value to the argument record,
+	 * converting it if necessary. 
+	 */
+	
+	if (tPtr == &tclIntType) {
+	    if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
+		args[k].type = TCL_DOUBLE;
+		args[k].doubleValue = i;
+	    } else {
+		args[k].type = TCL_INT;
+		args[k].intValue = i;
+	    }
+	} else {
+	    if (mathFuncPtr->argTypes[k] == TCL_INT) {
+		args[k].type = TCL_INT;
+		args[k].intValue = (long) d;
+	    } else {
+		args[k].type = TCL_DOUBLE;
+		args[k].doubleValue = d;
+	    }
+	}
+    }
+
+    /*
+     * Invoke the function and copy its result back into valuePtr.
+     */
+
+    tcl_MathInProgress++;
+    result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
+	    &funcResult);
+    tcl_MathInProgress--;
+    if (result != TCL_OK) {
+	goto done;
+    }
+
+    /*
+     * Pop the objc top stack elements and decrement their ref counts.
+     */
+		
+    i = (stackTop - (objc-1));
+    while (i <= stackTop) {
+	valuePtr = stackPtr[i].o;
+	Tcl_DecrRefCount(valuePtr);
+	i++;
+    }
+    stackTop -= objc;
+    
+    /*
+     * Push the call's object result.
+     */
+    
+    if (funcResult.type == TCL_INT) {
+	PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
+    } else {
+	d = funcResult.doubleValue;
+	if (IS_NAN(d) || IS_INF(d)) {
+	    TclExprFloatError(interp, d);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	PUSH_OBJECT(Tcl_NewDoubleObj(d));
+    }
+
+    /*
+     * Reflect the change to stackTop back in eePtr.
+     */
+
+    done:
+    DECACHE_STACK_INFO();
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExprFloatError --
+ *
+ *	This procedure is called when an error occurs during a
+ *	floating-point operation. It reads errno and sets
+ *	interp->objResultPtr accordingly.
+ *
+ * Results:
+ *	interp->objResultPtr is set to hold an error message.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExprFloatError(interp, value)
+    Tcl_Interp *interp;		/* Where to store error message. */
+    double value;		/* Value returned after error;  used to
+				 * distinguish underflows from overflows. */
+{
+    char *s;
+
+    Tcl_ResetResult(interp);
+    if ((errno == EDOM) || (value != value)) {
+	s = "domain error: argument not in valid range";
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
+    } else if ((errno == ERANGE) || IS_INF(value)) {
+	if (value == 0.0) {
+	    s = "floating-point value too small to represent";
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
+	} else {
+	    s = "floating-point value too large to represent";
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
+	}
+    } else {			/* FAILS IF STRING REP CONTAINS NULLS */
+	char msg[100];
+	
+	sprintf(msg, "unknown floating-point error, errno = %d", errno);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
+	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
+    }
+}
+
+#ifdef TCL_COMPILE_STATS
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvalStatsCmd --
+ *
+ *	Implements the "evalstats" command that prints instruction execution
+ *	counts to stdout.
+ *
+ * Results:
+ *	Standard Tcl results.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EvalStatsCmd(unused, interp, argc, argv)
+    ClientData unused;		/* Unused. */
+    Tcl_Interp *interp;		/* The current interpreter. */
+    int argc;			/* The number of arguments. */
+    char **argv;		/* The argument strings. */
+{
+    register double total = 0.0;
+    register int i;
+
+    for (i = 0;  i < 256;  i++) {
+        if (instructionCount[i]) {
+            total += instructionCount[i];
+        }
+    }   
+
+    fprintf(stdout, "\nNumber of ByteCode compilations: %ld\n",
+	    tclNumCompilations);
+    fprintf(stdout, "Number of ByteCode executions: %ld\n",
+	    numExecutions);
+    fprintf(stdout, "Number of Tcl objects in use: %ld, allocated %ld, freed %ld\n",
+	    (tclObjsAlloced - tclObjsFreed), tclObjsAlloced, tclObjsFreed);
+    fprintf(stdout, "Number of instructions executed: %.0f\n\n", total);
+    for (i = 0;  i < 256;  i++) {
+        if (instructionCount[i]) {
+            fprintf(stdout, "%30s %8d %6.2f%%\n",
+		    opName[i], instructionCount[i],
+		    (instructionCount[i] * 100.0)/total);
+        }
+    }
+
+#ifdef TCL_MEM_DEBUG
+    fprintf(stdout, "\nHeap Statistics:\n");
+    TclDumpMemoryInfo(stdout);
+#endif /* TCL_MEM_DEBUG */
+
+    return TCL_OK;
+}
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandFromObj --
+ *
+ *      Returns the command specified by the name in a Tcl_Obj.
+ *
+ * Results:
+ *	Returns a token for the command if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL.
+ *
+ * Side effects:
+ *      May update the internal representation for the object, caching
+ *      the command reference so that the next time this procedure is
+ *	called with the same object, the command can be found quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_GetCommandFromObj(interp, objPtr)
+    Tcl_Interp *interp;		/* The interpreter in which to resolve the
+				 * command and to report errors. */
+    register Tcl_Obj *objPtr;	/* The object containing the command's
+				 * name. If the name starts with "::", will
+				 * be looked up in global namespace. Else,
+				 * looked up first in the current namespace
+				 * if contextNsPtr is NULL, then in global
+				 * namespace. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register ResolvedCmdName *resPtr;
+    register Command *cmdPtr;
+    Namespace *currNsPtr;
+    int result;
+
+    /*
+     * Get the internal representation, converting to a command type if
+     * needed. The internal representation is a ResolvedCmdName that points
+     * to the actual command.
+     */
+    
+    if (objPtr->typePtr != &tclCmdNameType) {
+        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return (Tcl_Command) NULL;
+        }
+    }
+    resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+
+    /*
+     * Get the current namespace.
+     */
+    
+    if (iPtr->varFramePtr != NULL) {
+	currNsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+	currNsPtr = iPtr->globalNsPtr;
+    }
+
+    /*
+     * Check the context namespace and the namespace epoch of the resolved
+     * symbol to make sure that it is fresh. If not, then force another
+     * conversion to the command type, to discard the old rep and create a
+     * new one. Note that we verify that the namespace id of the context
+     * namespace is the same as the one we cached; this insures that the
+     * namespace wasn't deleted and a new one created at the same address
+     * with the same command epoch.
+     */
+    
+    cmdPtr = NULL;
+    if ((resPtr != NULL)
+	    && (resPtr->refNsPtr == currNsPtr)
+	    && (resPtr->refNsId == currNsPtr->nsId)
+	    && (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
+        cmdPtr = resPtr->cmdPtr;
+        if (cmdPtr->cmdEpoch != resPtr->cmdEpoch) {
+            cmdPtr = NULL;
+        }
+    }
+
+    if (cmdPtr == NULL) {
+        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return (Tcl_Command) NULL;
+        }
+        resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+        if (resPtr != NULL) {
+            cmdPtr = resPtr->cmdPtr;
+        }
+    }
+
+    if (cmdPtr == NULL) {
+	return (Tcl_Command) NULL;
+    }
+    return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCmdNameInternalRep --
+ *
+ *	Frees the resources associated with a cmdName object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Decrements the ref count of any cached ResolvedCmdName structure
+ *	pointed to by the cmdName's internal representation. If this is 
+ *	the last use of the ResolvedCmdName, it is freed. This in turn
+ *	decrements the ref count of the Command structure pointed to by 
+ *	the ResolvedSymbol, which may free the Command structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeCmdNameInternalRep(objPtr)
+    register Tcl_Obj *objPtr;	/* CmdName object with internal
+				 * representation to free. */
+{
+    register ResolvedCmdName *resPtr =
+	(ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+
+    if (resPtr != NULL) {
+	/*
+	 * Decrement the reference count of the ResolvedCmdName structure.
+	 * If there are no more uses, free the ResolvedCmdName structure.
+	 */
+    
+        resPtr->refCount--;
+        if (resPtr->refCount == 0) {
+            /*
+	     * Now free the cached command, unless it is still in its
+             * hash table or if there are other references to it
+             * from other cmdName objects.
+	     */
+	    
+            Command *cmdPtr = resPtr->cmdPtr;
+            TclCleanupCommand(cmdPtr);
+            ckfree((char *) resPtr);
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupCmdNameInternalRep --
+ *
+ *	Initialize the internal representation of an cmdName Tcl_Obj to a
+ *	copy of the internal representation of an existing cmdName object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to point to the ResolvedCmdName
+ *	structure corresponding to "srcPtr"s internal rep. Increments the
+ *	ref count of the ResolvedCmdName structure pointed to by the
+ *	cmdName's internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupCmdNameInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    register ResolvedCmdName *resPtr =
+        (ResolvedCmdName *) srcPtr->internalRep.otherValuePtr;
+
+    copyPtr->internalRep.otherValuePtr = (VOID *) resPtr;
+    if (resPtr != NULL) {
+        resPtr->refCount++;
+    }
+    copyPtr->typePtr = &tclCmdNameType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetCmdNameFromAny --
+ *
+ *	Generate an cmdName internal form for the Tcl object "objPtr".
+ *
+ * Results:
+ *	The return value is a standard Tcl result. The conversion always
+ *	succeeds and TCL_OK is returned.
+ *
+ * Side effects:
+ *	A pointer to a ResolvedCmdName structure that holds a cached pointer
+ *	to the command with a name that matches objPtr's string rep is
+ *	stored as objPtr's internal representation. This ResolvedCmdName
+ *	pointer will be NULL if no matching command was found. The ref count
+ *	of the cached Command's structure (if any) is also incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetCmdNameFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *name;
+    Tcl_Command cmd;
+    register Command *cmdPtr;
+    Namespace *currNsPtr;
+    register ResolvedCmdName *resPtr;
+
+    /*
+     * Get "objPtr"s string representation. Make it up-to-date if necessary.
+     */
+
+    name = objPtr->bytes;
+    if (name == NULL) {
+	name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+    }
+
+    /*
+     * Find the Command structure, if any, that describes the command called
+     * "name". Build a ResolvedCmdName that holds a cached pointer to this
+     * Command, and bump the reference count in the referenced Command
+     * structure. A Command structure will not be deleted as long as it is
+     * referenced from a CmdName object.
+     */
+
+    cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
+	    /*flags*/ 0);
+    cmdPtr = (Command *) cmd;
+    if (cmdPtr != NULL) {
+	/*
+	 * Get the current namespace.
+	 */
+	
+	if (iPtr->varFramePtr != NULL) {
+	    currNsPtr = iPtr->varFramePtr->nsPtr;
+	} else {
+	    currNsPtr = iPtr->globalNsPtr;
+	}
+	
+	cmdPtr->refCount++;
+        resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+        resPtr->cmdPtr        = cmdPtr;
+        resPtr->refNsPtr      = currNsPtr;
+        resPtr->refNsId       = currNsPtr->nsId;
+        resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+        resPtr->cmdEpoch      = cmdPtr->cmdEpoch;
+        resPtr->refCount      = 1;
+    } else {
+	resPtr = NULL;	/* no command named "name" was found */
+    }
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as
+     * late as possible to allow the conversion code, in particular
+     * GetStringFromObj, to use that old internalRep. If no Command
+     * structure was found, leave NULL as the cached value.
+     */
+
+    if ((objPtr->typePtr != NULL)
+	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+    objPtr->typePtr = &tclCmdNameType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfCmdName --
+ *
+ *	Update the string representation for an cmdName object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Generates a panic. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfCmdName(objPtr)
+    Tcl_Obj *objPtr;		/* CmdName obj to update string rep. */
+{
+    /*
+     * This procedure is never invoked since the internal representation of
+     * a cmdName object is never modified.
+     */
+
+    panic("UpdateStringOfCmdName should never be invoked");
+}
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringForResultCode --
+ *
+ *	Procedure that returns a human-readable string representing a
+ *	Tcl result code such as TCL_ERROR. 
+ *
+ * Results:
+ *	If the result code is one of the standard Tcl return codes, the
+ *	result is a string representing that code such as "TCL_ERROR".
+ *	Otherwise, the result string is that code formatted as a
+ *	sequence of decimal digit characters. Note that the resulting
+ *	string must not be modified by the caller.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+StringForResultCode(result)
+    int result;			/* The Tcl result code for which to
+				 * generate a string. */
+{
+    static char buf[20];
+    
+    if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
+	return resultStrings[result];
+    }
+    TclFormatInt(buf, result);
+    return buf;
+}
+#endif /* TCL_COMPILE_DEBUG */
diff --git a/contrib/tcl/generic/tclFCmd.c b/contrib/tcl/generic/tclFCmd.c
new file mode 100644
index 0000000..ffee889
--- /dev/null
+++ b/contrib/tcl/generic/tclFCmd.c
@@ -0,0 +1,815 @@
+/*
+ * tclFCmd.c
+ *
+ *      This file implements the generic portion of file manipulation 
+ *      subcommands of the "file" command. 
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclFCmd.c 1.17 97/05/14 13:23:13
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static int		CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *source, char *dest, int copyFlag,
+			    int force));
+static char *		FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *path, Tcl_DString *bufferPtr));
+static int		FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv, int copyFlag));
+static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv, int *forcePtr));
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFileRenameCmd
+ *
+ *	This procedure implements the "rename" subcommand of the "file"
+ *      command.  Filename arguments need to be translated to native
+ *	format before being passed to platform-specific code that
+ *	implements rename functionality.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclFileRenameCmd(interp, argc, argv)
+    Tcl_Interp *interp;		/* Interp for error reporting. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
+{
+    return FileCopyRename(interp, argc, argv, 0);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFileCopyCmd
+ *
+ *	This procedure implements the "copy" subcommand of the "file"
+ *	command.  Filename arguments need to be translated to native
+ *	format before being passed to platform-specific code that
+ *	implements copy functionality.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclFileCopyCmd(interp, argc, argv)
+    Tcl_Interp *interp;		/* Used for error reporting */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
+{
+    return FileCopyRename(interp, argc, argv, 1);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FileCopyRename --
+ *
+ *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.
+ *	See comments for those procedures.
+ *
+ * Results:
+ *	See above.
+ *
+ * Side effects:
+ *	See above.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FileCopyRename(interp, argc, argv, copyFlag)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
+    int copyFlag;		/* If non-zero, copy source(s).  Otherwise,
+				 * rename them. */
+{
+    int i, result, force;
+    struct stat statBuf; 
+    Tcl_DString targetBuffer;
+    char *target;
+
+    i = FileForceOption(interp, argc - 2, argv + 2, &force);
+    if (i < 0) {
+	return TCL_ERROR;
+    }
+    i += 2;
+    if ((argc - i) < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ", argv[1], " ?options? source ?source ...? target\"", 
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * If target doesn't exist or isn't a directory, try the copy/rename.
+     * More than 2 arguments is only valid if the target is an existing
+     * directory.
+     */
+
+    target = Tcl_TranslateFileName(interp, argv[argc - 1], &targetBuffer);
+    if (target == NULL) {
+	return TCL_ERROR;
+    }
+
+    result = TCL_OK;
+
+    /*
+     * Call stat() so that if target is a symlink that points to a directory
+     * we will put the sources in that directory instead of overwriting the
+     * symlink.
+     */
+
+    if ((stat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
+	if ((argc - i) > 2) {
+	    errno = ENOTDIR;
+	    Tcl_PosixError(interp);
+	    Tcl_AppendResult(interp, "error ",
+		    ((copyFlag) ? "copying" : "renaming"), ": target \"",
+		    argv[argc - 1], "\" is not a directory", (char *) NULL);
+	    result = TCL_ERROR;
+	} else {
+	    /*
+	     * Even though already have target == translated(argv[i+1]),
+	     * pass the original argument down, so if there's an error, the
+	     * error message will reflect the original arguments.
+	     */
+
+	    result = CopyRenameOneFile(interp, argv[i], argv[i + 1], copyFlag,
+		    force);
+	}
+	Tcl_DStringFree(&targetBuffer);
+	return result;
+    }
+    
+    /*
+     * Move each source file into target directory.  Extract the basename
+     * from each source, and append it to the end of the target path.
+     */
+    
+    for ( ; i < argc - 1; i++) {
+	char *jargv[2];
+	char *source, *newFileName;
+	Tcl_DString sourceBuffer, newFileNameBuffer;
+
+	source = FileBasename(interp, argv[i], &sourceBuffer);
+	if (source == NULL) {
+	    result = TCL_ERROR;
+	    break;
+	}
+	jargv[0] = argv[argc - 1];
+	jargv[1] = source;
+	Tcl_DStringInit(&newFileNameBuffer);
+	newFileName = Tcl_JoinPath(2, jargv, &newFileNameBuffer);
+	result = CopyRenameOneFile(interp, argv[i], newFileName, copyFlag,
+		force);
+	Tcl_DStringFree(&sourceBuffer);
+	Tcl_DStringFree(&newFileNameBuffer);
+
+	if (result == TCL_ERROR) {
+	    break;
+	}
+    }
+    Tcl_DStringFree(&targetBuffer);
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFileMakeDirsCmd
+ *
+ *	This procedure implements the "mkdir" subcommand of the "file"
+ *      command.  Filename arguments need to be translated to native
+ *	format before being passed to platform-specific code that
+ *	implements mkdir functionality.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclFileMakeDirsCmd(interp, argc, argv)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    int argc;			/* Number of arguments */
+    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
+{
+    Tcl_DString nameBuffer, targetBuffer;
+    char *errfile;
+    int result, i, j, pargc;
+    char **pargv;
+    struct stat statBuf;
+
+    pargv = NULL;
+    errfile = NULL;
+    Tcl_DStringInit(&nameBuffer);
+    Tcl_DStringInit(&targetBuffer);
+
+    result = TCL_OK;
+    for (i = 2; i < argc; i++) {
+	char *name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
+	if (name == NULL) {
+	    result = TCL_ERROR;
+	    break;
+	}
+
+	Tcl_SplitPath(name, &pargc, &pargv);
+	if (pargc == 0) {
+	    errno = ENOENT;
+	    errfile = argv[i];
+	    break;
+	}
+	for (j = 0; j < pargc; j++) {
+	    char *target = Tcl_JoinPath(j + 1, pargv, &targetBuffer);
+
+	    /*
+	     * Call stat() so that if target is a symlink that points to a
+	     * directory we will create subdirectories in that directory.
+	     */
+
+	    if (stat(target, &statBuf) == 0) {
+		if (!S_ISDIR(statBuf.st_mode)) {
+		    errno = EEXIST;
+		    errfile = target;
+		    goto done;
+		}
+	    } else if ((errno != ENOENT)
+		    || (TclpCreateDirectory(target) != TCL_OK)) {
+		errfile = target;
+		goto done;
+	    }
+	    Tcl_DStringFree(&targetBuffer);
+	}
+	ckfree((char *) pargv);
+	pargv = NULL;
+	Tcl_DStringFree(&nameBuffer);
+    }
+	
+    done:
+    if (errfile != NULL) {
+	Tcl_AppendResult(interp, "can't create directory \"",
+		errfile, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	result = TCL_ERROR;
+    }
+
+    Tcl_DStringFree(&nameBuffer);
+    Tcl_DStringFree(&targetBuffer);
+    if (pargv != NULL) {
+	ckfree((char *) pargv);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFileDeleteCmd
+ *
+ *	This procedure implements the "delete" subcommand of the "file"
+ *      command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFileDeleteCmd(interp, argc, argv)
+    Tcl_Interp *interp;		/* Used for error reporting */
+    int argc;			/* Number of arguments */
+    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
+{
+    Tcl_DString nameBuffer, errorBuffer;
+    int i, force, result;
+    char *errfile;
+    
+    i = FileForceOption(interp, argc - 2, argv + 2, &force);
+    if (i < 0) {
+	return TCL_ERROR;
+    }
+    i += 2;
+    if ((argc - i) < 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ", argv[1], " ?options? file ?file ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    errfile = NULL;
+    result = TCL_OK;
+    Tcl_DStringInit(&errorBuffer);
+    Tcl_DStringInit(&nameBuffer);
+
+    for ( ; i < argc; i++) {
+	struct stat statBuf;
+	char *name;
+
+	errfile = argv[i];
+	Tcl_DStringSetLength(&nameBuffer, 0);
+	name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
+	if (name == NULL) {
+	    result = TCL_ERROR;
+	    goto done;
+	}
+
+	/*
+	 * Call lstat() to get info so can delete symbolic link itself.
+	 */
+
+	if (lstat(name, &statBuf) != 0) {
+	    /*
+	     * Trying to delete a file that does not exist is not
+	     * considered an error, just a no-op
+	     */
+
+	    if (errno != ENOENT) {
+		result = TCL_ERROR;
+	    }
+	} else if (S_ISDIR(statBuf.st_mode)) {
+	    result = TclpRemoveDirectory(name, force, &errorBuffer);
+	    if (result != TCL_OK) {
+		if ((force == 0) && (errno == EEXIST)) {
+		    Tcl_AppendResult(interp, "error deleting \"", argv[i],
+			    "\": directory not empty", (char *) NULL);
+		    Tcl_PosixError(interp);
+		    goto done;
+		}
+
+		/* 
+		 * If possible, use the untranslated name for the file.
+		 */
+		 
+		errfile = Tcl_DStringValue(&errorBuffer);
+		if (strcmp(name, errfile) == 0) {
+		    errfile = argv[i];
+		}
+	    }
+	} else {
+	    result = TclpDeleteFile(name);
+	}
+	
+	if (result == TCL_ERROR) {
+	    break;
+	}
+    }
+    if (result != TCL_OK) {
+	Tcl_AppendResult(interp, "error deleting \"", errfile,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+    } 
+    done:
+    Tcl_DStringFree(&errorBuffer);
+    Tcl_DStringFree(&nameBuffer);
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CopyRenameOneFile
+ *
+ *	Copies or renames specified source file or directory hierarchy
+ *	to the specified target.  
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Target is overwritten if the force flag is set.  Attempting to
+ *	copy/rename a file onto a directory or a directory onto a file
+ *	will always result in an error.  
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyRenameOneFile(interp, source, target, copyFlag, force) 
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *source;		/* Pathname of file to copy.  May need to
+				 * be translated. */
+    char *target;		/* Pathname of file to create/overwrite.
+				 * May need to be translated. */
+    int copyFlag;		/* If non-zero, copy files.  Otherwise,
+				 * rename them. */
+    int force;			/* If non-zero, overwrite target file if it
+				 * exists.  Otherwise, error if target already
+				 * exists. */
+{
+    int result;
+    Tcl_DString sourcePath, targetPath, errorBuffer;
+    char *targetName, *sourceName, *errfile;
+    struct stat sourceStatBuf, targetStatBuf;
+	
+    sourceName = Tcl_TranslateFileName(interp, source, &sourcePath);
+    if (sourceName == NULL) {
+	return TCL_ERROR;
+    }
+    targetName = Tcl_TranslateFileName(interp, target, &targetPath);
+    if (targetName == NULL) {
+	Tcl_DStringFree(&sourcePath);
+	return TCL_ERROR;
+    }
+    
+    errfile = NULL;
+    result = TCL_ERROR;
+    Tcl_DStringInit(&errorBuffer);
+    
+    /*
+     * We want to copy/rename links and not the files they point to, so we
+     * use lstat(). If target is a link, we also want to replace the 
+     * link and not the file it points to, so we also use lstat() on the
+     * target.
+     */
+
+    if (lstat(sourceName, &sourceStatBuf) != 0) {
+	errfile = source;
+	goto done;
+    }
+    if (lstat(targetName, &targetStatBuf) != 0) {
+	if (errno != ENOENT) {
+	    errfile = target;
+	    goto done;
+	}
+    } else {
+	if (force == 0) {
+	    errno = EEXIST;
+	    errfile = target;
+	    goto done;
+	}
+
+        /* 
+         * Prevent copying or renaming a file onto itself.  Under Windows, 
+         * stat always returns 0 for st_ino.  However, the Windows-specific 
+         * code knows how to deal with copying or renaming a file on top of
+         * itself.  It might be a good idea to write a stat that worked.
+         */
+     
+        if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
+            if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
+            	    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
+            	result = TCL_OK;
+            	goto done;
+            }
+        }
+
+	/*
+	 * Prevent copying/renaming a file onto a directory and
+	 * vice-versa.  This is a policy decision based on the fact that
+	 * existing implementations of copy and rename on all platforms
+	 * also prevent this.
+	 */
+
+	if (S_ISDIR(sourceStatBuf.st_mode)
+                && !S_ISDIR(targetStatBuf.st_mode)) {
+	    errno = EISDIR;
+	    Tcl_AppendResult(interp, "can't overwrite file \"", target,
+		    "\" with directory \"", source, "\"", (char *) NULL);
+	    goto done;
+	}
+	if (!S_ISDIR(sourceStatBuf.st_mode)
+	        && S_ISDIR(targetStatBuf.st_mode)) {
+	    errno = EISDIR;
+	    Tcl_AppendResult(interp, "can't overwrite directory \"", target, 
+	            "\" with file \"", source, "\"", (char *) NULL);
+	    goto done;
+	}
+    }
+
+    if (copyFlag == 0) {
+	result = TclpRenameFile(sourceName, targetName);
+	if (result == TCL_OK) {
+	    goto done;
+	}
+	    
+	if (errno == EINVAL) {
+	    Tcl_AppendResult(interp, "error renaming \"", source, "\" to \"",
+		    target, "\": trying to rename a volume or ",
+		    "move a directory into itself", (char *) NULL);
+	    goto done;
+	} else if (errno != EXDEV) {
+	    errfile = target;
+	    goto done;
+	}
+	
+	/*
+	 * The rename failed because the move was across file systems.
+	 * Fall through to copy file and then remove original.  Note that
+	 * the low-level TclpRenameFile is allowed to implement
+	 * cross-filesystem moves itself.
+	 */
+    }
+
+    if (S_ISDIR(sourceStatBuf.st_mode)) {
+	result = TclpCopyDirectory(sourceName, targetName, &errorBuffer);
+	if (result != TCL_OK) {
+	    errfile = Tcl_DStringValue(&errorBuffer);
+	    if (strcmp(errfile, sourceName) == 0) {
+		errfile = source;
+	    } else if (strcmp(errfile, targetName) == 0) {
+		errfile = target;
+	    }
+	}
+    } else {
+	result = TclpCopyFile(sourceName, targetName);
+	if (result != TCL_OK) {
+	    /*
+	     * Well, there really shouldn't be a problem with source,
+	     * because up there we checked to see if it was ok to copy it.
+	     */
+
+	    errfile = target;
+	}
+    }
+    if ((copyFlag == 0) && (result == TCL_OK)) {
+	if (S_ISDIR(sourceStatBuf.st_mode)) {
+	    result = TclpRemoveDirectory(sourceName, 1, &errorBuffer);
+	    if (result != TCL_OK) {
+		errfile = Tcl_DStringValue(&errorBuffer);
+		if (strcmp(errfile, sourceName) == 0) {
+		    errfile = source;
+		}
+	    }
+	} else {
+	    result = TclpDeleteFile(sourceName);
+	    if (result != TCL_OK) {
+		errfile = source;
+	    }
+	}
+	if (result != TCL_OK) {
+	    Tcl_AppendResult(interp, "can't unlink \"", errfile, "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+	    errfile = NULL;
+	}
+    }
+    
+    done:
+    if (errfile != NULL) {
+	Tcl_AppendResult(interp, 
+		((copyFlag) ? "error copying \"" : "error renaming \""),
+		source, (char *) NULL);
+	if (errfile != source) {
+	    Tcl_AppendResult(interp, "\" to \"", target, (char *) NULL);
+	    if (errfile != target) {
+		Tcl_AppendResult(interp, "\": \"", errfile, (char *) NULL);
+	    }
+	}
+	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
+		(char *) NULL);
+    }
+    Tcl_DStringFree(&errorBuffer);
+    Tcl_DStringFree(&sourcePath);
+    Tcl_DStringFree(&targetPath);
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FileForceOption --
+ *
+ *	Helps parse command line options for file commands that take
+ *	the "-force" and "--" options.
+ *
+ * Results:
+ *	The return value is how many arguments from argv were consumed
+ *	by this function, or -1 if there was an error parsing the
+ *	options.  If an error occurred, an error message is left in
+ *	interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FileForceOption(interp, argc, argv, forcePtr)
+    Tcl_Interp *interp;		/* Interp, for error return. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings.  First command line
+    option, if it exists, begins at */
+    int *forcePtr;		/* If the "-force" was specified, *forcePtr
+				 * is filled with 1, otherwise with 0. */
+{
+    int force, i;
+    
+    force = 0;
+    for (i = 0; i < argc; i++) {
+	if (argv[i][0] != '-') {
+	    break;
+	}
+	if (strcmp(argv[i], "-force") == 0) {
+	    force = 1;
+	} else if (strcmp(argv[i], "--") == 0) {
+	    i++;
+	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", argv[i], 
+		    "\": should be -force or --", (char *)NULL);
+	    return -1;
+	}
+    }
+    *forcePtr = force;
+    return i;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FileBasename --
+ *
+ *	Given a path in either tcl format (with / separators), or in the
+ *	platform-specific format for the current platform, return all the
+ *	characters in the path after the last directory separator.  But,
+ *	if path is the root directory, returns no characters.
+ *
+ * Results:
+ *	Appends the string that represents the basename to the end of
+ *	the specified initialized DString, returning a pointer to the
+ *	resulting string.  If there is an error, an error message is left
+ *	in interp, NULL is returned, and the Tcl_DString is unmodified.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static char *
+FileBasename(interp, path, bufferPtr)
+    Tcl_Interp *interp;		/* Interp, for error return. */
+    char *path;			/* Path whose basename to extract. */
+    Tcl_DString *bufferPtr;	/* Initialized DString that receives
+				 * basename. */
+{
+    int argc;
+    char **argv;
+    
+    Tcl_SplitPath(path, &argc, &argv);
+    if (argc == 0) {
+	Tcl_DStringInit(bufferPtr);
+    } else {
+	if ((argc == 1) && (*path == '~')) {
+	    Tcl_DString buffer;
+	    
+	    ckfree((char *) argv);
+	    path = Tcl_TranslateFileName(interp, path, &buffer);
+	    if (path == NULL) {
+		return NULL;
+	    }
+	    Tcl_SplitPath(path, &argc, &argv);
+	    Tcl_DStringFree(&buffer);
+	}
+	Tcl_DStringInit(bufferPtr);
+
+	/*
+	 * Return the last component, unless it is the only component, and it
+	 * is the root of an absolute path.
+	 */
+
+	if (argc > 0) {
+	    if ((argc > 1)
+		    || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
+		Tcl_DStringAppend(bufferPtr, argv[argc - 1], -1);
+	    }
+	}
+    }
+    ckfree((char *) argv);
+    return Tcl_DStringValue(bufferPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFileAttrsCmd --
+ *
+ *      Sets or gets the platform-specific attributes of a file. The objc-objv
+ *	points to the file name with the rest of the command line following.
+ *	This routine uses platform-specific tables of option strings
+ *	and callbacks. The callback to get the attributes take three
+ *	parameters:
+ *	    Tcl_Interp *interp;	    The interp to report errors with.
+ *				    Since this is an object-based API,
+ *				    the object form of the result should be
+ *				    used.
+ *	    CONST char *fileName;   This is extracted using
+ *				    Tcl_TranslateFileName.
+ *	    TclObj **attrObjPtrPtr; A new object to hold the attribute
+ *				    is allocated and put here.
+ *	The first two parameters of the callback used to write out the
+ *	attributes are the same. The third parameter is:
+ *	    CONST *attrObjPtr;	    A pointer to the object that has
+ *				    the new attribute.
+ *	They both return standard TCL errors; if the routine to get
+ *	an attribute fails, no object is allocated and *attrObjPtrPtr
+ *	is unchanged.
+ *
+ * Results:
+ *      Standard TCL error.
+ *
+ * Side effects:
+ *      May set file attributes for the file name.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFileAttrsCmd(interp, objc, objv)
+    Tcl_Interp *interp;		/* The interpreter for error reporting. */
+    int objc;			/* Number of command line arguments. */
+    Tcl_Obj *CONST objv[];	/* The command line objects. */
+{
+    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+    char *fileName;
+    int length, index;
+    Tcl_Obj *listObjPtr;
+    Tcl_Obj *elementObjPtr;
+    Tcl_DString buffer;
+
+    if ((objc > 2) && ((objc % 2) == 0)) {
+	Tcl_AppendStringsToObj(resultPtr, 
+		"wrong # args: must be \"file attributes name ?option? ?value? ?option value? ...\"",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    fileName = Tcl_GetStringFromObj(objv[0], &length);
+    if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
+    	return TCL_ERROR;
+    }
+    fileName = Tcl_DStringValue(&buffer);
+    
+    if (objc == 1) {
+    	listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    	
+    	for (index = 0; tclpFileAttrStrings[index] != NULL; index++) {
+    	    elementObjPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1);
+	    Tcl_ListObjAppendElement(interp, listObjPtr, elementObjPtr);
+	    if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
+	    	    &elementObjPtr) != TCL_OK) {
+	    	Tcl_DecrRefCount(listObjPtr);
+	    	return TCL_ERROR;
+	    }
+	    Tcl_ListObjAppendElement(interp, listObjPtr, elementObjPtr);
+    	}
+    	Tcl_SetObjResult(interp, listObjPtr);
+    } else if (objc == 2) {
+    	if (Tcl_GetIndexFromObj(interp, objv[1], tclpFileAttrStrings, "option",
+    		0, &index) != TCL_OK) {
+    	    return TCL_ERROR;
+    	}
+	if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
+		&elementObjPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, elementObjPtr);
+    } else {
+        int i;
+        
+    	for (i = 1; i < objc ; i += 2) {
+    	    if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings, "option",
+    	    	    0, &index) != TCL_OK) {
+    	    	return TCL_ERROR;
+    	    }
+    	    if ((*tclpFileAttrProcs[index].setProc)(interp, index, fileName,
+    	    	    objv[i + 1]) != TCL_OK) {
+    	    	return TCL_ERROR;
+    	    }
+    	}
+    }
+    
+    Tcl_DStringFree(&buffer);
+    
+    return TCL_OK;
+}
diff --git a/contrib/tcl/generic/tclFileName.c b/contrib/tcl/generic/tclFileName.c
index 90beb11..7464304 100644
--- a/contrib/tcl/generic/tclFileName.c
+++ b/contrib/tcl/generic/tclFileName.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclFileName.c 1.23 96/04/19 12:34:28
+ * SCCS: @(#) tclFileName.c 1.28 97/05/14 13:23:48
  */
 
 #include "tclInt.h"
@@ -95,10 +95,13 @@ FileNameCleanup(clientData)
 {
     if (winRootPatternPtr != NULL) {
 	ckfree((char *)winRootPatternPtr);
+        winRootPatternPtr = (regexp *) NULL;
     }
     if (macRootPatternPtr != NULL) {
 	ckfree((char *)macRootPatternPtr);
+        macRootPatternPtr = (regexp *) NULL;
     }
+    initialized = 0;
 }
 
 /*
@@ -901,7 +904,8 @@ Tcl_JoinPath(argc, argv, resultPtr)
  * Side effects:
  *	Information may be left in bufferPtr.
  *
- *---------------------------------------------------------------------- */
+ *----------------------------------------------------------------------
+ */
 
 char *
 Tcl_TranslateFileName(interp, name, bufferPtr)
@@ -1025,6 +1029,17 @@ TclGetExtension(name)
 	    && (lastSep > p)) {
 	p = NULL;
     }
+
+    /*
+     * Back up to the first period in a series of contiguous dots.
+     * This is needed so foo..o will be split on the first dot.
+     */
+
+    if (p != NULL) {
+	while ((p > name) && *(p-1) == '.') {
+	    p--;
+	}
+    }
     return p;
 }
 
@@ -1139,8 +1154,6 @@ Tcl_GlobCmd(dummy, interp, argc, argv)
     Tcl_DStringInit(&buffer);
     separators = NULL;		/* Needed only to prevent gcc warnings. */
     for (i = firstArg; i < argc; i++) {
-	head = tail = "";
-
 	switch (tclPlatform) {
 	case TCL_PLATFORM_UNIX:
 	    separators = "/";
@@ -1324,9 +1337,9 @@ TclDoGlob(interp, separators, headPtr, tail)
     Tcl_DString *headPtr;	/* Completely expanded prefix. */
     char *tail;			/* The unexpanded remainder of the path. */
 {
-    int level, baseLength, quoted, count;
+    int baseLength, quoted, count;
     int result = TCL_OK;
-    char *p, *openBrace, *closeBrace, *name, savedChar;
+    char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
     char lastChar = 0;
     int length = Tcl_DStringLength(headPtr);
 
@@ -1423,7 +1436,6 @@ TclDoGlob(interp, separators, headPtr, tail)
      */
 
     openBrace = closeBrace = NULL;
-    level = 0;
     quoted = 0;
     for (p = tail; *p != '\0'; p++) {
 	if (quoted) {
@@ -1442,12 +1454,12 @@ TclDoGlob(interp, separators, headPtr, tail)
 		closeBrace = p;		/* Balanced braces. */
 		break;
 	    }
-	    Tcl_ResetResult(interp);
-	    interp->result = "unmatched open-brace in file name";
+	    Tcl_SetResult(interp, "unmatched open-brace in file name",
+		    TCL_STATIC);
 	    return TCL_ERROR;
 	} else if (*p == '}') {
-	    Tcl_ResetResult(interp);
-	    interp->result = "unmatched close-brace in file name";
+	    Tcl_SetResult(interp, "unmatched close-brace in file name",
+		    TCL_STATIC);
 	    return TCL_ERROR;
 	}
     }
@@ -1495,13 +1507,19 @@ TclDoGlob(interp, separators, headPtr, tail)
      * this path component.  The variable p is pointing at a quoted or
      * unquoted directory separator or the end of the string.  So we need
      * to check for special globbing characters in the current pattern.
+     * We avoid modifying tail if p is pointing at the end of the string.
      */
 
-    savedChar = *p;
-    *p = '\0';
+    if (*p != '\0') {
+	 savedChar = *p;
+	 *p = '\0';
+	 firstSpecialChar = strpbrk(tail, "*[]?\\");
+	 *p = savedChar;
+    } else {
+	firstSpecialChar = strpbrk(tail, "*[]?\\");
+    }
 
-    if (strpbrk(tail, "*[]?\\") != NULL) {
-	*p = savedChar;
+    if (firstSpecialChar != NULL) {
 	/*
 	 * Look for matching files in the current directory.  The
 	 * implementation of this function is platform specific, but may
@@ -1512,7 +1530,6 @@ TclDoGlob(interp, separators, headPtr, tail)
 
 	return TclMatchFiles(interp, separators, headPtr, tail, p);
     }
-    *p = savedChar;
     Tcl_DStringAppend(headPtr, tail, p-tail);
     if (*p != '\0') {
 	return TclDoGlob(interp, separators, headPtr, p);
diff --git a/contrib/tcl/generic/tclGet.c b/contrib/tcl/generic/tclGet.c
index 9e208b9..76a0d5a 100644
--- a/contrib/tcl/generic/tclGet.c
+++ b/contrib/tcl/generic/tclGet.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclGet.c 1.24 96/02/15 11:42:47
+ * SCCS: @(#) tclGet.c 1.33 97/05/14 16:42:19
  */
 
 #include "tclInt.h"
@@ -45,7 +45,7 @@ Tcl_GetInt(interp, string, intPtr)
     int *intPtr;		/* Place to store converted result. */
 {
     char *end, *p;
-    int i;
+    long i;
 
     /*
      * Note: use strtoul instead of strtol for integer conversions
@@ -59,6 +59,90 @@ Tcl_GetInt(interp, string, intPtr)
     }
     if (*p == '-') {
 	p++;
+	i = -((long)strtoul(p, &end, 0));
+    } else if (*p == '+') {
+	p++;
+	i = strtoul(p, &end, 0);
+    } else {
+	i = strtoul(p, &end, 0);
+    }
+    if (end == p) {
+	badInteger:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "expected integer but got \"", string,
+                    "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+
+    /*
+     * The second test below is needed on platforms where "long" is
+     * larger than "int" to detect values that fit in a long but not in
+     * an int.
+     */
+
+    if ((errno == ERANGE) || (((long)(int) i) != i)) {
+        if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_SetResult(interp, "integer value too large to represent",
+		    TCL_STATIC);
+            Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+                    interp->result, (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    while ((*end != '\0') && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (*end != 0) {
+	goto badInteger;
+    }
+    *intPtr = (int) i;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetLong --
+ *
+ *	Given a string, produce the corresponding long integer value.
+ *	This routine is a version of Tcl_GetInt but returns a "long"
+ *	instead of an "int".
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *longPtr
+ *	will be set to the long integer value equivalent to string. If
+ *	string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetLong(interp, string, longPtr)
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
+    char *string;		/* String containing a (possibly signed)
+				 * long integer in a form acceptable to
+				 * strtoul. */
+    long *longPtr;		/* Place to store converted long result. */
+{
+    char *end, *p;
+    long i;
+
+    /*
+     * Note: don't depend on strtoul to handle sign characters; it won't
+     * in some implementations.
+     */
+
+    errno = 0;
+    for (p = string; isspace(UCHAR(*p)); p++) {
+	/* Empty loop body. */
+    }
+    if (*p == '-') {
+	p++;
 	i = -(int)strtoul(p, &end, 0);
     } else if (*p == '+') {
 	p++;
@@ -76,7 +160,8 @@ Tcl_GetInt(interp, string, intPtr)
     }
     if (errno == ERANGE) {
         if (interp != (Tcl_Interp *) NULL) {
-            interp->result = "integer value too large to represent";
+	    Tcl_SetResult(interp, "integer value too large to represent",
+		    TCL_STATIC);
             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
                     interp->result, (char *) NULL);
         }
@@ -88,7 +173,7 @@ Tcl_GetInt(interp, string, intPtr)
     if (*end != 0) {
 	goto badInteger;
     }
-    *intPtr = i;
+    *longPtr = i;
     return TCL_OK;
 }
 
@@ -101,7 +186,7 @@ Tcl_GetInt(interp, string, intPtr)
  *	floating-point value.
  *
  * Results:
- *	The return value is normally TCL_OK;  in this case *doublePtr
+ *	The return value is normally TCL_OK; in this case *doublePtr
  *	will be set to the double-precision value equivalent to string.
  *	If string is improperly formed then TCL_ERROR is returned and
  *	an error message will be left in interp->result.
@@ -114,7 +199,7 @@ Tcl_GetInt(interp, string, intPtr)
 
 int
 Tcl_GetDouble(interp, string, doublePtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
     char *string;		/* String containing a floating-point number
 				 * in a form acceptable to strtod. */
     double *doublePtr;		/* Place to store converted result. */
@@ -135,7 +220,18 @@ Tcl_GetDouble(interp, string, doublePtr)
     }
     if (errno != 0) {
         if (interp != (Tcl_Interp *) NULL) {
-            TclExprFloatError(interp, d);
+            TclExprFloatError(interp, d); /* sets interp->objResult */
+
+	    /*
+	     * Move the interpreter's object result to the string result, 
+	     * then reset the object result.
+	     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
+	     */
+
+	    Tcl_SetResult(interp,
+	            TclGetStringFromObj(Tcl_GetObjResult(interp),
+			    (int *) NULL),
+	            TCL_VOLATILE);
         }
 	return TCL_ERROR;
     }
@@ -171,7 +267,7 @@ Tcl_GetDouble(interp, string, doublePtr)
 
 int
 Tcl_GetBoolean(interp, string, boolPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
     char *string;		/* String containing a boolean number
 				 * specified either as 1/0 or true/false or
 				 * yes/no. */
diff --git a/contrib/tcl/generic/tclGetDate.y b/contrib/tcl/generic/tclGetDate.y
index ee3da89..1f4dce5 100644
--- a/contrib/tcl/generic/tclGetDate.y
+++ b/contrib/tcl/generic/tclGetDate.y
@@ -1,16 +1,17 @@
 /* 
  * tclGetDate.y --
  *
- *	Contains yacc grammar for parsing date and time strings
- *	based on getdate.y.
+ *	Contains yacc grammar for parsing date and time strings.
+ *	The output of this file should be the file tclDate.c which
+ *	is used directly in the Tcl sources.
  *
  * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclGetDate.y 1.26 96/07/23 16:09:45
+ * SCCS: @(#) tclGetDate.y 1.34 97/02/03 14:53:54
  */
 
 %{
@@ -18,10 +19,10 @@
  * tclDate.c --
  *
  *	This file is generated from a yacc grammar defined in
- *	the file tclGetDate.y
+ *	the file tclGetDate.y.  It should not be edited directly.
  *
  * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -42,6 +43,15 @@
 #   define END_OF_TIME     2037
 #endif
 
+/*
+ * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
+ * I don't know how universal this is; K&R II, the NetBSD manpages, and
+ * ../compat/strftime.c all agree that tm_year is the year-1900.  However,
+ * some systems may have a different value.  This #define should be the
+ * same as in ../compat/strftime.c.
+ */
+#define TM_YEAR_BASE 1900
+
 #define HOUR(x)         ((int) (60 * x))
 #define SECSPERDAY      (24L * 60L * 60L)
 
@@ -101,44 +111,19 @@ static time_t   yyRelSeconds;
 /*
  * Prototypes of internal functions.
  */
-static void
-yyerror _ANSI_ARGS_((char *s));
-
-static time_t
-ToSeconds _ANSI_ARGS_((time_t      Hours,
-                       time_t      Minutes,
-                       time_t      Seconds,
-                       MERIDIAN    Meridian));
-
-static int
-Convert _ANSI_ARGS_((time_t      Month,
-                     time_t      Day,
-                     time_t      Year,
-                     time_t      Hours,
-                     time_t      Minutes,
-                     time_t      Seconds,
-                     MERIDIAN    Meridia,
-                     DSTMODE     DSTmode,
-                     time_t     *TimePtr));
-
-static time_t
-DSTcorrect _ANSI_ARGS_((time_t      Start,
-                        time_t      Future));
-
-static time_t
-RelativeDate _ANSI_ARGS_((time_t      Start,
-                          time_t      DayOrdinal,
-                          time_t      DayNumber));
-
-static int
-RelativeMonth _ANSI_ARGS_((time_t      Start,
-                           time_t      RelMonth,
-                           time_t     *TimePtr));
-static int
-LookupWord _ANSI_ARGS_((char  *buff));
-
-static int
-yylex _ANSI_ARGS_((void));
+static void	yyerror _ANSI_ARGS_((char *s));
+static time_t	ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes,
+		    time_t Seconds, MERIDIAN Meridian));
+static int	Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year,
+		    time_t Hours, time_t Minutes, time_t Seconds,
+		    MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr));
+static time_t	DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future));
+static time_t	RelativeDate _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
+		    time_t DayNumber));
+static int	RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth,
+		    time_t *TimePtr));
+static int	LookupWord _ANSI_ARGS_((char *buff));
+static int	yylex _ANSI_ARGS_((void));
 
 int
 yyparse _ANSI_ARGS_((void));
@@ -313,24 +298,24 @@ relunit : tUNUMBER tMINUTE_UNIT {
         }
         ;
 
-number  : tUNUMBER {
-            if (yyHaveTime && yyHaveDate && !yyHaveRel)
-                yyYear = $1;
-            else {
-                yyHaveTime++;
-                if ($1 < 100) {
-                    yyHour = $1;
-                    yyMinutes = 0;
-                }
-                else {
-                    yyHour = $1 / 100;
-                    yyMinutes = $1 % 100;
-                }
-                yySeconds = 0;
-                yyMeridian = MER24;
-            }
-        }
-        ;
+number  : tUNUMBER
+    {
+	if (yyHaveTime && yyHaveDate && !yyHaveRel) {
+	    yyYear = $1;
+	} else {
+	    yyHaveTime++;
+	    if ($1 < 100) {
+		yyHour = 0;
+		yyMinutes = $1;
+	    } else {
+		yyHour = $1 / 100;
+		yyMinutes = $1 % 100;
+	    }
+	    yySeconds = 0;
+	    yyMeridian = MER24;
+	}
+    }
+;
 
 o_merid : /* NULL */ {
             $$ = MER24;
@@ -585,14 +570,10 @@ Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
     static int  DaysInMonth[12] = {
         31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
     };
-    time_t      tod;
-    time_t      Julian;
-    int         i;
-
-    if (Year < 0)
-        Year = -Year;
-    if (Year < 100)
-        Year += 1900;
+    time_t tod;
+    time_t Julian;
+    int i;
+
     DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0)
                     ? 29 : 28;
     if (Month < 1 || Month > 12
@@ -655,27 +636,44 @@ RelativeDate(Start, DayOrdinal, DayNumber)
 
 static int
 RelativeMonth(Start, RelMonth, TimePtr)
-    time_t      Start;
-    time_t      RelMonth;
-    time_t     *TimePtr;
+    time_t Start;
+    time_t RelMonth;
+    time_t *TimePtr;
 {
-    struct tm   *tm;
-    time_t      Month;
-    time_t      Year;
-    time_t      Julian;
+    struct tm *tm;
+    time_t Month;
+    time_t Year;
+    time_t Julian;
+    int result;
 
     if (RelMonth == 0) {
         *TimePtr = 0;
         return 0;
     }
     tm = TclpGetDate(&Start, 0);
-    Month = 12 * tm->tm_year + tm->tm_mon + RelMonth;
+    Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
     Year = Month / 12;
     Month = Month % 12 + 1;
-    if (Convert(Month, (time_t)tm->tm_mday, Year,
-                (time_t)tm->tm_hour, (time_t)tm->tm_min, (time_t)tm->tm_sec,
-                MER24, DSTmaybe, &Julian) < 0)
-        return -1;
+    result = Convert(Month, (time_t) tm->tm_mday, Year,
+	    (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
+	    MER24, DSTmaybe, &Julian);
+    /*
+     * The following iteration takes into account the case were we jump
+     * into a "short month".  Far example, "one month from Jan 31" will
+     * fail because there is no Feb 31.  The code below will reduce the
+     * day and try converting the date until we succed or the date equals
+     * 28 (which always works unless the date is bad in another way).
+     */
+
+    while ((result != 0) && (tm->tm_mday > 28)) {
+	tm->tm_mday--;
+	result = Convert(Month, (time_t) tm->tm_mday, Year,
+		(time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
+		MER24, DSTmaybe, &Julian);
+    }
+    if (result != 0) {
+	return -1;
+    }
     *TimePtr = DSTcorrect(Start, Julian);
     return 0;
 }
@@ -685,18 +683,18 @@ static int
 LookupWord(buff)
     char                *buff;
 {
-    register char       *p;
-    register char       *q;
-    register TABLE      *tp;
-    int                 i;
-    int                 abbrev;
+    register char *p;
+    register char *q;
+    register TABLE *tp;
+    int i;
+    int abbrev;
 
     /*
      * Make it lowercase.
      */
     for (p = buff; *p; p++) {
-        if (isupper(*p)) {
-            *p = (char) tolower(*p);
+        if (isupper(UCHAR(*p))) {
+            *p = (char) tolower(UCHAR(*p));
 	}
     }
 
@@ -771,7 +769,7 @@ LookupWord(buff)
     /*
      * Military timezones.
      */
-    if (buff[1] == '\0' && isalpha(*buff)) {
+    if (buff[1] == '\0' && isalpha(UCHAR(*buff))) {
         for (tp = MilitaryTable; tp->name; tp++) {
             if (strcmp(buff, tp->name) == 0) {
                 yylval.Number = tp->value;
@@ -784,19 +782,21 @@ LookupWord(buff)
      * Drop out any periods and try the timezone table again.
      */
     for (i = 0, p = q = buff; *q; q++)
-        if (*q != '.')
+        if (*q != '.') {
             *p++ = *q;
-        else
+        } else {
             i++;
+	}
     *p = '\0';
-    if (i)
+    if (i) {
         for (tp = TimezoneTable; tp->name; tp++) {
             if (strcmp(buff, tp->name) == 0) {
                 yylval.Number = tp->value;
                 return tp->type;
             }
 	}
-
+    }
+    
     return tID;
 }
 
@@ -836,7 +836,7 @@ yylex()
 	    }
             return sign ? tSNUMBER : tUNUMBER;
         }
-        if (isalpha(c)) {
+        if (isalpha(UCHAR(c))) {
             for (p = buff; isalpha(c = *yyInput++) || c == '.'; ) {
                 if (p < &buff[sizeof buff - 1]) {
                     *p++ = c;
@@ -869,19 +869,21 @@ yylex()
 
 int
 TclGetDate(p, now, zone, timePtr)
-    char          *p;
-    unsigned long  now;
-    long           zone;
+    char *p;
+    unsigned long now;
+    long zone;
     unsigned long *timePtr;
 {
-    struct tm           *tm;
-    time_t              Start;
-    time_t              Time;
-    time_t              tod;
+    struct tm *tm;
+    time_t Start;
+    time_t Time;
+    time_t tod;
+    int thisyear;
 
     yyInput = p;
     tm = TclpGetDate((time_t *) &now, 0);
-    yyYear = tm->tm_year;
+    thisyear = tm->tm_year + TM_YEAR_BASE;
+    yyYear = thisyear;
     yyMonth = tm->tm_mon + 1;
     yyDay = tm->tm_mday;
     yyTimezone = zone;
@@ -909,14 +911,35 @@ TclGetDate(p, now, zone, timePtr)
     }
     
     if (yyHaveDate || yyHaveTime || yyHaveDay) {
-        if (Convert(yyMonth, yyDay, yyYear, yyHour, yyMinutes, yySeconds,
-                    yyMeridian, yyDSTmode, &Start) < 0)
+	if (TclDateYear < 0) {
+	    TclDateYear = -TclDateYear;
+	}
+	/*
+	 * The following line handles years that are specified using
+	 * only two digits.  The line of code below implements a policy
+	 * defined by the X/Open workgroup on the millinium rollover.
+	 * Note: some of those dates may not actually be valid on some
+	 * platforms.  The POSIX standard startes that the dates 70-99
+	 * shall refer to 1970-1999 and 00-38 shall refer to 2000-2038.
+	 * This later definition should work on all platforms.
+	 */
+
+	if (TclDateYear < 100) {
+	    if (TclDateYear >= 69) {
+		TclDateYear += 1900;
+	    } else {
+		TclDateYear += 2000;
+	    }
+	}
+	if (Convert(yyMonth, yyDay, yyYear, yyHour, yyMinutes, yySeconds,
+		yyMeridian, yyDSTmode, &Start) < 0) {
             return -1;
-    }
-    else {
+	}
+    } else {
         Start = now;
-        if (!yyHaveRel)
+        if (!yyHaveRel) {
             Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec;
+	}
     }
 
     Start += yyRelSeconds;
diff --git a/contrib/tcl/generic/tclHash.c b/contrib/tcl/generic/tclHash.c
index 41de0b2..e20275a 100644
--- a/contrib/tcl/generic/tclHash.c
+++ b/contrib/tcl/generic/tclHash.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclHash.c 1.15 96/02/15 11:50:23
+ * SCCS: @(#) tclHash.c 1.16 96/04/29 10:30:49
  */
 
 #include "tclInt.h"
@@ -39,23 +39,23 @@
  */
 
 static Tcl_HashEntry *	ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key));
+			    CONST char *key));
 static Tcl_HashEntry *	ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key, int *newPtr));
+			    CONST char *key, int *newPtr));
 static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key));
+			    CONST char *key));
 static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key, int *newPtr));
-static unsigned int	HashString _ANSI_ARGS_((char *string));
+			    CONST char *key, int *newPtr));
+static unsigned int	HashString _ANSI_ARGS_((CONST char *string));
 static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
 static Tcl_HashEntry *	StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key));
+			    CONST char *key));
 static Tcl_HashEntry *	StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key, int *newPtr));
+			    CONST char *key, int *newPtr));
 static Tcl_HashEntry *	OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key));
+			    CONST char *key));
 static Tcl_HashEntry *	OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    char *key, int *newPtr));
+			    CONST char *key, int *newPtr));
 
 /*
  *----------------------------------------------------------------------
@@ -367,7 +367,7 @@ Tcl_HashStats(tablePtr)
 
 static unsigned int
 HashString(string)
-    register char *string;	/* String from which to compute hash value. */
+    register CONST char *string;/* String from which to compute hash value. */
 {
     register unsigned int result;
     register int c;
@@ -421,10 +421,10 @@ HashString(string)
 static Tcl_HashEntry *
 StringFind(tablePtr, key)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    char *key;			/* Key to use to find matching entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
 {
     register Tcl_HashEntry *hPtr;
-    register char *p1, *p2;
+    register CONST char *p1, *p2;
     int index;
 
     index = HashString(key) & tablePtr->mask;
@@ -471,13 +471,13 @@ StringFind(tablePtr, key)
 static Tcl_HashEntry *
 StringCreate(tablePtr, key, newPtr)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    char *key;			/* Key to use to find or create matching
+    CONST char *key;		/* Key to use to find or create matching
 				 * entry. */
     int *newPtr;		/* Store info here telling whether a new
 				 * entry was created. */
 {
     register Tcl_HashEntry *hPtr;
-    register char *p1, *p2;
+    register CONST char *p1, *p2;
     int index;
 
     index = HashString(key) & tablePtr->mask;
@@ -546,7 +546,7 @@ StringCreate(tablePtr, key, newPtr)
 static Tcl_HashEntry *
 OneWordFind(tablePtr, key)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    register char *key;		/* Key to use to find matching entry. */
+    register CONST char *key;	/* Key to use to find matching entry. */
 {
     register Tcl_HashEntry *hPtr;
     int index;
@@ -590,7 +590,7 @@ OneWordFind(tablePtr, key)
 static Tcl_HashEntry *
 OneWordCreate(tablePtr, key, newPtr)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    register char *key;		/* Key to use to find or create matching
+    register CONST char *key;	/* Key to use to find or create matching
 				 * entry. */
     int *newPtr;		/* Store info here telling whether a new
 				 * entry was created. */
@@ -622,7 +622,7 @@ OneWordCreate(tablePtr, key, newPtr)
     hPtr->bucketPtr = &(tablePtr->buckets[index]);
     hPtr->nextPtr = *hPtr->bucketPtr;
     hPtr->clientData = 0;
-    hPtr->key.oneWordValue = key;
+    hPtr->key.oneWordValue = (char *) key;	/* CONST XXXX */
     *hPtr->bucketPtr = hPtr;
     tablePtr->numEntries++;
 
@@ -658,7 +658,7 @@ OneWordCreate(tablePtr, key, newPtr)
 static Tcl_HashEntry *
 ArrayFind(tablePtr, key)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    char *key;			/* Key to use to find matching entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
 {
     register Tcl_HashEntry *hPtr;
     int *arrayPtr = (int *) key;
@@ -714,7 +714,7 @@ ArrayFind(tablePtr, key)
 static Tcl_HashEntry *
 ArrayCreate(tablePtr, key, newPtr)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    register char *key;		/* Key to use to find or create matching
+    register CONST char *key;	/* Key to use to find or create matching
 				 * entry. */
     int *newPtr;		/* Store info here telling whether a new
 				 * entry was created. */
@@ -799,7 +799,7 @@ ArrayCreate(tablePtr, key, newPtr)
 static Tcl_HashEntry *
 BogusFind(tablePtr, key)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    char *key;			/* Key to use to find matching entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
 {
     panic("called Tcl_FindHashEntry on deleted table");
     return NULL;
@@ -827,7 +827,7 @@ BogusFind(tablePtr, key)
 static Tcl_HashEntry *
 BogusCreate(tablePtr, key, newPtr)
     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    char *key;			/* Key to use to find or create matching
+    CONST char *key;		/* Key to use to find or create matching
 				 * entry. */
     int *newPtr;		/* Store info here telling whether a new
 				 * entry was created. */
diff --git a/contrib/tcl/generic/tclHistory.c b/contrib/tcl/generic/tclHistory.c
index c0cfd1f..f6572c7 100644
--- a/contrib/tcl/generic/tclHistory.c
+++ b/contrib/tcl/generic/tclHistory.c
@@ -7,12 +7,12 @@
  *	history substitutions.
  *
  * Copyright (c) 1990-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
  *
- * SCCS: @(#) tclHistory.c 1.40 96/02/15 11:50:24
+ * SCCS: @(#) tclHistory.c 1.43 97/05/14 13:23:18
  */
 
 #include "tclInt.h"
@@ -454,12 +454,15 @@ Tcl_HistoryCmd(dummy, interp, argc, argv)
 	iPtr->numEvents = count;
 	return TCL_OK;
     } else if ((c == 'n') && (strncmp(argv[1], "nextid", length)) == 0) {
+	char buf[40];
+	
 	if (argc != 2) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 		    " nextid\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
-	sprintf(iPtr->result, "%d", iPtr->curEventNum+1);
+	TclFormatInt(buf, iPtr->curEventNum+1);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
 	return TCL_OK;
     } else if ((c == 'r') && (strncmp(argv[1], "redo", length)) == 0) {
 	if (argc > 3) {
@@ -501,8 +504,7 @@ Tcl_HistoryCmd(dummy, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 	RevResult(iPtr, words);
-	iPtr->result = words;
-	iPtr->freeProc = TCL_DYNAMIC;
+	Tcl_SetResult(interp, words, TCL_DYNAMIC);
 	return TCL_OK;
     }
 
@@ -1044,7 +1046,7 @@ GetWords(iPtr, command, words)
     }
     for (index = 0; *next != 0; index++) {
 	start = next;
-	end = TclWordEnd(next, 0, (int *) NULL);
+	end = TclWordEnd(next, next + strlen(next), 0, (int *) NULL);
 	if (*end != 0) {
 	    end++;
 	    for (next = end; isspace(UCHAR(*next)); next++) {
diff --git a/contrib/tcl/generic/tclIO.c b/contrib/tcl/generic/tclIO.c
index f501357..b562b7b 100644
--- a/contrib/tcl/generic/tclIO.c
+++ b/contrib/tcl/generic/tclIO.c
@@ -4,12 +4,12 @@
  *	This file provides the generic portions (those that are the same on
  *	all platforms and for all channel types) of Tcl's IO facilities.
  *
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclIO.c 1.227 96/07/30 09:26:30
+ * SCCS: @(#) tclIO.c 1.265 97/06/20 13:24:48
  */
 
 #include	"tclInt.h"
@@ -34,6 +34,26 @@
 #endif
 
 /*
+ * The following structure encapsulates the state for a background channel
+ * copy.  Note that the data buffer for the copy will be appended to this
+ * structure.
+ */
+
+typedef struct CopyState {
+    struct Channel *readPtr;	/* Pointer to input channel. */
+    struct Channel *writePtr;	/* Pointer to output channel. */
+    int readFlags;		/* Original read channel flags. */
+    int writeFlags;		/* Original write channel flags. */
+    int toRead;			/* Number of bytes to copy, or -1. */
+    int total;			/* Total bytes transferred (written). */
+    Tcl_Interp *interp;		/* Interp that started the copy. */
+    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
+    int bufSize;		/* Size of appended buffer. */
+    char buffer[1];		/* Copy buffer, this must be the last
+				 * field. */
+} CopyState;
+
+/*
  * struct ChannelBuffer:
  *
  * Buffers data being sent to or from a channel.
@@ -74,13 +94,6 @@ typedef struct CloseCallback {
 } CloseCallback;
 
 /*
- * Forward declaration of Channel; being used in struct EventScriptRecord,
- * below.
- */
-
-typedef struct Channel *ChanPtr;
-
-/*
  * The following structure describes the information saved from a call to
  * "fileevent". This is used later when the event being waited for to
  * invoke the saved script in the interpreter designed in this record.
@@ -100,13 +113,6 @@ typedef struct EventScriptRecord {
 } EventScriptRecord;
 
 /*
- * Forward declaration of ChannelHandler; being used in struct Channel,
- * below.
- */
-
-typedef struct ChannelHandler *ChannelHandlerPtr;
-
-/*
  * struct Channel:
  *
  * One of these structures is allocated for each open channel. It contains data
@@ -136,8 +142,6 @@ typedef struct Channel {
                                  * because it happened in the background. The
                                  * value is the POSIX error code. */
     ClientData instanceData;	/* Instance specific data. */
-    Tcl_File inFile;		/* File to use for input, or NULL. */
-    Tcl_File outFile;		/* File to use for output, or NULL. */
     Tcl_ChannelType *typePtr;	/* Pointer to channel type structure. */
     int refCount;		/* How many interpreters hold references to
                                  * this IO channel? */
@@ -163,6 +167,8 @@ typedef struct Channel {
                                  * event handlers ("fileevent") on this
                                  * channel. */
     int bufSize;		/* What size buffers to allocate? */
+    Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */
+    CopyState *csPtr;		/* State of background copy, or NULL. */
 } Channel;
     
 /*
@@ -181,7 +187,7 @@ typedef struct Channel {
 #define BUFFER_READY		(1<<6)	/* Current output buffer (the
 					 * curOutPtr field in the
                                          * channel structure) should be
-                                         * output as soon as possible event
+                                         * output as soon as possible even
                                          * though it may not be full. */
 #define BG_FLUSH_SCHEDULED	(1<<7)	/* A background flush of the
 					 * queued output buffers has been
@@ -189,14 +195,14 @@ typedef struct Channel {
 #define CHANNEL_CLOSED		(1<<8)	/* Channel has been closed. No
 					 * further Tcl-level IO on the
                                          * channel is allowed. */
-#define	CHANNEL_EOF		(1<<9)	/* EOF occurred on this channel.
+#define CHANNEL_EOF		(1<<9)	/* EOF occurred on this channel.
 					 * This bit is cleared before every
                                          * input operation. */
 #define CHANNEL_STICKY_EOF	(1<<10)	/* EOF occurred on this channel because
 					 * we saw the input eofChar. This bit
                                          * prevents clearing of the EOF bit
                                          * before every input operation. */
-#define CHANNEL_BLOCKED		(1<<11)	/* EWOULDBLOCK or EAGAIN occurred
+#define CHANNEL_BLOCKED	(1<<11)	/* EWOULDBLOCK or EAGAIN occurred
 					 * on this channel. This bit is
                                          * cleared before every input or
                                          * output operation. */
@@ -210,6 +216,11 @@ typedef struct Channel {
                                          * channel, it does not call driver
                                          * level functions to avoid referring
                                          * to deallocated data. */
+#define CHANNEL_GETS_BLOCKED	(1<<14)	/* The last input operation was a gets
+					 * that failed to get a comlete line.
+					 * When set, file events will not be
+					 * delivered for buffered data unless
+					 * an EOL is present. */
 
 /*
  * For each channel handler registered in a call to Tcl_CreateChannelHandler,
@@ -271,13 +282,6 @@ static Channel *firstChanPtr = (Channel *) NULL;
 static int channelExitHandlerCreated = 0;
 
 /*
- * Has the channel event source been created and registered with the
- * notifier?
- */
-
-static int channelEventSourceCreated = 0;
-
-/*
  * The following structure describes the event that is added to the Tcl
  * event queue by the channel handler check procedure.
  */
@@ -303,18 +307,12 @@ static int stderrInitialized = 0;
  * Static functions in this file:
  */
 
-static int		ChannelEventDeleteProc _ANSI_ARGS_((
-			    Tcl_Event *evPtr, ClientData clientData));
-static void		ChannelEventSourceExitProc _ANSI_ARGS_((
-    			    ClientData data));
-static int		ChannelHandlerEventProc _ANSI_ARGS_((
-			    Tcl_Event *evPtr, int flags));
-static void		ChannelHandlerCheckProc _ANSI_ARGS_((
-			    ClientData clientData, int flags));
-static void		ChannelHandlerSetupProc _ANSI_ARGS_((
-			    ClientData clientData, int flags));
 static void		ChannelEventScriptInvoker _ANSI_ARGS_((
 			    ClientData clientData, int flags));
+static void		ChannelTimerProc _ANSI_ARGS_((
+			    ClientData clientData));
+static void		CheckForStdChannelsBeingClosed _ANSI_ARGS_((
+			    Tcl_Channel chan));
 static void		CleanupChannelHandlers _ANSI_ARGS_((
 			    Tcl_Interp *interp, Channel *chanPtr));
 static int		CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
@@ -322,6 +320,9 @@ static int		CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
 static void		CloseChannelsOnExit _ANSI_ARGS_((ClientData data));
 static int		CopyAndTranslateBuffer _ANSI_ARGS_((
 			    Channel *chanPtr, char *result, int space));
+static int		CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
+static void		CopyEventProc _ANSI_ARGS_((ClientData clientData,
+			    int mask));
 static void		CreateScriptRecord _ANSI_ARGS_((
 			    Tcl_Interp *interp, Channel *chanPtr,
                             int mask, char *script));
@@ -333,66 +334,74 @@ static void		DiscardInputQueued _ANSI_ARGS_((
 			    Channel *chanPtr, int discardSavedBuffers));
 static void		DiscardOutputQueued _ANSI_ARGS_((
     			    Channel *chanPtr));
+static int		DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
+			    int slen));
+static int		DoWrite _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
+			    int slen));
 static int		FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
                             Channel *chanPtr, int calledFromAsyncFlush));
-static void		FlushEventProc _ANSI_ARGS_((ClientData clientData,
-                            int mask));
 static Tcl_HashTable	*GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
 static int		GetEOL _ANSI_ARGS_((Channel *chanPtr));
 static int		GetInput _ANSI_ARGS_((Channel *chanPtr));
 static void		RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
 		            ChannelBuffer *bufPtr, int mustDiscard));
-static void		ReturnScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
-		            Channel *chanPtr, int mask));
 static int		ScanBufferForEOL _ANSI_ARGS_((Channel *chanPtr,
                             ChannelBuffer *bufPtr,
                             Tcl_EolTranslation translation, int eofChar,
 		            int *bytesToEOLPtr, int *crSeenPtr));
 static int		ScanInputForEOL _ANSI_ARGS_((Channel *chanPtr,
 		            int *bytesQueuedPtr));
+static int		SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
+		            Channel *chanPtr, int mode));
+static void		StopCopy _ANSI_ARGS_((CopyState *csPtr));
+static void		UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
+static int		CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
+							Channel *chan));
 
 /*
  *----------------------------------------------------------------------
  *
- * TclFindChannel --
+ * SetBlockMode --
  *
- *	Finds a channel given two Tcl_Files.
+ *	This function sets the blocking mode for a channel and updates
+ *	the state flags.
  *
  * Results:
- *	The Tcl_Channel found. Also returns nonzero in fileUsedPtr output
- *	parameter if it finds that the Tcl_File is already used in another
- *	channel.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *	Modifies the blocking mode of the channel and possibly generates
+ *	an error.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Channel
-TclFindFileChannel(inFile, outFile, fileUsedPtr)
-    Tcl_File inFile, outFile;		/* Channel has these Tcl_Files. */
-    int *fileUsedPtr;
+static int
+SetBlockMode(interp, chanPtr, mode)
+    Tcl_Interp *interp;		/* Interp for error reporting. */
+    Channel *chanPtr;		/* Channel to modify. */
+    int mode;			/* One of TCL_MODE_BLOCKING or
+				 * TCL_MODE_NONBLOCKING. */
 {
-    Channel *chanPtr;
-    
-    *fileUsedPtr = 0;
-    for (chanPtr = firstChanPtr;
-             chanPtr != (Channel *) NULL;
-             chanPtr = chanPtr->nextChanPtr) {
-        if ((chanPtr->inFile == inFile) && (chanPtr->outFile == outFile)) {
-            return (Tcl_Channel) chanPtr;
-        }
-        if ((inFile != (Tcl_File) NULL) && (chanPtr->inFile == inFile)) {
-            *fileUsedPtr = 1;
-            return (Tcl_Channel) NULL;
-        }
-        if ((outFile != (Tcl_File) NULL) && (chanPtr->outFile == outFile)) {
-            *fileUsedPtr = 1;
-            return (Tcl_Channel) NULL;
-        }
+    int result = 0;
+    if (chanPtr->typePtr->blockModeProc != NULL) {
+	result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
+		mode);
+    }
+    if (result != 0) {
+	Tcl_SetErrno(result);
+	if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_AppendResult(interp, "error setting blocking mode: ",
+		    Tcl_PosixError(interp), (char *) NULL);
+	}
+	return TCL_ERROR;
     }
-    return (Tcl_Channel) NULL;
+    if (mode == TCL_MODE_BLOCKING) {
+	chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
+    } else {
+	chanPtr->flags |= CHANNEL_NONBLOCKING;
+    }
+    return TCL_OK;
 }
 
 /*
@@ -467,22 +476,64 @@ Tcl_GetStdChannel(type)
     switch (type) {
 	case TCL_STDIN:
 	    if (!stdinInitialized) {
-		stdinInitialized = 1;
 		stdinChannel = TclGetDefaultStdChannel(TCL_STDIN);
+		stdinInitialized = 1;
+
+                /*
+                 * Artificially bump the refcount to ensure that the channel
+                 * is only closed on exit.
+                 *
+                 * NOTE: Must only do this if stdinChannel is not NULL. It
+                 * can be NULL in situations where Tcl is unable to connect
+                 * to the standard input.
+                 */
+
+                if (stdinChannel != (Tcl_Channel) NULL) {
+                    (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
+                            stdinChannel);
+                }
 	    }
 	    channel = stdinChannel;
 	    break;
 	case TCL_STDOUT:
 	    if (!stdoutInitialized) {
-		stdoutInitialized = 1;
 		stdoutChannel = TclGetDefaultStdChannel(TCL_STDOUT);
+		stdoutInitialized = 1;
+
+                /*
+                 * Artificially bump the refcount to ensure that the channel
+                 * is only closed on exit.
+                 *
+                 * NOTE: Must only do this if stdoutChannel is not NULL. It
+                 * can be NULL in situations where Tcl is unable to connect
+                 * to the standard output.
+                 */
+
+                if (stdoutChannel != (Tcl_Channel) NULL) {
+                    (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
+                            stdoutChannel);
+                }
 	    }
 	    channel = stdoutChannel;
 	    break;
 	case TCL_STDERR:
 	    if (!stderrInitialized) {
-		stderrInitialized = 1;
 		stderrChannel = TclGetDefaultStdChannel(TCL_STDERR);
+		stderrInitialized = 1;
+
+                /*
+                 * Artificially bump the refcount to ensure that the channel
+                 * is only closed on exit.
+                 *
+                 * NOTE: Must only do this if stderrChannel is not NULL. It
+                 * can be NULL in situations where Tcl is unable to connect
+                 * to the standard error.
+                 */
+
+                if (stderrChannel != (Tcl_Channel) NULL) {
+                    (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
+                            stderrChannel);
+                }
 	    }
 	    channel = stderrChannel;
 	    break;
@@ -568,8 +619,6 @@ Tcl_DeleteCloseHandler(chan, proc, clientData)
         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
             if (cbPrevPtr == (CloseCallback *) NULL) {
                 chanPtr->closeCbPtr = cbPtr->nextPtr;
-            } else {
-                cbPrevPtr = cbPtr->nextPtr;
             }
             ckfree((char *) cbPtr);
             break;
@@ -616,7 +665,19 @@ CloseChannelsOnExit(clientData)
         
         (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
                 "-blocking", "on");
-    
+
+        if ((chanPtr == (Channel *) stdinChannel) ||
+                (chanPtr == (Channel *) stdoutChannel) ||
+                (chanPtr == (Channel *) stderrChannel)) {
+
+            /*
+             * Decrement the refcount which was earlier artificially bumped
+             * up to keep the channel from being closed.
+             */
+
+            chanPtr->refCount--;
+        }
+
         if (chanPtr->refCount <= 0) {
 
 	    /*
@@ -625,7 +686,8 @@ CloseChannelsOnExit(clientData)
              * close the channel when it gets destroyed.
              */
 
-            Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+            (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+
         } else {
 
             /*
@@ -635,11 +697,12 @@ CloseChannelsOnExit(clientData)
             Tcl_Flush((Tcl_Channel) chanPtr);
 
             /*
-             * And close the OS level handles using the driver function:
+             * Call the device driver to actually close the underlying
+             * device for this channel.
              */
-
+            
             (chanPtr->typePtr->closeProc) (chanPtr->instanceData,
-                    (Tcl_Interp *) NULL, chanPtr->inFile, chanPtr->outFile);
+                    (Tcl_Interp *) NULL);
 
             /*
              * Finally, we clean up the fields in the channel data structure
@@ -648,12 +711,24 @@ CloseChannelsOnExit(clientData)
              * on it.
              */
 
-            chanPtr->inFile = (Tcl_File) NULL;
-            chanPtr->outFile = (Tcl_File) NULL;
             chanPtr->instanceData = (ClientData) NULL;
             chanPtr->flags |= CHANNEL_DEAD;
         }
     }
+
+    /*
+     * Reinitialize all the variables to the initial state:
+     */
+    
+    firstChanPtr = (Channel *) NULL;
+    nestedHandlerPtr = (NextChannelHandler *) NULL;
+    channelExitHandlerCreated = 0;
+    stdinChannel = NULL;
+    stdinInitialized = 0;
+    stdoutChannel = NULL;
+    stdoutInitialized = 0;
+    stderrChannel = NULL;
+    stderrInitialized = 0;
 }
 
 /*
@@ -751,7 +826,7 @@ DeleteChannelTable(clientData, interp)
     				/* Variables to loop over all channel events
                                  * registered, to delete the ones that refer
                                  * to the interpreter being deleted. */
-
+    
     /*
      * Delete all the registered channels - this will close channels whose
      * refcount reaches zero.
@@ -783,7 +858,7 @@ DeleteChannelTable(clientData, interp)
                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
                         ChannelEventScriptInvoker, (ClientData) sPtr);
 
-                Tcl_EventuallyFree((ClientData) sPtr->script, TCL_DYNAMIC);
+		ckfree(sPtr->script);
                 ckfree((char *) sPtr);
             } else {
                 prevPtr = sPtr;
@@ -800,9 +875,8 @@ DeleteChannelTable(clientData, interp)
         Tcl_DeleteHashEntry(hPtr);
         chanPtr->refCount--;
         if (chanPtr->refCount <= 0) {
-            chanPtr->flags |= CHANNEL_CLOSED;
             if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
-                Tcl_Close(interp, (Tcl_Channel) chanPtr);
+                (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
             }
         }
     }
@@ -813,9 +887,60 @@ DeleteChannelTable(clientData, interp)
 /*
  *----------------------------------------------------------------------
  *
+ * CheckForStdChannelsBeingClosed --
+ *
+ *	Perform special handling for standard channels being closed. When
+ *	given a standard channel, if the refcount is now 1, it means that
+ *	the last reference to the standard channel is being explicitly
+ *	closed. Now bump the refcount artificially down to 0, to ensure the
+ *	normal handling of channels being closed will occur. Also reset the
+ *	static pointer to the channel to NULL, to avoid dangling references.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Manipulates the refcount on standard channels. May smash the global
+ *	static pointer to a standard channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CheckForStdChannelsBeingClosed(chan)
+    Tcl_Channel chan;
+{
+    Channel *chanPtr = (Channel *) chan;
+    
+    if ((chan == stdinChannel) && (stdinInitialized)) {
+        if (chanPtr->refCount < 2) {
+            chanPtr->refCount = 0;
+            stdinChannel = NULL;
+            return;
+        }
+    } else if ((chan == stdoutChannel) && (stdoutInitialized)) {
+        if (chanPtr->refCount < 2) {
+            chanPtr->refCount = 0;
+            stdoutChannel = NULL;
+            return;
+        }
+    } else if ((chan == stderrChannel) && (stderrInitialized)) {
+        if (chanPtr->refCount < 2) {
+            chanPtr->refCount = 0;
+            stderrChannel = NULL;
+            return;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_UnregisterChannel --
  *
  *	Deletes the hash entry for a channel associated with an interpreter.
+ *	If the interpreter given as argument is NULL, it only decrements the
+ *	reference count.
  *
  * Results:
  *	A standard Tcl result.
@@ -836,29 +961,48 @@ Tcl_UnregisterChannel(interp, chan)
     Channel *chanPtr;		/* The real IO channel. */
 
     chanPtr = (Channel *) chan;
-    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-    if (hTblPtr == (Tcl_HashTable *) NULL) {
-        return TCL_OK;
-    }
-    hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        return TCL_OK;
-    }
-    if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
-        return TCL_OK;
+    
+    if (interp != (Tcl_Interp *) NULL) {
+        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+        if (hTblPtr == (Tcl_HashTable *) NULL) {
+            return TCL_OK;
+        }
+        hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
+        if (hPtr == (Tcl_HashEntry *) NULL) {
+            return TCL_OK;
+        }
+        if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
+            return TCL_OK;
+        }
+        Tcl_DeleteHashEntry(hPtr);
+
+        /*
+         * Remove channel handlers that refer to this interpreter, so that they
+         * will not be present if the actual close is delayed and more events
+         * happen on the channel. This may occur if the channel is shared
+         * between several interpreters, or if the channel has async
+         * flushing active.
+         */
+    
+        CleanupChannelHandlers(interp, chanPtr);
     }
-    Tcl_DeleteHashEntry(hPtr);
+
+    chanPtr->refCount--;
+    
+    /*
+     * Perform special handling for standard channels being closed. If the
+     * refCount is now 1 it means that the last reference to the standard
+     * channel is being explicitly closed, so bump the refCount down
+     * artificially to 0. This will ensure that the channel is actually
+     * closed, below. Also set the static pointer to NULL for the channel.
+     */
+
+    CheckForStdChannelsBeingClosed(chan);
 
     /*
-     * Remove channel handlers that refer to this interpreter, so that they
-     * will not be present if the actual close is delayed and more events
-     * happen on the channel. This may occur if the channel is shared between
-     * several interpreters, or if the channel has async flushing active.
+     * If the refCount reached zero, close the actual channel.
      */
-    
-    CleanupChannelHandlers(interp, chanPtr);
 
-    chanPtr->refCount--;
     if (chanPtr->refCount <= 0) {
 
         /*
@@ -887,6 +1031,8 @@ Tcl_UnregisterChannel(interp, chan)
  * Tcl_RegisterChannel --
  *
  *	Adds an already-open channel to the channel table of an interpreter.
+ *	If the interpreter passed as argument is NULL, it only increments
+ *	the channel refCount.
  *
  * Results:
  *	None.
@@ -913,15 +1059,17 @@ Tcl_RegisterChannel(interp, chan)
     if (chanPtr->channelName == (char *) NULL) {
         panic("Tcl_RegisterChannel: channel without name");
     }
-    hTblPtr = GetChannelTable(interp);
-    hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
-    if (new == 0) {
-        if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
-            return;
+    if (interp != (Tcl_Interp *) NULL) {
+        hTblPtr = GetChannelTable(interp);
+        hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
+        if (new == 0) {
+            if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
+                return;
+            }
+            panic("Tcl_RegisterChannel: duplicate channel names");
         }
-        panic("Tcl_RegisterChannel: duplicate channel names");
+        Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
     }
-    Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
     chanPtr->refCount++;
 }
 
@@ -1018,12 +1166,12 @@ Tcl_GetChannel(interp, chanName, modePtr)
  */
 
 Tcl_Channel
-Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
+Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
     Tcl_ChannelType *typePtr;	/* The channel type record. */
     char *chanName;		/* Name of channel to record. */
-    Tcl_File inFile;		/* File to use for input, or NULL. */
-    Tcl_File outFile;		/* File to use for output, or NULL. */
     ClientData instanceData;	/* Instance specific data. */
+    int mask;			/* TCL_READABLE & TCL_WRITABLE to indicate
+                                 * if the channel is readable, writable. */
 {
     Channel *chanPtr;		/* The channel structure newly created. */
 
@@ -1036,13 +1184,7 @@ Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
         panic("Tcl_CreateChannel: NULL channel name");
     }
 
-    chanPtr->flags = 0;
-    if (inFile != (Tcl_File) NULL) {
-        chanPtr->flags |= TCL_READABLE;
-    }
-    if (outFile != (Tcl_File) NULL) {
-        chanPtr->flags |= TCL_WRITABLE;
-    }
+    chanPtr->flags = mask;
 
     /*
      * Set the channel up initially in AUTO input translation mode to
@@ -1059,8 +1201,6 @@ Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
 
     chanPtr->unreportedError = 0;
     chanPtr->instanceData = instanceData;
-    chanPtr->inFile = inFile;
-    chanPtr->outFile = outFile;
     chanPtr->typePtr = typePtr;
     chanPtr->refCount = 0;
     chanPtr->closeCbPtr = (CloseCallback *) NULL;
@@ -1074,6 +1214,8 @@ Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
     chanPtr->interestMask = 0;
     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+    chanPtr->timer = NULL;
+    chanPtr->csPtr = NULL;
 
     /*
      * Link the channel into the list of all channels; create an on-exit
@@ -1090,23 +1232,54 @@ Tcl_CreateChannel(typePtr, chanName, inFile, outFile, instanceData)
     }
     
     /*
-     * Install this channel in the first empty standard channel slot.
+     * Install this channel in the first empty standard channel slot, if
+     * the channel was previously closed explicitly.
      */
 
-    if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
+    if ((stdinChannel == NULL) && (stdinInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
-    } else if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+    } else if ((stdoutChannel == NULL) && (stdoutInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
-    } else if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+    } else if ((stderrChannel == NULL) && (stderrInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
     } 
-
     return (Tcl_Channel) chanPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_GetChannelMode --
+ *
+ *	Computes a mask indicating whether the channel is open for
+ *	reading and writing.
+ *
+ * Results:
+ *	An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelMode(chan)
+    Tcl_Channel chan;		/* The channel for which the mode is
+                                 * being computed. */
+{
+    Channel *chanPtr;		/* The actual channel. */
+
+    chanPtr = (Channel *) chan;
+    return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetChannelName --
  *
  *	Returns the string identifying the channel name.
@@ -1161,13 +1334,13 @@ Tcl_GetChannelType(chan)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetChannelFile --
+ * Tcl_GetChannelHandle --
  *
- *	Returns a file associated with a channel.
+ *	Returns an OS handle associated with a channel.
  *
  * Results:
- *	The file or NULL if failed (e.g. the channel is not open for the
- *	requested direction).
+ *	Returns TCL_OK and places the handle in handlePtr, or returns
+ *	TCL_ERROR on failure.
  *
  * Side effects:
  *	None.
@@ -1175,22 +1348,23 @@ Tcl_GetChannelType(chan)
  *----------------------------------------------------------------------
  */
 
-Tcl_File
-Tcl_GetChannelFile(chan, direction)
+int
+Tcl_GetChannelHandle(chan, direction, handlePtr)
     Tcl_Channel chan;		/* The channel to get file from. */
     int direction;		/* TCL_WRITABLE or TCL_READABLE. */
+    ClientData *handlePtr;	/* Where to store handle */
 {
     Channel *chanPtr;		/* The actual channel. */
+    ClientData handle;
+    int result;
 
     chanPtr = (Channel *) chan;
-    switch (direction) {
-        case TCL_WRITABLE:
-            return chanPtr->outFile;
-        case TCL_READABLE:
-            return chanPtr->inFile;
-        default:
-            return NULL;
+    result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
+	    direction, &handle);
+    if (handlePtr) {
+	*handlePtr = handle;
     }
+    return result;
 }
 
 /*
@@ -1329,6 +1503,40 @@ DiscardOutputQueued(chanPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * CheckForDeadChannel --
+ *
+ *	This function checks is a given channel is Dead.
+ *      (A channel that has been closed but not yet deallocated.)
+ *
+ * Results:
+ *	True (1) if channel is Dead, False (0) if channel is Ok
+ *
+ * Side effects:
+ *      None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckForDeadChannel(interp, chanPtr)
+    Tcl_Interp *interp;		/* For error reporting (can be NULL) */
+    Channel    *chanPtr;	/* The channel to check. */
+{
+    if (chanPtr->flags & CHANNEL_DEAD) {
+        Tcl_SetErrno(EINVAL);
+	if (interp) {
+	    Tcl_AppendResult(interp,
+			     "unable to access channel: invalid channel",
+			     (char *) NULL);   
+	}
+	return 1;
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * FlushChannel --
  *
  *	This function flushes as much of the queued output as is possible
@@ -1363,7 +1571,6 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
                                          * written in current round. */
     int errorCode;			/* Stores POSIX error codes from
                                          * channel driver operations. */
-
     errorCode = 0;
 
     /*
@@ -1373,10 +1580,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
      * all interpreters.
      */
     
-    if (chanPtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
-        return -1;
-    }
+    if (CheckForDeadChannel(interp,chanPtr)) return -1;
     
     /*
      * Loop over the queued buffers and attempt to flush as
@@ -1431,8 +1635,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
         
         toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
         written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
-                chanPtr->outFile, bufPtr->buf + bufPtr->nextRemoved,
-                toWrite, &errorCode);
+                bufPtr->buf + bufPtr->nextRemoved, toWrite, &errorCode);
             
 	/*
          * If the write failed completely attempt to start the asynchronous
@@ -1452,39 +1655,25 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
             }
 
             /*
-             * If we would have blocked, attempt to set up an asynchronous
-             * background flushing for this channel if the channel is
-             * nonblocking, or block until more output can be written if
-             * the channel is blocking.
+             * If the channel is non-blocking and we would have blocked,
+             * start a background flushing handler and break out of the loop.
              */
 
             if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
-                if (chanPtr->flags & CHANNEL_NONBLOCKING) {
-                    if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
-                        Tcl_CreateFileHandler(chanPtr->outFile,
-                                TCL_WRITABLE, FlushEventProc,
-                                (ClientData) chanPtr);
+		if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+		    if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+			chanPtr->flags |= BG_FLUSH_SCHEDULED;
+			UpdateInterest(chanPtr);
                     }
-                    chanPtr->flags |= BG_FLUSH_SCHEDULED;
                     errorCode = 0;
-                    break;	/* Out of the "while (1)" loop. */
-                } else {
-
-                    /*
-                     * If the device driver did not emulate blocking behavior
-                     * then we must do it it here.
-                     */
-                    
-                    TclWaitForFile(chanPtr->outFile, TCL_WRITABLE, -1);
-                    errorCode = 0;
-                    continue;
+                    break;
+		} else {
+		    panic("Blocking channel driver did not block on output");
                 }
             }
 
             /*
-             * Decide whether to report the error upwards or defer it. If
-             * we got an error during async flush we discard all queued
-             * output.
+             * Decide whether to report the error upwards or defer it.
              */
 
             if (calledFromAsyncFlush) {
@@ -1520,20 +1709,19 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
     }	/* Closes "while (1)". */
     
     /*
-     * If the queue became empty and we have an asynchronous flushing
+     * If the queue became empty and we have the asynchronous flushing
      * mechanism active, cancel the asynchronous flushing.
      */
 
     if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
             (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
         chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
-        if (chanPtr->outFile != (Tcl_File) NULL) {
-            Tcl_DeleteFileHandler(chanPtr->outFile);
-        }
+	(chanPtr->typePtr->watchProc)(chanPtr->instanceData,
+		chanPtr->interestMask);
     }
 
     /*
-     * If the channel is flagged as closed, delete it when the refcount
+     * If the channel is flagged as closed, delete it when the refCount
      * drops to zero, the output queue is empty and there is no output
      * in the current output buffer.
      */
@@ -1576,20 +1764,11 @@ CloseChannel(interp, chanPtr, errorCode)
     Channel *prevChanPtr;		/* Preceding channel in list of
                                          * all channels - used to splice a
                                          * channel out of the list on close. */
-    
         
-    /*
-     * Remove the channel from the standard channel table.
-     */
+    if (chanPtr == NULL) {
+        return result;
+    }
     
-    if (Tcl_GetStdChannel(TCL_STDIN) == (Tcl_Channel) chanPtr) {
-	Tcl_SetStdChannel(NULL, TCL_STDIN);
-    } else if (Tcl_GetStdChannel(TCL_STDOUT) == (Tcl_Channel) chanPtr) {
-	Tcl_SetStdChannel(NULL, TCL_STDOUT);
-    } else if (Tcl_GetStdChannel(TCL_STDERR) == (Tcl_Channel) chanPtr) {
-	Tcl_SetStdChannel(NULL, TCL_STDERR);
-    } 
-
     /*
      * No more input can be consumed so discard any leftover input.
      */
@@ -1619,15 +1798,12 @@ CloseChannel(interp, chanPtr, errorCode)
      * output device.
      */
 
-    if ((chanPtr->outEofChar != 0) && (chanPtr->outFile != NULL)) {
+    if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
         int dummy;
         char c;
 
         c = (char) chanPtr->outEofChar;
-        if (!(chanPtr->flags & CHANNEL_DEAD)) {
-            (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
-                    chanPtr->outFile, &c, 1, &dummy);
-        }
+        (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
     }
 
     /*
@@ -1663,10 +1839,8 @@ CloseChannel(interp, chanPtr, errorCode)
      * OK, close the channel itself.
      */
         
-    if (!(chanPtr->flags & CHANNEL_DEAD)) {
-        result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp,
-                chanPtr->inFile, chanPtr->outFile);
-    }
+    result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp);
+    
     if (chanPtr->channelName != (char *) NULL) {
         ckfree(chanPtr->channelName);
     }
@@ -1686,6 +1860,18 @@ CloseChannel(interp, chanPtr, errorCode)
         }
     }
 
+    /*
+     * Cancel any outstanding timer.
+     */
+
+    Tcl_DeleteTimerHandler(chanPtr->timer);
+
+    /*
+     * Mark the channel as deleted by clearing the type structure.
+     */
+
+    chanPtr->typePtr = NULL;
+
     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
 
     return errorCode;
@@ -1727,11 +1913,39 @@ Tcl_Close(interp, chan)
     EventScriptRecord *ePtr, *eNextPtr;	/* Iterate over eventscript records. */
     Channel *chanPtr;			/* The real IO channel. */
     int result;				/* Of calling FlushChannel. */
+    NextChannelHandler *nhPtr;
 
-    chanPtr = (Channel *) chan;
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_OK;
+    }
+    
+    /*
+     * Perform special handling for standard channels being closed. If the
+     * refCount is now 1 it means that the last reference to the standard
+     * channel is being explicitly closed, so bump the refCount down
+     * artificially to 0. This will ensure that the channel is actually
+     * closed, below. Also set the static pointer to NULL for the channel.
+     */
 
+    CheckForStdChannelsBeingClosed(chan);
+
+    chanPtr = (Channel *) chan;
     if (chanPtr->refCount > 0) {
-        panic("called Tcl_Close on channel with refcount > 0");
+        panic("called Tcl_Close on channel with refCount > 0");
+    }
+
+    /*
+     * Remove any references to channel handlers for this channel that
+     * may be about to be invoked.
+     */
+
+    for (nhPtr = nestedHandlerPtr;
+             nhPtr != (NextChannelHandler *) NULL;
+             nhPtr = nhPtr->nestedHandlerPtr) {
+        if (nhPtr->nextHandlerPtr &&
+		(nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
+	    nhPtr->nextHandlerPtr = NULL;
+        }
     }
 
     /*
@@ -1746,6 +1960,13 @@ Tcl_Close(interp, chan)
         ckfree((char *) chPtr);
     }
     chanPtr->chPtr = (ChannelHandler *) NULL;
+    
+    
+    /*
+     * Cancel any pending copy operation.
+     */
+
+    StopCopy(chanPtr->csPtr);
 
     /*
      * Must set the interest mask now to 0, otherwise infinite loops
@@ -1764,7 +1985,7 @@ Tcl_Close(interp, chan)
              ePtr != (EventScriptRecord *) NULL;
              ePtr = eNextPtr) {
         eNextPtr = ePtr->nextPtr;
-        Tcl_EventuallyFree((ClientData)ePtr->script, TCL_DYNAMIC);
+	ckfree(ePtr->script);
         ckfree((char *) ePtr);
     }
     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
@@ -1781,12 +2002,6 @@ Tcl_Close(interp, chan)
     }
 
     /*
-     * And remove any events for this channel from the event queue.
-     */
-
-    Tcl_DeleteEvents(ChannelEventDeleteProc, (ClientData) chanPtr);
-
-    /*
      * Ensure that the last output buffer will be flushed.
      */
     
@@ -1813,44 +2028,6 @@ Tcl_Close(interp, chan)
 /*
  *----------------------------------------------------------------------
  *
- * ChannelEventDeleteProc --
- *
- *	This procedure returns 1 if the event passed in is for the
- *	channel passed in as the second argument. This procedure is
- *	used as a filter for events to delete in a call to
- *	Tcl_DeleteEvents in CloseChannel.
- *
- * Results:
- *	1 if matching, 0 otherwise.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ChannelEventDeleteProc(evPtr, clientData)
-    Tcl_Event *evPtr;		/* The event to check for a match. */
-    ClientData clientData;	/* The channel to check for. */
-{
-    ChannelHandlerEvent *cEvPtr;
-    Channel *chanPtr;
-
-    if (evPtr->proc != ChannelHandlerEventProc) {
-        return 0;
-    }
-    cEvPtr = (ChannelHandlerEvent *) evPtr;
-    chanPtr = (Channel *) clientData;
-    if (cEvPtr->chanPtr != chanPtr) {
-        return 0;
-    }
-    return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_Write --
  *
  *	Puts a sequence of characters into an output buffer, may queue the
@@ -1877,25 +2054,7 @@ Tcl_Write(chan, srcPtr, slen)
                                          * the output is null terminated
                                          * and we must compute its length. */
 {
-    Channel *chanPtr;			/* The actual channel. */
-    ChannelBuffer *outBufPtr;		/* Current output buffer. */
-    int foundNewline;			/* Did we find a newline in output? */
-    char *dPtr, *sPtr;			/* Search variables for newline. */
-    int crsent;				/* In CRLF eol translation mode,
-                                         * remember the fact that a CR was
-                                         * output to the channel without
-                                         * its following NL. */
-    int i;				/* Loop index for newline search. */
-    int destCopied;			/* How many bytes were used in this
-                                         * destination buffer to hold the
-                                         * output? */
-    int totalDestCopied;		/* How many bytes total were
-                                         * copied to the channel buffer? */
-    int srcCopied;			/* How many bytes were copied from
-                                         * the source string? */
-    char *destPtr;			/* Where in line to copy to? */
-
-    chanPtr = (Channel *) chan;
+    Channel *chanPtr = (Channel *) chan;
 
     /*
      * Check for unreported error.
@@ -1917,6 +2076,15 @@ Tcl_Write(chan, srcPtr, slen)
     }
     
     /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
+    }
+
+    /*
      * If length passed is negative, assume that the output is null terminated
      * and compute its length.
      */
@@ -1924,7 +2092,54 @@ Tcl_Write(chan, srcPtr, slen)
     if (slen < 0) {
         slen = strlen(srcPtr);
     }
-    
+
+    return DoWrite(chanPtr, srcPtr, slen);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoWrite --
+ *
+ *	Puts a sequence of characters into an output buffer, may queue the
+ *	buffer for output if it gets full, and also remembers whether the
+ *	current buffer is ready e.g. if it contains a newline and we are in
+ *	line buffering mode.
+ *
+ * Results:
+ *	The number of bytes written or -1 in case of error. If -1,
+ *	Tcl_GetErrno will return the error code.
+ *
+ * Side effects:
+ *	May buffer up output and may cause output to be produced on the
+ *	channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DoWrite(chanPtr, srcPtr, slen)
+    Channel *chanPtr;			/* The channel to buffer output for. */
+    char *srcPtr;			/* Data to write. */
+    int slen;				/* Number of bytes to write. */
+{
+    ChannelBuffer *outBufPtr;		/* Current output buffer. */
+    int foundNewline;			/* Did we find a newline in output? */
+    char *dPtr, *sPtr;			/* Search variables for newline. */
+    int crsent;				/* In CRLF eol translation mode,
+                                         * remember the fact that a CR was
+                                         * output to the channel without
+                                         * its following NL. */
+    int i;				/* Loop index for newline search. */
+    int destCopied;			/* How many bytes were used in this
+                                         * destination buffer to hold the
+                                         * output? */
+    int totalDestCopied;		/* How many bytes total were
+                                         * copied to the channel buffer? */
+    int srcCopied;			/* How many bytes were copied from
+                                         * the source string? */
+    char *destPtr;			/* Where in line to copy to? */
+
     /*
      * If we are in network (or windows) translation mode, record the fact
      * that we have not yet sent a CR to the channel.
@@ -2087,6 +2302,15 @@ Tcl_Flush(chan)
     }
     
     /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
+    }
+
+    /*
      * Force current output buffer to be output also.
      */
     
@@ -2183,10 +2407,7 @@ GetInput(chanPtr)
      * interpreter.
      */
     
-    if (chanPtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
-        return -1;
-    }
+    if (CheckForDeadChannel(NULL,chanPtr)) return EINVAL;
 
     /*
      * See if we can fill an existing buffer. If we can, read only
@@ -2219,59 +2440,47 @@ GetInput(chanPtr)
         bufPtr->nextPtr = (ChannelBuffer *) NULL;
     }
       
-    while (1) {
-    
-        /*
-         * If EOF is set, we should avoid calling the driver because on some
-         * platforms it is impossible to read from a device after EOF.
-         */
+    /*
+     * If EOF is set, we should avoid calling the driver because on some
+     * platforms it is impossible to read from a device after EOF.
+     */
 
-        if (chanPtr->flags & CHANNEL_EOF) {
-	    break;
-        }
-        nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
-                chanPtr->inFile, bufPtr->buf + bufPtr->nextAdded,
-                toRead, &result);
-        if (nread == 0) {
-            chanPtr->flags |= CHANNEL_EOF;
-            break;
-        } else if (nread < 0) {
-            if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
-                chanPtr->flags |= CHANNEL_BLOCKED;
-                result = EAGAIN;
-                if (chanPtr->flags & CHANNEL_NONBLOCKING) {
-                    Tcl_SetErrno(result);
-                    return result;
-                } else {
+    if (chanPtr->flags & CHANNEL_EOF) {
+	return 0;
+    }
 
-                    /*
-                     * If the device driver did not emulate blocking behavior
-                     * then we have to do it here.
-                     */
-                    
-                    TclWaitForFile(chanPtr->inFile, TCL_READABLE, -1);
-                }
-            } else {
-                Tcl_SetErrno(result);
-                return result;
-            }
-        } else {
-            bufPtr->nextAdded += nread;
+    nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
+	    bufPtr->buf + bufPtr->nextAdded, toRead, &result);
 
-            /*
-             * If we get a short read, signal up that we may be BLOCKED. We
-             * should avoid calling the driver because on some platforms we
-             * will block in the low level reading code even though the
-             * channel is set into nonblocking mode.
-             */
+    if (nread == 0) {
+	chanPtr->flags |= CHANNEL_EOF;
+    } else if (nread < 0) {
+	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+	    chanPtr->flags |= CHANNEL_BLOCKED;
+	    result = EAGAIN;
+	    if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+		Tcl_SetErrno(result);
+	    } else {
+		panic("Blocking channel driver did not block on input");
+	    }
+	} else {
+	    Tcl_SetErrno(result);
+	}
+	return result;
+    } else {
+	bufPtr->nextAdded += nread;
+
+	/*
+	 * If we get a short read, signal up that we may be BLOCKED. We
+	 * should avoid calling the driver because on some platforms we
+	 * will block in the low level reading code even though the
+	 * channel is set into nonblocking mode.
+	 */
             
-            if (nread < toRead) {
-                chanPtr->flags |= CHANNEL_BLOCKED;
-            }
-            break;
-        }
+	if (nread < toRead) {
+	    chanPtr->flags |= CHANNEL_BLOCKED;
+	}
     }
-
     return 0;
 }
 
@@ -2406,9 +2615,10 @@ CopyAndTranslateBuffer(chanPtr, result, space)
                     if (chanPtr->flags & INPUT_SAW_CR) {
                         chanPtr->flags &= (~(INPUT_SAW_CR));
                         result[copied] = '\r';
-                        copied++;
+                        bufPtr->nextRemoved--;
+                    } else {
+                        result[copied] = curByte;
                     }
-                    result[copied] = curByte;
                 }
             }
             break;
@@ -2724,7 +2934,7 @@ ScanInputForEOL(chanPtr, bytesQueuedPtr)
  *	end of line has been seen.
  *
  * Results:
- *	Number of bytes buffered or -1 on failure.
+ *	Number of bytes buffered (at least 1) or -1 on failure.
  *
  * Side effects:
  *	Consumes input from the channel.
@@ -2736,13 +2946,51 @@ static int
 GetEOL(chanPtr)
     Channel *chanPtr;	/* Channel to queue input on. */
 {
-    int result;			/* Of getting another buffer from the
-                                 * channel. */
     int bytesToEOL;		/* How many bytes in buffer up to and
                                  * including the end of line? */
     int bytesQueued;		/* How many bytes are queued currently
                                  * in the input chain of the channel? */
 
+    /*
+     * Check for unreported error.
+     */
+
+    if (chanPtr->unreportedError != 0) {
+        Tcl_SetErrno(chanPtr->unreportedError);
+        chanPtr->unreportedError = 0;
+        return -1;
+    }
+
+    /*
+     * Punt if the channel is not opened for reading.
+     */
+
+    if (!(chanPtr->flags & TCL_READABLE)) {
+        Tcl_SetErrno(EACCES);
+        return -1;
+    }
+
+    /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
+    }
+
+    /*
+     * If we have not encountered a sticky EOF, clear the EOF bit
+     * (sticky EOF is set if we have seen the input eofChar, to prevent
+     * reading beyond the eofChar). Also, always clear the BLOCKED bit.
+     * We want to discover these conditions anew in each operation.
+     */
+    
+    if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
+        chanPtr->flags &= (~(CHANNEL_EOF));
+    }
+    chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
+
     while (1) {
         bytesToEOL = ScanInputForEOL(chanPtr, &bytesQueued);
         if (bytesToEOL > 0) {
@@ -2759,18 +3007,30 @@ GetEOL(chanPtr)
         }
         if (chanPtr->flags & CHANNEL_BLOCKED) {
             if (chanPtr->flags & CHANNEL_NONBLOCKING) {
-                return -1;
+		goto blocked;
             }
             chanPtr->flags &= (~(CHANNEL_BLOCKED));
         }
-        result = GetInput(chanPtr);
-        if (result != 0) {
-            if (result == EAGAIN) {
-                chanPtr->flags |= CHANNEL_BLOCKED;
-            }
-            return -1;
+	if (GetInput(chanPtr) != 0) {
+	    goto blocked;
         }
     }
+
+    blocked:
+
+    /*
+     * We didn't get a complete line so we need to indicate to UpdateInterest
+     * that the gets blocked.  It will wait for more data instead of firing
+     * a timer, avoiding a busy wait.  This is where we are assuming that the
+     * next operation is a gets.  No more file events will be delivered on 
+     * this channel until new data arrives or some operation is performed
+     * on the channel (e.g. gets, read, fconfigure) that changes the blocking
+     * state.  Note that this means a file event will not be delivered even
+     * though a read would be able to consume the buffered data.
+     */
+
+    chanPtr->flags |= CHANNEL_GETS_BLOCKED;
+    return -1;
 }
 
 /*
@@ -2797,11 +3057,6 @@ Tcl_Read(chan, bufPtr, toRead)
     int toRead;			/* Maximum number of characters to read. */
 {
     Channel *chanPtr;		/* The real IO channel. */
-    int copied;			/* How many characters were copied into
-                                 * the result string? */
-    int copiedNow;		/* How many characters were copied from
-                                 * the current input buffer? */
-    int result;			/* Of calling GetInput. */
     
     chanPtr = (Channel *) chan;
 
@@ -2825,6 +3080,47 @@ Tcl_Read(chan, bufPtr, toRead)
     }
     
     /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
+    }
+
+    return DoRead(chanPtr, bufPtr, toRead);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoRead --
+ *
+ *	Reads a given number of characters from a channel.
+ *
+ * Results:
+ *	The number of characters read, or -1 on error. Use Tcl_GetErrno()
+ *	to retrieve the error code for the error that occurred.
+ *
+ * Side effects:
+ *	May cause input to be buffered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DoRead(chanPtr, bufPtr, toRead)
+    Channel *chanPtr;		/* The channel from which to read. */
+    char *bufPtr;		/* Where to store input read. */
+    int toRead;			/* Maximum number of characters to read. */
+{
+    int copied;			/* How many characters were copied into
+                                 * the result string? */
+    int copiedNow;		/* How many characters were copied from
+                                 * the current input buffer? */
+    int result;			/* Of calling GetInput. */
+    
+    /*
      * If we have not encountered a sticky EOF, clear the EOF bit. Either
      * way clear the BLOCKED bit. We want to discover these anew during
      * each operation.
@@ -2833,7 +3129,7 @@ Tcl_Read(chan, bufPtr, toRead)
     if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
         chanPtr->flags &= (~(CHANNEL_EOF));
     }
-    chanPtr->flags &= (~(CHANNEL_BLOCKED));
+    chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
     
     for (copied = 0; copied < toRead; copied += copiedNow) {
         copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
@@ -2866,7 +3162,8 @@ Tcl_Read(chan, bufPtr, toRead)
  *
  * Tcl_Gets --
  *
- *	Reads a complete line of input from the channel.
+ *	Reads a complete line of input from the channel into a
+ *	Tcl_DString.
  *
  * Results:
  *	Length of line read or -1 if error, EOF or blocked. If -1, use
@@ -2905,6 +3202,120 @@ Tcl_Gets(chan, lineRead)
     
     chanPtr = (Channel *) chan;
 
+    lineLen = GetEOL(chanPtr);
+    if (lineLen < 0) {
+        return -1;
+    }
+    offset = Tcl_DStringLength(lineRead);
+    Tcl_DStringSetLength(lineRead, lineLen + offset);
+    buf = Tcl_DStringValue(lineRead) + offset;
+
+    for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
+        copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
+                lineLen - copiedTotal);
+    }
+    if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
+        copiedTotal--;
+    }
+    Tcl_DStringSetLength(lineRead, copiedTotal + offset);
+    return copiedTotal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetsObj --
+ *
+ *	Reads a complete line of input from the channel into a
+ *	string object.
+ *
+ * Results:
+ *	Length of line read or -1 if error, EOF or blocked. If -1, use
+ *	Tcl_GetErrno() to retrieve the POSIX error code for the
+ *	error or condition that occurred.
+ *
+ * Side effects:
+ *	May flush output on the channel. May cause input to be
+ *	consumed from the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetsObj(chan, objPtr)
+    Tcl_Channel chan;		/* Channel from which to read. */
+    Tcl_Obj *objPtr;		/* The characters of the line read
+                                 * (excluding the terminating newline if
+                                 * present) will be appended to this
+                                 * object. The caller must have initialized
+                                 * it and is responsible for managing the
+                                 * storage. */
+{
+    Channel *chanPtr;		/* The channel to read from. */
+    char *buf;			/* Points into DString where data
+                                 * will be stored. */
+    int offset;			/* Offset from start of DString at
+                                 * which to append the line just read. */
+    int copiedTotal;		/* Accumulates total length of input copied. */
+    int copiedNow;		/* How many bytes were copied from the
+                                 * current input buffer? */
+    int lineLen;		/* Length of line read, including the
+                                 * translated newline. If this is zero
+                                 * and neither EOF nor BLOCKED is set,
+                                 * the current line is empty. */
+    
+    chanPtr = (Channel *) chan;
+
+    lineLen = GetEOL(chanPtr);
+    if (lineLen < 0) {
+        return -1;
+    }
+    (void) Tcl_GetStringFromObj(objPtr, &offset);
+    Tcl_SetObjLength(objPtr, lineLen + offset);
+    buf = Tcl_GetStringFromObj(objPtr, NULL) + offset;
+
+    for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
+        copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
+                lineLen - copiedTotal);
+    }
+    if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
+        copiedTotal--;
+    }
+    Tcl_SetObjLength(objPtr, copiedTotal + offset);
+    return copiedTotal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Ungets --
+ *
+ *	Causes the supplied string to be added to the input queue of
+ *	the channel, at either the head or tail of the queue.
+ *
+ * Results:
+ *	The number of bytes stored in the channel, or -1 on error.
+ *
+ * Side effects:
+ *	Adds input to the input queue of a channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Ungets(chan, str, len, atEnd)
+    Tcl_Channel chan;		/* The channel for which to add the input. */
+    char *str;			/* The input itself. */
+    int len;			/* The length of the input. */
+    int atEnd;			/* If non-zero, add at end of queue; otherwise
+                                 * add at head of queue. */    
+{
+    Channel *chanPtr;		/* The real IO channel. */
+    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
+    int i;
+
+    chanPtr = (Channel *) chan;
+
     /*
      * Check for unreported error.
      */
@@ -2925,39 +3336,50 @@ Tcl_Gets(chan, lineRead)
     }
 
     /*
-     * If we have not encountered a sticky EOF, clear the EOF bit
-     * (sticky EOF is set if we have seen the input eofChar, to prevent
-     * reading beyond the eofChar). Also, always clear the BLOCKED bit.
-     * We want to discover these conditions anew in each operation.
+     * If the channel is in the middle of a background copy, fail.
      */
-    
-    if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
-        chanPtr->flags &= (~(CHANNEL_EOF));
-    }
-    chanPtr->flags &= (~(CHANNEL_BLOCKED));
-    lineLen = GetEOL(chanPtr);
-    if (lineLen < 0) {
-        return -1;
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
     }
-    if (lineLen == 0) {
-        if (chanPtr->flags & (CHANNEL_EOF | CHANNEL_BLOCKED)) {
-            return -1;
-        }
-        return 0;
+
+    /*
+     * If we have encountered a sticky EOF, just punt without storing.
+     * (sticky EOF is set if we have seen the input eofChar, to prevent
+     * reading beyond the eofChar). Otherwise, clear the EOF flags, and
+     * clear the BLOCKED bit. We want to discover these conditions anew
+     * in each operation.
+     */
+
+    if (chanPtr->flags & CHANNEL_STICKY_EOF) {
+        return len;
     }
-    offset = Tcl_DStringLength(lineRead);
-    Tcl_DStringSetLength(lineRead, lineLen + offset);
-    buf = Tcl_DStringValue(lineRead) + offset;
+    chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
 
-    for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
-        copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
-                lineLen - copiedTotal);
+    bufPtr = (ChannelBuffer *) ckalloc((unsigned)
+            (CHANNELBUFFER_HEADER_SIZE + len));
+    for (i = 0; i < len; i++) {
+        bufPtr->buf[i] = str[i];
     }
-    if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
-        copiedTotal--;
+    bufPtr->bufSize = len;
+    bufPtr->nextAdded = len;
+    bufPtr->nextRemoved = 0;
+
+    if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+        bufPtr->nextPtr = (ChannelBuffer *) NULL;
+        chanPtr->inQueueHead = bufPtr;
+        chanPtr->inQueueTail = bufPtr;
+    } else if (atEnd) {
+        bufPtr->nextPtr = (ChannelBuffer *) NULL;
+        chanPtr->inQueueTail->nextPtr = bufPtr;
+        chanPtr->inQueueTail = bufPtr;
+    } else {
+        bufPtr->nextPtr = chanPtr->inQueueHead;
+        chanPtr->inQueueHead = bufPtr;
     }
-    Tcl_DStringSetLength(lineRead, copiedTotal + offset);
-    return copiedTotal;
+
+    return len;
 }
 
 /*
@@ -2984,9 +3406,8 @@ Tcl_Seek(chan, offset, mode)
     int offset;			/* Offset to seek to. */
     int mode;			/* Relative to which location to seek? */
 {
-    Channel *chanPtr;	/* The real IO channel. */
-    ChannelBuffer *bufPtr;	/* Iterates over queued input
-                                 * and output buffers. */
+    Channel *chanPtr;		/* The real IO channel. */
+    ChannelBuffer *bufPtr;
     int inputBuffered, outputBuffered;
     int result;			/* Of device driver operations. */
     int curPos;			/* Position on the device. */
@@ -3017,17 +3438,23 @@ Tcl_Seek(chan, offset, mode)
     }
 
     /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
+    }
+
+    /*
      * Disallow seek on dead channels -- channels that have been closed but
      * not yet been deallocated. Such channels can be found if the exit
      * handler for channel cleanup has run but the channel is still
      * registered in an interpreter.
      */
 
-    if (chanPtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
-        return -1;
-    }
-    
+    if (CheckForDeadChannel(NULL,chanPtr)) return -1;
+
     /*
      * Disallow seek on channels whose type does not have a seek procedure
      * defined. This means that the channel does not support seeking.
@@ -3059,6 +3486,7 @@ Tcl_Seek(chan, offset, mode)
         outputBuffered +=
             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
     }
+
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
         Tcl_SetErrno(EFAULT);
         return -1;
@@ -3101,7 +3529,7 @@ Tcl_Seek(chan, offset, mode)
         result = 0;
         if (chanPtr->typePtr->blockModeProc != NULL) {
             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
-                    chanPtr->inFile, chanPtr->outFile, TCL_MODE_BLOCKING);
+                    TCL_MODE_BLOCKING);
         }
         if (result != 0) {
             Tcl_SetErrno(result);
@@ -3109,7 +3537,6 @@ Tcl_Seek(chan, offset, mode)
         }
         chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
-            Tcl_DeleteFileHandler(chanPtr->outFile);
             chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
         }
     }
@@ -3132,8 +3559,7 @@ Tcl_Seek(chan, offset, mode)
          */
 
         curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
-                chanPtr->inFile, chanPtr->outFile, (long) offset,
-                mode, &result);
+                (long) offset, mode, &result);
         if (curPos == -1) {
             Tcl_SetErrno(result);
         }
@@ -3151,7 +3577,7 @@ Tcl_Seek(chan, offset, mode)
         result = 0;
         if (chanPtr->typePtr->blockModeProc != NULL) {
             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
-                    chanPtr->inFile, chanPtr->outFile, TCL_MODE_NONBLOCKING);
+                    TCL_MODE_NONBLOCKING);
         }
         if (result != 0) {
             Tcl_SetErrno(result);
@@ -3185,9 +3611,8 @@ int
 Tcl_Tell(chan)
     Tcl_Channel chan;			/* The channel to return pos for. */
 {
-    Channel *chanPtr;		/* The actual channel to tell on. */
-    ChannelBuffer *bufPtr;		/* Iterates over queued input
-                                         * and output buffers. */
+    Channel *chanPtr;			/* The actual channel to tell on. */
+    ChannelBuffer *bufPtr;
     int inputBuffered, outputBuffered;
     int result;				/* Of calling device driver. */
     int curPos;				/* Position on device. */
@@ -3211,10 +3636,7 @@ Tcl_Tell(chan)
      * registered in an interpreter.
      */
 
-    if (chanPtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
-        return -1;
-    }
+    if (CheckForDeadChannel(NULL,chanPtr)) return -1;
 
     /*
      * Disallow tell on channels that are open for neither
@@ -3227,6 +3649,15 @@ Tcl_Tell(chan)
     }
 
     /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	Tcl_SetErrno(EBUSY);
+	return -1;
+    }
+
+    /*
      * Disallow tell on channels whose type does not have a seek procedure
      * defined. This means that the channel does not support seeking.
      */
@@ -3251,10 +3682,13 @@ Tcl_Tell(chan)
              bufPtr = bufPtr->nextPtr) {
         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
     }
-    if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
+    if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
+           (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
+        chanPtr->flags |= BUFFER_READY;
         outputBuffered +=
             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
     }
+
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
         Tcl_SetErrno(EFAULT);
         return -1;
@@ -3266,7 +3700,7 @@ Tcl_Tell(chan)
      */
 
     curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
-            chanPtr->inFile, chanPtr->outFile, (long) 0, SEEK_CUR, &result);
+            (long) 0, SEEK_CUR, &result);
     if (curPos == -1) {
         Tcl_SetErrno(result);
         return -1;
@@ -3391,16 +3825,16 @@ Tcl_SetChannelBufferSize(chan, sz)
 {
     Channel *chanPtr;
     
-    if (sz < 10) {
-        sz = CHANNELBUFFER_DEFAULT_SIZE;
-    }
-
     /*
-     * Allow only buffers that are smaller than one megabyte.
+     * If the buffer size is smaller than 10 bytes or larger than one MByte,
+     * do not accept the requested size and leave the current buffer size.
      */
     
+    if (sz < 10) {
+        return;
+    }
     if (sz > (1024 * 1024)) {
-        sz = CHANNELBUFFER_DEFAULT_SIZE;
+        return;
     }
 
     chanPtr = (Channel *) chan;
@@ -3437,6 +3871,76 @@ Tcl_GetChannelBufferSize(chan)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_BadChannelOption --
+ *
+ *	This procedure generates a "bad option" error message in an
+ *	(optional) interpreter.  It is used by channel drivers when 
+ *      a invalid Set/Get option is requested. Its purpose is to concatenate
+ *      the generic options list to the specific ones and factorize
+ *      the generic options error message string.
+ *
+ * Results:
+ *	TCL_ERROR.
+ *
+ * Side effects:
+ *	An error message is generated in interp's result object to
+ *	indicate that a command was invoked with the a bad option
+ *	The message has the form
+ *		bad option "blah": should be one of 
+ *              <...generic options...>+<...specific options...>
+ *	"blah" is the optionName argument and "<specific options>"
+ *	is a space separated list of specific option words.
+ *      The function takes good care of inserting minus signs before
+ *      each option, commas after, and an "or" before the last option.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_BadChannelOption(interp, optionName, optionList)
+    Tcl_Interp *interp;			/* Current interpreter. (can be NULL)*/
+    char *optionName;			/* 'bad option' name */
+    char *optionList;			/* Specific options list to append 
+					 * to the standard generic options.
+					 * can be NULL for generic options 
+					 * only.
+					 */
+{
+    if (interp) {
+	CONST char *genericopt = 
+	    	"blocking buffering buffersize eofchar translation";
+	char **argv;
+	int  argc, i;
+	Tcl_DString ds;
+
+	Tcl_DStringInit(&ds);
+	Tcl_DStringAppend(&ds, (char *) genericopt, -1);
+	if (optionList && (*optionList)) {
+	    Tcl_DStringAppend(&ds, " ", 1);
+	    Tcl_DStringAppend(&ds, optionList, -1);
+	}
+	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), 
+	      	  &argc, &argv) != TCL_OK) {
+	    panic("malformed option list in channel driver");
+	}
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "bad option \"", optionName, 
+		 "\": should be one of ", (char *) NULL);
+	argc--;
+	for (i = 0; i < argc; i++) {
+	    Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
+	}
+	Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
+	Tcl_DStringFree(&ds);
+	ckfree((char *) argv);
+    }
+    Tcl_SetErrno(EINVAL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetChannelOption --
  *
  *	Gets a mode associated with an IO channel. If the optionName arg
@@ -3449,23 +3953,36 @@ Tcl_GetChannelBufferSize(chan)
  *	string value of the option(s) returned.
  *
  * Side effects:
- *	The string returned by this function is in static storage and
- *	may be reused at any time subsequent to the call.
+ *      None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetChannelOption(chan, optionName, dsPtr)
+Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
+    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
     Tcl_Channel chan;		/* Channel on which to get option. */
     char *optionName;		/* Option to get. */
     Tcl_DString *dsPtr;		/* Where to store value(s). */
 {
-    Channel *chanPtr;		/* The real IO channel. */
     size_t len;			/* Length of optionName string. */
     char optionVal[128];	/* Buffer for sprintf. */
+    Channel *chanPtr = (Channel *) chan;
+    int flags;
 
-    chanPtr = (Channel *) chan;
+    /*
+     * If we are in the middle of a background copy, use the saved flags.
+     */
+
+    if (chanPtr->csPtr) {
+	if (chanPtr == chanPtr->csPtr->readPtr) {
+	    flags = chanPtr->csPtr->readFlags;
+	} else {
+	    flags = chanPtr->csPtr->writeFlags;
+	}
+    } else {
+	flags = chanPtr->flags;
+    }
 
     /*
      * Disallow options on dead channels -- channels that have been closed but
@@ -3474,10 +3991,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
      * registered in an interpreter.
      */
 
-    if (chanPtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
-        return TCL_ERROR;
-    }
+    if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
 
     /*
      * If the optionName is NULL it means that we want a list of all
@@ -3496,7 +4010,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
             Tcl_DStringAppendElement(dsPtr, "-blocking");
         }
         Tcl_DStringAppendElement(dsPtr,
-                (chanPtr->flags & CHANNEL_NONBLOCKING) ? "0" : "1");
+		(flags & CHANNEL_NONBLOCKING) ? "0" : "1");
         if (len > 0) {
             return TCL_OK;
         }
@@ -3506,9 +4020,9 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
         if (len == 0) {
             Tcl_DStringAppendElement(dsPtr, "-buffering");
         }
-        if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+        if (flags & CHANNEL_LINEBUFFERED) {
             Tcl_DStringAppendElement(dsPtr, "line");
-        } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
+        } else if (flags & CHANNEL_UNBUFFERED) {
             Tcl_DStringAppendElement(dsPtr, "none");
         } else {
             Tcl_DStringAppendElement(dsPtr, "full");
@@ -3522,7 +4036,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
         if (len == 0) {
             Tcl_DStringAppendElement(dsPtr, "-buffersize");
         }
-        sprintf(optionVal, "%d", chanPtr->bufSize);
+        TclFormatInt(optionVal, chanPtr->bufSize);
         Tcl_DStringAppendElement(dsPtr, optionVal);
         if (len > 0) {
             return TCL_OK;
@@ -3534,11 +4048,11 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
         if (len == 0) {
             Tcl_DStringAppendElement(dsPtr, "-eofchar");
         }
-        if (((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
             Tcl_DStringStartSublist(dsPtr);
         }
-        if (chanPtr->flags & TCL_READABLE) {
+        if (flags & TCL_READABLE) {
             if (chanPtr->inEofChar == 0) {
                 Tcl_DStringAppendElement(dsPtr, "");
             } else {
@@ -3548,7 +4062,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
                 Tcl_DStringAppendElement(dsPtr, buf);
             }
         }
-        if (chanPtr->flags & TCL_WRITABLE) {
+        if (flags & TCL_WRITABLE) {
             if (chanPtr->outEofChar == 0) {
                 Tcl_DStringAppendElement(dsPtr, "");
             } else {
@@ -3558,7 +4072,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
                 Tcl_DStringAppendElement(dsPtr, buf);
             }
         }
-        if (((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
             Tcl_DStringEndSublist(dsPtr);
         }
@@ -3572,11 +4086,11 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
         if (len == 0) {
             Tcl_DStringAppendElement(dsPtr, "-translation");
         }
-        if (((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
             Tcl_DStringStartSublist(dsPtr);
         }
-        if (chanPtr->flags & TCL_READABLE) {
+        if (flags & TCL_READABLE) {
             if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
                 Tcl_DStringAppendElement(dsPtr, "auto");
             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
@@ -3587,7 +4101,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
                 Tcl_DStringAppendElement(dsPtr, "lf");
             }
         }
-        if (chanPtr->flags & TCL_WRITABLE) {
+        if (flags & TCL_WRITABLE) {
             if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
                 Tcl_DStringAppendElement(dsPtr, "auto");
             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
@@ -3598,7 +4112,7 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
                 Tcl_DStringAppendElement(dsPtr, "lf");
             }
         }
-        if (((chanPtr->flags & (TCL_READABLE|TCL_WRITABLE)) ==
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
             Tcl_DStringEndSublist(dsPtr);
         }
@@ -3607,14 +4121,23 @@ Tcl_GetChannelOption(chan, optionName, dsPtr)
         }
     }
     if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
+	/*
+	 * let the driver specific handle additional options
+	 * and result code and message.
+	 */
+
         return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
-                optionName, dsPtr);
-    }
-    if (len == 0) {
-        return TCL_OK;
+		  interp, optionName, dsPtr);
+    } else {
+	/*
+	 * no driver specific options case.
+	 */
+
+        if (len == 0) {
+            return TCL_OK;
+        }
+	return Tcl_BadChannelOption(interp, optionName, NULL);
     }
-    Tcl_SetErrno(EINVAL);
-    return TCL_ERROR;
 }
 
 /*
@@ -3641,26 +4164,36 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
     char *optionName;		/* Which option to set? */
     char *newValue;		/* New value for option. */
 {
-    int result;			/* Result of channel type operation. */
     int newMode;		/* New (numeric) mode to sert. */
-    Channel *chanPtr;	/* The real IO channel. */
+    Channel *chanPtr;		/* The real IO channel. */
     size_t len;			/* Length of optionName string. */
     int argc;
     char **argv;
-
+    
     chanPtr = (Channel *) chan;
 
     /*
+     * If the channel is in the middle of a background copy, fail.
+     */
+
+    if (chanPtr->csPtr) {
+	if (interp) {
+	    Tcl_AppendResult(interp,
+	         "unable to set channel options: background copy in progress",
+		 (char *) NULL);
+	}
+        return TCL_ERROR;
+    }
+
+
+    /*
      * Disallow options on dead channels -- channels that have been closed but
      * not yet been deallocated. Such channels can be found if the exit
      * handler for channel cleanup has run but the channel is still
      * registered in an interpreter.
      */
 
-    if (chanPtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
-        return -1;
-    }
+    if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
     
     len = strlen(optionName);
 
@@ -3674,29 +4207,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
         } else {
             newMode = TCL_MODE_NONBLOCKING;
         }
-        result = 0;
-        if (chanPtr->typePtr->blockModeProc != NULL) {
-            result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
-                    chanPtr->inFile, chanPtr->outFile, newMode);
-        }
-        if (result != 0) {
-            Tcl_SetErrno(result);
-            if (interp != (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "error setting blocking mode: ",
-                        Tcl_PosixError(interp), (char *) NULL);
-            }
-            return TCL_ERROR;
-        }
-        if (newMode == TCL_MODE_BLOCKING) {
-            chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
-            if (chanPtr->outFile != (Tcl_File) NULL) {
-                Tcl_DeleteFileHandler(chanPtr->outFile);
-                chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
-            }
-        } else {
-            chanPtr->flags |= CHANNEL_NONBLOCKING;
-        }
-        return TCL_OK;
+	return SetBlockMode(interp, chanPtr, newMode);
     }
 
     if ((len > 7) && (optionName[1] == 'b') &&
@@ -3714,7 +4225,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
             chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
             chanPtr->flags |= CHANNEL_UNBUFFERED;
         } else {
-            if (interp != (Tcl_Interp *) NULL) {
+            if (interp) {
                 Tcl_AppendResult(interp, "bad value for -buffering: ",
                         "must be one of full, line, or none",
                         (char *) NULL);
@@ -3749,7 +4260,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
                 chanPtr->inEofChar = (int) argv[0][0];
             }
         } else if (argc != 2) {
-            if (interp != (Tcl_Interp *) NULL) {
+            if (interp) {
                 Tcl_AppendResult(interp,
                         "bad value for -eofchar: should be a list of one or",
                         " two elements", (char *) NULL);
@@ -3772,171 +4283,116 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 
     if ((len > 1) && (optionName[1] == 't') &&
             (strncmp(optionName, "-translation", len) == 0)) {
+	char *readMode, *writeMode;
+
         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
             return TCL_ERROR;
         }
-        if (argc == 1) {
-            if (chanPtr->flags & TCL_READABLE) {
-                chanPtr->flags &= (~(INPUT_SAW_CR));
-                if (strcmp(argv[0], "auto") == 0) {
-                    chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
-                } else if (strcmp(argv[0], "binary") == 0) {
-                    chanPtr->inEofChar = 0;
-                    chanPtr->inputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[0], "lf") == 0) {
-                    chanPtr->inputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[0], "cr") == 0) {
-                    chanPtr->inputTranslation = TCL_TRANSLATE_CR;
-                } else if (strcmp(argv[0], "crlf") == 0) {
-                    chanPtr->inputTranslation = TCL_TRANSLATE_CRLF;
-                } else if (strcmp(argv[0], "platform") == 0) {
-                    chanPtr->inputTranslation = TCL_PLATFORM_TRANSLATION;
-                } else {
-                    if (interp != (Tcl_Interp *) NULL) {
-                        Tcl_AppendResult(interp,
-                                "bad value for -translation: ",
-                                "must be one of auto, binary, cr, lf, crlf,",
-                                " or platform", (char *) NULL);
-                    }
-                    ckfree((char *) argv);
-                    return TCL_ERROR;
-                }
-            }
-            if (chanPtr->flags & TCL_WRITABLE) {
-                if (strcmp(argv[0], "auto") == 0) {
-                    /*
-                     * This is a hack to get TCP sockets to produce output
-                     * in CRLF mode if they are being set into AUTO mode.
-                     * A better solution for achieving this effect will be
-                     * coded later.
-                     */
 
-                    if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
-                        chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
-                    } else {
-                        chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
-                    }
-                } else if (strcmp(argv[0], "binary") == 0) {
-                    chanPtr->outEofChar = 0;
-                    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[0], "lf") == 0) {
-                    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[0], "cr") == 0) {
-                    chanPtr->outputTranslation = TCL_TRANSLATE_CR;
-                } else if (strcmp(argv[0], "crlf") == 0) {
-                    chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
-                } else if (strcmp(argv[0], "platform") == 0) {
-                    chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
-                } else {
-                    if (interp != (Tcl_Interp *) NULL) {
-                        Tcl_AppendResult(interp,
-                                "bad value for -translation: ",
-                                "must be one of auto, binary, cr, lf, crlf,",
-                                " or platform", (char *) NULL);
-                    }
-                    ckfree((char *) argv);
-                    return TCL_ERROR;
-                }
-            }
-        } else if (argc != 2) {
-            if (interp != (Tcl_Interp *) NULL) {
+        if (argc == 1) {
+	    readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+	} else if (argc == 2) {
+	    readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+	} else {
+            if (interp) {
                 Tcl_AppendResult(interp,
                         "bad value for -translation: must be a one or two",
                         " element list", (char *) NULL);
             }
             ckfree((char *) argv);
             return TCL_ERROR;
-        } else {
-            if (chanPtr->flags & TCL_READABLE) {
-                if (argv[0][0] == '\0') {
-                    /* Empty body. */
-                } else if (strcmp(argv[0], "auto") == 0) {
-                    chanPtr->flags &= (~(INPUT_SAW_CR));
-                    chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
-                } else if (strcmp(argv[0], "binary") == 0) {
-                    chanPtr->inEofChar = 0;
-                    chanPtr->flags &= (~(INPUT_SAW_CR));
-                    chanPtr->inputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[0], "lf") == 0) {
-                    chanPtr->flags &= (~(INPUT_SAW_CR));
-                    chanPtr->inputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[0], "cr") == 0) {
-                    chanPtr->flags &= (~(INPUT_SAW_CR));
-                    chanPtr->inputTranslation = TCL_TRANSLATE_CR;
-                } else if (strcmp(argv[0], "crlf") == 0) {
-                    chanPtr->flags &= (~(INPUT_SAW_CR));
-                    chanPtr->inputTranslation = TCL_TRANSLATE_CRLF;
-                } else if (strcmp(argv[0], "platform") == 0) {
-                    chanPtr->flags &= (~(INPUT_SAW_CR));
-                    chanPtr->inputTranslation = TCL_PLATFORM_TRANSLATION;
-                } else {
-                    if (interp != (Tcl_Interp *) NULL) {
-                        Tcl_AppendResult(interp,
-                                "bad value for -translation: ",
-                                "must be one of auto, binary, cr, lf, crlf,",
-                                " or platform", (char *) NULL);
-                    }
-                    ckfree((char *) argv);
-                    return TCL_ERROR;
-                }
-            }
-            if (chanPtr->flags & TCL_WRITABLE) {
-                if (argv[1][0] == '\0') {
-                    /* Empty body. */
-                } else if (strcmp(argv[1], "auto") == 0) {
-                    /*
-                     * This is a hack to get TCP sockets to produce output
-                     * in CRLF mode if they are being set into AUTO mode.
-                     * A better solution for achieving this effect will be
-                     * coded later.
-                     */
+	}
 
-                    if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
-                        chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
-                    } else {
-                        chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
-                    }
-                } else if (strcmp(argv[1], "binary") == 0) {
-                    chanPtr->outEofChar = 0;
-                    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[1], "lf") == 0) {
-                    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
-                } else if (strcmp(argv[1], "cr") == 0) {
-                    chanPtr->outputTranslation = TCL_TRANSLATE_CR;
-                } else if (strcmp(argv[1], "crlf") == 0) {
-                    chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
-                } else if (strcmp(argv[1], "platform") == 0) {
-                    chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
-                } else {
-                    if (interp != (Tcl_Interp *) NULL) {
-                        Tcl_AppendResult(interp,
-                                "bad value for -translation: ",
-                                "must be one of auto, binary, cr, lf, crlf,",
-                                " or platform", (char *) NULL);
-                    }
-                    ckfree((char *) argv);
-                    return TCL_ERROR;
-                }
-            }
-        }
+	if (readMode) {
+	    if (*readMode == '\0') {
+		newMode = chanPtr->inputTranslation;
+	    } else if (strcmp(readMode, "auto") == 0) {
+		newMode = TCL_TRANSLATE_AUTO;
+	    } else if (strcmp(readMode, "binary") == 0) {
+		chanPtr->inEofChar = 0;
+		newMode = TCL_TRANSLATE_LF;
+	    } else if (strcmp(readMode, "lf") == 0) {
+		newMode = TCL_TRANSLATE_LF;
+	    } else if (strcmp(readMode, "cr") == 0) {
+		newMode = TCL_TRANSLATE_CR;
+	    } else if (strcmp(readMode, "crlf") == 0) {
+		newMode = TCL_TRANSLATE_CRLF;
+	    } else if (strcmp(readMode, "platform") == 0) {
+		newMode = TCL_PLATFORM_TRANSLATION;
+	    } else {
+		if (interp) {
+		    Tcl_AppendResult(interp,
+			    "bad value for -translation: ",
+			    "must be one of auto, binary, cr, lf, crlf,",
+			    " or platform", (char *) NULL);
+		}
+		ckfree((char *) argv);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Reset the EOL flags since we need to look at any buffered
+	     * data to see if the new translation mode allows us to
+	     * complete the line.
+	     */
+
+	    if (newMode != chanPtr->inputTranslation) {
+		chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
+		chanPtr->flags &= ~(INPUT_SAW_CR);
+		chanPtr->flags &= ~(CHANNEL_GETS_BLOCKED);
+		UpdateInterest(chanPtr);
+	    }
+	}
+	if (writeMode) {
+	    if (*writeMode == '\0') {
+		/* Do nothing. */
+	    } else if (strcmp(argv[0], "auto") == 0) {
+		/*
+		 * This is a hack to get TCP sockets to produce output
+		 * in CRLF mode if they are being set into AUTO mode.
+		 * A better solution for achieving this effect will be
+		 * coded later.
+		 */
+
+		if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
+		    chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
+		} else {
+		    chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+		}
+	    } else if (strcmp(writeMode, "binary") == 0) {
+		chanPtr->outEofChar = 0;
+		chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+	    } else if (strcmp(writeMode, "lf") == 0) {
+		chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+	    } else if (strcmp(writeMode, "cr") == 0) {
+		chanPtr->outputTranslation = TCL_TRANSLATE_CR;
+	    } else if (strcmp(writeMode, "crlf") == 0) {
+		chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
+	    } else if (strcmp(writeMode, "platform") == 0) {
+		chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+	    } else {
+		if (interp) {
+		    Tcl_AppendResult(interp,
+			    "bad value for -translation: ",
+			    "must be one of auto, binary, cr, lf, crlf,",
+			    " or platform", (char *) NULL);
+		}
+		ckfree((char *) argv);
+		return TCL_ERROR;
+	    }
+	}
         ckfree((char *) argv);            
         return TCL_OK;
     }
-        
+
     if (chanPtr->typePtr->setOptionProc != (Tcl_DriverSetOptionProc *) NULL) {
         return (chanPtr->typePtr->setOptionProc) (chanPtr->instanceData,
                 interp, optionName, newValue);
     }
     
-    if (interp != (Tcl_Interp *) NULL) {
-        Tcl_AppendResult(interp, "bad option \"", optionName,
-                "\": should be -blocking, -buffering, -buffersize, ",
-                "-eofchar, -translation, ",
-                "or channel type specific option",
-                (char *) NULL);
-    }
-
-    return TCL_ERROR;
+    return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
 }
 
 /*
@@ -3986,7 +4442,7 @@ CleanupChannelHandlers(interp, chanPtr)
             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
                     ChannelEventScriptInvoker, (ClientData) sPtr);
 
-            Tcl_EventuallyFree((ClientData) sPtr->script, TCL_DYNAMIC);
+	    ckfree(sPtr->script);
             ckfree((char *) sPtr);
         } else {
             prevPtr = sPtr;
@@ -3997,319 +4453,179 @@ CleanupChannelHandlers(interp, chanPtr)
 /*
  *----------------------------------------------------------------------
  *
- * ChannelEventSourceExitProc --
+ * Tcl_NotifyChannel --
  *
- *	This procedure is called during exit cleanup to delete the channel
- *	event source. It deletes the event source for channels.
+ *	This procedure is called by a channel driver when a driver
+ *	detects an event on a channel.  This procedure is responsible
+ *	for actually handling the event by invoking any channel
+ *	handler callbacks.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Destroys the channel event source.
+ *	Whatever the channel handler callback procedure does.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static void
-ChannelEventSourceExitProc(clientData)
-    ClientData clientData;		/* Not used. */
+void
+Tcl_NotifyChannel(channel, mask)
+    Tcl_Channel channel;	/* Channel that detected an event. */
+    int mask;			/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which events were detected. */
 {
-    Tcl_DeleteEventSource(ChannelHandlerSetupProc, ChannelHandlerCheckProc,
-            (ClientData) NULL);
-    channelEventSourceCreated = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ChannelHandlerSetupProc --
- *
- *	This procedure is part of the event source for channel handlers.
- *	It is invoked by Tcl_DoOneEvent before it waits for events. The
- *	job of this procedure is to provide information to Tcl_DoOneEvent
- *	on how to wait for events (what files to watch).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Tells the notifier what channels to watch.
- *
- *----------------------------------------------------------------------
- */
+    Channel *chanPtr = (Channel *) channel;
+    ChannelHandler *chPtr;
+    NextChannelHandler nh;
 
-static void
-ChannelHandlerSetupProc(clientData, flags)
-    ClientData clientData;		/* Not used. */
-    int flags;				/* Flags passed to Tk_DoOneEvent:
-					 * if it doesn't include
-					 * TCL_FILE_EVENTS then we do
-					 * nothing. */
-{
-    Tcl_Time dontBlock;
-    Channel *chanPtr, *nextChanPtr;
+    Tcl_Preserve((ClientData)chanPtr);
 
-    if (!(flags & TCL_FILE_EVENTS)) {
-        return;
-    }
+    /*
+     * If we are flushing in the background, be sure to call FlushChannel
+     * for writable events.  Note that we have to discard the writable
+     * event so we don't call any write handlers before the flush is
+     * complete.
+     */
 
-    dontBlock.sec = 0; dontBlock.usec = 0;
-    
-    for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
-             chanPtr = nextChanPtr) {
-        nextChanPtr = chanPtr->nextChanPtr;
-        if (chanPtr->interestMask & TCL_READABLE) {
-            if ((!(chanPtr->flags & CHANNEL_BLOCKED)) &&
-                    (chanPtr->inQueueHead != (ChannelBuffer *) NULL) &&
-                    (chanPtr->inQueueHead->nextRemoved <
-                            chanPtr->inQueueHead->nextAdded)) {
-                Tcl_SetMaxBlockTime(&dontBlock);
-            } else if (chanPtr->inFile != (Tcl_File) NULL) {
-                Tcl_WatchFile(chanPtr->inFile, TCL_READABLE);
-            }
-        }
-        if (chanPtr->interestMask & TCL_WRITABLE) {
-            if (chanPtr->outFile != (Tcl_File) NULL) {
-                Tcl_WatchFile(chanPtr->outFile, TCL_WRITABLE);
-            }
-        }
-        if (chanPtr->interestMask & TCL_EXCEPTION) {
-            if (chanPtr->inFile != (Tcl_File) NULL) {
-                Tcl_WatchFile(chanPtr->inFile, TCL_EXCEPTION);
-            }
-            if (chanPtr->outFile != (Tcl_File) NULL) {
-                Tcl_WatchFile(chanPtr->outFile, TCL_EXCEPTION);
-            }
-        }
+    if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+	FlushChannel(NULL, chanPtr, 1);
+	mask &= ~TCL_WRITABLE;
     }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ChannelHandlerCheckProc --
- *
- *	This procedure is the second part (of three) of the event source
- *	for channels. It is invoked by Tcl_DoOneEvent after the wait for
- *	events is over. The job of this procedure is to test each channel
- *	to see if it is ready now, and if so, to create events and put them
- *	on the Tcl event queue.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Makes entries on the Tcl event queue for each channel that is
- *	ready now.
- *
- *----------------------------------------------------------------------
- */
 
-static void
-ChannelHandlerCheckProc(clientData, flags)
-    ClientData clientData;		/* Not used. */
-    int flags;				/* Flags passed to Tk_DoOneEvent:
-					 * if it doesn't include 
-					 * TCL_FILE_EVENTS then we do
-					 * nothing. */
-{
-    Channel *chanPtr, *nextChanPtr;
-    ChannelHandlerEvent *ePtr;
-    int readyMask;
+    /*
+     * Add this invocation to the list of recursive invocations of
+     * ChannelHandlerEventProc.
+     */
     
-    if (!(flags & TCL_FILE_EVENTS)) {
-        return;
-    }
-
-    for (chanPtr = firstChanPtr;
-             chanPtr != (Channel *) NULL;
-             chanPtr = nextChanPtr) {
-        nextChanPtr = chanPtr->nextChanPtr;
-
-        readyMask = 0;
+    nh.nextHandlerPtr = (ChannelHandler *) NULL;
+    nh.nestedHandlerPtr = nestedHandlerPtr;
+    nestedHandlerPtr = &nh;
+    
+    for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
 
         /*
-         * Check for readability.
+         * If this channel handler is interested in any of the events that
+         * have occurred on the channel, invoke its procedure.
          */
         
-        if (chanPtr->interestMask & TCL_READABLE) {
-
-            /*
-             * The channel is considered ready for reading if there is input
-             * buffered AND the last attempt to read from the channel did not
-             * return EWOULDBLOCK, OR if the underlying file is ready.
-             *
-             * NOTE that the input queue may contain empty buffers, hence the
-             * special check to see if the first input buffer is empty. The
-             * invariant is that if there is an empty buffer in the queue
-             * there is only one buffer in the queue, hence an empty first
-             * buffer indicates that there is no input queued.
-             */
-            
-            if ((!(chanPtr->flags & CHANNEL_BLOCKED)) &&
-                    ((chanPtr->inQueueHead != (ChannelBuffer *) NULL) &&
-                            (chanPtr->inQueueHead->nextRemoved <
-                                    chanPtr->inQueueHead->nextAdded))) {
-                readyMask |= TCL_READABLE;
-            } else if (chanPtr->inFile != (Tcl_File) NULL) {
-                readyMask |=
-                    Tcl_FileReady(chanPtr->inFile, TCL_READABLE);
-            }
-        }
-
-        /*
-         * Check for writability.
-         */
-
-        if (chanPtr->interestMask & TCL_WRITABLE) {
-
-            /*
-             * The channel is considered ready for writing if there is no
-             * output buffered waiting to be written to the device, AND the
-             * underlying file is ready.
-             */
-            
-            if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
-                    (chanPtr->outFile != (Tcl_File) NULL)) {
-                readyMask |=
-                    Tcl_FileReady(chanPtr->outFile, TCL_WRITABLE);
-            }
-        }
+        if ((chPtr->mask & mask) != 0) {
+            nh.nextHandlerPtr = chPtr->nextPtr;
+	    (*(chPtr->proc))(chPtr->clientData, mask);
+            chPtr = nh.nextHandlerPtr;
+        } else {
+            chPtr = chPtr->nextPtr;
+	}
+    }
 
-        /*
-         * Check for exceptions.
-         */
+    /*
+     * Update the notifier interest, since it may have changed after
+     * invoking event handlers.
+     */
 
-        if (chanPtr->interestMask & TCL_EXCEPTION) {
-            if (chanPtr->inFile != (Tcl_File) NULL) {
-                readyMask |=
-                    Tcl_FileReady(chanPtr->inFile, TCL_EXCEPTION);
-            }
-            if (chanPtr->outFile != (Tcl_File) NULL) {
-                readyMask |=
-                    Tcl_FileReady(chanPtr->outFile, TCL_EXCEPTION);
-            }
-        }
-        
-        /*
-         * If there are any events for this channel, put a notice into the
-         * Tcl event queue.
-         */
-        
-        if (readyMask != 0) {
-            ePtr = (ChannelHandlerEvent *) ckalloc((unsigned)
-                    sizeof(ChannelHandlerEvent));
-            ePtr->header.proc = ChannelHandlerEventProc;
-            ePtr->chanPtr = chanPtr;
-            ePtr->readyMask = readyMask;
-            Tcl_QueueEvent((Tcl_Event *) ePtr, TCL_QUEUE_TAIL);
-        }
+    if (chanPtr->typePtr != NULL) {
+	UpdateInterest(chanPtr);
     }
+    Tcl_Release((ClientData)chanPtr);
+
+    nestedHandlerPtr = nh.nestedHandlerPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * FlushEventProc --
+ * UpdateInterest --
  *
- *	This routine dispatches a background flush event.
- *
- *	Errors that occur during the write operation are stored
- *	inside the channel structure for future reporting by the next
- *	operation that uses this channel.
+ *	Arrange for the notifier to call us back at appropriate times
+ *	based on the current state of the channel.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Causes production of output on a channel.
+ *	May schedule a timer or driver handler.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FlushEventProc(clientData, mask)
-    ClientData clientData;		/* Channel to produce output on. */
-    int mask;				/* Not used. */
+UpdateInterest(chanPtr)
+    Channel *chanPtr;		/* Channel to update. */
 {
-    (void) FlushChannel(NULL, (Channel *) clientData, 1);
+    int mask = chanPtr->interestMask;
+
+    /*
+     * If there are flushed buffers waiting to be written, then
+     * we need to watch for the channel to become writable.
+     */
+
+    if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+	mask |= TCL_WRITABLE;
+    }
+
+    /*
+     * If there is data in the input queue, and we aren't blocked waiting for
+     * an EOL, then we need to schedule a timer so we don't block in the
+     * notifier.  Also, cancel the read interest so we don't get duplicate
+     * events.
+     */
+
+    if (mask & TCL_READABLE) {
+	if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
+		&& (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
+		&& (chanPtr->inQueueHead->nextRemoved <
+			chanPtr->inQueueHead->nextAdded)) {
+	    mask &= ~TCL_READABLE;
+	    if (!chanPtr->timer) {
+		chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+			(ClientData) chanPtr);
+	    }
+	}
+    }
+    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ChannelHandlerEventProc --
+ * ChannelTimerProc --
  *
- *	This procedure is called by Tcl_DoOneEvent when a channel event
- *	reaches the front of the event queue. This procedure is responsible
- *	for actually handling the event by invoking the callback for the
- *	channel handler.
+ *	Timer handler scheduled by UpdateInterest to monitor the
+ *	channel buffers until they are empty.
  *
  * Results:
- *	Returns 1 if the event was handled, meaning that it should be
- *	removed from the queue. Returns 0 if the event was not handled
- *	meaning that it should stay in the queue. The only time the event
- *	will not be handled is if the TCL_FILE_EVENTS flag bit is not
- *	set in the flags passed.
- *
- *	NOTE: If the handler is deleted between the time the event is added
- *	to the queue and the time it reaches the head of the queue, the
- *	event is silently discarded (i.e. we return 1).
+ *	None.
  *
  * Side effects:
- *	Whatever the channel handler callback procedure does.
+ *	May invoke channel handlers.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-ChannelHandlerEventProc(evPtr, flags)
-    Tcl_Event *evPtr;		/* Event to service. */
-    int flags;			/* Flags that indicate what events to
-                                 * handle, such as TCL_FILE_EVENTS. */
+static void
+ChannelTimerProc(clientData)
+    ClientData clientData;
 {
-    Channel *chanPtr;
-    ChannelHandler *chPtr;
-    ChannelHandlerEvent *ePtr;
-    NextChannelHandler nh;
-
-    if (!(flags & TCL_FILE_EVENTS)) {
-        return 0;
-    }
-
-    ePtr = (ChannelHandlerEvent *) evPtr;
-    chanPtr = ePtr->chanPtr;
-
-    /*
-     * Add this invocation to the list of recursive invocations of
-     * ChannelHandlerEventProc.
-     */
-    
-    nh.nextHandlerPtr = (ChannelHandler *) NULL;
-    nh.nestedHandlerPtr = nestedHandlerPtr;
-    nestedHandlerPtr = &nh;
-    
-    for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+    Channel *chanPtr = (Channel *) clientData;
 
-        /*
-         * If this channel handler is interested in any of the events that
-         * have occurred on the channel, invoke its procedure.
-         */
-        
-        if ((chPtr->mask & ePtr->readyMask) != 0) {
-            nh.nextHandlerPtr = chPtr->nextPtr;
-	    (*(chPtr->proc))(chPtr->clientData, ePtr->readyMask);
-            chPtr = nh.nextHandlerPtr;
-        } else {
-            chPtr = chPtr->nextPtr;
-	}
+    if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
+	    && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
+	    && (chanPtr->inQueueHead->nextRemoved <
+		    chanPtr->inQueueHead->nextAdded)) {
+	/*
+	 * Restart the timer in case a channel handler reenters the
+	 * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
+	 */
+
+	chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+			(ClientData) chanPtr);
+	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
+ 
+   } else {
+	chanPtr->timer = NULL;
+	UpdateInterest(chanPtr);
     }
-
-    nestedHandlerPtr = nh.nestedHandlerPtr;
-    
-    return 1;
 }
 
 /*
@@ -4352,18 +4668,6 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
     chanPtr = (Channel *) chan;
     
     /*
-     * Ensure that the channel event source is registered with the Tcl
-     * notification mechanism.
-     */
-    
-    if (!channelEventSourceCreated) {
-        channelEventSourceCreated = 1;
-        Tcl_CreateEventSource(ChannelHandlerSetupProc, ChannelHandlerCheckProc,
-                (ClientData) NULL);
-        Tcl_CreateExitHandler(ChannelEventSourceExitProc, (ClientData) NULL);
-    }
-
-    /*
      * Check whether this channel handler is not already registered. If
      * it is not, create a new record, else reuse existing record (smash
      * current values).
@@ -4397,15 +4701,17 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
 
     /*
      * Recompute the interest mask for the channel - this call may actually
-     * be disabling an existing handler..
+     * be disabling an existing handler.
      */
     
     chanPtr->interestMask = 0;
     for (chPtr = chanPtr->chPtr;
-	     chPtr != (ChannelHandler *) NULL;
-	     chPtr = chPtr->nextPtr) {
+	 chPtr != (ChannelHandler *) NULL;
+	 chPtr = chPtr->nextPtr) {
 	chanPtr->interestMask |= chPtr->mask;
-    }                                       
+    }
+
+    UpdateInterest(chanPtr);
 }
 
 /*
@@ -4455,6 +4761,14 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
         }
         prevChPtr = chPtr;
     }
+    
+    /*
+     * If not found, return without doing anything.
+     */
+
+    if (chPtr == (ChannelHandler *) NULL) {
+        return;
+    }
 
     /*
      * If ChannelHandlerEventProc is about to process this handler, tell it to
@@ -4468,15 +4782,11 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
             nhPtr->nextHandlerPtr = chPtr->nextPtr;
         }
     }
-    
+
     /*
-     * If found, splice the entry out of the list.
+     * Splice it out of the list of channel handlers.
      */
-
-    if (chPtr == (ChannelHandler *) NULL) {
-        return;
-    }
-
+    
     if (prevChPtr == (ChannelHandler *) NULL) {
         chanPtr->chPtr = chPtr->nextPtr;
     } else {
@@ -4495,43 +4805,8 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
              chPtr = chPtr->nextPtr) {
         chanPtr->interestMask |= chPtr->mask;
     }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ReturnScriptRecord --
- *
- *	Get a script stored for this channel with this interpreter.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Sets interp->result to the script.
- *
- *----------------------------------------------------------------------
- */
 
-static void
-ReturnScriptRecord(interp, chanPtr, mask)
-    Tcl_Interp *interp;		/* The interpreter in which the script
-                                 * is to be executed. */
-    Channel *chanPtr;		/* The channel for which the script is
-                                 * stored. */
-    int mask;			/* Events in mask must overlap with events
-                                 * for which this script is stored. */
-{
-    EventScriptRecord *esPtr;
-    
-    for (esPtr = chanPtr->scriptRecordPtr;
-             esPtr != (EventScriptRecord *) NULL;
-             esPtr = esPtr->nextPtr) {
-        if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
-            interp->result = esPtr->script;
-            return;
-        }
-    }
+    UpdateInterest(chanPtr);
 }
 
 /*
@@ -4576,7 +4851,7 @@ DeleteScriptRecord(interp, chanPtr, mask)
             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
                     ChannelEventScriptInvoker, (ClientData) esPtr);
             
-            Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
+	    ckfree(esPtr->script);
             ckfree((char *) esPtr);
 
             break;
@@ -4618,7 +4893,7 @@ CreateScriptRecord(interp, chanPtr, mask, script)
              esPtr != (EventScriptRecord *) NULL;
              esPtr = esPtr->nextPtr) {
         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
-            Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
+	    ckfree(esPtr->script);
             esPtr->script = (char *) NULL;
             break;
         }
@@ -4677,16 +4952,13 @@ ChannelEventScriptInvoker(clientData, mask)
     script = esPtr->script;
 
     /*
-     * We must preserve the channel, script and interpreter because each of
-     * these may be deleted in the evaluation. If an error later occurs, we
-     * want to have the relevant data around for error reporting and so we
-     * can safely delete it.
+     * We must preserve the interpreter so we can report errors on it
+     * later.  Note that we do not need to preserve the channel because
+     * that is done by Tcl_NotifyChannel before calling channel handlers.
      */
     
-    Tcl_Preserve((ClientData) chanPtr);
-    Tcl_Preserve((ClientData) script);
     Tcl_Preserve((ClientData) interp);
-    result = Tcl_GlobalEval(esPtr->interp, script);
+    result = Tcl_GlobalEval(interp, script);
 
     /*
      * On error, cause a background error and remove the channel handler
@@ -4700,8 +4972,6 @@ ChannelEventScriptInvoker(clientData, mask)
         DeleteScriptRecord(interp, chanPtr, mask);
         Tcl_BackgroundError(interp);
     }
-    Tcl_Release((ClientData) chanPtr);
-    Tcl_Release((ClientData) script);
     Tcl_Release((ClientData) interp);
 }
 
@@ -4779,7 +5049,15 @@ Tcl_FileEventCmd(clientData, interp, argc, argv)
      */
 
     if (argc == 3) {
-        ReturnScriptRecord(interp, chanPtr, mask);
+	EventScriptRecord *esPtr;
+	for (esPtr = chanPtr->scriptRecordPtr;
+             esPtr != (EventScriptRecord *) NULL;
+             esPtr = esPtr->nextPtr) {
+	    if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
+		Tcl_SetResult(interp, esPtr->script, TCL_STATIC);
+		break;
+	    }
+	}
         return TCL_OK;
     }
 
@@ -4938,7 +5216,7 @@ TclTestChannelCmd(clientData, interp, argc, argv)
                  bufPtr = bufPtr->nextPtr) {
             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
         }
-        sprintf(buf, "%d", IOQueued);
+        TclFormatInt(buf, IOQueued);
         Tcl_AppendElement(interp, buf);
         
         IOQueued = 0;
@@ -4951,13 +5229,13 @@ TclTestChannelCmd(clientData, interp, argc, argv)
                  bufPtr = bufPtr->nextPtr) {
             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
         }
-        sprintf(buf, "%d", IOQueued);
+        TclFormatInt(buf, IOQueued);
         Tcl_AppendElement(interp, buf);
         
-        sprintf(buf, "%d", Tcl_Tell((Tcl_Channel) chanPtr));
+        TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
         Tcl_AppendElement(interp, buf);
 
-        sprintf(buf, "%d", chanPtr->refCount);
+        TclFormatInt(buf, chanPtr->refCount);
         Tcl_AppendElement(interp, buf);
 
         return TCL_OK;
@@ -5237,7 +5515,7 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
         }
         Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
                 ChannelEventScriptInvoker, (ClientData) esPtr);
-        Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
+	ckfree(esPtr->script);
         ckfree((char *) esPtr);
 
         return TCL_OK;
@@ -5271,7 +5549,7 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
             nextEsPtr = esPtr->nextPtr;
             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
                     ChannelEventScriptInvoker, (ClientData) esPtr);
-            Tcl_EventuallyFree((ClientData)esPtr->script, TCL_DYNAMIC);
+	    ckfree(esPtr->script);
             ckfree((char *) esPtr);
         }
         chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
@@ -5283,3 +5561,401 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
     return TCL_ERROR;
 
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCopyChannel --
+ *
+ *	This routine copies data from one channel to another, either
+ *	synchronously or asynchronously.  If a command script is
+ *	supplied, the operation runs in the background.  The script
+ *	is invoked when the copy completes.  Otherwise the function
+ *	waits until the copy is completed before returning.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May schedule a background copy operation that causes both
+ *	channels to be marked busy.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    Tcl_Channel inChan;		/* Channel to read from. */
+    Tcl_Channel outChan;	/* Channel to write to. */
+    int toRead;			/* Amount of data to copy, or -1 for all. */
+    Tcl_Obj *cmdPtr;		/* Pointer to script to execute or NULL. */
+{
+    Channel *inPtr = (Channel *) inChan;
+    Channel *outPtr = (Channel *) outChan;
+    int readFlags, writeFlags;
+    CopyState *csPtr;
+    int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
+
+    if (inPtr->csPtr) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+		Tcl_GetChannelName(inChan), "\" is busy", NULL);
+	return TCL_ERROR;
+    }
+    if (outPtr->csPtr) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+		Tcl_GetChannelName(outChan), "\" is busy", NULL);
+	return TCL_ERROR;
+    }
+
+    readFlags = inPtr->flags;
+    writeFlags = outPtr->flags;
+
+    /*
+     * Set up the blocking mode appropriately.  Background copies need
+     * non-blocking channels.  Foreground copies need blocking channels.
+     * If there is an error, restore the old blocking mode.
+     */
+
+    if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
+	if (SetBlockMode(interp, inPtr,
+		nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
+		!= TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }	    
+    if (inPtr != outPtr) {
+	if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
+	    if (SetBlockMode(NULL, outPtr,
+		    nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
+		    != TCL_OK) {
+		if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
+		    SetBlockMode(NULL, inPtr,
+			    (readFlags & CHANNEL_NONBLOCKING)
+			    ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
+		    return TCL_ERROR;
+		}
+	    }
+	}
+    }
+
+    /*
+     * Make sure the output side is unbuffered.
+     */
+
+    outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
+	| CHANNEL_UNBUFFERED;
+
+    /*
+     * Allocate a new CopyState to maintain info about the current copy in
+     * progress.  This structure will be deallocated when the copy is
+     * completed.
+     */
+
+    csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
+    csPtr->bufSize = inPtr->bufSize;
+    csPtr->readPtr = inPtr;
+    csPtr->writePtr = outPtr;
+    csPtr->readFlags = readFlags;
+    csPtr->writeFlags = writeFlags;
+    csPtr->toRead = toRead;
+    csPtr->total = 0;
+    csPtr->interp = interp;
+    if (cmdPtr) {
+	/*
+	 * We save this command object and mutate it later with
+	 * extra arguments, so we need a private copy.
+	 */
+
+	if (Tcl_IsShared(cmdPtr)) {
+	    cmdPtr = Tcl_DuplicateObj(cmdPtr);
+	}
+	Tcl_IncrRefCount(cmdPtr);
+    }
+    csPtr->cmdPtr = cmdPtr;
+    inPtr->csPtr = csPtr;
+    outPtr->csPtr = csPtr;
+
+    /*
+     * Start copying data between the channels.
+     */
+
+    return CopyData(csPtr, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyData --
+ *
+ *	This function implements the lowest level of the copying
+ *	mechanism for TclCopyChannel.
+ *
+ * Results:
+ *	Returns TCL_OK on success, else TCL_ERROR.
+ *
+ * Side effects:
+ *	Moves data between channels, may create channel handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyData(csPtr, mask)
+    CopyState *csPtr;		/* State of copy operation. */
+    int mask;			/* Current channel event flags. */
+{
+    Tcl_Interp *interp;
+    Tcl_Obj *cmdPtr, *errObj = NULL;
+    Tcl_Channel inChan, outChan;
+    int result = TCL_OK;
+    int size;
+    int total;
+
+    inChan = (Tcl_Channel)csPtr->readPtr;
+    outChan = (Tcl_Channel)csPtr->writePtr;
+    interp = csPtr->interp;
+    cmdPtr = csPtr->cmdPtr;
+
+    /*
+     * Copy the data the slow way, using the translation mechanism.
+     */
+
+    while (csPtr->toRead != 0) {
+
+	/*
+	 * Check for unreported background errors.
+	 */
+
+	if (csPtr->readPtr->unreportedError != 0) {
+	    Tcl_SetErrno(csPtr->readPtr->unreportedError);
+	    csPtr->readPtr->unreportedError = 0;
+	    goto readError;
+	}
+	if (csPtr->writePtr->unreportedError != 0) {
+	    Tcl_SetErrno(csPtr->writePtr->unreportedError);
+	    csPtr->writePtr->unreportedError = 0;
+	    goto writeError;
+	}
+	
+	/*
+	 * Read up to bufSize bytes.
+	 */
+
+	if ((csPtr->toRead == -1)
+		|| (csPtr->toRead > csPtr->bufSize)) {
+	    size = csPtr->bufSize;
+	} else {
+	    size = csPtr->toRead;
+	}
+	size = DoRead(csPtr->readPtr, csPtr->buffer, size);
+
+	if (size < 0) {
+	    readError:
+	    errObj = Tcl_NewObj();
+	    Tcl_AppendStringsToObj(errObj, "error reading \"",
+		    Tcl_GetChannelName(inChan), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+	    break;
+	} else if (size == 0) {
+	    /*
+	     * We had an underflow on the read side.  If we are at EOF,
+	     * then the copying is done, otherwise set up a channel
+	     * handler to detect when the channel becomes readable again.
+	     */
+	    
+	    if (Tcl_Eof(inChan)) {
+		break;
+	    } else if (!(mask & TCL_READABLE)) {
+		if (mask & TCL_WRITABLE) {
+		    Tcl_DeleteChannelHandler(outChan, CopyEventProc,
+			    (ClientData) csPtr);
+		}
+		Tcl_CreateChannelHandler(inChan, TCL_READABLE,
+			CopyEventProc, (ClientData) csPtr);
+	    }
+	    return TCL_OK;
+	}
+
+	/*
+	 * Now write the buffer out.
+	 */
+
+	size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
+	if (size < 0) {
+	    writeError:
+	    errObj = Tcl_NewObj();
+	    Tcl_AppendStringsToObj(errObj, "error writing \"",
+		    Tcl_GetChannelName(outChan), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+	    break;
+	}
+
+	/*
+	 * Check to see if the write is happening in the background.  If so,
+	 * stop copying and wait for the channel to become writable again.
+	 */
+
+	if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
+	    if (!(mask & TCL_WRITABLE)) {
+		if (mask & TCL_READABLE) {
+		    Tcl_DeleteChannelHandler(outChan, CopyEventProc,
+			    (ClientData) csPtr);
+		}
+		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
+			CopyEventProc, (ClientData) csPtr);
+	    }
+	    return TCL_OK;
+	}
+
+	/*
+	 * Update the current byte count if we care.
+	 */
+
+	if (csPtr->toRead != -1) {
+	    csPtr->toRead -= size;
+	}
+	csPtr->total += size;
+
+	/*
+	 * For background copies, we only do one buffer per invocation so
+	 * we don't starve the rest of the system.
+	 */
+
+	if (cmdPtr) {
+	    /*
+	     * The first time we enter this code, there won't be a
+	     * channel handler established yet, so do it here.
+	     */
+
+	    if (mask == 0) {
+		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
+			CopyEventProc, (ClientData) csPtr);
+	    }
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Make the callback or return the number of bytes transferred.
+     * The local total is used because StopCopoy frees csPtr.
+     */
+
+    total = csPtr->total;
+    if (cmdPtr) {
+	Tcl_IncrRefCount(cmdPtr);
+	StopCopy(csPtr);
+	Tcl_Preserve((ClientData) interp);
+
+	/*
+	 * This is already a private object, so we mutate it to add args.
+	 */
+	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
+	if (errObj) {
+	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
+	}
+	if (Tcl_EvalObj(interp, cmdPtr) != TCL_OK) {
+	    Tcl_BackgroundError(interp);
+	    result = TCL_ERROR;
+	}
+	Tcl_DecrRefCount(cmdPtr);
+	Tcl_Release((ClientData) interp);
+    } else {
+	StopCopy(csPtr);
+	if (errObj) {
+	    Tcl_SetObjResult(interp, errObj);
+	    result = TCL_ERROR;
+	} else {
+	    Tcl_ResetResult(interp);
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
+	}
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyEventProc --
+ *
+ *	This routine is invoked as a channel event handler for
+ *	the background copy operation.  It is just a trivial wrapper
+ *	around the CopyData routine.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CopyEventProc(clientData, mask)
+    ClientData clientData;
+    int mask;
+{
+    (void) CopyData((CopyState *)clientData, mask);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StopCopy --
+ *
+ *	This routine halts a copy that is in progress.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes any pending channel handlers and restores the blocking
+ *	and buffering modes of the channels.  The CopyState is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StopCopy(csPtr)
+    CopyState *csPtr;		/* State for bg copy to stop . */
+{
+    int nonBlocking;
+
+    if (!csPtr) {
+	return;
+    }
+
+    /*
+     * Restore the old blocking mode and output buffering mode.
+     */
+
+    nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
+    if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
+	SetBlockMode(NULL, csPtr->readPtr,
+		nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
+    }
+    if (csPtr->writePtr != csPtr->writePtr) {
+	if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
+	    SetBlockMode(NULL, csPtr->writePtr,
+		    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
+	}
+    }
+    csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+    csPtr->writePtr->flags |=
+	csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+	    
+
+    if (csPtr->cmdPtr) {
+	Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
+	    (ClientData)csPtr);
+	if (csPtr->readPtr != csPtr->writePtr) {
+	    Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
+		    CopyEventProc, (ClientData)csPtr);
+	}
+        Tcl_DecrRefCount(csPtr->cmdPtr);
+    }
+    csPtr->readPtr->csPtr = NULL;
+    csPtr->writePtr->csPtr = NULL;
+    ckfree((char*) csPtr);
+}
diff --git a/contrib/tcl/generic/tclIOCmd.c b/contrib/tcl/generic/tclIOCmd.c
index f6c5abd..ae09c8f 100644
--- a/contrib/tcl/generic/tclIOCmd.c
+++ b/contrib/tcl/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclIOCmd.c 1.96 96/05/10 15:20:56
+ * SCCS: @(#) tclIOCmd.c 1.117 97/06/23 18:57:17
  */
 
 #include	"tclInt.h"
@@ -46,7 +46,7 @@ static void	UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_PutsCmd --
+ * Tcl_PutsObjCmd --
  *
  *	This procedure is invoked to process the "puts" Tcl command.
  *	See the user documentation for details on what it does.
@@ -62,11 +62,11 @@ static void	UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
 
 	/* ARGSUSED */
 int
-Tcl_PutsCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_PutsObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Channel chan;			/* The channel to puts on. */
     int i;				/* Counter. */
@@ -74,16 +74,19 @@ Tcl_PutsCmd(clientData, interp, argc, argv)
     char *channelId;			/* Name of channel for puts. */
     int result;				/* Result of puts operation. */
     int mode;				/* Mode in which channel is opened. */
+    char *arg;
+    int length;
+    Tcl_Obj *resultPtr;
 
     i = 1;
     newline = 1;
-    if ((argc >= 2) && (strcmp(argv[1], "-nonewline") == 0)) {
+    if ((objc >= 2) && (strcmp(Tcl_GetStringFromObj(objv[1], NULL),
+	    "-nonewline") == 0)) {
 	newline = 0;
 	i++;
     }
-    if ((i < (argc-3)) || (i >= argc)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" ?-nonewline? ?channelId? string\"", (char *) NULL);
+    if ((i < (objc-3)) || (i >= objc)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
 	return TCL_ERROR;
     }
 
@@ -92,31 +95,37 @@ Tcl_PutsCmd(clientData, interp, argc, argv)
      * form of the command that is no longer recommended or documented.
      */
 
-    if (i == (argc-3)) {
-	if (strncmp(argv[i+2], "nonewline", strlen(argv[i+2])) != 0) {
-	    Tcl_AppendResult(interp, "bad argument \"", argv[i+2],
+    resultPtr = Tcl_NewObj();
+    if (i == (objc-3)) {
+	arg = Tcl_GetStringFromObj(objv[i+2], &length);
+	if (strncmp(arg, "nonewline", (size_t) length) != 0) {
+	    Tcl_AppendStringsToObj(resultPtr, "bad argument \"", arg,
 		    "\": should be \"nonewline\"", (char *) NULL);
+            Tcl_SetObjResult(interp, resultPtr);
 	    return TCL_ERROR;
 	}
 	newline = 0;
     }
-    if (i == (argc-1)) {
+    if (i == (objc-1)) {
 	channelId = "stdout";
     } else {
-	channelId = argv[i];
+	channelId = Tcl_GetStringFromObj(objv[i], NULL);
 	i++;
     }
     chan = Tcl_GetChannel(interp, channelId, &mode);
     if (chan == (Tcl_Channel) NULL) {
+        Tcl_DecrRefCount(resultPtr);
         return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-        Tcl_AppendResult(interp, "channel \"", channelId,
+	Tcl_AppendStringsToObj(resultPtr, "channel \"", channelId,
                 "\" wasn't opened for writing", (char *) NULL);
+        Tcl_SetObjResult(interp, resultPtr);
         return TCL_ERROR;
     }
-    
-    result = Tcl_Write(chan, argv[i], -1);
+
+    arg = Tcl_GetStringFromObj(objv[i], &length);
+    result = Tcl_Write(chan, arg, length);
     if (result < 0) {
         goto error;
     }
@@ -126,17 +135,20 @@ Tcl_PutsCmd(clientData, interp, argc, argv)
             goto error;
         }
     }
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 error:
-    Tcl_AppendResult(interp, "error writing \"", Tcl_GetChannelName(chan),
-	    "\": ", Tcl_PosixError(interp), (char *) NULL);
+    Tcl_AppendStringsToObj(resultPtr, "error writing \"",
+	    Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
+	    (char *) NULL);
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FlushCmd --
+ * Tcl_FlushObjCmd --
  *
  *	This procedure is called to process the Tcl "flush" command.
  *	See the user documentation for details on what it does.
@@ -152,44 +164,47 @@ error:
 
 	/* ARGSUSED */
 int
-Tcl_FlushCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_FlushObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Channel chan;			/* The channel to flush on. */
-    int result;				/* Result of call to channel
-                                         * level function. */
-    int mode;				/* Mode in which channel is opened. */
+    char *arg;
+    Tcl_Obj *resultPtr;
+    int mode;
 
-    if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" channelId\"", (char *) NULL);
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
 	return TCL_ERROR;
     }
-    chan = Tcl_GetChannel(interp, argv[1], &mode);
+    arg = Tcl_GetStringFromObj(objv[1], NULL);
+    chan = Tcl_GetChannel(interp, arg, &mode);
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
+    resultPtr = Tcl_GetObjResult(interp);
     if ((mode & TCL_WRITABLE) == 0) {
-        Tcl_AppendResult(interp, "channel \"", argv[1],
+	Tcl_AppendStringsToObj(resultPtr, "channel \"",
+		Tcl_GetStringFromObj(objv[1], NULL), 
                 "\" wasn't opened for writing", (char *) NULL);
         return TCL_ERROR;
     }
     
-    result = Tcl_Flush(chan);
-    if (result != TCL_OK) {
-        Tcl_AppendResult(interp, "error flushing \"", Tcl_GetChannelName(chan),
-		"\": ", Tcl_PosixError(interp), (char *) NULL);
+    if (Tcl_Flush(chan) != TCL_OK) {
+	Tcl_AppendStringsToObj(resultPtr, "error flushing \"",
+		Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
+		(char *) NULL);
+	return TCL_ERROR;
     }
-    return result;
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetsCmd --
+ * Tcl_GetsObjCmd --
  *
  *	This procedure is called to process the Tcl "gets" command.
  *	See the user documentation for details on what it does.
@@ -205,75 +220,67 @@ Tcl_FlushCmd(clientData, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_GetsCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_GetsObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Channel chan;			/* The channel to read from. */
-    char *varName;			/* Assign to this variable? */
-    char buf[128];			/* Buffer to store string
-                                         * representation of how long
-                                         * a line was read. */
-    Tcl_DString ds;			/* Dynamic string to hold the
-                                         * buffer for the line just read. */
     int lineLen;			/* Length of line just read. */
     int mode;				/* Mode in which channel is opened. */
+    char *arg;
+    Tcl_Obj *resultPtr, *objPtr;
 
-    if ((argc != 2) && (argc != 3)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" channelId ?varName?\"", (char *) NULL);
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
 	return TCL_ERROR;
     }
-    chan = Tcl_GetChannel(interp, argv[1], &mode);
+    arg = Tcl_GetStringFromObj(objv[1], NULL);
+    chan = Tcl_GetChannel(interp, arg, &mode);
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
+    resultPtr = Tcl_NewObj();
     if ((mode & TCL_READABLE) == 0) {
-        Tcl_AppendResult(interp, "channel \"", argv[1],
+	Tcl_AppendStringsToObj(resultPtr, "channel \"", arg,
                 "\" wasn't opened for reading", (char *) NULL);
+        Tcl_SetObjResult(interp, resultPtr);
         return TCL_ERROR;
     }
-    
-    if (argc != 3) {
-        varName = (char *) NULL;
-    } else {
-        varName = argv[2];
-    }
-    Tcl_DStringInit(&ds);
-    lineLen = Tcl_Gets(chan, &ds);
+
+    lineLen = Tcl_GetsObj(chan, resultPtr);
     if (lineLen < 0) {
         if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
-            Tcl_DStringFree(&ds);
-            Tcl_AppendResult(interp, "error reading \"",
+	    Tcl_SetObjLength(resultPtr, 0);
+	    Tcl_AppendStringsToObj(resultPtr, "error reading \"",
 		    Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
 		    (char *) NULL);
+            Tcl_SetObjResult(interp, resultPtr);
             return TCL_ERROR;
         }
         lineLen = -1;
     }
-    if (varName == (char *) NULL) {
-        Tcl_DStringResult(interp, &ds);
-    } else {
-        if (Tcl_SetVar(interp, varName, Tcl_DStringValue(&ds),
-                TCL_LEAVE_ERR_MSG) == NULL) {
-            Tcl_DStringFree(&ds);
+    if (objc == 3) {
+	Tcl_ResetResult(interp);
+	objPtr = Tcl_ObjSetVar2(interp, objv[2], NULL,
+		resultPtr, TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+	if (objPtr == NULL) {
+            Tcl_DecrRefCount(resultPtr);
             return TCL_ERROR;
         }
         Tcl_ResetResult(interp);
-        sprintf(buf, "%d", lineLen);
-        Tcl_AppendResult(interp, buf, (char *) NULL);
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), lineLen);
+        return TCL_OK;
     }
-    Tcl_DStringFree(&ds);
-
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ReadCmd --
+ * Tcl_ReadObjCmd --
  *
  *	This procedure is invoked to process the Tcl "read" command.
  *	See the user documentation for details on what it does.
@@ -289,11 +296,11 @@ Tcl_GetsCmd(clientData, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ReadCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ReadObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Channel chan;			/* The channel to read from. */
     int newline, i;			/* Discard newline at end? */
@@ -304,36 +311,39 @@ Tcl_ReadCmd(clientData, interp, argc, argv)
     int charactersReadNow;		/* How many characters were read
                                          * in this iteration? */
     int mode;				/* Mode in which channel is opened. */
-    Tcl_DString ds;			/* Used to accumulate the data
-                                         * read by Tcl_Read. */
     int bufSize;			/* Channel buffer size; used to decide
                                          * in what chunk sizes to read from
                                          * the channel. */
+    char *arg;
+    Tcl_Obj *resultPtr;
 
-    if ((argc != 2) && (argc != 3)) {
+    if ((objc != 2) && (objc != 3)) {
 argerror:
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" channelId ?numBytes?\" or \"", argv[0],
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numBytes?");
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), " or \"",
+		Tcl_GetStringFromObj(objv[0], NULL),
 		" ?-nonewline? channelId\"", (char *) NULL);
 	return TCL_ERROR;
     }
     i = 1;
     newline = 0;
-    if (strcmp(argv[i], "-nonewline") == 0) {
+    if (strcmp(Tcl_GetStringFromObj(objv[1], NULL), "-nonewline") == 0) {
 	newline = 1;
 	i++;
     }
 
-    if (i == argc) {
+    if (i == objc) {
         goto argerror;
     }
 
-    chan = Tcl_GetChannel(interp, argv[i], &mode);
+    arg =  Tcl_GetStringFromObj(objv[i], NULL);
+    chan = Tcl_GetChannel(interp, arg, &mode);
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-        Tcl_AppendResult(interp, "channel \"", argv[i],
+	resultPtr = Tcl_GetObjResult(interp);
+	Tcl_AppendStringsToObj(resultPtr, "channel \"", arg,
                 "\" wasn't opened for reading", (char *) NULL);
         return TCL_ERROR;
     }
@@ -346,35 +356,68 @@ argerror:
      */
 
     toRead = INT_MAX;
-    if (i < argc) {
-        if (isdigit((unsigned char) (argv[i][0]))) {
-            if (Tcl_GetInt(interp, argv[i], &toRead) != TCL_OK) {
+    if (i < objc) {
+	arg = Tcl_GetStringFromObj(objv[i], NULL);
+	if (isdigit((unsigned char) (arg[0]))) {
+	    if (Tcl_GetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
                 return TCL_ERROR;
-            }
-        } else if (strcmp(argv[i], "nonewline") == 0) {
-            newline = 1;
-        } else {
-            Tcl_AppendResult(interp, "bad argument \"", argv[i],
-                    "\": should be \"nonewline\"", (char *) NULL);
-            return TCL_ERROR;
+	    }
+	    Tcl_ResetResult(interp);
+	} else if (strcmp(arg, "nonewline") == 0) {
+	    newline = 1;
+	} else {
+	    resultPtr = Tcl_GetObjResult(interp);
+	    Tcl_AppendStringsToObj(resultPtr, "bad argument \"", arg,
+		    "\": should be \"nonewline\"", (char *) NULL);
+	    return TCL_ERROR;
         }
     }
 
+    /*
+     * Create a new object and use that instead of the interpreter
+     * result. We cannot use the interpreter's result object because
+     * it may get smashed at any time by recursive calls.
+     */
+    
+    resultPtr = Tcl_NewObj();
+    
     bufSize = Tcl_GetChannelBufferSize(chan);
-    Tcl_DStringInit(&ds);
+
+    /*
+     * If the caller specified a maximum length to read, then that is
+     * a good size to preallocate.
+     */
+    
+    if ((toRead != INT_MAX) && (toRead > bufSize)) {
+        Tcl_SetObjLength(resultPtr, toRead);
+    }
+    
     for (charactersRead = 0; charactersRead < toRead; ) {
         toReadNow = toRead - charactersRead;
         if (toReadNow > bufSize) {
             toReadNow = bufSize;
         }
-        Tcl_DStringSetLength(&ds, charactersRead + toReadNow);
+
+        /*
+         * NOTE: This is a NOOP if we set the size (above) to the
+         * number of bytes we expect to read. In the degenerate
+         * case, however, it will grow the buffer by the channel
+         * buffersize, which is 4K in most cases. This will result
+         * in inefficient copying for large files. This will be
+         * fixed in a future release.
+         */
+        
+	Tcl_SetObjLength(resultPtr, charactersRead + toReadNow);
         charactersReadNow =
-            Tcl_Read(chan, Tcl_DStringValue(&ds) + charactersRead, toReadNow);
+            Tcl_Read(chan, Tcl_GetStringFromObj(resultPtr, NULL)
+		    + charactersRead, toReadNow);
         if (charactersReadNow < 0) {
-            Tcl_DStringFree(&ds);
-            Tcl_AppendResult(interp, "error reading \"",
+	    Tcl_SetObjLength(resultPtr, 0);
+            Tcl_AppendStringsToObj(resultPtr, "error reading \"",
 		    Tcl_GetChannelName(chan), "\": ",
 		    Tcl_PosixError(interp), (char *) NULL);
+            Tcl_SetObjResult(interp, resultPtr);
+
             return TCL_ERROR;
         }
 
@@ -384,131 +427,33 @@ argerror:
          */
         
         charactersRead += charactersReadNow;
+
+        /*
+         * Do not call the driver again if we got a short read
+         */
+        
         if (charactersReadNow < toReadNow) {
             break;	/* Out of "for" loop. */
         }
     }
-
-    /*
-     * Tcl_Read does not put a NULL at the end of the string, so we must
-     * do it here.
-     */
     
-    Tcl_DStringSetLength(&ds, charactersRead);
-    Tcl_DStringResult(interp, &ds);
-    Tcl_DStringFree(&ds);
-
     /*
      * If requested, remove the last newline in the channel if at EOF.
      */
     
     if ((charactersRead > 0) && (newline) &&
-            (interp->result[charactersRead-1] == '\n')) {
-        interp->result[charactersRead-1] = '\0';
+          (Tcl_GetStringFromObj(resultPtr, NULL)[charactersRead-1] == '\n')) {
+	charactersRead--;
     }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclUnsupported0Cmd --
- *
- *	This procedure is invoked to process the Tcl "unsupported0" command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May copy a chunk from one channel to another.
- *
- *----------------------------------------------------------------------
- */
+    Tcl_SetObjLength(resultPtr, charactersRead);
 
-int
-TclUnsupported0Cmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Interpreter in which both channels
-                                         * are defined. */
-    int argc;				/* How many arguments? */
-    char **argv;			/* The argument strings. */
-{
-    Tcl_Channel inChan, outChan;
-    int requested;
-    char *bufPtr;
-    int actuallyRead, actuallyWritten, totalRead, toReadNow, mode;
-    
     /*
-     * Assume we want to copy the entire channel.
+     * Now set the object into the interpreter result and release our
+     * hold on it by decrrefing it.
      */
-    
-    requested = INT_MAX;
-
-    if ((argc < 3) || (argc > 4)) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"",
-                argv[0], " inChanId outChanId ?chunkSize?\"", (char *) NULL);
-        return TCL_ERROR;
-    }
-    inChan = Tcl_GetChannel(interp, argv[1], &mode);
-    if (inChan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
-    }
-    if ((mode & TCL_READABLE) == 0) {
-        Tcl_AppendResult(interp, "channel \"", argv[1],
-                "\" wasn't opened for reading", (char *) NULL);
-        return TCL_ERROR;
-    }
-    outChan = Tcl_GetChannel(interp, argv[2], &mode);
-    if (outChan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
-    }
-    if ((mode & TCL_WRITABLE) == 0) {
-        Tcl_AppendResult(interp, "channel \"", argv[2],
-                "\" wasn't opened for writing", (char *) NULL);
-        return TCL_ERROR;
-    }
-    
-    if (argc == 4) {
-	if (Tcl_GetInt(interp, argv[3], &requested) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-        if (requested < 0) {
-            requested = INT_MAX;
-        }
-    }
 
-    bufPtr = ckalloc((unsigned) TCL_READ_CHUNK_SIZE);
-    for (totalRead = 0;
-            requested > 0;
-            totalRead += actuallyRead, requested -= actuallyRead) {
-        toReadNow = requested;
-        if (toReadNow > TCL_READ_CHUNK_SIZE) {
-            toReadNow = TCL_READ_CHUNK_SIZE;
-        }
-        actuallyRead = Tcl_Read(inChan, bufPtr, toReadNow);
-        if (actuallyRead < 0) {
-            ckfree(bufPtr);
-	    Tcl_AppendResult(interp, argv[0], ": ", Tcl_GetChannelName(inChan),
-		Tcl_PosixError(interp), (char *) NULL);
-            return TCL_ERROR;
-        }
-        if (actuallyRead == 0) {
-            ckfree(bufPtr);
-            sprintf(interp->result, "%d", totalRead);
-            return TCL_OK;
-        }
-        actuallyWritten = Tcl_Write(outChan, bufPtr, actuallyRead);
-        if (actuallyWritten < 0) {
-            ckfree(bufPtr);
-	    Tcl_AppendResult(interp, argv[0], ": ", Tcl_GetChannelName(outChan),
-		Tcl_PosixError(interp), (char *) NULL);
-            return TCL_ERROR;
-        }
-    }
-    ckfree(bufPtr);
+    Tcl_SetObjResult(interp, resultPtr);
     
-    sprintf(interp->result, "%d", totalRead);
     return TCL_OK;
 }
 
@@ -575,7 +520,7 @@ Tcl_SeekCmd(clientData, interp, argc, argv)
     }
 
     result = Tcl_Seek(chan, offset, mode);
-    if (result < 0) {
+    if (result == -1) {
         Tcl_AppendResult(interp, "error during seek on \"", 
 		Tcl_GetChannelName(chan), "\": ",
                 Tcl_PosixError(interp), (char *) NULL);
@@ -610,6 +555,7 @@ Tcl_TellCmd(clientData, interp, argc, argv)
     char **argv;			/* Argument strings. */
 {
     Tcl_Channel chan;			/* The channel to tell on. */
+    char buf[40];
 
     if (argc != 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -625,8 +571,8 @@ Tcl_TellCmd(clientData, interp, argc, argv)
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
-    sprintf(interp->result, "%d", Tcl_Tell(chan));
-
+    TclFormatInt(buf, Tcl_Tell(chan));
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
     return TCL_OK;
 }
 
@@ -716,7 +662,6 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv)
     char **argv;			/* Argument strings. */
 {
     Tcl_Channel chan;			/* The channel to set a mode on. */
-    int result;				/* Of Tcl_Set/GetChannelOption. */
     int i;				/* Iterate over arg-value pairs. */
     Tcl_DString ds;			/* DString to hold result of
                                          * calling Tcl_GetChannelOption. */
@@ -733,33 +678,25 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv)
     }
     if (argc == 2) {
         Tcl_DStringInit(&ds);
-        if (Tcl_GetChannelOption(chan, (char *) NULL, &ds) != TCL_OK) {
-            Tcl_AppendResult(interp, "option retrieval failed",
-                    (char *) NULL);
-            return TCL_ERROR;
+        if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
+	    Tcl_DStringFree(&ds);
+	    return TCL_ERROR;
         }
         Tcl_DStringResult(interp, &ds);
-        Tcl_DStringFree(&ds);
         return TCL_OK;
     }
     if (argc == 3) {
         Tcl_DStringInit(&ds);
-        if (Tcl_GetChannelOption(chan, argv[2], &ds) != TCL_OK) {
+        if (Tcl_GetChannelOption(interp, chan, argv[2], &ds) != TCL_OK) {
             Tcl_DStringFree(&ds);
-            Tcl_AppendResult(interp, "bad option \"", argv[2],
-		    "\": must be -blocking, -buffering, -buffersize, ",
-                    "-eofchar, -translation, ",
-                    "or a channel type specific option", (char *) NULL);
             return TCL_ERROR;
         }
         Tcl_DStringResult(interp, &ds);
-        Tcl_DStringFree(&ds);
         return TCL_OK;
     }
     for (i = 3; i < argc; i += 2) {
-        result = Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]);
-        if (result != TCL_OK) {
-            return result;
+        if (Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]) != TCL_OK) {
+            return TCL_ERROR;
         }
     }
     return TCL_OK;
@@ -793,6 +730,7 @@ Tcl_EofCmd(unused, interp, argc, argv)
 {
     Tcl_Channel chan;			/* The channel to query for EOF. */
     int mode;				/* Mode in which channel is opened. */
+    char buf[40];
 
     if (argc != 2) {
         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -803,7 +741,9 @@ Tcl_EofCmd(unused, interp, argc, argv)
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
-    sprintf(interp->result, "%d", Tcl_Eof(chan) ? 1 : 0);
+
+    TclFormatInt(buf, Tcl_Eof(chan) ? 1 : 0);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
     return TCL_OK;
 }
 
@@ -901,7 +841,7 @@ Tcl_ExecCmd(dummy, interp, argc, argv)
         return TCL_OK;
     }
 
-    if (Tcl_GetChannelFile(chan, TCL_READABLE) != NULL) {
+    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
 #define	EXEC_BUFFER_SIZE 4096
 
         Tcl_DStringInit(&ds);
@@ -925,7 +865,6 @@ Tcl_ExecCmd(dummy, interp, argc, argv)
         }
         Tcl_DStringSetLength(&ds, readSoFar);
         Tcl_DStringResult(interp, &ds);
-        Tcl_DStringFree(&ds);
     }
 
     result = Tcl_Close(interp, chan);
@@ -977,6 +916,7 @@ Tcl_FblockedCmd(unused, interp, argc, argv)
 {
     Tcl_Channel chan;			/* The channel to query for blocked. */
     int mode;				/* Mode in which channel was opened. */
+    char buf[40];
 
     if (argc != 2) {
         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -993,7 +933,8 @@ Tcl_FblockedCmd(unused, interp, argc, argv)
         return TCL_ERROR;
     }
         
-    sprintf(interp->result, "%d", Tcl_InputBlocked(chan) ? 1 : 0);
+    TclFormatInt(buf, Tcl_InputBlocked(chan) ? 1 : 0);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
     return TCL_OK;
 }
 
@@ -1055,6 +996,12 @@ Tcl_OpenCmd(notUsed, interp, argc, argv)
     if (!pipeline) {
         chan = Tcl_OpenFileChannel(interp, argv[1], modeString, prot);
     } else {
+#ifdef MAC_TCL
+	Tcl_AppendResult(interp,
+		"command pipelines not supported on Macintosh OS",
+		(char *)NULL);
+	return TCL_ERROR;
+#else
 	int mode, seekFlag, cmdArgc;
 	char **cmdArgv;
 
@@ -1084,6 +1031,7 @@ Tcl_OpenCmd(notUsed, interp, argc, argv)
 	    chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, flags);
 	}
         ckfree((char *) cmdArgv);
+#endif
     }
     if (chan == (Tcl_Channel) NULL) {
         return TCL_ERROR;
@@ -1280,7 +1228,7 @@ AcceptCallbackProc(callbackData, chan, address, port)
         Tcl_Preserve((ClientData) script);
         Tcl_Preserve((ClientData) interp);
 
-	sprintf(portBuf, "%d", port);
+	TclFormatInt(portBuf, port);
         Tcl_RegisterChannel(interp, chan);
         result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
                 " ", address, " ", portBuf, (char *) NULL);
@@ -1508,3 +1456,90 @@ wrongNumArgs:
     
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FcopyObjCmd --
+ *
+ *	This procedure is invoked to process the "fcopy" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Moves data between two channels and possibly sets up a
+ *	background copy handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_FcopyObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Channel inChan, outChan;
+    char *arg;
+    int mode, i;
+    int toRead;
+    Tcl_Obj *cmdPtr;
+    static char* switches[] = { "-size", "-command", NULL };
+    enum { FcopySize, FcopyCommand } index;
+
+    if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "input output ?-size size? ?-command callback?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse the channel arguments and verify that they are readable
+     * or writable, as appropriate.
+     */
+
+    arg = Tcl_GetStringFromObj(objv[1], NULL);
+    inChan = Tcl_GetChannel(interp, arg, &mode);
+    if (inChan == (Tcl_Channel) NULL) {
+	return TCL_ERROR;
+    }
+    if ((mode & TCL_READABLE) == 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+		Tcl_GetStringFromObj(objv[1], NULL), 
+                "\" wasn't opened for reading", (char *) NULL);
+        return TCL_ERROR;
+    }
+    arg = Tcl_GetStringFromObj(objv[2], NULL);
+    outChan = Tcl_GetChannel(interp, arg, &mode);
+    if (outChan == (Tcl_Channel) NULL) {
+	return TCL_ERROR;
+    }
+    if ((mode & TCL_WRITABLE) == 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+		Tcl_GetStringFromObj(objv[1], NULL), 
+                "\" wasn't opened for writing", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    toRead = -1;
+    cmdPtr = NULL;
+    for (i = 3; i < objc; i += 2) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
+		(int *) &index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (index) {
+	    case FcopySize:
+		if (Tcl_GetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		break;
+	    case FcopyCommand:
+		cmdPtr = objv[i+1];
+		break;
+	}
+    }
+    return TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr);
+}
diff --git a/contrib/tcl/generic/tclIOSock.c b/contrib/tcl/generic/tclIOSock.c
index 8285037..2d67764 100644
--- a/contrib/tcl/generic/tclIOSock.c
+++ b/contrib/tcl/generic/tclIOSock.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclIOSock.c 1.16 96/03/12 07:04:33
+ * SCCS: @(#) tclIOSock.c 1.20 97/04/25 16:36:40
  */
 
 #include "tclInt.h"
@@ -41,10 +41,15 @@ TclSockGetPort(interp, string, proto, portPtr)
     char *proto;		/* "tcp" or "udp", typically */
     int *portPtr;		/* Return port number */
 {
-    struct servent *sp = getservbyname(string, proto);    
-    if (sp != NULL) {
-	*portPtr = ntohs((unsigned short) sp->s_port);
-	return TCL_OK;
+    struct servent *sp;		/* Protocol info for named services */
+    if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
+	sp = getservbyname(string, proto);    
+	if (sp != NULL) {
+	    *portPtr = ntohs((unsigned short) sp->s_port);
+	    Tcl_ResetResult(interp);	/* clear error message */
+	    return TCL_OK;
+	}
+	return TCL_ERROR;
     }
     if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
 	return TCL_ERROR;
@@ -79,18 +84,19 @@ TclSockMinimumBuffers(sock, size)
     int size;			/* Minimum buffer size */
 {
     int current;
-    int len = sizeof(int);
-
-    getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *) &current, &len);
+    int len;
+    
+    len = sizeof(int);
+    getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
     if (current < size) {
 	len = sizeof(int);
-	setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *) &size, len);
+	setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
     }
     len = sizeof(int);
-    getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *) &current, &len);
+    getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
     if (current < size) {
 	len = sizeof(int);
-	setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *) &size, len);
+	setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
     }
     return TCL_OK;
 }
diff --git a/contrib/tcl/generic/tclIOUtil.c b/contrib/tcl/generic/tclIOUtil.c
index f42e16b..cb2bd94 100644
--- a/contrib/tcl/generic/tclIOUtil.c
+++ b/contrib/tcl/generic/tclIOUtil.c
@@ -13,151 +13,12 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclIOUtil.c 1.123 96/04/29 14:08:24
+ * SCCS: @(#) tclIOUtil.c 1.132 97/04/23 16:21:42
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
-/*
- * A linked list of the following structures is used to keep track
- * of child processes that have been detached but haven't exited
- * yet, so we can make sure that they're properly "reaped" (officially
- * waited for) and don't lie around as zombies cluttering the
- * system.
- */
-
-typedef struct Detached {
-    int pid;				/* Id of process that's been detached
-					 * but isn't known to have exited. */
-    struct Detached *nextPtr;		/* Next in list of all detached
-					 * processes. */
-} Detached;
-
-static Detached *detList = NULL;	/* List of all detached proceses. */
-
-/*
- * Declarations for local procedures defined in this file:
- */
-
-static Tcl_File	FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
-	                    char *spec, int atOk, char *arg, int flags,
-	                    char *nextArg, int *skipPtr, int *closePtr));
-
-/*
- *----------------------------------------------------------------------
- *
- * FileForRedirect --
- *
- *	This procedure does much of the work of parsing redirection
- *	operators.  It handles "@" if specified and allowed, and a file
- *	name, and opens the file if necessary.
- *
- * Results:
- *	The return value is the descriptor number for the file.  If an
- *	error occurs then NULL is returned and an error message is left
- *	in interp->result.  Several arguments are side-effected; see
- *	the argument list below for details.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_File
-FileForRedirect(interp, spec, atOk, arg, flags, nextArg, skipPtr, closePtr)
-    Tcl_Interp *interp;			/* Intepreter to use for error
-					 * reporting. */
-    register char *spec;			/* Points to character just after
-					 * redirection character. */
-    int atOk;				/* Non-zero means '@' notation is
-					 * OK, zero means it isn't. */
-    char *arg;				/* Pointer to entire argument
-					 * containing spec:  used for error
-					 * reporting. */
-    int flags;				/* Flags to use for opening file. */
-    char *nextArg;			/* Next argument in argc/argv
-					 * array, if needed for file name.
-					 * May be NULL. */
-    int *skipPtr;			/* This value is incremented if
-					 * nextArg is used for redirection
-					 * spec. */
-    int *closePtr;			/* This value is set to 1 if the file
-					 * that's returned must be closed, 0
-					 * if it was specified with "@" so
-					 * it must be left open. */
-{
-    int writing = (flags & O_WRONLY);
-    Tcl_Channel chan;
-    Tcl_File file;
-
-    if (atOk && (*spec == '@')) {
-	spec++;
-	if (*spec == 0) {
-	    spec = nextArg;
-	    if (spec == NULL) {
-		goto badLastArg;
-	    }
-	    *skipPtr += 1;
-	}
-        chan = Tcl_GetChannel(interp, spec, NULL);
-        if (chan == (Tcl_Channel) NULL) {
-            return NULL;
-        }
-	*closePtr = 0;
-        file = Tcl_GetChannelFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
-        if (file == NULL) {
-            Tcl_AppendResult(interp,
-                    "channel \"",
-                    Tcl_GetChannelName(chan),
-                    "\" wasn't opened for ",
-                    writing ? "writing" : "reading", (char *) NULL);
-            return NULL;
-        }
-	if (writing) {
-
-	    /*
-	     * Be sure to flush output to the file, so that anything
-	     * written by the child appears after stuff we've already
-	     * written.
-	     */
-
-            Tcl_Flush(chan);
-	}
-    } else {
-	Tcl_DString buffer;
-	char *name;
-
-	if (*spec == 0) {
-	    spec = nextArg;
-	    if (spec == NULL) {
-		goto badLastArg;
-	    }
-	    *skipPtr += 1;
-	}
-	name = Tcl_TranslateFileName(interp, spec, &buffer);
-	if (name) {
-	    file = TclOpenFile(name, flags);
-	} else {
-	    file = NULL;
-	}
-	Tcl_DStringFree(&buffer);
-	if (file == NULL) {
-	    Tcl_AppendResult(interp, "couldn't ",
-		    (writing) ? "write" : "read", " file \"", spec, "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
-	    return NULL;
-	}
-	*closePtr = 1;
-    }
-    return file;
-
-    badLastArg:
-    Tcl_AppendResult(interp, "can't specify \"", arg,
-	    "\" as last word in command", (char *) NULL);
-    return NULL;
-}
 
 /*
  *----------------------------------------------------------------------
@@ -354,11 +215,11 @@ Tcl_EvalFile(interp, fileName)
     int result;
     struct stat statBuf;
     char *cmdBuffer = (char *) NULL;
-    char *oldScriptFile = (char *) NULL;
+    char *oldScriptFile;
     Interp *iPtr = (Interp *) interp;
     Tcl_DString buffer;
-    char *nativeName = (char *) NULL;
-    Tcl_Channel chan = (Tcl_Channel) NULL;
+    char *nativeName;
+    Tcl_Channel chan;
 
     Tcl_ResetResult(interp);
     oldScriptFile = iPtr->scriptFile;
@@ -438,670 +299,6 @@ error:
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_DetachPids --
- *
- *	This procedure is called to indicate that one or more child
- *	processes have been placed in background and will never be
- *	waited for;  they should eventually be reaped by
- *	Tcl_ReapDetachedProcs.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DetachPids(numPids, pidPtr)
-    int numPids;		/* Number of pids to detach:  gives size
-				 * of array pointed to by pidPtr. */
-    int *pidPtr;		/* Array of pids to detach. */
-{
-    register Detached *detPtr;
-    int i;
-
-    for (i = 0; i < numPids; i++) {
-	detPtr = (Detached *) ckalloc(sizeof(Detached));
-	detPtr->pid = pidPtr[i];
-	detPtr->nextPtr = detList;
-	detList = detPtr;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ReapDetachedProcs --
- *
- *	This procedure checks to see if any detached processes have
- *	exited and, if so, it "reaps" them by officially waiting on
- *	them.  It should be called "occasionally" to make sure that
- *	all detached processes are eventually reaped.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Processes are waited on, so that they can be reaped by the
- *	system.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_ReapDetachedProcs()
-{
-    register Detached *detPtr;
-    Detached *nextPtr, *prevPtr;
-    int status;
-    int pid;
-
-    for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
-	pid = (int) Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
-	if ((pid == 0) || ((pid == -1) && (errno != ECHILD))) {
-	    prevPtr = detPtr;
-	    detPtr = detPtr->nextPtr;
-	    continue;
-	}
-	nextPtr = detPtr->nextPtr;
-	if (prevPtr == NULL) {
-	    detList = detPtr->nextPtr;
-	} else {
-	    prevPtr->nextPtr = detPtr->nextPtr;
-	}
-	ckfree((char *) detPtr);
-	detPtr = nextPtr;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCleanupChildren --
- *
- *	This is a utility procedure used to wait for child processes
- *	to exit, record information about abnormal exits, and then
- *	collect any stderr output generated by them.
- *
- * Results:
- *	The return value is a standard Tcl result.  If anything at
- *	weird happened with the child processes, TCL_ERROR is returned
- *	and a message is left in interp->result.
- *
- * Side effects:
- *	If the last character of interp->result is a newline, then it
- *	is removed unless keepNewline is non-zero.  File errorId gets
- *	closed, and pidPtr is freed back to the storage allocator.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCleanupChildren(interp, numPids, pidPtr, errorChan)
-    Tcl_Interp *interp;		/* Used for error messages. */
-    int numPids;		/* Number of entries in pidPtr array. */
-    int *pidPtr;		/* Array of process ids of children. */
-    Tcl_Channel errorChan;	/* Channel for file containing stderr output
-				 * from pipeline.  NULL means there isn't any
-				 * stderr output. */
-{
-    int result = TCL_OK;
-    int i, pid, abnormalExit, anyErrorInfo;
-    WAIT_STATUS_TYPE waitStatus;
-    char *msg;
-
-    abnormalExit = 0;
-    for (i = 0; i < numPids; i++) {
-        pid = (int) Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
-	if (pid == -1) {
-	    result = TCL_ERROR;
-            if (interp != (Tcl_Interp *) NULL) {
-                msg = Tcl_PosixError(interp);
-                if (errno == ECHILD) {
-		    /*
-                     * This changeup in message suggested by Mark Diekhans
-                     * to remind people that ECHILD errors can occur on
-                     * some systems if SIGCHLD isn't in its default state.
-                     */
-
-                    msg =
-                        "child process lost (is SIGCHLD ignored or trapped?)";
-                }
-                Tcl_AppendResult(interp, "error waiting for process to exit: ",
-                        msg, (char *) NULL);
-            }
-	    continue;
-	}
-
-	/*
-	 * Create error messages for unusual process exits.  An
-	 * extra newline gets appended to each error message, but
-	 * it gets removed below (in the same fashion that an
-	 * extra newline in the command's output is removed).
-	 */
-
-	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
-	    char msg1[20], msg2[20];
-
-	    result = TCL_ERROR;
-	    sprintf(msg1, "%d", pid);
-	    if (WIFEXITED(waitStatus)) {
-                if (interp != (Tcl_Interp *) NULL) {
-                    sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
-                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
-                            (char *) NULL);
-                }
-		abnormalExit = 1;
-	    } else if (WIFSIGNALED(waitStatus)) {
-                if (interp != (Tcl_Interp *) NULL) {
-                    char *p;
-                    
-                    p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
-                    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
-                            Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
-                            (char *) NULL);
-                    Tcl_AppendResult(interp, "child killed: ", p, "\n",
-                            (char *) NULL);
-                }
-	    } else if (WIFSTOPPED(waitStatus)) {
-                if (interp != (Tcl_Interp *) NULL) {
-                    char *p;
-
-                    p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
-                    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
-                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
-                            p, (char *) NULL);
-                    Tcl_AppendResult(interp, "child suspended: ", p, "\n",
-                            (char *) NULL);
-                }
-	    } else {
-                if (interp != (Tcl_Interp *) NULL) {
-                    Tcl_AppendResult(interp,
-                            "child wait status didn't make sense\n",
-                            (char *) NULL);
-                }
-	    }
-	}
-    }
-
-    /*
-     * Read the standard error file.  If there's anything there,
-     * then return an error and add the file's contents to the result
-     * string.
-     */
-
-    anyErrorInfo = 0;
-    if (errorChan != NULL) {
-
-	/*
-	 * Make sure we start at the beginning of the file.
-	 */
-
-	Tcl_Seek(errorChan, 0L, SEEK_SET);
-
-        if (interp != (Tcl_Interp *) NULL) {
-            while (1) {
-#define BUFFER_SIZE 1000
-                char buffer[BUFFER_SIZE+1];
-                int count;
-    
-                count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
-                if (count == 0) {
-                    break;
-                }
-                result = TCL_ERROR;
-                if (count < 0) {
-                    Tcl_AppendResult(interp,
-                            "error reading stderr output file: ",
-                            Tcl_PosixError(interp), (char *) NULL);
-                    break;	/* out of the "while (1)" loop. */
-                }
-                buffer[count] = 0;
-                Tcl_AppendResult(interp, buffer, (char *) NULL);
-                anyErrorInfo = 1;
-            }
-        }
-        
-	Tcl_Close(NULL, errorChan);
-    }
-
-    /*
-     * If a child exited abnormally but didn't output any error information
-     * at all, generate an error message here.
-     */
-
-    if (abnormalExit && !anyErrorInfo && (interp != (Tcl_Interp *) NULL)) {
-	Tcl_AppendResult(interp, "child process exited abnormally",
-		(char *) NULL);
-    }
-    
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCreatePipeline --
- *
- *	Given an argc/argv array, instantiate a pipeline of processes
- *	as described by the argv.
- *
- * Results:
- *	The return value is a count of the number of new processes
- *	created, or -1 if an error occurred while creating the pipeline.
- *	*pidArrayPtr is filled in with the address of a dynamically
- *	allocated array giving the ids of all of the processes.  It
- *	is up to the caller to free this array when it isn't needed
- *	anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
- *	with the file id for the input pipe for the pipeline (if any):
- *	the caller must eventually close this file.  If outPipePtr
- *	isn't NULL, then *outPipePtr is filled in with the file id
- *	for the output pipe from the pipeline:  the caller must close
- *	this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
- *	with a file id that may be used to read error output after the
- *	pipeline completes.
- *
- * Side effects:
- *	Processes and pipes are created.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
-	outPipePtr, errFilePtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
-    int argc;			/* Number of entries in argv. */
-    char **argv;		/* Array of strings describing commands in
-				 * pipeline plus I/O redirection with <,
-				 * <<,  >, etc.  Argv[argc] must be NULL. */
-    int **pidArrayPtr;		/* Word at *pidArrayPtr gets filled in with
-				 * address of array of pids for processes
-				 * in pipeline (first pid is first process
-				 * in pipeline). */
-    Tcl_File *inPipePtr;	/* If non-NULL, input to the pipeline comes
-				 * from a pipe (unless overridden by
-				 * redirection in the command).  The file
-				 * id with which to write to this pipe is
-				 * stored at *inPipePtr.  NULL means command
-				 * specified its own input source. */
-    Tcl_File *outPipePtr;	/* If non-NULL, output to the pipeline goes
-				 * to a pipe, unless overriden by redirection
-				 * in the command.  The file id with which to
-				 * read frome this pipe is stored at
-				 * *outPipePtr.  NULL means command specified
-				 * its own output sink. */
-    Tcl_File *errFilePtr;	/* If non-NULL, all stderr output from the
-				 * pipeline will go to a temporary file
-				 * created here, and a descriptor to read
-				 * the file will be left at *errFilePtr.
-				 * The file will be removed already, so
-				 * closing this descriptor will be the end
-				 * of the file.  If this is NULL, then
-				 * all stderr output goes to our stderr.
-				 * If the pipeline specifies redirection
-				 * then the file will still be created
-				 * but it will never get any data. */
-{
-#if defined( MAC_TCL )
-    Tcl_AppendResult(interp,
-	    "command pipelines not supported on Macintosh OS", NULL);
-    return -1;
-#else /* !MAC_TCL */
-    int *pidPtr = NULL;		/* Points to malloc-ed array holding all
-				 * the pids of child processes. */
-    int numPids = 0;		/* Actual number of processes that exist
-				 * at *pidPtr right now. */
-    int cmdCount;		/* Count of number of distinct commands
-				 * found in argc/argv. */
-    char *input = NULL;		/* If non-null, then this points to a
-				 * string containing input data (specified
-				 * via <<) to be piped to the first process
-				 * in the pipeline. */
-    Tcl_File inputFile = NULL;
-				/* If != NULL, gives file to use as input for
-				 * first process in pipeline (specified via <
-				 * or <@). */
-    int closeInput = 0;		/* If non-zero, then must close inputId
-				 * when cleaning up (zero means the file needs
-				 * to stay open for some other reason). */
-    Tcl_File outputFile = NULL;
-				/* Writable file for output from last command
-				 * in pipeline (could be file or pipe).  NULL
-				 * means use stdout. */
-    int closeOutput = 0;	/* Non-zero means must close outputId when
-				 * cleaning up (similar to closeInput). */
-    Tcl_File errorFile = NULL;
-				/* Writable file for error output from all
-				 * commands in pipeline.  NULL means use
-				 * stderr. */
-    int closeError = 0;		/* Non-zero means must close errorId when
-				 * cleaning up. */
-    int skip;			/* Number of arguments to skip (because they
-				 * specify redirection). */
-    int lastBar;
-    int i, j;
-    char *p;
-    int hasPipes = TclHasPipes();
-    char finalOut[L_tmpnam];
-    char intIn[L_tmpnam];
-
-    finalOut[0]  = '\0';
-    intIn[0] = '\0';
-    
-    if (inPipePtr != NULL) {
-	*inPipePtr = NULL;
-    }
-    if (outPipePtr != NULL) {
-	*outPipePtr = NULL;
-    }
-    if (errFilePtr != NULL) {
-	*errFilePtr = NULL;
-    }
-
-    /*
-     * First, scan through all the arguments to figure out the structure
-     * of the pipeline.  Process all of the input and output redirection
-     * arguments and remove them from the argument list in the pipeline.
-     * Count the number of distinct processes (it's the number of "|"
-     * arguments plus one) but don't remove the "|" arguments.
-     */
-
-    cmdCount = 1;
-    lastBar = -1;
-    for (i = 0; i < argc; i++) {
-	if ((argv[i][0] == '|') && (((argv[i][1] == 0))
-		|| ((argv[i][1] == '&') && (argv[i][2] == 0)))) {
-	    if ((i == (lastBar+1)) || (i == (argc-1))) {
-		interp->result = "illegal use of | or |& in command";
-		return -1;
-	    }
-	    lastBar = i;
-	    cmdCount++;
-	    continue;
-	} else if (argv[i][0] == '<') {
-	    if ((inputFile != NULL) && closeInput) {
-		TclCloseFile(inputFile);
-	    }
-	    inputFile = NULL;
-	    skip = 1;
-	    if (argv[i][1] == '<') {
-		input = argv[i]+2;
-		if (*input == 0) {
-		    input = argv[i+1];
-		    if (input == 0) {
-			Tcl_AppendResult(interp, "can't specify \"", argv[i],
-				"\" as last word in command", (char *) NULL);
-			goto error;
-		    }
-		    skip = 2;
-		}
-	    } else {
-		input = 0;
-		inputFile = FileForRedirect(interp, argv[i]+1, 1, argv[i],
-			O_RDONLY, argv[i+1], &skip, &closeInput);
-		if (inputFile == NULL) {
-		    goto error;
-		}
-
-		/* When Win32s dies out, this code can be removed */
-		if (!hasPipes) {
-		    if (!closeInput) {
-			Tcl_AppendResult(interp, "redirection with '@'",
-				" notation is not supported on this system",
-				(char *) NULL);
-			goto error;
-		    }
-		    strcpy(intIn, skip == 1 ? argv[i]+1 : argv[i+1]);
-		}
-	    }
-	} else if (argv[i][0] == '>') {
-	    int append, useForStdErr, useForStdOut, mustClose, atOk, flags;
-	    Tcl_File file;
-
-	    skip = atOk = 1;
-	    append = useForStdErr = 0;
-	    useForStdOut = 1;
-	    if (argv[i][1] == '>') {
-		p = argv[i] + 2;
-		append = 1;
-		atOk = 0;
-		flags = O_WRONLY|O_CREAT;
-	    } else {
-		p = argv[i] + 1;
-		flags = O_WRONLY|O_CREAT|O_TRUNC;
-	    }
-	    if (*p == '&') {
-		useForStdErr = 1;
-		p++;
-	    }
-	    file = FileForRedirect(interp, p, atOk, argv[i], flags, argv[i+1],
-		    &skip, &mustClose);
-	    if (file == NULL) {
-		goto error;
-	    }
-
-	    /* When Win32s dies out, this code can be removed */
-	    if (!hasPipes) {
-		if (!mustClose) {
-		    Tcl_AppendResult(interp, "redirection with '@'",
-			    " notation is not supported on this system",
-			    (char *) NULL);
-		    goto error;
-		}
-		strcpy(finalOut, skip == 1 ? p : argv[i+1]);
-	    }
-
-	    if (hasPipes && append) {
-		TclSeekFile(file, 0L, 2);
-	    }
-
-	    /*
-	     * Got the file descriptor.  Now use it for standard output,
-	     * standard error, or both, depending on the redirection.
-	     */
-
-	    if (useForStdOut) {
-		if ((outputFile != NULL) && closeOutput) {
-		    TclCloseFile(outputFile);
-		}
-		outputFile = file;
-		closeOutput = mustClose;
-	    }
-	    if (useForStdErr) {
-		if ((errorFile != NULL) && closeError) {
-		    TclCloseFile(errorFile);
-		}
-		errorFile = file;
-		closeError = (useForStdOut) ? 0 : mustClose;
-	    }
-	} else if ((argv[i][0] == '2') && (argv[i][1] == '>')) {
-	    int append, atOk, flags;
-
-	    if ((errorFile != NULL) && closeError) {
-		TclCloseFile(errorFile);
-	    }
-	    skip = 1;
-	    p = argv[i] + 2;
-	    if (*p == '>') {
-		p++;
-		append = 1;
-		atOk = 0;
-		flags = O_WRONLY|O_CREAT;
-	    } else {
-		append = 0;
-		atOk = 1;
-		flags = O_WRONLY|O_CREAT|O_TRUNC;
-	    }
-	    errorFile = FileForRedirect(interp, p, atOk, argv[i], flags,
-		    argv[i+1], &skip, &closeError);
-	    if (errorFile == NULL) {
-		goto error;
-	    }
-	    if (hasPipes && append) {
-		TclSeekFile(errorFile, 0L, 2);
-	    }
-	} else {
-	    continue;
-	}
-	for (j = i+skip; j < argc; j++) {
-	    argv[j-skip] = argv[j];
-	}
-	argc -= skip;
-	i -= 1;			/* Process next arg from same position. */
-    }
-    if (argc == 0) {
-	interp->result =  "didn't specify command to execute";
-	return -1;
-    }
-
-    if ((hasPipes && inputFile == NULL) || (!hasPipes && intIn[0] == '\0')) {
-	if (input != NULL) {
-
-	    /*
-	     * The input for the first process is immediate data coming from
-	     * Tcl.  Create a temporary file for it and put the data into the
-	     * file.
-	     */
-	    
-	    inputFile = TclCreateTempFile(input);
-	    closeInput = 1;
-	    if (inputFile == NULL) {
-		Tcl_AppendResult(interp,
-			"couldn't create input file for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
-		goto error;
-	    }
-	} else if (inPipePtr != NULL) {
-	    Tcl_File inPipe, outPipe;
-	    /*
-	     * The input for the first process in the pipeline is to
-	     * come from a pipe that can be written from this end.
-	     */
-
-	    if (!hasPipes || TclCreatePipe(&inPipe, &outPipe) == 0) {
-		Tcl_AppendResult(interp,
-			"couldn't create input pipe for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
-		goto error;
-	    }
-	    inputFile = inPipe;
-	    closeInput = 1;
-	    *inPipePtr = outPipe;
-	}
-    }
-
-    /*
-     * Set up a pipe to receive output from the pipeline, if no other
-     * output sink has been specified.
-     */
-
-    if ((outputFile == NULL) && (outPipePtr != NULL)) {
-	if (!hasPipes) {
-	    tmpnam(finalOut);
-	} else {
-	    Tcl_File inPipe, outPipe;
-	    if (TclCreatePipe(&inPipe, &outPipe) == 0) {
-		Tcl_AppendResult(interp,
-			"couldn't create output pipe for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
-		goto error;
-	    }
-	    outputFile = outPipe;
-	    closeOutput = 1;
-	    *outPipePtr = inPipe;
-	}
-    }
-
-    /*
-     * Set up the standard error output sink for the pipeline, if
-     * requested.  Use a temporary file which is opened, then deleted.
-     * Could potentially just use pipe, but if it filled up it could
-     * cause the pipeline to deadlock:  we'd be waiting for processes
-     * to complete before reading stderr, and processes couldn't complete
-     * because stderr was backed up.
-     */
-
-    if (errFilePtr && !errorFile) {
-	*errFilePtr = TclCreateTempFile(NULL);
-	if (*errFilePtr == NULL) {
-	    Tcl_AppendResult(interp,
-		    "couldn't create error file for command: ",
-		    Tcl_PosixError(interp), (char *) NULL);
-	    goto error;
-	}
-	errorFile = *errFilePtr;
-	closeError = 0;
-    }
-	
-    /*
-     * Scan through the argc array, forking off a process for each
-     * group of arguments between "|" arguments.
-     */
-
-    pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
-    Tcl_ReapDetachedProcs();
-
-    if (TclSpawnPipeline(interp, pidPtr, &numPids, argc, argv, 
-	    inputFile, outputFile, errorFile, intIn, finalOut) == 0) {
-	goto error;
-    }
-    *pidArrayPtr = pidPtr;
-
-    /*
-     * All done.  Cleanup open files lying around and then return.
-     */
-
-cleanup:
-    if ((inputFile != NULL) && closeInput) {
-	TclCloseFile(inputFile);
-    }
-    if ((outputFile != NULL) && closeOutput) {
-	TclCloseFile(outputFile);
-    }
-    if ((errorFile != NULL) && closeError) {
-	TclCloseFile(errorFile);
-    }
-    return numPids;
-
-    /*
-     * An error occurred.  There could have been extra files open, such
-     * as pipes between children.  Clean them all up.  Detach any child
-     * processes that have been created.
-     */
-
-error:
-    if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
-	TclCloseFile(*inPipePtr);
-	*inPipePtr = NULL;
-    }
-    if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
-	TclCloseFile(*outPipePtr);
-	*outPipePtr = NULL;
-    }
-    if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
-	TclCloseFile(*errFilePtr);
-	*errFilePtr = NULL;
-    }
-    if (pidPtr != NULL) {
-	for (i = 0; i < numPids; i++) {
-	    if (pidPtr[i] != -1) {
-		Tcl_DetachPids(1, &pidPtr[i]);
-	    }
-	}
-	ckfree((char *) pidPtr);
-    }
-    numPids = -1;
-    goto cleanup;
-#endif /* !MAC_TCL */
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_GetErrno --
  *
  *	Gets the current value of the Tcl error code variable. This is
@@ -1179,109 +376,3 @@ Tcl_PosixError(interp)
     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
     return msg;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_OpenCommandChannel --
- *
- *	Opens an I/O channel to one or more subprocesses specified
- *	by argc and argv.  The flags argument determines the
- *	disposition of the stdio handles.  If the TCL_STDIN flag is
- *	set then the standard input for the first subprocess will
- *	be tied to the channel:  writing to the channel will provide
- *	input to the subprocess.  If TCL_STDIN is not set, then
- *	standard input for the first subprocess will be the same as
- *	this application's standard input.  If TCL_STDOUT is set then
- *	standard output from the last subprocess can be read from the
- *	channel;  otherwise it goes to this application's standard
- *	output.  If TCL_STDERR is set, standard error output for all
- *	subprocesses is returned to the channel and results in an error
- *	when the channel is closed;  otherwise it goes to this
- *	application's standard error.  If TCL_ENFORCE_MODE is not set,
- *	then argc and argv can redirect the stdio handles to override
- *	TCL_STDIN, TCL_STDOUT, and TCL_STDERR;  if it is set, then it 
- *	is an error for argc and argv to override stdio channels for
- *	which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
- *
- * Results:
- *	A new command channel, or NULL on failure with an error
- *	message left in interp.
- *
- * Side effects:
- *	Creates processes, opens pipes.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-Tcl_OpenCommandChannel(interp, argc, argv, flags)
-    Tcl_Interp *interp;		/* Interpreter for error reporting. Can
-                                 * NOT be NULL. */
-    int argc;			/* How many arguments. */
-    char **argv;		/* Array of arguments for command pipe. */
-    int flags;			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
-				 * TCL_STDERR, and TCL_ENFORCE_MODE. */
-{
-    Tcl_File *inPipePtr, *outPipePtr, *errFilePtr;
-    Tcl_File inPipe, outPipe, errFile;
-    int numPids, *pidPtr;
-    Tcl_Channel channel;
-
-    inPipe = outPipe = errFile = NULL;
-
-    inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
-    outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
-    errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
-    
-    numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
-            outPipePtr, errFilePtr);
-
-    if (numPids < 0) {
-	goto error;
-    }
-
-    /*
-     * Verify that the pipes that were created satisfy the
-     * readable/writable constraints. 
-     */
-
-    if (flags & TCL_ENFORCE_MODE) {
-	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
-	    Tcl_AppendResult(interp, "can't read output from command:",
-		    " standard output was redirected", (char *) NULL);
-	    goto error;
-	}
-	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
-	    Tcl_AppendResult(interp, "can't write input to command:",
-		    " standard input was redirected", (char *) NULL);
-	    goto error;
-	}
-    }
-    
-    channel = TclCreateCommandChannel(outPipe, inPipe, errFile,
-	    numPids, pidPtr);
-
-    if (channel == (Tcl_Channel) NULL) {
-        Tcl_AppendResult(interp, "pipe for command could not be created",
-                (char *) NULL);
-	goto error;
-    }
-    return channel;
-
-error:
-    if (numPids > 0) {
-	Tcl_DetachPids(numPids, pidPtr);
-	ckfree((char *) pidPtr);
-    }
-    if (inPipe != NULL) {
-	TclClosePipeFile(inPipe);
-    }
-    if (outPipe != NULL) {
-	TclClosePipeFile(outPipe);
-    }
-    if (errFile != NULL) {
-	TclClosePipeFile(errFile);
-    }
-    return NULL;
-}
diff --git a/contrib/tcl/generic/tclIndexObj.c b/contrib/tcl/generic/tclIndexObj.c
new file mode 100644
index 0000000..86a394f
--- /dev/null
+++ b/contrib/tcl/generic/tclIndexObj.c
@@ -0,0 +1,239 @@
+/* 
+ * tclIndexObj.c --
+ *
+ *	This file implements objects of type "index".  This object type
+ *	is used to lookup a keyword in a table of valid values and cache
+ *	the index of the matching entry.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclIndexObj.c 1.4 97/02/11 13:30:01
+ */
+
+#include "tclInt.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupIndexInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static int		SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+/*
+ * The structure below defines the index Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclIndexType = {
+    "index",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,	/* freeIntRepProc */
+    DupIndexInternalRep,	        /* dupIntRepProc */
+    UpdateStringOfIndex,		/* updateStringProc */
+    SetIndexFromAny			/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIndexFromObj --
+ *
+ *	This procedure looks up an object's value in a table of strings
+ *	and returns the index of the matching string, if any.
+ *
+ * Results:
+
+ *	If the value of objPtr is identical to or a unique abbreviation
+ *	for one of the entries in objPtr, then the return value is
+ *	TCL_OK and the index of the matching entry is stored at
+ *	*indexPtr.  If there isn't a proper match, then TCL_ERROR is
+ *	returned and an error message is left in interp's result (unless
+ *	interp is NULL).  The msg argument is used in the error
+ *	message; for example, if msg has the value "option" then the
+ *	error message will say something flag 'bad option "foo": must be
+ *	...'
+ *
+ * Side effects:
+ *	The result of the lookup is cached as the internal rep of
+ *	objPtr, so that repeated lookups can be done quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* Object containing the string to lookup. */
+    char **tablePtr;		/* Array of strings to compare against the
+				 * value of objPtr; last entry must be NULL
+				 * and there must not be duplicate entries. */
+    char *msg;			/* Identifying word to use in error messages. */
+    int flags;			/* 0 or TCL_EXACT */
+    int *indexPtr;		/* Place to store resulting integer index. */
+{
+    int index, length, i, numAbbrev;
+    char *key, *p1, *p2, **entryPtr;
+    Tcl_Obj *resultPtr;
+
+    /*
+     * See if there is a valid cached result from a previous lookup.
+     */
+
+    if ((objPtr->typePtr == &tclIndexType)
+	    && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) {
+	*indexPtr = (int) objPtr->internalRep.twoPtrValue.ptr2;
+	return TCL_OK;
+    }
+
+    /*
+     * Lookup the value of the object in the table.  Accept unique
+     * abbreviations unless TCL_EXACT is set in flags.
+     */
+
+    key = Tcl_GetStringFromObj(objPtr, &length);
+    index = -1;
+    numAbbrev = 0;
+    for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
+	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
+	    if (*p1 == 0) {
+		index = i;
+		goto done;
+	    }
+	}
+	if (*p1 == 0) {
+	    /*
+	     * The value is an abbreviation for this entry.  Continue
+	     * checking other entries to make sure it's unique.  If we
+	     * get more than one unique abbreviation, keep searching to
+	     * see if there is an exact match, but remember the number
+	     * of unique abbreviations and don't allow either.
+	     */
+
+	    numAbbrev++;
+	    index = i;
+	}
+    }
+    if ((flags & TCL_EXACT) || (numAbbrev != 1)) {
+	goto error;
+    }
+
+    done:
+    if ((objPtr->typePtr != NULL)
+	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) index;
+    objPtr->typePtr = &tclIndexType;
+    *indexPtr = index;
+    return TCL_OK;
+
+    error:
+    if (interp != NULL) {
+	resultPtr = Tcl_GetObjResult(interp);
+	Tcl_AppendStringsToObj(resultPtr,
+		(numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"",
+		key, "\": must be ", *tablePtr, (char *) NULL);
+	for (entryPtr = tablePtr+1; *entryPtr != NULL; entryPtr++) {
+	    if (entryPtr[1] == NULL) {
+		Tcl_AppendStringsToObj(resultPtr, ", or ", *entryPtr,
+			(char *) NULL);
+	    } else {
+		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
+			(char *) NULL);
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupIndexInternalRep --
+ *
+ *	Copy the internal representation of an index Tcl_Obj from one
+ *	object to another.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to same value as "srcPtr"s
+ *	internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupIndexInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.twoPtrValue.ptr1
+	    = srcPtr->internalRep.twoPtrValue.ptr1;
+    copyPtr->internalRep.twoPtrValue.ptr2
+	    = srcPtr->internalRep.twoPtrValue.ptr2;
+    copyPtr->typePtr = &tclIndexType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetIndexFromAny --
+ *
+ *	This procedure is called to convert a Tcl object to index
+ *	internal form. However, this doesn't make sense (need to have a
+ *	table of keywords in order to do the conversion) so the
+ *	procedure always generates an error.
+ *
+ * Results:
+ *	The return value is always TCL_ERROR, and an error message is
+ *	left in interp's result if interp isn't NULL. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetIndexFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	    "can't convert value to index except via Tcl_GetIndexFromObj API",
+	    -1);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfIndex --
+ *
+ *	This procedure is called to update the string representation for
+ *	an index object.  It should never be called, because we never
+ *	invalidate the string representation for an index object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A panic is added
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfIndex(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    panic("UpdateStringOfIndex should never be invoked");
+}
diff --git a/contrib/tcl/generic/tclInt.h b/contrib/tcl/generic/tclInt.h
index b86ad13..1e88992 100644
--- a/contrib/tcl/generic/tclInt.h
+++ b/contrib/tcl/generic/tclInt.h
@@ -4,12 +4,13 @@
  *	Declarations of things used internally by the Tcl interpreter.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1997 Lucent Technologies.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclInt.h 1.203 96/07/23 16:15:24
+ * SCCS: @(#) tclInt.h 1.277 97/06/20 15:19:00
  */
 
 #ifndef _TCLINT
@@ -58,6 +59,113 @@
 
 /*
  *----------------------------------------------------------------
+ * Data structures related to namespaces.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The structure below defines a namespace.
+ * Note: the first five fields must match exactly the fields in a
+ * Tcl_Namespace structure (see tcl.h). If you change one, be sure to
+ * change the other.
+ */
+
+typedef struct Namespace {
+    char *name;			 /* The namespace's simple (unqualified)
+				  * name. This contains no ::'s. The name of
+				  * the global namespace is "" although "::"
+				  * is an synonym. */
+    char *fullName;		 /* The namespace's fully qualified name.
+				  * This starts with ::. */
+    ClientData clientData;	 /* An arbitrary value associated with this
+				  * namespace. */
+    Tcl_NamespaceDeleteProc *deleteProc;
+				 /* Procedure invoked when deleting the
+				  * namespace to, e.g., free clientData. */
+    struct Namespace *parentPtr; /* Points to the namespace that contains
+				  * this one. NULL if this is the global
+				  * namespace. */
+    Tcl_HashTable childTable;	 /* Contains any child namespaces. Indexed
+                                  * by strings; values have type
+				  * (Namespace *). */
+    long nsId;			 /* Unique id for the namespace. */
+    Tcl_Interp *interp;		 /* The interpreter containing this
+				  * namespace. */
+    int flags;			 /* OR-ed combination of the namespace
+				  * status flags NS_DYING and NS_DEAD
+				  * listed below. */
+    int activationCount;	 /* Number of "activations" or active call
+				  * frames for this namespace that are on
+				  * the Tcl call stack. The namespace won't
+				  * be freed until activationCount becomes
+				  * zero. */
+    int refCount;		 /* Count of references by namespaceName *
+				  * objects. The namespace can't be freed
+				  * until refCount becomes zero. */
+    Tcl_HashTable cmdTable;	 /* Contains all the commands currently
+                                  * registered in the namespace. Indexed by
+                                  * strings; values have type (Command *).
+				  * Commands imported by Tcl_Import have
+				  * Command structures that point (via an
+				  * ImportedCmdRef structure) to the
+				  * Command structure in the source
+				  * namespace's command table. */
+    Tcl_HashTable varTable;	 /* Contains all the (global) variables
+				  * currently in this namespace. Indexed
+                                  * by strings; values have type (Var *). */
+    char **exportArrayPtr;	 /* Points to an array of string patterns
+				  * specifying which commands are exported.
+				  * A pattern may include "string match"
+				  * style wildcard characters to specify
+				  * multiple commands; however, no namespace
+				  * qualifiers are allowed. NULL if no
+				  * export patterns are registered. */
+    int numExportPatterns;	 /* Number of export patterns currently
+				  * registered using "namespace export". */
+    int maxExportPatterns;	 /* Mumber of export patterns for which
+				  * space is currently allocated. */
+    int cmdRefEpoch;		 /* Incremented if a newly added command
+				  * shadows a command for which this
+				  * namespace has already cached a Command *
+				  * pointer; this causes all its cached
+				  * Command* pointers to be invalidated. */
+} Namespace;
+
+/*
+ * Flags used to represent the status of a namespace:
+ *
+ * NS_DYING -	1 means Tcl_DeleteNamespace has been called to delete the
+ *		namespace but there are still active call frames on the Tcl
+ *		stack that refer to the namespace. When the last call frame
+ *		referring to it has been popped, it's variables and command
+ *		will be destroyed and it will be marked "dead" (NS_DEAD).
+ *		The namespace can no longer be looked up by name.
+ * NS_DEAD -	1 means Tcl_DeleteNamespace has been called to delete the
+ *		namespace and no call frames still refer to it. Its
+ *		variables and command have already been destroyed. This bit
+ *		allows the namespace resolution code to recognize that the
+ *		namespace is "deleted". When the last namespaceName object
+ *		in any byte code code unit that refers to the namespace has
+ *		been freed (i.e., when the namespace's refCount is 0), the
+ *		namespace's storage will be freed.
+ */
+
+#define NS_DYING  	0x01
+#define NS_DEAD  	0x02
+
+/*
+ * Flag passed to TclGetNamespaceForQualName to have it create all namespace
+ * components of a namespace-qualified name that cannot be found. The new
+ * namespaces are created within their specified parent. Note that this
+ * flag's value must not conflict with the values of the flags
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, and FIND_ONLY_NS (defined in
+ * tclNamesp.c).
+ */
+
+#define CREATE_NS_IF_UNKNOWN 0x800
+
+/*
+ *----------------------------------------------------------------
  * Data structures related to variables.   These are used primarily
  * in tclVar.c
  *----------------------------------------------------------------
@@ -116,7 +224,7 @@ typedef struct ArraySearch {
     Tcl_HashSearch search;	/* Info kept by the hash module about
 				 * progress through the array. */
     Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element
-				 * to be enumerated (it's leftover from
+			 	 * to be enumerated (it's leftover from
 				 * the Tcl_FirstHashEntry call or from
 				 * an "array anymore" command).  NULL
 				 * means must call Tcl_NextHashEntry
@@ -128,124 +236,245 @@ typedef struct ArraySearch {
 
 /*
  * The structure below defines a variable, which associates a string name
- * with a string value.  Pointers to these structures are kept as the
- * values of hash table entries, and the name of each variable is stored
- * in the hash entry.
+ * with a Tcl_Obj value. These structures are kept in procedure call frames
+ * (for local variables recognized by the compiler) or in the heap (for
+ * global variables and any variable not known to the compiler). For each
+ * Var structure in the heap, a hash table entry holds the variable name and
+ * a pointer to the Var structure.
  */
 
 typedef struct Var {
-    int valueLength;		/* Holds the number of non-null bytes
-				 * actually occupied by the variable's
-				 * current value in value.string (extra
-				 * space is sometimes left for expansion).
-				 * For array and global variables this is
-				 * meaningless. */
-    int valueSpace;		/* Total number of bytes of space allocated
-				 * at value.string.  0 means there is no
-				 * space allocated. */
     union {
-	char *string;		/* String value of variable, used for scalar
-				 * variables and array elements.  Malloc-ed. */
+	Tcl_Obj *objPtr;	/* The variable's object value. Used for 
+				 * scalar variables and array elements. */
 	Tcl_HashTable *tablePtr;/* For array variables, this points to
 				 * information about the hash table used
 				 * to implement the associative array. 
 				 * Points to malloc-ed data. */
-	struct Var *upvarPtr;	/* If this is a global variable being
+	struct Var *linkPtr;	/* If this is a global variable being
 				 * referred to in a procedure, or a variable
 				 * created by "upvar", this field points to
-				 * the record for the higher-level variable. */
+				 * the referenced variable's Var struct. */
     } value;
-    Tcl_HashEntry *hPtr;	/* Hash table entry that refers to this
-				 * variable, or NULL if the variable has
-				 * been detached from its hash table (e.g.
-				 * an array is deleted, but some of its
-				 * elements are still referred to in upvars). */
+    char *name;			/* NULL if the variable is in a hashtable,
+				 * otherwise points to the variable's
+				 * name. It is used, e.g., by TclLookupVar
+				 * and "info locals". The storage for the
+				 * characters of the name is not owned by
+				 * the Var and must not be freed when
+				 * freeing the Var. */
+    Namespace *nsPtr;		/* Points to the namespace that contains
+				 * this variable or NULL if the variable is
+				 * a local variable in a Tcl procedure. */
+    Tcl_HashEntry *hPtr;	/* If variable is in a hashtable, either the
+				 * hash table entry that refers to this
+				 * variable or NULL if the variable has been
+				 * detached from its hash table (e.g. an
+				 * array is deleted, but some of its
+				 * elements are still referred to in
+				 * upvars). NULL if the variable is not in a
+				 * hashtable. This is used to delete an
+				 * variable from its hashtable if it is no
+				 * longer needed. */
     int refCount;		/* Counts number of active uses of this
-				 * variable, not including its main hash
-				 * table entry: 1 for each additional variable
-				 * whose upVarPtr points here, 1 for each
-				 * nested trace active on variable.  This
-				 * record can't be deleted until refCount
-				 * becomes 0. */
+				 * variable, not including its entry in the
+				 * call frame or the hash table: 1 for each
+				 * additional variable whose linkPtr points
+				 * here, 1 for each nested trace active on
+				 * variable. This record can't be deleted
+				 * until refCount becomes 0. */
     VarTrace *tracePtr;		/* First in list of all traces set for this
 				 * variable. */
     ArraySearch *searchPtr;	/* First in list of all searches active
 				 * for this variable, or NULL if none. */
     int flags;			/* Miscellaneous bits of information about
-				 * variable.  See below for definitions. */
+				 * variable. See below for definitions. */
 } Var;
 
 /*
- * Flag bits for variables:
+ * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and
+ * VAR_LINK) are mutually exclusive and give the "type" of the variable.
+ * VAR_UNDEFINED is independent of the variable's type. 
  *
- * VAR_ARRAY	-		1 means this is an array variable rather
- *				than a scalar variable.
- * VAR_UPVAR - 			1 means this variable just contains a
- *				pointer to another variable that has the
- *				real value.  Variables like this come
- *				about through the "upvar" and "global"
- *				commands.
- * VAR_UNDEFINED -		1 means that the variable is currently
- *				undefined.  Undefined variables usually
- *				go away completely, but if an undefined
- *				variable has a trace on it, or if it is
- *				a global variable being used by a procedure,
- *				then it stays around even when undefined.
+ * VAR_SCALAR -			1 means this is a scalar variable and not
+ *				an array or link. The "objPtr" field points
+ *				to the variable's value, a Tcl object.
+ * VAR_ARRAY -			1 means this is an array variable rather
+ *				than a scalar variable or link. The
+ *				"tablePtr" field points to the array's
+ *				hashtable for its elements.
+ * VAR_LINK - 			1 means this Var structure contains a
+ *				pointer to another Var structure that
+ *				either has the real value or is itself
+ *				another VAR_LINK pointer. Variables like
+ *				this come about through "upvar" and "global"
+ *				commands, or through references to variables
+ *				in enclosing namespaces.
+ * VAR_UNDEFINED -		1 means that the variable is in the process
+ *				of being deleted. An undefined variable
+ *				logically does not exist and survives only
+ *				while it has a trace, or if it is a global
+ *				variable currently being used by some
+ *				procedure.
+ * VAR_IN_HASHTABLE -		1 means this variable is in a hashtable and
+ *				the Var structure is malloced. 0 if it is
+ *				a local variable that was assigned a slot
+ *				in a procedure frame by	the compiler so the
+ *				Var storage is part of the call frame.
  * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
  *				underway for a read or write access, so
  *				new read or write accesses should not cause
  *				trace procedures to be called and the
  *				variable can't be deleted.
+ * VAR_ARRAY_ELEMENT -		1 means that this variable is an array
+ *				element, so it is not legal for it to be
+ *				an array itself (the VAR_ARRAY flag had
+ *				better not be set).
+ */
+
+#define VAR_SCALAR		0x1
+#define VAR_ARRAY		0x2
+#define VAR_LINK		0x4
+#define VAR_UNDEFINED	        0x8
+#define VAR_IN_HASHTABLE	0x10
+#define VAR_TRACE_ACTIVE	0x20
+#define VAR_ARRAY_ELEMENT	0x40
+
+/*
+ * Macros to ensure that various flag bits are set properly for variables.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclSetVarScalar _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarArray _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarLink _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarArrayElement _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclSetVarUndefined _ANSI_ARGS_((Var *varPtr));
+ * EXTERN void	TclClearVarUndefined _ANSI_ARGS_((Var *varPtr));
  */
 
-#define VAR_ARRAY		1
-#define VAR_UPVAR		2
-#define VAR_UNDEFINED		4
-#define VAR_TRACE_ACTIVE	0x10
+#define TclSetVarScalar(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
+
+#define TclSetVarArray(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
+
+#define TclSetVarLink(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
+
+#define TclSetVarArrayElement(varPtr) \
+    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
+
+#define TclSetVarUndefined(varPtr) \
+    (varPtr)->flags |= VAR_UNDEFINED
+
+#define TclClearVarUndefined(varPtr) \
+    (varPtr)->flags &= ~VAR_UNDEFINED
+
+/*
+ * Macros to read various flag bits of variables.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int	TclIsVarScalar _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarLink _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarArray _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarUndefined _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarArrayElement _ANSI_ARGS_((Var *varPtr));
+ */
+    
+#define TclIsVarScalar(varPtr) \
+    ((varPtr)->flags & VAR_SCALAR)
+
+#define TclIsVarLink(varPtr) \
+    ((varPtr)->flags & VAR_LINK)
+
+#define TclIsVarArray(varPtr) \
+    ((varPtr)->flags & VAR_ARRAY)
+
+#define TclIsVarUndefined(varPtr) \
+    ((varPtr)->flags & VAR_UNDEFINED)
+
+#define TclIsVarArrayElement(varPtr) \
+    ((varPtr)->flags & VAR_ARRAY_ELEMENT)
 
 /*
  *----------------------------------------------------------------
- * Data structures related to procedures.   These are used primarily
- * in tclProc.c
+ * Data structures related to procedures.  These are used primarily
+ * in tclProc.c, tclCompile.c, and tclExecute.c.
  *----------------------------------------------------------------
  */
 
 /*
- * The structure below defines an argument to a procedure, which
- * consists of a name and an (optional) default value.
+ * The variable-length structure below describes a local variable of a
+ * procedure that was recognized by the compiler. These variables have a
+ * name, an element in the array of compiler-assigned local variables in the
+ * procedure's call frame, and various other items of information. If the
+ * local variable is a formal argument, it may also have a default value.
+ * The compiler can't recognize local variables whose names are
+ * expressions (these names are only known at runtime when the expressions
+ * are evaluated) or local variables that are created as a result of an
+ * "upvar" or "uplevel" command. These other local variables are kept
+ * separately in a hash table in the call frame.
  */
 
-typedef struct Arg {
-    struct Arg *nextPtr;	/* Next argument for this procedure,
-				 * or NULL if this is the last argument. */
-    char *defValue;		/* Pointer to arg's default value, or NULL
-				 * if no default value. */
-    char name[4];		/* Name of argument starts here.  The name
-				 * is followed by space for the default,
-				 * if there is one.  The actual size of this
-				 * field will be as large as necessary to
-				 * hold both name and default value.  THIS
-				 * MUST BE THE LAST FIELD IN THE STRUCTURE!! */
-} Arg;
+typedef struct CompiledLocal {
+    struct CompiledLocal *nextPtr;
+				/* Next compiler-recognized local variable
+				 * for this procedure, or NULL if this is
+				 * the last local. */
+    int nameLength;		/* The number of characters in local
+				 * variable's name. Used to speed up
+				 * variable lookups. */
+    int frameIndex;		/* Index in the array of compiler-assigned
+				 * variables in the procedure call frame. */
+    int isArg;			/* 1 if the local variable is a formal
+				 * argument. */
+    int isTemp;			/* 1 if the local variable is an anonymous
+				 * temporary variable. Temporaries have
+				 * a NULL name. */
+    int flags;			/* Flag bits for the local variable. Same as
+				 * the flags for the Var structure above,
+				 * although only VAR_SCALAR, VAR_ARRAY, and
+				 * VAR_LINK make sense. */
+    Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
+				 * argument, if any. NULL if not an argument
+				 * or, if an argument, no default value. */
+    char name[4];		/* Name of the local variable starts here.
+				 * If the name is NULL, this will just be
+				 * '\0'. The actual size of this field will
+				 * be large enough to hold the name. MUST
+				 * BE THE LAST FIELD IN THE STRUCTURE! */
+} CompiledLocal;
 
 /*
- * The structure below defines a command procedure, which consists of
- * a collection of Tcl commands plus information about arguments and
- * variables.
+ * The structure below defines a command procedure, which consists of a
+ * collection of Tcl commands plus information about arguments and other
+ * local variables recognized at compile time.
  */
 
 typedef struct Proc {
-    struct Interp *iPtr;	/* Interpreter for which this command
-				 * is defined. */
-    int refCount;		/* Reference count:  1 if still present
-				 * in command table plus 1 for each call
-				 * to the procedure that is currently
-				 * active.  This structure can be freed
-				 * when refCount becomes zero. */
-    char *command;		/* Command that constitutes the body of
-				 * the procedure (dynamically allocated). */
-    Arg *argPtr;		/* Pointer to first of procedure's formal
-				 * arguments, or NULL if none. */
+    struct Interp *iPtr;	  /* Interpreter for which this command
+				   * is defined. */
+    int refCount;		  /* Reference count: 1 if still present
+				   * in command table plus 1 for each call
+				   * to the procedure that is currently
+				   * active. This structure can be freed
+				   * when refCount becomes zero. */
+    Namespace *nsPtr;		  /* Points to the namespace that contains
+				   * this procedure. */
+    Tcl_Obj *bodyPtr;		  /* Points to the ByteCode object for
+				   * procedure's body command. */
+    int numArgs;		  /* Number of formal parameters. */
+    int numCompiledLocals;	  /* Count of local variables recognized by
+				   * the compiler including arguments and
+				   * temporaries. */
+    CompiledLocal *firstLocalPtr; /* Pointer to first of the procedure's
+				   * compiler-allocated local variables, or
+				   * NULL if none. The first numArgs entries
+				   * in this list describe the procedure's
+				   * formal arguments. */
+    CompiledLocal *lastLocalPtr;  /* Pointer to the last allocated local
+				   * variable or NULL if none. This has
+				   * frame index (numCompiledLocals-1). */
 } Proc;
 
 /*
@@ -274,35 +503,73 @@ typedef struct AssocData {
 } AssocData;    
 
 /*
- * The structure below defines a frame, which is a procedure invocation.
- * These structures exist only while procedures are being executed, and
- * provide a sort of call stack.
+ * The structure below defines a call frame. A call frame defines a naming
+ * context for a procedure call: its local naming scope (for local
+ * variables) and its global naming scope (a namespace, perhaps the global
+ * :: namespace). A call frame can also define the naming context for a
+ * namespace eval or namespace inscope command: the namespace in which the
+ * command's code should execute. The Tcl_CallFrame structures exist only
+ * while procedures or namespace eval/inscope's are being executed, and
+ * provide a kind of Tcl call stack.
+ * 
+ * WARNING!! The structure definition must be kept consistent with the
+ * Tcl_CallFrame structure in tcl.h. If you change one, change the other.
  */
 
 typedef struct CallFrame {
-    Tcl_HashTable varTable;	/* Hash table containing all of procedure's
-				 * local variables. */
-    int level;			/* Level of this procedure, for "uplevel"
-				 * purposes (i.e. corresponds to nesting of
-				 * callerVarPtr's, not callerPtr's).  1 means
-				 * outer-most procedure, 0 means top-level. */
-    int argc;			/* This and argv below describe name and
-				 * arguments for this procedure invocation. */
-    char **argv;		/* Array of arguments. */
+    Namespace *nsPtr;		/* Points to the namespace used to resolve
+				 * commands and global variables. */
+    int isProcCallFrame;	/* If nonzero, the frame was pushed to
+				 * execute a Tcl procedure and may have
+				 * local vars. If 0, the frame was pushed
+				 * to execute a namespace command and var
+				 * references are treated as references to
+				 * namespace vars; varTablePtr and
+				 * compiledLocals are ignored. */
+    int objc;			/* This and objv below describe the
+				 * arguments for this procedure call. */
+    Tcl_Obj *CONST *objv;	/* Array of argument objects. */
     struct CallFrame *callerPtr;
 				/* Value of interp->framePtr when this
-				 * procedure was invoked (i.e. next in
-				 * stack of all active procedures). */
+				 * procedure was invoked (i.e. next higher
+				 * in stack of all active procedures). */
     struct CallFrame *callerVarPtr;
 				/* Value of interp->varFramePtr when this
 				 * procedure was invoked (i.e. determines
-				 * variable scoping within caller;  same
+				 * variable scoping within caller). Same
 				 * as callerPtr unless an "uplevel" command
 				 * or something equivalent was active in
 				 * the caller). */
+    int level;			/* Level of this procedure, for "uplevel"
+				 * purposes (i.e. corresponds to nesting of
+				 * callerVarPtr's, not callerPtr's). 1 for
+				 * outermost procedure, 0 for top-level. */
+    Proc *procPtr;		/* Points to the structure defining the
+				 * called procedure. Used to get information
+				 * such as the number of compiled local
+				 * variables (local variables assigned
+				 * entries ["slots"] in the compiledLocals
+				 * array below). */
+    Tcl_HashTable *varTablePtr;	/* Hash table containing local variables not
+				 * recognized by the compiler, or created at
+				 * execution time through, e.g., upvar.
+				 * Initially NULL and created if needed. */
+    int numCompiledLocals;	/* Count of local variables recognized by
+				 * the compiler including arguments. */
+    Var* compiledLocals;	/* Points to the array of local variables
+				 * recognized by the compiler. The compiler
+				 * emits code that refers to these variables
+				 * using an index into this array. */
 } CallFrame;
 
 /*
+ *----------------------------------------------------------------
+ * Data structures related to history.   These are used primarily
+ * in tclHistory.c
+ *----------------------------------------------------------------
+ */
+
+/*
  * The structure below defines one history event (a previously-executed
  * command that can be re-executed in whole or in part).
  */
@@ -315,13 +582,6 @@ typedef struct {
 } HistoryEvent;
 
 /*
- *----------------------------------------------------------------
- * Data structures related to history.   These are used primarily
- * in tclHistory.c
- *----------------------------------------------------------------
- */
-
-/*
  * The structure below defines a pending revision to the most recent
  * history event.  Changes are linked together into a list and applied
  * during the next call to Tcl_RecordHistory.  See the comments at the
@@ -354,49 +614,174 @@ typedef struct HistoryRev {
 
 #define MAX_MATH_ARGS 5
 typedef struct MathFunc {
+    int builtinFuncIndex;	/* If this is a builtin math function, its
+				 * index in the array of builtin functions.
+				 * (tclCompilation.h lists these indices.)
+				 * The value is -1 if this is a new function
+				 * defined by Tcl_CreateMathFunc. The value
+				 * is also -1 if a builtin function is
+				 * replaced by a Tcl_CreateMathFunc call. */
     int numArgs;		/* Number of arguments for function. */
     Tcl_ValueType argTypes[MAX_MATH_ARGS];
 				/* Acceptable types for each argument. */
-    Tcl_MathProc *proc;		/* Procedure that implements this function. */
-    ClientData clientData;	/* Additional argument to pass to the function
-				 * when invoking it. */
+    Tcl_MathProc *proc;		/* Procedure that implements this function.
+				 * NULL if isBuiltinFunc is 1. */
+    ClientData clientData;	/* Additional argument to pass to the
+				 * function when invoking it. NULL if
+				 * isBuiltinFunc is 1. */
 } MathFunc;
 
 /*
  *----------------------------------------------------------------
- * One of the following structures exists for each command in
- * an interpreter.  The Tcl_Command opaque type actually refers
- * to these structures.
+ * Data structures related to bytecode compilation and execution.
+ * These are used primarily in tclCompile.c, tclExecute.c, and
+ * tclBasic.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Forward declaration to prevent an error when the forward reference to
+ * CompileEnv is encountered in the procedure type CompileProc declared
+ * below.
+ */
+
+struct CompileEnv;
+
+/*
+ * The type of procedures called by the Tcl bytecode compiler to compile
+ * commands. Pointers to these procedures are kept in the Command structure
+ * describing each command. When a CompileProc returns, the interpreter's
+ * result is set to error information, if any. In addition, the CompileProc
+ * returns an integer value, which is one of the following:
+ *
+ * TCL_OK		Compilation completed normally.
+ * TCL_ERROR		Compilation failed because of an error;
+ *			the interpreter's result describes what went wrong.
+ * TCL_OUT_LINE_COMPILE	Compilation failed because, e.g., the command is
+ *			too complex for effective inline compilation. The
+ *			CompileProc believes the command is legal but 
+ *			should be compiled "out of line" by emitting code
+ *			to invoke its command procedure at runtime.
+ */
+
+#define TCL_OUT_LINE_COMPILE	(TCL_CONTINUE + 1)
+
+typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, char *string,
+	char *lastChar, int compileFlags, struct CompileEnv *compEnvPtr));
+
+/*
+ * The data structure defining the execution environment for ByteCode's.
+ * There is one ExecEnv structure per Tcl interpreter. It holds the
+ * evaluation stack that holds command operands and results. The stack grows
+ * towards increasing addresses. The "stackTop" member is cached by
+ * TclExecuteByteCode in a local variable: it must be set before calling
+ * TclExecuteByteCode and will be restored by TclExecuteByteCode before it
+ * returns.
+ */
+
+typedef union StackItem {
+    Tcl_Obj *o;			/* Stack item as a pointer to a Tcl_Obj. */
+    int      i;			/* Stack item as an integer. */
+    VOID    *p;			/* Stack item as an arbitrary pointer. */
+} StackItem;
+
+typedef struct ExecEnv {
+    StackItem *stackPtr;	/* Points to the first item in the
+				 * evaluation stack on the heap. */
+    int stackTop;		/* Index of current top of stack; -1 when
+				 * the stack is empty. */
+    int stackEnd;		/* Index of last usable item in stack. */
+} ExecEnv;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to commands.
  *----------------------------------------------------------------
  */
 
+/*
+ * Forward declaration to prevent an error when the forward reference to
+ * Command is encountered in the ImportRef type declared below.
+ */
+
+struct Command;
+
+/*
+ * An imported command is created in an namespace when it imports a "real"
+ * command from another namespace. An imported command has a Command
+ * structure that points (via its ClientData value) to the "real" Command
+ * structure in the source namespace's command table. The real command
+ * records all the imported commands that refer to it in a list of ImportRef
+ * structures so that they can be deleted when the real command is deleted.  */
+
+typedef struct ImportRef {
+    struct Command *importedCmdPtr;
+    				/* Points to the imported command created in
+				 * an importing namespace; this command
+				 * redirects its invocations to the "real"
+				 * command. */
+    struct ImportRef *nextPtr;	/* Next element on the linked list of
+				 * imported commands that refer to the
+				 * "real" command. The real command deletes
+				 * these imported commands on this list when
+				 * it is deleted. */
+} ImportRef;
+
+/*
+ * A Command structure exists for each command in a namespace. The
+ * Tcl_Command opaque type actually refers to these structures.
+ */
+
 typedef struct Command {
-    Tcl_HashEntry *hPtr;	/* Pointer to the hash table entry in
-				 * interp->commandTable that refers to
-				 * this command.  Used to get a command's
-				 * name from its Tcl_Command handle.  NULL
-				 * means that the hash table entry has
-				 * been removed already (this can happen
-				 * if deleteProc causes the command to be
+    Tcl_HashEntry *hPtr;	/* Pointer to the hash table entry that
+				 * refers to this command. The hash table is
+				 * either a namespace's command table or an
+				 * interpreter's hidden command table. This
+				 * pointer is used to get a command's name
+				 * from its Tcl_Command handle. NULL means
+				 * that the hash table entry has been
+				 * removed already (this can happen if
+				 * deleteProc causes the command to be
 				 * deleted or recreated). */
-    Tcl_CmdProc *proc;		/* Procedure to process command. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
-    Tcl_CmdDeleteProc *deleteProc;
-				/* Procedure to invoke when deleting
+    Namespace *nsPtr;		/* Points to the namespace containing this
 				 * command. */
-    ClientData deleteData;	/* Arbitrary value to pass to deleteProc
-				 * (usually the same as clientData). */
+    int refCount;		/* 1 if in command hashtable plus 1 for each
+				 * reference from a CmdName Tcl object
+				 * representing a command's name in a
+				 * ByteCode instruction sequence. This
+				 * structure can be freed when refCount
+				 * becomes zero. */
+    int cmdEpoch;		/* Incremented to invalidate any references
+                                 * that point to this command when it is
+				 * renamed, deleted, hidden, or exposed. */
+    CompileProc *compileProc;   /* Procedure called to compile command. NULL
+				 * if no compile proc exists for command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
+    ClientData objClientData;	/* Arbitrary value passed to object proc. */
+    Tcl_CmdProc *proc;		/* String-based command procedure. */
+    ClientData clientData;	/* Arbitrary value passed to string proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* Procedure invoked when deleting command
+				 * to, e.g., free all client data. */
+    ClientData deleteData;	/* Arbitrary value passed to deleteProc. */
     int deleted;		/* Means that the command is in the process
 				 * of being deleted (its deleteProc is
-				 * currently executing).  Any other attempts
-				 * to delete the command should be ignored. */
+				 * currently executing). Other attempts to
+				 * delete the command should be ignored. */
+    ImportRef *importRefPtr;	/* List of each imported Command created in
+				 * another namespace when this command is
+				 * imported. These imported commands
+				 * redirect invocations back to this
+				 * command. The list is used to remove all
+				 * those imported commands when deleting
+				 * this "real" command. */
 } Command;
 
 /*
  *----------------------------------------------------------------
  * This structure defines an interpreter, which is a collection of
  * commands plus other state information related to interpreting
- * commands, such as variable storage.  Primary responsibility for
+ * commands, such as variable storage. Primary responsibility for
  * this data structure is in tclBasic.c, but almost every Tcl
  * source file uses something in here.
  *----------------------------------------------------------------
@@ -408,40 +793,50 @@ typedef struct Interp {
      * Note:  the first three fields must match exactly the fields in
      * a Tcl_Interp struct (see tcl.h).  If you change one, be sure to
      * change the other.
+     *
+     * The interpreter's result is held in both the string and the
+     * objResultPtr fields. These fields hold, respectively, the result's
+     * string or object value. The interpreter's result is always in the
+     * result field if that is non-empty, otherwise it is in objResultPtr.
+     * The two fields are kept consistent unless some C code sets
+     * interp->result directly. Programs should not access result and
+     * objResultPtr directly; instead, they should always get and set the
+     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult,
+     * and Tcl_GetStringResult. See the SetResult man page for details.
      */
 
-    char *result;		/* Points to result returned by last
-				 * command. */
-    Tcl_FreeProc *freeProc;	/* Zero means result is statically allocated.
-				 * TCL_DYNAMIC means result was allocated with
-				 * ckalloc and should be freed with ckfree.
-				 * Other values give address of procedure
-				 * to invoke to free the result.  Must be
-				 * freed by Tcl_Eval before executing next
-				 * command. */
+    char *result;               /* If the last command returned a string
+				 * result, this points to it. Should not be
+				 * accessed directly; see comment above. */
+    Tcl_FreeProc *freeProc;     /* Zero means a string result is statically
+                                 * allocated. TCL_DYNAMIC means string
+                                 * result was allocated with ckalloc and
+                                 * should be freed with ckfree. Other values
+                                 * give address of procedure to invoke to
+                                 * free the string result. Tcl_Eval must
+                                 * free it before executing next command. */
     int errorLine;		/* When TCL_ERROR is returned, this gives
-				 * the line number within the command where
-				 * the error occurred (1 means first line). */
-    Tcl_HashTable commandTable;	/* Contains all of the commands currently
-				 * registered in this interpreter.  Indexed
-				 * by strings; values have type (Command *). */
-    Tcl_HashTable mathFuncTable;/* Contains all of the math functions currently
+				 * the line number in the command where the
+				 * error occurred (1 means first line). */
+    Tcl_Obj *objResultPtr;	/* If the last command returned an object
+				 * result, this points to it. Should not be
+				 * accessed directly; see comment above. */
+    Namespace *globalNsPtr;     /* The interpreter's global namespace. */
+    Tcl_HashTable mathFuncTable;/* Contains all the math functions currently
 				 * defined for the interpreter.  Indexed by
-				 * strings (function names);  values have
+				 * strings (function names); values have
 				 * type (MathFunc *). */
 
     /*
-     * Information related to procedures and variables.  See tclProc.c
+     * Information related to procedures and variables. See tclProc.c
      * and tclvar.c for usage.
      */
 
-    Tcl_HashTable globalTable;	/* Contains all global variables for
-				 * interpreter. */
     int numLevels;		/* Keeps track of how many nested calls to
 				 * Tcl_Eval are in progress for this
 				 * interpreter.  It's used to delay deletion
-				 * of the table until all Tcl_Eval invocations
-				 * are completed. */
+				 * of the table until all Tcl_Eval
+				 * invocations are completed. */
     int maxNestingDepth;	/* If numLevels exceeds this value then Tcl
 				 * assumes that infinite recursion has
 				 * occurred and it generates an error. */
@@ -450,14 +845,14 @@ typedef struct Interp {
 				 * are no active procedures. */
     CallFrame *varFramePtr;	/* Points to the call frame whose variables
 				 * are currently in use (same as framePtr
-				 * unless an "uplevel" command is being
-				 * executed).  NULL means no procedure is
-				 * active or "uplevel 0" is being exec'ed. */
+				 * unless an "uplevel" command is
+				 * executing). NULL means no procedure is
+				 * active or "uplevel 0" is executing. */
     ActiveVarTrace *activeTracePtr;
-				/* First in list of active traces for interp,
-				 * or NULL if no active traces. */
+				/* First in list of active traces for
+				 * interp, or NULL if no active traces. */
     int returnCode;		/* Completion code to return if current
-				 * procedure exits with a TCL_RETURN code. */
+				 * procedure exits with TCL_RETURN code. */
     char *errorInfo;		/* Value to store in errorInfo if returnCode
 				 * is TCL_ERROR.  Malloc'ed, may be NULL */
     char *errorCode;		/* Value to store in errorCode if returnCode
@@ -481,11 +876,11 @@ typedef struct Interp {
     int revDisables;		/* 0 means history revision OK;  > 0 gives
 				 * a count of number of times revision has
 				 * been disabled. */
-    char *evalFirst;		/* If TCL_RECORD_BOUNDS flag set, Tcl_Eval
-				 * sets this field to point to the first
-				 * char. of text from which the current
-				 * command came.  Otherwise Tcl_Eval sets
-				 * this to NULL. */
+    char *evalFirst;		/* If TCL_RECORD_BOUNDS Tcl_Eval and
+				 * Tcl_EvalObj set this field to point to
+				 * the first char. of text from which the
+				 * current command came. Otherwise set to
+				 * NULL. */
     char *evalLast;		/* Similar to evalFirst, except points to
 				 * last character of current command. */
 
@@ -533,43 +928,47 @@ typedef struct Interp {
 				 * Malloc'ed, may be NULL. */
 
     /*
-     * Information used by Tcl_PrintDouble:
-     */
-
-    char pdFormat[10];		/* Format string used by Tcl_PrintDouble. */
-    int pdPrec;			/* Current precision (used to restore the
-				 * the tcl_precision variable after a bogus
-				 * value has been put into it). */
-
-    /*
      * Miscellaneous information:
      */
 
     int cmdCount;		/* Total number of times a command procedure
 				 * has been called for this interpreter. */
-    int noEval;			/* Non-zero means no commands should actually
-				 * be executed:  just parse only.  Used in
-				 * expressions when the result is already
-				 * determined. */
     int evalFlags;		/* Flags to control next call to Tcl_Eval.
 				 * Normally zero, but may be set before
 				 * calling Tcl_Eval.  See below for valid
 				 * values. */
-    char *termPtr;		/* Character just after the last one in
-				 * a command.  Set by Tcl_Eval before
-				 * returning. */
+    int termOffset;		/* Offset of character just after last one
+				 * compiled or executed by Tcl_EvalObj. */
+    int compileEpoch;		/* Holds the current "compilation epoch"
+				 * for this interpreter. This is
+				 * incremented to invalidate existing
+				 * ByteCodes when, e.g., a command with a
+				 * compile procedure is redefined. */
+    Proc *compiledProcPtr;	/* If a procedure is being compiled, a
+				 * pointer to its Proc structure; otherwise,
+				 * this is NULL. Set by ObjInterpProc in
+				 * tclProc.c and used by tclCompile.c to
+				 * process local variables appropriately. */
     char *scriptFile;		/* NULL means there is no nested source
 				 * command active;  otherwise this points to
 				 * the name of the file being sourced (it's
 				 * not malloc-ed:  it points to an argument
 				 * to Tcl_EvalFile. */
     int flags;			/* Various flag bits.  See below. */
+    long randSeed;		/* Seed used for rand() function. */
     Trace *tracePtr;		/* List of traces for this interpreter. */
     Tcl_HashTable *assocData;	/* Hash table for associating data with
                                  * this interpreter. Cleaned up when
                                  * this interpreter is deleted. */
+    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
+                                 * execution. Contains a pointer to the
+				 * Tcl evaluation stack. */
+    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
+				 * string. Returned by Tcl_ObjSetVar2 when
+				 * variable traces change a variable in a
+				 * gross way. */
     char resultSpace[TCL_RESULT_SIZE+1];
-				/* Static space for storing small results. */
+				/* Static space holding small results. */
 } Interp;
 
 /*
@@ -586,9 +985,9 @@ typedef struct Interp {
  *			codes other than these should be turned into errors.
  */
 
-#define TCL_BRACKET_TERM	1
-#define TCL_RECORD_BOUNDS	2
-#define TCL_ALLOW_EXCEPTIONS	4
+#define TCL_BRACKET_TERM	  1
+#define TCL_RECORD_BOUNDS	  2
+#define TCL_ALLOW_EXCEPTIONS	  4
 
 /*
  * Flag bits for Interp structures:
@@ -597,9 +996,9 @@ typedef struct Interp {
  *			don't process any more commands for it, and destroy
  *			the structure as soon as all nested invocations of
  *			Tcl_Eval are done.
- * ERR_IN_PROGRESS:	Non-zero means an error unwind is already in progress.
- *			Zero means a command proc has been invoked since last
- *			error occured.
+ * ERR_IN_PROGRESS:	Non-zero means an error unwind is already in
+ *			progress. Zero means a command proc has been
+ *			invoked since last error occured.
  * ERR_ALREADY_LOGGED:	Non-zero means information has already been logged
  *			in $errorInfo for the current Tcl_Eval instance,
  *			so Tcl_Eval needn't log it (used to implement the
@@ -608,26 +1007,28 @@ typedef struct Interp {
  *			called to record information for the current
  *			error.  Zero means Tcl_Eval must clear the
  *			errorCode variable if an error is returned.
- * EXPR_INITIALIZED:	1 means initialization specific to expressions has
- *			been carried out.
- */
-
-#define DELETED			1
-#define ERR_IN_PROGRESS		2
-#define ERR_ALREADY_LOGGED	4
-#define ERROR_CODE_SET		8
-#define EXPR_INITIALIZED	0x10
-
-/*
- * Default value for the pdPrec and pdFormat fields of interpreters:
+ * EXPR_INITIALIZED:	Non-zero means initialization specific to
+ *			expressions has	been carried out.
+ * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler
+ *			should not compile any commands into an inline
+ *			sequence of instructions. This is set 1, for
+ *			example, when command traces are requested.
+ * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the
+ *			interp has not be initialized.  This is set 1
+ *			when we first use the rand() or srand() functions.
  */
 
-#define DEFAULT_PD_PREC 6
-#define DEFAULT_PD_FORMAT "%g"
+#define DELETED			 1
+#define ERR_IN_PROGRESS		 2
+#define ERR_ALREADY_LOGGED	 4
+#define ERROR_CODE_SET		 8
+#define EXPR_INITIALIZED	 0x10
+#define DONT_COMPILE_CMDS_INLINE 0x20
+#define RAND_SEED_INITIALIZED	 0x40
 
 /*
  *----------------------------------------------------------------
- * Data structures related to command parsing.   These are used in
+ * Data structures related to command parsing. These are used in
  * tclParse.c and its clients.
  *----------------------------------------------------------------
  */
@@ -659,37 +1060,44 @@ typedef struct ParseValue {
  * A table used to classify input characters to assist in parsing
  * Tcl commands.  The table should be indexed with a signed character
  * using the CHAR_TYPE macro.  The character may have a negative
- * value.
+ * value.  The CHAR_TYPE macro takes a pointer to a signed character
+ * and a pointer to the last character in the source string.  If the
+ * src pointer is pointing at the terminating null of the string,
+ * CHAR_TYPE returns TCL_COMMAND_END.
  */
 
-extern char tclTypeTable[];
-#define CHAR_TYPE(c) (tclTypeTable+128)[c]
+extern unsigned char tclTypeTable[];
+#define CHAR_TYPE(src,last) \
+	(((src)==(last))?TCL_COMMAND_END:(tclTypeTable+128)[*(src)])
 
 /*
- * Possible values returned by CHAR_TYPE:
+ * Possible values returned by CHAR_TYPE. Note that except for TCL_DOLLAR,
+ * these are all one byte values with a single bit set 1. This means these
+ * values may be bit-or'ed together (except for TCL_DOLLAR) to quickly test
+ * whether a character is one of several different kinds of characters.
  *
  * TCL_NORMAL -		All characters that don't have special significance
  *			to the Tcl language.
  * TCL_SPACE -		Character is space, tab, or return.
- * TCL_COMMAND_END -	Character is newline or null or semicolon or
- *			close-bracket.
+ * TCL_COMMAND_END -	Character is newline or semicolon or close-bracket
+ *			or terminating null.
  * TCL_QUOTE -		Character is a double-quote.
  * TCL_OPEN_BRACKET -	Character is a "[".
  * TCL_OPEN_BRACE -	Character is a "{".
  * TCL_CLOSE_BRACE -	Character is a "}".
  * TCL_BACKSLASH -	Character is a "\".
- * TCL_DOLLAR -		Character is a "$".
+ * TCL_DOLLAR - 	Character is a "$".
  */
 
-#define TCL_NORMAL		0
-#define TCL_SPACE		1
-#define TCL_COMMAND_END		2
-#define TCL_QUOTE		3
-#define TCL_OPEN_BRACKET	4
-#define TCL_OPEN_BRACE		5
-#define TCL_CLOSE_BRACE		6
-#define TCL_BACKSLASH		7
-#define TCL_DOLLAR		8
+#define TCL_NORMAL		0x01
+#define TCL_SPACE		0x02
+#define TCL_COMMAND_END		0x04
+#define TCL_QUOTE		0x08
+#define TCL_OPEN_BRACKET	0x10
+#define TCL_OPEN_BRACE		0x20
+#define TCL_CLOSE_BRACE		0x40
+#define TCL_BACKSLASH		0x80
+#define TCL_DOLLAR		0x00
 
 /*
  * Maximum number of levels of nesting permitted in Tcl commands (used
@@ -707,33 +1115,18 @@ extern char tclTypeTable[];
 #define UCHAR(c) ((unsigned char) (c))
 
 /*
- * Given a size or address, the macro below "aligns" it to the machine's
- * memory unit size (e.g. an 8-byte boundary) so that anything can be
- * placed at the aligned address without fear of an alignment error.
- */
-
-#define TCL_ALIGN(x) ((x + 7) & ~7)
-
-/*
- * For each event source (created with Tcl_CreateEventSource) there
- * is a structure of the following type:
+ * This macro is used to determine the offset needed to safely allocate any
+ * data structure in memory. Given a starting offset or size, it "rounds up"
+ * or "aligns" the offset to the next 8-byte boundary so that any data
+ * structure can be placed at the resulting offset without fear of an
+ * alignment error.
+ *
+ * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce
+ * the wrong result on platforms that allocate addresses that are divisible
+ * by 4 or 2. Only use it for offsets or sizes.
  */
 
-typedef struct TclEventSource {
-    Tcl_EventSetupProc *setupProc;	/* This procedure is called by
-					 * Tcl_DoOneEvent to set up information
-					 * for the wait operation, such as
-					 * files to wait for or maximum
-					 * timeout. */
-    Tcl_EventCheckProc *checkProc;	/* This procedure is called by
-					 * Tcl_DoOneEvent after its wait
-					 * operation to see what events
-					 * are ready and queue them. */
-    ClientData clientData;		/* Arbitrary one-word argument to pass
-					 * to setupProc and checkProc. */
-    struct TclEventSource *nextPtr;	/* Next in list of all event sources
-					 * defined for applicaton. */
-} TclEventSource;
+#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
 
 /*
  * The following macros are used to specify the runtime platform
@@ -747,20 +1140,107 @@ typedef enum {
 } TclPlatformType;
 
 /*
+ * Flags for TclInvoke:
+ *
+ * TCL_INVOKE_HIDDEN		Invoke a hidden command; if not set,
+ *				invokes an exposed command.
+ * TCL_INVOKE_NO_UNKNOWN	If set, "unknown" is not invoked if
+ *				the command to be invoked is not found.
+ *				Only has an effect if invoking an exposed
+ *				command, i.e. if TCL_INVOKE_HIDDEN is not
+ *				also set.
+ */
+
+#define	TCL_INVOKE_HIDDEN	(1<<0)
+#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
+
+/*
+ * The structure used as the internal representation of Tcl list
+ * objects. This is an array of pointers to the element objects. This array
+ * is grown (reallocated and copied) as necessary to hold all the list's
+ * element pointers. The array might contain more slots than currently used
+ * to hold all element pointers. This is done to make append operations
+ * faster.
+ */
+
+typedef struct List {
+    int maxElemCount;		/* Total number of element array slots. */
+    int elemCount;		/* Current number of list elements. */
+    Tcl_Obj **elements;		/* Array of pointers to element objects. */
+} List;
+
+/*
+ * The following types are used for getting and storing platform-specific
+ * file attributes in tclFCmd.c and the various platform-versions of
+ * that file. This is done to have as much common code as possible
+ * in the file attributes code. For more information about the callbacks,
+ * see TclFileAttrsCmd in tclFCmd.c.
+ */
+
+typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	int objIndex, char *fileName, 
+	Tcl_Obj **attrObjPtrPtr));
+typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	int objIndex, char *fileName, 
+	Tcl_Obj *attrObjPtr));
+
+typedef struct TclFileAttrProcs {
+    TclGetFileAttrProc *getProc; 	/* The procedure for getting attrs. */
+    TclSetFileAttrProc *setProc;	/* The procedure for setting attrs. */
+} TclFileAttrProcs;
+
+/*
+ * Opaque handle used in pipeline routines to encapsulate platform-dependent
+ * state. 
+ */
+
+typedef struct TclFile_ *TclFile;
+    
+/*
  *----------------------------------------------------------------
- * Variables shared among Tcl modules but not used by the outside
- * world:
+ * Variables shared among Tcl modules but not used by the outside world.
  *----------------------------------------------------------------
  */
 
 extern Tcl_Time			tclBlockTime;
 extern int			tclBlockTimeSet;
 extern char *			tclExecutableName;
-extern TclEventSource *		tclFirstEventSourcePtr;
 extern Tcl_ChannelType	 	tclFileChannelType;
 extern char *			tclMemDumpFileName;
 extern TclPlatformType		tclPlatform;
-extern int			tclInInterpreterDeletion;
+extern char *			tclpFileAttrStrings[];
+extern CONST TclFileAttrProcs   tclpFileAttrProcs[];
+
+/*
+ * Variables denoting the Tcl object types defined in the core.
+ */
+
+extern Tcl_ObjType	tclBooleanType;
+extern Tcl_ObjType	tclByteCodeType;
+extern Tcl_ObjType	tclDoubleType;
+extern Tcl_ObjType	tclIntType;
+extern Tcl_ObjType	tclListType;
+extern Tcl_ObjType	tclStringType;
+
+/*
+ * The head of the list of free Tcl objects, and the total number of Tcl
+ * objects ever allocated and freed.
+ */
+
+extern Tcl_Obj *	tclFreeObjList;
+
+#ifdef TCL_COMPILE_STATS
+extern long 		tclObjsAlloced;
+extern long 		tclObjsFreed;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * Pointer to a heap-allocated string of length zero that the Tcl core uses
+ * as the value of an empty string representation for an object. This value
+ * is shared by all new objects allocated by Tcl_NewObj.
+ */
+
+extern char *		tclEmptyStringRep;
 
 /*
  *----------------------------------------------------------------
@@ -769,84 +1249,185 @@ extern int			tclInInterpreterDeletion;
  *----------------------------------------------------------------
  */
 
-EXTERN void		panic();
+EXTERN void		panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+EXTERN void		TclAllocateFreeObjects _ANSI_ARGS_((void));
+EXTERN int		TclChdir _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *dirName));
 EXTERN int		TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
-		            int numPids, int *pidPtr, Tcl_Channel errorChan));
-EXTERN int		TclCloseFile _ANSI_ARGS_((Tcl_File file));
+		            int numPids, Tcl_Pid *pidPtr,
+			    Tcl_Channel errorChan));
+EXTERN void		TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
 EXTERN char *		TclConvertToNative _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *name, Tcl_DString *bufferPtr));
 EXTERN char *		TclConvertToNetwork _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *name, Tcl_DString *bufferPtr));
-EXTERN void		TclCopyAndCollapse _ANSI_ARGS_((int count, char *src,
-			    char *dst));
-EXTERN int		TclChdir _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *dirName));
-EXTERN void		TclClosePipeFile _ANSI_ARGS_((Tcl_File file));
-EXTERN Tcl_Channel	TclCreateCommandChannel _ANSI_ARGS_((
-    			    Tcl_File readFile, Tcl_File writeFile,
-			    Tcl_File errorFile, int numPids, int *pidPtr));
-EXTERN int              TclCreatePipe _ANSI_ARGS_((Tcl_File *readPipe,
-			    Tcl_File *writePipe));
+EXTERN int		TclCopyAndCollapse _ANSI_ARGS_((int count,
+			    char *src, char *dst));
+EXTERN int		TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Channel inChan, Tcl_Channel outChan,
+			    int toRead, Tcl_Obj *cmdPtr));
+/*
+ * TclCreatePipeline unofficially exported for use by BLT.
+ */
 EXTERN int		TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
-			    int argc, char **argv, int **pidArrayPtr,
-			    Tcl_File *inPipePtr,
-			    Tcl_File *outPipePtr,
-			    Tcl_File *errFilePtr));
-EXTERN Tcl_File		TclCreateTempFile _ANSI_ARGS_((char *contents));
+			    int argc, char **argv, Tcl_Pid **pidArrayPtr,
+			    TclFile *inPipePtr, TclFile *outPipePtr,
+			    TclFile *errFilePtr));
+EXTERN int		TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+			    Namespace *nsPtr, char *procName,
+			    Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
+			    Proc **procPtrPtr));
+EXTERN void		TclDeleteCompiledLocalVars _ANSI_ARGS_((
+    			    Interp *iPtr, CallFrame *framePtr));
 EXTERN void		TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
 			    Tcl_HashTable *tablePtr));
 EXTERN int		TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *separators, Tcl_DString *headPtr,
 			    char *tail));
+EXTERN void		TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
 EXTERN void		TclExpandParseValue _ANSI_ARGS_((ParseValue *pvPtr,
 			    int needed));
 EXTERN void		TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
 			    double value));
+EXTERN int		TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+EXTERN int		TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp, 
+			    int argc, char **argv)) ;
+EXTERN int 		TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv));
+EXTERN int		TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv)) ;
+EXTERN int		TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv)) ;
+EXTERN void		TclFinalizeCompExecEnv _ANSI_ARGS_((void));
+EXTERN void		TclFinalizeExecEnv _ANSI_ARGS_((void));
 EXTERN int		TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *list, char **elementPtr, char **nextPtr,
-			    int *sizePtr, int *bracePtr));
-EXTERN Tcl_Channel	TclFindFileChannel _ANSI_ARGS_((Tcl_File inFile,
-		            Tcl_File outFile, int *fileUsedPtr));
+			    char *list, int listLength, char **elementPtr,
+			    char **nextPtr, int *sizePtr, int *bracePtr));
 EXTERN Proc *		TclFindProc _ANSI_ARGS_((Interp *iPtr,
 			    char *procName));
+EXTERN int		TclFormatInt _ANSI_ARGS_((char *buffer, long n));
 EXTERN void		TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr));
-EXTERN char *		TclGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN char *		TclGetExtension _ANSI_ARGS_((char *name));
 EXTERN void		TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
 		            Tcl_Channel chan));
+EXTERN char *		TclGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int		TclGetDate _ANSI_ARGS_((char *p,
 			    unsigned long now, long zone,
 			    unsigned long *timePtr));
 EXTERN Tcl_Channel	TclGetDefaultStdChannel _ANSI_ARGS_((int type));
+EXTERN Tcl_Obj *	TclGetElementOfIndexedArray _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    Tcl_Obj *elemPtr, int leaveErrorMsg));
 EXTERN char *		TclGetEnv _ANSI_ARGS_((char *name));
+EXTERN char *		TclGetExtension _ANSI_ARGS_((char *name));
 EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, CallFrame **framePtrPtr));
-EXTERN int		TclGetListIndex _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *string, int *indexPtr));
-EXTERN int		TclGetLoadedPackages _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *targetName));
+EXTERN int		TclGetIdleGeneration _ANSI_ARGS_((void));
+EXTERN int		TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, int endValue, int *indexPtr));
+EXTERN Tcl_Obj *	TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
+			    int localIndex, int leaveErrorMsg));
+EXTERN int		TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, long *longPtr));
+EXTERN int		TclGetLoadedPackages _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *targetName));
+EXTERN int		TclGetNamespaceForQualName _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *qualName,
+			    Namespace *cxtNsPtr, int flags,
+			    Namespace **nsPtrPtr, Namespace **altNsPtrPtr,
+			    Namespace **actualCxtPtrPtr,
+			    char **simpleNamePtr));
 EXTERN int		TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
         		    char *string, int *seekFlagPtr));
+EXTERN Tcl_Command	TclGetOriginalCommand _ANSI_ARGS_((
+			    Tcl_Command command));
 EXTERN char *		TclGetUserHome _ANSI_ARGS_((char *name,
 			    Tcl_DString *bufferPtr));
+EXTERN int		TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+		            int argc, char **argv, int flags));
 EXTERN int		TclGuessPackageName _ANSI_ARGS_((char *fileName,
 			    Tcl_DString *bufPtr));
 EXTERN int              TclHasPipes _ANSI_ARGS_((void));
 EXTERN int		TclHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclHideUnsafeCommands _ANSI_ARGS_((
+    			    Tcl_Interp *interp));
 EXTERN int		TclIdlePending _ANSI_ARGS_((void));
+EXTERN int		TclInExit _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	TclIncrElementOfIndexedArray _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    Tcl_Obj *elemPtr, long incrAmount));
+EXTERN Tcl_Obj *	TclIncrIndexedScalar _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    long incrAmount));
+EXTERN Tcl_Obj *	TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    long incrAmount, int part1NotParsed));
+EXTERN void		TclInitNamespaces _ANSI_ARGS_((void));
 EXTERN int		TclInterpInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+		            int argc, char **argv, int flags));
+EXTERN int		TclInvokeObjectCommand _ANSI_ARGS_((
+                            ClientData clientData, Tcl_Interp *interp,
+                            int argc, char **argv));
+EXTERN int		TclInvokeStringCommand _ANSI_ARGS_((
+                            ClientData clientData, Tcl_Interp *interp,
+                            int objc, Tcl_Obj *CONST objv[]));
 EXTERN Proc *		TclIsProc _ANSI_ARGS_((Command *cmdPtr));
 EXTERN int		TclLoadFile _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *fileName, char *sym1, char *sym2,
 			    Tcl_PackageInitProc **proc1Ptr,
 			    Tcl_PackageInitProc **proc2Ptr));
+EXTERN int		TclLooksLikeInt _ANSI_ARGS_((char *p));
+EXTERN Var *		TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags, char *msg,
+			    int createPart1, int createPart2,
+			    Var **arrayPtrPtr));
 EXTERN int		TclMakeFileTable _ANSI_ARGS_((Tcl_Interp *interp,
                             int noStdio));
 EXTERN int		TclMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *separators, Tcl_DString *dirPtr,
 			    char *pattern, char *tail));
 EXTERN int		TclNeedSpace _ANSI_ARGS_((char *start, char *end));
-EXTERN Tcl_File		TclOpenFile _ANSI_ARGS_((char *fname, int mode));
+EXTERN int		TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
+		    	    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+EXTERN int		TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+		            int objc, Tcl_Obj *CONST objv[], int flags));
+EXTERN int		TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
+		            int objc, Tcl_Obj *CONST objv[], int flags));
+EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
+EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
+EXTERN int		TclpCopyFile _ANSI_ARGS_((char *source, char *dest));
+EXTERN int              TclpCopyDirectory _ANSI_ARGS_((char *source,
+			    char *dest, Tcl_DString *errorPtr));
+EXTERN Tcl_Channel	TclpCreateCommandChannel _ANSI_ARGS_((
+    			    TclFile readFile, TclFile writeFile,
+			    TclFile errorFile, int numPids, Tcl_Pid *pidPtr));
+EXTERN int              TclpCreateDirectory _ANSI_ARGS_((char *path));
+EXTERN int              TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
+			    TclFile *writePipe));
+EXTERN int		TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
+			    int argc, char **argv, TclFile inputFile, 
+			    TclFile outputFile, TclFile errorFile,
+			    Tcl_Pid *pidPtr));
+EXTERN TclFile		TclpCreateTempFile _ANSI_ARGS_((char *contents, 
+			    Tcl_DString *namePtr));
+EXTERN int              TclpDeleteFile _ANSI_ARGS_((char *path));
+EXTERN void		TclpFree _ANSI_ARGS_((char *ptr));
+EXTERN unsigned long	TclpGetClicks _ANSI_ARGS_((void));
+EXTERN unsigned long	TclpGetSeconds _ANSI_ARGS_((void));
+EXTERN void		TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
+EXTERN int		TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
+EXTERN char *		TclpGetTZName _ANSI_ARGS_((void));
+EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
+			    int direction));
+EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((char *fname, int mode));
+EXTERN int		TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN char *		TclpRealloc _ANSI_ARGS_((char *ptr,
+			    unsigned int size));
+EXTERN int              TclpRemoveDirectory _ANSI_ARGS_((char *path,
+			    int recursive, Tcl_DString *errorPtr));
+EXTERN int              TclpRenameFile _ANSI_ARGS_((char *source, char *dest));
 EXTERN int		TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, char **termPtr, ParseValue *pvPtr));
 EXTERN int		TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
@@ -855,51 +1436,38 @@ EXTERN int		TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
 EXTERN int		TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, int termChar, int flags,
 			    char **termPtr, ParseValue *pvPtr));
-EXTERN int		TclParseWords _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *string, int flags, int maxWords,
-			    char **termPtr, int *argcPtr, char **argv,
-			    ParseValue *pvPtr));
-EXTERN unsigned long	TclpGetClicks _ANSI_ARGS_((void));
-EXTERN unsigned long	TclpGetSeconds _ANSI_ARGS_((void));
-EXTERN void		TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
-EXTERN int		TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
-EXTERN char *		TclpGetTZName _ANSI_ARGS_((void));
 EXTERN void		TclPlatformExit _ANSI_ARGS_((int status));
 EXTERN void		TclPlatformInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN char *		TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, char *name1, char *name2,
-			    int flags));
 EXTERN int		TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
-		            Tcl_Interp *cmdInterp, char *cmdName,
-                            Tcl_CmdProc *proc, ClientData clientData));
-EXTERN int		TclReadFile _ANSI_ARGS_((Tcl_File file,
-			    int shouldBlock, char *buf, int toRead));
-EXTERN int		TclSeekFile _ANSI_ARGS_((Tcl_File file,
-			    int offset, int whence));
+		            Tcl_Interp *cmdInterp, Tcl_Command cmd));
+EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Obj *objPtr));
+EXTERN int		TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *oldName, char *newName)) ;
+EXTERN void		TclResetShadowedCmdRefs _ANSI_ARGS_((
+			    Tcl_Interp *interp, Command *newCmdPtr));
 EXTERN int		TclServiceIdle _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	TclSetElementOfIndexedArray _ANSI_ARGS_((
+                            Tcl_Interp *interp, int localIndex,
+			    Tcl_Obj *elemPtr, Tcl_Obj *objPtr,
+			    int leaveErrorMsg));
+EXTERN Tcl_Obj *	TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
+			    int localIndex, Tcl_Obj *objPtr,
+			    int leaveErrorMsg));
 EXTERN void		TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int		TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
 		            char *string, char *proto, int *portPtr));
 EXTERN int		TclSockMinimumBuffers _ANSI_ARGS_((int sock,
         		    int size));
-EXTERN int              TclSpawnPipeline _ANSI_ARGS_((Tcl_Interp *interp,
-	                    int *pidPtr, int *numPids, int argc, char **argv,
-			    Tcl_File inputFile,
-			    Tcl_File outputFile,
-	                    Tcl_File errorFile,
-	                    char *intIn, char *finalOut));
+EXTERN void		TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
 EXTERN int		TclTestChannelCmd _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int		TclTestChannelEventCmd _ANSI_ARGS_((
     			    ClientData clientData, Tcl_Interp *interp,
                             int argc, char **argv));
 EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
-EXTERN int		TclWaitForFile _ANSI_ARGS_((Tcl_File file,
-			    int mask, int timeout));
-EXTERN char *		TclWordEnd _ANSI_ARGS_((char *start, int nested,
-			    int *semiPtr));
-EXTERN int		TclWriteFile _ANSI_ARGS_((Tcl_File file,
-			    int shouldBlock, char *buf, int toWrite));
+EXTERN char *		TclWordEnd _ANSI_ARGS_((char *start, char *lastChar,
+			    int nested, int *semiPtr));
 
 /*
  *----------------------------------------------------------------
@@ -909,62 +1477,62 @@ EXTERN int		TclWriteFile _ANSI_ARGS_((Tcl_File file,
 
 EXTERN int	Tcl_AfterCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_AppendCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ArrayCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_AppendObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ArrayObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_BinaryObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_BreakCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_CaseCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_CatchCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_CaseObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_CatchObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_CdCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ClockCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ClockObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_CloseCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ConcatCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ConcatObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_ContinueCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_CpCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_EofCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ErrorCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_EvalCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ErrorObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_EvalObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_ExecCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ExitCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ExprCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ExitObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ExprObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_FblockedCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_FconfigureCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_FileCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_FcopyObjCmd _ANSI_ARGS_((ClientData dummy,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_FileObjCmd _ANSI_ARGS_((ClientData dummy,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_FileEventCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_FlushCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_FlushObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_ForCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ForeachCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ForeachObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_FormatCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_GetsCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_GlobalCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_GetsObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_GlobalObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_GlobCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_HistoryCmd _ANSI_ARGS_((ClientData clientData,
@@ -973,68 +1541,56 @@ EXTERN int	Tcl_IfCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_IncrCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_InfoCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_InterpCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_JoinCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LappendCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LindexCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LinsertCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LlengthCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ListCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_InfoObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_InterpObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LindexObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LinsertObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LlengthObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ListObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_LoadCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LrangeCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LreplaceCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_LsCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LsearchCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_LsortCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_MacBeepCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_MacSourceCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_MkdirCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_MvCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_OpenCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_PackageCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_PidCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ProcCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_PutsCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_PidObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_PutsObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_PwdCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ReadCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_ReadObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_RegexpCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_RegsubCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_RenameCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_ReturnCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_RmCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int 	Tcl_RmdirCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_RenameObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ReturnObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_ScanCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_SeekCmd _ANSI_ARGS_((ClientData clientData,
@@ -1045,33 +1601,310 @@ EXTERN int	Tcl_SplitCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_SocketCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_SourceCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_StringCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_StringObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_SubstCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_SwitchCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SwitchObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_TellCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_TimeCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_TraceCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_UnsetCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_UpdateCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_UplevelCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	Tcl_UpvarCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_UplevelObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_UpvarObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_VariableObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_VwaitCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
 EXTERN int	Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
-EXTERN int	TclUnsupported0Cmd _ANSI_ARGS_((ClientData clientData,
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures found only in the Mac version of the core:
+ *----------------------------------------------------------------
+ */
+
+#ifdef MAC_TCL
+EXTERN int 	Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int 	Tcl_LsCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int 	Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int 	Tcl_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+#endif
+
+/*
+ *----------------------------------------------------------------
+ * Compilation procedures for commands in the generic core:
+ *----------------------------------------------------------------
+ */
+
+EXTERN int	TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *string, char *lastChar, int compileFlags,
+		    struct CompileEnv *compileEnvPtr));
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to create and release Tcl objects.
+ * TclNewObj(objPtr) creates a new object denoting an empty string.
+ * TclDecrRefCount(objPtr) decrements the object's reference count,
+ * and frees the object if its reference count is zero.
+ * These macros are inline versions of Tcl_NewObj() and
+ * Tcl_DecrRefCount(). Notice that the names differ in not having
+ * a "_" after the "Tcl". Notice also that these macros reference
+ * their argument more than once, so you should avoid calling them
+ * with an expression that is expensive to compute or has
+ * side effects. The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN void	TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+ * EXTERN void	TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+ *----------------------------------------------------------------
+ */
+
+#ifdef TCL_COMPILE_STATS
+#  define TclIncrObjsAllocated() \
+    tclObjsAlloced++
+#  define TclIncrObjsFreed() \
+    tclObjsFreed++
+#else
+#  define TclIncrObjsAllocated()
+#  define TclIncrObjsFreed()
+#endif /* TCL_COMPILE_STATS */
+
+#ifdef TCL_MEM_DEBUG
+#  define TclNewObj(objPtr) \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->length   = 0; \
+    (objPtr)->typePtr  = NULL; \
+    TclIncrObjsAllocated()
+#  define TclDbNewObj(objPtr, file, line) \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->length   = 0; \
+    (objPtr)->typePtr  = NULL; \
+    TclIncrObjsAllocated()
+#  define TclDecrRefCount(objPtr) \
+    if (--(objPtr)->refCount <= 0) { \
+ 	if ((objPtr)->refCount < -1) \
+            panic("Reference count for %lx was negative: %s line %d", \
+		  (objPtr), __FILE__, __LINE__); \
+        if (((objPtr)->bytes != NULL) \
+	        && ((objPtr)->bytes != tclEmptyStringRep)) { \
+	    ckfree((char *) (objPtr)->bytes); \
+        } \
+        if (((objPtr)->typePtr != NULL) \
+	        && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
+        } \
+        ckfree((char *) (objPtr)); \
+        TclIncrObjsFreed(); \
+    }
+#else /* not TCL_MEM_DEBUG */
+#  define TclNewObj(objPtr) \
+    if (tclFreeObjList == NULL) { \
+	TclAllocateFreeObjects(); \
+    } \
+    (objPtr) = tclFreeObjList; \
+    tclFreeObjList = (Tcl_Obj *) \
+	tclFreeObjList->internalRep.otherValuePtr; \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->length   = 0; \
+    (objPtr)->typePtr  = NULL; \
+    TclIncrObjsAllocated()
+#  define TclDecrRefCount(objPtr) \
+    if (--(objPtr)->refCount <= 0) { \
+        if (((objPtr)->bytes != NULL) \
+	        && ((objPtr)->bytes != tclEmptyStringRep)) { \
+	    ckfree((char *) (objPtr)->bytes); \
+        } \
+        if (((objPtr)->typePtr != NULL) \
+	        && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
+        } \
+        (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
+        tclFreeObjList = (objPtr); \
+        TclIncrObjsFreed(); \
+    }
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to set a Tcl_Obj's string representation
+ * to a copy of the "len" bytes starting at "bytePtr". This code
+ * works even if the byte array contains NULLs as long as the length
+ * is correct. Because "len" is referenced multiple times, it should
+ * be as simple an expression as possible. The ANSI C "prototype" for
+ * this macro is:
+ *
+ * EXTERN void	TclInitStringRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ *		    char *bytePtr, int len));
+ *----------------------------------------------------------------
+ */
+
+#define TclInitStringRep(objPtr, bytePtr, len) \
+    if ((len) == 0) { \
+        (objPtr)->bytes  = tclEmptyStringRep; \
+	(objPtr)->length = 0; \
+    } else { \
+	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
+	memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
+	        (unsigned) (len)); \
+	(objPtr)->bytes[len] = '\0'; \
+	(objPtr)->length = (len); \
+    }
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to get the string representation's
+ * byte array pointer and length from a Tcl_Obj. This is an inline
+ * version of Tcl_GetStringFromObj(). "lengthPtr" must be the
+ * address of an integer variable or NULL; If non-NULL, that variable
+ * will be set to the string rep's length. The macro's expression
+ * result is the string rep's byte pointer which might be NULL.
+ * Note that the bytes referenced by this pointer must not be modified
+ * by the caller. The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN char *  TclGetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+ *		       int *lengthPtr));
+ *----------------------------------------------------------------
+ */
+
+#define TclGetStringFromObj(objPtr, lengthPtr) \
+    ((objPtr)->bytes? \
+        ((lengthPtr)? \
+	    ((*(lengthPtr) = (objPtr)->length), (objPtr)->bytes) : \
+	    (objPtr)->bytes) : \
+        Tcl_GetStringFromObj((objPtr), (lengthPtr)))
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to reset an interpreter's Tcl object
+ * result to an unshared empty string object with ref count one.
+ * This does not clear any error information for the interpreter.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void	TclResetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
+ *---------------------------------------------------------------
+ */
+
+#define TclResetObjResult(interp) \
+    { \
+        register Tcl_Obj *objResultPtr = ((Interp *) interp)->objResultPtr; \
+        if (Tcl_IsShared(objResultPtr)) { \
+	    TclDecrRefCount(objResultPtr); \
+	    TclNewObj(objResultPtr); \
+	    Tcl_IncrRefCount(objResultPtr); \
+	    ((Interp *) interp)->objResultPtr = objResultPtr; \
+        } else { \
+	    if ((objResultPtr->bytes != NULL) \
+		    && (objResultPtr->bytes != tclEmptyStringRep)) { \
+	        ckfree((char *) objResultPtr->bytes); \
+	    } \
+	    objResultPtr->bytes  = tclEmptyStringRep; \
+	    objResultPtr->length = 0; \
+	    if ((objResultPtr->typePtr != NULL) \
+	            && (objResultPtr->typePtr->freeIntRepProc != NULL)) { \
+	        objResultPtr->typePtr->freeIntRepProc(objResultPtr); \
+	    } \
+	    objResultPtr->typePtr = (Tcl_ObjType *) NULL; \
+        } \
+    }
+
+/*
+ *----------------------------------------------------------------
+ * Procedures used in conjunction with Tcl namespaces. They are
+ * defined here instead of in tcl.h since they are not stable yet.
+ *----------------------------------------------------------------
+ */
+
+EXTERN int		Tcl_AppendExportList _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+			    Tcl_Obj *objPtr));
+EXTERN Tcl_Namespace *	Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, ClientData clientData,
+			    Tcl_NamespaceDeleteProc *deleteProc));
+EXTERN void		Tcl_DeleteNamespace _ANSI_ARGS_((
+			    Tcl_Namespace *nsPtr));
+EXTERN int		Tcl_Export _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Namespace *nsPtr, char *pattern,
+			    int resetListFirst));
+EXTERN Tcl_Command	Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tcl_Namespace *contextNsPtr,
+			    int flags));
+EXTERN Tcl_Namespace *	Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, Tcl_Namespace *contextNsPtr,
+			    int flags));
+EXTERN Tcl_Var		Tcl_FindNamespaceVar _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *name,
+			    Tcl_Namespace *contextNsPtr, int flags));
+EXTERN int		Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Namespace *nsPtr, char *pattern));
+EXTERN Tcl_Command	Tcl_GetCommandFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr));
+EXTERN void		Tcl_GetCommandFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Command command,
+			    Tcl_Obj *objPtr));
+EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Var variable,
+			    Tcl_Obj *objPtr));
+EXTERN int		Tcl_Import _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Namespace *nsPtr, char *pattern,
+			    int allowOverwrite));
+EXTERN void		Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp));
+EXTERN int		Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp,
+			    Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr,
+			    int isProcCallFrame)); 
 
 #endif /* _TCLINT */
+
diff --git a/contrib/tcl/generic/tclInterp.c b/contrib/tcl/generic/tclInterp.c
index d2b7f1a..e9ad76a 100644
--- a/contrib/tcl/generic/tclInterp.c
+++ b/contrib/tcl/generic/tclInterp.c
@@ -4,12 +4,12 @@
  *	This file implements the "interp" command which allows creation
  *	and manipulation of Tcl interpreters from within Tcl scripts.
  *
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclInterp.c 1.73 96/06/11 18:14:22
+ * SCCS: @(#) tclInterp.c 1.115 97/06/19 18:06:39
  */
 
 #include <stdio.h>
@@ -17,6 +17,20 @@
 #include "tclPort.h"
 
 /*
+ * Tcl script to make an interpreter safe.
+ */
+
+static char makeSafeScript[] =
+"if {[info exists env(DISPLAY)]} {\n\
+    set ___x___ $env(DISPLAY)\n\
+}\n\
+unset env\n\
+if {[info exists ___x___]} {\n\
+    set env(DISPLAY) $___x___\n\
+    unset ___x___\n\
+}";
+
+/*
  * Counter for how many aliases were created (global)
  */
 
@@ -57,8 +71,8 @@ typedef struct {
     char	*aliasName;	/* Name of alias command. */
     char	*targetName;	/* Name of target command in master interp. */
     Tcl_Interp	*targetInterp;	/* Master interpreter. */
-    int		argc;		/* Count of additional args to pass. */
-    char	**argv;		/* Actual additional args to pass. */    
+    int		objc;		/* Count of additional args to pass. */
+    Tcl_Obj	**objv;		/* Actual additional args to pass. */
     Tcl_HashEntry *aliasEntry;	/* Entry for the alias hash table in slave.
                                  * This is used by alias deletion to remove
                                  * the alias from the slave interpreter
@@ -123,71 +137,112 @@ typedef struct {
  */
 
 static int		AliasCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *currentInterp, int argc, char **argv));
+			    Tcl_Interp *currentInterp, int objc,
+		            Tcl_Obj *CONST objv[]));
 static void		AliasCmdDeleteProc _ANSI_ARGS_((
 			    ClientData clientData));
-static int		AliasHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
+static int		AliasCreationHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
 			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
 			    Master *masterPtr, char *aliasName,
-			    char *targetName, int argc, char **argv));
+			    char *targetName, int objc,
+			    Tcl_Obj *CONST objv[]));
 static int		CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
-			   int argc, char **argv));
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
 static Tcl_Interp	*CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *slavePath, int safe));
+		            Master *masterPtr, char *slavePath, int safe));
 static int		DeleteAlias _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, char *aliasName));
 static int		DescribeAlias _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, char *aliasName));
 static int		DeleteInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
-			    int argc, char **argv));
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
 static int		DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
-		            char *path));
+			    Master *masterPtr, char *path));
 static Tcl_Interp	*GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
 			    Master *masterPtr, char *path,
 			    Master **masterPtrPtr));
 static int		GetTarget _ANSI_ARGS_((Tcl_Interp *interp, char *path,
 			    char *aliasName));
+static int		InterpAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpExistsHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpIsSafeHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpInvokeHiddenHelper _ANSI_ARGS_((
+    			    Tcl_Interp *interp, Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpMarkTrustedHelper _ANSI_ARGS_((
+    			    Tcl_Interp *interp, Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpSlavesHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpShareHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		InterpTargetHelper _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		MarkTrusted _ANSI_ARGS_((Tcl_Interp *interp));
 static void		MasterRecordDeleteProc _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp));
-static int		MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
 static int		SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
-			    int argc, char **argv));
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveIsSafeHelper _ANSI_ARGS_((
+    			    Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+                            Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveInvokeHiddenHelper _ANSI_ARGS_((
+    			    Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+                            Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
+static int		SlaveMarkTrustedHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Interp *slaveInterp, Slave *slavePtr,
+		            int objc, Tcl_Obj *CONST objv[]));
 static int		SlaveObjectCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, char **argv));
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
 static void		SlaveObjectDeleteProc _ANSI_ARGS_((
 			    ClientData clientData));
 static void		SlaveRecordDeleteProc _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp));
 
 /*
- * These are all the Tcl core commands which are available in a safe
- * interpeter:
- */
-
-static char *TclCommandsToKeep[] = {
-    "after", "append", "array",
-    "break",
-    "case", "catch", "clock", "close", "concat", "continue",
-    "eof", "error", "eval", "expr",
-    "fblocked", "fileevent", "flush", "for", "foreach", "format",
-    "gets", "global",
-    "history",
-    "if", "incr", "info", "interp",
-    "join",
-    "lappend", "lindex", "linsert", "list", "llength",
-    "lower", "lrange", "lreplace", "lsearch", "lsort",
-    "package", "pid", "proc", "puts",
-    "read", "regexp", "regsub", "rename", "return",
-    "scan", "seek", "set", "split", "string", "subst", "switch",
-    "tell", "time", "trace",
-    "unset", "unsupported0", "update", "uplevel", "upvar",
-    "vwait",
-    "while",
-    NULL};
-static int TclCommandsToKeepCt =
-	(sizeof (TclCommandsToKeep) / sizeof (char *)) -1 ;
-
-/*
  *----------------------------------------------------------------------
  *
  * TclPreventAliasLoop --
@@ -196,40 +251,38 @@ static int TclCommandsToKeepCt =
  *	loop from being formed.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
- *	If TCL_ERROR is returned, the function also sets interp->result
- *	to an error message.
+ *	If TCL_ERROR is returned, the function also stores an error message
+ *	in the interpreter's result object.
  *
  * NOTE:
  *	This function is public internal (instead of being static to
- *	this file) because it is also used from Tcl_RenameCmd.
+ *	this file) because it is also used from TclRenameCommand.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclPreventAliasLoop(interp, cmdInterp, cmdName, proc, clientData)
+TclPreventAliasLoop(interp, cmdInterp, cmd)
     Tcl_Interp *interp;			/* Interp in which to report errors. */
     Tcl_Interp *cmdInterp;		/* Interp in which the command is
                                          * being defined. */
-    char *cmdName;			/* Name of Tcl command we are
-                                         * attempting to define. */
-    Tcl_CmdProc *proc;			/* The command procedure for the
-                                         * command being created. */
-    ClientData clientData;		/* The client data associated with the
-                                         * command to be created. */
+    Tcl_Command cmd;                    /* Tcl command we are attempting
+                                         * to define. */
 {
+    Command *cmdPtr = (Command *) cmd;
     Alias *aliasPtr, *nextAliasPtr;
-    Tcl_CmdInfo cmdInfo;
+    Tcl_Command aliasCmd;
+    Command *aliasCmdPtr;
     
     /*
      * If we are not creating or renaming an alias, then it is
      * always OK to create or rename the command.
      */
     
-    if (proc != AliasCmd) {
+    if (cmdPtr->objProc != AliasCmd) {
         return TCL_OK;
     }
 
@@ -239,42 +292,40 @@ TclPreventAliasLoop(interp, cmdInterp, cmdName, proc, clientData)
      * the chain then we have a loop.
      */
 
-    aliasPtr = (Alias *) clientData;
+    aliasPtr = (Alias *) cmdPtr->objClientData;
     nextAliasPtr = aliasPtr;
     while (1) {
 
         /*
-         * If the target of the next alias in the chain is the same as the
-         * source alias, we have a loop.
-         */
-        
-        if ((strcmp(nextAliasPtr->targetName, cmdName) == 0) &&
-                (nextAliasPtr->targetInterp == cmdInterp)) {
-            Tcl_AppendResult(interp, "cannot define or rename alias \"",
-                    aliasPtr->aliasName, "\": would create a loop",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
+         * If the target of the next alias in the chain is the same as
+         * the source alias, we have a loop.
+	 */
 
-        /*
-         * Otherwise, follow the chain one step further. If the target
-         * command is undefined then there is no loop.
-         */
-        
-        if (Tcl_GetCommandInfo(nextAliasPtr->targetInterp,
-                nextAliasPtr->targetName, &cmdInfo) == 0) {
+	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
+                nextAliasPtr->targetName,
+		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
+		/*flags*/ 0);
+        if (aliasCmd == (Tcl_Command) NULL) {
             return TCL_OK;
         }
+	aliasCmdPtr = (Command *) aliasCmd;
+        if (aliasCmdPtr == cmdPtr) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"cannot define or rename alias \"", aliasPtr->aliasName,
+		"\": would create a loop", (char *) NULL);
+            return TCL_ERROR;
+        }
 
         /*
-         * See if the target command is an alias - if so, follow the
-         * loop to its target command. Otherwise we do not have a loop.
-         */
+	 * Otherwise, follow the chain one step further. See if the target
+         * command is an alias - if so, follow the loop to its target
+         * command. Otherwise we do not have a loop.
+	 */
 
-        if (cmdInfo.proc != AliasCmd) {
+        if (aliasCmdPtr->objProc != AliasCmd) {
             return TCL_OK;
         }
-        nextAliasPtr = (Alias *) cmdInfo.clientData;
+        nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
     }
 
     /* NOTREACHED */
@@ -283,67 +334,90 @@ TclPreventAliasLoop(interp, cmdInterp, cmdName, proc, clientData)
 /*
  *----------------------------------------------------------------------
  *
- * MakeSafe --
+ * MarkTrusted --
+ *
+ *	Mark an interpreter as unsafe (i.e. remove the "safe" mark).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Removes the "safe" mark from an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MarkTrusted(interp)
+    Tcl_Interp *interp;		/* Interpreter to be marked unsafe. */
+{
+    Master *masterPtr;		/* Master record for interpreter to
+                                 * be marked unsafe. */
+
+    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
+            NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("MarkTrusted: could not find master record");
+    }
+    masterPtr->isSafe = 0;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeSafe --
  *
  *	Makes its argument interpreter contain only functionality that is
- *	defined to be part of Safe Tcl.
+ *	defined to be part of Safe Tcl. Unsafe commands are hidden, the
+ *	env array is unset, and the standard channels are removed.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Removes commands from its argument interpreter.
+ *	Hides commands in its argument interpreter, and removes settings
+ *	and channels.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-MakeSafe(interp)
+int
+Tcl_MakeSafe(interp)
     Tcl_Interp *interp;		/* Interpreter to be made safe. */
 {
-    char **argv;				/* Args for Tcl_Eval. */
-    int argc, keep, i, j;			/* Loop indices. */
-    char *cmdGetGlobalCmds = "info commands";	/* What command to run. */
-    char *cmdNoEnv = "unset env";		/* How to get rid of env. */
     Master *masterPtr;				/* Master record of interp
                                                  * to be made safe. */
     Tcl_Channel chan;				/* Channel to remove from
                                                  * safe interpreter. */
+    Tcl_Obj *objPtr;
 
-    /*
-     * Below, Tcl_Eval sets interp->result, so we do not.
-     */
-
-    Tcl_ResetResult(interp);
-    if ((Tcl_Eval(interp, cmdGetGlobalCmds) == TCL_ERROR) ||
-            (Tcl_SplitList(interp, interp->result, &argc, &argv) != TCL_OK)) {
-        return TCL_ERROR;
-    }
-    for (i = 0; i < argc; i++) {
-        for (keep = 0, j = 0; j < TclCommandsToKeepCt; j++) {
-            if (strcmp(TclCommandsToKeep[j], argv[i]) == 0) {
-                keep = 1;
-                break;
-            }
-        }
-        if (keep == 0) {
-            (void) Tcl_DeleteCommand(interp, argv[i]);
-        }
-    }
-    ckfree((char *) argv);
+    TclHideUnsafeCommands(interp);
     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
             NULL);
     if (masterPtr == (Master *) NULL) {
         panic("MakeSafe: could not find master record");
     }
     masterPtr->isSafe = 1;
-    if (Tcl_Eval(interp, cmdNoEnv) == TCL_ERROR) {
+    objPtr = Tcl_NewStringObj(makeSafeScript, -1);
+    Tcl_IncrRefCount(objPtr);
+
+    if (Tcl_EvalObj(interp, objPtr) == TCL_ERROR) {
+        Tcl_DecrRefCount(objPtr);
         return TCL_ERROR;
     }
 
+    Tcl_DecrRefCount(objPtr);
+    
     /*
      * Remove the standard channels from the interpreter; safe interpreters
      * do not ordinarily have access to stdin, stdout and stderr.
+     *
+     * NOTE: These channels are not added to the interpreter by the
+     * Tcl_CreateInterp call, but may be added later, by another I/O
+     * operation. We want to ensure that the interpreter does not have
+     * these channels even if it is being made safe after being used for
+     * some time..
      */
 
     chan = Tcl_GetStdChannel(TCL_STDIN);
@@ -392,7 +466,9 @@ GetInterp(interp, masterPtr, path, masterPtrPtr)
     int argc, i;		/* Loop indices. */
     Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */
 
-    if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
+    if (masterPtrPtr != (Master **) NULL) {
+        *masterPtrPtr = masterPtr;
+    }
     
     if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
         return (Tcl_Interp *) NULL;
@@ -443,12 +519,12 @@ GetInterp(interp, masterPtr, path, masterPtrPtr)
  */
 
 static Tcl_Interp *
-CreateSlave(interp, slavePath, safe)
+CreateSlave(interp, masterPtr, slavePath, safe)
     Tcl_Interp *interp;			/* Interp. to start search from. */
+    Master *masterPtr;			/* Master record. */
     char *slavePath;			/* Path (name) of slave to create. */
     int safe;				/* Should we make it "safe"? */
 {
-    Master *masterPtr;			/* Master record. */
     Tcl_Interp *slaveInterp;		/* Ptr to slave interpreter. */
     Tcl_Interp *masterInterp;		/* Ptr to master interp for slave. */
     Slave *slavePtr;			/* Slave record. */
@@ -458,12 +534,6 @@ CreateSlave(interp, slavePath, safe)
     char **argv;			/* Elements in slavePath. */
     char *masterPath;			/* Path to its master. */
 
-    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
-            NULL); 
-    if (masterPtr == (Master *) NULL) {
-        panic("CreatSlave: could not find master record");
-    }
-
     if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
         return (Tcl_Interp *) NULL;
     }
@@ -477,7 +547,8 @@ CreateSlave(interp, slavePath, safe)
         masterPath = Tcl_Merge(argc-1, argv);
         masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
         if (masterInterp == (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "interpreter named \"", masterPath,
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter named \"", masterPath,
                     "\" not found", (char *) NULL);
             ckfree((char *) argv);
             ckfree((char *) masterPath);
@@ -491,7 +562,8 @@ CreateSlave(interp, slavePath, safe)
     }
     hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
     if (new == 0) {
-        Tcl_AppendResult(interp, "interpreter named \"", slavePath,
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", slavePath,
                 "\" already exists, cannot create", (char *) NULL);
         ckfree((char *) argv);
         return (Tcl_Interp *) NULL;
@@ -504,7 +576,7 @@ CreateSlave(interp, slavePath, safe)
     slavePtr->masterInterp = masterInterp;
     slavePtr->slaveEntry = hPtr;
     slavePtr->slaveInterp = slaveInterp;
-    slavePtr->interpCmd = Tcl_CreateCommand(masterInterp, slavePath,
+    slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, slavePath,
             SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
     Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
     (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
@@ -512,28 +584,33 @@ CreateSlave(interp, slavePath, safe)
     Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
     
-    if (((safe) && (MakeSafe(slaveInterp) == TCL_ERROR)) ||
-            ((!safe) && (Tcl_Init(slaveInterp) == TCL_ERROR))) {
-        Tcl_ResetResult(interp);
-        Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
-                NULL, TCL_GLOBAL_ONLY));
-        Tcl_SetVar2(interp, "errorCode", (char *) NULL,
-                Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
-                        TCL_GLOBAL_ONLY),
-                TCL_GLOBAL_ONLY);
-        if (slaveInterp->freeProc != NULL) {
-            interp->result = slaveInterp->result;
-            interp->freeProc = slaveInterp->freeProc;
-            slaveInterp->freeProc = 0;
-        } else {
-            Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
+    if (safe) {
+        if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
+            goto error;
+        }
+    } else {
+        if (Tcl_Init(slaveInterp) == TCL_ERROR) {
+            goto error;
         }
-        Tcl_ResetResult(slaveInterp);
-        (void) Tcl_DeleteCommand(masterInterp, slavePath);
-        slaveInterp = (Tcl_Interp *) NULL;
     }
+
     ckfree((char *) argv);
     return slaveInterp;
+
+error:
+
+    Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
+            NULL, TCL_GLOBAL_ONLY));
+    Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+            Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
+                    TCL_GLOBAL_ONLY),
+            TCL_GLOBAL_ONLY);
+
+    Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+    Tcl_ResetResult(slaveInterp);
+
+    (void) Tcl_DeleteCommand(masterInterp, slavePath);
+    return (Tcl_Interp *) NULL;
 }
 
 /*
@@ -554,48 +631,47 @@ CreateSlave(interp, slavePath, safe)
  */
 
 static int
-CreateInterpObject(interp, argc, argv)
+CreateInterpObject(interp, masterPtr, objc, objv)
     Tcl_Interp *interp;			/* Invoking interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    Master *masterPtr;			/* Master record for same. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* with alias. */
 {
     int safe;				/* Create a safe interpreter? */
-    Master *masterPtr;			/* Master record. */
     int moreFlags;			/* Expecting more flag args? */
+    char *string;			/* Local pointer to object string. */
     char *slavePath;			/* Name of slave. */
     char localSlaveName[200];		/* Local area for creating names. */
     int i;				/* Loop counter. */
-    size_t len;				/* Length of option argument. */
+    int len;				/* Length of option argument. */
     static int interpCounter = 0;	/* Unique id for created names. */
 
-    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL); 
-    if (masterPtr == (Master *) NULL) {
-        panic("CreateInterpObject: could not find master record");
-    }
     moreFlags = 1;
     slavePath = NULL;
     safe = masterPtr->isSafe;
     
-    if (argc < 2 || argc > 5) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " create ?-safe? ?--? ?path?\"", (char *) NULL);
+    if ((objc < 2) || (objc > 5)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "create ?-safe? ?--? ?path?");
         return TCL_ERROR;
     }
-    for (i = 2; i < argc; i++) {
-        len = strlen(argv[i]);
-        if ((argv[i][0] == '-') && (moreFlags != 0)) {
-            if ((argv[i][1] == 's') && (strncmp(argv[i], "-safe", len) == 0)
-                && (len > 1)){
+    for (i = 2; i < objc; i++) {
+        string = Tcl_GetStringFromObj(objv[i], &len);
+        if ((string[0] == '-') && (moreFlags != 0)) {
+            if ((string[1] == 's') &&
+                (strncmp(string, "-safe", (size_t) len) == 0) &&
+                (len > 1)){
                 safe = 1;
-            } else if ((strncmp(argv[i], "--", len) == 0) && (len > 1)) {
+            } else if ((strncmp(string, "--", (size_t) len) == 0) &&
+                       (len > 1)) {
                 moreFlags = 0;
             } else {
-                Tcl_AppendResult(interp, "bad option \"", argv[i],
-                        "\": should be -safe", (char *) NULL);
+                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                        "bad option \"", string, "\": should be -safe",
+                        (char *) NULL);
                 return TCL_ERROR;
             }
         } else {
-            slavePath = argv[i];
+            slavePath = string;
         }
     }
     if (slavePath == (char *) NULL) {
@@ -603,12 +679,12 @@ CreateInterpObject(interp, argc, argv)
         interpCounter++;
         slavePath = localSlaveName;
     }
-    if (CreateSlave(interp, slavePath, safe) != NULL) {
-        Tcl_AppendResult(interp, slavePath, (char *) NULL);
+    if (CreateSlave(interp, masterPtr, slavePath, safe) != NULL) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(slavePath, -1));
         return TCL_OK;
     } else {
         /*
-         * CreateSlave already set interp->result if there was an error,
+         * CreateSlave already set the result if there was an error,
          * so we do not do it here.
          */
         return TCL_ERROR;
@@ -633,11 +709,11 @@ CreateInterpObject(interp, argc, argv)
  */
 
 static int
-DeleteOneInterpObject(interp, path)
+DeleteOneInterpObject(interp, masterPtr, path)
     Tcl_Interp *interp;			/* Interpreter for reporting errors. */
+    Master *masterPtr;			/* Interim storage for master record.*/
     char *path;				/* Path of interpreter to delete. */
 {
-    Master *masterPtr;			/* Interim storage for master record.*/
     Slave *slavePtr;			/* Interim storage for slave record. */
     Tcl_Interp *masterInterp;		/* Master of interp. to delete. */
     Tcl_HashEntry *hPtr;		/* Search element. */
@@ -647,13 +723,9 @@ DeleteOneInterpObject(interp, path)
     char *slaveName;			/* Last component in path. */
     char *masterPath;			/* One-before-last component in path.*/
 
-    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
-    if (masterPtr == (Master *) NULL) {
-        panic("DeleteInterpObject: could not find master record");
-    }
     if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
-        Tcl_AppendResult(interp, "bad interpreter path \"", path,
-                "\"", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "bad interpreter path \"", path, "\"", (char *) NULL);
         return TCL_ERROR;
     }
     if (localArgc < 2) {
@@ -667,8 +739,9 @@ DeleteOneInterpObject(interp, path)
         masterPath = Tcl_Merge(localArgc-1, localArgv);
         masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
         if (masterInterp == (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "interpreter named \"", masterPath,
-                    "\" not found", (char *) NULL);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter named \"", masterPath, "\" not found",
+                    (char *) NULL);
             ckfree((char *) localArgv);
             ckfree((char *) masterPath);
             return TCL_ERROR;
@@ -679,19 +752,19 @@ DeleteOneInterpObject(interp, path)
     hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
     if (hPtr == (Tcl_HashEntry *) NULL) {
         ckfree((char *) localArgv);
-        Tcl_AppendResult(interp, "interpreter named \"", path,
-                "\" not found", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", path, "\" not found", (char *) NULL);
         return TCL_ERROR;
     }
     slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
-    slaveName = Tcl_GetCommandName(masterInterp, slavePtr->interpCmd);
-    if (Tcl_DeleteCommand(masterInterp, slaveName) != 0) {
+    if (Tcl_DeleteCommandFromToken(masterInterp, slavePtr->interpCmd) != 0) {
         ckfree((char *) localArgv);
-        Tcl_AppendResult(interp, "interpreter named \"", path,
-                "\" not found", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", path, "\" not found", (char *) NULL);
         return TCL_ERROR;
     }
     ckfree((char *) localArgv);
+
     return TCL_OK;
 }
 
@@ -713,16 +786,19 @@ DeleteOneInterpObject(interp, path)
  */
 
 static int
-DeleteInterpObject(interp, argc, argv)
+DeleteInterpObject(interp, masterPtr, objc, objv)
     Tcl_Interp *interp;			/* Interpreter start search from. */
-    int argc;				/* Number of arguments in vector. */
-    char **argv;			/* Contains path to interps to
-                                         * delete. */
+    Master *masterPtr;			/* Interim storage for master record.*/
+    int objc;				/* Number of arguments in vector. */
+    Tcl_Obj *CONST objv[];		/* with alias. */
 {
     int i;
+    int len;
     
-    for (i = 2; i < argc; i++) {
-        if (DeleteOneInterpObject(interp, argv[i]) != TCL_OK) {
+    for (i = 2; i < objc; i++) {
+        if (DeleteOneInterpObject(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[i], &len))
+                != TCL_OK) {
             return TCL_ERROR;
         }
     }
@@ -732,7 +808,7 @@ DeleteInterpObject(interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * AliasHelper --
+ * AliasCreationHelper --
  *
  *	Helper function to do the work to actually create an alias or
  *	delete an alias.
@@ -748,8 +824,8 @@ DeleteInterpObject(interp, argc, argv)
  */
 
 static int
-AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
-     aliasName, targetName, argc, argv)
+AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
+     aliasName, targetName, objc, objv)
     Tcl_Interp *curInterp;		/* Interp that invoked this proc. */
     Tcl_Interp *slaveInterp;		/* Interp where alias cmd will live
                                          * or from which alias will be
@@ -758,8 +834,8 @@ AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
     Master *masterPtr;			/* Master record for target interp. */
     char *aliasName;			/* Name of alias cmd. */
     char *targetName;			/* Name of target cmd. */
-    int argc;				/* Additional arguments to store */
-    char **argv;			/* with alias. */
+    int objc;				/* Additional arguments to store */
+    Tcl_Obj *CONST objv[];		/* with alias. */
 {
     Alias *aliasPtr;			/* Storage for alias data. */
     Alias *tmpAliasPtr;			/* Temp storage for alias to delete. */
@@ -790,9 +866,10 @@ AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
     }
 
     if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
-        if (argc != 0) {
-            Tcl_AppendResult(curInterp, "malformed command: should be",
-                " \"alias ",  aliasName, " {}\"", (char *) NULL);
+        if (objc != 0) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(curInterp),
+                    "malformed command: should be",
+                    " \"alias ",  aliasName, " {}\"", (char *) NULL);
             return TCL_ERROR;
         }
 
@@ -806,35 +883,55 @@ AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
     strcpy(aliasPtr->targetName, targetName);
     aliasPtr->targetInterp = masterInterp;
 
-    aliasPtr->argv = (char **) NULL;
-    aliasPtr->argc = argc;
-    if (aliasPtr->argc > 0) {
-        aliasPtr->argv = (char **) ckalloc((unsigned) sizeof(char *) *
-                aliasPtr->argc);
-        for (i = 0; i < argc; i++) {
-            aliasPtr->argv[i] = (char *) ckalloc((unsigned) strlen(argv[i])+1);
-            strcpy(aliasPtr->argv[i], argv[i]);
+    aliasPtr->objv = NULL;
+    aliasPtr->objc = objc;
+
+    if (aliasPtr->objc > 0) {
+        aliasPtr->objv =
+            (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) *
+                    aliasPtr->objc);
+        for (i = 0; i < objc; i++) {
+            aliasPtr->objv[i] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
         }
     }
 
-    if (TclPreventAliasLoop(curInterp, slaveInterp, aliasName, AliasCmd,
-            (ClientData) aliasPtr) != TCL_OK) {
-        for (i = 0; i < argc; i++) {
-            ckfree(aliasPtr->argv[i]);
+    aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, aliasName,
+            AliasCmd, (ClientData) aliasPtr, AliasCmdDeleteProc);
+
+    if (TclPreventAliasLoop(curInterp, slaveInterp, 
+            aliasPtr->slaveCmd) != TCL_OK) {
+
+	/*
+         *  Found an alias loop!  The last call to Tcl_CreateObjCommand
+         *  made the alias point to itself.  Delete the command and
+         *  its alias record.  Be careful to wipe out its client data
+         *  first, so the command doesn't try to delete itself.
+         */
+	
+        Command *cmdPtr = (Command*) aliasPtr->slaveCmd;
+        cmdPtr->clientData = NULL;
+        cmdPtr->deleteProc = NULL;
+        cmdPtr->deleteData = NULL;
+        Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
+
+        for (i = 0; i < objc; i++) {
+            Tcl_DecrRefCount(aliasPtr->objv[i]);
         }
-        if (aliasPtr->argv != (char **) NULL) {
-            ckfree((char *) aliasPtr->argv);
+        if (aliasPtr->objv != (Tcl_Obj *CONST *) NULL) {
+            ckfree((char *) aliasPtr->objv);
         }
         ckfree(aliasPtr->aliasName);
         ckfree(aliasPtr->targetName);
         ckfree((char *) aliasPtr);
-        
+
+        /*
+         * The result was already set by TclPreventAliasLoop.
+         */
+
         return TCL_ERROR;
     }
     
-    aliasPtr->slaveCmd = Tcl_CreateCommand(slaveInterp, aliasName, AliasCmd,
-            (ClientData) aliasPtr, AliasCmdDeleteProc);
-
     /*
      * Make an entry in the alias table. If it already exists delete
      * the alias command. Then retry.
@@ -842,14 +939,29 @@ AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
 
     do {
         hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
-        if (new == 0) {
+        if (!new) {
             tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-            (void) Tcl_DeleteCommand(slaveInterp, tmpAliasPtr->aliasName);
-            Tcl_DeleteHashEntry(hPtr);
+            (void) Tcl_DeleteCommandFromToken(slaveInterp,
+	            tmpAliasPtr->slaveCmd);
+
+            /*
+             * The hash entry should be deleted by the Tcl_DeleteCommand
+             * above, in its command deletion callback (most likely this
+             * will be AliasCmdDeleteProc, which does the deletion).
+             */
         }
     } while (new == 0);
     aliasPtr->aliasEntry = hPtr;
     Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
+    
+    /*
+     * Create the new command. We must do it after deleting any old command,
+     * because the alias may be pointing at a renamed alias, as in:
+     *
+     * interp alias {} foo {} bar		# Create an alias "foo"
+     * rename foo zop				# Now rename the alias
+     * interp alias {} foo {} zop		# Now recreate "foo"...
+     */
 
     targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
     targetPtr->slaveCmd = aliasPtr->slaveCmd;
@@ -865,15 +977,90 @@ AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
 
     aliasPtr->targetEntry = hPtr;
 
-    curInterp->result = aliasPtr->aliasName;
+    /*
+     * Make sure we clear out the object result when setting the string
+     * result.
+     */
+
+    Tcl_SetObjResult(curInterp, Tcl_NewStringObj(aliasPtr->aliasName, -1));
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpAliasesHelper --
+ *
+ *	Computes a list of aliases defined in an interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpAliasesHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Invoking interpreter. */
+    Master *masterPtr;			/* Master record for current interp. */
+    int objc;				/* How many arguments? */
+    Tcl_Obj *CONST objv[];		/* Actual arguments. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    Slave *slavePtr;			/* Record for slave interp. */
+    Tcl_HashEntry *hPtr;		/* Search variable. */
+    Tcl_HashSearch hSearch;		/* Iteration variable. */
+    int len;				/* Dummy length variable. */
+    Tcl_Obj *listObjPtr, *elemObjPtr;	/* Local object pointers. */
+    
+    if ((objc != 2) && (objc != 3)) {
+        Tcl_WrongNumArgs(interp, 1, objv, " aliases ?path?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        slaveInterp = GetInterp(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[2], &len), NULL);
+        if (slaveInterp == (Tcl_Interp *) NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                    "\" not found", (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else {
+        slaveInterp = interp;
+    }
+    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
+            "tclSlaveRecord", NULL);
+    if (slavePtr == (Slave *) NULL) {
+        return TCL_OK;
+    }
+
+    /*
+     * Build a list to return the aliases:
+     */
             
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
+         hPtr != NULL;
+         hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+        elemObjPtr = Tcl_NewStringObj(
+            Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr), -1);
+        Tcl_ListObjAppendElement(interp, listObjPtr, elemObjPtr);
+    }
+    Tcl_SetObjResult(interp, listObjPtr);
+
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SlaveAliasHelper -
+ * InterpAliasHelper -
  *
  *	Handles the different forms of the "interp alias" command:
  *	- interp alias slavePath aliasName
@@ -893,52 +1080,835 @@ AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
  */
 
 static int
-SlaveAliasHelper(interp, argc, argv)
+InterpAliasHelper(interp, masterPtr, objc, objv)
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
-{
     Master *masterPtr;			/* Master record for current interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
     Tcl_Interp *slaveInterp,		/* Interpreters used when */
         *masterInterp;			/* creating an alias btn siblings. */
     Master *masterMasterPtr;		/* Master record for master interp. */
+    int len;
 
-    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
-    if (masterPtr == (Master *) NULL) {
-        panic("SlaveAliasHelper: could not find master record");
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                "alias slavePath slaveCmd masterPath masterCmd ?args ..?");
+        return TCL_ERROR;
     }
-    if (argc < 4) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " alias slavePath slaveCmd masterPath masterCmd ?args ..?\"",
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), NULL);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "could not find interpreter \"",
+                Tcl_GetStringFromObj(objv[2], &len), "\"",
                 (char *) NULL);
         return TCL_ERROR;
     }
-    slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
+    if (objc == 4) {
+        return DescribeAlias(interp, slaveInterp,
+                Tcl_GetStringFromObj(objv[3], &len));
+    }
+    if (objc == 5 && strcmp(Tcl_GetStringFromObj(objv[4], &len), "") == 0) {
+        return DeleteAlias(interp, slaveInterp,
+                Tcl_GetStringFromObj(objv[3], &len));
+    }
+    if (objc < 6) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                "alias slavePath slaveCmd masterPath masterCmd ?args ..?");
+        return TCL_ERROR;
+    }
+    masterInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[4], &len), &masterMasterPtr);
+    if (masterInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "could not find interpreter \"",
+                Tcl_GetStringFromObj(objv[4], &len), "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    return AliasCreationHelper(interp, slaveInterp, masterInterp,
+            masterMasterPtr, Tcl_GetStringFromObj(objv[3], &len),
+            Tcl_GetStringFromObj(objv[5], &len),
+            objc-6, objv+6);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpExistsHelper --
+ *
+ *	Computes whether a named interpreter exists or not.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpExistsHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for current interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Obj *objPtr;
+    int len;
+
+    if (objc > 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "exists ?path?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        if (GetInterp(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[2], &len), NULL) ==
+                (Tcl_Interp *) NULL) {
+            objPtr = Tcl_NewStringObj("0", 1);
+        } else {
+            objPtr = Tcl_NewStringObj("1", 1);
+        }
+    } else {
+        objPtr = Tcl_NewStringObj("1", 1);
+    }
+    Tcl_SetObjResult(interp, objPtr);
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpEvalHelper --
+ *
+ *	Helper function to handle all the details of evaluating a
+ *	command in another interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command itself does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpEvalHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for current interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    Interp *iPtr;			/* Internal data type for slave. */
+    int len;				/* Dummy length variable. */
+    int result;
+    Tcl_Obj *namePtr, *objPtr;		/* Local object pointer. */
+    char *string;
+
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 1, objv, " eval path arg ?arg ...?");
+        return TCL_ERROR;
+    }
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), NULL);
     if (slaveInterp == (Tcl_Interp *) NULL) {
-        Tcl_AppendResult(interp, "could not find interpreter \"",
-            argv[2], "\"", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
         return TCL_ERROR;
     }
-    if (argc == 4) {
-        return DescribeAlias(interp, slaveInterp, argv[3]);
+    objPtr = Tcl_ConcatObj(objc-3, objv+3);
+    Tcl_IncrRefCount(objPtr);
+    
+    Tcl_Preserve((ClientData) slaveInterp);
+    result = Tcl_EvalObj(slaveInterp, objPtr);
+
+    Tcl_DecrRefCount(objPtr);
+
+    /*
+     * Now make the result and any error information accessible. We
+     * have to be careful because the slave interpreter and the current
+     * interpreter can be the same - do not destroy the result.. This
+     * can happen if an interpreter contains an alias which is directed
+     * at a target command in the same interpreter.
+     */
+
+    if (interp != slaveInterp) {
+        if (result == TCL_ERROR) {
+
+            /*
+             * An error occurred, so transfer error information from
+             * the target interpreter back to our interpreter.
+             */
+
+            iPtr = (Interp *) slaveInterp;
+            if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                Tcl_AddErrorInfo(slaveInterp, "");
+            }
+            iPtr->flags &= (~(ERR_ALREADY_LOGGED));
+            
+            Tcl_ResetResult(interp);
+            namePtr = Tcl_NewStringObj("errorInfo", -1);
+            objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
+                    (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+            string = Tcl_GetStringFromObj(objPtr, &len);
+            Tcl_AddObjErrorInfo(interp, string, len);
+            Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+                    Tcl_GetVar2(slaveInterp, "errorCode", (char *)
+                            NULL, TCL_GLOBAL_ONLY),
+                    TCL_GLOBAL_ONLY);
+            Tcl_DecrRefCount(namePtr);
+        }
+
+	/*
+         * Move the result object from one interpreter to the
+         * other.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
+
     }
-    if (argc == 5 && strcmp(argv[4], "") == 0) {
-        return DeleteAlias(interp, slaveInterp, argv[3]);
+    Tcl_Release((ClientData) slaveInterp);
+    return result;        
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpExposeHelper --
+ *
+ *	Helper function to handle the details of exposing a command in
+ *	another interpreter.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Exposes a command. From now on the command can be called by scripts
+ *	in the interpreter in which it was exposed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpExposeHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for current interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    int len;				/* Dummy length variable. */
+
+    if ((objc != 4) && (objc != 5)) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                "expose path hiddenCmdName ?cmdName?");
+        return TCL_ERROR;
     }
-    if (argc < 6) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " alias slavePath slaveCmd masterPath masterCmd ?args ..?\"",
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "permission denied: safe interpreter cannot expose commands",
                 (char *) NULL);
         return TCL_ERROR;
     }
-    masterInterp = GetInterp(interp, masterPtr, argv[4], &masterMasterPtr);
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_ExposeCommand(slaveInterp,
+            Tcl_GetStringFromObj(objv[3], &len),
+                (objc == 5 ?
+                        Tcl_GetStringFromObj(objv[4], &len) :
+                        Tcl_GetStringFromObj(objv[3], &len)))
+            == TCL_ERROR) {
+        if (interp != slaveInterp) {
+            Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+            Tcl_ResetResult(slaveInterp);
+        }
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpHideHelper --
+ *
+ *	Helper function that handles the details of hiding a command in
+ *	another interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Hides a command. From now on the command cannot be called by
+ *	scripts in that interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpHideHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    int len;				/* Dummy length variable. */
+
+    if ((objc != 4) && (objc != 5)) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                " hide path cmdName ?hiddenCmdName?");
+        return TCL_ERROR;
+    }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "permission denied: safe interpreter cannot hide commands",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[3], &len),
+            (objc == 5 ?
+                    Tcl_GetStringFromObj(objv[4], &len) :
+                    Tcl_GetStringFromObj(objv[3], &len)))
+            == TCL_ERROR) {
+        if (interp != slaveInterp) {
+            Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+            Tcl_ResetResult(slaveInterp);
+        }
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpHiddenHelper --
+ *
+ *	Computes the list of hidden commands in a named interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpHiddenHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    int len;
+    Tcl_HashTable *hTblPtr;		/* Hidden command table. */
+    Tcl_HashEntry *hPtr;		/* Search variable. */
+    Tcl_HashSearch hSearch;		/* Iteration variable. */
+    Tcl_Obj *listObjPtr;		/* Local object pointer. */
+
+    if (objc > 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "hidden ?path?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        slaveInterp = GetInterp(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[2], &len),
+                &masterPtr);
+        if (slaveInterp == (Tcl_Interp *) NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                    "\" not found", (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else {
+        slaveInterp = interp;
+    }
+            
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
+            "tclHiddenCmds", NULL);
+    if (hTblPtr != (Tcl_HashTable *) NULL) {
+        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+             hPtr != (Tcl_HashEntry *) NULL;
+             hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+            Tcl_ListObjAppendElement(interp, listObjPtr,
+                    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
+        }
+    }
+    Tcl_SetObjResult(interp, listObjPtr);
+            
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpInvokeHiddenHelper --
+ *
+ *	Helper routine to handle the details of invoking a hidden
+ *	command in another interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the hidden command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpInvokeHiddenHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    int doGlobal = 0;
+    int len;
+    int result;
+    Tcl_Obj *namePtr, *objPtr;
+    Tcl_Interp *slaveInterp;
+    Interp *iPtr;
+    char *string;
+            
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                "invokehidden path ?-global? cmd ?arg ..?");
+        return TCL_ERROR;
+    }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "not allowed to invoke hidden commands from safe interpreter",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (strcmp(Tcl_GetStringFromObj(objv[3], &len), "-global") == 0) {
+        doGlobal = 1;
+        if (objc < 5) {
+            Tcl_WrongNumArgs(interp, 1, objv,
+                    "invokehidden path ?-global? cmd ?arg ..?");
+            return TCL_ERROR;
+        }
+    }
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    Tcl_Preserve((ClientData) slaveInterp);
+    if (doGlobal) {
+        result = TclObjInvokeGlobal(slaveInterp, objc-4, objv+4,
+                TCL_INVOKE_HIDDEN);
+    } else {
+        result = TclObjInvoke(slaveInterp, objc-3, objv+3, TCL_INVOKE_HIDDEN);
+    }
+
+    /*
+     * Now make the result and any error information accessible. We
+     * have to be careful because the slave interpreter and the current
+     * interpreter can be the same - do not destroy the result.. This
+     * can happen if an interpreter contains an alias which is directed
+     * at a target command in the same interpreter.
+     */
+
+    if (interp != slaveInterp) {
+        if (result == TCL_ERROR) {
+
+            /*
+             * An error occurred, so transfer error information from
+             * the target interpreter back to our interpreter.
+             */
+
+            iPtr = (Interp *) slaveInterp;
+            if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                Tcl_AddErrorInfo(slaveInterp, "");
+            }
+            iPtr->flags &= (~(ERR_ALREADY_LOGGED));
+
+            Tcl_ResetResult(interp);
+            namePtr = Tcl_NewStringObj("errorInfo", -1);
+            objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
+                    (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+            Tcl_DecrRefCount(namePtr);
+            string = Tcl_GetStringFromObj(objPtr, &len);
+            Tcl_AddObjErrorInfo(interp, string, len);
+            Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+                    Tcl_GetVar2(slaveInterp, "errorCode", (char *)
+                            NULL, TCL_GLOBAL_ONLY),
+                    TCL_GLOBAL_ONLY);
+        }
+
+	/*
+         * Move the result object from the slave to the master.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
+    }
+    Tcl_Release((ClientData) slaveInterp);
+    return result;        
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpMarkTrustedHelper --
+ *
+ *	Helper function to handle the details of marking another
+ *	interpreter as trusted (unsafe).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Henceforth the hard-wired checks for safety will not prevent
+ *	this interpreter from performing certain operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpMarkTrustedHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    int len;				/* Dummy length variable. */
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "marktrusted path");
+        return TCL_ERROR;
+    }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "\"", Tcl_GetStringFromObj(objv[0], &len),
+                " marktrusted\" can only",
+                " be invoked from a trusted interpreter",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    return MarkTrusted(slaveInterp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpIsSafeHelper --
+ *
+ *	Computes whether a named interpreter is safe.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpIsSafeHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    int len;				/* Dummy length variable. */
+    Tcl_Obj *objPtr;			/* Local object pointer. */
+
+    if (objc > 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "issafe ?path?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        slaveInterp = GetInterp(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
+        if (slaveInterp == (Tcl_Interp *) NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter \"",
+                    Tcl_GetStringFromObj(objv[2], &len), "\" not found",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+    }
+    if (masterPtr->isSafe == 0) {
+        objPtr = Tcl_NewStringObj("0", 1);
+    } else {
+        objPtr = Tcl_NewStringObj("1", 1);
+    }
+    Tcl_SetObjResult(interp, objPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpSlavesHelper --
+ *
+ *	Computes a list of slave interpreters of a named interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpSlavesHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    int len;
+    Tcl_HashEntry *hPtr;		/* Search variable. */
+    Tcl_HashSearch hSearch;		/* Iteration variable. */
+    Tcl_Obj *listObjPtr;		/* Local object pointers. */
+
+    if ((objc != 2) && (objc != 3)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "slaves ?path?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        if (GetInterp(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[2], &len), &masterPtr) ==
+                (Tcl_Interp *) NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                    "\" not found", (char *) NULL);
+            return TCL_ERROR;
+        }
+    }
+
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
+         hPtr != NULL;
+         hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+        Tcl_ListObjAppendElement(interp, listObjPtr,
+                Tcl_NewStringObj(
+                    Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr), -1));
+    }
+    Tcl_SetObjResult(interp, listObjPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpShareHelper --
+ *
+ *	Helper function to handle the details of sharing a channel between
+ *	interpreters.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	After this call the named channel will be shared between the
+ *	interpreters named in the arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpShareHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    Tcl_Interp *masterInterp;		/* Its master. */
+    int len;
+    Tcl_Channel chan;
+
+    if (objc != 5) {
+        Tcl_WrongNumArgs(interp, 1, objv, "share srcPath channelId destPath");
+        return TCL_ERROR;
+    }
+    masterInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), NULL);
+    if (masterInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[4], &len), NULL);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    chan = Tcl_GetChannel(masterInterp, Tcl_GetStringFromObj(objv[3], &len),
+            NULL);
+    if (chan == (Tcl_Channel) NULL) {
+        if (interp != masterInterp) {
+            Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
+            Tcl_ResetResult(masterInterp);
+        }
+        return TCL_ERROR;
+    }
+    Tcl_RegisterChannel(slaveInterp, chan);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpTargetHelper --
+ *
+ *	Helper function to compute the target of an alias.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpTargetHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    int len;
+    
+    if (objc != 4) {
+        Tcl_WrongNumArgs(interp, 1, objv, "target path alias");
+        return TCL_ERROR;
+    }
+    return GetTarget(interp,
+            Tcl_GetStringFromObj(objv[2], &len),
+            Tcl_GetStringFromObj(objv[3], &len));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpTransferHelper --
+ *
+ *	Helper function to handle the details of transferring ownership
+ *	of a channel between interpreters.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	After the call, the named channel will be registered in the target
+ *	interpreter and no longer available for use in the source interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpTransferHelper(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Master *masterPtr;			/* Master record for interp. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Interp *slaveInterp;		/* A slave. */
+    Tcl_Interp *masterInterp;		/* Its master. */
+    int len;
+    Tcl_Channel chan;
+            
+    if (objc != 5) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                "transfer srcPath channelId destPath");
+        return TCL_ERROR;
+    }
+    masterInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), NULL);
     if (masterInterp == (Tcl_Interp *) NULL) {
-        Tcl_AppendResult(interp, "could not find interpreter \"",
-            argv[4], "\"", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[4], &len), NULL);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    chan = Tcl_GetChannel(masterInterp,
+            Tcl_GetStringFromObj(objv[3], &len), NULL);
+    if (chan == (Tcl_Channel) NULL) {
+        if (interp != masterInterp) {
+
+            /*
+             * After fixing objresult, this code will change to:
+             * Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
+             */
+            
+            Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
+            Tcl_ResetResult(masterInterp);
+        }
+        return TCL_ERROR;
+    }
+    Tcl_RegisterChannel(slaveInterp, chan);
+    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
+        if (interp != masterInterp) {
+            Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
+            Tcl_ResetResult(masterInterp);
+        }
         return TCL_ERROR;
     }
-    return AliasHelper(interp, slaveInterp, masterInterp, masterMasterPtr,
-            argv[3], argv[5], argc-6, argv+6);
+    return TCL_OK;
 }
 
 /*
@@ -946,9 +1916,10 @@ SlaveAliasHelper(interp, argc, argv)
  *
  * DescribeAlias --
  *
- *	Sets interp->result to a Tcl list describing the given alias in the
- *	given interpreter: its target command and the additional arguments
- *	to prepend to any invocation of the alias.
+ *	Sets the interpreter's result object to a Tcl list describing
+ *	the given alias in the given interpreter: its target command
+ *	and the additional arguments to prepend to any invocation
+ *	of the alias.
  *
  * Results:
  *	A standard Tcl result.
@@ -961,30 +1932,50 @@ SlaveAliasHelper(interp, argc, argv)
 
 static int
 DescribeAlias(interp, slaveInterp, aliasName)
-    Tcl_Interp *interp;		/* Interpreter for result and errors. */
-    Tcl_Interp *slaveInterp;	/* Interpreter defining alias. */
-    char *aliasName;		/* Name of alias to describe. */
+    Tcl_Interp *interp;			/* Interpreter for result & errors. */
+    Tcl_Interp *slaveInterp;		/* Interpreter defining alias. */
+    char *aliasName;			/* Name of alias to describe. */
 {
-    Slave *slavePtr;		/* Slave record for slave interpreter. */
-    Tcl_HashEntry *hPtr;	/* Search variable. */
-    Alias *aliasPtr;		/* Structure describing alias. */
-    int i;			/* Loop variable. */
+    Slave *slavePtr;			/* Slave interp slave record. */
+    Tcl_HashEntry *hPtr;		/* Search variable. */
+    Alias *aliasPtr;			/* Structure describing alias. */
+    int i;				/* Loop variable. */
+    Tcl_Obj *listObjPtr;		/* Local object pointer. */
 
     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
             NULL);
     if (slavePtr == (Slave *) NULL) {
-        panic("DescribeAlias: could not find slave record");
+
+        /*
+         * It's possible that the interpreter still does not have a slave
+         * record. If so, create such a record now. This is only possible
+         * for interpreters that were created with Tcl_CreateInterp, not
+         * those created with Tcl_CreateSlave, so this interpreter does
+         * not have a master.
+         */
+        
+        slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
+        slavePtr->masterInterp = (Tcl_Interp *) NULL;
+        slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
+        slavePtr->slaveInterp = slaveInterp;
+        slavePtr->interpCmd = (Tcl_Command) NULL;
+        Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
+        (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
+                SlaveRecordDeleteProc, (ClientData) slavePtr);
     }
     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
     if (hPtr == (Tcl_HashEntry *) NULL) {
         return TCL_OK;
     }
     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-    Tcl_AppendResult(interp, aliasPtr->targetName, (char *) NULL);
-    for (i = 0; i < aliasPtr->argc; i++) {
-        Tcl_AppendElement(interp, aliasPtr->argv[i]);
+
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    Tcl_ListObjAppendElement(interp, listObjPtr,
+            Tcl_NewStringObj(aliasPtr->targetName, -1));
+    for (i = 0; i < aliasPtr->objc; i++) {
+        Tcl_ListObjAppendElement(interp, listObjPtr, aliasPtr->objv[i]);
     }
-    
+    Tcl_SetObjResult(interp, listObjPtr);
     return TCL_OK;
 }
 
@@ -1011,31 +2002,44 @@ DeleteAlias(interp, slaveInterp, aliasName)
     char *aliasName;		/* Name of alias to delete. */
 {
     Slave *slavePtr;		/* Slave record for slave interpreter. */
+    Alias *aliasPtr;		/* Points at alias structure to delete. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
-    Alias *aliasPtr;		/* Structure describing alias to delete. */
+    char *tmpPtr, *namePtr;	/* Local pointers to name of command to
+                                 * be deleted. */
 
     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
             NULL);
     if (slavePtr == (Slave *) NULL) {
-        panic("DeleteAlias: could not find slave record");
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
+        return TCL_ERROR;
     }
     
     /*
-     * Get the alias from the alias table, determine the current
-     * true name of the alias (it may have been renamed!) and then
-     * delete the true command name. The deleteProc on the alias
-     * command will take care of removing the entry from the alias
-     * table.
+     * Get the alias from the alias table, then delete the command. The
+     * deleteProc on the alias command will take care of removing the entry
+     * from the alias table.
      */
 
     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
     if (hPtr == (Tcl_HashEntry *) NULL) {
-        Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
-                (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
         return TCL_ERROR;
     }
     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-    aliasName = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);
+
+    /*
+     * Get a copy of the real name of the command -- it might have
+     * been renamed, and we want to delete the renamed command, not
+     * the current command (if any) by the name of the original alias.
+     * We need the local copy because the name may get smashed when the
+     * command to delete is exposed, if it was hidden.
+     */
+
+    tmpPtr = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);
+    namePtr = (char *) ckalloc((unsigned) strlen(tmpPtr) + 1);
+    strcpy(namePtr, tmpPtr);
 
     /*
      * NOTE: The deleteProc for this command will delete the
@@ -1044,9 +2048,15 @@ DeleteAlias(interp, slaveInterp, aliasName)
      * target table.
      */
 
-    if (Tcl_DeleteCommand(slaveInterp, aliasName) != 0) {
-        panic("DeleteAlias: did not find alias to be deleted");
+    if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
+        if (Tcl_ExposeCommand(slaveInterp, namePtr, namePtr) != TCL_OK) {
+            panic("DeleteAlias: did not find alias to be deleted");
+        }
+        if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
+            panic("DeleteAlias: did not find alias to be deleted");
+        }
     }
+    ckfree(namePtr);
 
     return TCL_OK;
 }
@@ -1097,9 +2107,11 @@ Tcl_GetInterpPath(askingInterp, targetInterp)
         return TCL_ERROR;
     }
     if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
+
         /*
-         * AskingInterp->result was set by recursive call.
+         * The result of askingInterp was set by recursive call.
          */
+
         return TCL_ERROR;
     }
     masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
@@ -1143,7 +2155,6 @@ GetTarget(askingInterp, path, aliasName)
     Alias *aliasPtr;		/* Data describing the alias. */
 
     Tcl_ResetResult(askingInterp);
-
     masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
             NULL);
     if (masterPtr == (Master *) NULL) {
@@ -1151,8 +2162,8 @@ GetTarget(askingInterp, path, aliasName)
     }
     slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
     if (slaveInterp == (Tcl_Interp *) NULL) {
-        Tcl_AppendResult(askingInterp, "could not find interpreter \"",
-            path, "\"", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
+                "could not find interpreter \"", path, "\"", (char *) NULL);
         return TCL_ERROR;
     }
     slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
@@ -1162,21 +2173,25 @@ GetTarget(askingInterp, path, aliasName)
     }
     hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
     if (hPtr == (Tcl_HashEntry *) NULL) {
-        Tcl_AppendResult(askingInterp, "alias \"", aliasName, "\" in path \"",
-                path, "\" not found", (char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
+                "alias \"", aliasName, "\" in path \"", path, "\" not found",
+                (char *) NULL);
         return TCL_ERROR;
     }
     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
     if (aliasPtr == (Alias *) NULL) {
         panic("GetTarget: could not find alias record");
     }
+    
     if (Tcl_GetInterpPath(askingInterp, aliasPtr->targetInterp) == TCL_ERROR) {
         Tcl_ResetResult(askingInterp);
-        Tcl_AppendResult(askingInterp, "target interpreter for alias \"",
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
+                "target interpreter for alias \"",
                 aliasName, "\" in path \"", path, "\" is not my descendant",
                 (char *) NULL);
         return TCL_ERROR;
     }
+    
     return TCL_OK;
 }
 
@@ -1198,289 +2213,625 @@ GetTarget(askingInterp, path, aliasName)
  */
 	/* ARGSUSED */
 int
-Tcl_InterpCmd(clientData, interp, argc, argv)
+Tcl_InterpObjCmd(clientData, interp, objc, objv)
     ClientData clientData;		/* Unused. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
 {
-    Tcl_Interp *slaveInterp;		/* A slave. */
-    Tcl_Interp *masterInterp;		/* A master. */
     Master *masterPtr;			/* Master record for current interp. */
-    Slave *slavePtr;			/* Record for slave interp. */
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch hSearch;
-    size_t len;				/* Length of command name. */
-    int result;				/* Result of eval. */
-    char *cmdName;			/* Name of sub command to do. */
-    char *cmd;				/* Command to eval. */
-    Tcl_Channel chan;			/* Channel to share or transfer. */
+    int result;				/* Local result variable. */
 
-    if (argc < 2) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " cmd ?arg ...?\"", (char *) NULL);
+    /*
+     * These are all the different subcommands for this command:
+     */
+    
+    static char *subCmds[] = {
+        "alias", "aliases", "create", "delete", "eval", "exists",
+	"expose", "hide", "hidden", "issafe", "invokehidden",
+        "marktrusted", "slaves", "share", "target", "transfer",
+        (char *) NULL};
+    enum ISubCmdIdx {
+        IAliasIdx, IAliasesIdx, ICreateIdx, IDeleteIdx, IEvalIdx,
+	IExistsIdx, IExposeIdx, IHideIdx, IHiddenIdx, IIsSafeIdx,
+	IInvokeHiddenIdx, IMarkTrustedIdx, ISlavesIdx, IShareIdx,
+        ITargetIdx, ITransferIdx
+    } index;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
         return TCL_ERROR;
     }
-    cmdName = argv[1];
 
     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
     if (masterPtr == (Master *) NULL) {
         panic("Tcl_InterpCmd: could not find master record");
     }
 
-    len = strlen(cmdName);
+    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
+            0, (int *) &index);
+    if (result != TCL_OK) {
+        return result;
+    }
     
-    if (cmdName[0] == 'a') {
-        if ((strncmp(cmdName, "alias", len) == 0) && (len <= 5)) {
-            return SlaveAliasHelper(interp, argc, argv);
-        }
+    switch (index) {
+        case IAliasIdx:
+            return InterpAliasHelper(interp, masterPtr, objc, objv);
+        case IAliasesIdx:
+            return InterpAliasesHelper(interp, masterPtr, objc, objv);
+        case ICreateIdx:
+            return CreateInterpObject(interp, masterPtr, objc, objv);
+        case IDeleteIdx:
+            return DeleteInterpObject(interp, masterPtr, objc, objv);
+        case IEvalIdx:
+            return InterpEvalHelper(interp, masterPtr, objc, objv);
+        case IExistsIdx:
+            return InterpExistsHelper(interp, masterPtr, objc, objv);
+        case IExposeIdx:
+            return InterpExposeHelper(interp, masterPtr, objc, objv);
+        case IHideIdx:
+            return InterpHideHelper(interp, masterPtr, objc, objv);
+        case IHiddenIdx:
+            return InterpHiddenHelper(interp, masterPtr, objc, objv);
+        case IIsSafeIdx:
+            return InterpIsSafeHelper(interp, masterPtr, objc, objv);
+        case IInvokeHiddenIdx:
+            return InterpInvokeHiddenHelper(interp, masterPtr, objc, objv);
+        case IMarkTrustedIdx:
+            return InterpMarkTrustedHelper(interp, masterPtr, objc, objv);
+        case ISlavesIdx:
+            return InterpSlavesHelper(interp, masterPtr, objc, objv);
+        case IShareIdx:
+            return InterpShareHelper(interp, masterPtr, objc, objv);
+        case ITargetIdx:
+            return InterpTargetHelper(interp, masterPtr, objc, objv);
+        case ITransferIdx:
+            return InterpTransferHelper(interp, masterPtr, objc, objv);
+    }
 
-        if (strcmp(cmdName, "aliases") == 0) {
-            if (argc != 2 && argc != 3) {
-                Tcl_AppendResult(interp, "wrong # args: should be \"",
-                        argv[0], " aliases ?path?\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            if (argc == 3) {
-                slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
-                if (slaveInterp == (Tcl_Interp *) NULL) {
-                    Tcl_AppendResult(interp, "interpreter \"",
-                            argv[2], "\" not found", (char *) NULL);
-                    return TCL_ERROR;
-                }
-            } else {
-                slaveInterp = interp;
-            }
-            slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
-                    "tclSlaveRecord", NULL);
-            if (slavePtr == (Slave *) NULL) {
-                return TCL_OK;
-            }
-            for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
-                 hPtr != NULL;
-                 hPtr = Tcl_NextHashEntry(&hSearch)) {
-                Tcl_AppendElement(interp,
-                        Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr));
+    return TCL_ERROR;    
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveAliasHelper --
+ *
+ *	Helper function to construct or query an alias for a slave
+ *	interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Potentially creates a new alias.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    Master *masterPtr;
+    int len;
+
+    switch (objc-2) {
+        case 0:
+            Tcl_WrongNumArgs(interp, 1, objv,
+                    "alias aliasName ?targetName? ?args..?");
+            return TCL_ERROR;
+
+        case 1:
+
+            /*
+             * Return the name of the command in the current
+             * interpreter for which the argument is an alias in the
+             * slave interpreter, and the list of saved arguments
+             */
+
+            return DescribeAlias(interp, slaveInterp,
+                    Tcl_GetStringFromObj(objv[2], &len));
+
+        default:
+            masterPtr = (Master *) Tcl_GetAssocData(interp,
+                    "tclMasterRecord", NULL);
+            if (masterPtr == (Master *) NULL) {
+                panic("SlaveObjectCmd: could not find master record");
             }
-            return TCL_OK;
-        }
+            return AliasCreationHelper(interp, slaveInterp, interp,
+                    masterPtr,
+                    Tcl_GetStringFromObj(objv[2], &len),
+                    Tcl_GetStringFromObj(objv[3], &len),
+                    objc-4, objv+4);
     }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveAliasesHelper --
+ *
+ *	Computes a list of aliases defined in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveAliasesHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    Tcl_HashEntry *hPtr;		/* For local searches. */
+    Tcl_HashSearch hSearch;		/* For local searches. */
+    Tcl_Obj *listObjPtr;		/* Local object pointer. */
+    Alias *aliasPtr;			/* Alias information. */
+
+    /*
+     * Return the names of all the aliases created in the
+     * slave interpreter.
+     */
 
-    if ((cmdName[0] == 'c') && (strncmp(cmdName, "create", len) == 0)) {
-        return CreateInterpObject(interp, argc, argv);
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
+            &hSearch);
+         hPtr != (Tcl_HashEntry *) NULL;
+         hPtr = Tcl_NextHashEntry(&hSearch)) {
+        aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+        Tcl_ListObjAppendElement(interp, listObjPtr,
+                Tcl_NewStringObj(aliasPtr->aliasName, -1));
     }
+    Tcl_SetObjResult(interp, listObjPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveEvalHelper --
+ *
+ *	Helper function to evaluate a command in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the command does.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if ((cmdName[0] == 'd') && (strncmp(cmdName, "delete", len) == 0)) {
-        return DeleteInterpObject(interp, argc, argv);
+static int
+SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    Interp *iPtr;			/* Internal data type for slave. */
+    Tcl_Obj *objPtr;			/* Local object pointer. */
+    Tcl_Obj *namePtr;			/* Local object pointer. */
+    int len;
+    char *string;
+    int result;
+    
+    if (objc < 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "eval arg ?arg ...?");
+        return TCL_ERROR;
     }
 
-    if (cmdName[0] == 'e') {
-        if ((strncmp(cmdName, "exists", len) == 0) && (len > 1)) {
-            if (argc > 3) {
-                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                        " exists ?path?\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            if (argc == 3) {
-                if (GetInterp(interp, masterPtr, argv[2], NULL) ==
-                        (Tcl_Interp *) NULL) {
-                    Tcl_AppendResult(interp, "0", (char *) NULL);
-                } else {
-                    Tcl_AppendResult(interp, "1", (char *) NULL);
-                }
-            } else {
-                Tcl_AppendResult(interp, "1", (char *) NULL);
-            }
-            return TCL_OK;
-        }
-        if ((strncmp(cmdName, "eval", len) == 0) && (len > 1)) {
-            if (argc < 4) {
-                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                        " eval path arg ?arg ...?\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
-            if (slaveInterp == (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "interpreter named \"", argv[2],
-                        "\" not found", (char *) NULL);
-                return TCL_ERROR;
-            }
-            cmd = Tcl_Concat(argc-3, argv+3);
-            Tcl_Preserve((ClientData) slaveInterp);
-            result = Tcl_Eval(slaveInterp, cmd);
-            ckfree((char *) cmd);
+    objPtr = Tcl_ConcatObj(objc-2, objv+2);
+    Tcl_IncrRefCount(objPtr);
+    
+    Tcl_Preserve((ClientData) slaveInterp);
+    result = Tcl_EvalObj(slaveInterp, objPtr);
+
+    Tcl_DecrRefCount(objPtr);
+
+    /*
+     * Make the result and any error information accessible. We have
+     * to be careful because the slave interpreter and the current
+     * interpreter can be the same - do not destroy the result.. This
+     * can happen if an interpreter contains an alias which is directed
+     * at a target command in the same interpreter.
+     */
+
+    if (interp != slaveInterp) {
+        if (result == TCL_ERROR) {
 
             /*
-             * Now make the result and any error information accessible. We
-             * have to be careful because the slave interpreter and the current
-             * interpreter can be the same - do not destroy the result.. This
-             * can happen if an interpreter contains an alias which is directed
-             * at a target command in the same interpreter.
+             * An error occurred, so transfer error information from the
+             * destination interpreter back to our interpreter. 
              */
 
-            if (interp != slaveInterp) {
-                if (result == TCL_ERROR) {
-
-                    /*
-                     * An error occurred, so transfer error information from
-                     * the target interpreter back to our interpreter.  Must
-                     * clear interp's result before calling Tcl_AddErrorInfo,
-                     * since Tcl_AddErrorInfo will store the interp's result in
-                     * errorInfo before appending slaveInterp's $errorInfo;
-                     * we've already got everything we need in the slave
-                     * interpreter's $errorInfo.
-                     */
-
-                    Tcl_ResetResult(interp);
-                    Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp,
-                            "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
-                    Tcl_SetVar2(interp, "errorCode", (char *) NULL,
-                            Tcl_GetVar2(slaveInterp, "errorCode", (char *)
-                                    NULL, TCL_GLOBAL_ONLY),
-                            TCL_GLOBAL_ONLY);
-                }
-                if (slaveInterp->freeProc != NULL) {
-                    interp->result = slaveInterp->result;
-                    interp->freeProc = slaveInterp->freeProc;
-                    slaveInterp->freeProc = 0;
-                } else {
-                    Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
-                }
-                Tcl_ResetResult(slaveInterp);
+            iPtr = (Interp *) slaveInterp;
+            if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                Tcl_AddErrorInfo(slaveInterp, "");
             }
-            Tcl_Release((ClientData) slaveInterp);
-            return result;        
+            iPtr->flags &= (~(ERR_ALREADY_LOGGED));
+
+            Tcl_ResetResult(interp);
+            namePtr = Tcl_NewStringObj("errorInfo", -1);
+            objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
+                    (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+            string = Tcl_GetStringFromObj(objPtr, &len);
+            Tcl_AddObjErrorInfo(interp, string, len);
+            Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+                    Tcl_GetVar2(slaveInterp, "errorCode", (char *)
+                            NULL, TCL_GLOBAL_ONLY),
+                    TCL_GLOBAL_ONLY);
+            Tcl_DecrRefCount(namePtr);
         }
+
+	/*
+         * Move the result object from one interpreter to the
+         * other.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
     }
+    Tcl_Release((ClientData) slaveInterp);
+    return result;        
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveExposeHelper --
+ *
+ *	Helper function to expose a command in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	After this call scripts in the slave will be able to invoke
+ *	the newly exposed command.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if ((cmdName[0] == 'i') && (strncmp(cmdName, "issafe", len) == 0)) {
-        if (argc > 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " issafe ?path?\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        if (argc == 3) {
-            slaveInterp = GetInterp(interp, masterPtr, argv[2], &masterPtr);
-            if (slaveInterp == (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "interpreter \"", argv[2],
-                        "\" not found", (char *) NULL);
-                return TCL_ERROR;
-            }
-        }
-        if (masterPtr->isSafe == 0) {
-            Tcl_AppendResult(interp, "0", (char *) NULL);
-        } else {
-            Tcl_AppendResult(interp, "1", (char *) NULL);
-        }
-        return TCL_OK;
+static int
+SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    int len;
+    
+    if ((objc != 3) && (objc != 4)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "expose hiddenCmdName ?cmdName?");
+        return TCL_ERROR;
+    }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "permission denied: safe interpreter cannot expose commands",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_ExposeCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
+            (objc == 4 ?
+                    Tcl_GetStringFromObj(objv[3], &len) :
+                    Tcl_GetStringFromObj(objv[2], &len)))
+            == TCL_ERROR) {
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveHideHelper --
+ *
+ *	Helper function to hide a command in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	After this call scripts in the slave will no longer be able
+ *	to invoke the named command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    int len;
+
+    if ((objc != 3) && (objc != 4)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "hide cmdName ?hiddenCmdName?");
+        return TCL_ERROR;
     }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "permission denied: safe interpreter cannot hide commands",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
+            (objc == 4 ?
+                    Tcl_GetStringFromObj(objv[3], &len) :
+                    Tcl_GetStringFromObj(objv[2], &len)))
+            == TCL_ERROR) {
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveHiddenHelper --
+ *
+ *	Helper function to compute list of hidden commands in a slave
+ *	interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    Tcl_Obj *listObjPtr;		/* Local object pointer. */
+    Tcl_HashTable *hTblPtr;		/* For local searches. */
+    Tcl_HashEntry *hPtr;		/* For local searches. */
+    Tcl_HashSearch hSearch;		/* For local searches. */
     
-    if (cmdName[0] == 's') {
-        if ((strncmp(cmdName, "slaves", len) == 0) && (len > 1)) {
-            if (argc != 2 && argc != 3) {
-                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                        " slaves ?path?\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            if (argc == 3) {
-                if (GetInterp(interp, masterPtr, argv[2], &masterPtr) ==
-                        (Tcl_Interp *) NULL) {
-                    Tcl_AppendResult(interp, "interpreter \"", argv[2],
-                            "\" not found", (char *) NULL);
-                    return TCL_ERROR;
-                }
-            }
-            for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
-                 hPtr != NULL;
-                 hPtr = Tcl_NextHashEntry(&hSearch)) {
-                Tcl_AppendElement(interp,
-                        Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr));
-            }
-            return TCL_OK;
-        }
-        if ((strncmp(cmdName, "share", len) == 0) && (len > 1)) {
-            if (argc != 5) {
-                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                        " share srcPath channelId destPath\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            masterInterp = GetInterp(interp, masterPtr, argv[2], NULL);
-            if (masterInterp == (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "interpreter \"", argv[2],
-                        "\" not found", (char *) NULL);
-                return TCL_ERROR;
-            }
-            slaveInterp = GetInterp(interp, masterPtr, argv[4], NULL);
-            if (slaveInterp == (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "interpreter \"", argv[4],
-                        "\" not found", (char *) NULL);
-                return TCL_ERROR;
-            }
-            chan = Tcl_GetChannel(masterInterp, argv[3], NULL);
-            if (chan == (Tcl_Channel) NULL) {
-                if (interp != masterInterp) {
-                    Tcl_AppendResult(interp, masterInterp->result,
-                            (char *) NULL);
-                    Tcl_ResetResult(masterInterp);
-                }
-                return TCL_ERROR;
-            }
-            Tcl_RegisterChannel(slaveInterp, chan);
-            return TCL_OK;
-        }
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "hidden");
+        return TCL_ERROR;
     }
 
-    if ((cmdName[0] == 't') && (strncmp(cmdName, "target", len) == 0)) {
-        if (argc != 4) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " target path alias\"", (char *) NULL);
-            return TCL_ERROR;
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
+            "tclHiddenCmds", NULL);
+    if (hTblPtr != (Tcl_HashTable *) NULL) {
+        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+             hPtr != (Tcl_HashEntry *) NULL;
+             hPtr = Tcl_NextHashEntry(&hSearch)) {
+            Tcl_ListObjAppendElement(interp, listObjPtr,
+                    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
         }
-        return GetTarget(interp, argv[2], argv[3]);
     }
+    Tcl_SetObjResult(interp, listObjPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveIsSafeHelper --
+ *
+ *	Helper function to compute whether a slave interpreter is safe.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if ((cmdName[0] == 't') && (strncmp(cmdName, "transfer", len) == 0)) {
-        if (argc != 5) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " transfer srcPath channelId destPath\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        masterInterp = GetInterp(interp, masterPtr, argv[2], NULL);
-        if (masterInterp == (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "interpreter \"", argv[2],
-                    "\" not found", (char *) NULL);
-            return TCL_ERROR;
-        }
-        slaveInterp = GetInterp(interp, masterPtr, argv[4], NULL);
-        if (slaveInterp == (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "interpreter \"", argv[4],
-                    "\" not found", (char *) NULL);
-            return TCL_ERROR;
-        }
-        chan = Tcl_GetChannel(masterInterp, argv[3], NULL);
-        if (chan == (Tcl_Channel) NULL) {
-            if (interp != masterInterp) {
-                Tcl_AppendResult(interp, masterInterp->result, (char *) NULL);
-                Tcl_ResetResult(masterInterp);
-            }
+static int
+SlaveIsSafeHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    Master *masterPtr;			/* Master record for slave interp. */
+    Tcl_Obj *namePtr;			/* Local object pointer. */
+
+    if (objc > 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "issafe");
+        return TCL_ERROR;
+    }
+    masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
+            "tclMasterRecord", NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("SlaveObjectCmd: could not find master record");
+    }
+    if (masterPtr->isSafe == 1) {
+        namePtr = Tcl_NewStringObj("1", 1);
+    } else {
+        namePtr = Tcl_NewStringObj("0", 1);
+    }
+    Tcl_SetObjResult(interp, namePtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveInvokeHiddenHelper --
+ *
+ *	Helper function to invoke a hidden command in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the hidden command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    Interp *iPtr;
+    Master *masterPtr;
+    int doGlobal = 0;
+    int result;
+    int len;
+    char *string;
+    Tcl_Obj *namePtr, *objPtr;
+            
+    if (objc < 3) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                "invokehidden ?-global? cmd ?arg ..?");
+        return TCL_ERROR;
+    }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "not allowed to invoke hidden commands from safe interpreter",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (strcmp(Tcl_GetStringFromObj(objv[2], &len), "-global") == 0) {
+        doGlobal = 1;
+        if (objc < 4) {
+            Tcl_WrongNumArgs(interp, 1, objv,
+                    "invokehidden path ?-global? cmd ?arg ..?");
             return TCL_ERROR;
         }
-        Tcl_RegisterChannel(slaveInterp, chan);
-        if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
-            if (interp != masterInterp) {
-                Tcl_AppendResult(interp, masterInterp->result, (char *) NULL);
-                Tcl_ResetResult(masterInterp);
+    }
+    masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
+            "tclMasterRecord", NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("SlaveObjectCmd: could not find master record");
+    }
+    Tcl_Preserve((ClientData) slaveInterp);
+    if (doGlobal) {
+        result = TclObjInvokeGlobal(slaveInterp, objc-3, objv+3,
+                TCL_INVOKE_HIDDEN);
+    } else {
+        result = TclObjInvoke(slaveInterp, objc-2, objv+2,
+                TCL_INVOKE_HIDDEN);
+    }
+
+    /*
+     * Now make the result and any error information accessible. We
+     * have to be careful because the slave interpreter and the current
+     * interpreter can be the same - do not destroy the result.. This
+     * can happen if an interpreter contains an alias which is directed
+     * at a target command in the same interpreter.
+     */
+
+    if (interp != slaveInterp) {
+        if (result == TCL_ERROR) {
+
+            /*
+             * An error occurred, so transfer error information from
+             * the target interpreter back to our interpreter.
+             */
+
+            iPtr = (Interp *) slaveInterp;
+            if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                Tcl_AddErrorInfo(slaveInterp, "");
             }
-            return TCL_ERROR;
+            iPtr->flags &= (~(ERR_ALREADY_LOGGED));
+
+            Tcl_ResetResult(interp);
+            namePtr = Tcl_NewStringObj("errorInfo", -1);
+            objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
+                    (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+            string = Tcl_GetStringFromObj(objPtr, &len);
+            Tcl_AddObjErrorInfo(interp, string, len);
+            Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+                    Tcl_GetVar2(slaveInterp, "errorCode", (char *)
+                            NULL, TCL_GLOBAL_ONLY),
+                    TCL_GLOBAL_ONLY);
+            Tcl_DecrRefCount(namePtr);
         }
 
-        return TCL_OK;
+	/*
+         * Move the result object from the slave to the master.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
     }
-        
-    Tcl_AppendResult(interp, "bad option \"", argv[1],
-            "\": should be alias, aliases, create, delete, exists, eval, ",
-            "issafe, share, slaves, target or transfer", (char *) NULL);
-    return TCL_ERROR;    
+    Tcl_Release((ClientData) slaveInterp);
+    return result;        
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveMarkTrustedHelper --
+ *
+ *	Helper function to mark a slave interpreter as trusted (unsafe).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	After this call the hard-wired security checks in the core no
+ *	longer prevent the slave from performing certain operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr, objc, objv)
+    Tcl_Interp	*interp;		/* Current interpreter. */
+    Tcl_Interp	*slaveInterp;		/* The slave interpreter. */
+    Slave *slavePtr;			/* Its slave record. */
+    int objc;				/* Count of arguments. */
+    Tcl_Obj *CONST objv[];		/* Vector of arguments. */
+{
+    int len;
+    
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "marktrusted");
+        return TCL_ERROR;
+    }
+    if (Tcl_IsSafe(interp)) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "\"", Tcl_GetStringFromObj(objv[0], &len), " marktrusted\"",
+                " can only be invoked from a trusted interpreter",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    return MarkTrusted(slaveInterp);
 }
 
 /*
@@ -1501,34 +2852,46 @@ Tcl_InterpCmd(clientData, interp, argc, argv)
  */
 
 static int
-SlaveObjectCmd(clientData, interp, argc, argv)
+SlaveObjectCmd(clientData, interp, objc, objv)
     ClientData clientData;		/* Slave interpreter. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* The argument vector. */
 {
-    Master *masterPtr;			/* Master record for slave interp. */
     Slave *slavePtr;			/* Slave record. */
     Tcl_Interp *slaveInterp;		/* Slave interpreter. */
-    char *cmdName;			/* Name of command to do. */
-    char *cmd;				/* Command to evaluate in slave
-                                         * interpreter. */
-    Alias *aliasPtr;			/* Alias information. */
-    Tcl_HashEntry *hPtr;		/* For local searches. */
-    Tcl_HashSearch hSearch;		/* For local searches. */
     int result;				/* Loop counter, status return. */
-    size_t len;				/* Length of command name. */
+    int len;				/* Length of command name. */
+
+    /*
+     * These are all the different subcommands for this command:
+     */
     
-    if (argc < 2) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-            " cmd ?arg ...?\"", (char *) NULL);
+    static char *subCmds[] = {
+        "alias", "aliases",
+        "eval", "expose",
+        "hide", "hidden",
+        "issafe", "invokehidden",
+        "marktrusted",
+        (char *) NULL};
+    enum ISubCmdIdx {
+        IAliasIdx, IAliasesIdx,
+        IEvalIdx, IExposeIdx,
+        IHideIdx, IHiddenIdx,
+        IIsSafeIdx, IInvokeHiddenIdx,
+        IMarkTrustedIdx
+    } index;
+    
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
         return TCL_ERROR;
     }
 
     slaveInterp = (Tcl_Interp *) clientData;
     if (slaveInterp == (Tcl_Interp *) NULL) {
-	Tcl_AppendResult(interp, "interpreter ", argv[0], " has been deleted",
-		(char *) NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter ", Tcl_GetStringFromObj(objv[0], &len),
+                " has been deleted", (char *) NULL);
 	return TCL_ERROR;
     }
 
@@ -1538,132 +2901,40 @@ SlaveObjectCmd(clientData, interp, argc, argv)
         panic("SlaveObjectCmd: could not find slave record");
     }
 
-    cmdName = argv[1];
-    len = strlen(cmdName);
-
-    if (cmdName[0] == 'a') {
-        if (strncmp(cmdName, "alias", len) == 0) {
-            switch (argc-2) {
-                case 0:
-                    Tcl_AppendResult(interp, "wrong # args: should be \"",
-                            argv[0], " alias aliasName ?targetName? ?args..?",
-                            (char *) NULL);
-                    return TCL_ERROR;
-
-                case 1:
-
-                    /*
-                     * Return the name of the command in the current
-                     * interpreter for which the argument is an alias in the
-                     * slave interpreter, and the list of saved arguments
-                     */
-
-                    return DescribeAlias(interp, slaveInterp, argv[2]);
-
-                default:
-                    masterPtr = (Master *) Tcl_GetAssocData(interp,
-                            "tclMasterRecord", NULL);
-                    if (masterPtr == (Master *) NULL) {
-                        panic("SlaveObjectCmd: could not find master record");
-                    }
-                    return AliasHelper(interp, slaveInterp, interp, masterPtr,
-                            argv[2], argv[3], argc-4, argv+4);
-            }
-        }
-
-        if (strncmp(cmdName, "aliases", len) == 0) {
-
-            /*
-             * Return the names of all the aliases created in the
-             * slave interpreter.
-             */
-
-            for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
-                    &hSearch);
-                 hPtr != (Tcl_HashEntry *) NULL;
-                 hPtr = Tcl_NextHashEntry(&hSearch)) {
-                aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-                Tcl_AppendElement(interp, aliasPtr->aliasName);
-            }
-            return TCL_OK;
-        }
-    }
-    
-
-    if ((cmdName[0] == 'e') && (strncmp(cmdName, "eval", len) == 0)) {
-        if (argc < 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " eval arg ?arg ...?\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-
-        cmd = Tcl_Concat(argc-2, argv+2);
-        Tcl_Preserve((ClientData) slaveInterp);
-        result = Tcl_Eval(slaveInterp, cmd);
-        ckfree((char *) cmd);
-
-        /*
-         * Now make the result and any error information accessible. We have
-         * to be careful because the slave interpreter and the current
-         * interpreter can be the same - do not destroy the result.. This
-         * can happen if an interpreter contains an alias which is directed
-         * at a target command in the same interpreter.
-         */
-
-        if (interp != slaveInterp) {
-            if (result == TCL_ERROR) {
-
-               /*
-                * An error occurred, so transfer error information from the
-                * destination interpreter back to our interpreter.  Must clear
-                * interp's result before calling Tcl_AddErrorInfo, since
-                * Tcl_AddErrorInfo will store the interp's result in errorInfo
-                * before appending slaveInterp's $errorInfo;
-                * we've already got everything we need in the slave
-                * interpreter's $errorInfo.
-                */
-
-                Tcl_ResetResult(interp);
-                Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp,
-                        "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
-                Tcl_SetVar2(interp, "errorCode", (char *) NULL,
-                        Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
-                                TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
-            }
-            if (slaveInterp->freeProc != NULL) {
-                interp->result = slaveInterp->result;
-                interp->freeProc = slaveInterp->freeProc;
-                slaveInterp->freeProc = 0;
-            } else {
-                Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
-            }
-            Tcl_ResetResult(slaveInterp);
-        }
-        Tcl_Release((ClientData) slaveInterp);
+    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
+            0, (int *) &index);
+    if (result != TCL_OK) {
         return result;
     }
 
-    if ((cmdName[0] == 'i') && (strncmp(cmdName, "issafe", len) == 0)) {
-        if (argc > 2) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " issafe\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
-                "tclMasterRecord", NULL);
-        if (masterPtr == (Master *) NULL) {
-            panic("SlaveObjectCmd: could not find master record");
-        }
-        if (masterPtr->isSafe == 1) {
-            Tcl_AppendResult(interp, "1", (char *) NULL);
-        } else {
-            Tcl_AppendResult(interp, "0", (char *) NULL);
-        }
-        return TCL_OK;
+    switch (index) {
+        case IAliasIdx:
+            return SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv);
+        case IAliasesIdx:
+            return SlaveAliasesHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
+        case IEvalIdx:
+            return SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv);
+        case IExposeIdx:
+            return SlaveExposeHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
+        case IHideIdx:
+            return SlaveHideHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
+        case IHiddenIdx:
+            return SlaveHiddenHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
+        case IIsSafeIdx:
+            return SlaveIsSafeHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
+        case IInvokeHiddenIdx:
+            return SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
+        case IMarkTrustedIdx:
+            return SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr,
+                    objc, objv);
     }
 
-    Tcl_AppendResult(interp, "bad option \"", argv[1],
-            "\": should be alias, aliases, eval or issafe", (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -1750,76 +3021,172 @@ SlaveObjectDeleteProc(clientData)
  */
 
 static int
-AliasCmd(clientData, interp, argc, argv)
+AliasCmd(clientData, interp, objc, objv)
     ClientData clientData;		/* Alias record. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument vector. */	
 {
+    Tcl_Interp *targetInterp;		/* Target for alias exec. */
+    Interp *iPtr;			/* Internal type of target. */
     Alias *aliasPtr;			/* Describes the alias. */
-    Tcl_CmdInfo cmdInfo;		/* Info about target command. */
+    Tcl_Command cmd;			/* The target command. */
+    Command *cmdPtr;			/* Points to target command. */
+    Tcl_Namespace *targetNsPtr;	        /* Target command's namespace. */
     int result;				/* Result of execution. */
-    int i, j, addArgc;			/* Loop counters. */
-    int localArgc;			/* Local argument count. */
-    char **localArgv;			/* Local argument vector. */
-    Interp *iPtr;			/* The target interpreter. */
+    int i, j, addObjc;			/* Loop counters. */
+    int localObjc;			/* Local argument count. */
+    Tcl_Obj **localObjv;		/* Local argument vector. */
+    Tcl_Obj *namePtr, *objPtr;		/* Local object pointers. */
+    char *string;			/* Local object string rep. */
+    int len;				/* Dummy length arg. */
     
     aliasPtr = (Alias *) clientData;
+    targetInterp = aliasPtr->targetInterp;
 
-    result = Tcl_GetCommandInfo(aliasPtr->targetInterp, aliasPtr->targetName,
-            &cmdInfo);
-    if (result == 0) {
-        Tcl_AppendResult(interp, "aliased target \"", aliasPtr->targetName,
-                "\" for \"", argv[0], "\" not found", (char *) NULL); 
-        return TCL_ERROR;
+    /*
+     * Look for the target command in the global namespace of the target
+     * interpreter.
+     */
+
+    cmdPtr = NULL;
+    targetNsPtr = Tcl_GetGlobalNamespace(aliasPtr->targetInterp);
+    cmd = Tcl_FindCommand(targetInterp, aliasPtr->targetName,
+            targetNsPtr, /*flags*/ 0);
+    if (cmd != (Tcl_Command) NULL) {
+        cmdPtr = (Command *) cmd;
     }
-    if (aliasPtr->argc <= 0) {
-        localArgv = argv;
-        localArgc = argc;
-    } else {
-        addArgc = aliasPtr->argc;
-        localArgc = argc + addArgc;
-        localArgv = (char **) ckalloc((unsigned) sizeof(char *) * localArgc);
-        localArgv[0] = argv[0];
-        for (i = 0, j = 1; i < addArgc; i++, j++) {
-            localArgv[j] = aliasPtr->argv[i];
+
+    iPtr = (Interp *) targetInterp;
+
+    /*
+     * If the command does not exist, invoke "unknown" in the master.
+     */
+    
+    if (cmdPtr == NULL) {
+        addObjc = aliasPtr->objc;
+        localObjc = addObjc + objc + 1;
+        localObjv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *)
+                * localObjc);
+        
+        localObjv[0] = Tcl_NewStringObj("unknown", -1);
+        localObjv[1] = Tcl_NewStringObj(aliasPtr->targetName, -1);
+        Tcl_IncrRefCount(localObjv[0]);
+        Tcl_IncrRefCount(localObjv[1]);
+        
+        for (i = 0, j = 2; i < addObjc; i++, j++) {
+            localObjv[j] = aliasPtr->objv[i];
         }
-        for (i = 1; i < argc; i++, j++) {
-            localArgv[j] = argv[i];
+        for (i = 1; i < objc; i++, j++) {
+            localObjv[j] = objv[i];
         }
+        Tcl_Preserve((ClientData) targetInterp);
+        result = TclObjInvoke(targetInterp, localObjc, localObjv, 0);
+
+        Tcl_DecrRefCount(localObjv[0]);
+        Tcl_DecrRefCount(localObjv[1]);
+        
+        ckfree((char *) localObjv);
+        
+        if (targetInterp != interp) {
+            if (result == TCL_ERROR) {
+                
+                /*
+                 * An error occurred, so transfer error information from
+                 * the target interpreter back to our interpreter.
+                 */
+
+                if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                    Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
+                }
+                iPtr->flags &= (~(ERR_ALREADY_LOGGED));
+
+                Tcl_ResetResult(interp);
+                namePtr = Tcl_NewStringObj("errorInfo", -1);
+                objPtr = Tcl_ObjGetVar2(targetInterp, namePtr,
+                        (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+                string = Tcl_GetStringFromObj(objPtr, &len);
+                Tcl_AddObjErrorInfo(interp, string, len);
+                Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+                        Tcl_GetVar2(targetInterp, "errorCode", (char *)
+                                NULL, TCL_GLOBAL_ONLY),
+                        TCL_GLOBAL_ONLY);
+                Tcl_DecrRefCount(namePtr);
+            }
+
+            /*
+             * Transfer the result from the target interpreter to the
+             * calling interpreter.
+             */
+            
+            Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
+            Tcl_ResetResult(targetInterp);
+        }
+
+	Tcl_Release((ClientData) targetInterp);
+        return result;
     }
 
     /*
-     * Invoke the redirected command in the target interpreter. Note
-     * that we are not calling eval because of possible security holes with
-     * $ substitution and bracketed command evaluation.
-     *
-     * We duplicate some code here from Tcl_Eval to implement recursion
-     * level counting and correct deletion of the target interpreter if
-     * that was requested but delayed because of in-progress evaluations.
+     * Otherwise invoke the regular target command.
      */
+    
+    if (aliasPtr->objc <= 0) {
+        localObjv = (Tcl_Obj **) objv;
+        localObjc = objc;
+    } else {
+        addObjc = aliasPtr->objc;
+        localObjc = objc + addObjc;
+        localObjv =
+            (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * localObjc);
+        localObjv[0] = objv[0];
+        for (i = 0, j = 1; i < addObjc; i++, j++) {
+            localObjv[j] = aliasPtr->objv[i];
+        }
+        for (i = 1; i < objc; i++, j++) {
+            localObjv[j] = objv[i];
+        }
+    }
 
-    iPtr = (Interp *) aliasPtr->targetInterp;
     iPtr->numLevels++;
-    Tcl_Preserve((ClientData) iPtr);
-    Tcl_ResetResult((Tcl_Interp *) iPtr);
-    result = (cmdInfo.proc)(cmdInfo.clientData, (Tcl_Interp *) iPtr,
-            localArgc, localArgv);
+    Tcl_Preserve((ClientData) targetInterp);
+
+    /*
+     * Reset the interpreter to its clean state; we do not know what state
+     * it is in now..
+     */
+    
+    Tcl_ResetResult(targetInterp);
+    result = (cmdPtr->objProc)(cmdPtr->objClientData, targetInterp,
+            localObjc, localObjv);
+
     iPtr->numLevels--;
+    
+    /*
+     * Check if we are at the bottom of the stack for the target interpreter.
+     * If so, check for special return codes.
+     */
+    
     if (iPtr->numLevels == 0) {
 	if (result == TCL_RETURN) {
 	    result = TclUpdateReturnInfo(iPtr);
 	}
 	if ((result != TCL_OK) && (result != TCL_ERROR)) {
-	    Tcl_ResetResult((Tcl_Interp *) iPtr);
+	    Tcl_ResetResult(targetInterp);
 	    if (result == TCL_BREAK) {
-		iPtr->result = "invoked \"break\" outside of a loop";
+                Tcl_SetObjResult(targetInterp,
+                        Tcl_NewStringObj("invoked \"break\" outside of a loop",
+                                -1));
 	    } else if (result == TCL_CONTINUE) {
-		iPtr->result = "invoked \"continue\" outside of a loop";
+                Tcl_SetObjResult(targetInterp,
+                        Tcl_NewStringObj(
+                            "invoked \"continue\" outside of a loop",
+                            -1));
 	    } else {
-		iPtr->result = iPtr->resultSpace;
-		sprintf(iPtr->resultSpace, "command returned bad code: %d",
-			result);
+                char buf[128];
+
+                sprintf(buf, "command returned bad code: %d", result);
+                Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
 	    }
 	    result = TCL_ERROR;
 	}
@@ -1829,58 +3196,53 @@ AliasCmd(clientData, interp, argc, argv)
      * Clean up any locally allocated argument vector structure.
      */
     
-    if (localArgv != argv) {
-        ckfree((char *) localArgv);
+    if (localObjv != objv) {
+        ckfree((char *) localObjv);
     }
     
     /*
+     * Move the result from the target interpreter to the invoking
+     * interpreter if they are different.
      *
-     * NOTE: Need to be careful if the target interpreter and the current
-     * interpreter are the same - must not destroy result. This may happen
-     * if an alias is created which redirects to a command in the same
-     * interpreter as the one in which the source command will be defined.
-     * Also: We cannot use aliasPtr any more because the alias may have
+     * Note: We cannot use aliasPtr any more because the alias may have
      * been deleted.
      */
 
-    if (interp != (Tcl_Interp *) iPtr) {
+    if (interp != targetInterp) {
         if (result == TCL_ERROR) {
-	    /*
-	     * An error occurred, so transfer error information from the
-	     * destination interpreter back to our interpreter.  Some tricky
-	     * points:
-	     * 1. Must call Tcl_AddErrorInfo in destination interpreter to
-	     *    make sure that the errorInfo variable has been initialized
-	     *    (it's initialized lazily and might not have been initialized
-	     *    yet).
-	     * 2. Must clear interp's result before calling Tcl_AddErrorInfo,
-	     *    since Tcl_AddErrorInfo will store the interp's result in
-	     *    errorInfo before appending aliasPtr->interp's $errorInfo;
-	     *    we've already got everything we need in the redirected
-	     *    interpreter's $errorInfo.
-	     */
-
-	    if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
-		Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
-	    }
-	    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+
+            /*
+             * An error occurred, so transfer the error information from
+             * the target interpreter back to our interpreter.
+             */
+
+            if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+                Tcl_AddErrorInfo(targetInterp, "");
+            }
+            iPtr->flags &= (~(ERR_ALREADY_LOGGED));
+            
             Tcl_ResetResult(interp);
-            Tcl_AddErrorInfo(interp, Tcl_GetVar2((Tcl_Interp *) iPtr,
-                    "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+            namePtr = Tcl_NewStringObj("errorInfo", -1);
+            objPtr = Tcl_ObjGetVar2(targetInterp, namePtr, (Tcl_Obj *) NULL,
+                    TCL_GLOBAL_ONLY);
+            string = Tcl_GetStringFromObj(objPtr, &len);
+            Tcl_AddObjErrorInfo(interp, string, len);
             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
-                    Tcl_GetVar2((Tcl_Interp *) iPtr, "errorCode",
-                    (char *) NULL, TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
-        }
-        if (iPtr->freeProc != NULL) {
-            interp->result = iPtr->result;
-            interp->freeProc = iPtr->freeProc;
-            iPtr->freeProc = 0;
-        } else {
-            Tcl_SetResult(interp, iPtr->result, TCL_VOLATILE);
+                    Tcl_GetVar2(targetInterp, "errorCode", (char *) NULL,
+                            TCL_GLOBAL_ONLY),
+                    TCL_GLOBAL_ONLY);
+            Tcl_DecrRefCount(namePtr);
         }
-        Tcl_ResetResult((Tcl_Interp *) iPtr);
+
+	/*
+         * Move the result object from one interpreter to the
+         * other.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
+        Tcl_ResetResult(targetInterp);
     }
-    Tcl_Release((ClientData) iPtr);
+    Tcl_Release((ClientData) targetInterp);
     return result;        
 }
 
@@ -1918,11 +3280,11 @@ AliasCmdDeleteProc(clientData)
 
     ckfree((char *) aliasPtr->targetName);
     ckfree((char *) aliasPtr->aliasName);
-    for (i = 0; i < aliasPtr->argc; i++) {
-        ckfree((char *) aliasPtr->argv[i]);
+    for (i = 0; i < aliasPtr->objc; i++) {
+        Tcl_DecrRefCount(aliasPtr->objv[i]);
     }
-    if (aliasPtr->argv != (char **) NULL) {
-        ckfree((char *) aliasPtr->argv);
+    if (aliasPtr->objv != (Tcl_Obj **) NULL) {
+        ckfree((char *) aliasPtr->objv);
     }
 
     Tcl_DeleteHashEntry(aliasPtr->aliasEntry);
@@ -1957,7 +3319,6 @@ MasterRecordDeleteProc(clientData, interp)
     Tcl_HashEntry *hPtr;		/* Search element. */
     Tcl_HashSearch hSearch;		/* Search record (internal). */
     Slave *slavePtr;			/* Loop variable. */
-    char *cmdName;			/* Name of command to delete. */
     Master *masterPtr;			/* Interim storage. */
 
     masterPtr = (Master *) clientData;
@@ -1965,8 +3326,7 @@ MasterRecordDeleteProc(clientData, interp)
          hPtr != NULL;
          hPtr = Tcl_NextHashEntry(&hSearch)) {
         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
-        cmdName = Tcl_GetCommandName(interp, slavePtr->interpCmd);
-        (void) Tcl_DeleteCommand(interp, cmdName);
+        (void) Tcl_DeleteCommandFromToken(interp, slavePtr->interpCmd);
     }
     Tcl_DeleteHashTable(&(masterPtr->slaveTable));
 
@@ -1974,9 +3334,8 @@ MasterRecordDeleteProc(clientData, interp)
          hPtr != NULL;
          hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
         targetPtr = (Target *) Tcl_GetHashValue(hPtr);
-        cmdName = Tcl_GetCommandName(targetPtr->slaveInterp,
-            targetPtr->slaveCmd);
-        (void) Tcl_DeleteCommand(targetPtr->slaveInterp, cmdName);
+        (void) Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
+	        targetPtr->slaveCmd);
     }
     Tcl_DeleteHashTable(&(masterPtr->targetTable));
 
@@ -2045,14 +3404,8 @@ SlaveRecordDeleteProc(clientData, interp)
 	cmdPtr->deleteProc = NULL;
 	cmdPtr->deleteData = NULL;
 
-        /*
-         * Get the command name from the master interpreter instead of
-         * relying on the stored name; the command may have been renamed.
-         */
-        
-	Tcl_DeleteCommand(slavePtr->masterInterp,
-                Tcl_GetCommandName(slavePtr->masterInterp,
-                        slavePtr->interpCmd));
+        Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
+	        slavePtr->interpCmd);
     }
 
     /*
@@ -2069,20 +3422,17 @@ SlaveRecordDeleteProc(clientData, interp)
 
         /*
          * The call to Tcl_DeleteCommand will release the storage
-         * occuppied by the hash entry and the alias record.
-         * NOTE that we cannot use the alias name directly because its
-         * storage will be deleted in the command deletion callback. Hence
-         * we must use the name for the command as stored in the hash table.
+         * occupied by the hash entry and the alias record.
          */
 
-        Tcl_DeleteCommand(interp,
-                Tcl_GetCommandName(interp, aliasPtr->slaveCmd));
+        Tcl_DeleteCommandFromToken(interp, aliasPtr->slaveCmd);
     }
         
     /*
-     * Finally dispose of the slave record itself.
+     * Finally dispose of the hash table and the slave record.
      */
-    
+
+    Tcl_DeleteHashTable(hTblPtr);
     ckfree((char *) slavePtr);    
 }
 
@@ -2156,32 +3506,6 @@ Tcl_IsSafe(interp)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_MakeSafe --
- *
- *	Makes an interpreter safe.
- *
- * Results:
- *	TCL_OK if it succeeds, TCL_ERROR else.
- *
- * Side effects:
- *	Removes functionality from an interpreter.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_MakeSafe(interp)
-    Tcl_Interp *interp;		/* Make this interpreter "safe". */
-{
-    if (interp == (Tcl_Interp *) NULL) {
-        return TCL_ERROR;
-    }
-    return MakeSafe(interp);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_CreateSlave --
  *
  *	Creates a slave interpreter. The slavePath argument denotes the
@@ -2208,10 +3532,17 @@ Tcl_CreateSlave(interp, slavePath, isSafe)
     char *slavePath;		/* Name of slave to create. */
     int isSafe;			/* Should new slave be "safe" ? */
 {
+    Master *masterPtr;			/* Master record for same. */
+
     if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
         return NULL;
     }
-    return CreateSlave(interp, slavePath, isSafe);
+    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
+            NULL); 
+    if (masterPtr == (Master *) NULL) {
+        panic("CreatSlave: could not find master record");
+    }
+    return CreateSlave(interp, masterPtr, slavePath, isSafe);
 }
 
 /*
@@ -2288,8 +3619,7 @@ Tcl_GetMaster(interp)
  *	Creates an alias between two interpreters.
  *
  * Results:
- *	TCL_OK if successful, TCL_ERROR if failed. If TCL_ERROR is returned
- *	the result of slaveInterp will contain an error message.
+ *	A standard Tcl result.
  *
  * Side effects:
  *	Creates a new alias, manipulates the result field of slaveInterp.
@@ -2307,6 +3637,61 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
     char **argv;			/* These are the additional args. */
 {
     Master *masterPtr;			/* Master record for target interp. */
+    Tcl_Obj **objv;
+    int i;
+    int result;
+    
+    if ((slaveInterp == (Tcl_Interp *) NULL) ||
+            (targetInterp == (Tcl_Interp *) NULL) ||
+            (slaveCmd == (char *) NULL) ||
+            (targetCmd == (char *) NULL)) {
+        return TCL_ERROR;
+    }
+    masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
+            NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("Tcl_CreateAlias: could not find master record");
+    }
+    objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
+    for (i = 0; i < argc; i++) {
+        objv[i] = Tcl_NewStringObj(argv[i], -1);
+        Tcl_IncrRefCount(objv[i]);
+    }
+    
+    result = AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
+            masterPtr, slaveCmd, targetCmd, argc, objv);
+
+    ckfree((char *) objv);
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateAliasObj --
+ *
+ *	Object version: Creates an alias between two interpreters.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates a new alias.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
+    Tcl_Interp *slaveInterp;		/* Interpreter for source command. */
+    char *slaveCmd;			/* Command to install in slave. */
+    Tcl_Interp *targetInterp;		/* Interpreter for target command. */
+    char *targetCmd;			/* Name of target command. */
+    int objc;				/* How many additional arguments? */
+    Tcl_Obj *CONST objv[];		/* Argument vector. */
+{
+    Master *masterPtr;			/* Master record for target interp. */
 
     if ((slaveInterp == (Tcl_Interp *) NULL) ||
             (targetInterp == (Tcl_Interp *) NULL) ||
@@ -2319,8 +3704,8 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
     if (masterPtr == (Master *) NULL) {
         panic("Tcl_CreateAlias: could not find master record");
     }
-    return AliasHelper(slaveInterp, slaveInterp, targetInterp, masterPtr,
-            slaveCmd, targetCmd, argc, argv);
+    return AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
+            masterPtr, slaveCmd, targetCmd, objc, objv);
 }
 
 /*
@@ -2331,12 +3716,10 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
  *	Gets information about an alias.
  *
  * Results:
- *	TCL_OK if successful, TCL_ERROR else. If TCL_ERROR is returned, the
- *	result field of the interpreter given as argument will contain an
- *	error message.
+ *	A standard Tcl result. 
  *
  * Side effects:
- *	Manipulates the result field of the interpreter given as argument.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -2354,6 +3737,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
     Slave *slavePtr;			/* Slave record for slave interp. */
     Tcl_HashEntry *hPtr;		/* Search element. */
     Alias *aliasPtr;			/* Storage for alias found. */
+    int len;
+    int i;
 
     if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
         return TCL_ERROR;
@@ -2376,10 +3761,73 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
         *targetNamePtr = aliasPtr->targetName;
     }
     if (argcPtr != (int *) NULL) {
-        *argcPtr = aliasPtr->argc;
+        *argcPtr = aliasPtr->objc;
     }
     if (argvPtr != (char ***) NULL) {
-        *argvPtr = aliasPtr->argv;
+        *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) *
+                aliasPtr->objc);
+        for (i = 0; i < aliasPtr->objc; i++) {
+            *argvPtr[i] = Tcl_GetStringFromObj(aliasPtr->objv[i], &len);
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ObjGetAlias --
+ *
+ *	Object version: Gets information about an alias.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
+        objvPtr)
+    Tcl_Interp *interp;			/* Interp to start search from. */
+    char *aliasName;			/* Name of alias to find. */
+    Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */
+    char **targetNamePtr;		/* (Return) name of target command. */
+    int *objcPtr;			/* (Return) count of addnl args. */
+    Tcl_Obj ***objvPtr;			/* (Return) additional args. */
+{
+    Slave *slavePtr;			/* Slave record for slave interp. */
+    Tcl_HashEntry *hPtr;		/* Search element. */
+    Alias *aliasPtr;			/* Storage for alias found. */
+
+    if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
+        return TCL_ERROR;
+    }
+    slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
+    if (slavePtr == (Slave *) NULL) {
+        panic("Tcl_GetAlias: could not find slave record");
+    }
+    hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+    if (targetInterpPtr != (Tcl_Interp **) NULL) {
+        *targetInterpPtr = aliasPtr->targetInterp;
+    }
+    if (targetNamePtr != (char **) NULL) {
+        *targetNamePtr = aliasPtr->targetName;
+    }
+    if (objcPtr != (int *) NULL) {
+        *objcPtr = aliasPtr->objc;
+    }
+    if (objvPtr != (Tcl_Obj ***) NULL) {
+        *objvPtr = aliasPtr->objv;
     }
     return TCL_OK;
 }
diff --git a/contrib/tcl/generic/tclLink.c b/contrib/tcl/generic/tclLink.c
index 1726c5d..bd6191d 100644
--- a/contrib/tcl/generic/tclLink.c
+++ b/contrib/tcl/generic/tclLink.c
@@ -8,12 +8,12 @@
  *	him.
  *
  * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
+ * 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.
  *
- * SCCS: @(#) tclLink.c 1.12 96/02/15 11:50:26
+ * SCCS: @(#) tclLink.c 1.15 97/01/21 21:51:42
  */
 
 #include "tclInt.h"
@@ -32,15 +32,29 @@ typedef struct Link {
 				 * that time via upvar. */
     char *addr;			/* Location of C variable. */
     int type;			/* Type of link (TCL_LINK_INT, etc.). */
-    int writable;		/* Zero means Tcl variable is read-only. */
     union {
 	int i;
 	double d;
     } lastValue;		/* Last known value of C variable;  used to
 				 * avoid string conversions. */
+    int flags;			/* Miscellaneous one-bit values;  see below
+				 * for definitions. */
 } Link;
 
 /*
+ * Definitions for flag bits:
+ * LINK_READ_ONLY -		1 means errors should be generated if Tcl
+ *				script attempts to write variable.
+ * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar
+ *				is in progress for this variable, so
+ *				trace callbacks on the variable should
+ *				be ignored.
+ */
+
+#define LINK_READ_ONLY		1
+#define LINK_BEING_UPDATED	2
+
+/*
  * Forward references to procedures defined later in this file:
  */
 
@@ -90,7 +104,11 @@ Tcl_LinkVar(interp, varName, addr, type)
     strcpy(linkPtr->varName, varName);
     linkPtr->addr = addr;
     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
-    linkPtr->writable = (type & TCL_LINK_READ_ONLY) == 0;
+    if (type & TCL_LINK_READ_ONLY) {
+	linkPtr->flags = LINK_READ_ONLY;
+    } else {
+	linkPtr->flags = 0;
+    }
     if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
 	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 	ckfree(linkPtr->varName);
@@ -170,14 +188,18 @@ Tcl_UpdateLinkedVar(interp, varName)
 {
     Link *linkPtr;
     char buffer[TCL_DOUBLE_SPACE];
+    int savedFlag;
 
     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
 	    LinkTraceProc, (ClientData) NULL);
     if (linkPtr == NULL) {
 	return;
     }
+    savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
+    linkPtr->flags |= LINK_BEING_UPDATED;
     Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
 	    TCL_GLOBAL_ONLY);
+    linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
 }
 
 /*
@@ -235,6 +257,17 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     }
 
     /*
+     * If we were invoked because of a call to Tcl_UpdateLinkedVar, then
+     * don't do anything at all.  In particular, we don't want to get
+     * upset that the variable is being modified, even if it is
+     * supposed to be read-only.
+     */
+
+    if (linkPtr->flags & LINK_BEING_UPDATED) {
+	return NULL;
+    }
+
+    /*
      * For read accesses, update the Tcl variable if the C variable
      * has changed since the last time we updated the Tcl variable.
      */
@@ -270,7 +303,7 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
      * could occur when the result has been partially set.
      */
 
-    if (!linkPtr->writable) {
+    if (linkPtr->flags & LINK_READ_ONLY) {
 	Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
 		TCL_GLOBAL_ONLY);
 	return "linked variable is read-only";
@@ -361,11 +394,11 @@ StringValue(linkPtr, buffer)
     switch (linkPtr->type) {
 	case TCL_LINK_INT:
 	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
-	    sprintf(buffer, "%d", linkPtr->lastValue.i);
+	    TclFormatInt(buffer, linkPtr->lastValue.i);
 	    return buffer;
 	case TCL_LINK_DOUBLE:
 	    linkPtr->lastValue.d = *(double *)(linkPtr->addr);
-	    Tcl_PrintDouble(linkPtr->interp, linkPtr->lastValue.d, buffer);
+	    Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer);
 	    return buffer;
 	case TCL_LINK_BOOLEAN:
 	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
diff --git a/contrib/tcl/generic/tclListObj.c b/contrib/tcl/generic/tclListObj.c
new file mode 100644
index 0000000..04b2633
--- /dev/null
+++ b/contrib/tcl/generic/tclListObj.c
@@ -0,0 +1,1053 @@
+/* 
+ * tclListObj.c --
+ *
+ *	This file contains procedures that implement the Tcl list object
+ *	type.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclListObj.c 1.44 97/06/13 18:25:32
+ */
+
+#include "tclInt.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
+static int		SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+/*
+ * The structure below defines the list Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclListType = {
+    "list",				/* name */
+    FreeListInternalRep,		/* freeIntRepProc */
+    DupListInternalRep,		        /* dupIntRepProc */
+    UpdateStringOfList,			/* updateStringProc */
+    SetListFromAny			/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewListObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new list object from an
+ *	(objc,objv) array: that is, each of the objc elements of the array
+ *	referenced by objv is inserted as an element into a new Tcl object.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewListObj.
+ *
+ * Results:
+ *	A new list object is returned that is initialized from the object
+ *	pointers in objv. If objc is less than or equal to zero, an empty
+ *	object is returned. The new object's string representation
+ *	is left NULL. The resulting new list object has ref count 0.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewListObj
+
+Tcl_Obj *
+Tcl_NewListObj(objc, objv)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+{
+    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewListObj(objc, objv)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+{
+    register Tcl_Obj *listPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    int i;
+    
+    TclNewObj(listPtr);
+    
+    if (objc > 0) {
+	Tcl_InvalidateStringRep(listPtr);
+	
+	elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	
+	listRepPtr = (List *) ckalloc(sizeof(List));
+	listRepPtr->maxElemCount = objc;
+	listRepPtr->elemCount    = objc;
+	listRepPtr->elements     = elemPtrs;
+	
+	listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+	listPtr->typePtr = &tclListType;
+    }
+    return listPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewListObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the
+ *	same as the Tcl_NewListObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewListObj.
+ *
+ * Results:
+ *	A new list object is returned that is initialized from the object
+ *	pointers in objv. If objc is less than or equal to zero, an empty
+ *	object is returned. The new object's string representation
+ *	is left NULL. The new list object has ref count 0.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewListObj(objc, objv, file, line)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *listPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    int i;
+    
+    TclDbNewObj(listPtr, file, line);
+    
+    if (objc > 0) {
+	Tcl_InvalidateStringRep(listPtr);
+	
+	elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	
+	listRepPtr = (List *) ckalloc(sizeof(List));
+	listRepPtr->maxElemCount = objc;
+	listRepPtr->elemCount    = objc;
+	listRepPtr->elements     = elemPtrs;
+	
+	listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+	listPtr->typePtr = &tclListType;
+    }
+    return listPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewListObj(objc, objv, file, line)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewListObj(objc, objv);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetListObj --
+ *
+ *	Modify an object to be a list containing each of the objc elements
+ *	of the object array referenced by objv.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object is made a list object and is initialized from the object
+ *	pointers in objv. If objc is less than or equal to zero, an empty
+ *	object is returned. The new object's string representation
+ *	is left NULL. The ref counts of the elements in objv are incremented
+ *	since the list now refers to them. The object's old string and
+ *	internal representations are freed and its type is set NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetListObj(objPtr, objc, objv)
+    Tcl_Obj *objPtr;		/* Object whose internal rep to init. */
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+{
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    int i;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetListObj called with shared object");
+    }
+    
+    /*
+     * Free any old string rep and any internal rep for the old type.
+     */
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+	objPtr->typePtr = NULL;
+    }
+        
+    /*
+     * Set the object's type to "list" and initialize the internal rep.
+     */
+
+    if (objc > 0) {
+	elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	
+	listRepPtr = (List *) ckalloc(sizeof(List));
+	listRepPtr->maxElemCount = objc;
+	listRepPtr->elemCount    = objc;
+	listRepPtr->elements     = elemPtrs;
+	
+	objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+	objPtr->typePtr = &tclListType;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjGetElements --
+ *
+ *	This procedure returns an (objc,objv) array of the elements in a
+ *	list object.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *objcPtr is set to
+ *	the count of list elements and *objvPtr is set to a pointer to an
+ *	array of (*objcPtr) pointers to each list element. If listPtr does
+ *	not refer to a list object and the object can not be converted to
+ *	one, TCL_ERROR is returned and an error message will be left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ *	The objects referenced by the returned array should be treated as
+ *	readonly and their ref counts are _not_ incremented; the caller must
+ *	do that if it holds on to a reference. Furthermore, the pointer
+ *	and length returned by this procedure may change as soon as any
+ *	procedure is called on the list object; be careful about retaining
+ *	the pointer in a local data structure.
+ *
+ * Side effects:
+ *	The possible conversion of the object referenced by listPtr
+ *	to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object for which an element array
+				 * is to be returned. */
+    int *objcPtr;		/* Where to store the count of objects
+				 * referenced by objv. */
+    Tcl_Obj ***objvPtr;		/* Where to store the pointer to an array
+				 * of pointers to the list's objects. */
+{
+    register List *listRepPtr;
+
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    *objcPtr = listRepPtr->elemCount;
+    *objvPtr = listRepPtr->elements;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjAppendList --
+ *
+ *	This procedure appends the objects in the list referenced by
+ *	elemListPtr to the list object referenced by listPtr. If listPtr is
+ *	not already a list object, an attempt will be made to convert it to
+ *	one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK. If listPtr or elemListPtr do
+ *	not refer to list objects and they can not be converted to one,
+ *	TCL_ERROR is returned and an error message is left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	The reference counts of the elements in elemListPtr are incremented
+ *	since the list now refers to them. listPtr and elemListPtr are
+ *	converted, if necessary, to list objects. Also, appending the
+ *	new elements may cause listObj's array of element pointers to grow.
+ *	listPtr's old string representation, if any, is invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object to append elements to. */
+    Tcl_Obj *elemListPtr;	/* List obj with elements to append. */
+{
+    register List *listRepPtr;
+    int listLen, objc, result;
+    Tcl_Obj **objv;
+
+    if (Tcl_IsShared(listPtr)) {
+	panic("Tcl_ListObjAppendList called with shared object");
+    }
+    if (listPtr->typePtr != &tclListType) {
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    listLen = listRepPtr->elemCount;
+
+    result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Insert objc new elements starting after the lists's last element.
+     * Delete zero existing elements.
+     */
+    
+    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjAppendElement --
+ *
+ *	This procedure is a special purpose version of
+ *	Tcl_ListObjAppendList: it appends a single object referenced by
+ *	objPtr to the list object referenced by listPtr. If listPtr is not
+ *	already a list object, an attempt will be made to convert it to one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case objPtr is added
+ *	to the end of listPtr's list. If listPtr does not refer to a list
+ *	object and the object can not be converted to one, TCL_ERROR is
+ *	returned and an error message will be left in the interpreter's
+ *	result if interp is not NULL.
+ *
+ * Side effects:
+ *	The ref count of objPtr is incremented since the list now refers 
+ *	to it. listPtr will be converted, if necessary, to a list object.
+ *	Also, appending the new element may cause listObj's array of element
+ *	pointers to grow. listPtr's old string representation, if any,
+ *	is invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjAppendElement(interp, listPtr, objPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    Tcl_Obj *listPtr;		/* List object to append objPtr to. */
+    Tcl_Obj *objPtr;		/* Object to append to listPtr's list. */
+{
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems;
+    
+    if (Tcl_IsShared(listPtr)) {
+	panic("Tcl_ListObjAppendElement called with shared object");
+    }
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    elemPtrs = listRepPtr->elements;
+    numElems = listRepPtr->elemCount;
+    
+    /*
+     * If there is no room in the current array of element pointers,
+     * allocate a new, larger array and copy the pointers to it.
+     */
+
+    if (numElems >= listRepPtr->maxElemCount) {
+	int numRequired = (numElems + 1);
+	int newMax = (2 * numRequired);
+	Tcl_Obj **newElemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+	
+	memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
+	       (size_t) (numElems * sizeof(Tcl_Obj *)));
+
+	listRepPtr->maxElemCount = newMax;
+	listRepPtr->elements = newElemPtrs;
+	ckfree((char *) elemPtrs);
+	elemPtrs = newElemPtrs;
+    }
+
+    /*
+     * Add objPtr to the end of listPtr's array of element
+     * pointers. Increment the ref count for the (now shared) objPtr.
+     */
+
+    elemPtrs[numElems] = objPtr;
+    Tcl_IncrRefCount(objPtr);
+    listRepPtr->elemCount++;
+
+    /*
+     * Invalidate any old string representation since the list's internal
+     * representation has changed.
+     */
+
+    Tcl_InvalidateStringRep(listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjIndex --
+ *
+ *	This procedure returns a pointer to the index'th object from the
+ *	list referenced by listPtr. The first element has index 0. If index
+ *	is negative or greater than or equal to the number of elements in
+ *	the list, a NULL is returned. If listPtr is not a list object, an
+ *	attempt will be made to convert it to a list.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case objPtrPtr is set
+ *	to the Tcl_Obj pointer for the index'th list element or NULL if
+ *	index is out of range. This object should be treated as readonly and
+ *	its ref count is _not_ incremented; the caller must do that if it
+ *	holds on to the reference. If listPtr does not refer to a list and
+ *	can't be converted to one, TCL_ERROR is returned and an error
+ *	message is left in the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	listPtr will be converted, if necessary, to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object to index into. */
+    register int index;		/* Index of element to return. */
+    Tcl_Obj **objPtrPtr;	/* The resulting Tcl_Obj* is stored here. */
+{
+    register List *listRepPtr;
+    
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    if ((index < 0) || (index >= listRepPtr->elemCount)) {
+	*objPtrPtr = NULL;
+    } else {
+	*objPtrPtr = listRepPtr->elements[index];
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjLength --
+ *
+ *	This procedure returns the number of elements in a list object. If
+ *	the object is not already a list object, an attempt will be made to
+ *	convert it to one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *intPtr will be
+ *	set to the integer count of list elements. If listPtr does not refer
+ *	to a list object and the object can not be converted to one,
+ *	TCL_ERROR is returned and an error message will be left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	The possible conversion of the argument object to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjLength(interp, listPtr, intPtr)
+    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr;	/* List object whose #elements to return. */
+    register int *intPtr;	/* The resulting int is stored here. */
+{
+    register List *listRepPtr;
+    
+    if (listPtr->typePtr != &tclListType) {
+	int result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    *intPtr = listRepPtr->elemCount;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjReplace --
+ * 
+ *	This procedure replaces zero or more elements of the list referenced
+ *	by listPtr with the objects from an (objc,objv) array. 
+ *	The objc elements of the array referenced by objv replace the
+ *	count elements in listPtr starting at first.
+ *
+ *	If the argument first is zero or negative, it refers to the first
+ *	element. If first is greater than or equal to the number of elements
+ *	in the list, then no elements are deleted; the new elements are
+ *	appended to the list. Count gives the number of elements to
+ *	replace. If count is zero or negative then no elements are deleted;
+ *	the new elements are simply inserted before first.
+ *
+ *	The argument objv refers to an array of objc pointers to the new
+ *	elements to be added to listPtr in place of those that were
+ *	deleted. If objv is NULL, no new elements are added. If listPtr is
+ *	not a list object, an attempt will be made to convert it to one.
+ *
+ * Results:
+ *	The return value is normally TCL_OK. If listPtr does
+ *	not refer to a list object and can not be converted to one,
+ *	TCL_ERROR is returned and an error message will be left in
+ *	the interpreter's result if interp is not NULL.
+ *
+ * Side effects:
+ *	The ref counts of the objc elements in objv are incremented since
+ *	the resulting list now refers to them. Similarly, the ref counts for
+ *	replaced objects are decremented. listPtr is converted, if
+ *	necessary, to a list object. listPtr's old string representation, if
+ *	any, is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *listPtr;		/* List object whose elements to replace. */
+    int first;			/* Index of first element to replace. */
+    int count;			/* Number of elements to replace. */
+    int objc;			/* Number of objects to insert. */
+    Tcl_Obj *CONST objv[];	/* An array of objc pointers to Tcl objects
+				 * to insert. */
+{
+    List *listRepPtr;
+    register Tcl_Obj **elemPtrs, **newPtrs;
+    Tcl_Obj *victimPtr;
+    int numElems, numRequired, numAfterLast;
+    int start, shift, newMax, i, j, result;
+     
+    if (Tcl_IsShared(listPtr)) {
+	panic("Tcl_ListObjReplace called with shared object");
+    }
+    if (listPtr->typePtr != &tclListType) {
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    elemPtrs = listRepPtr->elements;
+    numElems = listRepPtr->elemCount;
+
+    if (first < 0)  {
+    	first = 0;
+    }
+    if (first >= numElems) {
+	first = numElems;	/* so we'll insert after last element */
+    }
+    if (count < 0) {
+	count = 0;
+    }
+    
+    numRequired = (numElems - count + objc);
+    if (numRequired < listRepPtr->maxElemCount) {
+	/*
+	 * Enough room in the current array. First "delete" count
+	 * elements starting at first.
+	 */
+
+	for (i = 0, j = first;  i < count;  i++, j++) {
+	    victimPtr = elemPtrs[j];
+	    TclDecrRefCount(victimPtr);
+	}
+
+	/*
+	 * Shift the elements after the last one removed to their
+	 * new locations.
+	 */
+
+	start = (first + count);
+	numAfterLast = (numElems - start);
+	shift = (objc - count);	/* numNewElems - numDeleted */
+	if ((numAfterLast > 0) && (shift != 0)) {
+	    Tcl_Obj **src, **dst;
+
+	    if (shift < 0) {
+		for (src = elemPtrs + start, dst = src + shift;
+			numAfterLast > 0; numAfterLast--, src++, dst++) {
+		    *dst = *src;
+		}
+	    } else {
+		for (src = elemPtrs + numElems - 1, dst = src + shift;
+			numAfterLast > 0; numAfterLast--, src--, dst--) {
+		    *dst = *src;
+		}
+	    }
+	}
+
+	/*
+	 * Insert the new elements into elemPtrs before "first".
+	 */
+
+	for (i = 0, j = first;  i < objc;  i++, j++) {
+            elemPtrs[j] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
+        }
+
+	/*
+	 * Update the count of elements.
+	 */
+
+	listRepPtr->elemCount = numRequired;
+    } else {
+	/*
+	 * Not enough room in the current array. Allocate a larger array and
+	 * insert elements into it. 
+	 */
+
+	newMax = (2 * numRequired);
+	newPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+
+	/*
+	 * Copy over the elements before "first".
+	 */
+
+	if (first > 0) {
+	    memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
+		    (size_t) (first * sizeof(Tcl_Obj *)));
+	}
+
+	/*
+	 * "Delete" count elements starting at first.
+	 */
+
+	for (i = 0, j = first;  i < count;  i++, j++) {
+	    victimPtr = elemPtrs[j];
+	    TclDecrRefCount(victimPtr);
+	}
+
+	/*
+	 * Copy the elements after the last one removed, shifted to
+	 * their new locations.
+	 */
+
+	start = (first + count);
+	numAfterLast = (numElems - start);
+	if (numAfterLast > 0) {
+	    memcpy((VOID *) &(newPtrs[first + objc]),
+		    (VOID *) &(elemPtrs[start]),
+		    (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
+	}
+	
+	/*
+	 * Insert the new elements before "first" and update the
+	 * count of elements.
+	 */
+
+	for (i = 0, j = first;  i < objc;  i++, j++) {
+	    newPtrs[j] = objv[i];
+	    Tcl_IncrRefCount(objv[i]);
+	}
+
+	listRepPtr->elemCount = numRequired;
+	listRepPtr->maxElemCount = newMax;
+	listRepPtr->elements = newPtrs;
+	ckfree((char *) elemPtrs);
+    }
+    
+    /*
+     * Invalidate and free any old string representation since it no longer
+     * reflects the list's internal representation.
+     */
+
+    Tcl_InvalidateStringRep(listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeListInternalRep --
+ *
+ *	Deallocate the storage associated with a list object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees listPtr's List* internal representation and sets listPtr's
+ *	internalRep.otherValuePtr to NULL. Decrements the ref counts
+ *	of all element objects, which may free them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeListInternalRep(listPtr)
+    Tcl_Obj *listPtr;		/* List object with internal rep to free. */
+{
+    register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    register Tcl_Obj **elemPtrs = listRepPtr->elements;
+    register Tcl_Obj *objPtr;
+    int numElems = listRepPtr->elemCount;
+    int i;
+    
+    for (i = 0;  i < numElems;  i++) {
+	objPtr = elemPtrs[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    ckfree((char *) elemPtrs);
+    ckfree((char *) listRepPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupListInternalRep --
+ *
+ *	Initialize the internal representation of a list Tcl_Obj to a
+ *	copy of the internal representation of an existing list object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"srcPtr"s list internal rep pointer should not be NULL and we assume
+ *	it is not NULL. We set "copyPtr"s internal rep to a pointer to a
+ *	newly allocated List structure that, in turn, points to "srcPtr"s
+ *	element objects. Those element objects are not actually copied but
+ *	are shared between "srcPtr" and "copyPtr". The ref count of each
+ *	element object is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupListInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+{
+    List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
+    int numElems = srcListRepPtr->elemCount;
+    int maxElems = srcListRepPtr->maxElemCount;
+    register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
+    register Tcl_Obj **copyElemPtrs;
+    register List *copyListRepPtr;
+    int i;
+
+    /*
+     * Allocate a new List structure that points to "srcPtr"s element
+     * objects. Increment the ref counts for those (now shared) element
+     * objects.
+     */
+    
+    copyElemPtrs = (Tcl_Obj **)
+	ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
+    for (i = 0;  i < numElems;  i++) {
+	copyElemPtrs[i] = srcElemPtrs[i];
+	Tcl_IncrRefCount(copyElemPtrs[i]);
+    }
+    
+    copyListRepPtr = (List *) ckalloc(sizeof(List));
+    copyListRepPtr->maxElemCount = maxElems;
+    copyListRepPtr->elemCount    = numElems;
+    copyListRepPtr->elements     = copyElemPtrs;
+    
+    copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
+    copyPtr->typePtr = &tclListType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetListFromAny --
+ *
+ *	Attempt to generate a list internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
+ *	conversion, an error message is left in the interpreter's result
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, a list is stored as "objPtr"s internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetListFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *elemStart, *nextElem, *s;
+    int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
+    char *limit;		/* Points just after string's last byte. */
+    register char *p;
+    register Tcl_Obj **elemPtrs;
+    register Tcl_Obj *elemPtr;
+    List *listRepPtr;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Parse the string into separate string objects, and create a List
+     * structure that points to the element string objects. We use a
+     * modified version of Tcl_SplitList's implementation to avoid one
+     * malloc and a string copy for each list element. First, estimate the
+     * number of elements by counting the number of space characters in the
+     * list.
+     */
+
+    limit = (string + length);
+    estCount = 1;
+    for (p = string;  p < limit;  p++) {
+	if (isspace(UCHAR(*p))) {
+	    estCount++;
+	}
+    }
+
+    /*
+     * Allocate a new List structure with enough room for "estCount"
+     * elements. Each element is a pointer to a Tcl_Obj with the appropriate
+     * string rep. The initial "estCount" elements are set using the
+     * corresponding "argv" strings.
+     */
+
+    elemPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
+    for (p = string, lenRemain = length, i = 0;
+	    lenRemain > 0;
+	    p = nextElem, lenRemain = (limit - nextElem), i++) {
+	result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
+				&elemSize, &hasBrace);
+	if (result != TCL_OK) {
+	    for (j = 0;  j < i;  j++) {
+		elemPtr = elemPtrs[j];
+		Tcl_DecrRefCount(elemPtr);
+	    }
+	    ckfree((char *) elemPtrs);
+	    return result;
+	}
+	if (elemStart >= limit) {
+	    break;
+	}
+	if (i > estCount) {
+	    panic("SetListFromAny: bad size estimate for list");
+	}
+
+	/*
+	 * Allocate a Tcl object for the element and initialize it from the
+	 * "elemSize" bytes starting at "elemStart".
+	 */
+
+	s = ckalloc((unsigned) elemSize + 1);
+	if (hasBrace) {
+	    strncpy(s, elemStart, (size_t) elemSize);
+	    s[elemSize] = 0;
+	} else {
+	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+	}
+	
+	TclNewObj(elemPtr);
+        elemPtr->bytes  = s;
+        elemPtr->length = elemSize;
+        elemPtrs[i] = elemPtr;
+	Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
+    }
+
+    listRepPtr = (List *) ckalloc(sizeof(List));
+    listRepPtr->maxElemCount = estCount;
+    listRepPtr->elemCount    = i;
+    listRepPtr->elements     = elemPtrs;
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as
+     * late as possible to allow the conversion code, in particular
+     * Tcl_GetStringFromObj, to use that old internalRep.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+    objPtr->typePtr = &tclListType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfList --
+ *
+ *	Update the string representation for a list object.
+ *	Note: This procedure does not invalidate an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the list-to-string conversion. This string will be empty if the
+ *	list has no elements. The list internal representation
+ *	should not be NULL and we assume it is not NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfList(listPtr)
+    Tcl_Obj *listPtr;		/* List object with string rep to update. */
+{
+#   define LOCAL_SIZE 20
+    int localFlags[LOCAL_SIZE], *flagPtr;
+    List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+    int numElems = listRepPtr->elemCount;
+    register int i;
+    char *elem, *dst;
+    int length;
+
+    /*
+     * Convert each element of the list to string form and then convert it
+     * to proper list element form, adding it to the result buffer.
+     */
+
+    /*
+     * Pass 1: estimate space, gather flags.
+     */
+
+    if (numElems <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else {
+	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+    }
+    listPtr->length = 1;
+    for (i = 0; i < numElems; i++) {
+	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	listPtr->length += Tcl_ScanCountedElement(elem, length,
+		&flagPtr[i]) + 1;
+    }
+
+    /*
+     * Pass 2: copy into string rep buffer.
+     */
+
+    listPtr->bytes = ckalloc((unsigned) listPtr->length);
+    dst = listPtr->bytes;
+    for (i = 0; i < numElems; i++) {
+	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
+	*dst = ' ';
+	dst++;
+    }
+    if (flagPtr != localFlags) {
+	ckfree((char *) flagPtr);
+    }
+    if (dst == listPtr->bytes) {
+	*dst = 0;
+    } else {
+	dst--;
+	*dst = 0;
+    }
+    listPtr->length = dst - listPtr->bytes;
+}
diff --git a/contrib/tcl/generic/tclLoad.c b/contrib/tcl/generic/tclLoad.c
index 1c098aa..2e4e615 100644
--- a/contrib/tcl/generic/tclLoad.c
+++ b/contrib/tcl/generic/tclLoad.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclLoad.c 1.11 96/07/29 08:39:29
+ * SCCS: @(#) tclLoad.c 1.16 97/05/14 13:23:37
  */
 
 #include "tclInt.h"
@@ -101,12 +101,12 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
     char **argv;			/* Argument strings. */
 {
     Tcl_Interp *target;
-    LoadedPackage *pkgPtr;
+    LoadedPackage *pkgPtr, *defaultPtr;
     Tcl_DString pkgName, initName, safeInitName, fileName;
     Tcl_PackageInitProc *initProc, *safeInitProc;
     InterpPackage *ipFirstPtr, *ipPtr;
-    int code, c, gotPkgName;
-    char *p, *fullFileName;
+    int code, c, gotPkgName, namesMatch, filesMatch;
+    char *p, *fullFileName, *p1, *p2;
 
     if ((argc < 2) || (argc > 4)) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -126,7 +126,9 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
 	gotPkgName = 0;
     }
     if ((fullFileName[0] == 0) && !gotPkgName) {
-	interp->result = "must specify either file name or package name";
+	Tcl_SetResult(interp,
+		"must specify either file name or package name",
+		TCL_STATIC);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -146,55 +148,65 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
     }
 
     /*
-     * See if the desired file is already loaded.  If so, its package
-     * name must agree with ours (if we have one).
+     * Scan through the packages that are currently loaded to see if the
+     * package we want is already loaded.  We'll use a loaded package if
+     * it meets any of the following conditions:
+     *  - Its name and file match the once we're looking for.
+     *  - Its file matches, and we weren't given a name.
+     *  - Its name matches, the file name was specified as empty, and there
+     *    is only no statically loaded package with the same name.
      */
 
+    defaultPtr = NULL;
     for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
-	if (strcmp(pkgPtr->fileName, fullFileName) != 0) {
-	    continue;
-	}
-	if (gotPkgName) {
-	    char *p1, *p2;
+	if (!gotPkgName) {
+	    namesMatch = 0;
+	} else {
+	    namesMatch = 1;
 	    for (p1 = argv[2], p2 = pkgPtr->packageName; ; p1++, p2++) {
-		if ((isupper(*p1) ? tolower(*p1) : *p1)
-			!= (isupper(*p2) ? tolower(*p2) : *p2)) {
-		    if (fullFileName[0] == 0) {
-			/*
-			 * We're looking for a statically loaded package;
-			 * the file name is basically irrelevant here, so
-			 * don't get upset that there's some other package
-			 * with the same (empty string) file name.  Just
-			 * skip this package and go on to the next.
-			 */
-
-			goto nextPackage;
-		    }
-		    Tcl_AppendResult(interp, "file \"", fullFileName,
-			    "\" is already loaded for package \"",
-			    pkgPtr->packageName, "\"", (char *) NULL);
-		    code = TCL_ERROR;
-		    goto done;
+		if ((isupper(UCHAR(*p1)) ? tolower(UCHAR(*p1)) : *p1)
+			!= (isupper(UCHAR(*p2)) ? tolower(UCHAR(*p2)) : *p2)) {
+		    namesMatch = 0;
+		    break;
 		}
 		if (*p1 == 0) {
-		    goto gotPkg;
+		    break;
 		}
 	    }
-	    nextPackage:
-	    continue;
 	}
-	break;
+	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
+	if (filesMatch && (namesMatch || !gotPkgName)) {
+	    break;
+	}
+	if (namesMatch && (fullFileName[0] == 0)) {
+	    defaultPtr = pkgPtr;
+	}
+	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
+	    /*
+	     * Can't have two different packages loaded from the same
+	     * file.
+	     */
+
+	    Tcl_AppendResult(interp, "file \"", fullFileName,
+		    "\" is already loaded for package \"",
+		    pkgPtr->packageName, "\"", (char *) NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+    }
+    if (pkgPtr == NULL) {
+	pkgPtr = defaultPtr;
     }
-    gotPkg:
 
     /*
-     * If the file is already loaded in the target interpreter then
-     * there's nothing for us to do.
+     * Scan through the list of packages already loaded in the target
+     * interpreter.  If the package we want is already loaded there,
+     * then there's nothing for us to to.
      */
 
-    ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
-	    (Tcl_InterpDeleteProc **) NULL);
     if (pkgPtr != NULL) {
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
 	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	    if (ipPtr->pkgPtr == pkgPtr) {
 		code = TCL_OK;
@@ -230,9 +242,9 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
 		/*
 		 * The platform-specific code couldn't figure out the
 		 * module name.  Make a guess by taking the last element
-		 * of the file name, stripping off any leading "lib", and
-		 * then using all of the alphabetic characters that follow
-		 * that.
+		 * of the file name, stripping off any leading "lib",
+		 * and then using all of the alphabetic and underline
+		 * characters that follow that.
 		 */
 
 		Tcl_SplitPath(fullFileName, &pargc, &pargv);
@@ -241,7 +253,7 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
 			&& (pkgGuess[2] == 'b')) {
 		    pkgGuess += 3;
 		}
-		for (p = pkgGuess; isalpha(*p); p++) {
+		for (p = pkgGuess; isalpha(UCHAR(*p)) || (*p == '_'); p++) {
 		    /* Empty loop body. */
 		}
 		if (p == pkgGuess) {
@@ -435,6 +447,19 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr, *ipFirstPtr;
 
+    /*
+     * Check to see if someone else has already reported this package as
+     * statically loaded.  If this call is redundant then just return.
+     */
+
+    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
+	if ((pkgPtr->initProc == initProc)
+		&& (pkgPtr->safeInitProc == safeInitProc)
+		&& (strcmp(pkgPtr->packageName, pkgName) == 0)) {
+	    return;
+	}
+    }
+
     if (firstPackagePtr == NULL) {
 	Tcl_CreateExitHandler(LoadExitProc, (ClientData) NULL);
     }
diff --git a/contrib/tcl/generic/tclLoadNone.c b/contrib/tcl/generic/tclLoadNone.c
index 87b56e0..86d1ca5 100644
--- a/contrib/tcl/generic/tclLoadNone.c
+++ b/contrib/tcl/generic/tclLoadNone.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclLoadNone.c 1.5 96/02/15 11:43:01
+ * SCCS: @(#) tclLoadNone.c 1.6 97/05/14 13:23:38
  */
 
 #include "tclInt.h"
@@ -45,8 +45,9 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
 				/* Where to return the addresses corresponding
 				 * to sym1 and sym2. */
 {
-    interp->result =
-	    "dynamic loading is not currently available on this system";
+    Tcl_SetResult(interp,
+	    "dynamic loading is not currently available on this system",
+	    TCL_STATIC);
     return TCL_ERROR;
 }
 
diff --git a/contrib/tcl/generic/tclMain.c b/contrib/tcl/generic/tclMain.c
index d7b029d..6ed86e5 100644
--- a/contrib/tcl/generic/tclMain.c
+++ b/contrib/tcl/generic/tclMain.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclMain.c 1.50 96/04/10 16:40:57
+ * SCCS: @(#) tclMain.c 1.52 96/10/22 11:23:51
  */
 
 #include "tcl.h"
@@ -89,7 +89,6 @@ Tcl_Main(argc, argv, appInitProc)
     int code, gotPartial, tty, length;
     int exitCode = 0;
     Tcl_Channel inChannel, outChannel, errChannel;
-    Tcl_DString temp;
 
     Tcl_FindExecutable(argv[0]);
     interp = Tcl_CreateInterp();
@@ -114,7 +113,7 @@ Tcl_Main(argc, argv, appInitProc)
     args = Tcl_Merge(argc-1, argv+1);
     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
     ckfree(args);
-    sprintf(buffer, "%d", argc-1);
+    TclFormatInt(buffer, argc-1);
     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
 	    TCL_GLOBAL_ONLY);
@@ -171,40 +170,7 @@ Tcl_Main(argc, argv, appInitProc)
      * file if the application specified one and if the file exists.
      */
 
-    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
-
-    if (fileName != NULL) {
-        Tcl_Channel c;
-	char *fullName;
-
-        Tcl_DStringInit(&temp);
-	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
-	if (fullName == NULL) {
-	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	    if (errChannel) {
-		Tcl_Write(errChannel, interp->result, -1);
-		Tcl_Write(errChannel, "\n", 1);
-	    }
-	} else {
-
-	    /*
-	     * Test for the existence of the rc file before trying to read it.
-	     */
-
-            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
-            if (c != (Tcl_Channel) NULL) {
-                Tcl_Close(NULL, c);
-		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
-		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-		    if (errChannel) {
-			Tcl_Write(errChannel, interp->result, -1);
-			Tcl_Write(errChannel, "\n", 1);
-		    }
-		}
-	    }
-	}
-        Tcl_DStringFree(&temp);
-    }
+    Tcl_SourceRCFile(interp);
 
     /*
      * Process commands from stdin until there's an end-of-file.  Note
diff --git a/contrib/tcl/generic/tclNamesp.c b/contrib/tcl/generic/tclNamesp.c
new file mode 100644
index 0000000..2155ddf
--- /dev/null
+++ b/contrib/tcl/generic/tclNamesp.c
@@ -0,0 +1,3770 @@
+/*
+ * tclNamesp.c --
+ *
+ *      Contains support for namespaces, which provide a separate context of
+ *      commands and global variables. The global :: namespace is the
+ *      traditional Tcl "global" scope. Other namespaces are created as
+ *      children of the global namespace. These other namespaces contain
+ *      special-purpose commands and variables for packages.
+ *
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * Originally implemented by
+ *   Michael J. McLennan
+ *   Bell Labs Innovations for Lucent Technologies
+ *   mmclennan@lucent.com
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclNamesp.c 1.21 97/06/20 15:21:04
+ */
+
+#include "tclInt.h"
+
+/*
+ * Flag passed to TclGetNamespaceForQualName to indicate that it should
+ * search for a namespace rather than a command or variable inside a
+ * namespace. Note that this flag's value must not conflict with the values
+ * of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or CREATE_NS_IF_UNKNOWN.
+ */
+
+#define FIND_ONLY_NS	0x1000
+
+/*
+ * Count of the number of namespaces created. This value is used as a
+ * unique id for each namespace.
+ */
+
+static long numNsCreated = 0; 
+
+/*
+ * Data structure used as the ClientData of imported commands: commands
+ * created in an namespace when it imports a "real" command from another
+ * namespace.
+ */
+
+typedef struct ImportedCmdData {
+    Command *realCmdPtr;	/* "Real" command that this imported command
+                                 * refers to. */
+    Command *selfPtr;		/* Pointer to this imported command. Needed
+				 * only when deleting it in order to remove
+				 * it from the real command's linked list of
+				 * imported commands that refer to it. */
+} ImportedCmdData;
+
+/*
+ * This structure contains a cached pointer to a namespace that is the
+ * result of resolving the namespace's name in some other namespace. It is
+ * the internal representation for a nsName object. It contains the
+ * pointer along with some information that is used to check the cached
+ * pointer's validity.
+ */
+
+typedef struct ResolvedNsName {
+    Namespace *nsPtr;		/* A cached namespace pointer. */
+    long nsId;			/* nsPtr's unique namespace id. Used to
+				 * verify that nsPtr is still valid
+				 * (e.g., it's possible that the namespace
+				 * was deleted and a new one created at
+				 * the same address). */
+    Namespace *refNsPtr;	/* Points to the namespace containing the
+				 * reference (not the namespace that
+				 * contains the referenced namespace). */
+    int refCount;		/* Reference count: 1 for each nsName
+				 * object that has a pointer to this
+				 * ResolvedNsName structure as its internal
+				 * rep. This structure can be freed when
+				 * refCount becomes zero. */
+} ResolvedNsName;
+
+/*
+ * Declarations for procedures local to this file:
+ */
+
+static void		DeleteImportedCmd _ANSI_ARGS_((
+			    ClientData clientData));
+static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr));
+static void		FreeNsNameInternalRep _ANSI_ARGS_((
+			    Tcl_Obj *objPtr));
+static int		GetNamespaceFromObj _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    Tcl_Namespace **nsPtrPtr));
+static int		InvokeImportedCmd _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceChildrenCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceCodeCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceCurrentCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceDeleteCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceEvalCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceExportCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceForgetCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static void		NamespaceFree _ANSI_ARGS_((Namespace *nsPtr));
+static int		NamespaceImportCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceInscopeCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceOriginCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceParentCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceQualifiersCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceTailCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceWhichCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		SetNsNameFromAny _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Obj *objPtr));
+static void		UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * This structure defines a Tcl object type that contains a
+ * namespace reference.  It is used in commands that take the
+ * name of a namespace as an argument.  The namespace reference
+ * is resolved, and the result in cached in the object.
+ */
+
+Tcl_ObjType tclNsNameType = {
+    "nsName",			/* the type's name */
+    FreeNsNameInternalRep,	/* freeIntRepProc */
+    DupNsNameInternalRep,	/* dupIntRepProc */
+    UpdateStringOfNsName,	/* updateStringProc */
+    SetNsNameFromAny		/* setFromAnyProc */
+};
+
+/*
+ * Boolean flag indicating whether or not the namespName object
+ * type has been registered with the Tcl compiler.
+ */
+
+static int nsInitialized = 0;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitNamespaces --
+ *
+ *	Called when any interpreter is created to make sure that
+ *	things are properly set up for namespaces.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	On the first call, the namespName object type is registered
+ *	with the Tcl compiler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitNamespaces()
+{
+    if (!nsInitialized) {
+        Tcl_RegisterObjType(&tclNsNameType);
+        nsInitialized = 1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentNamespace --
+ *
+ *	Returns a pointer to an interpreter's currently active namespace.
+ *
+ * Results:
+ *	Returns a pointer to the interpreter's current namespace.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_GetCurrentNamespace(interp)
+    register Tcl_Interp *interp; /* Interpreter whose current namespace is
+				  * being queried. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Namespace *nsPtr;
+
+    if (iPtr->varFramePtr != NULL) {
+        nsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        nsPtr = iPtr->globalNsPtr;
+    }
+    return (Tcl_Namespace *) nsPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetGlobalNamespace --
+ *
+ *	Returns a pointer to an interpreter's global :: namespace.
+ *
+ * Results:
+ *	Returns a pointer to the specified interpreter's global namespace.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_GetGlobalNamespace(interp)
+    register Tcl_Interp *interp; /* Interpreter whose global namespace 
+				  * should be returned. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    
+    return (Tcl_Namespace *) iPtr->globalNsPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PushCallFrame --
+ *
+ *	Pushes a new call frame onto the interpreter's Tcl call stack.
+ *	Called when executing a Tcl procedure or a "namespace eval" or
+ *	"namespace inscope" command. 
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result object) if something goes wrong.
+ *
+ * Side effects:
+ *	Modifies the interpreter's Tcl call stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
+    Tcl_Interp *interp;		 /* Interpreter in which the new call frame
+				  * is to be pushed. */
+    Tcl_CallFrame *callFramePtr; /* Points to a call frame structure to
+				  * push. Storage for this have already been
+				  * allocated by the caller; typically this
+				  * is the address of a CallFrame structure
+				  * allocated on the caller's C stack.  The
+				  * call frame will be initialized by this
+				  * procedure. The caller can pop the frame
+				  * later with Tcl_PopCallFrame, and it is
+				  * responsible for freeing the frame's
+				  * storage. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace in which the
+				  * frame will execute. If NULL, the
+				  * interpreter's current namespace will
+				  * be used. */
+    int isProcCallFrame;	 /* If nonzero, the frame represents a
+				  * called Tcl procedure and may have local
+				  * vars. Vars will ordinarily be looked up
+				  * in the frame. If new variables are
+				  * created, they will be created in the
+				  * frame. If 0, the frame is for a
+				  * "namespace eval" or "namespace inscope"
+				  * command and var references are treated
+				  * as references to namespace variables. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register CallFrame *framePtr = (CallFrame *) callFramePtr;
+    register Namespace *nsPtr;
+
+    if (namespacePtr == NULL) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+        if (nsPtr->flags & NS_DEAD) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "namespace \"",
+		    nsPtr->fullName, "\" not found in context \"",
+		    Tcl_GetCurrentNamespace(interp)->fullName, "\"",
+		    (char *) NULL);
+            return TCL_ERROR;
+        }
+    }
+
+    nsPtr->activationCount++;
+    framePtr->nsPtr = nsPtr;
+    framePtr->isProcCallFrame = isProcCallFrame;
+    framePtr->objc = 0;
+    framePtr->objv = NULL;
+    framePtr->callerPtr = iPtr->framePtr;
+    framePtr->callerVarPtr = iPtr->varFramePtr;
+    if (iPtr->varFramePtr != NULL) {
+        framePtr->level = (iPtr->varFramePtr->level + 1);
+    } else {
+        framePtr->level = 1;
+    }
+    framePtr->procPtr = NULL; 	   /* no called procedure */
+    framePtr->varTablePtr = NULL;  /* and no local variables */
+    framePtr->numCompiledLocals = 0;
+    framePtr->compiledLocals = NULL;
+
+    /*
+     * Push the new call frame onto the interpreter's stack of procedure
+     * call frames making it the current frame.
+     */
+
+    iPtr->framePtr = framePtr;
+    iPtr->varFramePtr = framePtr;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PopCallFrame --
+ *
+ *	Removes a call frame from the Tcl call stack for the interpreter.
+ *	Called to remove a frame previously pushed by Tcl_PushCallFrame.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Modifies the call stack of the interpreter. Resets various fields of
+ *	the popped call frame. If a namespace has been deleted and
+ *	has no more activations on the call stack, the namespace is
+ *	destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_PopCallFrame(interp)
+    Tcl_Interp* interp;		/* Interpreter with call frame to pop. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register CallFrame *framePtr = iPtr->framePtr;
+    int saveErrFlag;
+    Namespace *nsPtr;
+
+    /*
+     * It's important to remove the call frame from the interpreter's stack
+     * of call frames before deleting local variables, so that traces
+     * invoked by the variable deletion don't see the partially-deleted
+     * frame.
+     */
+
+    iPtr->framePtr = framePtr->callerPtr;
+    iPtr->varFramePtr = framePtr->callerVarPtr;
+
+    /*
+     * Delete the local variables. As a hack, we save then restore the
+     * ERR_IN_PROGRESS flag in the interpreter. The problem is that there
+     * could be unset traces on the variables, which cause scripts to be
+     * evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack
+     * trace information if the procedure was exiting with an error. The
+     * code below preserves the flag. Unfortunately, that isn't really
+     * enough: we really should preserve the errorInfo variable too
+     * (otherwise a nested error in the trace script will trash errorInfo).
+     * What's really needed is a general-purpose mechanism for saving and
+     * restoring interpreter state.
+     */
+
+    saveErrFlag = (iPtr->flags & ERR_IN_PROGRESS);
+
+    if (framePtr->varTablePtr != NULL) {
+        TclDeleteVars(iPtr, framePtr->varTablePtr);
+        ckfree((char *) framePtr->varTablePtr);
+        framePtr->varTablePtr = NULL;
+    }
+    if (framePtr->numCompiledLocals > 0) {
+        TclDeleteCompiledLocalVars(iPtr, framePtr);
+    }
+
+    iPtr->flags |= saveErrFlag;
+
+    /*
+     * Decrement the namespace's count of active call frames. If the
+     * namespace is "dying" and there are no more active call frames,
+     * call Tcl_DeleteNamespace to destroy it.
+     */
+
+    nsPtr = framePtr->nsPtr;
+    nsPtr->activationCount--;
+    if ((nsPtr->flags & NS_DYING)
+	    && (nsPtr->activationCount == 0)) {
+        Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
+    }
+    framePtr->nsPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateNamespace --
+ *
+ *	Creates a new namespace with the given name. If there is no
+ *	active namespace (i.e., the interpreter is being initialized),
+ *	the global :: namespace is created and returned.
+ *
+ * Results:
+ *	Returns a pointer to the new namespace if successful. If the
+ *	namespace already exists or if another error occurs, this routine
+ *	returns NULL, along with an error message in the interpreter's
+ *	result object.
+ *
+ * Side effects:
+ *	If the name contains "::" qualifiers and a parent namespace does
+ *	not already exist, it is automatically created. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_CreateNamespace(interp, name, clientData, deleteProc)
+    Tcl_Interp *interp;             /* Interpreter in which a new namespace
+				     * is being created. Also used for
+				     * error reporting. */
+    char *name;                     /* Name for the new namespace. May be a
+				     * qualified name with names of ancestor
+				     * namespaces separated by "::"s. */
+    ClientData clientData;	    /* One-word value to store with
+				     * namespace. */
+    Tcl_NamespaceDeleteProc *deleteProc;
+    				    /* Procedure called to delete client
+				     * data when the namespace is deleted.
+				     * NULL if no procedure should be
+				     * called.*/
+{
+    Interp *iPtr = (Interp *) interp;
+    register Namespace *nsPtr, *ancestorPtr;
+    Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
+    Namespace *globalNsPtr = iPtr->globalNsPtr;
+    Tcl_HashEntry *entryPtr;
+    Tcl_DString buffer1, buffer2;
+    int newEntry, result;
+
+    /*
+     * Check first if there is no active namespace. If so, we assume
+     * the interpreter is being initialized. 
+     */
+
+    if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {
+	/*
+	 * Treat this namespace as the global namespace, and avoid
+	 * looking for a parent.
+	 */
+	
+        parentPtr = NULL;
+        name = "";
+    } else {
+	/*
+	 * There is no active namespace. Find the parent namespace that will
+	 * contain the new namespace.
+	 */
+
+	result = TclGetNamespaceForQualName(interp, name,
+		(Namespace *) NULL,
+		/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+		&parentPtr, &dummy1Ptr, &dummy2Ptr, &name);
+        if (result != TCL_OK) {
+            return NULL;
+        }
+
+        /*
+         * Check for a bad namespace name and make sure that the name
+	 * does not already exist in the parent namespace.
+	 */
+
+        if ((name == NULL) || (*name == '\0')) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "can't create namespace \"", name,
+    	    	    "\": invalid name", (char *) NULL);
+            return NULL;
+        }
+        if (Tcl_FindHashEntry(&parentPtr->childTable, name) != NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "can't create namespace \"", name,
+    	    	    "\": already exists", (char *) NULL);
+            return NULL;
+        }
+    }
+
+    /*
+     * Create the new namespace and root it in its parent. Increment the
+     * count of namespaces created.
+     */
+
+    numNsCreated++;
+
+    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
+    nsPtr->name            = (char *) ckalloc((unsigned) (strlen(name)+1));
+    strcpy(nsPtr->name, name);
+    nsPtr->fullName        = NULL;   /* set below */
+    nsPtr->clientData      = clientData;
+    nsPtr->deleteProc      = deleteProc;
+    nsPtr->parentPtr       = parentPtr;
+    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
+    nsPtr->nsId            = numNsCreated;
+    nsPtr->interp          = interp;
+    nsPtr->flags           = 0;
+    nsPtr->activationCount = 0;
+    nsPtr->refCount        = 0;
+    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    nsPtr->exportArrayPtr  = NULL;
+    nsPtr->numExportPatterns = 0;
+    nsPtr->maxExportPatterns = 0;
+    nsPtr->cmdRefEpoch     = 0;
+
+    if (parentPtr != NULL) {
+        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, name,
+	        &newEntry);
+        Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+    }
+
+    /*
+     * Build the fully qualified name for this namespace.
+     */
+
+    Tcl_DStringInit(&buffer1);
+    Tcl_DStringInit(&buffer2);
+    for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
+	    ancestorPtr = ancestorPtr->parentPtr) {
+        if (ancestorPtr != globalNsPtr) {
+            Tcl_DStringAppend(&buffer1, "::", 2);
+            Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
+        }
+        Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);
+
+        Tcl_DStringSetLength(&buffer2, 0);
+        Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
+        Tcl_DStringSetLength(&buffer1, 0);
+    }
+    
+    name = Tcl_DStringValue(&buffer2);
+    nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
+    strcpy(nsPtr->fullName, name);
+
+    Tcl_DStringFree(&buffer1);
+    Tcl_DStringFree(&buffer2);
+
+    /*
+     * Return a pointer to the new namespace.
+     */
+
+    return (Tcl_Namespace *) nsPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteNamespace --
+ *
+ *	Deletes a namespace and all of the commands, variables, and other
+ *	namespaces within it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When a namespace is deleted, it is automatically removed as a
+ *	child of its parent namespace. Also, all its commands, variables
+ *	and child namespaces are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteNamespace(namespacePtr)
+    Tcl_Namespace *namespacePtr;   /* Points to the namespace to delete. */
+{
+    register Namespace *nsPtr = (Namespace *) namespacePtr;
+    Interp *iPtr = (Interp *) nsPtr->interp;
+    Namespace *globalNsPtr =
+	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
+    Tcl_HashEntry *entryPtr;
+
+    /*
+     * If the namespace is on the call frame stack, it is marked as "dying"
+     * (NS_DYING is OR'd into its flags): the namespace can't be looked up
+     * by name but its commands and variables are still usable by those
+     * active call frames. When all active call frames referring to the
+     * namespace have been popped from the Tcl stack, Tcl_PopCallFrame will
+     * call this procedure again to delete everything in the namespace.
+     * If no nsName objects refer to the namespace (i.e., if its refCount 
+     * is zero), its commands and variables are deleted and the storage for
+     * its namespace structure is freed. Otherwise, if its refCount is
+     * nonzero, the namespace's commands and variables are deleted but the
+     * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
+     * flags to allow the namespace resolution code to recognize that the
+     * namespace is "deleted". The structure's storage is freed by
+     * FreeNsNameInternalRep when its refCount reaches 0.
+     */
+
+    if (nsPtr->activationCount > 0) {
+        nsPtr->flags |= NS_DYING;
+        if (nsPtr->parentPtr != NULL) {
+            entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+		    nsPtr->name);
+            if (entryPtr != NULL) {
+                Tcl_DeleteHashEntry(entryPtr);
+            }
+        }
+        nsPtr->parentPtr = NULL;
+    } else {
+	/*
+	 * Delete the namespace and everything in it. If this is the global
+	 * namespace, then clear it but don't free its storage unless the
+	 * interpreter is being torn down.
+	 */
+
+        TclTeardownNamespace(nsPtr);
+
+        if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
+            /*
+	     * If this is the global namespace, then it may have residual
+             * "errorInfo" and "errorCode" variables for errors that
+             * occurred while it was being torn down.  Try to clear the
+             * variable list one last time.
+	     */
+
+            TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
+	    
+            Tcl_DeleteHashTable(&nsPtr->childTable);
+            Tcl_DeleteHashTable(&nsPtr->cmdTable);
+
+            /*
+             * If the reference count is 0, then discard the namespace.
+             * Otherwise, mark it as "dead" so that it can't be used.
+             */
+
+            if (nsPtr->refCount == 0) {
+                NamespaceFree(nsPtr);
+            } else {
+                nsPtr->flags |= NS_DEAD;
+            }
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTeardownNamespace --
+ *
+ *	Used internally to dismantle and unlink a namespace when it is
+ *	deleted. Divorces the namespace from its parent, and deletes all
+ *	commands, variables, and child namespaces.
+ *
+ *	This is kept separate from Tcl_DeleteNamespace so that the global
+ *	namespace can be handled specially. Global variables like
+ *	"errorInfo" and "errorCode" need to remain intact while other
+ *	namespaces and commands are torn down, in case any errors occur.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes this namespace from its parent's child namespace hashtable.
+ *	Deletes all commands, variables and namespaces in this namespace.
+ *	If this is the global namespace, the "errorInfo" and "errorCode"
+ *	variables are left alone and deleted later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclTeardownNamespace(nsPtr)
+    register Namespace *nsPtr;	/* Points to the namespace to be dismantled
+				 * and unlinked from its parent. */
+{
+    Interp *iPtr = (Interp *) nsPtr->interp;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_Namespace *childNsPtr;
+    Tcl_Command cmd;
+    Namespace *globalNsPtr =
+	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
+    int i;
+
+    /*
+     * Start by destroying the namespace's variable table,
+     * since variables might trigger traces.
+     */
+
+    if (nsPtr == globalNsPtr) {
+	/*
+	 * This is the global namespace, so be careful to preserve the
+	 * "errorInfo" and "errorCode" variables. These might be needed
+	 * later on if errors occur while deleting commands. We are careful
+	 * to destroy and recreate the "errorInfo" and "errorCode"
+	 * variables, in case they had any traces on them.
+	 */
+    
+        char *str, *errorInfoStr, *errorCodeStr;
+
+        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY);
+        if (str != NULL) {
+            errorInfoStr = ckalloc((unsigned) (strlen(str)+1));
+            strcpy(errorInfoStr, str);
+        } else {
+            errorInfoStr = NULL;
+        }
+
+        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY);
+        if (str != NULL) {
+            errorCodeStr = ckalloc((unsigned) (strlen(str)+1));
+            strcpy(errorCodeStr, str);
+        } else {
+            errorCodeStr = NULL;
+        }
+
+        TclDeleteVars(iPtr, &nsPtr->varTable);
+        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+
+        if (errorInfoStr != NULL) {
+            Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr,
+                TCL_GLOBAL_ONLY);
+            ckfree(errorInfoStr);
+        }
+        if (errorCodeStr != NULL) {
+            Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr,
+                TCL_GLOBAL_ONLY);
+            ckfree(errorCodeStr);
+        }
+    } else {
+	/*
+	 * Variable table should be cleared but not freed! TclDeleteVars
+	 * frees it, so we reinitialize it afterwards.
+	 */
+    
+        TclDeleteVars(iPtr, &nsPtr->varTable);
+        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    }
+
+    /*
+     * Remove the namespace from its parent's child hashtable.
+     */
+
+    if (nsPtr->parentPtr != NULL) {
+        entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+	        nsPtr->name);
+        if (entryPtr != NULL) {
+            Tcl_DeleteHashEntry(entryPtr);
+        }
+    }
+    nsPtr->parentPtr = NULL;
+
+    /*
+     * Delete all the child namespaces.
+     *
+     * BE CAREFUL: When each child is deleted, it will divorce
+     *    itself from its parent. You can't traverse a hash table
+     *    properly if its elements are being deleted. We use only
+     *    the Tcl_FirstHashEntry function to be safe.
+     */
+
+    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
+        childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
+        Tcl_DeleteNamespace(childNsPtr);
+    }
+
+    /*
+     * Delete all commands in this namespace. Be careful when traversing the
+     * hash table: when each command is deleted, it removes itself from the
+     * command table. There's a special hack here because "tkerror" is just
+     * a synonym for "bgerror" (they share a Command structure). Just
+     * delete the hash table entry for "tkerror" without invoking its
+     * callback or cleaning up its Command structure.
+     */
+
+    hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, "tkerror");
+    if (hPtr != NULL) {
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+            entryPtr != NULL;
+            entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
+        cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+        Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+    }
+    Tcl_DeleteHashTable(&nsPtr->cmdTable);
+    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
+
+    /*
+     * Free the namespace's export pattern array.
+     */
+
+    if (nsPtr->exportArrayPtr != NULL) {
+	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
+	    ckfree(nsPtr->exportArrayPtr[i]);
+	}
+        ckfree((char *) nsPtr->exportArrayPtr);
+	nsPtr->exportArrayPtr = NULL;
+	nsPtr->numExportPatterns = 0;
+	nsPtr->maxExportPatterns = 0;
+    }
+
+    /*
+     * Free any client data associated with the namespace.
+     */
+
+    if (nsPtr->deleteProc != NULL) {
+        (*nsPtr->deleteProc)(nsPtr->clientData);
+    }
+    nsPtr->deleteProc = NULL;
+    nsPtr->clientData = NULL;
+
+    /*
+     * Reset the namespace's id field to ensure that this namespace won't
+     * be interpreted as valid by, e.g., the cache validation code for
+     * cached command references in Tcl_GetCommandFromObj.
+     */
+
+    nsPtr->nsId = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceFree --
+ *
+ *	Called after a namespace has been deleted, when its
+ *	reference count reaches 0.  Frees the data structure
+ *	representing the namespace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NamespaceFree(nsPtr)
+    register Namespace *nsPtr;	/* Points to the namespace to free. */
+{
+    /*
+     * Most of the namespace's contents are freed when the namespace is
+     * deleted by Tcl_DeleteNamespace. All that remains is to free its names
+     * (for error messages), and the structure itself.
+     */
+
+    ckfree(nsPtr->name);
+    ckfree(nsPtr->fullName);
+
+    ckfree((char *) nsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Export --
+ *
+ *	Makes all the commands matching a pattern available to later ber
+ *	imported from the namespace specified by contextNsPtr (or the
+ *	current namespace if contextNsPtr is NULL). The specified pattern is
+ *	appended onto the namespace's export pattern list, which is
+ *	optionally cleared beforehand.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result) if something goes wrong.
+ *
+ * Side effects:
+ *	Appends the export pattern onto the namespace's export list.
+ *	Optionally reset the namespace's export pattern list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
+    Tcl_Interp *interp;		 /* Current interpreter. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace from which 
+				  * commands are to be exported. NULL for
+                                  * the current namespace. */
+    char *pattern;               /* String pattern indicating which commands
+                                  * to export. This pattern may not include
+				  * any namespace qualifiers; only commands
+				  * in the specified namespace may be
+				  * exported. */
+    int resetListFirst;		 /* If nonzero, resets the namespace's
+				  * export list before appending 
+				  * be overwritten by imported commands.
+				  * If 0, return an error if an imported
+				  * cmd conflicts with an existing one. */
+{
+#define INIT_EXPORT_PATTERNS 5    
+    Namespace *nsPtr, *exportNsPtr, *altNsPtr, *dummyPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    char *simplePattern, *patternCpy;
+    int neededElems, len, i, result;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) currNsPtr;
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * If resetListFirst is true (nonzero), clear the namespace's export
+     * pattern list.
+     */
+
+    if (resetListFirst) {
+	if (nsPtr->exportArrayPtr != NULL) {
+	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
+		ckfree(nsPtr->exportArrayPtr[i]);
+	    }
+	    ckfree((char *) nsPtr->exportArrayPtr);
+	    nsPtr->exportArrayPtr = NULL;
+	    nsPtr->numExportPatterns = 0;
+	    nsPtr->maxExportPatterns = 0;
+	}
+    }
+
+    /*
+     * Check that the pattern doesn't have namespace qualifiers.
+     */
+
+    result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
+	    /*flags*/ TCL_LEAVE_ERR_MSG, &exportNsPtr, &altNsPtr,
+	    &dummyPtr, &simplePattern);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (exportNsPtr == NULL) {
+	exportNsPtr = altNsPtr;
+    }
+    if ((exportNsPtr != currNsPtr)
+	    || (strcmp(pattern, simplePattern) != 0)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	        "invalid export pattern \"", pattern,
+		"\": pattern can't specify a namespace",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure there is room in the namespace's pattern array for the
+     * new pattern.
+     */
+
+    neededElems = currNsPtr->numExportPatterns + 1;
+    if (currNsPtr->exportArrayPtr == NULL) {
+	currNsPtr->exportArrayPtr = (char **)
+	        ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
+	currNsPtr->numExportPatterns = 0;
+	currNsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
+    } else if (neededElems > currNsPtr->maxExportPatterns) {
+	int numNewElems = 2 * currNsPtr->maxExportPatterns;
+	size_t currBytes = currNsPtr->numExportPatterns * sizeof(char *);
+	size_t newBytes  = numNewElems * sizeof(char *);
+	char **newPtr = (char **) ckalloc((unsigned) newBytes);
+
+	memcpy((VOID *) newPtr, (VOID *) currNsPtr->exportArrayPtr,
+	        currBytes);
+	ckfree((char *) currNsPtr->exportArrayPtr);
+	currNsPtr->exportArrayPtr = (char **) newPtr;
+	currNsPtr->maxExportPatterns = numNewElems;
+    }
+
+    /*
+     * Add the pattern to the namespace's array of export patterns.
+     */
+
+    len = strlen(pattern);
+    patternCpy = (char *) ckalloc((unsigned) (len + 1));
+    strcpy(patternCpy, pattern);
+    
+    currNsPtr->exportArrayPtr[currNsPtr->numExportPatterns] = patternCpy;
+    currNsPtr->numExportPatterns++;
+    return TCL_OK;
+#undef INIT_EXPORT_PATTERNS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendExportList --
+ *
+ *	Appends onto the argument object the list of export patterns for the
+ *	specified namespace.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case the object
+ *	referenced by objPtr has each export pattern appended to it. If an
+ *	error occurs, TCL_ERROR is returned and the interpreter's result
+ *	holds an error message.
+ *
+ * Side effects:
+ *	If necessary, the object referenced by objPtr is converted into
+ *	a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppendExportList(interp, namespacePtr, objPtr)
+    Tcl_Interp *interp;		 /* Interpreter used for error reporting. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace whose export
+				  * pattern list is appended onto objPtr.
+				  * NULL for the current namespace. */
+    Tcl_Obj *objPtr;		 /* Points to the Tcl object onto which the
+				  * export pattern list is appended. */
+{
+    Namespace *nsPtr;
+    int i, result;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * Append the export pattern list onto objPtr.
+     */
+
+    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
+	result = Tcl_ListObjAppendElement(interp, objPtr,
+		Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1));
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Import --
+ *
+ *	Imports all of the commands matching a pattern into the namespace
+ *	specified by contextNsPtr (or the current namespace if contextNsPtr
+ *	is NULL). This is done by creating a new command (the "imported
+ *	command") that points to the real command in its original namespace.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result) if something goes wrong.
+ *
+ * Side effects:
+ *	Creates new commands in the importing namespace. These indirect
+ *	calls back to the real command and are deleted if the real commands
+ *	are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
+    Tcl_Interp *interp;		 /* Current interpreter. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace into which the
+				  * commands are to be imported. NULL for
+                                  * the current namespace. */
+    char *pattern;               /* String pattern indicating which commands
+                                  * to import. This pattern should be
+				  * qualified by the name of the namespace
+				  * from which to import the command(s). */
+    int allowOverwrite;		 /* If nonzero, allow existing commands to
+				  * be overwritten by imported commands.
+				  * If 0, return an error if an imported
+				  * cmd conflicts with an existing one. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    char *simplePattern, *cmdName;
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+    ImportRef *refPtr;
+    Tcl_Command importedCmd;
+    ImportedCmdData *dataPtr;
+    int wasExported, i, result;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) currNsPtr;
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * From the pattern, find the namespace from which we are importing
+     * and get the simple pattern (no namespace qualifiers or ::'s) at
+     * the end.
+     */
+
+    if (strlen(pattern) == 0) {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	        "empty import pattern", -1);
+        return TCL_ERROR;
+    }
+    result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
+	    /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
+	    &actualCtxPtr, &simplePattern);
+    if (result != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if (importNsPtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown namespace in import pattern \"",
+		pattern, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (importNsPtr == nsPtr) {
+	if (pattern == simplePattern) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "no namespace specified in import pattern \"", pattern,
+		    "\"", (char *) NULL);
+	} else {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "import pattern \"", pattern,
+		    "\" tries to import from namespace \"",
+		    importNsPtr->name, "\" into itself", (char *) NULL);
+	}
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the command table in the source namespace and look for
+     * exported commands that match the string pattern. Create an "imported
+     * command" in the current namespace for each imported command; these
+     * commands redirect their invocations to the "real" command.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
+	    (hPtr != NULL);
+	    hPtr = Tcl_NextHashEntry(&search)) {
+        cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+        if (Tcl_StringMatch(cmdName, simplePattern)) {
+	    /*
+	     * The command cmdName in the source namespace matches the
+	     * pattern. Check whether it was exported. If it wasn't,
+	     * we ignore it.
+	     */
+
+	    wasExported = 0;
+	    for (i = 0;  i < importNsPtr->numExportPatterns;  i++) {
+		if (Tcl_StringMatch(cmdName,
+			importNsPtr->exportArrayPtr[i])) {
+		    wasExported = 1;
+		    break;
+		}
+	    }
+	    if (!wasExported) {
+		continue;
+            }
+
+	    /*
+	     * Unless there is a name clash, create an imported command
+	     * in the current namespace that refers to cmdPtr.
+	     */
+	    
+            if ((Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL)
+		    || allowOverwrite) {
+		/*
+		 * Create the imported command and its client data.
+		 * To create the new command in the current namespace, 
+		 * generate a fully qualified name for it.
+		 */
+
+		Tcl_DString ds;
+
+		Tcl_DStringInit(&ds);
+		Tcl_DStringAppend(&ds, currNsPtr->fullName, -1);
+		if (currNsPtr != iPtr->globalNsPtr) {
+		    Tcl_DStringAppend(&ds, "::", 2);
+		}
+		Tcl_DStringAppend(&ds, cmdName, -1);
+		
+		cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+		dataPtr = (ImportedCmdData *)
+		        ckalloc(sizeof(ImportedCmdData));
+                importedCmd = Tcl_CreateObjCommand(interp, 
+                        Tcl_DStringValue(&ds), InvokeImportedCmd,
+                        (ClientData) dataPtr, DeleteImportedCmd);
+		dataPtr->realCmdPtr = cmdPtr;
+		dataPtr->selfPtr = (Command *) importedCmd;
+
+		/*
+		 * Create an ImportRef structure describing this new import
+		 * command and add it to the import ref list in the "real"
+		 * command.
+		 */
+
+                refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+                refPtr->importedCmdPtr = (Command *) importedCmd;
+                refPtr->nextPtr = cmdPtr->importRefPtr;
+                cmdPtr->importRefPtr = refPtr;
+            } else {
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		        "can't import command \"", cmdName,
+			"\": already exists", (char *) NULL);
+                return TCL_ERROR;
+            }
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ForgetImport --
+ *
+ *	Deletes previously imported commands. Given a pattern that may
+ *	include the name of an exporting namespace, this procedure first
+ *	finds all matching exported commands. It then looks in the namespace
+ *	specified by namespacePtr for any corresponding previously imported
+ *	commands, which it deletes. If namespacePtr is NULL, commands are
+ *	deleted from the current namespace.
+ *
+ * Results:
+ *	Returns TCL_OK if successful. If there is an error, returns
+ *	TCL_ERROR and puts an error message in the interpreter's result
+ *	object.
+ *
+ * Side effects:
+ *	May delete commands. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ForgetImport(interp, namespacePtr, pattern)
+    Tcl_Interp *interp;		 /* Current interpreter. */
+    Tcl_Namespace *namespacePtr; /* Points to the namespace from which
+				  * previously imported commands should be
+				  * removed. NULL for current namespace. */
+    char *pattern;		 /* String pattern indicating which imported
+				  * commands to remove. This pattern should
+				  * be qualified by the name of the
+				  * namespace from which the command(s) were
+				  * imported. */
+{
+    Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr;
+    char *simplePattern, *cmdName;
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+    int result;
+
+    /*
+     * If the specified namespace is NULL, use the current namespace.
+     */
+
+    if (namespacePtr == NULL) {
+        nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else {
+        nsPtr = (Namespace *) namespacePtr;
+    }
+
+    /*
+     * From the pattern, find the namespace from which we are importing
+     * and get the simple pattern (no namespace qualifiers or ::'s) at
+     * the end.
+     */
+
+    result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
+	    /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
+	    &actualCtxPtr, &simplePattern);
+    if (result != TCL_OK) {
+        return result;
+    }
+    if (importNsPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown namespace in namespace forget pattern \"",
+		pattern, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the command table in the source namespace and look for
+     * exported commands that match the string pattern. If the current
+     * namespace has an imported command that refers to one of those real
+     * commands, delete it.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
+            (hPtr != NULL);
+            hPtr = Tcl_NextHashEntry(&search)) {
+        cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+        if (Tcl_StringMatch(cmdName, simplePattern)) {
+            hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
+            if (hPtr != NULL) {	/* cmd of same name in current namespace */
+                cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+                if (cmdPtr->deleteProc == DeleteImportedCmd) { 
+                    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+                }
+            }
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetOriginalCommand --
+ *
+ *	An imported command is created in an namespace when it imports a
+ *	"real" command from another namespace. If the specified command is a
+ *	imported command, this procedure returns the original command it
+ *	refers to.  
+ *
+ * Results:
+ *	If the command was imported into a sequence of namespaces a, b,...,n
+ *	where each successive namespace just imports the command from the
+ *	previous namespace, this procedure returns the Tcl_Command token in
+ *	the first namespace, a. Otherwise, if the specified command is not
+ *	an imported command, the procedure returns NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclGetOriginalCommand(command)
+    Tcl_Command command;	/* The command for which the original
+				 * command should be returned. */
+{
+    register Command *cmdPtr = (Command *) command;
+    ImportedCmdData *dataPtr;
+
+    if (cmdPtr->deleteProc != DeleteImportedCmd) {
+	return (Tcl_Command) NULL;
+    }
+    
+    while (cmdPtr->deleteProc == DeleteImportedCmd) {
+	dataPtr = (ImportedCmdData *) cmdPtr->objClientData;
+	cmdPtr = dataPtr->realCmdPtr;
+    }
+    return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeImportedCmd --
+ *
+ *	Invoked by Tcl whenever the user calls an imported command that
+ *	was created by Tcl_Import. Finds the "real" command (in another
+ *	namespace), and passes control to it.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result object is set to an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InvokeImportedCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Points to the imported command's
+				 * ImportedCmdData structure. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    register Command *realCmdPtr = dataPtr->realCmdPtr;
+
+    return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+            objc, objv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteImportedCmd --
+ *
+ *	Invoked by Tcl whenever an imported command is deleted. The "real"
+ *	command keeps a list of all the imported commands that refer to it,
+ *	so those imported commands can be deleted when the real command is
+ *	deleted. This procedure removes the imported command reference from
+ *	the real command's list, and frees up the memory associated with
+ *	the imported command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes the imported command from the real command's import list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteImportedCmd(clientData)
+    ClientData clientData;	/* Points to the imported command's
+				 * ImportedCmdData structure. */
+{
+    ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    Command *realCmdPtr = dataPtr->realCmdPtr;
+    Command *selfPtr = dataPtr->selfPtr;
+    register ImportRef *refPtr, *prevPtr;
+
+    prevPtr = NULL;
+    for (refPtr = realCmdPtr->importRefPtr;  refPtr != NULL;
+            refPtr = refPtr->nextPtr) {
+	if (refPtr->importedCmdPtr == selfPtr) {
+	    /*
+	     * Remove *refPtr from real command's list of imported commands
+	     * that refer to it.
+	     */
+	    
+	    if (prevPtr == NULL) { /* refPtr is first in list */
+		realCmdPtr->importRefPtr = refPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = refPtr->nextPtr;
+	    }
+	    ckfree((char *) refPtr);
+	    ckfree((char *) dataPtr);
+	    return;
+	}
+	prevPtr = refPtr;
+    }
+	
+    panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetNamespaceForQualName --
+ *
+ *	Given a qualified name specifying a command, variable, or namespace,
+ *	and a namespace in which to resolve the name, this procedure returns
+ *	a pointer to the namespace that contains the item. A qualified name
+ *	consists of the "simple" name of an item qualified by the names of
+ *	an arbitrary number of containing namespace separated by "::"s. If
+ *	the qualified name starts with "::", it is interpreted absolutely
+ *	from the global namespace. Otherwise, it is interpreted relative to
+ *	the namespace specified by cxtNsPtr if it is non-NULL. If cxtNsPtr
+ *	is NULL, the name is interpreted relative to the current namespace.
+ *
+ *	A relative name like "foo::bar::x" can be found starting in either
+ *	the current namespace or in the global namespace. So each search
+ *	usually follows two tracks, and two possible namespaces are
+ *	returned. If the procedure sets either *nsPtrPtr or *altNsPtrPtr to
+ *	NULL, then that path failed.
+ *
+ *	If "flags" contains TCL_GLOBAL_ONLY, the relative qualified name is
+ *	sought only in the global :: namespace. The alternate search
+ *	(also) starting from the global namespace is ignored and
+ *	*altNsPtrPtr is set NULL. 
+ *
+ *	If "flags" contains TCL_NAMESPACE_ONLY, the relative qualified
+ *	name is sought only in the namespace specified by cxtNsPtr. The
+ *	alternate search starting from the global namespace is ignored and
+ *	*altNsPtrPtr is set NULL. If both TCL_GLOBAL_ONLY and
+ *	TCL_NAMESPACE_ONLY are specified, TCL_GLOBAL_ONLY is ignored and
+ *	the search starts from the namespace specified by cxtNsPtr.
+ *
+ *	If "flags" contains CREATE_NS_IF_UNKNOWN, all namespace
+ *	components of the qualified name that cannot be found are
+ *	automatically created within their specified parent. This makes sure
+ *	that functions like Tcl_CreateCommand always succeed. There is no
+ *	alternate search path, so *altNsPtrPtr is set NULL.
+ *
+ *	If "flags" contains FIND_ONLY_NS, the qualified name is treated as a
+ *	reference to a namespace, and the entire qualified name is
+ *	followed. If the name is relative, the namespace is looked up only
+ *	in the current namespace. A pointer to the namespace is stored in
+ *	*nsPtrPtr and NULL is stored in *simpleNamePtr. Otherwise, if
+ *	FIND_ONLY_NS is not specified, only the leading components are
+ *	treated as namespace names, and a pointer to the simple name of the
+ *	final component is stored in *simpleNamePtr.
+ *
+ * Results:
+ *	Ordinarily this procedure returns TCL_OK. It sets *nsPtrPtr and
+ *	*altNsPtrPtr to point to the two possible namespaces which represent
+ *	the last (containing) namespace in the qualified name. If the
+ *	procedure sets either *nsPtrPtr or *altNsPtrPtr to NULL, then the
+ *	search along that path failed. The procedure also stores a pointer
+ *	to the simple name of the final component in *simpleNamePtr. If the
+ *	qualified name is "::" or was treated as a namespace reference
+ *	(FIND_ONLY_NS), the procedure stores a pointer to the
+ *	namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets
+ *	*simpleNamePtr to point to an empty string.
+ *
+ *	If there is an error, this procedure returns TCL_ERROR. If "flags"
+ *	contains TCL_LEAVE_ERR_MSG, an error message is returned in the
+ *	interpreter's result object. Otherwise, the interpreter's result
+ *	object is left unchanged.
+ *
+ *	*actualCxtPtrPtr is set to the actual context namespace. It is
+ *	set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
+ *	is NULL, it is set to the current namespace context.
+ *
+ * Side effects:
+ *	If flags contains TCL_LEAVE_ERR_MSG and an error is encountered,
+ *	the interpreter's result object will contain an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
+	nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
+    Tcl_Interp *interp;		 /* Interpreter in which to find the
+				  * namespace containing qualName. */
+    register char *qualName;	 /* A namespace-qualified name of an
+				  * command, variable, or namespace. */
+    Namespace *cxtNsPtr;	 /* The namespace in which to start the
+				  * search for qualName's namespace. If NULL
+				  * start from the current namespace.
+				  * Ignored if TCL_GLOBAL_ONLY or
+				  * TCL_NAMESPACE_ONLY are set. */
+    int flags;			 /* Flags controlling the search: an OR'd
+				  * combination of TCL_GLOBAL_ONLY,
+				  * TCL_NAMESPACE_ONLY,
+				  * CREATE_NS_IF_UNKNOWN, and
+				  * FIND_ONLY_NS. */
+    Namespace **nsPtrPtr;	 /* Address where procedure stores a pointer
+				  * to containing namespace if qualName is
+				  * found starting from *cxtNsPtr or, if
+				  * TCL_GLOBAL_ONLY is set, if qualName is
+				  * found in the global :: namespace. NULL
+				  * is stored otherwise. */
+    Namespace **altNsPtrPtr;	 /* Address where procedure stores a pointer
+				  * to containing namespace if qualName is
+				  * found starting from the global ::
+				  * namespace. NULL is stored if qualName
+				  * isn't found starting from :: or if the
+				  * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				  * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag
+				  * is set. */
+    Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer
+				  * to the actual namespace from which the
+				  * search started. This is either cxtNsPtr,
+				  * the :: namespace if TCL_GLOBAL_ONLY was
+				  * specified, or the current namespace if
+				  * cxtNsPtr was NULL. */
+    char **simpleNamePtr;	 /* Address where procedure stores the
+				  * simple name at end of the qualName, or
+				  * NULL if qualName is "::" or the flag
+				  * FIND_ONLY_NS was specified. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Namespace *nsPtr = cxtNsPtr;
+    Namespace *altNsPtr;
+    Namespace *globalNsPtr = iPtr->globalNsPtr;
+    register char *start, *end;
+    char *nsName;
+    Tcl_HashEntry *entryPtr;
+    Tcl_DString buffer;
+    int len, result;
+
+    /*
+     * Determine the context namespace nsPtr in which to start the primary
+     * search. If TCL_NAMESPACE_ONLY or FIND_ONLY_NS was specified, search
+     * from the current namespace. If the qualName name starts with a "::"
+     * or TCL_GLOBAL_ONLY was specified, search from the global
+     * namespace. Otherwise, use the given namespace given in cxtNsPtr, or
+     * if that is NULL, use the current namespace context. Note that we
+     * always treat two or more adjacent ":"s as a namespace separator.
+     */
+
+    if (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS)) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else if (flags & TCL_GLOBAL_ONLY) {
+	nsPtr = globalNsPtr;
+    } else if (nsPtr == NULL) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    start = qualName;		/* pts to start of qualifying namespace */
+    if ((*qualName == ':') && (*(qualName+1) == ':')) {
+	start = qualName+2;	/* skip over the initial :: */
+	while (*start == ':') {
+            start++;		/* skip over a subsequent : */
+	}
+        nsPtr = globalNsPtr;
+        if (*start == '\0') {	/* qualName is just two or more ":"s */
+            *nsPtrPtr        = globalNsPtr;
+            *altNsPtrPtr     = NULL;
+	    *actualCxtPtrPtr = globalNsPtr;
+            *simpleNamePtr   = start; /* points to empty string */
+            return TCL_OK;
+        }
+    }
+    *actualCxtPtrPtr = nsPtr;
+
+    /*
+     * Start an alternate search path starting with the global namespace.
+     * However, if the starting context is the global namespace, or if the
+     * flag is set to search only the namespace *cxtNsPtr, ignore the
+     * alternate search path.
+     */
+
+    altNsPtr = globalNsPtr;
+    if ((nsPtr == globalNsPtr)
+	    || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {
+        altNsPtr = NULL;
+    }
+
+    /*
+     * Loop to resolve each namespace qualifier in qualName.
+     */
+
+    Tcl_DStringInit(&buffer);
+    end = start;
+    while (*start != '\0') {
+        /*
+         * Find the next namespace qualifier (i.e., a name ending in "::")
+	 * or the end of the qualified name  (i.e., a name ending in "\0").
+	 * Set len to the number of characters, starting from start,
+	 * in the name; set end to point after the "::"s or at the "\0".
+         */
+
+	len = 0;
+        for (end = start;  *end != '\0';  end++) {
+	    if ((*end == ':') && (*(end+1) == ':')) {
+		end += 2;	/* skip over the initial :: */
+		while (*end == ':') {
+		    end++;	/* skip over the subsequent : */
+		}
+		break;		/* exit for loop; end is after ::'s */
+	    }
+            len++;
+	}
+
+	if ((*end == '\0')
+	        && !((len >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) {
+	    /*
+	     * qualName ended with a simple name at start. If FIND_ONLY_NS
+	     * was specified, look this up as a namespace. Otherwise,
+	     * start is the name of a cmd or var and we are done.
+	     */
+	    
+	    if (flags & FIND_ONLY_NS) {
+		nsName = start;
+	    } else {
+		*nsPtrPtr      = nsPtr;
+		*altNsPtrPtr   = altNsPtr;
+		*simpleNamePtr = start;
+		Tcl_DStringFree(&buffer);
+		return TCL_OK;
+	    }
+	} else {
+	    /*
+	     * start points to the beginning of a namespace qualifier ending
+	     * in "::". end points to the start of a name in that namespace
+	     * that might be empty. Copy the namespace qualifier to a
+	     * buffer so it can be null terminated. We can't modify the
+	     * incoming qualName since it may be a string constant.
+	     */
+
+	    Tcl_DStringSetLength(&buffer, 0);
+            Tcl_DStringAppend(&buffer, start, len);
+            nsName = Tcl_DStringValue(&buffer);
+        }
+
+        /*
+	 * Look up the namespace qualifier nsName in the current namespace
+         * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set,
+         * create that qualifying namespace. This is needed for procedures
+         * like Tcl_CreateCommand that cannot fail.
+	 */
+
+        if (nsPtr != NULL) {
+            entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
+            if (entryPtr != NULL) {
+                nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+            } else if (flags & CREATE_NS_IF_UNKNOWN) {
+		Tcl_CallFrame frame;
+		
+		result = Tcl_PushCallFrame(interp, &frame,
+		        (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
+                if (result != TCL_OK) {
+                    Tcl_DStringFree(&buffer);
+                    return result;
+                }
+                nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
+		        (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+                Tcl_PopCallFrame(interp);
+                if (nsPtr == NULL) {
+                    Tcl_DStringFree(&buffer);
+                    return TCL_ERROR;
+                }
+            } else {		/* namespace not found and wasn't created */
+                nsPtr = NULL;
+            }
+        }
+
+        /*
+         * Look up the namespace qualifier in the alternate search path too.
+         */
+
+        if (altNsPtr != NULL) {
+            entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
+            if (entryPtr != NULL) {
+                altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+            } else {
+                altNsPtr = NULL;
+            }
+        }
+
+        /*
+         * If both search paths have failed, return NULL results.
+         */
+
+        if ((nsPtr == NULL) && (altNsPtr == NULL)) {
+            *nsPtrPtr      = NULL;
+            *altNsPtrPtr   = NULL;
+            *simpleNamePtr = NULL;
+            Tcl_DStringFree(&buffer);
+            return TCL_OK;
+        }
+
+	start = end;
+    }
+
+    /*
+     * We ignore trailing "::"s in a namespace name, but in a command or
+     * variable name, trailing "::"s refer to the cmd or var named {}.
+     */
+
+    if ((flags & FIND_ONLY_NS)
+	    || ((end > start ) && (*(end-1) != ':'))) {
+	*simpleNamePtr = NULL; /* found namespace name */
+    } else {
+	*simpleNamePtr = end;  /* found cmd/var: points to empty string */
+    }
+
+    /*
+     * As a special case, if we are looking for a namespace and qualName
+     * is "" and the current active namespace (nsPtr) is not the global
+     * namespace, return NULL (no namespace was found). This is because
+     * namespaces can not have empty names except for the global namespace.
+     */
+
+    if ((flags & FIND_ONLY_NS) && (*qualName == '\0')
+	    && (nsPtr != globalNsPtr)) {
+	nsPtr = NULL;
+    }
+    
+    *nsPtrPtr    = nsPtr;
+    *altNsPtrPtr = altNsPtr;
+    Tcl_DStringFree(&buffer);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespace --
+ *
+ *	Searches for a namespace.
+ *
+ * Results:
+ *	Returns a pointer to the namespace if it is found. Otherwise,
+ *	returns NULL and leaves an error message in the interpreter's
+ *	result object if "flags" contains TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Namespace *
+Tcl_FindNamespace(interp, name, contextNsPtr, flags)
+    Tcl_Interp *interp;		 /* The interpreter in which to find the
+				  * namespace. */
+    char *name;			 /* Namespace name. If it starts with "::",
+				  * will be looked up in global namespace.
+				  * Else, looked up first in contextNsPtr
+				  * (current namespace if contextNsPtr is
+				  * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag is set
+				  * or if the name starts with "::".
+				  * Otherwise, points to namespace in which
+				  * to resolve name; if NULL, look up name
+				  * in the current namespace. */
+    register int flags;		 /* Flags controlling namespace lookup: an
+				  * OR'd combination of TCL_GLOBAL_ONLY and
+				  * TCL_LEAVE_ERR_MSG flags. */
+{
+    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
+    char *dummy;
+    int result;
+
+    /*
+     * Find the namespace(s) that contain the specified namespace name.
+     * Add the FIND_ONLY_NS flag to resolve the name all the way down
+     * to its last component, a namespace.
+     */
+
+    result = TclGetNamespaceForQualName(interp, name,
+	    (Namespace *) contextNsPtr, /*flags*/ (flags | FIND_ONLY_NS),
+	    &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+    if (result != TCL_OK) {
+        return NULL;
+    }
+    if (nsPtr != NULL) {
+       return (Tcl_Namespace *) nsPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown namespace \"", name, "\"", (char *) NULL);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindCommand --
+ *
+ *	Searches for a command.
+ *
+ * Results:
+ *	Returns a token for the command if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL and leaves an
+ *	error message in the interpreter's result object if "flags"
+ *	contains TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_FindCommand(interp, name, contextNsPtr, flags)
+    Tcl_Interp *interp;         /* The interpreter in which to find the
+				  * command and to report errors. */
+    char *name;		         /* Command's name. If it starts with "::",
+				  * will be looked up in global namespace.
+				  * Else, looked up first in contextNsPtr
+				  * (current namespace if contextNsPtr is
+				  * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
+				  * Otherwise, points to namespace in which
+				  * to resolve name. If NULL, look up name
+				  * in the current namespace. */
+    int flags;                   /* An OR'd combination of flags:
+				  * TCL_GLOBAL_ONLY (look up name only in
+				  * global namespace), TCL_NAMESPACE_ONLY
+				  * (look up only in contextNsPtr, or the
+				  * current namespace if contextNsPtr is
+				  * NULL), and TCL_LEAVE_ERR_MSG. If both
+				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
+				  * are given, TCL_GLOBAL_ONLY is
+				  * ignored. */
+{
+    Namespace *nsPtr[2], *cxtNsPtr;
+    char *simpleName;
+    register Tcl_HashEntry *entryPtr;
+    register Command *cmdPtr;
+    register int search;
+    int result;
+
+    /*
+     * Find the namespace(s) that contain the command.
+     */
+
+    result = TclGetNamespaceForQualName(interp, name,
+	    (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1],
+	    &cxtNsPtr, &simpleName);
+    if (result != TCL_OK) {
+        return (Tcl_Command) NULL;
+    }
+
+    /*
+     * Look for the command in the command table of its namespace.
+     * Be sure to check both possible search paths: from the specified
+     * namespace context and from the global namespace.
+     */
+
+    cmdPtr = NULL;
+    for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
+        if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+	    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
+		    simpleName);
+            if (entryPtr != NULL) {
+                cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+            }
+        }
+    }
+    if (cmdPtr != NULL) {
+        return (Tcl_Command) cmdPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown command \"", name, "\"", (char *) NULL);
+    }
+    return (Tcl_Command) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespaceVar --
+ *
+ *	Searches for a namespace variable, a variable not local to a
+ *	procedure. The variable can be either a scalar or an array, but
+ *	may not be an element of an array.
+ *
+ * Results:
+ *	Returns a token for the variable if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL and leaves an
+ *	error message in the interpreter's result object if "flags"
+ *	contains TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Var
+Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
+    Tcl_Interp *interp;		 /* The interpreter in which to find the
+				  * variable. */
+    char *name;			 /* Variable's name. If it starts with "::",
+				  * will be looked up in global namespace.
+				  * Else, looked up first in contextNsPtr
+				  * (current namespace if contextNsPtr is
+				  * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
+				  * Otherwise, points to namespace in which
+				  * to resolve name. If NULL, look up name
+				  * in the current namespace. */
+    int flags;			 /* An OR'd combination of flags:
+				  * TCL_GLOBAL_ONLY (look up name only in
+				  * global namespace), TCL_NAMESPACE_ONLY
+				  * (look up only in contextNsPtr, or the
+				  * current namespace if contextNsPtr is
+				  * NULL), and TCL_LEAVE_ERR_MSG. If both
+				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
+				  * are given, TCL_GLOBAL_ONLY is
+				  * ignored. */
+{
+    Namespace *nsPtr[2], *cxtNsPtr;
+    char *simpleName;
+    Tcl_HashEntry *entryPtr;
+    Var *varPtr;
+    register int search;
+    int result;
+
+    /*
+     * Find the namespace(s) that contain the variable.
+     */
+
+    result = TclGetNamespaceForQualName(interp, name,
+	    (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1],
+	    &cxtNsPtr, &simpleName);
+    if (result != TCL_OK) {
+        return (Tcl_Var) NULL;
+    }
+
+    /*
+     * Look for the variable in the variable table of its namespace.
+     * Be sure to check both possible search paths: from the specified
+     * namespace context and from the global namespace.
+     */
+
+    varPtr = NULL;
+    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
+        if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+            entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable,
+		    simpleName);
+            if (entryPtr != NULL) {
+                varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+            }
+        }
+    }
+    if (varPtr != NULL) {
+	return (Tcl_Var) varPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown variable \"", name, "\"", (char *) NULL);
+    }
+    return (Tcl_Var) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclResetShadowedCmdRefs --
+ *
+ *	Called when a command is added to a namespace to check for existing
+ *	command references that the new command may invalidate. Consider the
+ *	following cases that could happen when you add a command "foo" to a
+ *	namespace "b":
+ *	   1. It could shadow a command named "foo" at the global scope.
+ *	      If it does, all command references in the namespace "b" are
+ *	      suspect.
+ *	   2. Suppose the namespace "b" resides in a namespace "a".
+ *	      Then to "a" the new command "b::foo" could shadow another
+ *	      command "b::foo" in the global namespace. If so, then all
+ *	      command references in "a" are suspect.
+ *	The same checks are applied to all parent namespaces, until we
+ *	reach the global :: namespace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the new command shadows an existing command, the cmdRefEpoch
+ *	counter is incremented in each namespace that sees the shadow.
+ *	This invalidates all command references that were previously cached
+ *	in that namespace. The next time the commands are used, they are
+ *	resolved from scratch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclResetShadowedCmdRefs(interp, newCmdPtr)
+    Tcl_Interp *interp;	       /* Interpreter containing the new command. */
+    Command *newCmdPtr;	       /* Points to the new command. */
+{
+    char *cmdName;
+    Tcl_HashEntry *hPtr;
+    register Namespace *nsPtr;
+    Namespace *trailNsPtr, *shadowNsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    int found, i;
+
+    /*
+     * This procedure generates an array used to hold the trail list. This
+     * starts out with stack-allocated space but uses dynamically-allocated
+     * storage if needed.
+     */
+
+#define NUM_TRAIL_ELEMS 5
+    Namespace *(trailStorage[NUM_TRAIL_ELEMS]);
+    Namespace **trailPtr = trailStorage;
+    int trailFront = -1;
+    int trailSize = NUM_TRAIL_ELEMS;
+
+    /*
+     * Start at the namespace containing the new command, and work up
+     * through the list of parents. Stop just before the global namespace,
+     * since the global namespace can't "shadow" its own entries.
+     *
+     * The namespace "trail" list we build consists of the names of each
+     * namespace that encloses the new command, in order from outermost to
+     * innermost: for example, "a" then "b". Each iteration of this loop
+     * eventually extends the trail upwards by one namespace, nsPtr. We use
+     * this trail list to see if nsPtr (e.g. "a" in 2. above) could have
+     * now-invalid cached command references. This will happen if nsPtr
+     * (e.g. "a") contains a sequence of child namespaces (e.g. "b")
+     * such that there is a identically-named sequence of child namespaces
+     * starting from :: (e.g. "::b") whose tail namespace contains a command
+     * also named cmdName.
+     */
+
+    cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
+    for (nsPtr = newCmdPtr->nsPtr;
+	    (nsPtr != NULL) && (nsPtr != globalNsPtr);
+            nsPtr = nsPtr->parentPtr) {
+        /*
+	 * Find the maximal sequence of child namespaces contained in nsPtr
+	 * such that there is a identically-named sequence of child
+	 * namespaces starting from ::. shadowNsPtr will be the tail of this
+	 * sequence, or the deepest namespace under :: that might contain a
+	 * command now shadowed by cmdName. We check below if shadowNsPtr
+	 * actually contains a command cmdName.
+	 */
+
+        found = 1;
+        shadowNsPtr = globalNsPtr;
+
+        for (i = trailFront;  i >= 0;  i--) {
+            trailNsPtr = trailPtr[i];
+            hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
+		    trailNsPtr->name);
+            if (hPtr != NULL) {
+                shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr);
+            } else {
+                found = 0;
+                break;
+            }
+        }
+
+        /*
+	 * If shadowNsPtr contains a command named cmdName, we invalidate
+         * all of the command refs cached in nsPtr. As a boundary case,
+	 * shadowNsPtr is initially :: and we check for case 1. above.
+	 */
+
+        if (found) {
+            hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
+            if (hPtr != NULL) {
+                nsPtr->cmdRefEpoch++;
+            }
+        }
+
+        /*
+	 * Insert nsPtr at the front of the trail list: i.e., at the end
+	 * of the trailPtr array.
+	 */
+
+	trailFront++;
+	if (trailFront == trailSize) {
+	    size_t currBytes = trailSize * sizeof(Namespace *);
+	    int newSize = 2*trailSize;
+	    size_t newBytes = newSize * sizeof(Namespace *);
+	    Namespace **newPtr =
+		    (Namespace **) ckalloc((unsigned) newBytes);
+	    
+	    memcpy((VOID *) newPtr, (VOID *) trailPtr, currBytes);
+	    if (trailPtr != trailStorage) {
+		ckfree((char *) trailPtr);
+	    }
+	    trailPtr = newPtr;
+	    trailSize = newSize;
+	}
+	trailPtr[trailFront] = nsPtr;
+    }
+
+    /*
+     * Free any allocated storage.
+     */
+    
+    if (trailPtr != trailStorage) {
+	ckfree((char *) trailPtr);
+    }
+#undef NUM_TRAIL_ELEMS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetNamespaceFromObj --
+ *
+ *	Returns the namespace specified by the name in a Tcl_Obj.
+ *
+ * Results:
+ *	Returns TCL_OK if the namespace was resolved successfully, and
+ *	stores a pointer to the namespace in the location specified by
+ *	nsPtrPtr. If the namespace can't be found, the procedure stores
+ *	NULL in *nsPtrPtr and returns TCL_OK. If anything else goes wrong,
+ *	this procedure returns TCL_ERROR.
+ *
+ * Side effects:
+ *	May update the internal representation for the object, caching the
+ *	namespace reference. The next time this procedure is called, the
+ *	namespace value can be found quickly.
+ *
+ *	If anything goes wrong, an error message is left in the
+ *	interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
+    Tcl_Interp *interp;		/* The current interpreter. */
+    Tcl_Obj *objPtr;		/* The object to be resolved as the name
+				 * of a namespace. */
+    Tcl_Namespace **nsPtrPtr;	/* Result namespace pointer goes here. */
+{
+    register ResolvedNsName *resNamePtr;
+    register Namespace *nsPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    int result;
+
+    /*
+     * Get the internal representation, converting to a namespace type if
+     * needed. The internal representation is a ResolvedNsName that points
+     * to the actual namespace.
+     */
+
+    if (objPtr->typePtr != &tclNsNameType) {
+        result = tclNsNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return TCL_ERROR;
+        }
+    }
+    resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+
+    /*
+     * Check the context namespace of the resolved symbol to make sure that
+     * it is fresh. If not, then force another conversion to the namespace
+     * type, to discard the old rep and create a new one. Note that we
+     * verify that the namespace id of the cached namespace is the same as
+     * the id when we cached it; this insures that the namespace wasn't
+     * deleted and a new one created at the same address.
+     */
+
+    nsPtr = NULL;
+    if ((resNamePtr != NULL)
+	    && (resNamePtr->refNsPtr == currNsPtr)
+	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+        nsPtr = resNamePtr->nsPtr;
+	if (nsPtr->flags & NS_DEAD) {
+	    nsPtr = NULL;
+	}
+    }
+    if (nsPtr == NULL) {	/* try again */
+        result = tclNsNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+            return TCL_ERROR;
+        }
+        resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+        if (resNamePtr != NULL) {
+            nsPtr = resNamePtr->nsPtr;
+            if (nsPtr->flags & NS_DEAD) {
+                nsPtr = NULL;
+            }
+        }
+    }
+    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NamespaceObjCmd --
+ *
+ *	Invoked to implement the "namespace" command that creates, deletes,
+ *	or manipulates Tcl namespaces. Handles the following syntax:
+ *
+ *	    namespace children ?name? ?pattern?
+ *	    namespace code arg
+ *	    namespace current
+ *	    namespace delete ?name name...?
+ *	    namespace eval name arg ?arg...?
+ *	    namespace export ?-clear? ?pattern pattern...?
+ *	    namespace forget ?pattern pattern...?
+ *	    namespace import ?-force? ?pattern pattern...?
+ *	    namespace inscope name arg ?arg...?
+ *	    namespace origin name
+ *	    namespace parent ?name?
+ *	    namespace qualifiers string
+ *	    namespace tail string
+ *	    namespace which ?-command? ?-variable? name
+ *
+ * Results:
+ *	Returns TCL_OK if the command is successful. Returns TCL_ERROR if
+ *	anything goes wrong.
+ *
+ * Side effects:
+ *	Based on the subcommand name (e.g., "import"), this procedure
+ *	dispatches to a corresponding procedure NamespaceXXXCmd defined
+ *	statically in this file. This procedure's side effects depend on
+ *	whatever that subcommand procedure does. If there is an error, this
+ *	procedure returns an error message in the interpreter's result
+ *	object. Otherwise it may return a result in the interpreter's result
+ *	object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;		/* Arbitrary value passed to cmd. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    register int objc;			/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    static char *subCmds[] = {
+            "children", "code", "current", "delete",
+	    "eval", "export", "forget", "import",
+	    "inscope", "origin", "parent", "qualifiers",
+	    "tail", "which", (char *) NULL};
+    enum NSSubCmdIdx {
+	    NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+	    NSEvalIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
+	    NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
+	    NSTailIdx, NSWhichIdx
+    } index;
+    int result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Return an index reflecting the particular subcommand.
+     */
+
+    result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], subCmds,
+	    "subcommand", /*flags*/ 0, (int *) &index);
+    if (result != TCL_OK) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad namespace subcommand \"",
+		Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"\": should be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which",
+		(char *) NULL);
+	return result;
+    }
+    
+    switch (index) {
+        case NSChildrenIdx:
+	    result = NamespaceChildrenCmd(clientData, interp, objc, objv);
+            break;
+        case NSCodeIdx:
+	    result = NamespaceCodeCmd(clientData, interp, objc, objv);
+            break;
+        case NSCurrentIdx:
+	    result = NamespaceCurrentCmd(clientData, interp, objc, objv);
+            break;
+        case NSDeleteIdx:
+	    result = NamespaceDeleteCmd(clientData, interp, objc, objv);
+            break;
+        case NSEvalIdx:
+	    result = NamespaceEvalCmd(clientData, interp, objc, objv);
+            break;
+        case NSExportIdx:
+	    result = NamespaceExportCmd(clientData, interp, objc, objv);
+            break;
+        case NSForgetIdx:
+	    result = NamespaceForgetCmd(clientData, interp, objc, objv);
+            break;
+        case NSImportIdx:
+	    result = NamespaceImportCmd(clientData, interp, objc, objv);
+            break;
+        case NSInscopeIdx:
+	    result = NamespaceInscopeCmd(clientData, interp, objc, objv);
+            break;
+        case NSOriginIdx:
+	    result = NamespaceOriginCmd(clientData, interp, objc, objv);
+            break;
+        case NSParentIdx:
+	    result = NamespaceParentCmd(clientData, interp, objc, objv);
+            break;
+        case NSQualifiersIdx:
+	    result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
+            break;
+        case NSTailIdx:
+	    result = NamespaceTailCmd(clientData, interp, objc, objv);
+            break;
+        case NSWhichIdx:
+	    result = NamespaceWhichCmd(clientData, interp, objc, objv);
+            break;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceChildrenCmd --
+ *
+ *	Invoked to implement the "namespace children" command that returns a
+ *	list containing the fully-qualified names of the child namespaces of
+ *	a given namespace. Handles the following syntax:
+ *
+ *	    namespace children ?name? ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceChildrenCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    Namespace *nsPtr, *childNsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    char *pattern = NULL;
+    Tcl_DString buffer;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Tcl_Obj *listPtr, *elemPtr;
+
+    /*
+     * Get a pointer to the specified namespace, or the current namespace.
+     */
+
+    if (objc == 2) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    } else if ((objc == 3) || (objc == 4)) {
+        if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (namespacePtr == NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "unknown namespace \"",
+		    Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		    "\" in namespace children command", (char *) NULL);
+            return TCL_ERROR;
+        }
+        nsPtr = (Namespace *) namespacePtr;
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "children ?name? ?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Get the glob-style pattern, if any, used to narrow the search.
+     */
+
+    Tcl_DStringInit(&buffer);
+    if (objc == 4) {
+        char *name = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	
+        if ((*name == ':') && (*(name+1) == ':')) {
+            pattern = name;
+        } else {
+            Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
+            if (nsPtr != globalNsPtr) {
+                Tcl_DStringAppend(&buffer, "::", 2);
+            }
+            Tcl_DStringAppend(&buffer, name, -1);
+            pattern = Tcl_DStringValue(&buffer);
+        }
+    }
+
+    /*
+     * Create a list containing the full names of all child namespaces
+     * whose names match the specified pattern, if any.
+     */
+
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+    while (entryPtr != NULL) {
+        childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+        if ((pattern == NULL)
+	        || Tcl_StringMatch(childNsPtr->fullName, pattern)) {
+            elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
+            Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
+        }
+        entryPtr = Tcl_NextHashEntry(&search);
+    }
+
+    Tcl_SetObjResult(interp, listPtr);
+    Tcl_DStringFree(&buffer);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceCodeCmd --
+ *
+ *	Invoked to implement the "namespace code" command to capture the
+ *	namespace context of a command. Handles the following syntax:
+ *
+ *	    namespace code arg
+ *
+ *	Here "arg" can be a list. "namespace code arg" produces a result
+ *	equivalent to that produced by the command
+ *
+ *	    list namespace inscope [namespace current] $arg
+ *
+ *	However, if "arg" is itself a scoped value starting with
+ *	"namespace inscope", then the result is just "arg".
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error
+ *	message as the result in the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceCodeCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Namespace *currNsPtr;
+    Tcl_Obj *listPtr, *objPtr;
+    register char *arg, *p;
+    int length;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "code arg");
+        return TCL_ERROR;
+    }
+
+    /*
+     * If "arg" is already a scoped value, then return it directly.
+     */
+
+    arg = Tcl_GetStringFromObj(objv[2], &length);
+    if ((*arg == 'n') && (length > 17)
+	    && (strncmp(arg, "namespace", 9) == 0)) {
+	for (p = (arg + 9);  (*p == ' ');  p++) {
+	    /* empty body: skip over spaces */
+	}
+	if ((*p == 'i') && ((p + 7) <= (arg + length))
+	        && (strncmp(p, "inscope", 7) == 0)) {
+	    Tcl_SetObjResult(interp, objv[2]);
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Otherwise, construct a scoped command by building a list with
+     * "namespace inscope", the full name of the current namespace, and 
+     * the argument "arg". By constructing a list, we ensure that scoped
+     * commands are interpreted properly when they are executed later,
+     * by the "namespace inscope" command.
+     */
+
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    Tcl_ListObjAppendElement(interp, listPtr,
+            Tcl_NewStringObj("namespace", -1));
+    Tcl_ListObjAppendElement(interp, listPtr,
+	    Tcl_NewStringObj("inscope", -1));
+
+    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+	objPtr = Tcl_NewStringObj("::", -1);
+    } else {
+	objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
+    }
+    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+    
+    Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceCurrentCmd --
+ *
+ *	Invoked to implement the "namespace current" command which returns
+ *	the fully-qualified name of the current namespace. Handles the
+ *	following syntax:
+ *
+ *	    namespace current
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceCurrentCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register Namespace *currNsPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "current");
+        return TCL_ERROR;
+    }
+
+    /*
+     * The "real" name of the global namespace ("::") is the null string,
+     * but we return "::" for it as a convenience to programmers. Note that
+     * "" and "::" are treated as synonyms by the namespace code so that it
+     * is still easy to do things like:
+     *
+     *    namespace [namespace current]::bar { ... }
+     */
+
+    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
+    } else {
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceDeleteCmd --
+ *
+ *	Invoked to implement the "namespace delete" command to delete
+ *	namespace(s). Handles the following syntax:
+ *
+ *	    namespace delete ?name name...?
+ *
+ *	Each name identifies a namespace. It may include a sequence of
+ *	namespace qualifiers separated by "::"s. If a namespace is found, it
+ *	is deleted: all variables and procedures contained in that namespace
+ *	are deleted. If that namespace is being used on the call stack, it
+ *	is kept alive (but logically deleted) until it is removed from the
+ *	call stack: that is, it can no longer be referenced by name but any
+ *	currently executing procedure that refers to it is allowed to do so
+ *	until the procedure returns. If the namespace can't be found, this
+ *	procedure returns an error. If no namespaces are specified, this
+ *	command does nothing.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Deletes the specified namespaces. If anything goes wrong, this
+ *	procedure returns an error message in the interpreter's
+ *	result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceDeleteCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    char *name;
+    register int i;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "delete ?name name...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Destroying one namespace may cause another to be destroyed. Break
+     * this into two passes: first check to make sure that all namespaces on
+     * the command line are valid, and report any errors.
+     */
+
+    for (i = 2;  i < objc;  i++) {
+        name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	namespacePtr = Tcl_FindNamespace(interp, name,
+		(Tcl_Namespace *) NULL, /*flags*/ 0);
+        if (namespacePtr == NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "unknown namespace \"",
+		    Tcl_GetStringFromObj(objv[i], (int *) NULL),
+		    "\" in namespace delete command", (char *) NULL);
+            return TCL_ERROR;
+        }
+    }
+
+    /*
+     * Okay, now delete each namespace.
+     */
+
+    for (i = 2;  i < objc;  i++) {
+        name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	namespacePtr = Tcl_FindNamespace(interp, name,
+	    (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
+	if (namespacePtr == NULL) {
+            return TCL_ERROR;
+        }
+        Tcl_DeleteNamespace(namespacePtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceEvalCmd --
+ *
+ *	Invoked to implement the "namespace eval" command. Executes
+ *	commands in a namespace. If the namespace does not already exist,
+ *	it is created. Handles the following syntax:
+ *
+ *	    namespace eval name arg ?arg...?
+ *
+ *	If more than one arg argument is specified, the command that is
+ *	executed is the result of concatenating the arguments together with
+ *	a space between each argument.
+ *
+ * Results:
+ *	Returns TCL_OK if the namespace is found and the commands are
+ *	executed successfully. Returns TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns the result of the command in the interpreter's result
+ *	object. If anything goes wrong, this procedure returns an error
+ *	message as the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceEvalCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    Tcl_CallFrame frame;
+    Tcl_Obj *objPtr;
+    char *name;
+    int length, result;
+
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 1, objv, "eval name arg ?arg...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Try to resolve the namespace reference, caching the result in the
+     * namespace object along the way.
+     */
+
+    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    /*
+     * If the namespace wasn't found, try to create it.
+     */
+    
+    if (namespacePtr == NULL) {
+	name = Tcl_GetStringFromObj(objv[2], &length);
+	namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, 
+                (Tcl_NamespaceDeleteProc *) NULL);
+	if (namespacePtr == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Make the specified namespace the current namespace and evaluate
+     * the command(s).
+     */
+
+    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+	    /*isProcCallFrame*/ 0);
+    if (result != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    if (objc == 4) {
+        result = Tcl_EvalObj(interp, objv[3]);
+    } else {
+        objPtr = Tcl_ConcatObj(objc-3, objv+3);
+        result = Tcl_EvalObj(interp, objPtr);
+        Tcl_DecrRefCount(objPtr);  /* we're done with the object */
+    }
+    if (result == TCL_ERROR) {
+        char msg[256];
+	
+        sprintf(msg, "\n    (in namespace eval \"%.200s\" script line %d)",
+            namespacePtr->fullName, interp->errorLine);
+        Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+    
+    Tcl_PopCallFrame(interp);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceExportCmd --
+ *
+ *	Invoked to implement the "namespace export" command that specifies
+ *	which commands are exported from a namespace. The exported commands
+ *	are those that can be imported into another namespace using
+ *	"namespace import". Both commands defined in a namespace and
+ *	commands the namespace has imported can be exported by a
+ *	namespace. This command has the following syntax:
+ *
+ *	    namespace export ?-clear? ?pattern pattern...?
+ *
+ *	Each pattern may contain "string match"-style pattern matching
+ *	special characters, but the pattern may not include any namespace
+ *	qualifiers: that is, the pattern must specify commands in the
+ *	current (exporting) namespace. The specified patterns are appended
+ *	onto the namespace's list of export patterns.
+ *
+ *	To reset the namespace's export pattern list, specify the "-clear"
+ *	flag.
+ *
+ *	If there are no export patterns and the "-clear" flag isn't given,
+ *	this command returns the namespace's current export list.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceExportCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
+    char *pattern, *string;
+    int resetListFirst = 0;
+    int firstArg, patternCt, i, result;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+	        "export ?-clear? ?pattern pattern...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Process the optional "-clear" argument.
+     */
+
+    firstArg = 2;
+    if (firstArg < objc) {
+	string = Tcl_GetStringFromObj(objv[firstArg], (int *) NULL);
+	if (strcmp(string, "-clear") == 0) {
+	    resetListFirst = 1;
+	    firstArg++;
+	}
+    }
+
+    /*
+     * If no pattern arguments are given, and "-clear" isn't specified,
+     * return the namespace's current export pattern list.
+     */
+
+    patternCt = (objc - firstArg);
+    if (patternCt == 0) {
+	if (firstArg > 2) {
+	    return TCL_OK;
+	} else {		/* create list with export patterns */
+	    Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+	    result = Tcl_AppendExportList(interp,
+		    (Tcl_Namespace *) currNsPtr, listPtr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    Tcl_SetObjResult(interp, listPtr);
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Add each pattern to the namespace's export pattern list.
+     */
+    
+    for (i = firstArg;  i < objc;  i++) {
+	pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
+		((i == firstArg)? resetListFirst : 0));
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceForgetCmd --
+ *
+ *	Invoked to implement the "namespace forget" command to remove
+ *	imported commands from a namespace. Handles the following syntax:
+ *
+ *	    namespace forget ?pattern pattern...?
+ *
+ *	Each pattern is a name like "foo::*" or "a::b::x*". That is, the
+ *	pattern may include the special pattern matching characters
+ *	recognized by the "string match" command, but only in the command
+ *	name at the end of the qualified name; the special pattern
+ *	characters may not appear in a namespace name. All of the commands
+ *	that match that pattern are checked to see if they have an imported
+ *	command in the current namespace that refers to the matched
+ *	command. If there is an alias, it is removed.
+ *	
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Imported commands are removed from the current namespace. If
+ *	anything goes wrong, this procedure returns an error message in the
+ *	interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceForgetCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    char *pattern;
+    register int i, result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "forget ?pattern pattern...?");
+        return TCL_ERROR;
+    }
+
+    for (i = 2;  i < objc;  i++) {
+        pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceImportCmd --
+ *
+ *	Invoked to implement the "namespace import" command that imports
+ *	commands into a namespace. Handles the following syntax:
+ *
+ *	    namespace import ?-force? ?pattern pattern...?
+ *
+ *	Each pattern is a namespace-qualified name like "foo::*",
+ *	"a::b::x*", or "bar::p". That is, the pattern may include the
+ *	special pattern matching characters recognized by the "string match"
+ *	command, but only in the command name at the end of the qualified
+ *	name; the special pattern characters may not appear in a namespace
+ *	name. All of the commands that match the pattern and which are
+ *	exported from their namespace are made accessible from the current
+ *	namespace context. This is done by creating a new "imported command"
+ *	in the current namespace that points to the real command in its
+ *	original namespace; when the imported command is called, it invokes
+ *	the real command.
+ *
+ *	If an imported command conflicts with an existing command, it is
+ *	treated as an error. But if the "-force" option is included, then
+ *	existing commands are overwritten by the imported commands.
+ *	
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Adds imported commands to the current namespace. If anything goes
+ *	wrong, this procedure returns an error message in the interpreter's
+ *	result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceImportCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int allowOverwrite = 0;
+    char *string, *pattern;
+    register int i, result;
+    int firstArg;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+	        "import ?-force? ?pattern pattern...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Skip over the optional "-force" as the first argument.
+     */
+
+    firstArg = 2;
+    if (firstArg < objc) {
+	string = Tcl_GetStringFromObj(objv[firstArg], (int *) NULL);
+	if ((*string == '-') && (strcmp(string, "-force") == 0)) {
+	    allowOverwrite = 1;
+	    firstArg++;
+	}
+    }
+
+    /*
+     * Handle the imports for each of the patterns.
+     */
+
+    for (i = firstArg;  i < objc;  i++) {
+        pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
+	        allowOverwrite);
+        if (result != TCL_OK) {
+            return result;
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceInscopeCmd --
+ *
+ *	Invoked to implement the "namespace inscope" command that executes a
+ *	script in the context of a particular namespace. This command is not
+ *	expected to be used directly by programmers; calls to it are
+ *	generated implicitly when programs use "namespace code" commands
+ *	to register callback scripts. Handles the following syntax:
+ *
+ *	    namespace inscope name arg ?arg...?
+ *
+ *	The "namespace inscope" command is much like the "namespace eval"
+ *	command except that it has lappend semantics and the namespace must
+ *	already exist. It treats the first argument as a list, and appends
+ *	any arguments after the first onto the end as proper list elements.
+ *	For example,
+ *
+ *	    namespace inscope ::foo a b c d
+ *
+ *	is equivalent to
+ *
+ *	    namespace eval ::foo [concat a [list b c d]]
+ *
+ *	This lappend semantics is important because many callback scripts
+ *	are actually prefixes.
+ *
+ * Results:
+ *	Returns TCL_OK to indicate success, or TCL_ERROR to indicate
+ *	failure.
+ *
+ * Side effects:
+ *	Returns a result in the Tcl interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceInscopeCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+    Tcl_CallFrame frame;
+    int i, result;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "inscope name arg ?arg...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Resolve the namespace reference.
+     */
+
+    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    if (result != TCL_OK) {
+        return result;
+    }
+    if (namespacePtr == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	        "unknown namespace \"",
+		Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		"\" in inscope namespace command", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Make the specified namespace the current namespace.
+     */
+
+    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+	    /*isProcCallFrame*/ 0);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    /*
+     * Execute the command. If there is just one argument, just treat it as
+     * a script and evaluate it. Otherwise, create a list from the arguments
+     * after the first one, then concatenate the first argument and the list
+     * of extra arguments to form the command to evaluate.
+     */
+
+    if (objc == 4) {
+        result = Tcl_EvalObj(interp, objv[3]);
+    } else {
+	Tcl_Obj *concatObjv[2];
+	register Tcl_Obj *listPtr, *cmdObjPtr;
+	
+        listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+        for (i = 4;  i < objc;  i++) {
+	    result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
+            if (result != TCL_OK) {
+                Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+                return result;
+            }
+        }
+
+	concatObjv[0] = objv[3];
+	concatObjv[1] = listPtr;
+	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
+        result = Tcl_EvalObj(interp, cmdObjPtr);
+	
+	Tcl_DecrRefCount(cmdObjPtr);  /* we're done with the cmd object */
+	Tcl_DecrRefCount(listPtr);    /* we're done with the list object */
+    }
+    if (result == TCL_ERROR) {
+        char msg[256];
+	
+        sprintf(msg,
+	    "\n    (in namespace inscope \"%.200s\" script line %d)",
+            namespacePtr->fullName, interp->errorLine);
+        Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    Tcl_PopCallFrame(interp);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceOriginCmd --
+ *
+ *	Invoked to implement the "namespace origin" command to return the
+ *	fully-qualified name of the "real" command to which the specified
+ *	"imported command" refers. Handles the following syntax:
+ *
+ *	    namespace origin name
+ *
+ * Results:
+ *	An imported command is created in an namespace when that namespace
+ *	imports a command from another namespace. If a command is imported
+ *	into a sequence of namespaces a, b,...,n where each successive
+ *	namespace just imports the command from the previous namespace, this
+ *	command returns the fully-qualified name of the original command in
+ *	the first namespace, a. If "name" does not refer to an alias, its
+ *	fully-qualified name is returned. The returned name is stored in the
+ *	interpreter's result object. This procedure returns TCL_OK if
+ *	successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error message in
+ *	the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceOriginCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Command command, origCommand;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "origin name");
+        return TCL_ERROR;
+    }
+
+    command = Tcl_GetCommandFromObj(interp, objv[2]);
+    if (command == (Tcl_Command) NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"invalid command name \"",
+		Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		"\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    origCommand = TclGetOriginalCommand(command);
+    if (origCommand == (Tcl_Command) NULL) {
+	/*
+	 * The specified command isn't an imported command. Return the
+	 * command's name qualified by the full name of the namespace it
+	 * was defined in.
+	 */
+	
+	Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
+    } else {
+	Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceParentCmd --
+ *
+ *	Invoked to implement the "namespace parent" command that returns the
+ *	fully-qualified name of the parent namespace for a specified
+ *	namespace. Handles the following syntax:
+ *
+ *	    namespace parent ?name?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceParentCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *nsPtr;
+    int result;
+
+    if (objc == 2) {
+        nsPtr = Tcl_GetCurrentNamespace(interp);
+    } else if (objc == 3) {
+	result = GetNamespaceFromObj(interp, objv[2], &nsPtr);
+        if (result != TCL_OK) {
+            return result;
+        }
+        if (nsPtr == NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "unknown namespace \"",
+		    Tcl_GetStringFromObj(objv[2], (int *) NULL),
+		    "\" in namespace parent command", (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else {
+        Tcl_WrongNumArgs(interp, 1, objv, "parent ?name?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Report the parent of the specified namespace.
+     */
+
+    if (nsPtr->parentPtr != NULL) {
+        Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	        nsPtr->parentPtr->fullName, -1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceQualifiersCmd --
+ *
+ *	Invoked to implement the "namespace qualifiers" command that returns
+ *	any leading namespace qualifiers in a string. These qualifiers are
+ *	namespace names separated by "::"s. For example, for "::foo::p" this
+ *	command returns "::foo", and for "::" it returns "". This command
+ *	is the complement of the "namespace tail" command. Note that this
+ *	command does not check whether the "namespace" names are, in fact,
+ *	the names of currently defined namespaces. Handles the following
+ *	syntax:
+ *
+ *	    namespace qualifiers string
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceQualifiersCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register char *name, *p;
+    int length;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "qualifiers string");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the end of the string, then work backward and find
+     * the start of the last "::" qualifier.
+     */
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    for (p = name;  *p != '\0';  p++) {
+	/* empty body */
+    }
+    while (--p >= name) {
+        if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
+	    p -= 2;		/* back up over the :: */
+	    while ((*p == ':') && (p >= name)) {
+		p--;		/* back up over the preceeding : */
+	    }
+	    break;
+        }
+    }
+
+    if (p >= name) {
+        length = p-name+1;
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceTailCmd --
+ *
+ *	Invoked to implement the "namespace tail" command that returns the
+ *	trailing name at the end of a string with "::" namespace
+ *	qualifiers. These qualifiers are namespace names separated by
+ *	"::"s. For example, for "::foo::p" this command returns "p", and for
+ *	"::" it returns "". This command is the complement of the "namespace
+ *	qualifiers" command. Note that this command does not check whether
+ *	the "namespace" names are, in fact, the names of currently defined
+ *	namespaces. Handles the following syntax:
+ *
+ *	    namespace tail string
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceTailCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    register char *name, *p;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "tail string");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the end of the string, then work backward and find the
+     * last "::" qualifier.
+     */
+
+    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    for (p = name;  *p != '\0';  p++) {
+	/* empty body */
+    }
+    while (--p > name) {
+        if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
+            p++;		/* just after the last "::" */
+            break;
+        }
+    }
+    
+    if (p >= name) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceWhichCmd --
+ *
+ *	Invoked to implement the "namespace which" command that returns the
+ *	fully-qualified name of a command or variable. If the specified
+ *	command or variable does not exist, it returns "". Handles the
+ *	following syntax:
+ *
+ *	    namespace which ?-command? ?-variable? name
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceWhichCmd(dummy, interp, objc, objv)
+    ClientData dummy;                   /* Not used. */
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    int objc;                           /* Number of arguments. */
+    Tcl_Obj *CONST objv[];              /* Argument objects. */
+{
+    register char *arg;
+    Tcl_Command cmd;
+    Tcl_Var variable;
+    int argIndex, lookup;
+
+    if (objc < 3) {
+        badArgs:
+        Tcl_WrongNumArgs(interp, 1, objv,
+	        "which ?-command? ?-variable? name");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Look for a flag controlling the lookup.
+     */
+
+    argIndex = 2;
+    lookup = 0;			/* assume command lookup by default */
+    arg = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    if (*arg == '-') {
+	if (strncmp(arg, "-command", 8) == 0) {
+	    lookup = 0;
+	} else if (strncmp(arg, "-variable", 9) == 0) {
+	    lookup = 1;
+	} else {
+	    goto badArgs;
+	}
+	argIndex = 3;
+    }
+    if (objc != (argIndex + 1)) {
+	goto badArgs;
+    }
+
+    switch (lookup) {
+    case 0:			/* -command */
+	cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
+        if (cmd == (Tcl_Command) NULL) {	
+            return TCL_OK;	/* cmd not found, just return (no error) */
+        }
+	Tcl_GetCommandFullName(interp, cmd, Tcl_GetObjResult(interp));
+        break;
+
+    case 1:			/* -variable */
+        arg = Tcl_GetStringFromObj(objv[argIndex], (int *) NULL);
+	variable = Tcl_FindNamespaceVar(interp, arg, (Tcl_Namespace *) NULL,
+		/*flags*/ 0);
+        if (variable != (Tcl_Var) NULL) {
+            Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
+        }
+        break;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeNsNameInternalRep --
+ *
+ *	Frees the resources associated with a nsName object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Decrements the ref count of any Namespace structure pointed
+ *	to by the nsName's internal representation. If there are no more
+ *	references to the namespace, it's structure will be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeNsNameInternalRep(objPtr)
+    register Tcl_Obj *objPtr;   /* nsName object with internal
+                                 * representation to free */
+{
+    register ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    Namespace *nsPtr;
+
+    /*
+     * Decrement the reference count of the namespace. If there are no
+     * more references, free it up.
+     */
+
+    if (resNamePtr != NULL) {
+        resNamePtr->refCount--;
+        if (resNamePtr->refCount == 0) {
+
+            /*
+	     * Decrement the reference count for the cached namespace.  If
+	     * the namespace is dead, and there are no more references to
+	     * it, free it.
+	     */
+
+            nsPtr = resNamePtr->nsPtr;
+            nsPtr->refCount--;
+            if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+                NamespaceFree(nsPtr);
+            }
+            ckfree((char *) resNamePtr);
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupNsNameInternalRep --
+ *
+ *	Initializes the internal representation of a nsName object to a copy
+ *	of the internal representation of another nsName object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to refer to the same namespace
+ *	referenced by srcPtr's internal rep. Increments the ref count of
+ *	the ResolvedNsName structure used to hold the namespace reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupNsNameInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;                /* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;      /* Object with internal rep to set. */
+{
+    register ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) srcPtr->internalRep.otherValuePtr;
+
+    copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
+    if (resNamePtr != NULL) {
+        resNamePtr->refCount++;
+    }
+    copyPtr->typePtr = &tclNsNameType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetNsNameFromAny --
+ *
+ *	Attempt to generate a nsName internal representation for a
+ *	Tcl object.
+ *
+ * Results:
+ *	Returns TCL_OK if the value could be converted to a proper
+ *	namespace reference. Otherwise, it returns TCL_ERROR, along
+ *	with an error message in the interpreter's result object.
+ *
+ * Side effects:
+ *	If successful, the object is made a nsName object. Its internal rep
+ *	is set to point to a ResolvedNsName, which contains a cached pointer
+ *	to the Namespace. Reference counts are kept on both the
+ *	ResolvedNsName and the Namespace, so we can keep track of their
+ *	usage and free them when appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetNsNameFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Points to the namespace in which to
+				 * resolve name. Also used for error
+				 * reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *name, *dummy;
+    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
+    register ResolvedNsName *resNamePtr;
+    int flags, result;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    name = objPtr->bytes;
+    if (name == NULL) {
+	name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+    }
+
+    /*
+     * Look for the namespace "name" in the current namespace. If there is
+     * an error parsing the (possibly qualified) name, return an error.
+     * If the namespace isn't found, we convert the object to an nsName
+     * object with a NULL ResolvedNsName* internal rep.
+     */
+
+    flags = ((interp != NULL)? TCL_LEAVE_ERR_MSG : 0) | FIND_ONLY_NS;
+    result = TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+            flags, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    /*
+     * If we found a namespace, then create a new ResolvedNsName structure
+     * that holds a reference to it.
+     */
+
+    if (nsPtr != NULL) {
+	Namespace *currNsPtr =
+	        (Namespace *) Tcl_GetCurrentNamespace(interp);
+	
+        nsPtr->refCount++;
+        resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
+        resNamePtr->nsPtr = nsPtr;
+        resNamePtr->nsId = nsPtr->nsId;
+        resNamePtr->refNsPtr = currNsPtr;
+        resNamePtr->refCount = 1;
+    } else {
+        resNamePtr = NULL;
+    }
+
+    /*
+     * Free the old internalRep before setting the new one.
+     * We do this as late as possible to allow the conversion code
+     * (in particular, Tcl_GetStringFromObj) to use that old internalRep.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+        oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
+    objPtr->typePtr = &tclNsNameType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfNsName --
+ *
+ *	Updates the string representation for a nsName object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a copy of the fully qualified
+ *	namespace name.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfNsName(objPtr)
+    register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
+{
+    ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    register Namespace *nsPtr;
+    char *name = "";
+    int length;
+
+    if ((resNamePtr != NULL)
+	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+        nsPtr = resNamePtr->nsPtr;
+        if (nsPtr->flags & NS_DEAD) {
+            nsPtr = NULL;
+        }
+        if (nsPtr != NULL) {
+            name = nsPtr->fullName;
+        }
+    }
+
+    /*
+     * The following sets the string rep to an empty string on the heap
+     * if the internal rep is NULL.
+     */
+
+    length = strlen(name);
+    if (length == 0) {
+	objPtr->bytes = tclEmptyStringRep;
+    } else {
+	objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
+	memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
+	objPtr->bytes[length] = '\0';
+    }
+    objPtr->length = length;
+}
diff --git a/contrib/tcl/generic/tclNotify.c b/contrib/tcl/generic/tclNotify.c
index 0745591..19f38f3 100644
--- a/contrib/tcl/generic/tclNotify.c
+++ b/contrib/tcl/generic/tclNotify.c
@@ -1,71 +1,125 @@
 /* 
  * tclNotify.c --
  *
- *	This file provides the parts of the Tcl event notifier that are
- *	the same on all platforms, plus a few other parts that are used
- *	on more than one platform but not all.
+ *	This file implements the generic portion of the Tcl notifier.
+ *	The notifier is lowest-level part of the event system.  It
+ *	manages an event queue that holds Tcl_Event structures.  The
+ *	platform specific portion of the notifier is defined in the
+ *	tcl*Notify.c files in each platform directory.
  *
- *	The notifier is the lowest-level part of the event system.  It
- *	manages an event queue that holds Tcl_Event structures and a list
- *	of event sources that can add events to the queue.  It also
- *	contains the procedure Tcl_DoOneEvent that invokes the event
- *	sources and blocks to wait for new events, but Tcl_DoOneEvent
- *	is in the platform-specific part of the notifier (in files like
- *	tclUnixNotify.c).
- *
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclNotify.c 1.6 96/02/29 09:20:10
+ * SCCS: @(#) tclNotify.c 1.15 97/06/18 17:14:04
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
 /*
- * The following variable records the address of the first event
- * source in the list of all event sources for the application.
- * This variable is accessed by the notifier to traverse the list
- * and invoke each event source.
+ * The following static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * For each event source (created with Tcl_CreateEventSource) there
+ * is a structure of the following type:
  */
 
-TclEventSource *tclFirstEventSourcePtr = NULL;
+typedef struct EventSource {
+    Tcl_EventSetupProc *setupProc;
+    Tcl_EventCheckProc *checkProc;
+    ClientData clientData;
+    struct EventSource *nextPtr;
+} EventSource;
 
 /*
- * The following variables indicate how long to block in the event
- * notifier the next time it blocks (default:  block forever).
+ * The following structure keeps track of the state of the notifier.
+ * The first three elements keep track of the event queue.  In addition to
+ * the first (next to be serviced) and last events in the queue, we keep
+ * track of a "marker" event.  This provides a simple priority mechanism
+ * whereby events can be inserted at the front of the queue but behind all
+ * other high-priority events already in the queue (this is used for things
+ * like a sequence of Enter and Leave events generated during a grab in
+ * Tk).
  */
 
-static int blockTimeSet = 0;	/* 0 means there is no maximum block
+static struct {
+    Tcl_Event *firstEventPtr;	/* First pending event, or NULL if none. */
+    Tcl_Event *lastEventPtr;	/* Last pending event, or NULL if none. */
+    Tcl_Event *markerEventPtr;	/* Last high-priority event in queue, or
+				 * NULL if none. */
+    int serviceMode;		/* One of TCL_SERVICE_NONE or
+				 * TCL_SERVICE_ALL. */
+    int blockTimeSet;		/* 0 means there is no maximum block
 				 * time:  block forever. */
-static Tcl_Time blockTime;	/* If blockTimeSet is 1, gives the
+    Tcl_Time blockTime;		/* If blockTimeSet is 1, gives the
 				 * maximum elapsed time for the next block. */
+    int inTraversal;		/* 1 if Tcl_SetMaxBlockTime is being
+				 * called during an event source traversal. */
+    EventSource *firstEventSourcePtr;
+				/* Pointer to first event source in
+				 * global list of event sources. */
+} notifier;
 
 /*
- * The following variables keep track of the event queue.  In addition
- * to the first (next to be serviced) and last events in the queue,
- * we keep track of a "marker" event.  This provides a simple priority
- * mechanism whereby events can be inserted at the front of the queue
- * but behind all other high-priority events already in the queue (this
- * is used for things like a sequence of Enter and Leave events generated
- * during a grab in Tk).
+ * Declarations for functions used in this file.
  */
 
-static Tcl_Event *firstEventPtr = NULL;
-				/* First pending event, or NULL if none. */
-static Tcl_Event *lastEventPtr = NULL;
-				/* Last pending event, or NULL if none. */
-static Tcl_Event *markerEventPtr = NULL;
-				/* Last high-priority event in queue, or
-				 * NULL if none. */
+static void	InitNotifier _ANSI_ARGS_((void));
+static void	NotifierExitHandler _ANSI_ARGS_((ClientData clientData));
 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ *	This routine is called to initialize the notifier module.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates an exit handler and initializes static data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitNotifier()
+{
+    initialized = 1;
+    memset(&notifier, 0, sizeof(notifier));
+    notifier.serviceMode = TCL_SERVICE_NONE;
+    Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+}
+
 /*
- * Prototypes for procedures used only in this file:
+ *----------------------------------------------------------------------
+ *
+ * NotifierExitHandler --
+ *
+ *	This routine is called during Tcl finalization.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Clears the notifier intialization flag.
+ *
+ *----------------------------------------------------------------------
  */
 
-static int		ServiceEvent _ANSI_ARGS_((int flags));
+static void
+NotifierExitHandler(clientData)
+    ClientData clientData;  /* Not used. */
+{
+    initialized = 0;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -112,14 +166,18 @@ Tcl_CreateEventSource(setupProc, checkProc, clientData)
     ClientData clientData;		/* One-word argument to pass to
 					 * setupProc and checkProc. */
 {
-    TclEventSource *sourcePtr;
+    EventSource *sourcePtr;
+
+    if (!initialized) {
+	InitNotifier();
+    }
 
-    sourcePtr = (TclEventSource *) ckalloc(sizeof(TclEventSource));
+    sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
     sourcePtr->setupProc = setupProc;
     sourcePtr->checkProc = checkProc;
     sourcePtr->clientData = clientData;
-    sourcePtr->nextPtr = tclFirstEventSourcePtr;
-    tclFirstEventSourcePtr = sourcePtr;
+    sourcePtr->nextPtr = notifier.firstEventSourcePtr;
+    notifier.firstEventSourcePtr = sourcePtr;
 }
 
 /*
@@ -150,9 +208,9 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
     ClientData clientData;		/* One-word argument to pass to
 					 * setupProc and checkProc. */
 {
-    TclEventSource *sourcePtr, *prevPtr;
+    EventSource *sourcePtr, *prevPtr;
 
-    for (sourcePtr = tclFirstEventSourcePtr, prevPtr = NULL;
+    for (sourcePtr = notifier.firstEventSourcePtr, prevPtr = NULL;
 	    sourcePtr != NULL;
 	    prevPtr = sourcePtr, sourcePtr = sourcePtr->nextPtr) {
 	if ((sourcePtr->setupProc != setupProc)
@@ -161,7 +219,7 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
 	    continue;
 	}
 	if (prevPtr == NULL) {
-	    tclFirstEventSourcePtr = sourcePtr->nextPtr;
+	    notifier.firstEventSourcePtr = sourcePtr->nextPtr;
 	} else {
 	    prevPtr->nextPtr = sourcePtr->nextPtr;
 	}
@@ -202,44 +260,48 @@ Tcl_QueueEvent(evPtr, position)
     Tcl_QueuePosition position;	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 				 * TCL_QUEUE_MARK. */
 {
+    if (!initialized) {
+	InitNotifier();
+    }
+
     if (position == TCL_QUEUE_TAIL) {
 	/*
 	 * Append the event on the end of the queue.
 	 */
 
 	evPtr->nextPtr = NULL;
-	if (firstEventPtr == NULL) {
-	    firstEventPtr = evPtr;
+	if (notifier.firstEventPtr == NULL) {
+	    notifier.firstEventPtr = evPtr;
 	} else {
-	    lastEventPtr->nextPtr = evPtr;
+	    notifier.lastEventPtr->nextPtr = evPtr;
 	}
-	lastEventPtr = evPtr;
+	notifier.lastEventPtr = evPtr;
     } else if (position == TCL_QUEUE_HEAD) {
 	/*
 	 * Push the event on the head of the queue.
 	 */
 
-	evPtr->nextPtr = firstEventPtr;
-	if (firstEventPtr == NULL) {
-	    lastEventPtr = evPtr;
+	evPtr->nextPtr = notifier.firstEventPtr;
+	if (notifier.firstEventPtr == NULL) {
+	    notifier.lastEventPtr = evPtr;
 	}	    
-	firstEventPtr = evPtr;
+	notifier.firstEventPtr = evPtr;
     } else if (position == TCL_QUEUE_MARK) {
 	/*
 	 * Insert the event after the current marker event and advance
 	 * the marker to the new event.
 	 */
 
-	if (markerEventPtr == NULL) {
-	    evPtr->nextPtr = firstEventPtr;
-	    firstEventPtr = evPtr;
+	if (notifier.markerEventPtr == NULL) {
+	    evPtr->nextPtr = notifier.firstEventPtr;
+	    notifier.firstEventPtr = evPtr;
 	} else {
-	    evPtr->nextPtr = markerEventPtr->nextPtr;
-	    markerEventPtr->nextPtr = evPtr;
+	    evPtr->nextPtr = notifier.markerEventPtr->nextPtr;
+	    notifier.markerEventPtr->nextPtr = evPtr;
 	}
-	markerEventPtr = evPtr;
+	notifier.markerEventPtr = evPtr;
 	if (evPtr->nextPtr == NULL) {
-	    lastEventPtr = evPtr;
+	    notifier.lastEventPtr = evPtr;
 	}
     }
 }
@@ -269,14 +331,18 @@ Tcl_DeleteEvents(proc, clientData)
 {
     Tcl_Event *evPtr, *prevPtr, *hold;
 
-    for (prevPtr = (Tcl_Event *) NULL, evPtr = firstEventPtr;
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    for (prevPtr = (Tcl_Event *) NULL, evPtr = notifier.firstEventPtr;
              evPtr != (Tcl_Event *) NULL;
              ) {
         if ((*proc) (evPtr, clientData) == 1) {
-            if (firstEventPtr == evPtr) {
-                firstEventPtr = evPtr->nextPtr;
+            if (notifier.firstEventPtr == evPtr) {
+                notifier.firstEventPtr = evPtr->nextPtr;
                 if (evPtr->nextPtr == (Tcl_Event *) NULL) {
-                    lastEventPtr = (Tcl_Event *) NULL;
+                    notifier.lastEventPtr = (Tcl_Event *) NULL;
                 }
             } else {
                 prevPtr->nextPtr = evPtr->nextPtr;
@@ -294,10 +360,10 @@ Tcl_DeleteEvents(proc, clientData)
 /*
  *----------------------------------------------------------------------
  *
- * ServiceEvent --
+ * Tcl_ServiceEvent --
  *
- *	Process one event from the event queue.  This routine is called
- *	by the notifier whenever it wants Tk to process an event.  
+ *	Process one event from the event queue, or invoke an
+ *	asynchronous event handler.
  *
  * Results:
  *	The return value is 1 if the procedure actually found an event
@@ -311,8 +377,8 @@ Tcl_DeleteEvents(proc, clientData)
  *----------------------------------------------------------------------
  */
 
-static int
-ServiceEvent(flags)
+int
+Tcl_ServiceEvent(flags)
     int flags;			/* Indicates what events should be processed.
 				 * May be any combination of TCL_WINDOW_EVENTS
 				 * TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other
@@ -323,6 +389,21 @@ ServiceEvent(flags)
     Tcl_Event *evPtr, *prevPtr;
     Tcl_EventProc *proc;
 
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    /*
+     * Asynchronous event handlers are considered to be the highest
+     * priority events, and so must be invoked before we process events
+     * on the event queue.
+     */
+    
+    if (Tcl_AsyncReady()) {
+	(void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+	return 1;
+    }
+
     /*
      * No event flags is equivalent to TCL_ALL_EVENTS.
      */
@@ -336,7 +417,8 @@ ServiceEvent(flags)
      * that can actually be handled.
      */
 
-    for (evPtr = firstEventPtr; evPtr != NULL; evPtr = evPtr->nextPtr) {
+    for (evPtr = notifier.firstEventPtr; evPtr != NULL;
+	 evPtr = evPtr->nextPtr) {
 	/*
 	 * Call the handler for the event.  If it actually handles the
 	 * event then free the storage for the event.  There are two
@@ -356,23 +438,26 @@ ServiceEvent(flags)
 	proc = evPtr->proc;
 	evPtr->proc = NULL;
 	if ((proc != NULL) && (*proc)(evPtr, flags)) {
-	    if (firstEventPtr == evPtr) {
-		firstEventPtr = evPtr->nextPtr;
+	    if (notifier.firstEventPtr == evPtr) {
+		notifier.firstEventPtr = evPtr->nextPtr;
 		if (evPtr->nextPtr == NULL) {
-		    lastEventPtr = NULL;
+		    notifier.lastEventPtr = NULL;
+		}
+		if (notifier.markerEventPtr == evPtr) {
+		    notifier.markerEventPtr = NULL;
 		}
 	    } else {
-		for (prevPtr = firstEventPtr; prevPtr->nextPtr != evPtr;
-			prevPtr = prevPtr->nextPtr) {
+		for (prevPtr = notifier.firstEventPtr;
+		     prevPtr->nextPtr != evPtr; prevPtr = prevPtr->nextPtr) {
 		    /* Empty loop body. */
 		}
 		prevPtr->nextPtr = evPtr->nextPtr;
 		if (evPtr->nextPtr == NULL) {
-		    lastEventPtr = prevPtr;
+		    notifier.lastEventPtr = prevPtr;
+		}
+		if (notifier.markerEventPtr == evPtr) {
+		    notifier.markerEventPtr = prevPtr;
 		}
-	    }
-	    if (markerEventPtr == evPtr) {
-		markerEventPtr = NULL;
 	    }
 	    ckfree((char *) evPtr);
 	    return 1;
@@ -398,6 +483,64 @@ ServiceEvent(flags)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_GetServiceMode --
+ *
+ *	This routine returns the current service mode of the notifier.
+ *
+ * Results:
+ *	Returns either TCL_SERVICE_ALL or TCL_SERVICE_NONE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetServiceMode()
+{
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    return notifier.serviceMode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetServiceMode --
+ *
+ *	This routine sets the current service mode of the notifier.
+ *
+ * Results:
+ *	Returns the previous service mode.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetServiceMode(mode)
+    int mode;			/* New service mode: TCL_SERVICE_ALL or
+				 * TCL_SERVICE_NONE */
+{
+    int oldMode;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    oldMode = notifier.serviceMode;
+    notifier.serviceMode = mode;
+    return oldMode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_SetMaxBlockTime --
  *
  *	This procedure is invoked by event sources to tell the notifier
@@ -420,11 +563,28 @@ Tcl_SetMaxBlockTime(timePtr)
 				 * the next blocking operation in the
 				 * event notifier. */
 {
-    if (!blockTimeSet || (timePtr->sec < blockTime.sec)
-	    || ((timePtr->sec == blockTime.sec)
-	    && (timePtr->usec < blockTime.usec))) {
-	blockTime = *timePtr;
-	blockTimeSet = 1;
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    if (!notifier.blockTimeSet || (timePtr->sec < notifier.blockTime.sec)
+	    || ((timePtr->sec == notifier.blockTime.sec)
+	    && (timePtr->usec < notifier.blockTime.usec))) {
+	notifier.blockTime = *timePtr;
+	notifier.blockTimeSet = 1;
+    }
+
+    /*
+     * If we are called outside an event source traversal, set the
+     * timeout immediately.
+     */
+
+    if (!notifier.inTraversal) {
+	if (notifier.blockTimeSet) {
+	    Tcl_SetTimer(&notifier.blockTime);
+	} else {
+	    Tcl_SetTimer(NULL);
+	}
     }
 }
 
@@ -459,9 +619,24 @@ Tcl_DoOneEvent(flags)
 				 * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
 				 * others defined by event sources. */
 {
-    TclEventSource *sourcePtr;
+    int result = 0, oldMode;
+    EventSource *sourcePtr;
     Tcl_Time *timePtr;
 
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    /*
+     * The first thing we do is to service any asynchronous event
+     * handlers.
+     */
+    
+    if (Tcl_AsyncReady()) {
+	(void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+	return 1;
+    }
+
     /*
      * No event flags is equivalent to TCL_ALL_EVENTS.
      */
@@ -471,108 +646,212 @@ Tcl_DoOneEvent(flags)
     }
 
     /*
+     * Set the service mode to none so notifier event routines won't
+     * try to service events recursively.
+     */
+
+    oldMode = notifier.serviceMode;
+    notifier.serviceMode = TCL_SERVICE_NONE;
+
+    /*
      * The core of this procedure is an infinite loop, even though
      * we only service one event.  The reason for this is that we
-     * might think we have an event ready (e.g. the connection to
-     * the server becomes readable), but then we might discover that
-     * there's nothing interesting on that connection, so no event
-     * was serviced.  Or, the select operation could return prematurely
-     * due to a signal.  The easiest thing in both these cases is
-     * just to loop back and try again.
+     * may be processing events that don't do anything inside of Tcl.
      */
 
     while (1) {
 
 	/*
-	 * The first thing we do is to service any asynchronous event
-	 * handlers.
-	 */
-    
-	if (Tcl_AsyncReady()) {
-	    (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
-	    return 1;
-	}
-
-	/*
 	 * If idle events are the only things to service, skip the
 	 * main part of the loop and go directly to handle idle
-	 * events (i.e. don't wait even if TCL_DONT_WAIT isn't set.
+	 * events (i.e. don't wait even if TCL_DONT_WAIT isn't set).
 	 */
 
-	if (flags == TCL_IDLE_EVENTS) {
+	if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) {
 	    flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
 	    goto idleEvents;
 	}
 
 	/*
-	 * Ask Tk to service a queued event, if there are any.
+	 * Ask Tcl to service a queued event, if there are any.
 	 */
 
-	if (ServiceEvent(flags)) {
-	    return 1;
+	if (Tcl_ServiceEvent(flags)) {
+	    result = 1;	    
+	    break;
 	}
 
 	/*
-	 * There are no events already queued.  Invoke all of the
-	 * event sources to give them a chance to setup for the wait.
+	 * If TCL_DONT_WAIT is set, be sure to poll rather than
+	 * blocking, otherwise reset the block time to infinity.
 	 */
 
-	blockTimeSet = 0;
-	for (sourcePtr = tclFirstEventSourcePtr; sourcePtr != NULL;
-		sourcePtr = sourcePtr->nextPtr) {
-	    (*sourcePtr->setupProc)(sourcePtr->clientData, flags);
+	if (flags & TCL_DONT_WAIT) {
+	    notifier.blockTime.sec = 0;
+	    notifier.blockTime.usec = 0;
+	    notifier.blockTimeSet = 1;
+	} else {
+	    notifier.blockTimeSet = 0;
 	}
-	if ((flags & TCL_DONT_WAIT) ||
-		((flags & TCL_IDLE_EVENTS) && TclIdlePending())) {
-	    /*
-	     * Don't block:  there are idle events waiting, or we don't
-	     * care about idle events anyway, or the caller asked us not
-	     * to block.
-	     */
 
-	    blockTime.sec = 0;
-	    blockTime.usec = 0;
-	    timePtr = &blockTime;
-	} else if (blockTimeSet) {
-	    timePtr = &blockTime;
+	/*
+	 * Set up all the event sources for new events.  This will
+	 * cause the block time to be updated if necessary.
+	 */
+
+	notifier.inTraversal = 1;
+	for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+	     sourcePtr = sourcePtr->nextPtr) {
+	    if (sourcePtr->setupProc) {
+		(sourcePtr->setupProc)(sourcePtr->clientData, flags);
+	    }
+	}
+	notifier.inTraversal = 0;
+
+	if ((flags & TCL_DONT_WAIT) || notifier.blockTimeSet) {
+	    timePtr = &notifier.blockTime;
 	} else {
 	    timePtr = NULL;
 	}
 
 	/*
-	 * Wait until an event occurs or the timer expires.
+	 * Wait for a new event or a timeout.  If Tcl_WaitForEvent
+	 * returns -1, we should abort Tcl_DoOneEvent.
 	 */
 
-	if (Tcl_WaitForEvent(timePtr) == TCL_ERROR) {
-	    return 0;
+	result = Tcl_WaitForEvent(timePtr);
+	if (result < 0) {
+	    result = 0;
+	    break;
 	}
 
 	/*
-	 * Give each of the event sources a chance to queue events,
-	 * then call ServiceEvent and give it another chance to
-	 * service events.
+	 * Check all the event sources for new events.
 	 */
 
-	for (sourcePtr = tclFirstEventSourcePtr; sourcePtr != NULL;
-		sourcePtr = sourcePtr->nextPtr) {
-	    (*sourcePtr->checkProc)(sourcePtr->clientData, flags);
+	for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+	     sourcePtr = sourcePtr->nextPtr) {
+	    if (sourcePtr->checkProc) {
+		(sourcePtr->checkProc)(sourcePtr->clientData, flags);
+	    }
 	}
-	if (ServiceEvent(flags)) {
-	    return 1;
+
+	/*
+	 * Check for events queued by the notifier or event sources.
+	 */
+
+	if (Tcl_ServiceEvent(flags)) {
+	    result = 1;
+	    break;
 	}
 
 	/*
-	 * We've tried everything at this point, but nobody had anything
-	 * to do.  Check for idle events.  If none, either quit or go back
-	 * to the top and try again.
+	 * We've tried everything at this point, but nobody we know
+	 * about had anything to do.  Check for idle events.  If none,
+	 * either quit or go back to the top and try again.
 	 */
 
 	idleEvents:
-	if ((flags & TCL_IDLE_EVENTS) && TclServiceIdle()) {
-	    return 1;
+	if (flags & TCL_IDLE_EVENTS) {
+	    if (TclServiceIdle()) {
+		result = 1;
+		break;
+	    }
 	}
 	if (flags & TCL_DONT_WAIT) {
-	    return 0;
+	    break;
 	}
     }
+
+    notifier.serviceMode = oldMode;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ServiceAll --
+ *
+ *	This routine checks all of the event sources, processes
+ *	events that are on the Tcl event queue, and then calls the
+ *	any idle handlers.  Platform specific notifier callbacks that
+ *	generate events should call this routine before returning to
+ *	the system in order to ensure that Tcl gets a chance to
+ *	process the new events.
+ *
+ * Results:
+ *	Returns 1 if an event or idle handler was invoked, else 0.
+ *
+ * Side effects:
+ *	Anything that an event or idle handler may do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ServiceAll()
+{
+    int result = 0;
+    EventSource *sourcePtr;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    if (notifier.serviceMode == TCL_SERVICE_NONE) {
+	return result;
+    }
+
+    /*
+     * We need to turn off event servicing like we to in Tcl_DoOneEvent,
+     * to avoid recursive calls.
+     */
+    
+    notifier.serviceMode = TCL_SERVICE_NONE;
+
+    /*
+     * Check async handlers first.
+     */
+
+    if (Tcl_AsyncReady()) {
+	(void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+    }
+
+    /*
+     * Make a single pass through all event sources, queued events,
+     * and idle handlers.  Note that we wait to update the notifier
+     * timer until the end so we can avoid multiple changes.
+     */
+
+    notifier.inTraversal = 1;
+    notifier.blockTimeSet = 0;
+
+    for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+	 sourcePtr = sourcePtr->nextPtr) {
+	if (sourcePtr->setupProc) {
+	    (sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
+	}
+    }
+    for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+	 sourcePtr = sourcePtr->nextPtr) {
+	if (sourcePtr->checkProc) {
+	    (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
+	}
+    }
+
+    while (Tcl_ServiceEvent(0)) {
+	result = 1;
+    }
+    if (TclServiceIdle()) {
+	result = 1;
+    }
+
+    if (!notifier.blockTimeSet) {
+	Tcl_SetTimer(NULL);
+    } else {
+	Tcl_SetTimer(&notifier.blockTime);
+    }
+    notifier.inTraversal = 0;
+    notifier.serviceMode = TCL_SERVICE_ALL;
+    return result;
 }
diff --git a/contrib/tcl/generic/tclObj.c b/contrib/tcl/generic/tclObj.c
new file mode 100644
index 0000000..5d4afe5
--- /dev/null
+++ b/contrib/tcl/generic/tclObj.c
@@ -0,0 +1,2021 @@
+/* 
+ * tclObj.c --
+ *
+ *	This file contains Tcl object-related procedures that are used by
+ * 	many Tcl commands.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclObj.c 1.44 97/06/20 15:19:32
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Table of all object types.
+ */
+
+static Tcl_HashTable typeTable;
+static int typeTableInitialized = 0;    /* 0 means not yet initialized. */
+
+/*
+ * Head of the list of free Tcl_Objs we maintain.
+ */
+
+Tcl_Obj *tclFreeObjList = NULL;
+
+/*
+ * Pointer to a heap-allocated string of length zero that the Tcl core uses
+ * as the value of an empty string representation for an object. This value
+ * is shared by all new objects allocated by Tcl_NewObj.
+ */
+
+char *tclEmptyStringRep = NULL;
+
+/*
+ * Count of the number of Tcl objects every allocated (by Tcl_NewObj) and
+ * freed (by TclFreeObj).
+ */
+
+#ifdef TCL_COMPILE_STATS
+long tclObjsAlloced = 0;
+long tclObjsFreed = 0;
+#endif /* TCL_COMPILE_STATS */
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupBooleanInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		DupDoubleInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		DupIntInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		FinalizeTypeTable _ANSI_ARGS_((void));
+static void		FinalizeFreeObjList _ANSI_ARGS_((void));
+static void		InitTypeTable _ANSI_ARGS_((void));
+static int		SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static int		SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static int		SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structures below defines the Tcl object types defined in this file by
+ * means of procedures that can be invoked by generic object code. See also
+ * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
+ * implementations.
+ */
+
+Tcl_ObjType tclBooleanType = {
+    "boolean",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupBooleanInternalRep,		/* dupIntRepProc */
+    UpdateStringOfBoolean,		/* updateStringProc */
+    SetBooleanFromAny			/* setFromAnyProc */
+};
+
+Tcl_ObjType tclDoubleType = {
+    "double",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupDoubleInternalRep,		/* dupIntRepProc */
+    UpdateStringOfDouble,		/* updateStringProc */
+    SetDoubleFromAny			/* setFromAnyProc */
+};
+
+Tcl_ObjType tclIntType = {
+    "int",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupIntInternalRep,		        /* dupIntRepProc */
+    UpdateStringOfInt,			/* updateStringProc */
+    SetIntFromAny			/* setFromAnyProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitTypeTable --
+ *
+ *	This procedure is invoked to perform once-only initialization of
+ *	the type table. It also registers the object types defined in 
+ *	this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the table of defined object types "typeTable" with
+ *	builtin object types defined in this file. It also initializes the
+ *	value of tclEmptyStringRep, which points to the heap-allocated
+ *	string of length zero used as the string representation for
+ *	newly-created objects.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitTypeTable()
+{
+    typeTableInitialized = 1;
+
+    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
+    Tcl_RegisterObjType(&tclBooleanType);
+    Tcl_RegisterObjType(&tclDoubleType);
+    Tcl_RegisterObjType(&tclIntType);
+    Tcl_RegisterObjType(&tclStringType);
+    Tcl_RegisterObjType(&tclListType);
+    Tcl_RegisterObjType(&tclByteCodeType);
+
+    tclEmptyStringRep = (char *) ckalloc((unsigned) 1);
+    tclEmptyStringRep[0] = '\0';
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeTypeTable --
+ *
+ *	This procedure is called by Tcl_Finalize after all exit handlers
+ *	have been run to free up storage associated with the table of Tcl
+ *	object types.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes all entries in the hash table of object types, "typeTable".
+ *	Then sets "typeTableInitialized" to 0 so that the Tcl type system
+ *	will be properly reinitialized if Tcl is restarted. Also deallocates
+ *	the storage for tclEmptyStringRep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeTypeTable()
+{
+    if (typeTableInitialized) {
+        Tcl_DeleteHashTable(&typeTable);
+	ckfree(tclEmptyStringRep);
+        typeTableInitialized = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeFreeObjList --
+ *
+ *	Resets the free object list so it can later be reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Resets the value of tclFreeObjList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeFreeObjList()
+{
+    tclFreeObjList = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeCompExecEnv --
+ *
+ *	Clean up the compiler execution environment so it can later be
+ *	properly reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Cleans up the execution environment
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeCompExecEnv()
+{
+    FinalizeTypeTable();
+    FinalizeFreeObjList();
+    TclFinalizeExecEnv();
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_RegisterObjType --
+ *
+ *	This procedure is called to register a new Tcl object type
+ *	in the table of all object types supported by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The type is registered in the Tcl type table. If there was already
+ *	a type with the same name as in typePtr, it is replaced with the
+ *	new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_RegisterObjType(typePtr)
+    Tcl_ObjType *typePtr;	/* Information about object type;
+				 * storage must be statically
+				 * allocated (must live forever). */
+{
+    register Tcl_HashEntry *hPtr;
+    int new;
+
+    if (!typeTableInitialized) {
+	InitTypeTable();
+    }
+
+    /*
+     * If there's already an object type with the given name, remove it.
+     */
+
+    hPtr = Tcl_FindHashEntry(&typeTable, typePtr->name);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * Now insert the new object type.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&typeTable, typePtr->name, &new);
+    if (new) {
+	Tcl_SetHashValue(hPtr, typePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendAllObjTypes --
+ *
+ *	This procedure appends onto the argument object the name of each
+ *	object type as a list element. This includes the builtin object
+ *	types (e.g. int, list) as well as those added using
+ *	Tcl_CreateObjType. These names can be used, for example, with
+ *	Tcl_GetObjType to get pointers to the corresponding Tcl_ObjType
+ *	structures.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case the object
+ *	referenced by objPtr has each type name appended to it. If an
+ *	error occurs, TCL_ERROR is returned and the interpreter's result
+ *	holds an error message.
+ *
+ * Side effects:
+ *	If necessary, the object referenced by objPtr is converted into
+ *	a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppendAllObjTypes(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
+    Tcl_Obj *objPtr;		/* Points to the Tcl object onto which the
+				 * name of each registered type is appended
+				 * as a list element. */
+{
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_ObjType *typePtr;
+    int result;
+ 
+    if (!typeTableInitialized) {
+	InitTypeTable();
+    }
+
+    /*
+     * This code assumes that types names do not contain embedded NULLs.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
+	    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+        typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+	result = Tcl_ListObjAppendElement(interp, objPtr,
+	        Tcl_NewStringObj(typePtr->name, -1));
+	if (result == TCL_ERROR) {
+	    return result;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetObjType --
+ *
+ *	This procedure looks up an object type by name.
+ *
+ * Results:
+ *	If an object type with name matching "typeName" is found, a pointer
+ *	to its Tcl_ObjType structure is returned; otherwise, NULL is
+ *	returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ObjType *
+Tcl_GetObjType(typeName)
+    char *typeName;		/* Name of Tcl object type to look up. */
+{
+    register Tcl_HashEntry *hPtr;
+    Tcl_ObjType *typePtr;
+
+    if (!typeTableInitialized) {
+	InitTypeTable();
+    }
+
+    hPtr = Tcl_FindHashEntry(&typeTable, typeName);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+	return typePtr;
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConvertToType --
+ *
+ *	Convert the Tcl object "objPtr" to have type "typePtr" if possible.
+ *
+ * Results:
+ *	The return value is TCL_OK on success and TCL_ERROR on failure. If
+ *	TCL_ERROR is returned, then the interpreter's result contains an
+ *	error message unless "interp" is NULL. Passing a NULL "interp"
+ *	allows this procedure to be used as a test whether the conversion
+ *	could be done (and in fact was done).
+ *
+ * Side effects:
+ *	Any internal representation for the old type is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConvertToType(interp, objPtr, typePtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+    Tcl_ObjType *typePtr;	/* The target type. */
+{
+    if (objPtr->typePtr == typePtr) {
+	return TCL_OK;
+    }
+
+    /*
+     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal
+     * form as appropriate for the target type. This frees the old internal
+     * representation.
+     */
+
+    return typePtr->setFromAnyProc(interp, objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
+ *	the empty string. These objects have a NULL object type and NULL
+ *	string representation byte pointer. Type managers call this routine
+ *	to allocate new objects that they further initialize.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewObj.
+ *
+ * Results:
+ *	The result is a newly allocated object that represents the empty
+ *	string. The new object's typePtr is set NULL and its ref count
+ *	is set to 0.
+ *
+ * Side effects:
+ *	If compiling with TCL_COMPILE_STATS, this procedure increments
+ *	the global count of allocated objects (tclObjsAlloced).
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewObj
+
+Tcl_Obj *
+Tcl_NewObj()
+{
+    return Tcl_DbNewObj("unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewObj()
+{
+    register Tcl_Obj *objPtr;
+
+    /*
+     * Allocate the object using the list of free Tcl_Objs we maintain.
+     */
+
+    if (tclFreeObjList == NULL) {
+	TclAllocateFreeObjects();
+    }
+    objPtr = tclFreeObjList;
+    tclFreeObjList = (Tcl_Obj *) tclFreeObjList->internalRep.otherValuePtr;
+    
+    objPtr->refCount = 0;
+    objPtr->bytes    = tclEmptyStringRep;
+    objPtr->length   = 0;
+    objPtr->typePtr  = NULL;
+#ifdef TCL_COMPILE_STATS
+    tclObjsAlloced++;
+#endif /* TCL_COMPILE_STATS */
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
+ *	empty string. It is the same as the Tcl_NewObj procedure above
+ *	except that it calls Tcl_DbCkalloc directly with the file name and
+ *	line number from its caller. This simplifies debugging since then
+ *	the checkmem command will report the correct file name and line
+ *	number when reporting objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewObj.
+ *
+ * Results:
+ *	The result is a newly allocated that represents the empty string.
+ *	The new object's typePtr is set NULL and its ref count is set to 0.
+ *
+ * Side effects:
+ *	If compiling with TCL_COMPILE_STATS, this procedure increments
+ *	the global count of allocated objects (tclObjsAlloced).
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewObj(file, line)
+    register char *file;	/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    register int line;		/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    /*
+     * If debugging Tcl's memory usage, allocate the object using ckalloc.
+     * Otherwise, allocate it using the list of free Tcl_Objs we maintain.
+     */
+
+    objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
+    objPtr->refCount = 0;
+    objPtr->bytes    = tclEmptyStringRep;
+    objPtr->length   = 0;
+    objPtr->typePtr  = NULL;
+#ifdef TCL_COMPILE_STATS
+    tclObjsAlloced++;
+#endif /* TCL_COMPILE_STATS */
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewObj(file, line)
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewObj();
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAllocateFreeObjects --
+ *
+ *	Procedure to allocate a number of free Tcl_Objs. This is done using
+ *	a single ckalloc to reduce the overhead for Tcl_Obj allocation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
+ *	first of a number of free Tcl_Obj's linked together by their
+ *	internalRep.otherValuePtrs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define OBJS_TO_ALLOC_EACH_TIME 100
+
+void
+TclAllocateFreeObjects()
+{
+    Tcl_Obj tmp[2];
+    size_t objSizePlusPadding =	/* NB: this assumes byte addressing. */
+	((int)(&(tmp[1])) - (int)(&(tmp[0])));
+    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * objSizePlusPadding);
+    char *basePtr;
+    register Tcl_Obj *prevPtr, *objPtr;
+    register int i;
+
+    basePtr = (char *) ckalloc(bytesToAlloc);
+    memset(basePtr, 0, bytesToAlloc);
+
+    prevPtr = NULL;
+    objPtr = (Tcl_Obj *) basePtr;
+    for (i = 0;  i < OBJS_TO_ALLOC_EACH_TIME;  i++) {
+	objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
+	prevPtr = objPtr;
+	objPtr = (Tcl_Obj *) (((char *)objPtr) + objSizePlusPadding);
+    }
+    tclFreeObjList = prevPtr;
+}
+#undef OBJS_TO_ALLOC_EACH_TIME
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeObj --
+ *
+ *	This procedure frees the memory associated with the argument
+ *	object. It is called by the tcl.h macro Tcl_DecrRefCount when an
+ *	object's ref count is zero. It is only "public" since it must
+ *	be callable by that macro wherever the macro is used. It should not
+ *	be directly called by clients.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates the storage for the object's Tcl_Obj structure
+ *	after deallocating the string representation and calling the
+ *	type-specific Tcl_FreeInternalRepProc to deallocate the object's
+ *	internal representation. If compiling with TCL_COMPILE_STATS,
+ *	this procedure increments the global count of freed objects
+ *	(tclObjsFreed).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeObj(objPtr)
+    register Tcl_Obj *objPtr;	/* The object to be freed. */
+{
+    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    
+#ifdef TCL_MEM_DEBUG
+    if ((objPtr)->refCount < -1) {
+	panic("Reference count for %lx was negative", objPtr);
+    }
+#endif /* TCL_MEM_DEBUG */
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	typePtr->freeIntRepProc(objPtr);
+    }
+
+    /*
+     * If debugging Tcl's memory usage, deallocate the object using ckfree.
+     * Otherwise, deallocate it by adding it onto the list of free
+     * Tcl_Objs we maintain.
+     */
+    
+#ifdef TCL_MEM_DEBUG
+    ckfree((char *) objPtr);
+#else
+    objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
+    tclFreeObjList = objPtr;
+#endif /* TCL_MEM_DEBUG */
+
+#ifdef TCL_COMPILE_STATS    
+    tclObjsFreed++;
+#endif /* TCL_COMPILE_STATS */    
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DuplicateObj --
+ *
+ *	Create and return a new object that is a duplicate of the argument
+ *	object.
+ *
+ * Results:
+ *	The return value is a pointer to a newly created Tcl_Obj. This
+ *	object has reference count 0 and the same type, if any, as the
+ *	source object objPtr. Also:
+ *	  1) If the source object has a valid string rep, we copy it;
+ *	     otherwise, the duplicate's string rep is set NULL to mark
+ *	     it invalid.
+ *	  2) If the source object has an internal representation (i.e. its
+ *	     typePtr is non-NULL), the new object's internal rep is set to
+ *	     a copy; otherwise the new internal rep is marked invalid.
+ *
+ * Side effects:
+ *      What constitutes "copying" the internal representation depends on
+ *	the type. For example, if the argument object is a list,
+ *	the element objects it points to will not actually be copied but
+ *	will be shared with the duplicate list. That is, the ref counts of
+ *	the element objects will be incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_DuplicateObj(objPtr)
+    register Tcl_Obj *objPtr;		/* The object to duplicate. */
+{
+    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    register Tcl_Obj *dupPtr;
+
+    TclNewObj(dupPtr);
+
+    if (objPtr->bytes == NULL) {
+	dupPtr->bytes = NULL;
+    } else if (objPtr->bytes != tclEmptyStringRep) {
+	int len = objPtr->length;
+	
+	dupPtr->bytes = (char *) ckalloc((unsigned) len+1);
+	if (len > 0) {
+	    memcpy((VOID *) dupPtr->bytes, (VOID *) objPtr->bytes,
+		   (unsigned) len);
+	}
+	dupPtr->bytes[len] = '\0';
+	dupPtr->length = len;
+    }
+    
+    if (typePtr != NULL) {
+	typePtr->dupIntRepProc(objPtr, dupPtr);
+    }
+    return dupPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStringFromObj --
+ *
+ *	Returns the string representation's byte array pointer and length
+ *	for an object.
+ *
+ * Results:
+ *	Returns a pointer to the string representation of objPtr. If
+ *	lengthPtr isn't NULL, the length of the string representation is
+ *	stored at *lengthPtr. The byte array referenced by the returned
+ *	pointer must not be modified by the caller. Furthermore, the
+ *	caller must copy the bytes if they need to retain them since the
+ *	object's string rep can change as a result of other operations.
+ *
+ * Side effects:
+ *	May call the object's updateStringProc to update the string
+ *	representation from the internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetStringFromObj(objPtr, lengthPtr)
+    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
+				 * should be returned. */
+    register int *lengthPtr;	/* If non-NULL, the location where the
+				 * string rep's byte array length should be
+				 * stored. If NULL, no length is stored. */
+{
+    if (objPtr->bytes != NULL) {
+	if (lengthPtr != NULL) {
+	    *lengthPtr = objPtr->length;
+	}
+	return objPtr->bytes;
+    }
+
+    objPtr->typePtr->updateStringProc(objPtr);
+    if (lengthPtr != NULL) {
+	*lengthPtr = objPtr->length;
+    }
+    return objPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InvalidateStringRep --
+ *
+ *	This procedure is called to invalidate an object's string
+ *	representation. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates the storage for any old string representation, then
+ *	sets the string representation NULL to mark it invalid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_InvalidateStringRep(objPtr)
+     register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
+				 * should be freed. */
+{
+    if (objPtr->bytes != NULL) {
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    ckfree((char *) objPtr->bytes);
+	}
+	objPtr->bytes = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewBooleanObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new boolean object and
+ *	initializes it from the argument boolean value. A nonzero
+ *	"boolValue" is coerced to 1.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewBooleanObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewBooleanObj
+
+Tcl_Obj *
+Tcl_NewBooleanObj(boolValue)
+    register int boolValue;	/* Boolean used to initialize new object. */
+{
+    return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewBooleanObj(boolValue)
+    register int boolValue;	/* Boolean used to initialize new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewBooleanObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
+ *	same as the Tcl_NewBooleanObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewBooleanObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewBooleanObj(boolValue, file, line)
+    register int boolValue;	/* Boolean used to initialize new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewBooleanObj(boolValue, file, line)
+    register int boolValue;	/* Boolean used to initialize new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewBooleanObj(boolValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetBooleanObj --
+ *
+ *	Modify an object to be a boolean object and to have the specified
+ *	boolean value. A nonzero "boolValue" is coerced to 1.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetBooleanObj(objPtr, boolValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register int boolValue;	/* Boolean used to set object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetBooleanObj called with shared object");
+    }
+    
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetBooleanFromObj --
+ *
+ *	Attempt to return a boolean from the Tcl object "objPtr". If the
+ *	object is not already a boolean, an attempt will be made to convert
+ *	it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already a boolean, the conversion will free
+ *	any old internal representation. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
+    register int *boolPtr;	/* Place to store resulting boolean. */
+{
+    register int result;
+
+    result = SetBooleanFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*boolPtr = (int) objPtr->internalRep.longValue;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupBooleanInternalRep --
+ *
+ *	Initialize the internal representation of a boolean Tcl_Obj to a
+ *	copy of the internal representation of an existing boolean object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the boolean (an integer)
+ *	corresponding to "srcPtr"s internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupBooleanInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+    copyPtr->typePtr = &tclBooleanType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetBooleanFromAny --
+ *
+ *	Attempt to generate a boolean internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is a standard Tcl result. If an error occurs during
+ *	conversion, an error message is left in the interpreter's result
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s
+ *	internal representation and the type of "objPtr" is set to boolean.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetBooleanFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    register char c;
+    char lowerCase[10];
+    int newBool, length;
+    register int i;
+    double dbl;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Copy the string converting its characters to lower case.
+     */
+
+    for (i = 0;  (i < 9) && (i < length);  i++) {
+	c = string[i];
+	if (isupper(UCHAR(c))) {
+	    c = (char) tolower(UCHAR(c));
+	}
+	lowerCase[i] = c;
+    }
+    lowerCase[i] = 0;
+
+    /*
+     * Parse the string as a boolean. We use an implementation here that
+     * doesn't report errors in interp if interp is NULL.
+     */
+
+    c = lowerCase[0];
+    if ((c == '0') && (lowerCase[1] == '\0')) {
+	newBool = 0;
+    } else if ((c == '1') && (lowerCase[1] == '\0')) {
+	newBool = 1;
+    } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
+	newBool = 1;
+    } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
+	newBool = 0;
+    } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
+	newBool = 1;
+    } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
+	newBool = 0;
+    } else if ((c == 'o') && (length >= 2)) {
+	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+	    newBool = 1;
+	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+	    newBool = 0;
+	} else {
+	    goto badBoolean;
+	}
+    } else {
+        /*
+         * Still might be a string containing the characters representing an
+         * int or double that wasn't handled above. This would be a string
+         * like "27" or "1.0" that is non-zero and not "1". Such a string
+         * whould result in the boolean value true. We try converting to
+         * double. If that succeeds and the resulting double is non-zero, we
+         * have a "true". Note that numbers can't have embedded NULLs.
+	 */
+
+	dbl = strtod(string, &end);
+	if (end == string) {
+	    goto badBoolean;
+	}
+
+	/*
+	 * Make sure the string has no garbage after the end of the double.
+	 */
+	
+	while ((end < (string+length)) && isspace(UCHAR(*end))) {
+	    end++;
+	}
+	if (end != (string+length)) {
+	    goto badBoolean;
+	}
+	newBool = (dbl != 0.0);
+    }
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as
+     * late as possible to allow the conversion code, in particular
+     * Tcl_GetStringFromObj, to use that old internalRep.
+     */
+
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.longValue = newBool;
+    objPtr->typePtr = &tclBooleanType;
+    return TCL_OK;
+
+    badBoolean:
+    if (interp != NULL) {
+	/*
+	 * Must copy string before resetting the result in case a caller
+	 * is trying to convert the interpreter's result to a boolean.
+	 */
+	
+	char buf[100];
+	sprintf(buf, "expected boolean value but got \"%.50s\"", string);
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfBoolean --
+ *
+ *	Update the string representation for a boolean object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the boolean-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfBoolean(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    char *s = ckalloc((unsigned) 2);
+    
+    s[0] = (char) (objPtr->internalRep.longValue? '1' : '0');
+    s[1] = '\0';
+    objPtr->bytes = s;
+    objPtr->length = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewDoubleObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new double object and
+ *	initializes it from the argument double value.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewDoubleObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewDoubleObj
+
+Tcl_Obj *
+Tcl_NewDoubleObj(dblValue)
+    register double dblValue;	/* Double used to initialize the object. */
+{
+    return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewDoubleObj(dblValue)
+    register double dblValue;	/* Double used to initialize the object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+    return objPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewDoubleObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new double objects. It is the
+ *	same as the Tcl_NewDoubleObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewDoubleObj.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewDoubleObj(dblValue, file, line)
+    register double dblValue;	/* Double used to initialize the object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewDoubleObj(dblValue, file, line)
+    register double dblValue;	/* Double used to initialize the object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewDoubleObj(dblValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetDoubleObj --
+ *
+ *	Modify an object to be a double object and to have the specified
+ *	double value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetDoubleObj(objPtr, dblValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register double dblValue;	/* Double used to set the object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetDoubleObj called with shared object");
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetDoubleFromObj --
+ *
+ *	Attempt to return a double from the Tcl object "objPtr". If the
+ *	object is not already a double, an attempt will be made to convert
+ *	it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already a double, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get a double. */
+    register double *dblPtr;	/* Place to store resulting double. */
+{
+    register int result;
+    
+    if (objPtr->typePtr == &tclDoubleType) {
+	*dblPtr = objPtr->internalRep.doubleValue;
+	return TCL_OK;
+    }
+
+    result = SetDoubleFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*dblPtr = objPtr->internalRep.doubleValue;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupDoubleInternalRep --
+ *
+ *	Initialize the internal representation of a double Tcl_Obj to a
+ *	copy of the internal representation of an existing double object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the double precision floating 
+ *	point number corresponding to "srcPtr"s internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupDoubleInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.doubleValue = srcPtr->internalRep.doubleValue;
+    copyPtr->typePtr = &tclDoubleType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetDoubleFromAny --
+ *
+ *	Attempt to generate an double-precision floating point internal form
+ *	for the Tcl object "objPtr".
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, a double is stored as "objPtr"s internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetDoubleFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    double newDouble;
+    int length;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Now parse "objPtr"s string as an double. Numbers can't have embedded
+     * NULLs. We use an implementation here that doesn't report errors in
+     * interp if interp is NULL.
+     */
+
+    errno = 0;
+    newDouble = strtod(string, &end);
+    if (end == string) {
+	badDouble:
+	if (interp != NULL) {
+	    /*
+	     * Must copy string before resetting the result in case a caller
+	     * is trying to convert the interpreter's result to an int.
+	     */
+	    
+	    char buf[100];
+	    sprintf(buf, "expected floating-point number but got \"%.50s\"",
+	            string);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	}
+	return TCL_ERROR;
+    }
+    if (errno != 0) {
+	if (interp != NULL) {
+	    TclExprFloatError(interp, newDouble);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the string has no garbage after the end of the double.
+     */
+    
+    while ((end < (string+length)) && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (end != (string+length)) {
+	goto badDouble;
+    }
+    
+    /*
+     * The conversion to double succeeded. Free the old internalRep before
+     * setting the new one. We do this as late as possible to allow the
+     * conversion code, in particular Tcl_GetStringFromObj, to use that old
+     * internalRep.
+     */
+    
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.doubleValue = newDouble;
+    objPtr->typePtr = &tclDoubleType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfDouble --
+ *
+ *	Update the string representation for a double-precision floating
+ *	point object. This must obey the current tcl_precision value for
+ *	double-to-string conversions. Note: This procedure does not free an
+ *	existing old string rep so storage will be lost if this has not
+ *	already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the double-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfDouble(objPtr)
+    register Tcl_Obj *objPtr;	/* Double obj with string rep to update. */
+{
+    char buffer[TCL_DOUBLE_SPACE];
+    register int len;
+    
+    Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
+	    buffer);
+    len = strlen(buffer);
+    
+    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
+    objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewIntObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewIntObj to create a new integer object end up calling the
+ *	debugging procedure Tcl_DbNewLongObj instead.
+ *
+ *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
+ *	calls to Tcl_NewIntObj result in a call to one of the two
+ *	Tcl_NewIntObj implementations below. We provide two implementations
+ *	so that the Tcl core can be compiled to do memory debugging of the 
+ *	core even if a client does not request it for itself.
+ *
+ *	Integer and long integer objects share the same "integer" type
+ *	implementation. We store all integers as longs and Tcl_GetIntFromObj
+ *	checks whether the current value of the long can be represented by
+ *	an int.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewIntObj
+
+Tcl_Obj *
+Tcl_NewIntObj(intValue)
+    register int intValue;	/* Int used to initialize the new object. */
+{
+    return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewIntObj(intValue)
+    register int intValue;	/* Int used to initialize the new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (long)intValue;
+    objPtr->typePtr = &tclIntType;
+    return objPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetIntObj --
+ *
+ *	Modify an object to be an integer and to have the specified integer
+ *	value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetIntObj(objPtr, intValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register int intValue;	/* Integer used to set object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetIntObj called with shared object");
+    }
+    
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = (long) intValue;
+    objPtr->typePtr = &tclIntType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIntFromObj --
+ *
+ *	Attempt to return an int from the Tcl object "objPtr". If the object
+ *	is not already an int, an attempt will be made to convert it to one.
+ *
+ *	Integer and long integer objects share the same "integer" type
+ *	implementation. We store all integers as longs and Tcl_GetIntFromObj
+ *	checks whether the current value of the long can be represented by
+ *	an int.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion or if the long integer held by the object
+ *	can not be represented by an int, an error message is left in
+ *	the interpreter's result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetIntFromObj(interp, objPtr, intPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get a int. */
+    register int *intPtr;	/* Place to store resulting int. */
+{
+    register long l;
+    int result;
+    
+    if (objPtr->typePtr != &tclIntType) {
+	result = SetIntFromAny(interp, objPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    l = objPtr->internalRep.longValue;
+    if (((long)((int)l)) == l) {
+	*intPtr = (int)objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+    if (interp != NULL) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"integer value too large to represent as non-long integer", -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupIntInternalRep --
+ *
+ *	Initialize the internal representation of an int Tcl_Obj to a
+ *	copy of the internal representation of an existing int object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"copyPtr"s internal rep is set to the integer corresponding to
+ *	"srcPtr"s internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupIntInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+    copyPtr->typePtr = &tclIntType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetIntFromAny --
+ *
+ *	Attempt to generate an integer internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is a standard object Tcl result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, an int is stored as "objPtr"s internal
+ *	representation. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetIntFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    int length;
+    register char *p;
+    long newLong;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Now parse "objPtr"s string as an int. We use an implementation here
+     * that doesn't report errors in interp if interp is NULL. Note: use
+     * strtoul instead of strtol for integer conversions to allow full-size
+     * unsigned numbers, but don't depend on strtoul to handle sign
+     * characters; it won't in some implementations.
+     */
+
+    errno = 0;
+    for (p = string;  isspace(UCHAR(*p));  p++) {
+	/* Empty loop body. */
+    }
+    if (*p == '-') {
+	p++;
+	newLong = -((long)strtoul(p, &end, 0));
+    } else if (*p == '+') {
+	p++;
+	newLong = strtoul(p, &end, 0);
+    } else {
+	newLong = strtoul(p, &end, 0);
+    }
+    if (end == p) {
+	badInteger:
+	if (interp != NULL) {
+	    /*
+	     * Must copy string before resetting the result in case a caller
+	     * is trying to convert the interpreter's result to an int.
+	     */
+	    
+	    char buf[100];
+	    sprintf(buf, "expected integer but got \"%.50s\"", string);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	}
+	return TCL_ERROR;
+    }
+    if (errno == ERANGE) {
+	if (interp != NULL) {
+	    char *s = "integer value too large to represent";
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the string has no garbage after the end of the int.
+     */
+    
+    while ((end < (string+length)) && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (end != (string+length)) {
+	goto badInteger;
+    }
+
+    /*
+     * The conversion to int succeeded. Free the old internalRep before
+     * setting the new one. We do this as late as possible to allow the
+     * conversion code, in particular Tcl_GetStringFromObj, to use that old
+     * internalRep.
+     */
+
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = newLong;
+    objPtr->typePtr = &tclIntType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInt --
+ *
+ *	Update the string representation for an integer object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the int-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfInt(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    char buffer[TCL_DOUBLE_SPACE];
+    register int len;
+    
+    len = TclFormatInt(buffer, objPtr->internalRep.longValue);
+    
+    objPtr->bytes = ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
+    objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewLongObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewLongObj to create a new long integer object end up calling
+ *	the debugging procedure Tcl_DbNewLongObj instead.
+ *
+ *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
+ *	calls to Tcl_NewLongObj result in a call to one of the two
+ *	Tcl_NewLongObj implementations below. We provide two implementations
+ *	so that the Tcl core can be compiled to do memory debugging of the 
+ *	core even if a client does not request it for itself.
+ *
+ *	Integer and long integer objects share the same "integer" type
+ *	implementation. We store all integers as longs and Tcl_GetIntFromObj
+ *	checks whether the current value of the long can be represented by
+ *	an int.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewLongObj
+
+Tcl_Obj *
+Tcl_NewLongObj(longValue)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+{
+    return Tcl_DbNewLongObj(longValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewLongObj(longValue)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+    return objPtr;
+}
+#endif /* if TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewLongObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewIntObj and Tcl_NewLongObj to create new integer or
+ *	long integer objects end up calling the debugging procedure
+ *	Tcl_DbNewLongObj instead. We provide two implementations of
+ *	Tcl_DbNewLongObj so that whether the Tcl core is compiled to do
+ *	memory debugging of the core is independent of whether a client
+ *	requests debugging for itself.
+ *
+ *	When the core is compiled with TCL_MEM_DEBUG defined,
+ *	Tcl_DbNewLongObj calls Tcl_DbCkalloc directly with the file name and
+ *	line number from its caller. This simplifies debugging since then
+ *	the checkmem command will report the caller's file name and line
+ *	number when reporting objects that haven't been freed.
+ *
+ *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
+ *	this procedure just returns the result of calling Tcl_NewLongObj.
+ *
+ * Results:
+ *	The newly created long integer object is returned. This object
+ *	will have an invalid string representation. The returned object has
+ *	ref count 0.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewLongObj(longValue, file, line)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewLongObj(longValue, file, line)
+    register long longValue;	/* Long integer used to initialize the
+				 * new object. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewLongObj(longValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetLongObj --
+ *
+ *	Modify an object to be an integer object and to have the specified
+ *	long integer value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetLongObj(objPtr, longValue)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    register long longValue;	/* Long integer used to initialize the
+				 * object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetLongObj called with shared object");
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetLongFromObj --
+ *
+ *	Attempt to return an long integer from the Tcl object "objPtr". If
+ *	the object is not already an int object, an attempt will be made to
+ *	convert it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int object, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetLongFromObj(interp, objPtr, longPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object from which to get a long. */
+    register long *longPtr;	/* Place to store resulting long. */
+{
+    register int result;
+    
+    if (objPtr->typePtr == &tclIntType) {
+	*longPtr = objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+    result = SetIntFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*longPtr = objPtr->internalRep.longValue;
+    }
+    return result;
+}
diff --git a/contrib/tcl/generic/tclParse.c b/contrib/tcl/generic/tclParse.c
index 656e218..57ba1e1 100644
--- a/contrib/tcl/generic/tclParse.c
+++ b/contrib/tcl/generic/tclParse.c
@@ -11,247 +11,21 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclParse.c 1.50 96/03/02 14:46:55
+ * SCCS: @(#) tclParse.c 1.55 97/05/14 13:23:19
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
 /*
- * The following table assigns a type to each character.  Only types
- * meaningful to Tcl parsing are represented here.  The table is
- * designed to be referenced with either signed or unsigned characters,
- * so it has 384 entries.  The first 128 entries correspond to negative
- * character values, the next 256 correspond to positive character
- * values.  The last 128 entries are identical to the first 128.  The
- * table is always indexed with a 128-byte offset (the 128th entry
- * corresponds to a 0 character value).
- */
-
-char tclTypeTable[] = {
-    /*
-     * Negative character values, from -128 to -1:
-     */
-
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-
-    /*
-     * Positive character values, from 0-127:
-     */
-
-    TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
-    TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
-    TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
-    TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
-    TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
-
-    /*
-     * Large unsigned character values, from 128-255:
-     */
-
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
-};
-
-/*
  * Function prototypes for procedures local to this file:
  */
 
-static char *	QuoteEnd _ANSI_ARGS_((char *string, int term));
-static char *	ScriptEnd _ANSI_ARGS_((char *p, int nested));
-static char *	VarNameEnd _ANSI_ARGS_((char *string));
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Backslash --
- *
- *	Figure out how to handle a backslash sequence.
- *
- * Results:
- *	The return value is the character that should be substituted
- *	in place of the backslash sequence that starts at src.  If
- *	readPtr isn't NULL then it is filled in with a count of the
- *	number of characters in the backslash sequence.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-char
-Tcl_Backslash(src, readPtr)
-    char *src;			/* Points to the backslash character of
-				 * a backslash sequence. */
-    int *readPtr;		/* Fill in with number of characters read
-				 * from src, unless NULL. */
-{
-    register char *p = src+1;
-    char result;
-    int count;
-
-    count = 2;
-
-    switch (*p) {
-	case 'a':
-	    result = 0x7;	/* Don't say '\a' here, since some compilers */
-	    break;		/* don't support it. */
-	case 'b':
-	    result = '\b';
-	    break;
-	case 'f':
-	    result = '\f';
-	    break;
-	case 'n':
-	    result = '\n';
-	    break;
-	case 'r':
-	    result = '\r';
-	    break;
-	case 't':
-	    result = '\t';
-	    break;
-	case 'v':
-	    result = '\v';
-	    break;
-	case 'x':
-	    if (isxdigit(UCHAR(p[1]))) {
-		char *end;
-
-		result = (char) strtoul(p+1, &end, 16);
-		count = end - src;
-	    } else {
-		count = 2;
-		result = 'x';
-	    }
-	    break;
-	case '\n':
-	    do {
-		p++;
-	    } while ((*p == ' ') || (*p == '\t'));
-	    result = ' ';
-	    count = p - src;
-	    break;
-	case 0:
-	    result = '\\';
-	    count = 1;
-	    break;
-	default:
-	    if (isdigit(UCHAR(*p))) {
-		result = (char)(*p - '0');
-		p++;
-		if (!isdigit(UCHAR(*p))) {
-		    break;
-		}
-		count = 3;
-		result = (char)((result << 3) + (*p - '0'));
-		p++;
-		if (!isdigit(UCHAR(*p))) {
-		    break;
-		}
-		count = 4;
-		result = (char)((result << 3) + (*p - '0'));
-		break;
-	    }
-	    result = *p;
-	    count = 2;
-	    break;
-    }
-
-    if (readPtr != NULL) {
-	*readPtr = count;
-    }
-    return result;
-}
+static char *	QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
+		    int term));
+static char *	ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
+		    int nested));
+static char *	VarNameEnd _ANSI_ARGS_((char *string,  char *lastChar));
 
 /*
  *--------------------------------------------------------------
@@ -299,6 +73,7 @@ TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
 				 * fully-substituted result of parse. */
 {
     register char *src, *dst, c;
+    char *lastChar = string + strlen(string);
 
     src = string;
     dst = pvPtr->next;
@@ -321,7 +96,7 @@ TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
 	    pvPtr->next = dst;
 	    *termPtr = src;
 	    return TCL_OK;
-	} else if (CHAR_TYPE(c) == TCL_NORMAL) {
+	} else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
 	    copy:
 	    *dst = c;
 	    dst++;
@@ -364,8 +139,11 @@ TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
 	    src += numRead;
 	    continue;
 	} else if (c == '\0') {
+	    char buf[30];
+	    
 	    Tcl_ResetResult(interp);
-	    sprintf(interp->result, "missing %c", termChar);
+	    sprintf(buf, "missing %c", termChar);
+	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
 	    *termPtr = string-1;
 	    return TCL_ERROR;
 	} else {
@@ -418,7 +196,7 @@ TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
 
     iPtr->evalFlags = flags | TCL_BRACKET_TERM;
     result = Tcl_Eval(interp, string);
-    *termPtr = iPtr->termPtr;
+    *termPtr = (string + iPtr->termOffset);
     if (result != TCL_OK) {
 	/*
 	 * The increment below results in slightly cleaner message in
@@ -438,7 +216,8 @@ TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
     }
     strcpy(pvPtr->next, iPtr->result);
     pvPtr->next += length;
-    Tcl_FreeResult(iPtr);
+    
+    Tcl_FreeResult(interp);
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = '\0';
     return TCL_OK;
@@ -483,6 +262,7 @@ TclParseBraces(interp, string, termPtr, pvPtr)
     int level;
     register char *src, *dst, *end;
     register char c;
+    char *lastChar = string + strlen(string);
 
     src = string;
     dst = pvPtr->next;
@@ -505,7 +285,7 @@ TclParseBraces(interp, string, termPtr, pvPtr)
 	}
 	*dst = c;
 	dst++;
-	if (CHAR_TYPE(c) == TCL_NORMAL) {
+	if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
 	    continue;
 	} else if (c == '{') {
 	    level++;
@@ -558,281 +338,6 @@ TclParseBraces(interp, string, termPtr, pvPtr)
 /*
  *--------------------------------------------------------------
  *
- * TclParseWords --
- *
- *	This procedure parses one or more words from a command
- *	string and creates argv-style pointers to fully-substituted
- *	copies of those words.
- *
- * Results:
- *	The return value is a standard Tcl result.
- *	
- *	*argcPtr is modified to hold a count of the number of words
- *	successfully parsed, which may be 0.  At most maxWords words
- *	will be parsed.  If 0 <= *argcPtr < maxWords then it
- *	means that a command separator was seen.  If *argcPtr
- *	is maxWords then it means that a command separator was
- *	not seen yet.
- *
- *	*TermPtr is filled in with the address of the character
- *	just after the last one successfully processed in the
- *	last word.  This is either the command terminator (if
- *	*argcPtr < maxWords), the character just after the last
- *	one in a word (if *argcPtr is maxWords), or the vicinity
- *	of an error (if the result is not TCL_OK).
- *	
- *	The pointers at *argv are filled in with pointers to the
- *	fully-substituted words, and the actual contents of the
- *	words are copied to the buffer at pvPtr.
- *
- *	If an error occurrs then an error message is left in
- *	interp->result and the information at *argv, *argcPtr,
- *	and *pvPtr may be incomplete.
- *
- * Side effects:
- *	The buffer space in pvPtr may be enlarged by calling its
- *	expandProc.
- *
- *--------------------------------------------------------------
- */
-
-int
-TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for nested command
-				 * evaluations and error messages. */
-    char *string;		/* First character of word. */
-    int flags;			/* Flags to control parsing (same values as
-				 * passed to Tcl_Eval). */
-    int maxWords;		/* Maximum number of words to parse. */
-    char **termPtr;		/* Store address of terminating character
-				 * here. */
-    int *argcPtr;		/* Filled in with actual number of words
-				 * parsed. */
-    char **argv;		/* Store addresses of individual words here. */
-    register ParseValue *pvPtr;	/* Information about where to place
-				 * fully-substituted word. */
-{
-    register char *src, *dst;
-    register char c;
-    int type, result, argc;
-    char *oldBuffer;		/* Used to detect when pvPtr's buffer gets
-				 * reallocated, so we can adjust all of the
-				 * argv pointers. */
-
-    src = string;
-    oldBuffer = pvPtr->buffer;
-    dst = pvPtr->next;
-    for (argc = 0; argc < maxWords; argc++) {
-	argv[argc] = dst;
-
-	/*
-	 * Skip leading space.
-	 */
-    
-	skipSpace:
-	c = *src;
-	type = CHAR_TYPE(c);
-	while (type == TCL_SPACE) {
-	    src++;
-	    c = *src;
-	    type = CHAR_TYPE(c);
-	}
-    
-	/*
-	 * Handle the normal case (i.e. no leading double-quote or brace).
-	 */
-
-	if (type == TCL_NORMAL) {
-	    normalArg:
-	    while (1) {
-		if (dst == pvPtr->end) {
-		    /*
-		     * Target buffer space is about to run out.  Make
-		     * more space.
-		     */
-	
-		    pvPtr->next = dst;
-		    (*pvPtr->expandProc)(pvPtr, 1);
-		    dst = pvPtr->next;
-		}
-	
-		if (type == TCL_NORMAL) {
-		    copy:
-		    *dst = c;
-		    dst++;
-		    src++;
-		} else if (type == TCL_SPACE) {
-		    goto wordEnd;
-		} else if (type == TCL_DOLLAR) {
-		    int length;
-		    char *value;
-	
-		    value = Tcl_ParseVar(interp, src, termPtr);
-		    if (value == NULL) {
-			return TCL_ERROR;
-		    }
-		    src = *termPtr;
-		    length = strlen(value);
-		    if ((pvPtr->end - dst) <= length) {
-			pvPtr->next = dst;
-			(*pvPtr->expandProc)(pvPtr, length);
-			dst = pvPtr->next;
-		    }
-		    strcpy(dst, value);
-		    dst += length;
-		} else if (type == TCL_COMMAND_END) {
-		    if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
-			goto copy;
-		    }
-
-		    /*
-		     * End of command;  simulate a word-end first, so
-		     * that the end-of-command can be processed as the
-		     * first thing in a new word.
-		     */
-
-		    goto wordEnd;
-		} else if (type == TCL_OPEN_BRACKET) {
-		    pvPtr->next = dst;
-		    result = TclParseNestedCmd(interp, src+1, flags, termPtr,
-			    pvPtr);
-		    if (result != TCL_OK) {
-			return result;
-		    }
-		    src = *termPtr;
-		    dst = pvPtr->next;
-		} else if (type == TCL_BACKSLASH) {
-		    int numRead;
-    
-		    *dst = Tcl_Backslash(src, &numRead);
-
-		    /*
-		     * The following special check allows a backslash-newline
-		     * to be treated as a word-separator, as if the backslash
-		     * and newline had been collapsed before command parsing
-		     * began.
-		     */
-
-		    if (src[1] == '\n') {
-			src += numRead;
-			goto wordEnd;
-		    }
-		    src += numRead;
-		    dst++;
-		} else {
-		    goto copy;
-		}
-		c = *src;
-		type = CHAR_TYPE(c);
-	    }
-	} else {
-    
-	    /*
-	     * Check for the end of the command.
-	     */
-	
-	    if (type == TCL_COMMAND_END) {
-		if (flags & TCL_BRACKET_TERM) {
-		    if (c == '\0') {
-			Tcl_SetResult(interp, "missing close-bracket",
-				TCL_STATIC);
-			return TCL_ERROR;
-		    }
-		} else {
-		    if (c == ']') {
-			goto normalArg;
-		    }
-		}
-		goto done;
-	    }
-	
-	    /*
-	     * Now handle the special cases: open braces, double-quotes,
-	     * and backslash-newline.
-	     */
-
-	    pvPtr->next = dst;
-	    if (type == TCL_QUOTE) {
-		result = TclParseQuotes(interp, src+1, '"', flags,
-			termPtr, pvPtr);
-	    } else if (type == TCL_OPEN_BRACE) {
-		result = TclParseBraces(interp, src+1, termPtr, pvPtr);
-	    } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
-		/*
-		 * This code is needed so that a backslash-newline at the
-		 * very beginning of a word is treated as part of the white
-		 * space between words and not as a space within the word.
-		 */
-
-		src += 2;
-		goto skipSpace;
-	    } else {
-		goto normalArg;
-	    }
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	
-	    /*
-	     * Back from quotes or braces;  make sure that the terminating
-	     * character was the end of the word.
-	     */
-	
-	    c = **termPtr;
-	    if ((c == '\\') && ((*termPtr)[1] == '\n')) {
-		/*
-		 * Line is continued on next line;  the backslash-newline
-		 * sequence turns into space, which is OK.  No need to do
-		 * anything here.
-		 */
-	    } else {
-		type = CHAR_TYPE(c);
-		if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
-		    if (*src == '"') {
-			Tcl_SetResult(interp,
-				"extra characters after close-quote",
-				TCL_STATIC);
-		    } else {
-			Tcl_SetResult(interp,
-				"extra characters after close-brace",
-				TCL_STATIC);
-		    }
-		    return TCL_ERROR;
-		}
-	    }
-	    src = *termPtr;
-	    dst = pvPtr->next;
-	}
-
-	/*
-	 * We're at the end of a word, so add a null terminator.  Then
-	 * see if the buffer was re-allocated during this word.  If so,
-	 * update all of the argv pointers.
-	 */
-
-	wordEnd:
-	*dst = '\0';
-	dst++;
-	if (oldBuffer != pvPtr->buffer) {
-	    int i;
-
-	    for (i = 0; i <= argc; i++) {
-		argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
-	    }
-	    oldBuffer = pvPtr->buffer;
-	}
-    }
-
-    done:
-    pvPtr->next = dst;
-    *termPtr = src;
-    *argcPtr = argc;
-    return TCL_OK;
-}
-
-/*
- *--------------------------------------------------------------
- *
  * TclExpandParseValue --
  *
  *	This procedure is commonly used as the value of the
@@ -914,8 +419,9 @@ TclExpandParseValue(pvPtr, needed)
  */
 
 char *
-TclWordEnd(start, nested, semiPtr)
+TclWordEnd(start, lastChar, nested, semiPtr)
     char *start;		/* Beginning of a word of a Tcl command. */
+    char *lastChar;		/* Terminating character in string. */
     int nested;			/* Zero means this is a top-level command.
 				 * One means this is a nested command (close
 				 * bracket is a word terminator). */
@@ -941,7 +447,7 @@ TclWordEnd(start, nested, semiPtr)
 	    continue;
 	}
 	if ((p[0] == '\\') && (p[1] == '\n')) {
-	    if (p[2] == 0) {
+	    if (p+2 == lastChar) {
 		return p+2;
 	    }
 	    continue;
@@ -954,8 +460,8 @@ TclWordEnd(start, nested, semiPtr)
      */
 
     if (*p == '"') {
-	p = QuoteEnd(p+1, '"');
-	if (*p == 0) {
+	p = QuoteEnd(p+1, lastChar, '"');
+	if (p == lastChar) {
 	    return p;
 	}
 	p++;
@@ -971,7 +477,7 @@ TclWordEnd(start, nested, semiPtr)
 		braces--;
 	    } else if (*p == '{') {
 		braces++;
-	    } else if (*p == 0) {
+	    } else if (p == lastChar) {
 		return p;
 	    }
 	}
@@ -988,8 +494,8 @@ TclWordEnd(start, nested, semiPtr)
 
     while (1) {
 	if (*p == '[') {
-	    p = ScriptEnd(p+1, 1);
-	    if (*p == 0) {
+	    p = ScriptEnd(p+1, lastChar, 1);
+	    if (p == lastChar) {
 		return p;
 	    }
 	    p++;
@@ -1006,8 +512,8 @@ TclWordEnd(start, nested, semiPtr)
 	    (void) Tcl_Backslash(p, &count);
 	    p += count;
 	} else if (*p == '$') {
-	    p = VarNameEnd(p);
-	    if (*p == 0) {
+	    p = VarNameEnd(p, lastChar);
+	    if (p == lastChar) {
 		return p;
 	    }
 	    p++;
@@ -1024,7 +530,7 @@ TclWordEnd(start, nested, semiPtr)
 	    return p-1;
 	} else if ((*p == ']') && nested) {
 	    return p-1;
-	} else if (*p == 0) {
+	} else if (p == lastChar) {
 	    if (nested) {
 		/*
 		 * Nested commands can't end because of the end of the
@@ -1063,9 +569,10 @@ TclWordEnd(start, nested, semiPtr)
  */
 
 static char *
-QuoteEnd(string, term)
+QuoteEnd(string, lastChar, term)
     char *string;		/* Pointer to character just after opening
 				 * "quote". */
+    char *lastChar;		/* Terminating character in string. */
     int term;			/* This character will terminate the
 				 * quoted string (e.g. '"' or ')'). */
 {
@@ -1078,19 +585,19 @@ QuoteEnd(string, term)
 	    p += count;
 	} else if (*p == '[') {
 	    for (p++; *p != ']'; p++) {
-		p = TclWordEnd(p, 1, (int *) NULL);
+		p = TclWordEnd(p, lastChar, 1, (int *) NULL);
 		if (*p == 0) {
 		    return p;
 		}
 	    }
 	    p++;
 	} else if (*p == '$') {
-	    p = VarNameEnd(p);
+	    p = VarNameEnd(p, lastChar);
 	    if (*p == 0) {
 		return p;
 	    }
 	    p++;
-	} else if (*p == 0) {
+	} else if (p == lastChar) {
 	    return p;
 	} else {
 	    p++;
@@ -1120,13 +627,14 @@ QuoteEnd(string, term)
  */
 
 static char *
-VarNameEnd(string)
+VarNameEnd(string, lastChar)
     char *string;		/* Pointer to dollar-sign character. */
+    char *lastChar;		/* Terminating character in string. */
 {
     register char *p = string+1;
 
     if (*p == '{') {
-	for (p++; (*p != '}') && (*p != 0); p++) {
+	for (p++; (*p != '}') && (p != lastChar); p++) {
 	    /* Empty loop body. */
 	}
 	return p;
@@ -1135,7 +643,7 @@ VarNameEnd(string)
 	p++;
     }
     if ((*p == '(') && (p != string+1)) {
-	return QuoteEnd(p+1, ')');
+	return QuoteEnd(p+1, lastChar, ')');
     }
     return p-1;
 }
@@ -1162,8 +670,9 @@ VarNameEnd(string)
  */
 
 static char *
-ScriptEnd(p, nested)
+ScriptEnd(p, lastChar, nested)
     char *p;			/* Script to check. */
+    char *lastChar;		/* Terminating character in string. */
     int nested;			/* Zero means this is a top-level command.
 				 * One means this is a nested command (the
 				 * last character of the script must be
@@ -1187,7 +696,7 @@ ScriptEnd(p, nested)
 		     * this command isn't complete.
 		     */
 
-		    if ((p[1] == '\n') && (p[2] == 0)) {
+		    if ((p[1] == '\n') && (p+2 == lastChar)) {
 			return p+2;
 		    }
 		    Tcl_Backslash(p, &length);
@@ -1195,11 +704,11 @@ ScriptEnd(p, nested)
 		} else {
 		    p++;
 		}
-	    } while ((*p != 0) && (*p != '\n'));
+	    } while ((p != lastChar) && (*p != '\n'));
 	    continue;
 	}
-	p = TclWordEnd(p, nested, &commentOK);
-	if (*p == 0) {
+	p = TclWordEnd(p, lastChar, nested, &commentOK);
+	if (p == lastChar) {
 	    return p;
 	}
 	p++;
@@ -1208,7 +717,7 @@ ScriptEnd(p, nested)
 		return p;
 	    }
 	} else {
-	    if (*p == 0) {
+	    if (p == lastChar) {
 		return p-1;
 	    }
 	}
@@ -1260,13 +769,13 @@ Tcl_ParseVar(interp, string, termPtr)
      *    variable is a scalar variable.
      * 2. The $ sign is not followed by an open curly brace.  Then the
      *    variable name is everything up to the next character that isn't
-     *    a letter, digit, or underscore.  If the following character is an
-     *    open parenthesis, then the information between parentheses is
-     *    the array element name, which can include any of the substitutions
-     *    permissible between quotes.
+     *    a letter, digit, or underscore, or a "::" namespace separator.
+     *    If the following character is an open parenthesis, then the
+     *    information between parentheses is the array element name, which
+     *    can include any of the substitutions permissible between quotes.
      * 3. The $ sign is followed by something that isn't a letter, digit,
-     *    or underscore:  in this case, there is no variable name, and "$"
-     *    is returned.
+     *    underscore, or a "::" namespace separator: in this case,
+     *    there is no variable name, and "$" is returned.
      */
 
     name2 = NULL;
@@ -1289,8 +798,20 @@ Tcl_ParseVar(interp, string, termPtr)
 	string++;
     } else {
 	name1 = string;
-	while (isalnum(UCHAR(*string)) || (*string == '_')) {
-	    string++;
+	while (isalnum(UCHAR(*string)) || (*string == '_')
+	        || (*string == ':')) {
+	    if (*string == ':') {
+		if (*(string+1) == ':') {
+                    string += 2;  /* skip over the initial :: */
+		    while (*string == ':') {
+			string++; /* skip over a subsequent : */
+		    }
+		} else {
+		    break;	  /* : by itself */
+                }
+	    } else {
+		string++;
+	    }
 	}
 	if (string == name1) {
 	    if (termPtr != 0) {
@@ -1339,9 +860,6 @@ Tcl_ParseVar(interp, string, termPtr)
 	*termPtr = string;
     }
 
-    if (((Interp *) interp)->noEval) {
-	return "";
-    }
     c = *name1End;
     *name1End = 0;
     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
@@ -1381,6 +899,6 @@ Tcl_CommandComplete(cmd)
     if (*cmd == 0) {
 	return 1;
     }
-    p = ScriptEnd(cmd, 0);
+    p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
     return (*p != 0);
 }
diff --git a/contrib/tcl/generic/tclPipe.c b/contrib/tcl/generic/tclPipe.c
new file mode 100644
index 0000000..bf606cc
--- /dev/null
+++ b/contrib/tcl/generic/tclPipe.c
@@ -0,0 +1,1051 @@
+/* 
+ * tclPipe.c --
+ *
+ *	This file contains the generic portion of the command channel
+ *	driver as well as various utility routines used in managing
+ *	subprocesses.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclPipe.c 1.8 97/06/20 13:26:45
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * A linked list of the following structures is used to keep track
+ * of child processes that have been detached but haven't exited
+ * yet, so we can make sure that they're properly "reaped" (officially
+ * waited for) and don't lie around as zombies cluttering the
+ * system.
+ */
+
+typedef struct Detached {
+    Tcl_Pid pid;			/* Id of process that's been detached
+					 * but isn't known to have exited. */
+    struct Detached *nextPtr;		/* Next in list of all detached
+					 * processes. */
+} Detached;
+
+static Detached *detList = NULL;	/* List of all detached proceses. */
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static TclFile	FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
+	            char *spec, int atOk, char *arg, char *nextArg, 
+		    int flags, int *skipPtr, int *closePtr, int *releasePtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileForRedirect --
+ *
+ *	This procedure does much of the work of parsing redirection
+ *	operators.  It handles "@" if specified and allowed, and a file
+ *	name, and opens the file if necessary.
+ *
+ * Results:
+ *	The return value is the descriptor number for the file.  If an
+ *	error occurs then NULL is returned and an error message is left
+ *	in interp->result.  Several arguments are side-effected; see
+ *	the argument list below for details.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TclFile
+FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
+	releasePtr)
+    Tcl_Interp *interp;		/* Intepreter to use for error reporting. */
+    char *spec;			/* Points to character just after
+				 * redirection character. */
+    char *arg;			/* Pointer to entire argument containing 
+				 * spec:  used for error reporting. */
+    int atOK;			/* Non-zero means that '@' notation can be 
+				 * used to specify a channel, zero means that
+				 * it isn't. */
+    char *nextArg;		/* Next argument in argc/argv array, if needed 
+				 * for file name or channel name.  May be 
+				 * NULL. */
+    int flags;			/* Flags to use for opening file or to 
+				 * specify mode for channel. */
+    int *skipPtr;		/* Filled with 1 if redirection target was
+				 * in spec, 2 if it was in nextArg. */
+    int *closePtr;		/* Filled with one if the caller should 
+				 * close the file when done with it, zero
+				 * otherwise. */
+    int *releasePtr;
+{
+    int writing = (flags & O_WRONLY);
+    Tcl_Channel chan;
+    TclFile file;
+
+    *skipPtr = 1;
+    if ((atOK != 0)  && (*spec == '@')) {
+	spec++;
+	if (*spec == '\0') {
+	    spec = nextArg;
+	    if (spec == NULL) {
+		goto badLastArg;
+	    }
+	    *skipPtr = 2;
+	}
+        chan = Tcl_GetChannel(interp, spec, NULL);
+        if (chan == (Tcl_Channel) NULL) {
+            return NULL;
+        }
+	file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
+        if (file == NULL) {
+            Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
+                    "\" wasn't opened for ",
+                    ((writing) ? "writing" : "reading"), (char *) NULL);
+            return NULL;
+        }
+	*releasePtr = 1;
+	if (writing) {
+
+	    /*
+	     * Be sure to flush output to the file, so that anything
+	     * written by the child appears after stuff we've already
+	     * written.
+	     */
+
+            Tcl_Flush(chan);
+	}
+    } else {
+	char *name;
+	Tcl_DString nameString;
+
+	if (*spec == '\0') {
+	    spec = nextArg;
+	    if (spec == NULL) {
+		goto badLastArg;
+	    }
+	    *skipPtr = 2;
+	}
+	name = Tcl_TranslateFileName(interp, spec, &nameString);
+	if (name != NULL) {
+	    file = TclpOpenFile(name, flags);
+	} else {
+	    file = NULL;
+	}
+	Tcl_DStringFree(&nameString);
+	if (file == NULL) {
+	    Tcl_AppendResult(interp, "couldn't ",
+		    ((writing) ? "write" : "read"), " file \"", spec, "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+	    return NULL;
+	}
+        *closePtr = 1;
+    }
+    return file;
+
+    badLastArg:
+    Tcl_AppendResult(interp, "can't specify \"", arg,
+	    "\" as last word in command", (char *) NULL);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DetachPids --
+ *
+ *	This procedure is called to indicate that one or more child
+ *	processes have been placed in background and will never be
+ *	waited for;  they should eventually be reaped by
+ *	Tcl_ReapDetachedProcs.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DetachPids(numPids, pidPtr)
+    int numPids;		/* Number of pids to detach:  gives size
+				 * of array pointed to by pidPtr. */
+    Tcl_Pid *pidPtr;		/* Array of pids to detach. */
+{
+    register Detached *detPtr;
+    int i;
+
+    for (i = 0; i < numPids; i++) {
+	detPtr = (Detached *) ckalloc(sizeof(Detached));
+	detPtr->pid = pidPtr[i];
+	detPtr->nextPtr = detList;
+	detList = detPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ReapDetachedProcs --
+ *
+ *	This procedure checks to see if any detached processes have
+ *	exited and, if so, it "reaps" them by officially waiting on
+ *	them.  It should be called "occasionally" to make sure that
+ *	all detached processes are eventually reaped.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Processes are waited on, so that they can be reaped by the
+ *	system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ReapDetachedProcs()
+{
+    register Detached *detPtr;
+    Detached *nextPtr, *prevPtr;
+    int status;
+    Tcl_Pid pid;
+
+    for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
+	pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
+	if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
+	    prevPtr = detPtr;
+	    detPtr = detPtr->nextPtr;
+	    continue;
+	}
+	nextPtr = detPtr->nextPtr;
+	if (prevPtr == NULL) {
+	    detList = detPtr->nextPtr;
+	} else {
+	    prevPtr->nextPtr = detPtr->nextPtr;
+	}
+	ckfree((char *) detPtr);
+	detPtr = nextPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupChildren --
+ *
+ *	This is a utility procedure used to wait for child processes
+ *	to exit, record information about abnormal exits, and then
+ *	collect any stderr output generated by them.
+ *
+ * Results:
+ *	The return value is a standard Tcl result.  If anything at
+ *	weird happened with the child processes, TCL_ERROR is returned
+ *	and a message is left in interp->result.
+ *
+ * Side effects:
+ *	If the last character of interp->result is a newline, then it
+ *	is removed unless keepNewline is non-zero.  File errorId gets
+ *	closed, and pidPtr is freed back to the storage allocator.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCleanupChildren(interp, numPids, pidPtr, errorChan)
+    Tcl_Interp *interp;		/* Used for error messages. */
+    int numPids;		/* Number of entries in pidPtr array. */
+    Tcl_Pid *pidPtr;		/* Array of process ids of children. */
+    Tcl_Channel errorChan;	/* Channel for file containing stderr output
+				 * from pipeline.  NULL means there isn't any
+				 * stderr output. */
+{
+    int result = TCL_OK;
+    int i, abnormalExit, anyErrorInfo;
+    Tcl_Pid pid;
+    WAIT_STATUS_TYPE waitStatus;
+    char *msg;
+
+    abnormalExit = 0;
+    for (i = 0; i < numPids; i++) {
+        pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
+	if (pid == (Tcl_Pid) -1) {
+	    result = TCL_ERROR;
+            if (interp != (Tcl_Interp *) NULL) {
+                msg = Tcl_PosixError(interp);
+                if (errno == ECHILD) {
+		    /*
+                     * This changeup in message suggested by Mark Diekhans
+                     * to remind people that ECHILD errors can occur on
+                     * some systems if SIGCHLD isn't in its default state.
+                     */
+
+                    msg =
+                        "child process lost (is SIGCHLD ignored or trapped?)";
+                }
+                Tcl_AppendResult(interp, "error waiting for process to exit: ",
+                        msg, (char *) NULL);
+            }
+	    continue;
+	}
+
+	/*
+	 * Create error messages for unusual process exits.  An
+	 * extra newline gets appended to each error message, but
+	 * it gets removed below (in the same fashion that an
+	 * extra newline in the command's output is removed).
+	 */
+
+	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
+	    char msg1[20], msg2[20];
+
+	    result = TCL_ERROR;
+	    sprintf(msg1, "%ld", TclpGetPid(pid));
+	    if (WIFEXITED(waitStatus)) {
+                if (interp != (Tcl_Interp *) NULL) {
+                    sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
+                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
+                            (char *) NULL);
+                }
+		abnormalExit = 1;
+	    } else if (WIFSIGNALED(waitStatus)) {
+                if (interp != (Tcl_Interp *) NULL) {
+                    char *p;
+                    
+                    p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
+                    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
+                            Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
+                            (char *) NULL);
+                    Tcl_AppendResult(interp, "child killed: ", p, "\n",
+                            (char *) NULL);
+                }
+	    } else if (WIFSTOPPED(waitStatus)) {
+                if (interp != (Tcl_Interp *) NULL) {
+                    char *p;
+
+                    p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
+                    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
+                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
+                            p, (char *) NULL);
+                    Tcl_AppendResult(interp, "child suspended: ", p, "\n",
+                            (char *) NULL);
+                }
+	    } else {
+                if (interp != (Tcl_Interp *) NULL) {
+                    Tcl_AppendResult(interp,
+                            "child wait status didn't make sense\n",
+                            (char *) NULL);
+                }
+	    }
+	}
+    }
+
+    /*
+     * Read the standard error file.  If there's anything there,
+     * then return an error and add the file's contents to the result
+     * string.
+     */
+
+    anyErrorInfo = 0;
+    if (errorChan != NULL) {
+
+	/*
+	 * Make sure we start at the beginning of the file.
+	 */
+
+	Tcl_Seek(errorChan, 0L, SEEK_SET);
+
+        if (interp != (Tcl_Interp *) NULL) {
+            while (1) {
+#define BUFFER_SIZE 1000
+                char buffer[BUFFER_SIZE+1];
+                int count;
+    
+                count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
+                if (count == 0) {
+                    break;
+                }
+                result = TCL_ERROR;
+                if (count < 0) {
+                    Tcl_AppendResult(interp,
+                            "error reading stderr output file: ",
+                            Tcl_PosixError(interp), (char *) NULL);
+                    break;	/* out of the "while (1)" loop. */
+                }
+                buffer[count] = 0;
+                Tcl_AppendResult(interp, buffer, (char *) NULL);
+                anyErrorInfo = 1;
+            }
+        }
+        
+	Tcl_Close((Tcl_Interp *) NULL, errorChan);
+    }
+
+    /*
+     * If a child exited abnormally but didn't output any error information
+     * at all, generate an error message here.
+     */
+
+    if (abnormalExit && !anyErrorInfo && (interp != (Tcl_Interp *) NULL)) {
+	Tcl_AppendResult(interp, "child process exited abnormally",
+		(char *) NULL);
+    }
+    
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreatePipeline --
+ *
+ *	Given an argc/argv array, instantiate a pipeline of processes
+ *	as described by the argv.
+ *
+ *	This procedure is unofficially exported for use by BLT.
+ *
+ * Results:
+ *	The return value is a count of the number of new processes
+ *	created, or -1 if an error occurred while creating the pipeline.
+ *	*pidArrayPtr is filled in with the address of a dynamically
+ *	allocated array giving the ids of all of the processes.  It
+ *	is up to the caller to free this array when it isn't needed
+ *	anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
+ *	with the file id for the input pipe for the pipeline (if any):
+ *	the caller must eventually close this file.  If outPipePtr
+ *	isn't NULL, then *outPipePtr is filled in with the file id
+ *	for the output pipe from the pipeline:  the caller must close
+ *	this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
+ *	with a file id that may be used to read error output after the
+ *	pipeline completes.
+ *
+ * Side effects:
+ *	Processes and pipes are created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
+	outPipePtr, errFilePtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
+    int argc;			/* Number of entries in argv. */
+    char **argv;		/* Array of strings describing commands in
+				 * pipeline plus I/O redirection with <,
+				 * <<,  >, etc.  Argv[argc] must be NULL. */
+    Tcl_Pid **pidArrayPtr;	/* Word at *pidArrayPtr gets filled in with
+				 * address of array of pids for processes
+				 * in pipeline (first pid is first process
+				 * in pipeline). */
+    TclFile *inPipePtr;		/* If non-NULL, input to the pipeline comes
+				 * from a pipe (unless overridden by
+				 * redirection in the command).  The file
+				 * id with which to write to this pipe is
+				 * stored at *inPipePtr.  NULL means command
+				 * specified its own input source. */
+    TclFile *outPipePtr;	/* If non-NULL, output to the pipeline goes
+				 * to a pipe, unless overriden by redirection
+				 * in the command.  The file id with which to
+				 * read frome this pipe is stored at
+				 * *outPipePtr.  NULL means command specified
+				 * its own output sink. */
+    TclFile *errFilePtr;	/* If non-NULL, all stderr output from the
+				 * pipeline will go to a temporary file
+				 * created here, and a descriptor to read
+				 * the file will be left at *errFilePtr.
+				 * The file will be removed already, so
+				 * closing this descriptor will be the end
+				 * of the file.  If this is NULL, then
+				 * all stderr output goes to our stderr.
+				 * If the pipeline specifies redirection
+				 * then the file will still be created
+				 * but it will never get any data. */
+{
+    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all
+				 * the pids of child processes. */
+    int numPids;		/* Actual number of processes that exist
+				 * at *pidPtr right now. */
+    int cmdCount;		/* Count of number of distinct commands
+				 * found in argc/argv. */
+    char *inputLiteral = NULL;	/* If non-null, then this points to a
+				 * string containing input data (specified
+				 * via <<) to be piped to the first process
+				 * in the pipeline. */
+    TclFile inputFile = NULL;	/* If != NULL, gives file to use as input for
+				 * first process in pipeline (specified via <
+				 * or <@). */
+    int inputClose = 0;		/* If non-zero, then inputFile should be 
+    				 * closed when cleaning up. */
+    int inputRelease = 0;
+    TclFile outputFile = NULL;	/* Writable file for output from last command
+				 * in pipeline (could be file or pipe).  NULL
+				 * means use stdout. */
+    int outputClose = 0;	/* If non-zero, then outputFile should be 
+    				 * closed when cleaning up. */
+    int outputRelease = 0;
+    TclFile errorFile = NULL;	/* Writable file for error output from all
+				 * commands in pipeline.  NULL means use
+				 * stderr. */
+    int errorClose = 0;		/* If non-zero, then errorFile should be 
+    				 * closed when cleaning up. */
+    int errorRelease = 0;
+    char *p;
+    int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
+    Tcl_DString execBuffer;
+    TclFile pipeIn;
+    TclFile curInFile, curOutFile, curErrFile;
+    Tcl_Channel channel;
+
+    if (inPipePtr != NULL) {
+	*inPipePtr = NULL;
+    }
+    if (outPipePtr != NULL) {
+	*outPipePtr = NULL;
+    }
+    if (errFilePtr != NULL) {
+	*errFilePtr = NULL;
+    }
+
+    Tcl_DStringInit(&execBuffer);
+    
+    pipeIn = NULL;
+    curInFile = NULL;
+    curOutFile = NULL;
+    numPids = 0;
+
+    /*
+     * First, scan through all the arguments to figure out the structure
+     * of the pipeline.  Process all of the input and output redirection
+     * arguments and remove them from the argument list in the pipeline.
+     * Count the number of distinct processes (it's the number of "|"
+     * arguments plus one) but don't remove the "|" arguments because 
+     * they'll be used in the second pass to seperate the individual 
+     * child processes.  Cannot start the child processes in this pass 
+     * because the redirection symbols may appear anywhere in the 
+     * command line -- e.g., the '<' that specifies the input to the 
+     * entire pipe may appear at the very end of the argument list.
+     */
+
+    lastBar = -1;
+    cmdCount = 1;
+    for (i = 0; i < argc; i++) {
+        skip = 0;
+	p = argv[i];
+	switch (*p++) {
+	case '|':
+	    if (*p == '&') {
+		p++;
+	    }
+	    if (*p == '\0') {
+		if ((i == (lastBar + 1)) || (i == (argc - 1))) {
+		    Tcl_SetResult(interp,
+			    "illegal use of | or |& in command",
+			    TCL_STATIC);
+		    goto error;
+		}
+	    }
+	    lastBar = i;
+	    cmdCount++;
+	    break;
+
+	case '<':
+	    if (inputClose != 0) {
+		inputClose = 0;
+		TclpCloseFile(inputFile);
+	    }
+	    if (inputRelease != 0) {
+		inputRelease = 0;
+		TclpReleaseFile(inputFile);
+	    }
+	    if (*p == '<') {
+		inputFile = NULL;
+		inputLiteral = p + 1;
+		skip = 1;
+		if (*inputLiteral == '\0') {
+		    inputLiteral = argv[i + 1];
+		    if (inputLiteral == NULL) {
+			Tcl_AppendResult(interp, "can't specify \"", argv[i],
+				"\" as last word in command", (char *) NULL);
+			goto error;
+		    }
+		    skip = 2;
+		}
+	    } else {
+		inputLiteral = NULL;
+		inputFile = FileForRedirect(interp, p, 1, argv[i], 
+			argv[i + 1], O_RDONLY, &skip, &inputClose, &inputRelease);
+		if (inputFile == NULL) {
+		    goto error;
+		}
+	    }
+	    break;
+
+	case '>':
+	    atOK = 1;
+	    flags = O_WRONLY | O_CREAT | O_TRUNC;
+	    errorToOutput = 0;
+	    if (*p == '>') {
+		p++;
+		atOK = 0;
+		flags = O_WRONLY | O_CREAT;
+	    }
+	    if (*p == '&') {
+		if (errorClose != 0) {
+		    errorClose = 0;
+		    TclpCloseFile(errorFile);
+		}
+		errorToOutput = 1;
+		p++;
+	    }
+
+	    /*
+	     * Close the old output file, but only if the error file is
+	     * not also using it.
+	     */
+
+	    if (outputClose != 0) {
+		outputClose = 0;
+		if (errorFile == outputFile) {
+		    errorClose = 1;
+		} else {
+		    TclpCloseFile(outputFile);
+		}
+	    }
+	    if (outputRelease != 0) {
+		outputRelease = 0;
+		if (errorFile == outputFile) {
+		    errorRelease = 1;
+		} else {
+		    TclpReleaseFile(outputFile);
+		}
+	    }
+	    outputFile = FileForRedirect(interp, p, atOK, argv[i], 
+		    argv[i + 1], flags, &skip, &outputClose, &outputRelease);
+	    if (outputFile == NULL) {
+		goto error;
+	    }
+	    if (errorToOutput) {
+		if (errorClose != 0) {
+		    errorClose = 0;
+		    TclpCloseFile(errorFile);
+		}
+		if (errorRelease != 0) {
+		    errorRelease = 0;
+		    TclpReleaseFile(errorFile);
+		}
+		errorFile = outputFile;
+	    }
+	    break;
+
+	case '2':
+	    if (*p != '>') {
+		break;
+	    }
+	    p++;
+	    atOK = 1;
+	    flags = O_WRONLY | O_CREAT | O_TRUNC;
+	    if (*p == '>') {
+		p++;
+		atOK = 0;
+		flags = O_WRONLY | O_CREAT;
+	    }
+	    if (errorClose != 0) {
+		errorClose = 0;
+		TclpCloseFile(errorFile);
+	    }
+	    if (errorRelease != 0) {
+		errorRelease = 0;
+		TclpReleaseFile(errorFile);
+	    }
+	    errorFile = FileForRedirect(interp, p, atOK, argv[i], 
+		    argv[i + 1], flags, &skip, &errorClose, &errorRelease);
+	    if (errorFile == NULL) {
+		goto error;
+	    }
+	    break;
+	}
+
+	if (skip != 0) {
+	    for (j = i + skip; j < argc; j++) {
+		argv[j - skip] = argv[j];
+	    }
+	    argc -= skip;
+	    i -= 1;
+	}
+    }
+
+    if (inputFile == NULL) {
+	if (inputLiteral != NULL) {
+	    /*
+	     * The input for the first process is immediate data coming from
+	     * Tcl.  Create a temporary file for it and put the data into the
+	     * file.
+	     */
+	    inputFile = TclpCreateTempFile(inputLiteral, NULL);
+	    if (inputFile == NULL) {
+		Tcl_AppendResult(interp,
+			"couldn't create input file for command: ",
+			Tcl_PosixError(interp), (char *) NULL);
+		goto error;
+	    }
+	    inputClose = 1;
+	} else if (inPipePtr != NULL) {
+	    /*
+	     * The input for the first process in the pipeline is to
+	     * come from a pipe that can be written from by the caller.
+	     */
+
+	    if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
+		Tcl_AppendResult(interp, 
+			"couldn't create input pipe for command: ",
+			Tcl_PosixError(interp), (char *) NULL);
+		goto error;
+	    }
+	    inputClose = 1;
+	} else {
+	    /*
+	     * The input for the first process comes from stdin.
+	     */
+
+	    channel = Tcl_GetStdChannel(TCL_STDIN);
+	    if (channel != NULL) {
+		inputFile = TclpMakeFile(channel, TCL_READABLE);
+		if (inputFile != NULL) {
+		    inputRelease = 1;
+		}
+	    }
+	}
+    }
+
+    if (outputFile == NULL) {
+	if (outPipePtr != NULL) {
+	    /*
+	     * Output from the last process in the pipeline is to go to a
+	     * pipe that can be read by the caller.
+	     */
+
+	    if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
+		Tcl_AppendResult(interp, 
+			"couldn't create output pipe for command: ",
+			Tcl_PosixError(interp), (char *) NULL);
+		goto error;
+	    }
+	    outputClose = 1;
+	} else {
+	    /*
+	     * The output for the last process goes to stdout.
+	     */
+
+	    channel = Tcl_GetStdChannel(TCL_STDOUT);
+	    if (channel) {
+		outputFile = TclpMakeFile(channel, TCL_WRITABLE);
+		if (outputFile != NULL) {
+		    outputRelease = 1;
+		}
+	    }
+	}
+    }
+
+    if (errorFile == NULL) {
+	if (errFilePtr != NULL) {
+	    /*
+	     * Set up the standard error output sink for the pipeline, if
+	     * requested.  Use a temporary file which is opened, then deleted.
+	     * Could potentially just use pipe, but if it filled up it could
+	     * cause the pipeline to deadlock:  we'd be waiting for processes
+	     * to complete before reading stderr, and processes couldn't 
+	     * complete because stderr was backed up.
+	     */
+
+	    errorFile = TclpCreateTempFile(NULL, NULL);
+	    if (errorFile == NULL) {
+		Tcl_AppendResult(interp,
+			"couldn't create error file for command: ",
+			Tcl_PosixError(interp), (char *) NULL);
+		goto error;
+	    }
+	    *errFilePtr = errorFile;
+	} else {
+	    /*
+	     * Errors from the pipeline go to stderr.
+	     */
+
+	    channel = Tcl_GetStdChannel(TCL_STDERR);
+	    if (channel) {
+		errorFile = TclpMakeFile(channel, TCL_WRITABLE);
+		if (errorFile != NULL) {
+		    errorRelease = 1;
+		}
+	    }
+	}
+    }
+	
+    /*
+     * Scan through the argc array, creating a process for each
+     * group of arguments between the "|" characters.
+     */
+
+    Tcl_ReapDetachedProcs();
+    pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
+
+    curInFile = inputFile;
+
+    for (i = 0; i < argc; i = lastArg + 1) { 
+	int joinThisError;
+	Tcl_Pid pid;
+
+	/*
+	 * Convert the program name into native form. 
+	 */
+
+	argv[i] = Tcl_TranslateFileName(interp, argv[i], &execBuffer);
+	if (argv[i] == NULL) {
+	    goto error;
+	}
+
+	/*
+	 * Find the end of the current segment of the pipeline.
+	 */
+
+	joinThisError = 0;
+	for (lastArg = i; lastArg < argc; lastArg++) {
+	    if (argv[lastArg][0] == '|') { 
+		if (argv[lastArg][1] == '\0') { 
+		    break;
+		}
+		if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
+		    joinThisError = 1;
+		    break;
+		}
+	    }
+	}
+	argv[lastArg] = NULL;
+
+	/*
+	 * If this is the last segment, use the specified outputFile.
+	 * Otherwise create an intermediate pipe.  pipeIn will become the
+	 * curInFile for the next segment of the pipe.
+	 */
+
+	if (lastArg == argc) { 
+	    curOutFile = outputFile;
+	} else {
+	    if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
+		Tcl_AppendResult(interp, "couldn't create pipe: ",
+			Tcl_PosixError(interp), (char *) NULL);
+		goto error;
+	    }
+	}
+
+	if (joinThisError != 0) {
+	    curErrFile = curOutFile;
+	} else {
+	    curErrFile = errorFile;
+	}
+
+	if (TclpCreateProcess(interp, lastArg - i, argv + i,
+		curInFile, curOutFile, curErrFile, &pid) != TCL_OK) {
+	    goto error;
+	}
+	Tcl_DStringFree(&execBuffer);
+
+	pidPtr[numPids] = pid;
+	numPids++;
+
+	/*
+	 * Close off our copies of file descriptors that were set up for
+	 * this child, then set up the input for the next child.
+	 */
+
+	if ((curInFile != NULL) && (curInFile != inputFile)) {
+	    TclpCloseFile(curInFile);
+	}
+	curInFile = pipeIn;
+	pipeIn = NULL;
+
+	if ((curOutFile != NULL) && (curOutFile != outputFile)) {
+	    TclpCloseFile(curOutFile);
+	}
+	curOutFile = NULL;
+    }
+
+    *pidArrayPtr = pidPtr;
+
+    /*
+     * All done.  Cleanup open files lying around and then return.
+     */
+
+cleanup:
+    Tcl_DStringFree(&execBuffer);
+
+    if (inputClose) {
+	TclpCloseFile(inputFile);
+    } else if (inputRelease) {
+	TclpReleaseFile(inputFile);
+    }
+    if (outputClose) {
+	TclpCloseFile(outputFile);
+    } else if (outputRelease) {
+	TclpReleaseFile(outputFile);
+    }
+    if (errorClose) {
+	TclpCloseFile(errorFile);
+    } else if (errorRelease) {
+	TclpReleaseFile(errorFile);
+    }
+    return numPids;
+
+    /*
+     * An error occurred.  There could have been extra files open, such
+     * as pipes between children.  Clean them all up.  Detach any child
+     * processes that have been created.
+     */
+
+error:
+    if (pipeIn != NULL) {
+	TclpCloseFile(pipeIn);
+    }
+    if ((curOutFile != NULL) && (curOutFile != outputFile)) {
+	TclpCloseFile(curOutFile);
+    }
+    if ((curInFile != NULL) && (curInFile != inputFile)) {
+	TclpCloseFile(curInFile);
+    }
+    if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
+	TclpCloseFile(*inPipePtr);
+	*inPipePtr = NULL;
+    }
+    if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
+	TclpCloseFile(*outPipePtr);
+	*outPipePtr = NULL;
+    }
+    if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
+	TclpCloseFile(*errFilePtr);
+	*errFilePtr = NULL;
+    }
+    if (pidPtr != NULL) {
+	for (i = 0; i < numPids; i++) {
+	    if (pidPtr[i] != (Tcl_Pid) -1) {
+		Tcl_DetachPids(1, &pidPtr[i]);
+	    }
+	}
+	ckfree((char *) pidPtr);
+    }
+    numPids = -1;
+    goto cleanup;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenCommandChannel --
+ *
+ *	Opens an I/O channel to one or more subprocesses specified
+ *	by argc and argv.  The flags argument determines the
+ *	disposition of the stdio handles.  If the TCL_STDIN flag is
+ *	set then the standard input for the first subprocess will
+ *	be tied to the channel:  writing to the channel will provide
+ *	input to the subprocess.  If TCL_STDIN is not set, then
+ *	standard input for the first subprocess will be the same as
+ *	this application's standard input.  If TCL_STDOUT is set then
+ *	standard output from the last subprocess can be read from the
+ *	channel;  otherwise it goes to this application's standard
+ *	output.  If TCL_STDERR is set, standard error output for all
+ *	subprocesses is returned to the channel and results in an error
+ *	when the channel is closed;  otherwise it goes to this
+ *	application's standard error.  If TCL_ENFORCE_MODE is not set,
+ *	then argc and argv can redirect the stdio handles to override
+ *	TCL_STDIN, TCL_STDOUT, and TCL_STDERR;  if it is set, then it 
+ *	is an error for argc and argv to override stdio channels for
+ *	which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
+ *
+ * Results:
+ *	A new command channel, or NULL on failure with an error
+ *	message left in interp.
+ *
+ * Side effects:
+ *	Creates processes, opens pipes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenCommandChannel(interp, argc, argv, flags)
+    Tcl_Interp *interp;		/* Interpreter for error reporting. Can
+                                 * NOT be NULL. */
+    int argc;			/* How many arguments. */
+    char **argv;		/* Array of arguments for command pipe. */
+    int flags;			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
+				 * TCL_STDERR, and TCL_ENFORCE_MODE. */
+{
+    TclFile *inPipePtr, *outPipePtr, *errFilePtr;
+    TclFile inPipe, outPipe, errFile;
+    int numPids;
+    Tcl_Pid *pidPtr;
+    Tcl_Channel channel;
+
+    inPipe = outPipe = errFile = NULL;
+
+    inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
+    outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
+    errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
+    
+    numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
+            outPipePtr, errFilePtr);
+
+    if (numPids < 0) {
+	goto error;
+    }
+
+    /*
+     * Verify that the pipes that were created satisfy the
+     * readable/writable constraints. 
+     */
+
+    if (flags & TCL_ENFORCE_MODE) {
+	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
+	    Tcl_AppendResult(interp, "can't read output from command:",
+		    " standard output was redirected", (char *) NULL);
+	    goto error;
+	}
+	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
+	    Tcl_AppendResult(interp, "can't write input to command:",
+		    " standard input was redirected", (char *) NULL);
+	    goto error;
+	}
+    }
+    
+    channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
+	    numPids, pidPtr);
+
+    if (channel == (Tcl_Channel) NULL) {
+        Tcl_AppendResult(interp, "pipe for command could not be created",
+                (char *) NULL);
+	goto error;
+    }
+    return channel;
+
+error:
+    if (numPids > 0) {
+	Tcl_DetachPids(numPids, pidPtr);
+	ckfree((char *) pidPtr);
+    }
+    if (inPipe != NULL) {
+	TclpCloseFile(inPipe);
+    }
+    if (outPipe != NULL) {
+	TclpCloseFile(outPipe);
+    }
+    if (errFile != NULL) {
+	TclpCloseFile(errFile);
+    }
+    return NULL;
+}
diff --git a/contrib/tcl/generic/tclPkg.c b/contrib/tcl/generic/tclPkg.c
index 9dc0b94..4a58eac 100644
--- a/contrib/tcl/generic/tclPkg.c
+++ b/contrib/tcl/generic/tclPkg.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclPkg.c 1.6 96/02/15 11:43:16
+ * SCCS: @(#) tclPkg.c 1.9 97/05/14 13:23:51
  */
 
 #include "tclInt.h"
@@ -304,6 +304,7 @@ Tcl_PackageCmd(dummy, interp, argc, argv)
     Tcl_HashSearch search;
     Tcl_HashTable *tablePtr;
     char *version;
+    char buf[30];
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -355,7 +356,7 @@ Tcl_PackageCmd(dummy, interp, argc, argv)
 	    if (ComparePkgVersions(availPtr->version, argv[3], (int *) NULL)
 		    == 0) {
 		if (argc == 4) {
-		    interp->result = availPtr->script;
+		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
 		    return TCL_OK;
 		}
 		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
@@ -404,7 +405,7 @@ Tcl_PackageCmd(dummy, interp, argc, argv)
 	    if (hPtr != NULL) {
 		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
 		if (pkgPtr->version != NULL) {
-		    interp->result = pkgPtr->version;
+		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
 		}
 	    }
 	    return TCL_OK;
@@ -438,11 +439,11 @@ Tcl_PackageCmd(dummy, interp, argc, argv)
 	if (version == NULL) {
 	    return TCL_ERROR;
 	}
-	interp->result = version;
+	Tcl_SetResult(interp, version, TCL_VOLATILE);
     } else if ((c == 'u') && (strncmp(argv[1], "unknown", length) == 0)) {
 	if (argc == 2) {
 	    if (iPtr->packageUnknown != NULL) {
-		iPtr->result = iPtr->packageUnknown;
+		Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
 	    }
 	} else if (argc == 3) {
 	    if (iPtr->packageUnknown != NULL) {
@@ -471,8 +472,8 @@ Tcl_PackageCmd(dummy, interp, argc, argv)
 		|| (CheckVersion(interp, argv[3]) != TCL_OK)) {
 	    return TCL_ERROR;
 	}
-	sprintf(interp->result, "%d", ComparePkgVersions(argv[2], argv[3],
-		(int *) NULL));
+	TclFormatInt(buf, ComparePkgVersions(argv[2], argv[3], (int *) NULL));
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if ((c == 'v') && (strncmp(argv[1], "versions", length) == 0)
 	    && (length >= 2)) {
 	if (argc != 3) {
@@ -500,7 +501,8 @@ Tcl_PackageCmd(dummy, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 	ComparePkgVersions(argv[2], argv[3], &satisfies);
-	sprintf(interp->result, "%d", satisfies);
+	TclFormatInt(buf, satisfies);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
 		"\": should be forget, ifneeded, names, ",
@@ -628,11 +630,11 @@ CheckVersion(interp, string)
 {
     char *p = string;
 
-    if (!isdigit(*p)) {
+    if (!isdigit(UCHAR(*p))) {
 	goto error;
     }
     for (p++; *p != 0; p++) {
-	if (!isdigit(*p) && (*p != '.')) {
+	if (!isdigit(UCHAR(*p)) && (*p != '.')) {
 	    goto error;
 	}
     }
diff --git a/contrib/tcl/generic/tclPosixStr.c b/contrib/tcl/generic/tclPosixStr.c
index 1ac415c..162021f 100644
--- a/contrib/tcl/generic/tclPosixStr.c
+++ b/contrib/tcl/generic/tclPosixStr.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclPosixStr.c 1.31 96/07/28 16:25:29
+ * SCCS: @(#) tclPosixStr.c 1.32 96/10/10 10:09:42
  */
 
 #include "tclInt.h"
@@ -540,7 +540,7 @@ Tcl_ErrnoMsg(err)
 	case EBFONT: return "bad font file format";
 #endif
 #ifdef EBUSY
-	case EBUSY: return "mount device busy";
+	case EBUSY: return "file busy";
 #endif
 #ifdef ECHILD
 	case ECHILD: return "no children";
diff --git a/contrib/tcl/generic/tclPreserve.c b/contrib/tcl/generic/tclPreserve.c
index 947873d..24b41ee 100644
--- a/contrib/tcl/generic/tclPreserve.c
+++ b/contrib/tcl/generic/tclPreserve.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclPreserve.c 1.17 96/07/23 16:15:34
+ * SCCS: @(#) tclPreserve.c 1.18 96/08/05 13:15:08
  */
 
 #include "tclInt.h"
diff --git a/contrib/tcl/generic/tclProc.c b/contrib/tcl/generic/tclProc.c
index 0b34e23..14238d9 100644
--- a/contrib/tcl/generic/tclProc.c
+++ b/contrib/tcl/generic/tclProc.c
@@ -5,15 +5,16 @@
  *	including the "proc" and "uplevel" commands.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
  *
- * SCCS: @(#) tclProc.c 1.72 96/02/15 11:42:48
+ * SCCS: @(#) tclProc.c 1.113 97/06/23 15:51:52
  */
 
 #include "tclInt.h"
+#include "tclCompile.h"
 
 /*
  * Forward references to procedures defined later in this file:
@@ -27,13 +28,13 @@ static  void	ProcDeleteProc _ANSI_ARGS_((ClientData clientData));
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ProcCmd --
+ * Tcl_ProcObjCmd --
  *
- *	This procedure is invoked to process the "proc" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "proc" Tcl 
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	A new procedure gets created.
@@ -43,44 +44,113 @@ static  void	ProcDeleteProc _ANSI_ARGS_((ClientData clientData));
 
 	/* ARGSUSED */
 int
-Tcl_ProcCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ProcObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
     register Proc *procPtr;
-    int result, argCount, i;
+    char *fullName, *procName, *args, *bytes, *p;
     char **argArray = NULL;
-    Arg *lastArgPtr;
-    register Arg *argPtr = NULL;	/* Initialization not needed, but
-					 * prevents compiler warning. */
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
+    Tcl_Obj *defPtr, *bodyPtr;
+    Tcl_DString ds;
+    int numArgs, length, result, i;
+    register CompiledLocal *localPtr;
 
-    if (argc != 4) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" name args body\"", (char *) NULL);
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
 	return TCL_ERROR;
     }
 
+    /*
+     * Determine the namespace where the procedure should reside. Unless
+     * the command name includes namespace qualifiers, this will be the
+     * current namespace.
+     */
+    
+    fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    result = TclGetNamespaceForQualName(interp, fullName,
+	    (Namespace *) NULL, TCL_LEAVE_ERR_MSG,
+            &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    if (result != TCL_OK) {
+        return result;
+    }
+    if (nsPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", fullName,
+		"\": unknown namespace", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (procName == NULL) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", fullName,
+		"\": bad procedure name", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if ((nsPtr != iPtr->globalNsPtr)
+	    && (procName != NULL) && (procName[0] == ':')) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", procName,
+		"\" in non-global namespace with name starting with \":\"",
+	        (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * If the procedure's body object is shared because its string value is
+     * identical to, e.g., the body of another procedure, we must create a
+     * private copy for this procedure to use. Such sharing of procedure
+     * bodies is rare but can cause problems. A procedure body is compiled
+     * in a context that includes the number of compiler-allocated "slots"
+     * for local variables. Each formal parameter is given a local variable
+     * slot (the "procPtr->numCompiledLocals = numArgs" assignment
+     * below). This means that the same code can not be shared by two
+     * procedures that have a different number of arguments, even if their
+     * bodies are identical. Note that we don't use Tcl_DuplicateObj since
+     * we would not want any bytecode internal representation.
+     */
+
+    bodyPtr = objv[3];
+    if (Tcl_IsShared(bodyPtr)) {
+	bytes = Tcl_GetStringFromObj(bodyPtr, &length);
+	bodyPtr = Tcl_NewStringObj(bytes, length);
+    }
+
+    /*
+     * We increment the ref count of the procedure's body object since
+     * there will be a reference to it in the Proc structure.
+     */
+    
+    Tcl_IncrRefCount(bodyPtr);
+
     procPtr = (Proc *) ckalloc(sizeof(Proc));
     procPtr->iPtr = iPtr;
     procPtr->refCount = 1;
-    procPtr->command = (char *) ckalloc((unsigned) strlen(argv[3]) + 1);
-    strcpy(procPtr->command, argv[3]);
-    procPtr->argPtr = NULL;
-
+    procPtr->nsPtr = nsPtr;
+    procPtr->bodyPtr = bodyPtr;
+    procPtr->numArgs  = 0;	/* actual argument count is set below. */
+    procPtr->numCompiledLocals = 0;
+    procPtr->firstLocalPtr = NULL;
+    procPtr->lastLocalPtr = NULL;
+    
     /*
      * Break up the argument list into argument specifiers, then process
      * each argument specifier.
+     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
      */
 
-    result = Tcl_SplitList(interp, argv[2], &argCount, &argArray);
+    args = Tcl_GetStringFromObj(objv[2], &length);
+    result = Tcl_SplitList(interp, args, &numArgs, &argArray);
     if (result != TCL_OK) {
 	goto procError;
     }
-    lastArgPtr = NULL;
-    for (i = 0; i < argCount; i++) {
+    
+    procPtr->numArgs = numArgs;
+    procPtr->numCompiledLocals = numArgs;
+    for (i = 0;  i < numArgs;  i++) {
 	int fieldCount, nameLength, valueLength;
 	char **fieldValues;
 
@@ -95,62 +165,122 @@ Tcl_ProcCmd(dummy, interp, argc, argv)
 	}
 	if (fieldCount > 2) {
 	    ckfree((char *) fieldValues);
-	    Tcl_AppendResult(interp,
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		    "too many fields in argument specifier \"",
 		    argArray[i], "\"", (char *) NULL);
-	    result = TCL_ERROR;
 	    goto procError;
 	}
 	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
 	    ckfree((char *) fieldValues);
-	    Tcl_AppendResult(interp, "procedure \"", argv[1],
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "procedure \"", fullName,
 		    "\" has argument with no name", (char *) NULL);
-	    result = TCL_ERROR;
 	    goto procError;
 	}
-	nameLength = strlen(fieldValues[0]) + 1;
+	
+	nameLength = strlen(fieldValues[0]);
 	if (fieldCount == 2) {
-	    valueLength = strlen(fieldValues[1]) + 1;
+	    valueLength = strlen(fieldValues[1]);
 	} else {
 	    valueLength = 0;
 	}
-	argPtr = (Arg *) ckalloc((unsigned)
-		(sizeof(Arg) - sizeof(argPtr->name) + nameLength
-		+ valueLength));
-	if (lastArgPtr == NULL) {
-	    procPtr->argPtr = argPtr;
+
+	/*
+	 * Check that the formal parameter name is a scalar.
+	 */
+
+	p = fieldValues[0];
+	while (*p != '\0') {
+	    if (*p == '(') {
+		char *q = p;
+		do {
+		    q++;
+		} while (*q != '\0');
+		q--;
+		if (*q == ')') { /* we have an array element */
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		            "procedure \"", fullName,
+		            "\" has formal parameter \"", fieldValues[0],
+			    "\" that is an array element",
+			    (char *) NULL);
+		    ckfree((char *) fieldValues);
+		    goto procError;
+		}
+	    }
+	    p++;
+	}
+
+	/*
+	 * Allocate an entry in the runtime procedure frame's array of local
+	 * variables for the argument. 
+	 */
+
+	localPtr = (CompiledLocal *) ckalloc((unsigned) 
+	        (sizeof(CompiledLocal) - sizeof(localPtr->name)
+		+ nameLength+1));
+	if (procPtr->firstLocalPtr == NULL) {
+	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
 	} else {
-	    lastArgPtr->nextPtr = argPtr;
+	    procPtr->lastLocalPtr->nextPtr = localPtr;
+	    procPtr->lastLocalPtr = localPtr;
 	}
-	lastArgPtr = argPtr;
-	argPtr->nextPtr = NULL;
-	strcpy(argPtr->name, fieldValues[0]);
+	localPtr->nextPtr = NULL;
+	localPtr->nameLength = nameLength;
+	localPtr->frameIndex = i;
+	localPtr->isArg  = 1;
+	localPtr->isTemp = 0;
+	localPtr->flags = VAR_SCALAR;
 	if (fieldCount == 2) {
-	    argPtr->defValue = argPtr->name + nameLength;
-	    strcpy(argPtr->defValue, fieldValues[1]);
+	    localPtr->defValuePtr =
+		    Tcl_NewStringObj(fieldValues[1], valueLength);
+	    Tcl_IncrRefCount(localPtr->defValuePtr);
 	} else {
-	    argPtr->defValue = NULL;
+	    localPtr->defValuePtr = NULL;
 	}
+	strcpy(localPtr->name, fieldValues[0]);
+	
 	ckfree((char *) fieldValues);
     }
 
-    Tcl_CreateCommand(interp, argv[1], InterpProc, (ClientData) procPtr,
-	    ProcDeleteProc);
+    /*
+     * Now create a command for the procedure. This will be in the current
+     * namespace unless the procedure's name included namespace qualifiers.
+     * To create the new command in the right namespace, we generate a
+     * fully qualified name for it.
+     */
+
+    Tcl_DStringInit(&ds);
+    if (nsPtr != iPtr->globalNsPtr) {
+	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+	Tcl_DStringAppend(&ds, "::", 2);
+    }
+    Tcl_DStringAppend(&ds, procName, -1);
+    
+    Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), InterpProc,
+	    (ClientData) procPtr, ProcDeleteProc);
+    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
+	    (ClientData) procPtr, ProcDeleteProc);
     ckfree((char *) argArray);
     return TCL_OK;
 
     procError:
-    ckfree(procPtr->command);
-    while (procPtr->argPtr != NULL) {
-	argPtr = procPtr->argPtr;
-	procPtr->argPtr = argPtr->nextPtr;
-	ckfree((char *) argPtr);
+    Tcl_DecrRefCount(bodyPtr);
+    while (procPtr->firstLocalPtr != NULL) {
+	localPtr = procPtr->firstLocalPtr;
+	procPtr->firstLocalPtr = localPtr->nextPtr;
+	
+	defPtr = localPtr->defValuePtr;
+	if (defPtr != NULL) {
+	    Tcl_DecrRefCount(defPtr);
+	}
+	
+	ckfree((char *) localPtr);
     }
     ckfree((char *) procPtr);
     if (argArray != NULL) {
 	ckfree((char *) argArray);
     }
-    return result;
+    return TCL_ERROR;
 }
 
 /*
@@ -240,13 +370,13 @@ TclGetFrame(interp, string, framePtrPtr)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UplevelCmd --
+ * Tcl_UplevelObjCmd --
  *
- *	This procedure is invoked to process the "uplevel" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object procedure is invoked to process the "uplevel" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	See the user documentation.
@@ -256,36 +386,38 @@ TclGetFrame(interp, string, framePtrPtr)
 
 	/* ARGSUSED */
 int
-Tcl_UplevelCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_UplevelObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    int result;
+    char *optLevel;
+    int length, result;
     CallFrame *savedVarFramePtr, *framePtr;
 
-    if (argc < 2) {
+    if (objc < 2) {
 	uplevelSyntax:
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" ?level? command ?arg ...?\"", (char *) NULL);
+	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
 	return TCL_ERROR;
     }
 
     /*
      * Find the level to use for executing the command.
+     * THIS FAILS IF THE OBJECT RESULT'S STRING REP CONTAINS A NULL.
      */
 
-    result = TclGetFrame(interp, argv[1], &framePtr);
+    optLevel = Tcl_GetStringFromObj(objv[1], &length);
+    result = TclGetFrame(interp, optLevel, &framePtr);
     if (result == -1) {
 	return TCL_ERROR;
     }
-    argc -= (result+1);
-    if (argc == 0) {
+    objc -= (result+1);
+    if (objc == 0) {
 	goto uplevelSyntax;
     }
-    argv += (result+1);
+    objv += (result+1);
 
     /*
      * Modify the interpreter state to execute in the given frame.
@@ -298,19 +430,17 @@ Tcl_UplevelCmd(dummy, interp, argc, argv)
      * Execute the residual arguments as a command.
      */
 
-    if (argc == 1) {
-	result = Tcl_Eval(interp, argv[0]);
+    if (objc == 1) {
+	result = Tcl_EvalObj(interp, objv[0]);
     } else {
-	char *cmd;
-
-	cmd = Tcl_Concat(argc, argv);
-	result = Tcl_Eval(interp, cmd);
-	ckfree(cmd);
+	Tcl_Obj *cmdObjPtr = Tcl_ConcatObj(objc, objv);
+	result = Tcl_EvalObj(interp, cmdObjPtr);
+	Tcl_DecrRefCount(cmdObjPtr); /* done with object */
     }
     if (result == TCL_ERROR) {
 	char msg[60];
 	sprintf(msg, "\n    (\"uplevel\" body line %d)", interp->errorLine);
-	Tcl_AddErrorInfo(interp, msg);
+	Tcl_AddObjErrorInfo(interp, msg, -1);
     }
 
     /*
@@ -345,14 +475,15 @@ TclFindProc(iPtr, procName)
     Interp *iPtr;		/* Interpreter in which to look. */
     char *procName;		/* Name of desired procedure. */
 {
-    Tcl_HashEntry *hPtr;
+    Tcl_Command cmd;
     Command *cmdPtr;
 
-    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, procName);
-    if (hPtr == NULL) {
-	return NULL;
+    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
+            (Tcl_Namespace *) NULL, /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+        return NULL;
     }
-    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    cmdPtr = (Command *) cmd;
     if (cmdPtr->proc != InterpProc) {
 	return NULL;
     }
@@ -392,8 +523,8 @@ TclIsProc(cmdPtr)
  *
  * InterpProc --
  *
- *	When a Tcl procedure gets invoked, this routine gets invoked
- *	to interpret the procedure.
+ *	When a Tcl procedure gets invoked with an argc/argv array of
+ *	strings, this routine gets invoked to interpret the procedure.
  *
  * Results:
  *	A standard Tcl result value, usually TCL_OK.
@@ -412,43 +543,261 @@ InterpProc(clientData, interp, argc, argv)
 				 * invoked. */
     int argc;			/* Count of number of arguments to this
 				 * procedure. */
-    char **argv;		/* Argument values. */
+    register char **argv;	/* Argument values. */
 {
-    register Proc *procPtr = (Proc *) clientData;
-    register Arg *argPtr;
-    register Interp *iPtr;
-    char **args;
-    CallFrame frame;
-    char *value;
+    register Tcl_Obj *objPtr;
+    register int i;
     int result;
 
     /*
-     * Set up a call frame for the new procedure invocation.
+     * This procedure generates an objv array for object arguments that hold
+     * the argv strings. It starts out with stack-allocated space but uses
+     * dynamically-allocated storage if needed.
      */
 
-    iPtr = procPtr->iPtr;
-    Tcl_InitHashTable(&frame.varTable, TCL_STRING_KEYS);
-    if (iPtr->varFramePtr != NULL) {
-	frame.level = iPtr->varFramePtr->level + 1;
-    } else {
-	frame.level = 1;
-    }
-    frame.argc = argc;
-    frame.argv = argv;
-    frame.callerPtr = iPtr->framePtr;
-    frame.callerVarPtr = iPtr->varFramePtr;
-    iPtr->framePtr = &frame;
-    iPtr->varFramePtr = &frame;
-    iPtr->returnCode = TCL_OK;
+#define NUM_ARGS 20
+    Tcl_Obj *(objStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = objStorage;
+
+    /*
+     * Create the object argument array "objv". Make sure objv is large
+     * enough to hold the objc arguments plus 1 extra for the zero
+     * end-of-objv word.
+     */
+
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+    }
+
+    for (i = 0;  i < argc;  i++) {
+	objv[i] = Tcl_NewStringObj(argv[i], -1);
+	Tcl_IncrRefCount(objv[i]);
+    }
+    objv[argc] = 0;
 
     /*
-     * Match the actual arguments against the procedure's formal
-     * parameters to compute local variables.
+     * Use TclObjInterpProc to actually interpret the procedure.
      */
 
-    for (argPtr = procPtr->argPtr, args = argv+1, argc -= 1;
-	    argPtr != NULL;
-	    argPtr = argPtr->nextPtr, args++, argc--) {
+    result = TclObjInterpProc(clientData, interp, argc, objv);
+
+    /*
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+    
+    Tcl_SetResult(interp,
+	    TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	    TCL_VOLATILE);
+
+    /*
+     * Decrement the ref counts on the objv elements since we are done
+     * with them.
+     */
+
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	TclDecrRefCount(objPtr);
+    }
+    
+    /*
+     * Free the objv array if malloc'ed storage was used.
+     */
+
+    if (objv != objStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInterpProc --
+ *
+ *	When a Tcl procedure gets invoked during bytecode evaluation, this 
+ *	object-based routine gets invoked to interpret the procedure.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	Depends on the commands in the procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInterpProc(clientData, interp, objc, objv)
+    ClientData clientData;	/* Record describing procedure to be
+				 * interpreted. */
+    Tcl_Interp *interp;		/* Interpreter in which procedure was
+				 * invoked. */
+    int objc;			/* Count of number of arguments to this
+				 * procedure. */
+    Tcl_Obj *CONST objv[];	/* Argument value objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Proc *procPtr = (Proc *) clientData;
+    Tcl_Obj *bodyPtr = procPtr->bodyPtr;
+    CallFrame frame;
+    register CallFrame *framePtr = &frame;
+    register Var *varPtr;
+    register CompiledLocal *localPtr;
+    Proc *saveProcPtr;
+    char *procName, *bytes;
+    int nameLen, localCt, numArgs, argCt, length, i, result;
+
+    /*
+     * This procedure generates an array "compiledLocals" that holds the
+     * storage for local variables. It starts out with stack-allocated space
+     * but uses dynamically-allocated storage if needed.
+     */
+
+#define NUM_LOCALS 20
+    Var localStorage[NUM_LOCALS];
+    Var *compiledLocals = localStorage;
+
+    /*
+     * Get the procedure's name.
+     * THIS FAILS IF THE PROC NAME'S STRING REP HAS A NULL.
+     */
+    
+    procName = Tcl_GetStringFromObj(objv[0], &nameLen);
+
+    /*
+     * If necessary, compile the procedure's body. The compiler will
+     * allocate frame slots for the procedure's non-argument local
+     * variables. If the ByteCode already exists, make sure it hasn't been
+     * invalidated by someone redefining a core command (this might make the
+     * compiled code wrong). Also, if the code was compiled in/for a
+     * different interpreter, we recompile it. Note that compiling the body
+     * might increase procPtr->numCompiledLocals if new local variables are
+     * found while compiling.
+     */
+
+    if (bodyPtr->typePtr == &tclByteCodeType) {
+	ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+	
+	if ((codePtr->iPtr != iPtr)
+	        || (codePtr->compileEpoch != iPtr->compileEpoch)) {
+	    tclByteCodeType.freeIntRepProc(bodyPtr);
+	    bodyPtr->typePtr = (Tcl_ObjType *) NULL;
+	}
+    }
+    if (bodyPtr->typePtr != &tclByteCodeType) {
+	char buf[100];
+	int numChars;
+	char *ellipsis;
+	
+	if (tclTraceCompile >= 1) {
+	    /*
+	     * Display a line summarizing the top level command we
+	     * are about to compile.
+	     */
+
+	    numChars = nameLen;
+	    ellipsis = "";
+	    if (numChars > 50) {
+		numChars = 50;
+		ellipsis = "...";
+	    }
+	    fprintf(stdout, "Compiling body of proc \"%.*s%s\"\n",
+		    numChars, procName, ellipsis);
+	}
+	
+	saveProcPtr = iPtr->compiledProcPtr;
+	iPtr->compiledProcPtr = procPtr;
+	result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+	iPtr->compiledProcPtr = saveProcPtr;
+	
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		numChars = nameLen;
+		ellipsis = "";
+		if (numChars > 50) {
+		    numChars = 50;
+		    ellipsis = "...";
+		}
+		sprintf(buf, "\n    (compiling body of proc \"%.*s%s\", line %d)",
+			numChars, procName, ellipsis, interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, buf, -1);
+	    }
+	    return result;
+	}
+    }
+
+    /*
+     * Create the "compiledLocals" array. Make sure it is large enough to
+     * hold all the procedure's compiled local variables, including its
+     * formal parameters.
+     */
+
+    localCt = procPtr->numCompiledLocals;
+    if (localCt > NUM_LOCALS) {
+	compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
+    }
+    
+    /*
+     * Set up and push a new call frame for the new procedure invocation.
+     * This call frame will execute in the proc's namespace, which might
+     * be different than the current namespace.
+     */
+
+    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+            (Tcl_Namespace *) procPtr->nsPtr, /*isProcCallFrame*/ 1);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    framePtr->objc = objc;
+    framePtr->objv = objv;  /* ref counts for args are incremented below */
+    framePtr->procPtr = procPtr;
+    framePtr->numCompiledLocals = localCt;
+    framePtr->compiledLocals = compiledLocals;
+
+    /*
+     * Initialize the array of local variables stored in the call frame.
+     */
+
+    varPtr = framePtr->compiledLocals;
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+	    localPtr = localPtr->nextPtr) {
+	varPtr->value.objPtr = NULL;
+	varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+	varPtr->nsPtr = procPtr->nsPtr;
+	varPtr->hPtr = NULL;
+	varPtr->refCount = 0;
+	varPtr->tracePtr = NULL;
+	varPtr->searchPtr = NULL;
+	varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
+	varPtr++;
+    }
+
+    /*
+     * Match and assign the call's actual parameters to the procedure's
+     * formal arguments. The formal arguments are described by the first
+     * numArgs entries in both the Proc structure's local variable list and
+     * the call frame's local variable array.
+     */
+
+    numArgs = procPtr->numArgs;
+    varPtr = framePtr->compiledLocals;
+    localPtr = procPtr->firstLocalPtr;
+    argCt = objc;
+    for (i = 1, argCt -= 1;  i <= numArgs;  i++, argCt--) {
+	if (!localPtr->isArg) {
+	    panic("TclObjInterpProc: local variable %s is not argument but should be",
+		  localPtr->name);
+	    return TCL_ERROR;
+	}
+	if (localPtr->isTemp) {
+	    panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
+	    return TCL_ERROR;
+	}
 
 	/*
 	 * Handle the special case of the last formal being "args".  When
@@ -456,31 +805,40 @@ InterpProc(clientData, interp, argc, argv)
 	 * actual arguments.
 	 */
 
-	if ((argPtr->nextPtr == NULL)
-		&& (strcmp(argPtr->name, "args") == 0)) {
-	    if (argc < 0) {
-		argc = 0;
-	    }
-	    value = Tcl_Merge(argc, args);
-	    Tcl_SetVar(interp, argPtr->name, value, 0);
-	    ckfree(value);
-	    argc = 0;
-	    break;
-	} else if (argc > 0) {
-	    value = *args;
-	} else if (argPtr->defValue != NULL) {
-	    value = argPtr->defValue;
+	if ((i == numArgs) && ((localPtr->name[0] == 'a')
+	        && (strcmp(localPtr->name, "args") == 0))) {
+	    Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
+	    varPtr->value.objPtr = listPtr;
+	    Tcl_IncrRefCount(listPtr); /* local var is a reference */
+	    varPtr->flags &= ~VAR_UNDEFINED;
+	    argCt = 0;
+	    break;		/* done processing args */
+	} else if (argCt > 0) {
+	    Tcl_Obj *objPtr = objv[i];
+	    varPtr->value.objPtr = objPtr;
+	    varPtr->flags &= ~VAR_UNDEFINED;
+	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
+					* another reference to object. */
+	} else if (localPtr->defValuePtr != NULL) {
+	    Tcl_Obj *objPtr = localPtr->defValuePtr;
+	    varPtr->value.objPtr = objPtr;
+	    varPtr->flags &= ~VAR_UNDEFINED;
+	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
+					* another reference to object. */
 	} else {
-	    Tcl_AppendResult(interp, "no value given for parameter \"",
-		    argPtr->name, "\" to \"", argv[0], "\"",
-		    (char *) NULL);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "no value given for parameter \"", localPtr->name,
+		    "\" to \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		    "\"", (char *) NULL);
 	    result = TCL_ERROR;
 	    goto procDone;
 	}
-	Tcl_SetVar(interp, argPtr->name, value, 0);
+	varPtr++;
+	localPtr = localPtr->nextPtr;
     }
-    if (argc > 0) {
-	Tcl_AppendResult(interp, "called \"", argv[0],
+    if (argCt > 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"called \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
 		"\" with too many arguments", (char *) NULL);
 	result = TCL_ERROR;
 	goto procDone;
@@ -490,62 +848,63 @@ InterpProc(clientData, interp, argc, argv)
      * Invoke the commands in the procedure's body.
      */
 
+    if (tclTraceExec >= 1) {
+	fprintf(stdout, "Calling proc ");
+	for (i = 0;  i < objc;  i++) {
+	    bytes = Tcl_GetStringFromObj(objv[i], &length);
+	    TclPrintSource(stdout, bytes, TclMin(length, 15));
+	    fprintf(stdout, " ");
+	}
+	fprintf(stdout, "\n");
+	fflush(stdout);
+    }
+
+    iPtr->returnCode = TCL_OK;
     procPtr->refCount++;
-    result = Tcl_Eval(interp, procPtr->command);
+    result = Tcl_EvalObj(interp, procPtr->bodyPtr);
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
 	CleanupProc(procPtr);
     }
-    if (result == TCL_RETURN) {
-	result = TclUpdateReturnInfo(iPtr);
-    } else if (result == TCL_ERROR) {
-	char msg[100];
-
-	/*
-	 * Record information telling where the error occurred.
-	 */
 
-	sprintf(msg, "\n    (procedure \"%.50s\" line %d)", argv[0],
-		iPtr->errorLine);
-	Tcl_AddErrorInfo(interp, msg);
-    } else if (result == TCL_BREAK) {
-	iPtr->result = "invoked \"break\" outside of a loop";
-	result = TCL_ERROR;
-    } else if (result == TCL_CONTINUE) {
-	iPtr->result = "invoked \"continue\" outside of a loop";
-	result = TCL_ERROR;
+    if (result != TCL_OK) {
+	if (result == TCL_RETURN) {
+	    result = TclUpdateReturnInfo(iPtr);
+	} else if (result == TCL_ERROR) {
+	    char msg[100];
+	    sprintf(msg, "\n    (procedure \"%.50s\" line %d)",
+		    procName, iPtr->errorLine);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	} else if (result == TCL_BREAK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "invoked \"break\" outside of a loop", -1);
+	    result = TCL_ERROR;
+	} else if (result == TCL_CONTINUE) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "invoked \"continue\" outside of a loop", -1);
+	    result = TCL_ERROR;
+	}
     }
+    
+    procDone:
 
     /*
-     * Delete the call frame for this procedure invocation (it's
-     * important to remove the call frame from the interpreter
-     * before deleting it, so that traces invoked during the
-     * deletion don't see the partially-deleted frame).
+     * Pop and free the call frame for this procedure invocation.
      */
-
-    procDone:
-    iPtr->framePtr = frame.callerPtr;
-    iPtr->varFramePtr = frame.callerVarPtr;
-
+    
+    Tcl_PopCallFrame(interp);
+    
     /*
-     * The check below is a hack.  The problem is that there could be
-     * unset traces on the variables, which cause scripts to be evaluated.
-     * This will clear the ERR_IN_PROGRESS flag, losing stack trace
-     * information if the procedure was exiting with an error.  The
-     * code below preserves the flag.  Unfortunately, that isn't
-     * really enough:  we really should preserve the errorInfo variable
-     * too (otherwise a nested error in the trace script will trash
-     * errorInfo).  What's really needed is a general-purpose
-     * mechanism for saving and restoring interpreter state.
+     * Free the compiledLocals array if malloc'ed storage was used.
      */
 
-    if (iPtr->flags & ERR_IN_PROGRESS) {
-	TclDeleteVars(iPtr, &frame.varTable);
-	iPtr->flags |= ERR_IN_PROGRESS;
-    } else {
-	TclDeleteVars(iPtr, &frame.varTable);
+    if (compiledLocals != localStorage) {
+	ckfree((char *) compiledLocals);
     }
     return result;
+#undef NUM_LOCALS
 }
 
 /*
@@ -602,14 +961,22 @@ static void
 CleanupProc(procPtr)
     register Proc *procPtr;		/* Procedure to be deleted. */
 {
-    register Arg *argPtr;
+    register CompiledLocal *localPtr;
+    Tcl_Obj *bodyPtr = procPtr->bodyPtr;
+    Tcl_Obj *defPtr;
 
-    ckfree((char *) procPtr->command);
-    for (argPtr = procPtr->argPtr; argPtr != NULL; ) {
-	Arg *nextPtr = argPtr->nextPtr;
+    if (bodyPtr != NULL) {
+	Tcl_DecrRefCount(bodyPtr);
+    }
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
+	CompiledLocal *nextPtr = localPtr->nextPtr;
 
-	ckfree((char *) argPtr);
-	argPtr = nextPtr;
+	if (localPtr->defValuePtr != NULL) {
+	    defPtr = localPtr->defValuePtr;
+	    Tcl_DecrRefCount(defPtr);
+	}
+	ckfree((char *) localPtr);
+	localPtr = nextPtr;
     }
     ckfree((char *) procPtr);
 }
diff --git a/contrib/tcl/generic/tclStringObj.c b/contrib/tcl/generic/tclStringObj.c
new file mode 100644
index 0000000..e421833
--- /dev/null
+++ b/contrib/tcl/generic/tclStringObj.c
@@ -0,0 +1,598 @@
+/* 
+ * tclStringObj.c --
+ *
+ *	This file contains procedures that implement string operations
+ *	on Tcl objects.  To do this efficiently (i.e. to allow many
+ *	appends to be done to an object without constantly reallocating
+ *	the space for the string representation) we overallocate the
+ *	space for the string and use the internal representation to keep
+ *	track of the extra space.  Objects with this internal
+ *	representation are called "expandable string objects".
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclStringObj.c 1.29 97/06/13 18:17:19
+ */
+
+#include "tclInt.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		ConvertToStringType _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr));
+static int		SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines the string Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclStringType = {
+    "string",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,	/* freeIntRepProc */
+    DupStringInternalRep,		/* dupIntRepProc */
+    UpdateStringOfString,		/* updateStringProc */
+    SetStringFromAny			/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewStringObj --
+ *
+ *	This procedure is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new string object and
+ *	initializes it from the byte pointer and length arguments.
+ *
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewStringObj.
+ *
+ * Results:
+ *	A newly created string object is returned that has ref count zero.
+ *
+ * Side effects:
+ *	The new object's internal string representation will be set to a
+ *	copy of the length bytes starting at "bytes". If "length" is
+ *	negative, use bytes up to the first NULL byte; i.e., assume "bytes"
+ *	points to a C-style NULL-terminated string. The object's type is set
+ *	to NULL. An extra NULL is added to the end of the new object's byte
+ *	array.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewStringObj
+
+Tcl_Obj *
+Tcl_NewStringObj(bytes, length)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+{
+    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewStringObj(bytes, length)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+{
+    register Tcl_Obj *objPtr;
+
+    if (length < 0) {
+	length = strlen(bytes);
+    }
+    TclNewObj(objPtr);
+    TclInitStringRep(objPtr, bytes, length);
+    return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewStringObj --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new string objects. It is the
+ *	same as the Tcl_NewStringObj procedure above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the checkmem command
+ *	will report the correct file name and line number when reporting
+ *	objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	result of calling Tcl_NewStringObj.
+ *
+ * Results:
+ *	A newly created string object is returned that has ref count zero.
+ *
+ * Side effects:
+ *	The new object's internal string representation will be set to a
+ *	copy of the length bytes starting at "bytes". If "length" is
+ *	negative, use bytes up to the first NULL byte; i.e., assume "bytes"
+ *	points to a C-style NULL-terminated string. The object's type is set
+ *	to NULL. An extra NULL is added to the end of the new object's byte
+ *	array.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewStringObj(bytes, length, file, line)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    register Tcl_Obj *objPtr;
+
+    if (length < 0) {
+	length = strlen(bytes);
+    }
+    TclDbNewObj(objPtr, file, line);
+    TclInitStringRep(objPtr, bytes, length);
+    return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewStringObj(bytes, length, file, line)
+    register char *bytes;	/* Points to the first of the length bytes
+				 * used to initialize the new object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte. */
+    char *file;			/* The name of the source file calling this
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
+    return Tcl_NewStringObj(bytes, length);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetStringObj --
+ *
+ *	Modify an object to hold a string that is a copy of the bytes
+ *	indicated by the byte pointer and length arguments. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string representation will be set to a copy of
+ *	the "length" bytes starting at "bytes". If "length" is negative, use
+ *	bytes up to the first NULL byte; i.e., assume "bytes" points to a
+ *	C-style NULL-terminated string. The object's old string and internal
+ *	representations are freed and the object's type is set NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetStringObj(objPtr, bytes, length)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
+    char *bytes;		/* Points to the first of the length bytes
+				 * used to initialize the object. */
+    register int length;	/* The number of bytes to copy from "bytes"
+				 * when initializing the object. If 
+				 * negative, use bytes up to the first
+				 * NULL byte.*/
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    /*
+     * Free any old string rep, then set the string rep to a copy of
+     * the length bytes starting at "bytes".
+     */
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetStringObj called with shared object");
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if (length < 0) {
+	length = strlen(bytes);
+    }
+    TclInitStringRep(objPtr, bytes, length);
+        
+    /*
+     * Set the type to NULL and free any internal rep for the old type.
+     */
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->typePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjLength --
+ *
+ *	This procedure changes the length of the string representation
+ *	of an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the size of objPtr's string representation is greater than
+ *	length, then it is reduced to length and a new terminating null
+ *	byte is stored in the strength.  If the length of the string
+ *	representation is greater than length, the storage space is
+ *	reallocated to the given length; a null byte is stored at the
+ *	end, but other bytes past the end of the original string
+ *	representation are undefined.  The object's internal
+ *	representation is changed to "expendable string".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjLength(objPtr, length)
+    register Tcl_Obj *objPtr;	/* Pointer to object.  This object must
+				 * not currently be shared. */
+    register int length;	/* Number of bytes desired for string
+				 * representation of object, not including
+				 * terminating null byte. */
+{
+    char *new;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetObjLength called with shared object");
+    }
+    if (objPtr->typePtr != &tclStringType) {
+	ConvertToStringType(objPtr);
+    }
+    
+    if ((long)length > objPtr->internalRep.longValue) {
+	/*
+	 * Not enough space in current string. Reallocate the string
+	 * space and free the old string.
+	 */
+
+	new = (char *) ckalloc((unsigned) (length+1));
+	if (objPtr->bytes != NULL) {
+	    memcpy((VOID *) new, (VOID *) objPtr->bytes,
+		    (size_t) objPtr->length);
+	    Tcl_InvalidateStringRep(objPtr);
+	}
+	objPtr->bytes = new;
+	objPtr->internalRep.longValue = (long) length;
+    }
+    objPtr->length = length;
+    if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
+	objPtr->bytes[length] = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendToObj --
+ *
+ *	This procedure appends a sequence of bytes to an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The bytes at *bytes are appended to the string representation
+ *	of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendToObj(objPtr, bytes, length)
+    register Tcl_Obj *objPtr;	/* Points to the object to append to. */
+    char *bytes;		/* Points to the bytes to append to the
+				 * object. */
+    register int length;	/* The number of bytes to append from
+				 * "bytes". If < 0, then append all bytes
+				 * up to NULL byte. */
+{
+    int newLength, oldLength;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_AppendToObj called with shared object");
+    }
+    if (objPtr->typePtr != &tclStringType) {
+	ConvertToStringType(objPtr);
+    }
+    if (length < 0) {
+	length = strlen(bytes);
+    }
+    if (length == 0) {
+	return;
+    }
+    oldLength = objPtr->length;
+    newLength = length + oldLength;
+    if ((long)newLength > objPtr->internalRep.longValue) {
+	/*
+	 * There isn't currently enough space in the string
+	 * representation so allocate additional space.  In fact,
+	 * overallocate so that there is room for future growth without
+	 * having to reallocate again.
+	 */
+
+	Tcl_SetObjLength(objPtr, 2*newLength);
+    }
+    if (length > 0) {
+	memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
+	       (size_t) length);
+	objPtr->length = newLength;
+	objPtr->bytes[objPtr->length] = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendStringsToObj --
+ *
+ *	This procedure appends one or more null-terminated strings
+ *	to an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The contents of all the string arguments are appended to the
+ *	string representation of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
+{
+    va_list argList;
+    register Tcl_Obj *objPtr;
+    int newLength, oldLength;
+    register char *string, *dst;
+
+    objPtr = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_AppendStringsToObj called with shared object");
+    }
+    if (objPtr->typePtr != &tclStringType) {
+	ConvertToStringType(objPtr);
+    }
+
+    /*
+     * Figure out how much space is needed for all the strings, and
+     * expand the string representation if it isn't big enough. If no
+     * bytes would be appended, just return.
+     */
+
+    newLength = oldLength = objPtr->length;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	newLength += strlen(string);
+    }
+    if (newLength == oldLength) {
+	return;
+    }
+
+    if ((long)newLength > objPtr->internalRep.longValue) {
+	/*
+	 * There isn't currently enough space in the string
+	 * representation so allocate additional space.  If the current
+	 * string representation isn't empty (i.e. it looks like we're
+	 * doing a series of appends) then overallocate the space so
+	 * that we won't have to do as much reallocation in the future.
+	 */
+
+	Tcl_SetObjLength(objPtr,
+		(objPtr->length == 0) ? newLength : 2*newLength);
+    }
+
+    /*
+     * Make a second pass through the arguments, appending all the
+     * strings to the object.
+     */
+
+    TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+    dst = objPtr->bytes + oldLength;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	while (*string != 0) {
+	    *dst = *string;
+	    dst++;
+	    string++;
+	}
+    }
+
+    /*
+     * Add a null byte to terminate the string.  However, be careful:
+     * it's possible that the object is totally empty (if it was empty
+     * originally and there was nothing to append).  In this case dst is
+     * NULL; just leave everything alone.
+     */
+
+    if (dst != NULL) {
+	*dst = 0;
+    }
+    objPtr->length = newLength;
+    va_end(argList);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertToStringType --
+ *
+ *	This procedure converts the internal representation of an object
+ *	to "expandable string" type.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Any old internal reputation for objPtr is freed and the
+ *	internal representation is set to that for an expandable string
+ *	(the field internalRep.longValue holds 1 less than the allocated
+ *	length of objPtr's string representation).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConvertToStringType(objPtr)
+    register Tcl_Obj *objPtr;	/* Pointer to object.  Must have a
+				 * typePtr that isn't &tclStringType. */
+{
+    if (objPtr->typePtr != NULL) {
+	if (objPtr->bytes == NULL) {
+	    objPtr->typePtr->updateStringProc(objPtr);
+	}
+	if (objPtr->typePtr->freeIntRepProc != NULL) {
+	    objPtr->typePtr->freeIntRepProc(objPtr);
+	}
+    }
+    objPtr->typePtr = &tclStringType;
+    if (objPtr->bytes != NULL) {
+	objPtr->internalRep.longValue = (long)objPtr->length;
+    } else {
+	objPtr->internalRep.longValue = 0;
+	objPtr->length = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupStringInternalRep --
+ *
+ *	Initialize the internal representation of a new Tcl_Obj to a
+ *	copy of the internal representation of an existing string object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to a copy of srcPtr's internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupStringInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy.  Must
+				 * have an internal representation of type
+				 * "expandable string". */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set.  Must
+				 * not currently have an internal rep.*/
+{
+    /*
+     * Tricky point: the string value was copied by generic object
+     * management code, so it doesn't contain any extra bytes that
+     * might exist in the source object.
+     */
+
+    copyPtr->internalRep.longValue = (long)copyPtr->length;
+    copyPtr->typePtr = &tclStringType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetStringFromAny --
+ *
+ *	Create an internal representation of type "expandable string"
+ *	for an object.
+ *
+ * Results:
+ *	This operation always succeeds and returns TCL_OK.
+ *
+ * Side effects:
+ *	This procedure does nothing; there is no advantage in converting
+ *	the internal representation now, so we just defer it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetStringFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+{
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfString --
+ *
+ *	Update the string representation for an object whose internal
+ *	representation is "expandable string".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfString(objPtr)
+    Tcl_Obj *objPtr;		/* Object with string rep to update. */
+{
+    /*
+     * The string is almost always valid already, in which case there's
+     * nothing for us to do. The only case we have to worry about is if
+     * the object is totally null. In this case, set the string rep to
+     * an empty string.
+     */
+
+    if (objPtr->bytes == NULL) {
+	objPtr->bytes = tclEmptyStringRep;
+	objPtr->length = 0;
+    }
+    return;
+}
diff --git a/contrib/tcl/generic/tclTest.c b/contrib/tcl/generic/tclTest.c
index 74ff0e2..7ee313b 100644
--- a/contrib/tcl/generic/tclTest.c
+++ b/contrib/tcl/generic/tclTest.c
@@ -7,14 +7,16 @@
  *	they're only used for testing.
  *
  * Copyright (c) 1993-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclTest.c 1.78 96/04/11 14:50:51
+ * SCCS: @(#) tclTest.c 1.111 97/06/26 14:33:03
  */
 
+#define TCL_TEST
+
 #include "tclInt.h"
 #include "tclPort.h"
 
@@ -68,19 +70,6 @@ typedef struct DelCmd {
 } DelCmd;
 
 /*
- * The following structure is used to keep track of modal timeout
- * handlers created by the "testmodal" command.
- */
-
-typedef struct Modal {
-    Tcl_Interp *interp;		/* Interpreter in which to set variable
-				 * "x" when timer fires. */
-    char *key;			/* Null-terminated string to store in
-				 * global variable "x" in interp when
-				 * timer fires.  Malloc-ed. */
-} Modal;
-
-/*
  * Forward declarations for procedures defined later in this file:
  */
 
@@ -95,6 +84,12 @@ static int		CmdProc1 _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		CmdProc2 _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int argc, char **argv));
+static int		CreatedCommandProc _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int argc, char **argv));
+static int		CreatedCommandProc2 _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int argc, char **argv));
 static void		DelCallbackProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp));
 static int		DelCmdProc _ANSI_ARGS_((ClientData clientData,
@@ -102,7 +97,12 @@ static int		DelCmdProc _ANSI_ARGS_((ClientData clientData,
 static void		DelDeleteProc _ANSI_ARGS_((ClientData clientData));
 static void		ExitProcEven _ANSI_ARGS_((ClientData clientData));
 static void		ExitProcOdd _ANSI_ARGS_((ClientData clientData));
-static void		ModalTimeoutProc _ANSI_ARGS_((ClientData clientData));
+static int              GetTimesCmd _ANSI_ARGS_((ClientData clientData,
+                            Tcl_Interp *interp, int argc, char **argv));
+static int              NoopCmd _ANSI_ARGS_((ClientData clientData,
+                            Tcl_Interp *interp, int argc, char **argv));
+static int              NoopObjCmd _ANSI_ARGS_((ClientData clientData,
+                            Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 static void		SpecialFree _ANSI_ARGS_((char *blockPtr));
 static int		StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
 static int		TestasyncCmd _ANSI_ARGS_((ClientData dummy,
@@ -111,6 +111,10 @@ static int		TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestchmodCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestdcallCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestdelCmd _ANSI_ARGS_((ClientData dummy,
@@ -121,14 +125,19 @@ static int		TestdstringCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
-static int		TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
+static int		TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestfileCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestfeventCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestgetplatformCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
-static int		TestfhandleCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestgetvarfullnameCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
 static int		TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
 		            Tcl_Interp *interp, int argc, char **argv));
 static int		TestlinkCmd _ANSI_ARGS_((ClientData dummy,
@@ -136,10 +145,18 @@ static int		TestlinkCmd _ANSI_ARGS_((ClientData dummy,
 static int		TestMathFunc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, Tcl_Value *args,
 			    Tcl_Value *resultPtr));
-static int		TestmodalCmd _ANSI_ARGS_((ClientData dummy,
+static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, Tcl_Value *args,
+			    Tcl_Value *resultPtr));
+static int		TestPanicCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestsetnoerrCmd _ANSI_ARGS_((ClientData dummy,
+		            Tcl_Interp *interp, int argc, char **argv));
+static int		TestsetobjerrorcodeCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
 static int		TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
@@ -148,12 +165,9 @@ static int		TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestupvarCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
-static int		TestwordendCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, char **argv));
-static int		TestfeventCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, char **argv));
-static int		TestPanicCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestwordendObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
 
 /*
  * External (platform specific) initialization routine:
@@ -185,7 +199,9 @@ int
 Tcltest_Init(interp)
     Tcl_Interp *interp;		/* Interpreter for application. */
 {
-    if (Tcl_PkgProvide(interp, "Tcltest", "7.5") == TCL_ERROR) {
+    Tcl_ValueType t3ArgTypes[2];
+	
+    if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
         return TCL_ERROR;
     }
 
@@ -193,16 +209,24 @@ Tcltest_Init(interp)
      * Create additional commands and math functions for testing Tcl.
      */
 
+    Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testchannel", TclTestChannelCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testchannelevent", TclTestChannelEventCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0,
@@ -214,22 +238,28 @@ Tcltest_Init(interp)
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testfhandle", TestfhandleCmd,
+    Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
+    Tcl_CreateCommand(interp, "testfile", TestfileCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testgetvarfullname",
+	    TestgetvarfullnameCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testmodal", TestmodalCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testsetnoerr", TestsetnoerrCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testsetobjerrorcode", 
+	    TestsetobjerrorcodeCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
@@ -239,16 +269,22 @@ Tcltest_Init(interp)
             (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testwordend", TestwordendCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testwordend", TestwordendObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
             (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testpanic", TestPanicCmd, (ClientData) 0,
             (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateMathFunc(interp, "T1", 0, (Tcl_ValueType *) NULL, TestMathFunc,
 	    (ClientData) 123);
     Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc,
 	    (ClientData) 345);
+    t3ArgTypes[0] = TCL_EITHER;
+    t3ArgTypes[1] = TCL_EITHER;
+    Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
+	    (ClientData) 0);
 
     /*
      * And finally add any platform specific test commands.
@@ -285,10 +321,11 @@ TestasyncCmd(dummy, interp, argc, argv)
     TestAsyncHandler *asyncPtr, *prevPtr;
     int id, code;
     static int nextId = 1;
+    char buf[30];
 
     if (argc < 2) {
 	wrongNumArgs:
-	interp->result = "wrong # args";
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
@@ -304,7 +341,8 @@ TestasyncCmd(dummy, interp, argc, argv)
 	strcpy(asyncPtr->command, argv[2]);
 	asyncPtr->nextPtr = firstHandler;
 	firstHandler = asyncPtr;
-	sprintf(interp->result, "%d", asyncPtr->id);
+	sprintf(buf, "%d", asyncPtr->id);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "delete") == 0) {
 	if (argc == 2) {
 	    while (firstHandler != NULL) {
@@ -427,7 +465,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
 	Tcl_DStringResult(interp, &delString);
     } else if (strcmp(argv[1], "get") == 0) {
 	if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
-	    interp->result = "??";
+	    Tcl_SetResult(interp, "??", TCL_STATIC);
 	    return TCL_OK;
 	}
 	if (info.proc == CmdProc1) {
@@ -448,15 +486,24 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
 	} else {
 	    Tcl_AppendResult(interp, " unknown", (char *) NULL);
 	}
+	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName,
+	        (char *) NULL);
+	if (info.isNativeObjectProc) {
+	    Tcl_AppendResult(interp, " nativeObjectProc", (char *) NULL);
+	} else {
+	    Tcl_AppendResult(interp, " stringProc", (char *) NULL);
+	}
     } else if (strcmp(argv[1], "modify") == 0) {
 	info.proc = CmdProc2;
 	info.clientData = (ClientData) "new_command_data";
+	info.objProc = NULL;
+        info.objClientData = (ClientData) NULL;
 	info.deleteProc = CmdDelProc2;
 	info.deleteData = (ClientData) "new_delete_data";
 	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
-	    interp->result = "0";
+	    Tcl_SetResult(interp, "0", TCL_STATIC);
 	} else {
-	    interp->result = "1";
+	    Tcl_SetResult(interp, "1", TCL_STATIC);
 	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -516,8 +563,9 @@ CmdDelProc2(clientData)
  *
  * TestcmdtokenCmd --
  *
- *	This procedure implements the "testcmdtoken" command.  It is used
- *	to test Tcl_Command tokens and Tcl_GetCommandName.
+ *	This procedure implements the "testcmdtoken" command. It is used
+ *	to test Tcl_Command tokens and procedures such as
+ *	Tcl_GetCommandFullName.
  *
  * Results:
  *	A standard Tcl result.
@@ -538,6 +586,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
 {
     Tcl_Command token;
     long int l;
+    char buf[30];
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -547,14 +596,25 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
     if (strcmp(argv[1], "create") == 0) {
 	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
 		(ClientData) "original", (Tcl_CmdDeleteProc *) NULL);
-	sprintf(interp->result, "%lx", (long int) token);
+	sprintf(buf, "%lx", (long int) token);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "name") == 0) {
+	Tcl_Obj *objPtr;
+	
 	if (sscanf(argv[2], "%lx", &l) != 1) {
 	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
 		    "\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
-	interp->result = Tcl_GetCommandName(interp, (Tcl_Command) l);
+
+	objPtr = Tcl_NewObj();
+	Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
+	
+	Tcl_AppendElement(interp,
+	        Tcl_GetCommandName(interp, (Tcl_Command) l));
+	Tcl_AppendElement(interp,
+		Tcl_GetStringFromObj(objPtr, (int *) NULL));
+	Tcl_DecrRefCount(objPtr);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
 		"\": must be create or name", (char *) NULL);
@@ -566,6 +626,103 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
+ * TestcreatecommandCmd --
+ *
+ *	This procedure implements the "testcreatecommand" command. It is
+ *	used to test that the Tcl_CreateCommand creates a new command in
+ *	the namespace specified as part of its name, if any. It also
+ *	checks that the namespace code ignore single ":"s in the middle
+ *	or end of a command name.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes two commands ("test_ns_basic::createdcommand"
+ *	and "value:at:").
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestcreatecommandCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "create") == 0) {
+	Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
+		CreatedCommandProc, (ClientData) NULL,
+		(Tcl_CmdDeleteProc *) NULL);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand");
+    } else if (strcmp(argv[1], "create2") == 0) {
+	Tcl_CreateCommand(interp, "value:at:",
+		CreatedCommandProc2, (ClientData) NULL,
+		(Tcl_CmdDeleteProc *) NULL);
+    } else if (strcmp(argv[1], "delete2") == 0) {
+	Tcl_DeleteCommand(interp, "value:at:");
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be create, delete, create2, or delete2",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+static int
+CreatedCommandProc(clientData, interp, argc, argv)
+    ClientData clientData;		/* String to return. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_CmdInfo info;
+    int found;
+
+    found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand",
+	    &info);
+    if (!found) {
+	Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
+	        (char *) NULL);
+	return TCL_ERROR;
+    }
+    Tcl_AppendResult(interp, "CreatedCommandProc in ",
+	    info.namespacePtr->fullName, (char *) NULL);
+    return TCL_OK;
+}
+
+static int
+CreatedCommandProc2(clientData, interp, argc, argv)
+    ClientData clientData;		/* String to return. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_CmdInfo info;
+    int found;
+
+    found = Tcl_GetCommandInfo(interp, "value:at:", &info);
+    if (!found) {
+	Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
+	        (char *) NULL);
+	return TCL_ERROR;
+    }
+    Tcl_AppendResult(interp, "CreatedCommandProc2 in ",
+	    info.namespacePtr->fullName, (char *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestdcallCmd --
  *
  *	This procedure implements the "testdcall" command.  It is used
@@ -658,7 +815,7 @@ TestdelCmd(dummy, interp, argc, argv)
     Tcl_Interp *slave;
 
     if (argc != 4) {
-	interp->result = "wrong # args";
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
 	return TCL_ERROR;
     }
 
@@ -767,7 +924,7 @@ TestdstringCmd(dummy, interp, argc, argv)
 
     if (argc < 2) {
 	wrongNumArgs:
-	interp->result = "wrong # args";
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "append") == 0) {
@@ -797,18 +954,17 @@ TestdstringCmd(dummy, interp, argc, argv)
 	if (argc != 2) {
 	    goto wrongNumArgs;
 	}
-	interp->result = Tcl_DStringValue(&dstring);
+	Tcl_SetResult(interp, Tcl_DStringValue(&dstring), TCL_VOLATILE);
     } else if (strcmp(argv[1], "gresult") == 0) {
 	if (argc != 3) {
 	    goto wrongNumArgs;
 	}
 	if (strcmp(argv[2], "staticsmall") == 0) {
-	    interp->result = "short";
+	    Tcl_SetResult(interp, "short", TCL_STATIC);
 	} else if (strcmp(argv[2], "staticlarge") == 0) {
-	    interp->result = "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n";
+	    Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
 	} else if (strcmp(argv[2], "free") == 0) {
-	    interp->result = (char *) ckalloc(100);
-	    interp->freeProc = TCL_DYNAMIC;
+	    Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
 	    strcpy(interp->result, "This is a malloc-ed string");
 	} else if (strcmp(argv[2], "special") == 0) {
 	    interp->result = (char *) ckalloc(100);
@@ -823,10 +979,13 @@ TestdstringCmd(dummy, interp, argc, argv)
 	}
 	Tcl_DStringGetResult(interp, &dstring);
     } else if (strcmp(argv[1], "length") == 0) {
+	char buf[30];
+	
 	if (argc != 2) {
 	    goto wrongNumArgs;
 	}
-	sprintf(interp->result, "%d", Tcl_DStringLength(&dstring));
+	sprintf(buf, "%d", Tcl_DStringLength(&dstring));
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "result") == 0) {
 	if (argc != 2) {
 	    goto wrongNumArgs;
@@ -936,123 +1095,10 @@ ExitProcEven(clientData)
 /*
  *----------------------------------------------------------------------
  *
- * TestfhandleCmd --
- *
- *	This procedure implements the "testfhandle" command.  It is
- *	used to test Tcl_GetFile, Tcl_FreeFile, and
- *	Tcl_GetFileInfo.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestfhandleCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
-{
-#define MAX_FHANDLES 10
-    static Tcl_File testHandles[MAX_FHANDLES];
-    static initialized = 0;
-
-    int i, index, type;
-    ClientData data;
-
-    if (!initialized) {
-	for (i = 0; i < MAX_FHANDLES; i++) {
-	    testHandles[i] = NULL;
-	}
-	initialized = 1;
-    }
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " option ... \"", (char *) NULL);
-        return TCL_ERROR;
-    }
-    index = -1;
-    if (argc >= 3) {
-	if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (index >= MAX_FHANDLES) {
-	    Tcl_AppendResult(interp, "bad index ", argv[2], (char *) NULL);
-	    return TCL_ERROR;
-	}
-    }
-    if (strcmp(argv[1], "compare") == 0) {
-	int index2;
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		    argv[0], " index index\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetInt(interp, argv[3], (int *) &index2) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (testHandles[index] == testHandles[index2]) {
-	    sprintf(interp->result, "equal");
-	} else {
-	    sprintf(interp->result, "notequal");
-	}
-    } else if (strcmp(argv[1], "get") == 0) {
-	if (argc != 5) {
-	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		    argv[0], " index data type\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetInt(interp, argv[3], (int *) &data) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetInt(interp, argv[4], &type) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	testHandles[index] = Tcl_GetFile(data, type);
-    } else if (strcmp(argv[1], "free") == 0) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		    argv[0], " index\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_FreeFile(testHandles[index]);
-    } else if (strcmp(argv[1], "info1") == 0) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		    argv[0], " index\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	data = Tcl_GetFileInfo(testHandles[index], NULL);
-	sprintf(interp->result, "%d", (int)data);
-    } else if (strcmp(argv[1], "info2") == 0) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		    argv[0], " index\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	data = Tcl_GetFileInfo(testHandles[index], &type);
-	sprintf(interp->result, "%d %d", (int)data, type);
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be compare, get, free, info1, or info2",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestfilewaitCmd --
+ * TestexprlongCmd --
  *
- *	This procedure implements the "testfilewait" command. It is
- *	used to test TclWaitForFile.
+ *	This procedure verifies that Tcl_ExprLong does not modify the
+ *	interpreter result if there is no error.
  *
  * Results:
  *	A standard Tcl result.
@@ -1064,52 +1110,23 @@ TestfhandleCmd(clientData, interp, argc, argv)
  */
 
 static int
-TestfilewaitCmd(clientData, interp, argc, argv)
+TestexprlongCmd(clientData, interp, argc, argv)
     ClientData clientData;		/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
     int argc;				/* Number of arguments. */
     char **argv;			/* Argument strings. */
 {
-    int mask, result, timeout;
-    Tcl_Channel channel;
-    Tcl_File file;
-
-    if (argc != 4) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		" file readable|writable|both timeout\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-    channel = Tcl_GetChannel(interp, argv[1], NULL);
-    if (channel == NULL) {
-	return TCL_ERROR;
-    }
-    if (strcmp(argv[2], "readable") == 0) {
-	mask = TCL_READABLE;
-    } else if (strcmp(argv[2], "writable") == 0){
-	mask = TCL_WRITABLE;
-    } else if (strcmp(argv[2], "both") == 0){
-	mask = TCL_WRITABLE|TCL_READABLE;
-    } else {
-	Tcl_AppendResult(interp, "bad argument \"", argv[2],
-		"\": must be readable, writable, or both", (char *) NULL);
-	return TCL_ERROR;
-    }
-    file = Tcl_GetChannelFile(channel, 
-	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE);
-    if (file == NULL) {
-	interp->result = "couldn't get channel file";
-	return TCL_ERROR;
-    }
-    if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    result = TclWaitForFile(file, mask, timeout);
-    if (result & TCL_READABLE) {
-	Tcl_AppendElement(interp, "readable");
-    }
-    if (result & TCL_WRITABLE) {
-	Tcl_AppendElement(interp, "writable");
+    long exprResult;
+    char buf[30];
+    int result;
+    
+    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    result = Tcl_ExprLong(interp, "4+1", &exprResult);
+    if (result != TCL_OK) {
+        return result;
     }
+    sprintf(buf, ": %ld", exprResult);
+    Tcl_AppendResult(interp, buf, NULL);
     return TCL_OK;
 }
 
@@ -1330,7 +1347,7 @@ TestlinkCmd(dummy, interp, argc, argv)
     } else if (strcmp(argv[1], "get") == 0) {
 	sprintf(buffer, "%d", intVar);
 	Tcl_AppendElement(interp, buffer);
-	Tcl_PrintDouble(interp, realVar, buffer);
+	Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
 	Tcl_AppendElement(interp, buffer);
 	sprintf(buffer, "%d", boolVar);
 	Tcl_AppendElement(interp, buffer);
@@ -1447,113 +1464,101 @@ TestMathFunc(clientData, interp, args, resultPtr)
 /*
  *----------------------------------------------------------------------
  *
- * CleanupTestSetassocdataTests --
+ * TestMathFunc2 --
  *
- *	This function is called when an interpreter is deleted to clean
- *	up any data left over from running the testsetassocdata command.
+ *	This is a user-defined math procedure to test out math procedures
+ *	that do have arguments, in this case 2.
  *
  * Results:
- *	None.
+ *	A normal Tcl completion code.
  *
  * Side effects:
- *	Releases storage.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
+
 	/* ARGSUSED */
-static void
-CleanupTestSetassocdataTests(clientData, interp)
-    ClientData clientData;		/* Data to be released. */
-    Tcl_Interp *interp;			/* Interpreter being deleted. */
+static int
+TestMathFunc2(clientData, interp, args, resultPtr)
+    ClientData clientData;		/* Integer value to return. */
+    Tcl_Interp *interp;			/* Used to report errors. */
+    Tcl_Value *args;			/* Points to an array of two
+					 * Tcl_Values for the two
+					 * arguments. */
+    Tcl_Value *resultPtr;		/* Where to store the result. */
 {
-    ckfree((char *) clientData);
+    int result = TCL_OK;
+    
+    /*
+     * Return the maximum of the two arguments with the correct type.
+     */
+    
+    if (args[0].type == TCL_INT) {
+	int i0 = args[0].intValue;
+	
+	if (args[1].type == TCL_INT) {
+	    int i1 = args[1].intValue;
+	    
+	    resultPtr->type = TCL_INT;
+	    resultPtr->intValue = ((i0 > i1)? i0 : i1);
+	} else if (args[1].type == TCL_DOUBLE) {
+	    double d0 = i0;
+	    double d1 = args[1].doubleValue;
+
+	    resultPtr->type = TCL_DOUBLE;
+	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+	} else {
+	    Tcl_SetResult(interp, "T2: wrong type for arg 2", TCL_STATIC);
+	    result = TCL_ERROR;
+	}
+    } else if (args[0].type == TCL_DOUBLE) {
+	double d0 = args[0].doubleValue;
+	
+	if (args[1].type == TCL_INT) {
+	    double d1 = args[1].intValue;
+	    
+	    resultPtr->type = TCL_DOUBLE;
+	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+	} else if (args[1].type == TCL_DOUBLE) {
+	    double d1 = args[1].doubleValue;
+
+	    resultPtr->type = TCL_DOUBLE;
+	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+	} else {
+	    Tcl_SetResult(interp, "T2: wrong type for arg 2", TCL_STATIC);
+	    result = TCL_ERROR;
+	}
+    } else {
+	Tcl_SetResult(interp, "T2: wrong type for arg 1", TCL_STATIC);
+	result = TCL_ERROR;
+    }
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TestmodalCmd --
+ * CleanupTestSetassocdataTests --
  *
- *	This procedure implements the "testmodal" command. It is used
- *	to test modal timeouts created by Tcl_CreateModalTimeout.
+ *	This function is called when an interpreter is deleted to clean
+ *	up any data left over from running the testsetassocdata command.
  *
  * Results:
- *	A standard Tcl result.
+ *	None.
  *
  * Side effects:
- *	Modifies or creates an association between a key and associated
- *	data for this interpreter.
+ *	Releases storage.
  *
  *----------------------------------------------------------------------
  */
-
-static int
-TestmodalCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
-{
-#define NUM_MODALS 10
-    static Modal modals[NUM_MODALS];
-    static int numModals = 0;
-    int ms;
-
-    if (argc < 2) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " option ?arg arg ...?\"", (char *) NULL);
-        return TCL_ERROR;
-    }
-
-    if (strcmp(argv[1], "create") == 0) {
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		    " create ms key\"", (char *) NULL);
-	    return TCL_ERROR;
-	}
-	if (numModals >= NUM_MODALS) {
-	    interp->result = "too many modal timeouts";
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetInt(interp, argv[2], &ms) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	modals[numModals].interp = interp;
-	modals[numModals].key = (char *) ckalloc((unsigned)
-		(strlen(argv[3]) + 1));
-	strcpy(modals[numModals].key, argv[3]);
-	Tcl_CreateModalTimeout(ms, ModalTimeoutProc,
-		(ClientData) &modals[numModals]);
-	numModals += 1;
-    } else if (strcmp(argv[1], "delete") == 0) {
-	if (numModals == 0) {
-	    interp->result = "no more modal timeouts";
-	    return TCL_ERROR;
-	}
-	numModals -= 1;
-	ckfree(modals[numModals].key);
-	Tcl_DeleteModalTimeout(ModalTimeoutProc,
-		(ClientData) &modals[numModals]);
-    } else if (strcmp(argv[1], "event") == 0) {
-	Tcl_DoOneEvent(TCL_TIMER_EVENTS|TCL_DONT_WAIT);
-    } else if (strcmp(argv[1], "eventnotimers") == 0) {
-	Tcl_DoOneEvent(0x100000|TCL_DONT_WAIT);
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, event, or eventnotimers",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
+	/* ARGSUSED */
 static void
-ModalTimeoutProc(clientData)
-    ClientData clientData;	/* Pointer to Modal structure. */
+CleanupTestSetassocdataTests(clientData, interp)
+    ClientData clientData;		/* Data to be released. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
 {
-    Modal *modalPtr = (Modal *) clientData;
-    Tcl_SetVar(modalPtr->interp, "x", modalPtr->key,
-	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+    ckfree((char *) clientData);
 }
 
 /*
@@ -1582,6 +1587,8 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
     char **argv;			/* Argument strings. */
 {
     char *buf;
+    char *oldData;
+    Tcl_InterpDeleteProc *procPtr;
     
     if (argc != 3) {
         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
@@ -1591,6 +1598,16 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
 
     buf = ckalloc((unsigned) strlen(argv[2]) + 1);
     strcpy(buf, argv[2]);
+
+    /*
+     * If we previously associated a malloced value with the variable,
+     * free it before associating a new value.
+     */
+
+    oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr);
+    if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
+	ckfree(oldData);
+    }
     
     Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, 
 	(ClientData) buf);
@@ -1770,6 +1787,8 @@ TestupvarCmd(dummy, interp, argc, argv)
     int argc;				/* Number of arguments. */
     char **argv;			/* Argument strings. */
 {
+    int flags = 0;
+    
     if ((argc != 5) && (argc != 6)) {
 	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
 		argv[0], " level name ?name2? dest global\"", (char *) NULL);
@@ -1777,12 +1796,21 @@ TestupvarCmd(dummy, interp, argc, argv)
     }
 
     if (argc == 5) {
-	return Tcl_UpVar(interp, argv[1], argv[2], argv[3],
-		(strcmp(argv[4], "global") == 0) ? TCL_GLOBAL_ONLY : 0);
+	if (strcmp(argv[4], "global") == 0) {
+	    flags = TCL_GLOBAL_ONLY;
+	} else if (strcmp(argv[4], "namespace") == 0) {
+	    flags = TCL_NAMESPACE_ONLY;
+	}
+	return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags);
     } else {
+	if (strcmp(argv[5], "global") == 0) {
+	    flags = TCL_GLOBAL_ONLY;
+	} else if (strcmp(argv[5], "namespace") == 0) {
+	    flags = TCL_NAMESPACE_ONLY;
+	}
 	return Tcl_UpVar2(interp, argv[1], argv[2], 
 		(argv[3][0] == 0) ? (char *) NULL : argv[3], argv[4],
-		(strcmp(argv[5], "global") == 0) ? TCL_GLOBAL_ONLY : 0);
+		flags);
     }
 }
 
@@ -1805,24 +1833,70 @@ TestupvarCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestwordendCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+TestwordendObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
 {
-    if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		argv[0], " string\"", (char *) NULL);
+    Tcl_Obj *objPtr;
+    char *string, *end;
+    int length;
+
+    if (objc != 2) {
+    	Tcl_WrongNumArgs(interp, 1, objv, "string");
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, TclWordEnd(argv[1], 0, (int *) NULL), TCL_VOLATILE);
+    objPtr = Tcl_GetObjResult(interp);
+    string = Tcl_GetStringFromObj(objv[1], &length);
+    end = TclWordEnd(string, string+length, 0, NULL);
+    Tcl_AppendToObj(objPtr, end, length - (end - string));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * TestsetobjerrorcodeCmd --
+ *
+ *	This procedure implements the "testsetobjerrorcodeCmd".
+ *	This tests up to five elements passed to the
+ *	Tcl_SetObjErrorCode command.
+ *
+ * Results:
+ *	A standard Tcl result. Always returns TCL_ERROR so that
+ *	the error code can be tested.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestsetobjerrorcodeCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    Tcl_Obj *listObjPtr;
+
+    if (objc > 1) {
+	listObjPtr = Tcl_ConcatObj(objc - 1, objv + 1);
+    } else {
+	listObjPtr = Tcl_NewObj();
+    }
+    Tcl_IncrRefCount(listObjPtr);
+    Tcl_SetObjErrorCode(interp, listObjPtr);
+    Tcl_DecrRefCount(listObjPtr);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestfeventCmd --
  *
  *	This procedure implements the "testfevent" command.  It is
@@ -1930,3 +2004,500 @@ TestPanicCmd(dummy, interp, argc, argv)
  
     return TCL_OK;
 }
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TestchmodCmd --
+ *
+ *	Implements the "testchmod" cmd.  Used when testing "file"
+ *	command.  The only attribute used by the Mac and Windows platforms
+ *	is the user write flag; if this is not set, the file is
+ *	made read-only.  Otehrwise, the file is made read-write.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Changes permissions of specified files.
+ *
+ *---------------------------------------------------------------------------
+ */
+ 
+static int
+TestchmodCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int i, mode;
+    char *rest;
+
+    if (argc < 2) {
+	usage:
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" mode file ?file ...?", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    mode = (int) strtol(argv[1], &rest, 8);
+    if (*rest != '\0') {
+	goto usage;
+    }
+
+    for (i = 2; i < argc; i++) {
+        Tcl_DString buffer;
+        
+        argv[i] = Tcl_TranslateFileName(interp, argv[i], &buffer);
+        if (argv[i] == NULL) {
+            return TCL_ERROR;
+        }
+	if (chmod(argv[i], (unsigned) mode) != 0) {
+	    Tcl_AppendResult(interp, argv[i], ": ", Tcl_PosixError(interp),
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+        Tcl_DStringFree(&buffer);
+    }
+    return TCL_OK;
+}
+
+static int
+TestfileCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int force, i, j, result;
+    Tcl_DString error, name[2];
+    
+    if (argc < 3) {
+	return TCL_ERROR;
+    }
+
+    force = 0;
+    i = 2;
+    if (strcmp(argv[2], "-force") == 0) {
+        force = 1;
+	i = 3;
+    }
+
+    Tcl_DStringInit(&name[0]);
+    Tcl_DStringInit(&name[1]);
+    Tcl_DStringInit(&error);
+
+    if (argc - i > 2) {
+	return TCL_ERROR;
+    }
+
+    for (j = i; j < argc; j++) {
+        argv[j] = Tcl_TranslateFileName(interp, argv[j], &name[j - i]);
+	if (argv[j] == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+
+    if (strcmp(argv[1], "mv") == 0) {
+	result = TclpRenameFile(argv[i], argv[i + 1]);
+    } else if (strcmp(argv[1], "cp") == 0) {
+        result = TclpCopyFile(argv[i], argv[i + 1]);
+    } else if (strcmp(argv[1], "rm") == 0) {
+        result = TclpDeleteFile(argv[i]);
+    } else if (strcmp(argv[1], "mkdir") == 0) {
+        result = TclpCreateDirectory(argv[i]);
+    } else if (strcmp(argv[1], "cpdir") == 0) {
+        result = TclpCopyDirectory(argv[i], argv[i + 1], &error);
+    } else if (strcmp(argv[1], "rmdir") == 0) {
+        result = TclpRemoveDirectory(argv[i], force, &error);
+    } else {
+        result = TCL_ERROR;
+	goto end;
+    }
+	
+    if (result != TCL_OK) {
+	if (Tcl_DStringValue(&error)[0] != '\0') {
+	    Tcl_AppendResult(interp, Tcl_DStringValue(&error), " ", NULL);
+	}
+	Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL);
+    }
+
+    end:
+    Tcl_DStringFree(&error);
+    Tcl_DStringFree(&name[0]);
+    Tcl_DStringFree(&name[1]);
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetvarfullnameCmd --
+ *
+ *	Implements the "testgetvarfullname" cmd that is used when testing
+ *	the Tcl_GetVariableFullName procedure.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetvarfullnameCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    char *name, *arg;
+    int flags = 0;
+    Tcl_Namespace *namespacePtr;
+    Tcl_CallFrame frame;
+    Tcl_Var variable;
+    int result;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name scope");
+        return TCL_ERROR;
+    }
+    
+    name = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+
+    arg = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    if (strcmp(arg, "global") == 0) {
+	flags = TCL_GLOBAL_ONLY;
+    } else if (strcmp(arg, "namespace") == 0) {
+	flags = TCL_NAMESPACE_ONLY;
+    }
+
+    /*
+     * This command, like any other created with Tcl_Create[Obj]Command,
+     * runs in the global namespace. As a "namespace-aware" command that
+     * needs to run in a particular namespace, it must activate that
+     * namespace itself.
+     */
+
+    if (flags == TCL_NAMESPACE_ONLY) {
+	namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var",
+	        (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
+	if (namespacePtr == NULL) {
+	    return TCL_ERROR;
+	}
+	result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+                /*isProcCallFrame*/ 0);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    
+    variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL,
+	    (flags | TCL_LEAVE_ERR_MSG));
+
+    if (flags == TCL_NAMESPACE_ONLY) {
+	Tcl_PopCallFrame(interp);
+    }
+    if (variable == (Tcl_Var) NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTimesCmd --
+ *
+ *	This procedure implements the "gettimes" command.  It is
+ *	used for computing the time needed for various basic operations
+ *	such as reading variables, allocating memory, sprintf, converting
+ *	variables, etc.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Allocates and frees memory, sets a variable "a" in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetTimesCmd(unused, interp, argc, argv)
+    ClientData unused;		/* Unused. */
+    Tcl_Interp *interp;		/* The current interpreter. */
+    int argc;			/* The number of arguments. */
+    char **argv;		/* The argument strings. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int i, n;
+    double timePer;
+    Tcl_Time start, stop;
+    Tcl_Obj *objPtr;
+    Tcl_Obj **objv;
+    char *s;
+    char newString[30];
+
+    /* alloc & free 100000 times */
+    fprintf(stderr, "alloc & free 100000 6 word items\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
+	ckfree((char *) objPtr);
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);
+    
+    /* alloc 5000 times */
+    fprintf(stderr, "alloc 5000 6 word items\n");
+    objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
+    TclpGetTime(&start);
+    for (i = 0;  i < 5000;  i++) {
+	objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);
+    
+    /* free 5000 times */
+    fprintf(stderr, "free 5000 6 word items\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 5000;  i++) {
+	ckfree((char *) objv[i]);
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per free\n", timePer/5000);
+
+    /* Tcl_NewObj 5000 times */
+    fprintf(stderr, "Tcl_NewObj 5000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 5000;  i++) {
+	objv[i] = Tcl_NewObj();
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per Tcl_NewObj\n", timePer/5000);
+    
+    /* Tcl_DecrRefCount 5000 times */
+    fprintf(stderr, "Tcl_DecrRefCount 5000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 5000;  i++) {
+	objPtr = objv[i];
+	Tcl_DecrRefCount(objPtr);
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
+    ckfree((char *) objv);
+
+    /* TclGetStringFromObj 100000 times */
+    fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
+    objPtr = Tcl_NewStringObj("12345", -1);
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	(void) TclGetStringFromObj(objPtr, &n);
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per TclGetStringFromObj of \"12345\"\n",
+	    timePer/100000);
+
+    /* Tcl_GetIntFromObj 100000 times */
+    fprintf(stderr, "Tcl_GetIntFromObj of \"12345\" 100000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	if (Tcl_GetIntFromObj(interp, objPtr, &n) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per Tcl_GetIntFromObj of \"12345\"\n",
+	    timePer/100000);
+    Tcl_DecrRefCount(objPtr);
+    
+    /* Tcl_GetInt 100000 times */
+    fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	if (Tcl_GetInt(interp, "12345", &n) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per Tcl_GetInt of \"12345\"\n",
+	    timePer/100000);
+
+    /* sprintf 100000 times */
+    fprintf(stderr, "sprintf of 12345 100000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	sprintf(newString, "%d", 12345);
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per sprintf of 12345\n",
+	    timePer/100000);
+
+    /* hashtable lookup 100000 times */
+    fprintf(stderr, "hashtable lookup of \"gettimes\" 100000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	(void) Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable, "gettimes");
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per hashtable lookup of \"gettimes\"\n",
+	    timePer/100000);
+
+    /* Tcl_SetVar 100000 times */
+    fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG);
+	if (s == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per Tcl_SetVar of a to \"12345\"\n",
+	    timePer/100000);
+
+    /* Tcl_GetVar 100000 times */
+    fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n");
+    TclpGetTime(&start);
+    for (i = 0;  i < 100000;  i++) {
+	s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG);
+	if (s == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    TclpGetTime(&stop);
+    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    fprintf(stderr, "   %.3f usec per Tcl_GetVar of a==\"12345\"\n",
+	    timePer/100000);
+    
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NoopCmd --
+ *
+ *	This procedure is just used to time the overhead involved in
+ *	parsing and invoking a command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NoopCmd(unused, interp, argc, argv)
+    ClientData unused;		/* Unused. */
+    Tcl_Interp *interp;		/* The current interpreter. */
+    int argc;			/* The number of arguments. */
+    char **argv;		/* The argument strings. */
+{
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NoopObjCmd --
+ *
+ *	This object-based procedure is just used to time the overhead
+ *	involved in parsing and invoking a command.
+ *
+ * Results:
+ *	Returns the TCL_OK result code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NoopObjCmd(unused, interp, objc, objv)
+    ClientData unused;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetnoerrCmd --
+ *
+ *	Implements the "testsetnoerr" cmd that is used when testing
+ *	the Tcl_Set/GetVar C Api without TCL_LEAVE_ERR_MSG flag
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestsetnoerrCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    char *value;
+    if (argc == 2) {
+	Tcl_SetResult(interp, "before get", TCL_STATIC);
+	value = Tcl_GetVar2(interp, argv[1], (char *) NULL, TCL_PARSE_PART1);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, value, TCL_VOLATILE);
+	return TCL_OK;
+    } else if (argc == 3) {
+	char *m1 = "before set";
+	char *message=Tcl_Alloc(strlen(m1)+1);
+	
+	strcpy(message,m1);
+
+	Tcl_SetResult(interp, message, TCL_DYNAMIC);
+
+	value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
+		            TCL_PARSE_PART1);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, value, TCL_VOLATILE);
+	return TCL_OK;
+    } else {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " varName ?newValue?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+}
+
diff --git a/contrib/tcl/generic/tclTestObj.c b/contrib/tcl/generic/tclTestObj.c
new file mode 100644
index 0000000..86adc2d
--- /dev/null
+++ b/contrib/tcl/generic/tclTestObj.c
@@ -0,0 +1,1097 @@
+/* 
+ * tclTestObj.c --
+ *
+ *	This file contains C command procedures for the additional Tcl
+ *	commands that are used for testing implementations of the Tcl object
+ *	types. These commands are not normally included in Tcl
+ *	applications; they're only used for testing.
+ *
+ * Copyright (c) 1995, 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.
+ *
+ * SCCS: @(#) tclTestObj.c 1.27 97/05/19 17:37:31
+ */
+
+#include "tclInt.h"
+
+/*
+ * An array of Tcl_Obj pointers used in the commands that operate on or get
+ * the values of Tcl object-valued variables. varPtr[i] is the i-th
+ * variable's Tcl_Obj *.
+ */
+
+#define NUMBER_OF_OBJECT_VARS 20
+static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int		CheckIfVarUnset _ANSI_ARGS_((Tcl_Interp *interp,
+			    int varIndex));
+static int		GetVariableIndex _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int *indexPtr));
+static void		SetVarToObj _ANSI_ARGS_((int varIndex,
+			    Tcl_Obj *objPtr));
+int			TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+static int		TestbooleanobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		TestconvertobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		TestdoubleobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		TestindexobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		TestintobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		TestobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjTest_Init --
+ *
+ *	This procedure creates additional commands that are used to test the
+ *	Tcl object support.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code, and leaves an error
+ *	message in interp->result if an error occurs.
+ *
+ * Side effects:
+ *	Creates and registers several new testing commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjTest_Init(interp)
+    Tcl_Interp *interp;
+{
+    register int i;
+    
+    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
+        varPtr[i] = NULL;
+    }
+	
+    Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestbooleanobjCmd --
+ *
+ *	This procedure implements the "testbooleanobj" command.  It is used
+ *	to test the boolean Tcl object type implementation.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates and frees boolean objects, and also converts objects to
+ *	have boolean type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestbooleanobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int varIndex, boolValue, length;
+    char *index, *subCmd;
+
+    if (objc < 3) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    index = Tcl_GetStringFromObj(objv[2], &length);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    if (strcmp(subCmd, "set") == 0) {
+	if (objc != 4) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * If the object currently bound to the variable with index varIndex
+	 * has ref count 1 (i.e. the object is unshared) we can modify that
+	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
+	 * we must create a new object to modify/set and decrement the old
+	 * formerly-shared object's ref count. This is "copy on write".
+	 */
+
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "get") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "not") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
+				  &boolValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"\": must be set, get, or not", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestconvertobjCmd --
+ *
+ *	This procedure implements the "testconvertobj" command. It is used
+ *	to test converting objects to new types.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Converts objects to new types.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestconvertobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int length;
+    char *subCmd;
+    char buf[20];
+
+    if (objc < 3) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    if (strcmp(subCmd, "double") == 0) {
+	double d;
+
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	sprintf(buf, "%f", d);
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"\": must be double", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdoubleobjCmd --
+ *
+ *	This procedure implements the "testdoubleobj" command.  It is used
+ *	to test the double-precision floating point Tcl object type
+ *	implementation.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates and frees double objects, and also converts objects to
+ *	have double type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestdoubleobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int varIndex, length;
+    double doubleValue;
+    char *index, *subCmd, *string;
+	
+    if (objc < 3) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    index = Tcl_GetStringFromObj(objv[2], &length);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    if (strcmp(subCmd, "set") == 0) {
+	if (objc != 4) {
+	    goto wrongNumArgs;
+	}
+	string = Tcl_GetStringFromObj(objv[3], &length);
+	if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * If the object currently bound to the variable with index varIndex
+	 * has ref count 1 (i.e. the object is unshared) we can modify that
+	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
+	 * we must create a new object to modify/set and decrement the old
+	 * formerly-shared object's ref count. This is "copy on write".
+	 */
+
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "get") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "mult10") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
+				 &doubleValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "div10") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
+				 &doubleValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"\": must be set, get, mult10, or div10", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestindexobjCmd --
+ *
+ *	This procedure implements the "testindexobj" command. It is used to
+ *	test the index Tcl object type implementation.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates and frees int objects, and also converts objects to
+ *	have int type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestindexobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int allowAbbrev, index, index2, setError, i, dummy, result;
+    char **argv;
+    static char *tablePtr[] = {"a", "b", "check", (char *) NULL};
+
+    if ((objc == 3) && (strcmp(Tcl_GetStringFromObj(objv[1], &dummy),
+	    "check") == 0)) {
+	/*
+	 * This code checks to be sure that the results of
+	 * Tcl_GetIndexFromObj are properly cached in the object and
+	 * returned on subsequent lookups.
+	 */
+
+	Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
+		"token", 0, &index);
+	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	objv[1]->internalRep.twoPtrValue.ptr2 = (VOID *) index2;
+	result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
+		tablePtr, "token", 0, &index);
+	if (result == TCL_OK) {
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+	}
+	return result;
+    }
+
+    if (objc < 5) {
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    argv = (char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
+    for (i = 4; i < objc; i++) {
+	argv[i-4] = Tcl_GetStringFromObj(objv[i], &dummy);
+    }
+    argv[objc-4] = NULL;
+    result = Tcl_GetIndexFromObj(setError ? interp : NULL, objv[3],
+	    argv, "token", allowAbbrev ? 0 : TCL_EXACT, &index);
+    ckfree((char *) argv);
+    if (result == TCL_OK) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestintobjCmd --
+ *
+ *	This procedure implements the "testintobj" command. It is used to
+ *	test the int Tcl object type implementation.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates and frees int objects, and also converts objects to
+ *	have int type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestintobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int intValue, varIndex, length, i;
+    long longValue;
+    char *index, *subCmd, *string;
+	
+    if (objc < 3) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    index = Tcl_GetStringFromObj(objv[2], &length);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    if (strcmp(subCmd, "set") == 0) {
+	if (objc != 4) {
+	    goto wrongNumArgs;
+	}
+	string = Tcl_GetStringFromObj(objv[3], &length);
+	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	intValue = i;
+
+	/*
+	 * If the object currently bound to the variable with index varIndex
+	 * has ref count 1 (i.e. the object is unshared) we can modify that
+	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
+	 * we must create a new object to modify/set and decrement the old
+	 * formerly-shared object's ref count. This is "copy on write".
+	 */
+
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetIntObj(varPtr[varIndex], intValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
+	if (objc != 4) {
+	    goto wrongNumArgs;
+	}
+	string = Tcl_GetStringFromObj(objv[3], &length);
+	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	intValue = i;
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetIntObj(varPtr[varIndex], intValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+	}
+    } else if (strcmp(subCmd, "setlong") == 0) {
+	if (objc != 4) {
+	    goto wrongNumArgs;
+	}
+	string = Tcl_GetStringFromObj(objv[3], &length);
+	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	intValue = i;
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetLongObj(varPtr[varIndex], intValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "setmaxlong") == 0) {
+	long maxLong = LONG_MAX;
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
+	}
+    } else if (strcmp(subCmd, "ismaxlong") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        ((longValue == LONG_MAX)? "1" : "0"), -1);
+    } else if (strcmp(subCmd, "get") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "inttoobigtest") == 0) {
+	/*
+	 * If long ints have more bits than ints on this platform, verify
+	 * that Tcl_GetIntFromObj returns an error if the long int held
+	 * in an integer object's internal representation is too large
+	 * to fit in an int.
+	 */
+	
+	long maxLong = LONG_MAX;
+	
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (INT_MAX == LONG_MAX) { /* int is same size as long int */
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+	} else {
+	    if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+		Tcl_SetLongObj(varPtr[varIndex], maxLong);
+	    } else {
+		SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
+	    }
+	    if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+		return TCL_OK;
+	    }
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
+	}
+    } else if (strcmp(subCmd, "mult10") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
+			      &intValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "div10") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
+			      &intValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"\": must be set, get, mult10, or div10", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestobjCmd --
+ *
+ *	This procedure implements the "testobj" command. It is used to test
+ *	the type-independent portions of the Tcl object type implementation.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates and frees objects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int varIndex, destIndex, i;
+    char *index, *subCmd, *string;
+    Tcl_ObjType *targetType;
+    char buf[20];
+    int length;
+	
+    if (objc < 2) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+
+    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    if (strcmp(subCmd, "assign") == 0) {
+        if (objc != 4) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetStringFromObj(objv[2], &length);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	string = Tcl_GetStringFromObj(objv[3], &length);
+        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        SetVarToObj(destIndex, varPtr[varIndex]);
+	Tcl_SetObjResult(interp, varPtr[destIndex]);
+     } else if (strcmp(subCmd, "convert") == 0) {
+        char *typeName;
+        if (objc != 4) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetStringFromObj(objv[2], &length);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+        typeName = Tcl_GetStringFromObj(objv[3], &length);
+        if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "no type ", typeName, " found", (char *) NULL);
+            return TCL_ERROR;
+        }
+        if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
+            != TCL_OK) {
+            return TCL_ERROR;
+        }
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "duplicate") == 0) {
+        if (objc != 4) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetStringFromObj(objv[2], &length);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	string = Tcl_GetStringFromObj(objv[3], &length);
+        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	Tcl_SetObjResult(interp, varPtr[destIndex]);
+    } else if (strcmp(subCmd, "freeallvars") == 0) {
+        if (objc != 2) {
+            goto wrongNumArgs;
+        }
+        for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
+            if (varPtr[i] != NULL) {
+                Tcl_DecrRefCount(varPtr[i]);
+                varPtr[i] = NULL;
+            }
+        }
+    } else if (strcmp(subCmd, "newobj") == 0) {
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetStringFromObj(objv[2], &length);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        SetVarToObj(varIndex, Tcl_NewObj());
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "refcount") == 0) {
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetStringFromObj(objv[2], &length);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+        sprintf(buf, "%d", varPtr[varIndex]->refCount);
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+    } else if (strcmp(subCmd, "type") == 0) {
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetStringFromObj(objv[2], &length);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+        if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
+        } else {
+            Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                    varPtr[varIndex]->typePtr->name, -1);
+        }
+    } else if (strcmp(subCmd, "types") == 0) {
+        if (objc != 2) {
+            goto wrongNumArgs;
+        }
+	if (Tcl_AppendAllObjTypes(interp, Tcl_GetObjResult(interp)) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad option \"",
+		Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"\": must be assign, convert, duplicate, freeallvars, ",
+		"newobj, objcount, refcount, type, or types",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TeststringobjCmd --
+ *
+ *	This procedure implements the "teststringobj" command. It is used to
+ *	test the string Tcl object type implementation.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates and frees string objects, and also converts objects to
+ *	have string type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TeststringobjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int varIndex, option, i, length;
+#define MAX_STRINGS 10
+    char *index, *string, *strings[MAX_STRINGS+1];
+    static char *options[] = {
+	"append", "appendstrings", "get", "length", "length2",
+	"set", "set2", "setlength", (char *) NULL
+    };
+
+    if (objc < 3) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    index = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch (option) {
+	case 0:				/* append */
+	    if (objc != 5) {
+		goto wrongNumArgs;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (varPtr[varIndex] == NULL) {
+		SetVarToObj(varIndex, Tcl_NewObj());
+	    }
+	    
+	    /*
+	     * If the object bound to variable "varIndex" is shared, we must
+	     * "copy on write" and append to a copy of the object. 
+	     */
+	    
+	    if (Tcl_IsShared(varPtr[varIndex])) {
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	    }
+	    string = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    Tcl_AppendToObj(varPtr[varIndex], string, length);
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    break;
+	case 1:				/* appendstrings */
+	    if (objc > (MAX_STRINGS+3)) {
+		goto wrongNumArgs;
+	    }
+	    if (varPtr[varIndex] == NULL) {
+		SetVarToObj(varIndex, Tcl_NewObj());
+	    }
+
+	    /*
+	     * If the object bound to variable "varIndex" is shared, we must
+	     * "copy on write" and append to a copy of the object. 
+	     */
+
+	    if (Tcl_IsShared(varPtr[varIndex])) {
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	    }
+	    for (i = 3;  i < objc;  i++) {
+		strings[i-3] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	    }
+	    strings[objc-3] = NULL;
+	    Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
+		    strings[2], strings[3], strings[4], strings[5],
+		    strings[6], strings[7], strings[8], strings[9],
+		    strings[10], strings[11]);
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    break;
+	case 2:				/* get */
+	    if (objc != 3) {
+		goto wrongNumArgs;
+	    }
+	    if (CheckIfVarUnset(interp, varIndex)) {
+		return TCL_ERROR;
+	    }
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    break;
+	case 3:				/* length */
+	    if (objc != 3) {
+		goto wrongNumArgs;
+	    }
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
+		    ? varPtr[varIndex]->length : -1);
+	    break;
+	case 4:				/* length2 */
+	    if (objc != 3) {
+		goto wrongNumArgs;
+	    }
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
+		    ? (int) varPtr[varIndex]->internalRep.longValue : -1);
+	    break;
+	case 5:				/* set */
+	    if (objc != 4) {
+		goto wrongNumArgs;
+	    }
+
+	    /*
+	     * If the object currently bound to the variable with index
+	     * varIndex has ref count 1 (i.e. the object is unshared) we
+	     * can modify that object directly. Otherwise, if RC>1 (i.e.
+	     * the object is shared), we must create a new object to
+	     * modify/set and decrement the old formerly-shared object's
+	     * ref count. This is "copy on write".
+	     */
+    
+	    string = Tcl_GetStringFromObj(objv[3], &length);
+	    if ((varPtr[varIndex] != NULL)
+		    && !Tcl_IsShared(varPtr[varIndex])) {
+		Tcl_SetStringObj(varPtr[varIndex], string, length);
+	    } else {
+		SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
+	    }
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    break;
+	case 6:				/* set2 */
+	    if (objc != 4) {
+		goto wrongNumArgs;
+	    }
+	    SetVarToObj(varIndex, objv[3]);
+	    break;
+	case 7:				/* setlength */
+	    if (objc != 4) {
+		goto wrongNumArgs;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (varPtr[varIndex] != NULL) {
+		Tcl_SetObjLength(varPtr[varIndex], length);
+	    }
+	    break;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetVarToObj --
+ *
+ *	Utility routine to assign a Tcl_Obj* to a test variable. The
+ *	Tcl_Obj* can be NULL.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	This routine handles ref counting details for assignment:
+ *	i.e. the old value's ref count must be decremented (if not NULL) and
+ *	the new one incremented (also if not NULL).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetVarToObj(varIndex, objPtr)
+    int varIndex;		/* Designates the assignment variable. */
+    Tcl_Obj *objPtr;		/* Points to object to assign to var. */
+{
+    if (varPtr[varIndex] != NULL) {
+	Tcl_DecrRefCount(varPtr[varIndex]);
+    }
+    varPtr[varIndex] = objPtr;
+    if (objPtr != NULL) {
+	Tcl_IncrRefCount(objPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetVariableIndex --
+ *
+ *	Utility routine to get a test variable index from the command line.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetVariableIndex(interp, string, indexPtr)
+    Tcl_Interp *interp;         /* Interpreter for error reporting. */
+    char *string;               /* String containing a variable index
+				 * specified as a nonnegative number less
+				 * than NUMBER_OF_OBJECT_VARS. */
+    int *indexPtr;              /* Place to store converted result. */
+{
+    int index;
+    
+    if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1);
+	return TCL_ERROR;
+    }
+
+    *indexPtr = index;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckIfVarUnset --
+ *
+ *	Utility procedure that checks whether a test variable is readable:
+ *	i.e., that varPtr[varIndex] is non-NULL.
+ *
+ * Results:
+ *	1 if the test variable is unset (NULL); 0 otherwise.
+ *
+ * Side effects:
+ *	Sets the interpreter result to an error message if the variable is
+ *	unset (NULL).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckIfVarUnset(interp, varIndex)
+    Tcl_Interp *interp;		/* Interpreter for error reporting. */
+    int varIndex;		/* Index of the test variable to check. */
+{
+    if (varPtr[varIndex] == NULL) {
+	char buf[100];
+	
+	sprintf(buf, "variable %d is unset (NULL)", varIndex);
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	return 1;
+    }
+    return 0;
+}
diff --git a/contrib/tcl/generic/tclTimer.c b/contrib/tcl/generic/tclTimer.c
new file mode 100644
index 0000000..2a91f65
--- /dev/null
+++ b/contrib/tcl/generic/tclTimer.c
@@ -0,0 +1,1081 @@
+/* 
+ * tclTimer.c --
+ *
+ *	This file provides timer event management facilities for Tcl,
+ *	including the "after" command.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclTimer.c 1.6 97/05/20 11:08:02
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * This flag indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * For each timer callback that's pending there is one record of the following
+ * type.  The normal handlers (created by Tcl_CreateTimerHandler) are chained
+ * together in a list sorted by time (earliest event first).
+ */
+
+typedef struct TimerHandler {
+    Tcl_Time time;			/* When timer is to fire. */
+    Tcl_TimerProc *proc;		/* Procedure to call. */
+    ClientData clientData;		/* Argument to pass to proc. */
+    Tcl_TimerToken token;		/* Identifies handler so it can be
+					 * deleted. */
+    struct TimerHandler *nextPtr;	/* Next event in queue, or NULL for
+					 * end of queue. */
+} TimerHandler;
+
+static TimerHandler *firstTimerHandlerPtr = NULL;
+					/* First event in queue. */
+static int lastTimerId;			/* Timer identifier of most recently
+					 * created timer. */
+static int timerPending;		/* 1 if a timer event is in the queue. */
+
+/*
+ * The data structure below is used by the "after" command to remember
+ * the command to be executed later.  All of the pending "after" commands
+ * for an interpreter are linked together in a list.
+ */
+
+typedef struct AfterInfo {
+    struct AfterAssocData *assocPtr;
+				/* Pointer to the "tclAfter" assocData for
+				 * the interp in which command will be
+				 * executed. */
+    char *command;		/* Command to execute.  Malloc'ed, so must
+				 * be freed when structure is deallocated. */
+    int id;			/* Integer identifier for command;  used to
+				 * cancel it. */
+    Tcl_TimerToken token;	/* Used to cancel the "after" command.  NULL
+				 * means that the command is run as an
+				 * idle handler rather than as a timer
+				 * handler.  NULL means this is an "after
+				 * idle" handler rather than a
+                                 * timer handler. */
+    struct AfterInfo *nextPtr;	/* Next in list of all "after" commands for
+				 * this interpreter. */
+} AfterInfo;
+
+/*
+ * One of the following structures is associated with each interpreter
+ * for which an "after" command has ever been invoked.  A pointer to
+ * this structure is stored in the AssocData for the "tclAfter" key.
+ */
+
+typedef struct AfterAssocData {
+    Tcl_Interp *interp;		/* The interpreter for which this data is
+				 * registered. */
+    AfterInfo *firstAfterPtr;	/* First in list of all "after" commands
+				 * still pending for this interpreter, or
+				 * NULL if none. */
+} AfterAssocData;
+
+/*
+ * There is one of the following structures for each of the
+ * handlers declared in a call to Tcl_DoWhenIdle.  All of the
+ * currently-active handlers are linked together into a list.
+ */
+
+typedef struct IdleHandler {
+    Tcl_IdleProc (*proc);	/* Procedure to call. */
+    ClientData clientData;	/* Value to pass to proc. */
+    int generation;		/* Used to distinguish older handlers from
+				 * recently-created ones. */
+    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
+} IdleHandler;
+
+static IdleHandler *idleList;
+				/* First in list of all idle handlers. */
+static IdleHandler *lastIdlePtr;
+				/* Last in list (or NULL for empty list). */
+static int idleGeneration;	/* Used to fill in the "generation" fields
+				 * of IdleHandler structures.  Increments
+				 * each time Tcl_DoOneEvent starts calling
+				 * idle handlers, so that all old handlers
+				 * can be called without calling any of the
+				 * new ones created by old ones. */
+
+/*
+ * Prototypes for procedures referenced only in this file:
+ */
+
+static void		AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp));
+static void		AfterProc _ANSI_ARGS_((ClientData clientData));
+static void		FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
+static AfterInfo *	GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
+			    char *string));
+static void		InitTimer _ANSI_ARGS_((void));
+static void		TimerExitProc _ANSI_ARGS_((ClientData clientData));
+static int		TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+			    int flags));
+static void		TimerCheckProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static void		TimerSetupProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitTimer --
+ *
+ *	This function initializes the timer module.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Registers the idle and timer event sources.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitTimer()
+{
+    initialized = 1;
+    lastTimerId = 0;
+    timerPending = 0;
+    idleGeneration = 0;
+    firstTimerHandlerPtr = NULL;
+    lastIdlePtr = NULL;
+    idleList = NULL;
+
+    Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
+    Tcl_CreateExitHandler(TimerExitProc, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerExitProc --
+ *
+ *	This function is call at exit or unload time to remove the
+ *	timer and idle event sources.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes the timer and idle event sources.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerExitProc(clientData)
+    ClientData clientData;	/* Not used. */
+{
+    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
+    initialized = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_CreateTimerHandler --
+ *
+ *	Arrange for a given procedure to be invoked at a particular
+ *	time in the future.
+ *
+ * Results:
+ *	The return value is a token for the timer event, which
+ *	may be used to delete the event before it fires.
+ *
+ * Side effects:
+ *	When milliseconds have elapsed, proc will be invoked
+ *	exactly once.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tcl_TimerToken
+Tcl_CreateTimerHandler(milliseconds, proc, clientData)
+    int milliseconds;		/* How many milliseconds to wait
+				 * before invoking proc. */
+    Tcl_TimerProc *proc;	/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary data to pass to proc. */
+{
+    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
+    Tcl_Time time;
+
+    if (!initialized) {
+	InitTimer();
+    }
+
+    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
+
+    /*
+     * Compute when the event should fire.
+     */
+
+    TclpGetTime(&time);
+    timerHandlerPtr->time.sec = time.sec + milliseconds/1000;
+    timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;
+    if (timerHandlerPtr->time.usec >= 1000000) {
+	timerHandlerPtr->time.usec -= 1000000;
+	timerHandlerPtr->time.sec += 1;
+    }
+    
+    /*
+     * Fill in other fields for the event.
+     */
+
+    timerHandlerPtr->proc = proc;
+    timerHandlerPtr->clientData = clientData;
+    lastTimerId++;
+    timerHandlerPtr->token = (Tcl_TimerToken) lastTimerId;
+
+    /*
+     * Add the event to the queue in the correct position
+     * (ordered by event firing time).
+     */
+
+    for (tPtr2 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
+	    prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
+	if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
+		|| ((tPtr2->time.sec == timerHandlerPtr->time.sec)
+		&& (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
+	    break;
+	}
+    }
+    timerHandlerPtr->nextPtr = tPtr2;
+    if (prevPtr == NULL) {
+	firstTimerHandlerPtr = timerHandlerPtr;
+    } else {
+	prevPtr->nextPtr = timerHandlerPtr;
+    }
+
+    TimerSetupProc(NULL, TCL_ALL_EVENTS);
+    return timerHandlerPtr->token;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_DeleteTimerHandler --
+ *
+ *	Delete a previously-registered timer handler.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Destroy the timer callback identified by TimerToken,
+ *	so that its associated procedure will not be called.
+ *	If the callback has already fired, or if the given
+ *	token doesn't exist, then nothing happens.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteTimerHandler(token)
+    Tcl_TimerToken token;	/* Result previously returned by
+				 * Tcl_DeleteTimerHandler. */
+{
+    register TimerHandler *timerHandlerPtr, *prevPtr;
+
+    for (timerHandlerPtr = firstTimerHandlerPtr, prevPtr = NULL;
+	    timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
+	    timerHandlerPtr = timerHandlerPtr->nextPtr) {
+	if (timerHandlerPtr->token != token) {
+	    continue;
+	}
+	if (prevPtr == NULL) {
+	    firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
+	} else {
+	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
+	}
+	ckfree((char *) timerHandlerPtr);
+	return;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerSetupProc --
+ *
+ *	This function is called by Tcl_DoOneEvent to setup the timer
+ *	event source for before blocking.  This routine checks both the
+ *	idle and after timer lists.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May update the maximum notifier block time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerSetupProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    Tcl_Time blockTime;
+
+    if (((flags & TCL_IDLE_EVENTS) && idleList)
+	    || ((flags & TCL_TIMER_EVENTS) && timerPending)) {
+	/*
+	 * There is an idle handler or a pending timer event, so just poll.
+	 */
+
+	blockTime.sec = 0;
+	blockTime.usec = 0;
+
+    } else if ((flags & TCL_TIMER_EVENTS) && firstTimerHandlerPtr) {
+	/*
+	 * Compute the timeout for the next timer on the list.
+	 */
+
+	TclpGetTime(&blockTime);
+	blockTime.sec = firstTimerHandlerPtr->time.sec - blockTime.sec;
+	blockTime.usec = firstTimerHandlerPtr->time.usec - blockTime.usec;
+	if (blockTime.usec < 0) {
+	    blockTime.sec -= 1;
+	    blockTime.usec += 1000000;
+	}
+	if (blockTime.sec < 0) {
+	    blockTime.sec = 0;
+	    blockTime.usec = 0;
+	}
+    } else {
+	return;
+    }
+	
+    Tcl_SetMaxBlockTime(&blockTime);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerCheckProc --
+ *
+ *	This function is called by Tcl_DoOneEvent to check the timer
+ *	event source for events.  This routine checks both the
+ *	idle and after timer lists.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event and update the maximum notifier block time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerCheckProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    Tcl_Event *timerEvPtr;
+    Tcl_Time blockTime;
+
+    if ((flags & TCL_TIMER_EVENTS) && firstTimerHandlerPtr) {
+	/*
+	 * Compute the timeout for the next timer on the list.
+	 */
+
+	TclpGetTime(&blockTime);
+	blockTime.sec = firstTimerHandlerPtr->time.sec - blockTime.sec;
+	blockTime.usec = firstTimerHandlerPtr->time.usec - blockTime.usec;
+	if (blockTime.usec < 0) {
+	    blockTime.sec -= 1;
+	    blockTime.usec += 1000000;
+	}
+	if (blockTime.sec < 0) {
+	    blockTime.sec = 0;
+	    blockTime.usec = 0;
+	}
+
+	/*
+	 * If the first timer has expired, stick an event on the queue.
+	 */
+
+	if (blockTime.sec == 0 && blockTime.usec == 0 && !timerPending) {
+	    timerPending = 1;
+	    timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
+	    timerEvPtr->proc = TimerHandlerEventProc;
+	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerHandlerEventProc --
+ *
+ *	This procedure is called by Tcl_ServiceEvent when a timer event
+ *	reaches the front of the event queue.  This procedure handles
+ *	the event by invoking the callbacks for all timers that are
+ *	ready.
+ *
+ * Results:
+ *	Returns 1 if the event was handled, meaning it should be removed
+ *	from the queue.  Returns 0 if the event was not handled, meaning
+ *	it should stay on the queue.  The only time the event isn't
+ *	handled is if the TCL_TIMER_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ *	Whatever the timer handler callback procedures do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TimerHandlerEventProc(evPtr, flags)
+    Tcl_Event *evPtr;		/* Event to service. */
+    int flags;			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    TimerHandler *timerHandlerPtr, **nextPtrPtr;
+    Tcl_Time time;
+    int currentTimerId;
+
+    /*
+     * Do nothing if timers aren't enabled.  This leaves the event on the
+     * queue, so we will get to it as soon as ServiceEvents() is called
+     * with timers enabled.
+     */
+
+    if (!(flags & TCL_TIMER_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * The code below is trickier than it may look, for the following
+     * reasons:
+     *
+     * 1. New handlers can get added to the list while the current
+     *    one is being processed.  If new ones get added, we don't
+     *    want to process them during this pass through the list to avoid
+     *	  starving other event sources.  This is implemented using the
+     *	  token number in the handler:  new handlers will have a
+     *    newer token than any of the ones currently on the list.
+     * 2. The handler can call Tcl_DoOneEvent, so we have to remove
+     *    the handler from the list before calling it. Otherwise an
+     *    infinite loop could result.
+     * 3. Tcl_DeleteTimerHandler can be called to remove an element from
+     *    the list while a handler is executing, so the list could
+     *    change structure during the call.
+     * 4. Because we only fetch the current time before entering the loop,
+     *    the only way a new timer will even be considered runnable is if
+     *	  its expiration time is within the same millisecond as the
+     *	  current time.  This is fairly likely on Windows, since it has
+     *	  a course granularity clock.  Since timers are placed
+     *	  on the queue in time order with the most recently created
+     *    handler appearing after earlier ones with the same expiration
+     *	  time, we don't have to worry about newer generation timers
+     *	  appearing before later ones.
+     */
+
+    timerPending = 0;
+    currentTimerId = lastTimerId;
+    TclpGetTime(&time);
+    while (1) {
+	nextPtrPtr = &firstTimerHandlerPtr;
+	timerHandlerPtr = firstTimerHandlerPtr;
+	if (timerHandlerPtr == NULL) {
+	    break;
+	}
+	    
+	if ((timerHandlerPtr->time.sec > time.sec)
+		|| ((timerHandlerPtr->time.sec == time.sec)
+			&& (timerHandlerPtr->time.usec > time.usec))) {
+	    break;
+	}
+
+	/*
+	 * Bail out if the next timer is of a newer generation.
+	 */
+
+	if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
+	    break;
+	}
+
+	/*
+	 * Remove the handler from the queue before invoking it,
+	 * to avoid potential reentrancy problems.
+	 */
+
+	(*nextPtrPtr) = timerHandlerPtr->nextPtr;
+	(*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
+	ckfree((char *) timerHandlerPtr);
+    }
+    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
+    return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_DoWhenIdle --
+ *
+ *	Arrange for proc to be invoked the next time the system is
+ *	idle (i.e., just before the next time that Tcl_DoOneEvent
+ *	would have to wait for something to happen).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Proc will eventually be called, with clientData as argument.
+ *	See the manual entry for details.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_DoWhenIdle(proc, clientData)
+    Tcl_IdleProc *proc;		/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+{
+    register IdleHandler *idlePtr;
+    Tcl_Time blockTime;
+
+    if (!initialized) {
+	InitTimer();
+    }
+
+    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
+    idlePtr->proc = proc;
+    idlePtr->clientData = clientData;
+    idlePtr->generation = idleGeneration;
+    idlePtr->nextPtr = NULL;
+    if (lastIdlePtr == NULL) {
+	idleList = idlePtr;
+    } else {
+	lastIdlePtr->nextPtr = idlePtr;
+    }
+    lastIdlePtr = idlePtr;
+
+    blockTime.sec = 0;
+    blockTime.usec = 0;
+    Tcl_SetMaxBlockTime(&blockTime);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CancelIdleCall --
+ *
+ *	If there are any when-idle calls requested to a given procedure
+ *	with given clientData, cancel all of them.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the proc/clientData combination were on the when-idle list,
+ *	they are removed so that they will never be called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CancelIdleCall(proc, clientData)
+    Tcl_IdleProc *proc;		/* Procedure that was previously registered. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+{
+    register IdleHandler *idlePtr, *prevPtr;
+    IdleHandler *nextPtr;
+
+    for (prevPtr = NULL, idlePtr = idleList; idlePtr != NULL;
+	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
+	while ((idlePtr->proc == proc)
+		&& (idlePtr->clientData == clientData)) {
+	    nextPtr = idlePtr->nextPtr;
+	    ckfree((char *) idlePtr);
+	    idlePtr = nextPtr;
+	    if (prevPtr == NULL) {
+		idleList = idlePtr;
+	    } else {
+		prevPtr->nextPtr = idlePtr;
+	    }
+	    if (idlePtr == NULL) {
+		lastIdlePtr = prevPtr;
+		return;
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclServiceIdle --
+ *
+ *	This procedure is invoked by the notifier when it becomes
+ *	idle.  It will invoke all idle handlers that are present at
+ *	the time the call is invoked, but not those added during idle
+ *	processing.
+ *
+ * Results:
+ *	The return value is 1 if TclServiceIdle found something to
+ *	do, otherwise return value is 0.
+ *
+ * Side effects:
+ *	Invokes all pending idle handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclServiceIdle()
+{
+    IdleHandler *idlePtr;
+    int oldGeneration;
+    Tcl_Time blockTime;
+
+    if (idleList == NULL) {
+	return 0;
+    }
+
+    oldGeneration = idleGeneration;
+    idleGeneration++;
+
+    /*
+     * The code below is trickier than it may look, for the following
+     * reasons:
+     *
+     * 1. New handlers can get added to the list while the current
+     *    one is being processed.  If new ones get added, we don't
+     *    want to process them during this pass through the list (want
+     *    to check for other work to do first).  This is implemented
+     *    using the generation number in the handler:  new handlers
+     *    will have a different generation than any of the ones currently
+     *    on the list.
+     * 2. The handler can call Tcl_DoOneEvent, so we have to remove
+     *    the handler from the list before calling it. Otherwise an
+     *    infinite loop could result.
+     * 3. Tcl_CancelIdleCall can be called to remove an element from
+     *    the list while a handler is executing, so the list could
+     *    change structure during the call.
+     */
+
+    for (idlePtr = idleList;
+	    ((idlePtr != NULL)
+		    && ((oldGeneration - idlePtr->generation) >= 0));
+	    idlePtr = idleList) {
+	idleList = idlePtr->nextPtr;
+	if (idleList == NULL) {
+	    lastIdlePtr = NULL;
+	}
+	(*idlePtr->proc)(idlePtr->clientData);
+	ckfree((char *) idlePtr);
+    }
+    if (idleList) {
+	blockTime.sec = 0;
+	blockTime.usec = 0;
+	Tcl_SetMaxBlockTime(&blockTime);
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AfterCmd --
+ *
+ *	This procedure is invoked to process the "after" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_AfterCmd(clientData, interp, argc, argv)
+    ClientData clientData;	/* Points to the "tclAfter" assocData for
+				 * this interpreter, or NULL if the assocData
+				 * hasn't been created yet.*/
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+{
+    /*
+     * The variable below is used to generate unique identifiers for
+     * after commands.  This id can wrap around, which can potentially
+     * cause problems.  However, there are not likely to be problems
+     * in practice, because after commands can only be requested to
+     * about a month in the future, and wrap-around is unlikely to
+     * occur in less than about 1-10 years.  Thus it's unlikely that
+     * any old ids will still be around when wrap-around occurs.
+     */
+
+    static int nextId = 1;
+    int ms;
+    AfterInfo *afterPtr;
+    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
+    Tcl_CmdInfo cmdInfo;
+    size_t length;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option ?arg arg ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Create the "after" information associated for this interpreter,
+     * if it doesn't already exist.  Associate it with the command too,
+     * so that it will be passed in as the ClientData argument in the
+     * future.
+     */
+
+    if (assocPtr == NULL) {
+	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
+	assocPtr->interp = interp;
+	assocPtr->firstAfterPtr = NULL;
+	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
+		(ClientData) assocPtr);
+	cmdInfo.proc = Tcl_AfterCmd;
+	cmdInfo.clientData = (ClientData) assocPtr;
+	cmdInfo.objProc = NULL;
+	cmdInfo.objClientData = (ClientData) NULL;
+	cmdInfo.deleteProc = NULL;
+	cmdInfo.deleteData = (ClientData) assocPtr;
+	Tcl_SetCommandInfo(interp, argv[0], &cmdInfo);
+    }
+
+    /*
+     * Parse the command.
+     */
+
+    length = strlen(argv[1]);
+    if (isdigit(UCHAR(argv[1][0]))) {
+	if (Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (ms < 0) {
+	    ms = 0;
+	}
+	if (argc == 2) {
+	    Tcl_Sleep(ms);
+	    return TCL_OK;
+	}
+	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr->assocPtr = assocPtr;
+	if (argc == 3) {
+	    afterPtr->command = (char *) ckalloc((unsigned)
+		    (strlen(argv[2]) + 1));
+	    strcpy(afterPtr->command, argv[2]);
+	} else {
+	    afterPtr->command = Tcl_Concat(argc-2, argv+2);
+	}
+	afterPtr->id = nextId;
+	nextId += 1;
+	afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
+		(ClientData) afterPtr);
+	afterPtr->nextPtr = assocPtr->firstAfterPtr;
+	assocPtr->firstAfterPtr = afterPtr;
+	sprintf(interp->result, "after#%d", afterPtr->id);
+    } else if (strncmp(argv[1], "cancel", length) == 0) {
+	char *arg;
+
+	if (argc < 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " cancel id|command\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (argc == 3) {
+	    arg = argv[2];
+	} else {
+	    arg = Tcl_Concat(argc-2, argv+2);
+	}
+	for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
+		afterPtr = afterPtr->nextPtr) {
+	    if (strcmp(afterPtr->command, arg) == 0) {
+		break;
+	    }
+	}
+	if (afterPtr == NULL) {
+	    afterPtr = GetAfterEvent(assocPtr, arg);
+	}
+	if (arg != argv[2]) {
+	    ckfree(arg);
+	}
+	if (afterPtr != NULL) {
+	    if (afterPtr->token != NULL) {
+		Tcl_DeleteTimerHandler(afterPtr->token);
+	    } else {
+		Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+	    }
+	    FreeAfterPtr(afterPtr);
+	}
+    } else if ((strncmp(argv[1], "idle", length) == 0)
+	     && (length >= 2)) {
+	if (argc < 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " idle script script ...\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr->assocPtr = assocPtr;
+	if (argc == 3) {
+	    afterPtr->command = (char *) ckalloc((unsigned)
+		    (strlen(argv[2]) + 1));
+	    strcpy(afterPtr->command, argv[2]);
+	} else {
+	    afterPtr->command = Tcl_Concat(argc-2, argv+2);
+	}
+	afterPtr->id = nextId;
+	nextId += 1;
+	afterPtr->token = NULL;
+	afterPtr->nextPtr = assocPtr->firstAfterPtr;
+	assocPtr->firstAfterPtr = afterPtr;
+	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
+	sprintf(interp->result, "after#%d", afterPtr->id);
+    } else if ((strncmp(argv[1], "info", length) == 0)
+	     && (length >= 2)) {
+	if (argc == 2) {
+	    char buffer[30];
+	    
+	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
+		    afterPtr = afterPtr->nextPtr) {
+		if (assocPtr->interp == interp) {
+		    sprintf(buffer, "after#%d", afterPtr->id);
+		    Tcl_AppendElement(interp, buffer);
+		}
+	    }
+	    return TCL_OK;
+	}
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " info ?id?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	afterPtr = GetAfterEvent(assocPtr, argv[2]);
+	if (afterPtr == NULL) {
+	    Tcl_AppendResult(interp, "event \"", argv[2],
+		    "\" doesn't exist", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_AppendElement(interp, afterPtr->command);
+	Tcl_AppendElement(interp,
+		(afterPtr->token == NULL) ? "idle" : "timer");
+    } else {
+	Tcl_AppendResult(interp, "bad argument \"", argv[1],
+		"\": must be cancel, idle, info, or a number",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetAfterEvent --
+ *
+ *	This procedure parses an "after" id such as "after#4" and
+ *	returns a pointer to the AfterInfo structure.
+ *
+ * Results:
+ *	The return value is either a pointer to an AfterInfo structure,
+ *	if one is found that corresponds to "string" and is for interp,
+ *	or NULL if no corresponding after event can be found.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static AfterInfo *
+GetAfterEvent(assocPtr, string)
+    AfterAssocData *assocPtr;	/* Points to "after"-related information for
+				 * this interpreter. */
+    char *string;		/* Textual identifier for after event, such
+				 * as "after#6". */
+{
+    AfterInfo *afterPtr;
+    int id;
+    char *end;
+
+    if (strncmp(string, "after#", 6) != 0) {
+	return NULL;
+    }
+    string += 6;
+    id = strtoul(string, &end, 10);
+    if ((end == string) || (*end != 0)) {
+	return NULL;
+    }
+    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
+	    afterPtr = afterPtr->nextPtr) {
+	if (afterPtr->id == id) {
+	    return afterPtr;
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AfterProc --
+ *
+ *	Timer callback to execute commands registered with the
+ *	"after" command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Executes whatever command was specified.  If the command
+ *	returns an error, then the command "bgerror" is invoked
+ *	to process the error;  if bgerror fails then information
+ *	about the error is output on stderr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AfterProc(clientData)
+    ClientData clientData;	/* Describes command to execute. */
+{
+    AfterInfo *afterPtr = (AfterInfo *) clientData;
+    AfterAssocData *assocPtr = afterPtr->assocPtr;
+    AfterInfo *prevPtr;
+    int result;
+    Tcl_Interp *interp;
+
+    /*
+     * First remove the callback from our list of callbacks;  otherwise
+     * someone could delete the callback while it's being executed, which
+     * could cause a core dump.
+     */
+
+    if (assocPtr->firstAfterPtr == afterPtr) {
+	assocPtr->firstAfterPtr = afterPtr->nextPtr;
+    } else {
+	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
+		prevPtr = prevPtr->nextPtr) {
+	    /* Empty loop body. */
+	}
+	prevPtr->nextPtr = afterPtr->nextPtr;
+    }
+
+    /*
+     * Execute the callback.
+     */
+
+    interp = assocPtr->interp;
+    Tcl_Preserve((ClientData) interp);
+    result = Tcl_GlobalEval(interp, afterPtr->command);
+    if (result != TCL_OK) {
+	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
+	Tcl_BackgroundError(interp);
+    }
+    Tcl_Release((ClientData) interp);
+    
+    /*
+     * Free the memory for the callback.
+     */
+
+    ckfree(afterPtr->command);
+    ckfree((char *) afterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeAfterPtr --
+ *
+ *	This procedure removes an "after" command from the list of
+ *	those that are pending and frees its resources.  This procedure
+ *	does *not* cancel the timer handler;  if that's needed, the
+ *	caller must do it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The memory associated with afterPtr is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeAfterPtr(afterPtr)
+    AfterInfo *afterPtr;		/* Command to be deleted. */
+{
+    AfterInfo *prevPtr;
+    AfterAssocData *assocPtr = afterPtr->assocPtr;
+
+    if (assocPtr->firstAfterPtr == afterPtr) {
+	assocPtr->firstAfterPtr = afterPtr->nextPtr;
+    } else {
+	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
+		prevPtr = prevPtr->nextPtr) {
+	    /* Empty loop body. */
+	}
+	prevPtr->nextPtr = afterPtr->nextPtr;
+    }
+    ckfree(afterPtr->command);
+    ckfree((char *) afterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AfterCleanupProc --
+ *
+ *	This procedure is invoked whenever an interpreter is deleted
+ *	to cleanup the AssocData for "tclAfter".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	After commands are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+AfterCleanupProc(clientData, interp)
+    ClientData clientData;	/* Points to AfterAssocData for the
+				 * interpreter. */
+    Tcl_Interp *interp;		/* Interpreter that is being deleted. */
+{
+    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
+    AfterInfo *afterPtr;
+
+    while (assocPtr->firstAfterPtr != NULL) {
+	afterPtr = assocPtr->firstAfterPtr;
+	assocPtr->firstAfterPtr = afterPtr->nextPtr;
+	if (afterPtr->token != NULL) {
+	    Tcl_DeleteTimerHandler(afterPtr->token);
+	} else {
+	    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+	}
+	ckfree(afterPtr->command);
+	ckfree((char *) afterPtr);
+    }
+    ckfree((char *) assocPtr);
+}
diff --git a/contrib/tcl/generic/tclUtil.c b/contrib/tcl/generic/tclUtil.c
index 5c15536..2eca40c 100644
--- a/contrib/tcl/generic/tclUtil.c
+++ b/contrib/tcl/generic/tclUtil.c
@@ -5,12 +5,12 @@
  *	commands.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUtil.c 1.114 96/06/06 13:48:58
+ * SCCS: @(#) tclUtil.c 1.154 97/06/26 13:49:14
  */
 
 #include "tclInt.h"
@@ -58,19 +58,19 @@ static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
  *	it means that list didn't have proper list structure;
  *	interp->result contains a more detailed error message.
  *
- *	If TCL_OK is returned, then *elementPtr will be set to point
- *	to the first element of list, and *nextPtr will be set to point
- *	to the character just after any white space following the last
- *	character that's part of the element.  If this is the last argument
- *	in the list, then *nextPtr will point to the NULL character at the
- *	end of list.  If sizePtr is non-NULL, *sizePtr is filled in with
- *	the number of characters in the element.  If the element is in
- *	braces, then *elementPtr will point to the character after the
- *	opening brace and *sizePtr will not include either of the braces.
- *	If there isn't an element in the list, *sizePtr will be zero, and
- *	both *elementPtr and *termPtr will refer to the null character at
- *	the end of list.  Note:  this procedure does NOT collapse backslash
- *	sequences.
+ *	If TCL_OK is returned, then *elementPtr will be set to point to the
+ *	first element of list, and *nextPtr will be set to point to the
+ *	character just after any white space following the last character
+ *	that's part of the element. If this is the last argument in the
+ *	list, then *nextPtr will point just after the last character in the
+ *	list (i.e., at the character at list+listLength). If sizePtr is
+ *	non-NULL, *sizePtr is filled in with the number of characters in the
+ *	element.  If the element is in braces, then *elementPtr will point
+ *	to the character after the opening brace and *sizePtr will not
+ *	include either of the braces. If there isn't an element in the list,
+ *	*sizePtr will be zero, and both *elementPtr and *termPtr will point
+ *	just after the last character in the list. Note: this procedure does
+ *	NOT collapse backslash sequences.
  *
  * Side effects:
  *	None.
@@ -79,63 +79,75 @@ static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
  */
 
 int
-TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
+TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
+	       bracePtr)
     Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
 				 * If NULL, then no error message is left
 				 * after errors. */
-    register char *list;	/* String containing Tcl list with zero
-				 * or more elements (possibly in braces). */
-    char **elementPtr;		/* Fill in with location of first significant
+    char *list;			/* Points to the first byte of a string
+				 * containing a Tcl list with zero or more
+				 * elements (possibly in braces). */
+    int listLength;		/* Number of bytes in the list's string. */
+    char **elementPtr;		/* Where to put address of first significant
 				 * character in first element of list. */
     char **nextPtr;		/* Fill in with location of character just
 				 * after all white space following end of
-				 * argument (i.e. next argument or end of
-				 * list). */
+				 * argument (next arg or end of list). */
     int *sizePtr;		/* If non-zero, fill in with size of
 				 * element. */
-    int *bracePtr;		/* If non-zero fill in with non-zero/zero
+    int *bracePtr;		/* If non-zero, fill in with non-zero/zero
 				 * to indicate that arg was/wasn't
 				 * in braces. */
 {
-    register char *p;
-    int openBraces = 0;
+    register char *p = list;
+    char *elemStart;		/* Points to first byte of first element. */
+    char *limit;		/* Points just after list's last byte. */
+    int openBraces = 0;		/* Brace nesting level during parse. */
     int inQuotes = 0;
-    int size;
-
+    int size = 0;		/* Init. avoids compiler warning. */
+    int numChars;
+    char *p2;
+    
     /*
      * Skim off leading white space and check for an opening brace or
-     * quote.   Note:  use of "isascii" below and elsewhere in this
+     * quote. We treat embedded NULLs in the list as bytes belonging to
+     * a list element. Note: use of "isascii" below and elsewhere in this
      * procedure is a temporary hack (7/27/90) because Mx uses characters
-     * with the high-order bit set for some things.  This should probably
+     * with the high-order bit set for some things. This should probably
      * be changed back eventually, or all of Tcl should call isascii.
      */
 
-    while (isspace(UCHAR(*list))) {
-	list++;
+    limit = (list + listLength);
+    while ((p < limit) && (isspace(UCHAR(*p)))) {
+	p++;
+    }
+    if (p == limit) {		/* no element found */
+	elemStart = limit;
+	goto done;
     }
-    if (*list == '{') {
+
+    if (*p == '{') {
 	openBraces = 1;
-	list++;
-    } else if (*list == '"') {
+	p++;
+    } else if (*p == '"') {
 	inQuotes = 1;
-	list++;
+	p++;
     }
+    elemStart = p;
     if (bracePtr != 0) {
 	*bracePtr = openBraces;
     }
-    p = list;
 
     /*
-     * Find the end of the element (either a space or a close brace or
-     * the end of the string).
+     * Find element's end (a space, close brace, or the end of the string).
      */
 
-    while (1) {
+    while (p < limit) {
 	switch (*p) {
 
 	    /*
-	     * Open brace: don't treat specially unless the element is
-	     * in braces.  In this case, keep a nesting count.
+	     * Open brace: don't treat specially unless the element is in
+	     * braces. In this case, keep a nesting count.
 	     */
 
 	    case '{':
@@ -145,32 +157,38 @@ TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
 		break;
 
 	    /*
-	     * Close brace: if element is in braces, keep nesting
-	     * count and quit when the last close brace is seen.
+	     * Close brace: if element is in braces, keep nesting count and
+	     * quit when the last close brace is seen.
 	     */
 
 	    case '}':
-		if (openBraces == 1) {
-		    char *p2;
-
-		    size = p - list;
+		if (openBraces > 1) {
+		    openBraces--;
+		} else if (openBraces == 1) {
+		    size = (p - elemStart);
 		    p++;
-		    if (isspace(UCHAR(*p)) || (*p == 0)) {
+		    if ((p >= limit) || isspace(UCHAR(*p))) {
 			goto done;
 		    }
-		    for (p2 = p; (*p2 != 0) && (!isspace(UCHAR(*p2)))
-			    && (p2 < p+20); p2++) {
-			/* null body */
-		    }
+
+		    /*
+		     * Garbage after the closing brace; return an error.
+		     */
+		    
 		    if (interp != NULL) {
-			Tcl_ResetResult(interp);
-			sprintf(interp->result,
+			char buf[100];
+			
+			p2 = p;
+			while ((p2 < limit) && (!isspace(UCHAR(*p2)))
+			        && (p2 < p+20)) {
+			    p2++;
+			}
+			sprintf(buf,
 				"list element in braces followed by \"%.*s\" instead of space",
 				(int) (p2-p), p);
+			Tcl_SetResult(interp, buf, TCL_VOLATILE);
 		    }
 		    return TCL_ERROR;
-		} else if (openBraces != 0) {
-		    openBraces--;
 		}
 		break;
 
@@ -180,15 +198,13 @@ TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
 	     */
 
 	    case '\\': {
-		int size;
-
-		(void) Tcl_Backslash(p, &size);
-		p += size - 1;
+		(void) Tcl_Backslash(p, &numChars);
+		p += (numChars - 1);
 		break;
 	    }
 
 	    /*
-	     * Space: ignore if element is in braces or quotes;  otherwise
+	     * Space: ignore if element is in braces or quotes; otherwise
 	     * terminate element.
 	     */
 
@@ -199,68 +215,74 @@ TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
 	    case '\t':
 	    case '\v':
 		if ((openBraces == 0) && !inQuotes) {
-		    size = p - list;
+		    size = (p - elemStart);
 		    goto done;
 		}
 		break;
 
 	    /*
-	     * Double-quote:  if element is in quotes then terminate it.
+	     * Double-quote: if element is in quotes then terminate it.
 	     */
 
 	    case '"':
 		if (inQuotes) {
-		    char *p2;
-
-		    size = p-list;
+		    size = (p - elemStart);
 		    p++;
-		    if (isspace(UCHAR(*p)) || (*p == 0)) {
+		    if ((p >= limit) || isspace(UCHAR(*p))) {
 			goto done;
 		    }
-		    for (p2 = p; (*p2 != 0) && (!isspace(UCHAR(*p2)))
-			    && (p2 < p+20); p2++) {
-			/* null body */
-		    }
+
+		    /*
+		     * Garbage after the closing quote; return an error.
+		     */
+		    
 		    if (interp != NULL) {
-			Tcl_ResetResult(interp);
-			sprintf(interp->result,
-				"list element in quotes followed by \"%.*s\" %s", (int) (p2-p), p,
-				"instead of space");
+			char buf[100];
+			
+			p2 = p;
+			while ((p2 < limit) && (!isspace(UCHAR(*p2)))
+				 && (p2 < p+20)) {
+			    p2++;
+			}
+			sprintf(buf,
+				"list element in quotes followed by \"%.*s\" %s",
+				(int) (p2-p), p, "instead of space");
+			Tcl_SetResult(interp, buf, TCL_VOLATILE);
 		    }
 		    return TCL_ERROR;
 		}
 		break;
+	}
+	p++;
+    }
 
-	    /*
-	     * End of list:  terminate element.
-	     */
 
-	    case 0:
-		if (openBraces != 0) {
-		    if (interp != NULL) {
-			Tcl_SetResult(interp, "unmatched open brace in list",
-				TCL_STATIC);
-		    }
-		    return TCL_ERROR;
-		} else if (inQuotes) {
-		    if (interp != NULL) {
-			Tcl_SetResult(interp, "unmatched open quote in list",
-				TCL_STATIC);
-		    }
-		    return TCL_ERROR;
-		}
-		size = p - list;
-		goto done;
+    /*
+     * End of list: terminate element.
+     */
 
+    if (p == limit) {
+	if (openBraces != 0) {
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "unmatched open brace in list",
+			TCL_STATIC);
+	    }
+	    return TCL_ERROR;
+	} else if (inQuotes) {
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "unmatched open quote in list",
+			TCL_STATIC);
+	    }
+	    return TCL_ERROR;
 	}
-	p++;
+	size = (p - elemStart);
     }
 
     done:
-    while (isspace(UCHAR(*p))) {
+    while ((p < limit) && (isspace(UCHAR(*p)))) {
 	p++;
     }
-    *elementPtr = list;
+    *elementPtr = elemStart;
     *nextPtr = p;
     if (sizePtr != 0) {
 	*sizePtr = size;
@@ -276,11 +298,11 @@ TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
  *	Copy a string and eliminate any backslashes that aren't in braces.
  *
  * Results:
- *	There is no return value.  Count chars. get copied from src
- *	to dst.  Along the way, if backslash sequences are found outside
- *	braces, the backslashes are eliminated in the copy.
- *	After scanning count chars. from source, a null character is
- *	placed at the end of dst.
+ *	There is no return value. Count characters get copied from src to
+ *	dst. Along the way, if backslash sequences are found outside braces,
+ *	the backslashes are eliminated in the copy. After scanning count
+ *	chars from source, a null character is placed at the end of dst.
+ *	Returns the number of characters that got copied.
  *
  * Side effects:
  *	None.
@@ -288,28 +310,31 @@ TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
  *----------------------------------------------------------------------
  */
 
-void
+int
 TclCopyAndCollapse(count, src, dst)
-    int count;			/* Total number of characters to copy
-				 * from src. */
+    int count;			/* Number of characters to copy from src. */
     register char *src;		/* Copy from here... */
     register char *dst;		/* ... to here. */
 {
     register char c;
     int numRead;
+    int newCount = 0;
 
-    for (c = *src; count > 0; src++, c = *src, count--) {
+    for (c = *src;  count > 0;  src++, c = *src, count--) {
 	if (c == '\\') {
 	    *dst = Tcl_Backslash(src, &numRead);
 	    dst++;
 	    src += numRead-1;
 	    count -= numRead-1;
+	    newCount++;
 	} else {
 	    *dst = c;
 	    dst++;
+	    newCount++;
 	}
     }
     *dst = 0;
+    return newCount;
 }
 
 /*
@@ -345,16 +370,16 @@ TclCopyAndCollapse(count, src, dst)
 int
 Tcl_SplitList(interp, list, argcPtr, argvPtr)
     Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
-				 * If NULL, then no error message is left. */
+				 * If NULL, no error message is left. */
     char *list;			/* Pointer to string with list structure. */
     int *argcPtr;		/* Pointer to location to fill in with
 				 * the number of elements in the list. */
-    char ***argvPtr;		/* Pointer to place to store pointer to array
-				 * of pointers to list elements. */
+    char ***argvPtr;		/* Pointer to place to store pointer to
+				 * array of pointers to list elements. */
 {
     char **argv;
     register char *p;
-    int size, i, result, elSize, brace;
+    int length, size, i, result, elSize, brace;
     char *element;
 
     /*
@@ -372,9 +397,14 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
     size++;			/* Leave space for final NULL pointer. */
     argv = (char **) ckalloc((unsigned)
 	    ((size * sizeof(char *)) + (p - list) + 1));
+    length = strlen(list);
     for (i = 0, p = ((char *) argv) + size*sizeof(char *);
-	    *list != 0; i++) {
-	result = TclFindElement(interp, list, &element, &list, &elSize, &brace);
+	    *list != 0;  i++) {
+	char *prevList = list;
+	
+	result = TclFindElement(interp, list, length, &element,
+				&list, &elSize, &brace);
+	length -= (list - prevList);
 	if (result != TCL_OK) {
 	    ckfree((char *) argv);
 	    return result;
@@ -392,7 +422,7 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
 	}
 	argv[i] = p;
 	if (brace) {
-	    strncpy(p, element, (size_t) elSize);
+	    (void) strncpy(p, element, (size_t) elSize);
 	    p += elSize;
 	    *p = 0;
 	    p++;
@@ -414,9 +444,9 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
  * Tcl_ScanElement --
  *
  *	This procedure is a companion procedure to Tcl_ConvertElement.
- *	It scans a string to see what needs to be done to it (e.g.
- *	add backslashes or enclosing braces) to make the string into
- *	a valid Tcl list element.
+ *	It scans a string to see what needs to be done to it (e.g. add
+ *	backslashes or enclosing braces) to make the string into a
+ *	valid Tcl list element.
  *
  * Results:
  *	The return value is an overestimate of the number of characters
@@ -435,10 +465,46 @@ int
 Tcl_ScanElement(string, flagPtr)
     char *string;		/* String to convert to Tcl list element. */
     int *flagPtr;		/* Where to store information to guide
+				 * Tcl_ConvertCountedElement. */
+{
+    return Tcl_ScanCountedElement(string, -1, flagPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanCountedElement --
+ *
+ *	This procedure is a companion procedure to
+ *	Tcl_ConvertCountedElement.  It scans a string to see what
+ *	needs to be done to it (e.g. add backslashes or enclosing
+ *	braces) to make the string into a valid Tcl list element.
+ *	If length is -1, then the string is scanned up to the first
+ *	null byte.
+ *
+ * Results:
+ *	The return value is an overestimate of the number of characters
+ *	that will be needed by Tcl_ConvertCountedElement to produce a
+ *	valid list element from string.  The word at *flagPtr is
+ *	filled in with a value needed by Tcl_ConvertCountedElement
+ *	when doing the actual conversion.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ScanCountedElement(string, length, flagPtr)
+    char *string;		/* String to convert to Tcl list element. */
+    int length;			/* Number of bytes in string, or -1. */
+    int *flagPtr;		/* Where to store information to guide
 				 * Tcl_ConvertElement. */
 {
     int flags, nestingLevel;
     register char *p;
+    char *lastChar;
 
     /*
      * This procedure and Tcl_ConvertElement together do two things:
@@ -450,10 +516,10 @@ Tcl_ScanElement(string, flagPtr)
      * 2. They try to produce legible output, which means minimizing the
      * use of backslashes (using braces instead).  However, there are
      * some situations where backslashes must be used (e.g. an element
-     * like "{abc": the leading brace will have to be backslashed.  For
-     * each element, one of three things must be done:
+     * like "{abc": the leading brace will have to be backslashed.
+     * For each element, one of three things must be done:
      *
-     * (a) Use the element as-is (it doesn't contain anything special
+     * (a) Use the element as-is (it doesn't contain any special
      * characters).  This is the most desirable option.
      *
      * (b) Enclose the element in braces, but leave the contents alone.
@@ -470,8 +536,15 @@ Tcl_ScanElement(string, flagPtr)
      * a backslash followed by newline.
      *
      * The procedure figures out how many bytes will be needed to store
-     * the result (actually, it overestimates).  It also collects information
+     * the result (actually, it overestimates). It also collects information
      * about the element in the form of a flags word.
+     *
+     * Note: list elements produced by this procedure and
+     * Tcl_ConvertCountedElement must have the property that they can be
+     * enclosing in curly braces to make sub-lists.  This means, for
+     * example, that we must not leave unmatched curly braces in the
+     * resulting list element.  This property is necessary in order for
+     * procedures like Tcl_DStringStartSublist to work.
      */
 
     nestingLevel = 0;
@@ -479,11 +552,15 @@ Tcl_ScanElement(string, flagPtr)
     if (string == NULL) {
 	string = "";
     }
+    if (length == -1) {
+	length = strlen(string);
+    }
+    lastChar = string + length;
     p = string;
-    if ((*p == '{') || (*p == '"') || (*p == 0)) {
+    if ((p == lastChar) || (*p == '{') || (*p == '"')) {
 	flags |= USE_BRACES;
     }
-    for ( ; *p != 0; p++) {
+    for ( ; p != lastChar; p++) {
 	switch (*p) {
 	    case '{':
 		nestingLevel++;
@@ -506,8 +583,8 @@ Tcl_ScanElement(string, flagPtr)
 		flags |= USE_BRACES;
 		break;
 	    case '\\':
-		if ((p[1] == 0) || (p[1] == '\n')) {
-		    flags = TCL_DONT_USE_BRACES;
+		if ((p+1 == lastChar) || (p[1] == '\n')) {
+		    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
 		} else {
 		    int size;
 
@@ -536,9 +613,9 @@ Tcl_ScanElement(string, flagPtr)
  *
  * Tcl_ConvertElement --
  *
- *	This is a companion procedure to Tcl_ScanElement.  Given the
- *	information produced by Tcl_ScanElement, this procedure converts
- *	a string to a list element equal to that string.
+ *	This is a companion procedure to Tcl_ScanElement.  Given
+ *	the information produced by Tcl_ScanElement, this procedure
+ *	converts a string to a list element equal to that string.
  *
  * Results:
  *	Information is copied to *dst in the form of a list element
@@ -559,23 +636,61 @@ Tcl_ConvertElement(src, dst, flags)
     char *dst;			/* Place to put list-ified element. */
     int flags;			/* Flags produced by Tcl_ScanElement. */
 {
+    return Tcl_ConvertCountedElement(src, -1, dst, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConvertCountedElement --
+ *
+ *	This is a companion procedure to Tcl_ScanCountedElement.  Given
+ *	the information produced by Tcl_ScanCountedElement, this
+ *	procedure converts a string to a list element equal to that
+ *	string.
+ *
+ * Results:
+ *	Information is copied to *dst in the form of a list element
+ *	identical to src (i.e. if Tcl_SplitList is applied to dst it
+ *	will produce a string identical to src).  The return value is
+ *	a count of the number of characters copied (not including the
+ *	terminating NULL character).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ConvertCountedElement(src, length, dst, flags)
+    register char *src;		/* Source information for list element. */
+    int length;			/* Number of bytes in src, or -1. */
+    char *dst;			/* Place to put list-ified element. */
+    int flags;			/* Flags produced by Tcl_ScanElement. */
+{
     register char *p = dst;
+    char *lastChar;
 
     /*
      * See the comment block at the beginning of the Tcl_ScanElement
      * code for details of how this works.
      */
 
-    if ((src == NULL) || (*src == 0)) {
+    if (src && length == -1) {
+	length = strlen(src);
+    }
+    if ((src == NULL) || (length == 0)) {
 	p[0] = '{';
 	p[1] = '}';
 	p[2] = 0;
 	return 2;
     }
+    lastChar = src + length;
     if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
 	*p = '{';
 	p++;
-	for ( ; *src != 0; src++, p++) {
+	for ( ; src != lastChar; src++, p++) {
 	    *p = *src;
 	}
 	*p = '}';
@@ -595,7 +710,7 @@ Tcl_ConvertElement(src, dst, flags)
 	    src++;
 	    flags |= BRACES_UNMATCHED;
 	}
-	for (; *src != 0 ; src++) {
+	for (; src != lastChar; src++) {
 	    switch (*src) {
 		case ']':
 		case '[':
@@ -807,6 +922,100 @@ Tcl_Concat(argc, argv)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_ConcatObj --
+ *
+ *	Concatenate the strings from a set of objects into a single string
+ *	object with spaces between the original strings.
+ *
+ * Results:
+ *	The return value is a new string object containing a concatenation
+ *	of the strings in objv. Its ref count is zero.
+ *
+ * Side effects:
+ *	A new object is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ConcatObj(objc, objv)
+    int objc;			/* Number of objects to concatenate. */
+    Tcl_Obj *CONST objv[];	/* Array of objects to concatenate. */
+{
+    int allocSize, finalSize, length, elemLength, i;
+    register char *p;
+    register char *element;
+    char *concatStr;
+    register Tcl_Obj *objPtr;
+
+    allocSize = 0;
+    for (i = 0;  i < objc;  i++) {
+	objPtr = objv[i];
+	element = TclGetStringFromObj(objPtr, &length);
+	if ((element != NULL) && (length > 0)) {
+	    allocSize += (length + 1);
+	}
+    }
+    if (allocSize == 0) {
+	allocSize = 1;		/* enough for the NULL byte at end */
+    }
+
+    /*
+     * Allocate storage for the concatenated result. Note that allocSize
+     * is one more than the total number of characters, and so includes
+     * room for the terminating NULL byte.
+     */
+    
+    concatStr = (char *) ckalloc((unsigned) allocSize);
+
+    /*
+     * Now concatenate the elements. Clip white space off the front and back
+     * to generate a neater result, and ignore any empty elements. Also put
+     * a null byte at the end.
+     */
+
+    finalSize = 0;
+    if (objc == 0) {
+	*concatStr = '\0';
+    } else {
+	p = concatStr;
+        for (i = 0;  i < objc;  i++) {
+	    objPtr = objv[i];
+	    element = TclGetStringFromObj(objPtr, &elemLength);
+	    while ((elemLength > 0) && (isspace(UCHAR(*element)))) {
+	         element++;
+		 elemLength--;
+	    }
+	    while ((elemLength > 0)
+		    && isspace(UCHAR(element[elemLength-1]))) {
+		elemLength--;
+	    }
+	    if (elemLength == 0) {
+	         continue;	/* nothing left of this element */
+	    }
+	    memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
+	    p += elemLength;
+	    *p = ' ';
+	    p++;
+	    finalSize += (elemLength + 1);
+        }
+        if (p != concatStr) {
+	    p[-1] = 0;
+	    finalSize -= 1;	/* we overwrote the final ' ' */
+        } else {
+	    *p = 0;
+        }
+    }
+    
+    TclNewObj(objPtr);
+    objPtr->bytes  = concatStr;
+    objPtr->length = finalSize;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_StringMatch --
  *
  *	See if a particular string matches a particular pattern.
@@ -953,7 +1162,7 @@ Tcl_StringMatch(string, pattern)
  *
  * Side effects:
  *	interp->result is left pointing either to "string" (if "copy" is 0)
- *	or to a copy of string.
+ *	or to a copy of string. Also, the object result is reset.
  *
  *----------------------------------------------------------------------
  */
@@ -962,7 +1171,7 @@ void
 Tcl_SetResult(interp, string, freeProc)
     Tcl_Interp *interp;		/* Interpreter with which to associate the
 				 * return value. */
-    char *string;		/* Value to be returned.  If NULL,
+    register char *string;	/* Value to be returned.  If NULL,
 				 * the result is set to an empty string. */
     Tcl_FreeProc *freeProc;	/* Gives information about the string:
 				 * TCL_STATIC, TCL_VOLATILE, or the address
@@ -1006,6 +1215,161 @@ Tcl_SetResult(interp, string, freeProc)
 	    (*oldFreeProc)(oldResult);
 	}
     }
+
+    /*
+     * Reset the object result since we just set the string result.
+     */
+
+    TclResetObjResult(iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStringResult --
+ *
+ *	Returns an interpreter's result value as a string.
+ *
+ * Results:
+ *	The interpreter's result as a string.
+ *
+ * Side effects:
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetStringResult(interp)
+     register Tcl_Interp *interp; /* Interpreter whose result to return. */
+{
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+    
+    if (*(interp->result) == 0) {
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+    }
+    return interp->result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjResult --
+ *
+ *	Arrange for objPtr to be an interpreter's result value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	interp->objResultPtr is left pointing to the object referenced
+ *	by objPtr. The object's reference count is incremented since
+ *	there is now a new reference to it. The reference count for any
+ *	old objResultPtr value is decremented. Also, the string result
+ *	is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjResult(interp, objPtr)
+    Tcl_Interp *interp;		/* Interpreter with which to associate the
+				 * return object value. */
+    register Tcl_Obj *objPtr;	/* Tcl object to be returned. If NULL, the
+				 * obj result is made an empty string
+				 * object. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *oldObjResult = iPtr->objResultPtr;
+
+    iPtr->objResultPtr = objPtr;
+    Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */
+
+    /*
+     * We wait until the end to release the old object result, in case
+     * we are setting the result to itself.
+     */
+    
+    TclDecrRefCount(oldObjResult);
+
+    /*
+     * Reset the string result since we just set the result object.
+     */
+
+    if (iPtr->freeProc != NULL) {
+	if ((iPtr->freeProc == TCL_DYNAMIC)
+	        || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+	    ckfree(iPtr->result);
+	} else {
+	    (*iPtr->freeProc)(iPtr->result);
+	}
+	iPtr->freeProc = 0;
+    }
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetObjResult --
+ *
+ *	Returns an interpreter's result value as a Tcl object. The object's
+ *	reference count is not modified; the caller must do that if it
+ *	needs to hold on to a long-term reference to it.
+ *
+ * Results:
+ *	The interpreter's result as an object.
+ *
+ * Side effects:
+ *	If the interpreter has a non-empty string result, the result object
+ *	is either empty or stale because some procedure set interp->result
+ *	directly. If so, the string result is moved to the result object
+ *	then the string result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetObjResult(interp)
+    Tcl_Interp *interp;		/* Interpreter whose result to return. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *objResultPtr;
+    register int length;
+
+    /*
+     * If the string result is non-empty, move the string result to the
+     * object result, then reset the string result.
+     */
+    
+    if (*(iPtr->result) != 0) {
+	TclResetObjResult(iPtr);
+	
+	objResultPtr = iPtr->objResultPtr;
+	length = strlen(iPtr->result);
+	TclInitStringRep(objResultPtr, iPtr->result, length);
+	
+	if (iPtr->freeProc != NULL) {
+	    if ((iPtr->freeProc == TCL_DYNAMIC)
+	            || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+		ckfree(iPtr->result);
+	    } else {
+		(*iPtr->freeProc)(iPtr->result);
+	    }
+	    iPtr->freeProc = 0;
+	}
+	iPtr->result = iPtr->resultSpace;
+	iPtr->resultSpace[0] = 0;
+    }
+    return iPtr->objResultPtr;
 }
 
 /*
@@ -1013,35 +1377,49 @@ Tcl_SetResult(interp, string, freeProc)
  *
  * Tcl_AppendResult --
  *
- *	Append a variable number of strings onto the result already
- *	present for an interpreter.
+ *	Append a variable number of strings onto the interpreter's string
+ *	result.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The result in the interpreter given by the first argument
- *	is extended by the strings given by the second and following
- *	arguments (up to a terminating NULL argument).
+ *	The result of the interpreter given by the first argument is
+ *	extended by the strings given by the second and following arguments
+ *	(up to a terminating NULL argument).
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
  *
  *----------------------------------------------------------------------
  */
 
-	/* VARARGS2 */
 void
 Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 {
     va_list argList;
     register Interp *iPtr;
-    char *string;
+    register char *string;
     int newSpace;
 
     /*
-     * First, scan through all the arguments to see how much space is
-     * needed.
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
      */
 
     iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult((Tcl_Interp *) iPtr,
+	        TclGetStringFromObj(Tcl_GetObjResult((Tcl_Interp *) iPtr),
+		        (int *) NULL),
+	        TCL_VOLATILE);
+    }
+    
+    /*
+     * Scan through all the arguments to see how much space is needed.
+     */
+
     newSpace = 0;
     while (1) {
 	string = va_arg(argList, char *);
@@ -1053,8 +1431,8 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
     va_end(argList);
 
     /*
-     * If the append buffer isn't already setup and large enough
-     * to hold the new data, set it up.
+     * If the append buffer isn't already setup and large enough to hold
+     * the new data, set it up.
      */
 
     if ((iPtr->result != iPtr->appendResult)
@@ -1064,8 +1442,8 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
     }
 
     /*
-     * Final step:  go through all the argument strings again, copying
-     * them into the buffer.
+     * Now go through all the argument strings again, copying them into the
+     * buffer.
      */
 
     TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
@@ -1085,18 +1463,20 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
  *
  * Tcl_AppendElement --
  *
- *	Convert a string to a valid Tcl list element and append it
- *	to the current result (which is ostensibly a list).
+ *	Convert a string to a valid Tcl list element and append it to the
+ *	result (which is ostensibly a list).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The result in the interpreter given by the first argument
- *	is extended with a list element converted from string.  A
- *	separator space is added before the converted list element
- *	unless the current result is empty, contains the single
- *	character "{", or ends in " {".
+ *	The result in the interpreter given by the first argument is
+ *	extended with a list element converted from string. A separator
+ *	space is added before the converted list element unless the current
+ *	result is empty, contains the single character "{", or ends in " {".
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
  *
  *----------------------------------------------------------------------
  */
@@ -1109,8 +1489,21 @@ Tcl_AppendElement(interp, string)
 				 * add to result. */
 {
     register Interp *iPtr = (Interp *) interp;
-    int size, flags;
     char *dst;
+    register int size;
+    int flags;
+
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+    }
 
     /*
      * See how much space is needed, and grow the append buffer if
@@ -1143,9 +1536,10 @@ Tcl_AppendElement(interp, string)
  *
  * SetupAppendBuffer --
  *
- *	This procedure makes sure that there is an append buffer
- *	properly initialized for interp, and that it has at least
- *	enough room to accommodate newSpace new bytes of information.
+ *	This procedure makes sure that there is an append buffer properly
+ *	initialized, if necessary, from the interpreter's result, and
+ *	that it has at least enough room to accommodate newSpace new
+ *	bytes of information.
  *
  * Results:
  *	None.
@@ -1165,9 +1559,9 @@ SetupAppendBuffer(iPtr, newSpace)
     int totalSpace;
 
     /*
-     * Make the append buffer larger, if that's necessary, then
-     * copy the current result into the append buffer and make the
-     * append buffer the official Tcl result.
+     * Make the append buffer larger, if that's necessary, then copy the
+     * result into the append buffer and make the append buffer the official
+     * Tcl result.
      */
 
     if (iPtr->result != iPtr->appendResult) {
@@ -1192,6 +1586,7 @@ SetupAppendBuffer(iPtr, newSpace)
 
 	iPtr->appendUsed = strlen(iPtr->result);
     }
+    
     totalSpace = newSpace + iPtr->appendUsed;
     if (totalSpace >= iPtr->appendAvl) {
 	char *new;
@@ -1211,26 +1606,69 @@ SetupAppendBuffer(iPtr, newSpace)
     } else if (iPtr->result != iPtr->appendResult) {
 	strcpy(iPtr->appendResult, iPtr->result);
     }
-    Tcl_FreeResult(iPtr);
+    
+    Tcl_FreeResult((Tcl_Interp *) iPtr);
     iPtr->result = iPtr->appendResult;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ResetResult --
+ * Tcl_FreeResult --
  *
- *	This procedure restores the result area for an interpreter
- *	to its default initialized state, freeing up any memory that
- *	may have been allocated for the result and clearing any
- *	error information for the interpreter.
+ *	This procedure frees up the memory associated with an interpreter's
+ *	string result. It also resets the interpreter's result object.
+ *	Tcl_FreeResult is most commonly used when a procedure is about to
+ *	replace one result value with another.
  *
  * Results:
  *	None.
  *
  * Side effects:
+ *	Frees the memory associated with interp's string result and sets
+ *	interp->freeProc to zero, but does not change interp->result or
+ *	clear error state. Resets interp's result object to an unshared
+ *	empty object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeResult(interp)
+    register Tcl_Interp *interp; /* Interpreter for which to free result. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    
+    if (iPtr->freeProc != NULL) {
+	if ((iPtr->freeProc == TCL_DYNAMIC)
+	        || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+	    ckfree(iPtr->result);
+	} else {
+	    (*iPtr->freeProc)(iPtr->result);
+	}
+	iPtr->freeProc = 0;
+    }
+    
+    TclResetObjResult(iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ResetResult --
+ *
+ *	This procedure resets both the interpreter's string and object
+ *	results.
+ *
+ * Results:
  *	None.
  *
+ * Side effects:
+ *	It resets the result object to an unshared empty object. It
+ *	then restores the interpreter's string result area to its default
+ *	initialized state, freeing up any memory that may have been
+ *	allocated. It also clears any error information for the interpreter.
+ *
  *----------------------------------------------------------------------
  */
 
@@ -1240,11 +1678,13 @@ Tcl_ResetResult(interp)
 {
     register Interp *iPtr = (Interp *) interp;
 
-    Tcl_FreeResult(iPtr);
+    TclResetObjResult(iPtr);
+    
+    Tcl_FreeResult(interp);
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
-    iPtr->flags &=
-	    ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
+    
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
 }
 
 /*
@@ -1299,47 +1739,38 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 /*
  *----------------------------------------------------------------------
  *
- * TclGetListIndex --
+ * Tcl_SetObjErrorCode --
  *
- *	Parse a list index, which may be either an integer or the
- *	value "end".
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned. The caller should
+ *	build a list object up and pass it to this routine.
  *
  * Results:
- *	The return value is either TCL_OK or TCL_ERROR.  If it is
- *	TCL_OK, then the index corresponding to string is left in
- *	*indexPtr.  If the return value is TCL_ERROR, then string
- *	was bogus;  an error message is returned in interp->result.
- *	If a negative index is specified, it is rounded up to 0.
- *	The index value may be larger than the size of the list
- *	(this happens when "end" is specified).
+ *	None.
  *
  * Side effects:
- *	None.
+ *	The errorCode global variable is modified to be the new value.
+ *	A flag is set internally to remember that errorCode has been
+ *	set, so the variable doesn't get set automatically when the
+ *	error is returned.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclGetListIndex(interp, string, indexPtr)
-    Tcl_Interp *interp;			/* Interpreter for error reporting. */
-    char *string;			/* String containing list index. */
-    int *indexPtr;			/* Where to store index. */
+void
+Tcl_SetObjErrorCode(interp, errorObjPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *errorObjPtr;
 {
-    if (isdigit(UCHAR(*string)) || (*string == '-')) {
-	if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (*indexPtr < 0) {
-	    *indexPtr = 0;
-	}
-    } else if (strncmp(string, "end", strlen(string)) == 0) {
-	*indexPtr = INT_MAX;
-    } else {
-	Tcl_AppendResult(interp, "bad index \"", string,
-		"\": must be integer or \"end\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
+    Tcl_Obj *namePtr;
+    Interp *iPtr;
+    
+    namePtr = Tcl_NewStringObj("errorCode", -1);
+    iPtr = (Interp *) interp;
+    Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, errorObjPtr,
+	    TCL_GLOBAL_ONLY);
+    iPtr->flags |= ERROR_CODE_SET;
+    Tcl_DecrRefCount(namePtr);
 }
 
 /*
@@ -1599,7 +2030,7 @@ Tcl_DStringInit(dsPtr)
  *
  * Side effects:
  *	Length bytes from string (or all of string if length is less
- *	than zero) are added to the current value of the string.  Memory
+ *	than zero) are added to the current value of the string. Memory
  *	gets reallocated if needed to accomodate the string's new size.
  *
  *----------------------------------------------------------------------
@@ -1626,14 +2057,14 @@ Tcl_DStringAppend(dsPtr, string, length)
 
     /*
      * Allocate a larger buffer for the string if the current one isn't
-     * large enough.  Allocate extra space in the new buffer so that there
+     * large enough. Allocate extra space in the new buffer so that there
      * will be room to grow before we have to allocate again.
      */
 
     if (newSize >= dsPtr->spaceAvl) {
 	dsPtr->spaceAvl = newSize*2;
 	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
-	memcpy((VOID *)newString, (VOID *) dsPtr->string,
+	memcpy((VOID *) newString, (VOID *) dsPtr->string,
 		(size_t) dsPtr->length);
 	if (dsPtr->string != dsPtr->staticSpace) {
 	    ckfree(dsPtr->string);
@@ -1810,15 +2241,15 @@ Tcl_DStringFree(dsPtr)
  * Tcl_DStringResult --
  *
  *	This procedure moves the value of a dynamic string into an
- *	interpreter as its result.  The string itself is reinitialized
- *	to an empty string.
+ *	interpreter as its string result. Afterwards, the dynamic string
+ *	is reset to an empty string.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	The string is "moved" to interp's result, and any existing
- *	result for interp is freed up.  DsPtr is reinitialized to
+ *	string result for interp is freed. dsPtr is reinitialized to
  *	an empty string.
  *
  *----------------------------------------------------------------------
@@ -1826,12 +2257,13 @@ Tcl_DStringFree(dsPtr)
 
 void
 Tcl_DStringResult(interp, dsPtr)
-    Tcl_Interp *interp;			/* Interpreter whose result is to be
-					 * reset. */
-    Tcl_DString *dsPtr;			/* Dynamic string that is to become
-					 * the result of interp. */
+    Tcl_Interp *interp;		 /* Interpreter whose result is to be
+				  * reset. */
+    register Tcl_DString *dsPtr; /* Dynamic string that is to become
+				  * the result of interp. */
 {
     Tcl_ResetResult(interp);
+    
     if (dsPtr->string != dsPtr->staticSpace) {
 	interp->result = dsPtr->string;
 	interp->freeProc = TCL_DYNAMIC;
@@ -1841,6 +2273,7 @@ Tcl_DStringResult(interp, dsPtr)
     } else {
 	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
     }
+    
     dsPtr->string = dsPtr->staticSpace;
     dsPtr->length = 0;
     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
@@ -1852,30 +2285,46 @@ Tcl_DStringResult(interp, dsPtr)
  *
  * Tcl_DStringGetResult --
  *
- *	This procedure moves the result of an interpreter into a
- *	dynamic string.
+ *	This procedure moves an interpreter's result into a dynamic string.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The interpreter's result is cleared, and the previous contents
- *	of dsPtr are freed.
+ *	The interpreter's string result is cleared, and the previous
+ *	contents of dsPtr are freed.
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 void
 Tcl_DStringGetResult(interp, dsPtr)
-    Tcl_Interp *interp;			/* Interpreter whose result is to be
-					 * reset. */
-    Tcl_DString *dsPtr;			/* Dynamic string that is to become
-					 * the result of interp. */
+    Tcl_Interp *interp;		 /* Interpreter whose result is to be
+				  * reset. */
+    register Tcl_DString *dsPtr; /* Dynamic string that is to become the
+				  * result of interp. */
 {
-    Interp *iPtr = (Interp *) interp;
+    register Interp *iPtr = (Interp *) interp;
+    
     if (dsPtr->string != dsPtr->staticSpace) {
 	ckfree(dsPtr->string);
     }
+
+    /*
+     * If the string result is empty, move the object result to the
+     * string result, then reset the object result.
+     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+     */
+
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+    }
+
     dsPtr->length = strlen(iPtr->result);
     if (iPtr->freeProc != NULL) {
 	if ((iPtr->freeProc == TCL_DYNAMIC)
@@ -1899,6 +2348,7 @@ Tcl_DStringGetResult(interp, dsPtr)
 	}
 	strcpy(dsPtr->string, iPtr->result);
     }
+    
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
 }
@@ -1981,14 +2431,16 @@ Tcl_DStringEndSublist(dsPtr)
 void
 Tcl_PrintDouble(interp, value, dst)
     Tcl_Interp *interp;			/* Interpreter whose tcl_precision
-					 * variable controls printing. */
+					 * variable used to be used to control
+					 * printing.  It's ignored now. */
     double value;			/* Value to print as string. */
     char *dst;				/* Where to store converted value;
 					 * must have at least TCL_DOUBLE_SPACE
 					 * characters. */
 {
     register char *p;
-    sprintf(dst, ((Interp *) interp)->pdFormat, value);
+
+    sprintf(dst, "%.17g", value);
 
     /*
      * If the ASCII result looks like an integer, add ".0" so that it
@@ -2009,73 +2461,6 @@ Tcl_PrintDouble(interp, value, dst)
 /*
  *----------------------------------------------------------------------
  *
- * TclPrecTraceProc --
- *
- *	This procedure is invoked whenever the variable "tcl_precision"
- *	is written.
- *
- * Results:
- *	Returns NULL if all went well, or an error message if the
- *	new value for the variable doesn't make sense.
- *
- * Side effects:
- *	If the new value doesn't make sense then this procedure
- *	undoes the effect of the variable modification.  Otherwise
- *	it modifies the format string that's used by Tcl_PrintDouble.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-char *
-TclPrecTraceProc(clientData, interp, name1, name2, flags)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    char *name1;		/* Name of variable. */
-    char *name2;		/* Second part of variable name. */
-    int flags;			/* Information about what happened. */
-{
-    register Interp *iPtr = (Interp *) interp;
-    char *value, *end;
-    int prec;
-
-    /*
-     * If the variable is unset, then recreate the trace and restore
-     * the default value of the format string.
-     */
-
-    if (flags & TCL_TRACE_UNSETS) {
-	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
-	    Tcl_TraceVar2(interp, name1, name2,
-		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-		    TclPrecTraceProc, clientData);
-	}
-	strcpy(iPtr->pdFormat, DEFAULT_PD_FORMAT);
-	iPtr->pdPrec = DEFAULT_PD_PREC;
-	return (char *) NULL;
-    }
-
-    value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
-    if (value == NULL) {
-	value = "";
-    }
-    prec = strtoul(value, &end, 10);
-    if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
-	    (end == value) || (*end != 0)) {
-	char oldValue[10];
-
-	sprintf(oldValue, "%d", iPtr->pdPrec);
-	Tcl_SetVar2(interp, name1, name2, oldValue, flags & TCL_GLOBAL_ONLY);
-	return "improper value for precision";
-    }
-    sprintf(iPtr->pdFormat, "%%.%dg", prec);
-    iPtr->pdPrec = prec;
-    return (char *) NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclNeedSpace --
  *
  *	This procedure checks to see whether it is appropriate to
@@ -2128,3 +2513,239 @@ TclNeedSpace(start, end)
     }
     return 1;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFormatInt --
+ *
+ *	This procedure formats an integer into a sequence of decimal digit
+ *	characters in a buffer. If the integer is negative, a minus sign is
+ *	inserted at the start of the buffer. A null character is inserted at
+ *	the end of the formatted characters. It is the caller's
+ *	responsibility to ensure that enough storage is available. This
+ *	procedure has the effect of sprintf(buffer, "%d", n) but is faster.
+ *
+ * Results:
+ *	An integer representing the number of characters formatted, not
+ *	including the terminating \0.
+ *
+ * Side effects:
+ *	The formatted characters are written into the storage pointer to
+ *	by the "buffer" argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFormatInt(buffer, n)
+    register char *buffer;	/* Points to the storage into which the
+				 * formatted characters are written. */
+    long n;			/* The integer to format. */
+{
+    register long intVal;
+    register int i;
+    int numFormatted, j;
+    char *digits = "0123456789";
+
+    /*
+     * Check first whether "n" is the maximum negative value. This is
+     * -2^(m-1) for an m-bit word, and has no positive equivalent;
+     * negating it produces the same value.
+     */
+
+    if (n == -n) {
+	sprintf(buffer, "%ld", n);
+	return strlen(buffer);
+    }
+
+    /*
+     * Generate the characters of the result backwards in the buffer.
+     */
+
+    intVal = (n < 0? -n : n);
+    i = 0;
+    buffer[0] = '\0';
+    do {
+	i++;
+	buffer[i] = digits[intVal % 10];
+	intVal = intVal/10;
+    } while (intVal > 0);
+    if (n < 0) {
+	i++;
+	buffer[i] = '-';
+    }
+    numFormatted = i;
+
+    /*
+     * Now reverse the characters.
+     */
+
+    for (j = 0;  j < i;  j++, i--) {
+	char tmp = buffer[i];
+	buffer[i] = buffer[j];
+	buffer[j] = tmp;
+    }
+    return numFormatted;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLooksLikeInt --
+ *
+ *	This procedure decides whether the leading characters of a
+ *	string look like an integer or something else (such as a
+ *	floating-point number or string).
+ *
+ * Results:
+ *	The return value is 1 if the leading characters of p look
+ *	like a valid Tcl integer.  If they look like a floating-point
+ *	number (e.g. "e01" or "2.4"), or if they don't look like a
+ *	number at all, then 0 is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLooksLikeInt(p)
+    register char *p;		/* Pointer to string. */
+{
+    while (isspace(UCHAR(*p))) {
+	p++;
+    }
+    if ((*p == '+') || (*p == '-')) {
+	p++;
+    }
+    if (!isdigit(UCHAR(*p))) {
+	return 0;
+    }
+    p++;
+    while (isdigit(UCHAR(*p))) {
+	p++;
+    }
+    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
+	return 1;
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WrongNumArgs --
+ *
+ *	This procedure generates a "wrong # args" error message in an
+ *	interpreter.  It is used as a utility function by many command
+ *	procedures.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An error message is generated in interp's result object to
+ *	indicate that a command was invoked with the wrong number of
+ *	arguments.  The message has the form
+ *		wrong # args: should be "foo bar additional stuff"
+ *	where "foo" and "bar" are the initial objects in objv (objc
+ *	determines how many of these are printed) and "additional stuff"
+ *	is the contents of the message argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_WrongNumArgs(interp, objc, objv, message)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments to print
+					 * from objv. */
+    Tcl_Obj *CONST objv[];		/* Initial argument objects, which
+					 * should be included in the error
+					 * message. */
+    char *message;			/* Error message to print after the
+					 * leading objects in objv. */
+{
+    Tcl_Obj *objPtr;
+    int i;
+
+    objPtr = Tcl_GetObjResult(interp);
+    Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+    for (i = 0; i < objc; i++) {
+	Tcl_AppendStringsToObj(objPtr,
+		Tcl_GetStringFromObj(objv[i], (int *) NULL), " ",
+		(char *) NULL);
+    }
+    Tcl_AppendStringsToObj(objPtr, message, "\"", (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetIntForIndex --
+ *
+ *	This procedure returns an integer corresponding to the list index
+ *	held in a Tcl object. The Tcl object's value is expected to be
+ *	either an integer or the string "end". 
+ *
+ * Results:
+ *	The return value is normally TCL_OK, which means that the index was
+ *	successfully stored into the location referenced by "indexPtr".  If
+ *	the Tcl object referenced by "objPtr" has the value "end", the
+ *	value stored is "endValue". If "objPtr"s values is not "end" and
+ *	can not be converted to an integer, TCL_ERROR is returned and, if
+ *	"interp" is non-NULL, an error message is left in the interpreter's
+ *	result object.
+ *
+ * Side effects:
+ *	The object referenced by "objPtr" might be converted to an
+ *	integer object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
+     Tcl_Interp *interp;	/* Interpreter to use for error reporting. 
+				 * If NULL, then no error message is left
+				 * after errors. */
+     register Tcl_Obj *objPtr;	/* Points to an object containing either
+				 * "end" or an integer. */
+     int endValue;		/* The value to be stored at "indexPtr" if
+				 * "objPtr" holds "end". */
+     register int *indexPtr;	/* Location filled in with an integer
+				 * representing an index. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register char *bytes;
+    int index, length, result;
+
+    /*
+     * THIS FAILS IF THE INDEX OBJECT'S STRING REP CONTAINS NULLS.
+     */
+    
+    if (objPtr->typePtr == &tclIntType) {
+	*indexPtr = (int)objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+    
+    bytes = TclGetStringFromObj(objPtr, &length);
+    if ((*bytes == 'e')
+	    && (strncmp(bytes, "end", (unsigned) length) == 0)) {
+	index = endValue;
+    } else {
+	result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objPtr, &index);
+	if (result != TCL_OK) {
+	    if (iPtr != NULL) {
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"bad index \"", bytes,
+			"\": must be integer or \"end\"", (char *) NULL);
+	    }
+	    return result;
+	}
+    }
+    *indexPtr = index;
+    return TCL_OK;
+}
diff --git a/contrib/tcl/generic/tclVar.c b/contrib/tcl/generic/tclVar.c
index c5c2147..577ba74 100644
--- a/contrib/tcl/generic/tclVar.c
+++ b/contrib/tcl/generic/tclVar.c
@@ -8,12 +8,12 @@
  *	implementation by Mark Diekhans and Karl Lehenbauer.
  *
  * Copyright (c) 1987-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclVar.c 1.69 96/02/28 21:45:10
+ * SCCS: @(#) tclVar.c 1.113 97/06/25 08:54:16
  */
 
 #include "tclInt.h"
@@ -29,29 +29,8 @@ static char *isArray =		"variable is array";
 static char *needArray =	"variable isn't array";
 static char *noSuchElement =	"no such element in array";
 static char *danglingUpvar =	"upvar refers to element in deleted array";
-
-/*
- * Creation flag values passed in to LookupVar:
- *
- * CRT_PART1 -		1 means create hash table entry for part 1 of
- *			name, if it doesn't already exist.  0 means
- *			return an error if it doesn't exist.
- * CRT_PART2 -		1 means create hash table entry for part 2 of
- *			name, if it doesn't already exist.  0 means
- *			return an error if it doesn't exist.
- */
-
-#define CRT_PART1	1
-#define CRT_PART2	2
-
-/*
- * The following additional flag is used internally and passed through
- * to LookupVar to indicate that a procedure like Tcl_GetVar was called
- * instead of Tcl_GetVar2 and the single name value hasn't yet been
- * parsed into an array name and index (if any).
- */
-
-#define PART1_NOT_PARSED	0x10000
+static char *badNamespace =	"parent namespace doesn't exist";
+static char *missingName =	"missing variable name";
 
 /*
  * Forward references to procedures defined later in this file:
@@ -60,16 +39,15 @@ static char *danglingUpvar =	"upvar refers to element in deleted array";
 static  char *		CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
 			    Var *varPtr, char *part1, char *part2,
 			    int flags));
-static void		CleanupVar _ANSI_ARGS_((Var *varPtr, Var *arrayPtr));
+static void		CleanupVar _ANSI_ARGS_((Var *varPtr,
+			    Var *arrayPtr));
 static void		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
-static void		DeleteArray _ANSI_ARGS_((Interp *iPtr, char *arrayName,
-			    Var *varPtr, int flags));
-static Var *		LookupVar _ANSI_ARGS_((Tcl_Interp *interp, char *part1,
-			    char *part2, int flags, char *msg, int create,
-			    Var **arrayPtrPtr));
-static int		MakeUpvar _ANSI_ARGS_((Interp *iPtr,
-			    CallFrame *framePtr, char *otherP1,
-			    char *otherP2, char *myName, int flags));
+static void		DeleteArray _ANSI_ARGS_((Interp *iPtr,
+			    char *arrayName, Var *varPtr, int flags));
+static int		MakeUpvar _ANSI_ARGS_((
+			    Interp *iPtr, CallFrame *framePtr,
+			    char *otherP1, char *otherP2, int otherFlags,
+			    char *myName, int myFlags));
 static Var *		NewVar _ANSI_ARGS_((void));
 static ArraySearch *	ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
 			    Var *varPtr, char *varName, char *string));
@@ -80,75 +58,106 @@ static void		VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
 /*
  *----------------------------------------------------------------------
  *
- * LookupVar --
+ * TclLookupVar --
  *
- *	This procedure is used by virtually all of the variable
- *	code to locate a variable given its name(s).
+ *	This procedure is used by virtually all of the variable code to
+ *	locate a variable given its name(s).
  *
  * Results:
- *	The return value is a pointer to the variable indicated by
- *	part1 and part2, or NULL if the variable couldn't be found.
- *	If the variable is found, *arrayPtrPtr is filled in with
- *	the address of the array that contains the variable (or NULL
- *	if the variable is a scalar).  Note:  it's possible that the
- *	variable returned may be VAR_UNDEFINED, even if CRT_PART1 and
- *	CRT_PART2 are specified (these only cause the hash table entry
- *	and/or array to be created).
+ *	The return value is a pointer to the variable structure indicated by
+ *	part1 and part2, or NULL if the variable couldn't be found. If the
+ *	variable is found, *arrayPtrPtr is filled in with the address of the
+ *	variable structure for the array that contains the variable (or NULL
+ *	if the variable is a scalar). If the variable can't be found and
+ *	either createPart1 or createPart2 are 1, a new as-yet-undefined
+ *	(VAR_UNDEFINED) variable structure is created, entered into a hash
+ *	table, and returned.
+ *
+ *	If the variable isn't found and creation wasn't specified, or some
+ *	other error occurs, NULL is returned and an error message is left in
+ *	interp->result if TCL_LEAVE_ERR_MSG is set in flags. (The result
+ *	isn't put in interp->objResultPtr because this procedure is used
+ *	by so many string-based routines.)
+ *
+ *	Note: it's possible for the variable returned to be VAR_UNDEFINED
+ *	even if createPart1 or createPart2 are 1 (these only cause the hash
+ *	table entry or array to be created). For example, the variable might
+ *	be a global that has been unset but is still referenced by a
+ *	procedure, or a variable that has been unset but it only being kept
+ *	in existence (if VAR_UNDEFINED) by a trace.
  *
  * Side effects:
- *	None.
+ *	New hashtable entries may be created if createPart1 or createPart2
+ *	are 1.
  *
  *----------------------------------------------------------------------
  */
 
-static Var *
-LookupVar(interp, part1, part2, flags, msg, create, arrayPtrPtr)
+Var *
+TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
+        arrayPtrPtr)
     Tcl_Interp *interp;		/* Interpreter to use for lookup. */
-    char *part1;		/* If part2 isn't NULL, this is the name
-				 * of an array.  Otherwise, if the
-				 * PART1_NOT_PARSED flag bit is set this
+    char *part1;		/* If part2 isn't NULL, this is the name of
+				 * an array. Otherwise, if the
+				 * TCL_PARSE_PART1 flag bit is set this
 				 * is a full variable name that could
-				 * include a parenthesized array elemnt.
-				 * If PART1_NOT_PARSED isn't present, then
+				 * include a parenthesized array elemnt. If
+				 * TCL_PARSE_PART1 isn't present, then
 				 * this is the name of a scalar variable. */
-    char *part2;		/* Name of an element within array, or NULL. */
-    int flags;			/* Only the TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG,
-				 * and PART1_NOT_PARSED bits matter. */
+    char *part2;		/* Name of element within array, or NULL. */
+    int flags;			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_LEAVE_ERR_MSG, and
+				 * TCL_PARSE_PART1 bits matter. */
     char *msg;			/* Verb to use in error messages, e.g.
-				 * "read" or "set".  Only needed if
+				 * "read" or "set". Only needed if
 				 * TCL_LEAVE_ERR_MSG is set in flags. */
-    int create;			/* OR'ed combination of CRT_PART1 and
-				 * CRT_PART2.  Tells which entries to create
-				 * if they don't already exist. */
+    int createPart1;		/* If 1, create hash table entry for part 1
+				 * of name, if it doesn't already exist. If
+				 * 0, return error if it doesn't exist. */
+    int createPart2;		/* If 1, create hash table entry for part 2
+				 * of name, if it doesn't already exist. If
+				 * 0, return error if it doesn't exist. */
     Var **arrayPtrPtr;		/* If the name refers to an element of an
 				 * array, *arrayPtrPtr gets filled in with
-				 * address of array variable.  Otherwise
+				 * address of array variable. Otherwise
 				 * this is set to NULL. */
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_HashTable *tablePtr;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Tcl_HashTable *tablePtr;	/* Points to the hashtable, if any, in which
+				 * to look up the variable. */
+    Tcl_Var var;                /* Used to search for global names. */
+    Var *varPtr;		/* Points to the Var structure returned for
+    				 * the variable. */
+    char *elName;		/* Name of array element or NULL; may be
+				 * same as part2, or may be openParen+1. */
+    char *openParen, *closeParen;
+                                /* If this procedure parses a name into
+				 * array and index, these point to the
+				 * parens around the index.  Otherwise they
+				 * are NULL. These are needed to restore
+				 * the parens after parsing the name. */
+    Namespace *varNsPtr, *dummy1Ptr, *dummy2Ptr;
     Tcl_HashEntry *hPtr;
-    Var *varPtr;
-    int new;
-    char *openParen, *closeParen;	/* If this procedure parses a name
-					 * into array and index, these point
-					 * to the parens around the index.
-					 * Otherwise they are NULL.  These
-					 * are needed to restore the parens
-					 * after parsing the name. */
-    char *elName;			/* Name of array element or NULL;
-					 * may be same as part2, or may be
-					 * openParen+1. */
-    char *p;
+    register char *p;
+    int new, i, result;
+
+    varPtr = NULL;
+    *arrayPtrPtr = NULL;
+    openParen = closeParen = NULL;
+    varNsPtr = NULL;		/* set non-NULL if a nonlocal variable */
 
     /*
      * If the name hasn't been parsed into array name and index yet,
      * do it now.
      */
 
-    openParen = closeParen = NULL;
     elName = part2;
-    if (flags & PART1_NOT_PARSED) {
+    if (flags & TCL_PARSE_PART1) {
 	for (p = part1; ; p++) {
 	    if (*p == 0) {
 		elName = NULL;
@@ -174,73 +183,186 @@ LookupVar(interp, part1, part2, flags, msg, create, arrayPtrPtr)
     }
 
     /*
-     * Lookup part1.
+     * Look up part1. Look it up as either a namespace variable or as a
+     * local variable in a procedure call frame (varFramePtr).
+     * Interpret part1 as a namespace variable if:
+     *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
+     *    2) there is no active frame (we're at the global :: scope),
+     *    3) the active frame was pushed to define the namespace context
+     *       for a "namespace eval" or "namespace inscope" command,
+     *    4) the name has namespace qualifiers ("::"s).
+     * Otherwise, if part1 is a local variable, search first in the
+     * frame's array of compiler-allocated local variables, then in its
+     * hashtable for runtime-created local variables.
+     *
+     * If createPart1 and the variable isn't found, create the variable and,
+     * if necessary, create varFramePtr's local var hashtable.
      */
 
-    *arrayPtrPtr = NULL;
-    if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
-	tablePtr = &iPtr->globalTable;
-    } else {
-	tablePtr = &iPtr->varFramePtr->varTable;
-    }
-    if (create & CRT_PART1) {
-	hPtr = Tcl_CreateHashEntry(tablePtr, part1, &new);
-	if (openParen != NULL) {
-	    *openParen = '(';
-	}
-	if (new) {
-	    varPtr = NewVar();
-	    Tcl_SetHashValue(hPtr, varPtr);
-	    varPtr->hPtr = hPtr;
+    if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
+	        || (varFramePtr == NULL)
+	        || !varFramePtr->isProcCallFrame
+	        || (strstr(part1, "::") != NULL)) {
+	char *tail;
+	
+	var = Tcl_FindNamespaceVar(interp, part1, (Tcl_Namespace *) NULL,
+	        flags);
+	if (var != (Tcl_Var) NULL) {
+            varPtr = (Var *) var;
+        }
+	if (varPtr == NULL) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		Tcl_ResetResult(interp);
+	    }
+	    if (createPart1) {   /* var wasn't found so create it  */
+		result = TclGetNamespaceForQualName(interp, part1,
+		        (Namespace *) NULL, flags, &varNsPtr, &dummy1Ptr,
+			&dummy2Ptr, &tail);
+		if (result != TCL_OK) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			/*
+			 * Move the interpreter's object result to the
+			 * string result, then reset the object result.
+			 * FAILS IF OBJECT RESULT'S STRING REP HAS NULLS.
+			 */
+			
+			Tcl_SetResult(interp,
+	                        TclGetStringFromObj(Tcl_GetObjResult(interp),
+				    (int *) NULL),
+	                        TCL_VOLATILE);
+		    }
+		    goto done;
+		}
+		if (varNsPtr == NULL) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			VarErrMsg(interp, part1, part2, msg, badNamespace);
+		    }
+		    goto done;
+		}
+		if (tail == NULL) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			VarErrMsg(interp, part1, part2, msg, missingName);
+		    }
+		    goto done;
+		}
+		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
+		varPtr = NewVar();
+		Tcl_SetHashValue(hPtr, varPtr);
+		varPtr->hPtr = hPtr;
+		varPtr->nsPtr = varNsPtr;
+	    } else {		/* var wasn't found and not to create it */
+		if (flags & TCL_LEAVE_ERR_MSG) {
+		    VarErrMsg(interp, part1, part2, msg, noSuchVar);
+		}
+		goto done;
+	    }
 	}
-    } else {
-	hPtr = Tcl_FindHashEntry(tablePtr, part1);
-	if (openParen != NULL) {
-	    *openParen = '(';
+    } else {			/* local var: look in frame varFramePtr */
+	Proc *procPtr = varFramePtr->procPtr;
+	int localCt = procPtr->numCompiledLocals;
+	CompiledLocal *localPtr = procPtr->firstLocalPtr;
+	Var *localVarPtr = varFramePtr->compiledLocals;
+	int part1Len = strlen(part1);
+	
+	for (i = 0;  i < localCt;  i++) {
+	    if (!localPtr->isTemp) {
+		char *localName = localVarPtr->name;
+		if ((part1[0] == localName[0])
+		        && (part1Len == localPtr->nameLength)
+		        && (strcmp(part1, localName) == 0)) {
+		    varPtr = localVarPtr;
+		    break;
+		}
+	    }
+	    localVarPtr++;
+	    localPtr = localPtr->nextPtr;
 	}
-	if (hPtr == NULL) {
-	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, part1, part2, msg, noSuchVar);
+	if (varPtr == NULL) {	/* look in the frame's var hash table */
+	    tablePtr = varFramePtr->varTablePtr;
+	    if (createPart1) {
+		if (tablePtr == NULL) {
+		    tablePtr = (Tcl_HashTable *)
+			    ckalloc(sizeof(Tcl_HashTable));
+		    Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+		    varFramePtr->varTablePtr = tablePtr;
+		}
+		hPtr = Tcl_CreateHashEntry(tablePtr, part1, &new);
+		if (new) {
+		    varPtr = NewVar();
+		    Tcl_SetHashValue(hPtr, varPtr);
+		    varPtr->hPtr = hPtr;
+                    varPtr->nsPtr = NULL; /* a local variable */
+		} else {
+		    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+		}
+	    } else {
+		hPtr = NULL;
+		if (tablePtr != NULL) {
+		    hPtr = Tcl_FindHashEntry(tablePtr, part1);
+		}
+		if (hPtr == NULL) {
+		    if (flags & TCL_LEAVE_ERR_MSG) {
+			VarErrMsg(interp, part1, part2, msg, noSuchVar);
+		    }
+		    goto done;
+		}
+		varPtr = (Var *) Tcl_GetHashValue(hPtr);
 	    }
-	    return NULL;
 	}
     }
-    varPtr = (Var *) Tcl_GetHashValue(hPtr);
-    if (varPtr->flags & VAR_UPVAR) {
-	varPtr = varPtr->value.upvarPtr;
+    if (openParen != NULL) {
+	*openParen = '(';
+	openParen = NULL;
     }
 
+    /*
+     * If varPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command. Traverse
+     * through any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(varPtr)) {
+	varPtr = varPtr->value.linkPtr;
+    }
+
+    /*
+     * If we're not dealing with an array element, return varPtr.
+     */
+    
     if (elName == NULL) {
-	return varPtr;
+        goto done;
     }
 
     /*
-     * We're dealing with an array element, so make sure the variable
-     * is an array and lookup the element (create it if desired).
+     * We're dealing with an array element. Make sure the variable is an
+     * array and look up the element (create the element if desired).
      */
 
-    if (varPtr->flags & VAR_UNDEFINED) {
-	if (!(create & CRT_PART1)) {
+    if (TclIsVarUndefined(varPtr) && !TclIsVarArrayElement(varPtr)) {
+	if (!createPart1) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		VarErrMsg(interp, part1, part2, msg, noSuchVar);
 	    }
-	    return NULL;
+	    varPtr = NULL;
+	    goto done;
 	}
-	varPtr->flags = VAR_ARRAY;
-	varPtr->value.tablePtr = (Tcl_HashTable *)
-		ckalloc(sizeof(Tcl_HashTable));
+	TclSetVarArray(varPtr);
+	TclClearVarUndefined(varPtr);
+	varPtr->value.tablePtr =
+	        (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
 	Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
-    } else if (!(varPtr->flags & VAR_ARRAY)) {
+    } else if (!TclIsVarArray(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, part1, part2, msg, needArray);
 	}
-	return NULL;
+	varPtr = NULL;
+	goto done;
     }
     *arrayPtrPtr = varPtr;
     if (closeParen != NULL) {
 	*closeParen = 0;
     }
-    if (create & CRT_PART2) {
+    if (createPart2) {
 	hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, elName, &new);
 	if (closeParen != NULL) {
 	    *closeParen = ')';
@@ -252,6 +374,8 @@ LookupVar(interp, part1, part2, flags, msg, create, arrayPtrPtr)
 	    varPtr = NewVar();
 	    Tcl_SetHashValue(hPtr, varPtr);
 	    varPtr->hPtr = hPtr;
+	    varPtr->nsPtr = varNsPtr;
+	    TclSetVarArrayElement(varPtr);
 	}
     } else {
 	hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, elName);
@@ -262,10 +386,17 @@ LookupVar(interp, part1, part2, flags, msg, create, arrayPtrPtr)
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		VarErrMsg(interp, part1, part2, msg, noSuchElement);
 	    }
-	    return NULL;
+	    varPtr = NULL;
+	    goto done;
 	}
     }
-    return (Var *) Tcl_GetHashValue(hPtr);
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+    done:
+    if (openParen != NULL) {
+        *openParen = '(';
+    }
+    return varPtr;
 }
 
 /*
@@ -273,17 +404,16 @@ LookupVar(interp, part1, part2, flags, msg, create, arrayPtrPtr)
  *
  * Tcl_GetVar --
  *
- *	Return the value of a Tcl variable.
+ *	Return the value of a Tcl variable as a string.
  *
  * Results:
- *	The return value points to the current value of varName.  If
- *	the variable is not defined or can't be read because of a clash
- *	in array usage then a NULL pointer is returned and an error
- *	message is left in interp->result if the TCL_LEAVE_ERR_MSG
- *	flag is set.  Note:  the return value is only valid up until
- *	the next call to Tcl_SetVar or Tcl_SetVar2;  if you depend on
- *	the value lasting longer than that, then make yourself a private
- *	copy.
+ *	The return value points to the current value of varName as a string.
+ *	If the variable is not defined or can't be read because of a clash
+ *	in array usage then a NULL pointer is returned and an error message
+ *	is left in interp->result if the TCL_LEAVE_ERR_MSG flag is set.
+ *	Note: the return value is only valid up until the next change to the
+ *	variable; if you depend on the value lasting longer than that, then
+ *	make yourself a private copy.
  *
  * Side effects:
  *	None.
@@ -296,11 +426,12 @@ Tcl_GetVar(interp, varName, flags)
     Tcl_Interp *interp;		/* Command interpreter in which varName is
 				 * to be looked up. */
     char *varName;		/* Name of a variable in interp. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY
-				 * or TCL_LEAVE_ERR_MSG bits. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
+				 * bits. */
 {
     return Tcl_GetVar2(interp, varName, (char *) NULL,
-	    flags | PART1_NOT_PARSED);
+		       (flags | TCL_PARSE_PART1));
 }
 
 /*
@@ -308,18 +439,17 @@ Tcl_GetVar(interp, varName, flags)
  *
  * Tcl_GetVar2 --
  *
- *	Return the value of a Tcl variable, given a two-part name
- *	consisting of array name and element within array.
+ *	Return the value of a Tcl variable as a string, given a two-part
+ *	name consisting of array name and element within array.
  *
  * Results:
- *	The return value points to the current value of the variable
- *	given by part1 and part2.  If the specified variable doesn't
- *	exist, or if there is a clash in array usage, then NULL is
- *	returned and a message will be left in interp->result if the
- *	TCL_LEAVE_ERR_MSG flag is set.  Note:  the return value is
- *	only valid up until the next call to Tcl_SetVar or Tcl_SetVar2;
- *	if you depend on the value lasting longer than that, then make
- *	yourself a private copy.
+ *	The return value points to the current value of the variable given
+ *	by part1 and part2 as a string. If the specified variable doesn't
+ *	exist, or if there is a clash in array usage, then NULL is returned
+ *	and a message will be left in interp->result if the
+ *	TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid
+ *	up until the next change to the variable; if you depend on the value
+ *	lasting longer than that, then make yourself a private copy.
  *
  * Side effects:
  *	None.
@@ -331,19 +461,111 @@ char *
 Tcl_GetVar2(interp, part1, part2, flags)
     Tcl_Interp *interp;		/* Command interpreter in which variable is
 				 * to be looked up. */
-    char *part1;		/* Name of array (if part2 is NULL) or
-				 * name of variable. */
-    char *part2;		/* If non-null, gives name of element in
-				 * array. */
+    char *part1;		/* Name of an array (if part2 is non-NULL)
+				 * or the name of a variable. */
+    char *part2;		/* If non-NULL, gives the name of an element
+				 * in the array part1. */
     int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
-				 * TCL_LEAVE_ERR_MSG, and PART1_NOT_PARSED
-				 * bits. */
+				 * TCL_NAMESPACE_ONLY, TCL_LEAVE_ERR_MSG,
+                                 * and TCL_PARSE_PART1 bits. */
+{
+    register Tcl_Obj *part1Ptr;
+    register Tcl_Obj *part2Ptr = NULL;
+    Tcl_Obj *objPtr;
+    int length;
+
+    length = strlen(part1);
+    TclNewObj(part1Ptr);
+    TclInitStringRep(part1Ptr, part1, length);
+    Tcl_IncrRefCount(part1Ptr);
+
+    if (part2 != NULL) {
+        length = strlen(part2);
+        TclNewObj(part2Ptr);
+        TclInitStringRep(part2Ptr, part2, length);
+	Tcl_IncrRefCount(part2Ptr);
+    }
+    
+    objPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+    
+    TclDecrRefCount(part1Ptr);	    /* done with the part1 name object */
+    if (part2Ptr != NULL) {
+	TclDecrRefCount(part2Ptr);  /* and the part2 name object */
+    }
+    
+    if (objPtr == NULL) {
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+	return NULL;
+    }
+
+    /*
+     * THIS FAILS IF Tcl_ObjGetVar2's RESULT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    return TclGetStringFromObj(objPtr, (int *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ObjGetVar2 --
+ *
+ *	Return the value of a Tcl variable as a Tcl object, given a
+ *	two-part name consisting of array name and element within array.
+ *
+ * Results:
+ *	The return value points to the current object value of the variable
+ *	given by part1Ptr and part2Ptr. If the specified variable doesn't
+ *	exist, or if there is a clash in array usage, then NULL is returned
+ *	and a message will be left in the interpreter's result if the
+ *	TCL_LEAVE_ERR_MSG flag is set.
+ *
+ * Side effects:
+ *	The ref count for the returned object is _not_ incremented to
+ *	reflect the returned reference; if you want to keep a reference to
+ *	the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
+				 * an array (if part2 is non-NULL) or the
+				 * name of a variable. */
+    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
+				 * the name of an element in the array
+				 * part1Ptr. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_LEAVE_ERR_MSG, and
+				 * TCL_PARSE_PART1 bits. */
 {
-    Var *varPtr, *arrayPtr;
     Interp *iPtr = (Interp *) interp;
+    register Var *varPtr;
+    Var *arrayPtr;
+    char *part1, *msg;
+    char *part2 = NULL;
+
+    /*
+     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
 
-    varPtr = LookupVar(interp, part1, part2, flags, "read", CRT_PART2,
-	    &arrayPtr);
+    part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
+    if (part2Ptr != NULL) {
+	part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
+    }
+    varPtr = TclLookupVar(interp, part1, part2, flags, "read",
+            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return NULL;
     }
@@ -354,25 +576,29 @@ Tcl_GetVar2(interp, part1, part2, flags)
 
     if ((varPtr->tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	char *msg;
-
 	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|PART1_NOT_PARSED)) | TCL_TRACE_READS);
+		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_READS);
 	if (msg != NULL) {
-	    VarErrMsg(interp, part1, part2, "read", msg);
-	    goto cleanup;
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, "read", msg);
+	    }
+	    goto errorReturn;
 	}
     }
-    if (!(varPtr->flags & (VAR_UNDEFINED|VAR_UPVAR|VAR_ARRAY))) {
-	return varPtr->value.string;
+
+    /*
+     * Return the element if it's an existing scalar variable.
+     */
+    
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
     }
+    
     if (flags & TCL_LEAVE_ERR_MSG) {
-	char *msg;
-
-	if ((varPtr->flags & VAR_UNDEFINED) && (arrayPtr != NULL)
-		&& !(arrayPtr->flags & VAR_UNDEFINED)) {
+	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+	        && !TclIsVarUndefined(arrayPtr)) {
 	    msg = noSuchElement;
-	} else if (varPtr->flags & VAR_ARRAY) {
+	} else if (TclIsVarArray(varPtr)) {
 	    msg = isArray;
 	} else {
 	    msg = noSuchVar;
@@ -381,12 +607,12 @@ Tcl_GetVar2(interp, part1, part2, flags)
     }
 
     /*
-     * If the variable doesn't exist anymore and no-one's using it,
-     * then free up the relevant structures and hash table entries.
+     * An error. If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
      */
 
-    cleanup:
-    if (varPtr->flags & VAR_UNDEFINED) {
+    errorReturn:
+    if (TclIsVarUndefined(varPtr)) {
 	CleanupVar(varPtr, arrayPtr);
     }
     return NULL;
@@ -395,20 +621,345 @@ Tcl_GetVar2(interp, part1, part2, flags)
 /*
  *----------------------------------------------------------------------
  *
+ * TclGetIndexedScalar --
+ *
+ *	Return the Tcl object value of a local scalar variable in the active
+ *	procedure, given its index in the procedure's array of compiler
+ *	allocated local variables.
+ *
+ * Results:
+ *	The return value points to the current object value of the variable
+ *	given by localIndex. If the specified variable doesn't exist, or
+ *	there is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result if leaveErrorMsg is 1.
+ *
+ * Side effects:
+ *	The ref count for the returned object is _not_ incremented to
+ *	reflect the returned reference; if you want to keep a reference to
+ *	the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    int localIndex;		/* Index of variable in procedure's array
+				 * of local variables. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    Var *varPtr;		/* Points to the variable's in-frame Var
+				 * structure. */
+    char *varName;		/* Name of the local variable. */
+    char *msg;
+
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x, no compiled locals\n",
+		    localIndex, (unsigned int) varFramePtr);
+	panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
+	      (unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x with %i locals\n",
+		    localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclGetIndexedScalar: bad local index %i in frame 0x%x",
+	      localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+    
+    varPtr = &(compiledLocals[localIndex]);
+    varName = varPtr->name;
+
+    /*
+     * If varPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(varPtr)) {
+	varPtr = varPtr->value.linkPtr;
+    }
+
+    /*
+     * Invoke any traces that have been set for the variable.
+     */
+
+    if (varPtr->tracePtr != NULL) {
+	msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
+	        TCL_TRACE_READS);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, varName, NULL, "read", msg);
+	    }
+	    return NULL;
+	}
+    }
+
+    /*
+     * Make sure we're dealing with a scalar variable and not an array, and
+     * that the variable exists (isn't undefined).
+     */
+
+    if (!TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr)) {
+	if (leaveErrorMsg) {
+	    if (TclIsVarArray(varPtr)) {
+		msg = isArray;
+	    } else {
+		msg = noSuchVar;
+	    }
+	    VarErrMsg(interp, varName, NULL, "read", msg);
+	}
+	return NULL;
+    }
+    return varPtr->value.objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetElementOfIndexedArray --
+ *
+ *	Return the Tcl object value for an element in a local array
+ *	variable. The element is named by the object elemPtr while the 
+ *	array is specified by its index in the active procedure's array
+ *	of compiler allocated local variables.
+ *
+ * Results:
+ *	The return value points to the current object value of the
+ *	element. If the specified array or element doesn't exist, or there
+ *	is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result if leaveErrorMsg is 1.
+ *
+ * Side effects:
+ *	The ref count for the returned object is _not_ incremented to
+ *	reflect the returned reference; if you want to keep a reference to
+ *	the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    int localIndex;		/* Index of array variable in procedure's
+				 * array of local variables. */
+    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
+				 * an element to get in the array. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * the interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    Var *arrayPtr;		/* Points to the array's in-frame Var
+				 * structure. */
+    char *arrayName;		/* Name of the local array. */
+    Tcl_HashEntry *hPtr;
+    Var *varPtr = NULL;		/* Points to the element's Var structure
+				 * that we return. Initialized to avoid
+				 * compiler warning. */
+    char *elem, *msg;
+
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclGetElementOfIndexedArray: can't get element of local %i in frame 0x%x, no compiled locals\n",
+		    localIndex, (unsigned int) varFramePtr);
+	panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
+	      (unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclGetIndexedScalar: can't get element of local %i in frame 0x%x with %i locals\n",
+		    localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclGetElementOfIndexedArray: bad local index %i in frame 0x%x",
+	      localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    /*
+     * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
+    arrayPtr = &(compiledLocals[localIndex]);
+    arrayName = arrayPtr->name;
+
+    /*
+     * If arrayPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(arrayPtr)) {
+	arrayPtr = arrayPtr->value.linkPtr;
+    }
+
+    /*
+     * Make sure we're dealing with an array and that the array variable
+     * exists (isn't undefined).
+     */
+
+    if (!TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "read", noSuchVar);
+	}
+	goto errorReturn;
+    } 
+
+    /*
+     * Look up the element.
+     */
+
+    hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elem);
+    if (hPtr == NULL) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "read", noSuchElement);
+	}
+	goto errorReturn;
+    }
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * Invoke any traces that have been set for the element variable.
+     */
+
+    if (varPtr->tracePtr != NULL) {
+	msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
+	        TCL_TRACE_READS);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, arrayName, elem, "read", msg);
+	    }
+	    goto errorReturn;
+	}
+    }
+
+    /*
+     * Return the element if it's an existing scalar variable.
+     */
+    
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    if (leaveErrorMsg) {
+	if (TclIsVarArray(varPtr)) {
+	    msg = isArray;
+	} else {
+	    msg = noSuchVar;
+	}
+	VarErrMsg(interp, arrayName, elem, "read", msg);
+    }
+
+    /*
+     * An error. If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
+     */
+
+    errorReturn:
+    if ((varPtr != NULL) && TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, NULL); /* the array is not in a hashtable */
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCmd --
+ *
+ *	This procedure is invoked to process the "set" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result value.
+ *
+ * Side effects:
+ *	A variable's value may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_SetCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc == 2) {
+	char *value;
+
+	value = Tcl_GetVar2(interp, argv[1], (char *) NULL,
+		TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, value, TCL_VOLATILE);
+	return TCL_OK;
+    } else if (argc == 3) {
+	char *result;
+
+	result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
+		TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
+	if (result == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, result, TCL_VOLATILE);
+	return TCL_OK;
+    } else {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " varName ?newValue?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_SetVar --
  *
  *	Change the value of a variable.
  *
  * Results:
- *	Returns a pointer to the malloc'ed string holding the new
- *	value of the variable.  The caller should not modify this
- *	string.  If the write operation was disallowed then NULL
- *	is returned;  if the TCL_LEAVE_ERR_MSG flag is set, then
- *	an explanatory message will be left in interp->result.
+ *	Returns a pointer to the malloc'ed string which is the character
+ *	representation of the variable's new value. The caller must not
+ *	modify this string. If the write operation was disallowed then NULL
+ *	is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an
+ *	explanatory message will be left in interp->result. Note that the
+ *	returned string may not be the same as newValue; this is because
+ *	variable traces may modify the variable's value.
  *
  * Side effects:
  *	If varName is defined as a local or global variable in interp,
- *	its value is changed to newValue.  If varName isn't currently
+ *	its value is changed to newValue. If varName isn't currently
  *	defined, then a new global variable by that name is created.
  *
  *----------------------------------------------------------------------
@@ -421,11 +972,12 @@ Tcl_SetVar(interp, varName, newValue, flags)
     char *varName;		/* Name of a variable in interp. */
     char *newValue;		/* New value for varName. */
     int flags;			/* Various flags that tell how to set value:
-				 * any of TCL_GLOBAL_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG. */
+				 * any of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
 {
     return Tcl_SetVar2(interp, varName, (char *) NULL, newValue,
-	    flags | PART1_NOT_PARSED);
+		       (flags | TCL_PARSE_PART1));
 }
 
 /*
@@ -433,60 +985,189 @@ Tcl_SetVar(interp, varName, newValue, flags)
  *
  * Tcl_SetVar2 --
  *
- *	Given a two-part variable name, which may refer either to a
- *	scalar variable or an element of an array, change the value
- *	of the variable.  If the named scalar or array or element
- *	doesn't exist then create one.
+ *      Given a two-part variable name, which may refer either to a
+ *      scalar variable or an element of an array, change the value
+ *      of the variable.  If the named scalar or array or element
+ *      doesn't exist then create one.
  *
  * Results:
- *	Returns a pointer to the malloc'ed string holding the new
- *	value of the variable.  The caller should not modify this
- *	string.  If the write operation was disallowed because an
- *	array was expected but not found (or vice versa), then NULL
- *	is returned;  if the TCL_LEAVE_ERR_MSG flag is set, then
- *	an explanatory message will be left in interp->result.
+ *	Returns a pointer to the malloc'ed string which is the character
+ *	representation of the variable's new value. The caller must not
+ *	modify this string. If the write operation was disallowed because an
+ *	array was expected but not found (or vice versa), then NULL is
+ *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
+ *	message will be left in interp->result. Note that the returned
+ *	string may not be the same as newValue; this is because variable
+ *	traces may modify the variable's value.
  *
  * Side effects:
- *	The value of the given variable is set.  If either the array
- *	or the entry didn't exist then a new one is created.
+ *      The value of the given variable is set. If either the array
+ *      or the entry didn't exist then a new one is created.
  *
  *----------------------------------------------------------------------
  */
 
 char *
 Tcl_SetVar2(interp, part1, part2, newValue, flags)
+    Tcl_Interp *interp;         /* Command interpreter in which variable is
+                                 * to be looked up. */
+    char *part1;                /* If part2 is NULL, this is name of scalar
+                                 * variable. Otherwise it is the name of
+                                 * an array. */
+    char *part2;                /* Name of an element within an array, or
+				 * NULL. */
+    char *newValue;             /* New value for variable. */
+    int flags;                  /* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or 
+				 * TCL_PARSE_PART1. */
+{
+    register Tcl_Obj *valuePtr;
+    register Tcl_Obj *part1Ptr;
+    register Tcl_Obj *part2Ptr = NULL;
+    Tcl_Obj *varValuePtr;
+    int length;
+
+    /*
+     * Create an object holding the variable's new value and use
+     * Tcl_ObjSetVar2 to actually set the variable.
+     */
+
+    length = strlen(newValue);
+    TclNewObj(valuePtr);
+    TclInitStringRep(valuePtr, newValue, length);
+    Tcl_IncrRefCount(valuePtr);
+
+    length = strlen(part1);
+    TclNewObj(part1Ptr);
+    TclInitStringRep(part1Ptr, part1, length);
+    Tcl_IncrRefCount(part1Ptr);
+
+    if (part2 != NULL) {
+        length = strlen(part2);
+        TclNewObj(part2Ptr);
+        TclInitStringRep(part2Ptr, part2, length);
+	Tcl_IncrRefCount(part2Ptr);
+    }
+    
+    varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr,
+	    flags);
+    
+    TclDecrRefCount(part1Ptr);      /* done with the part1 name object */
+    if (part2Ptr != NULL) {
+	TclDecrRefCount(part2Ptr);  /* and the part2 name object */
+    }
+    Tcl_DecrRefCount(valuePtr); /* done with the object */
+    
+    if (varValuePtr == NULL) {
+	/*
+	 * Move the interpreter's object result to the string result, 
+	 * then reset the object result.
+	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
+	 */
+
+	Tcl_SetResult(interp,
+	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+	        TCL_VOLATILE);
+	return NULL;
+    }
+
+    /*
+     * THIS FAILS IF Tcl_ObjSetVar2's RESULT'S STRING REP HAS A NULL BYTE.
+     */
+
+    return TclGetStringFromObj(varValuePtr, (int *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ObjSetVar2 --
+ *
+ *	Given a two-part variable name, which may refer either to a scalar
+ *	variable or an element of an array, change the value of the variable
+ *	to a new Tcl object value. If the named scalar or array or element
+ *	doesn't exist then create one.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable. If the write operation was disallowed because an array was
+ *	expected but not found (or vice versa), then NULL is returned; if
+ *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
+ *	be left in the interpreter's result. Note that the returned object
+ *	may not be the same one referenced by newValuePtr; this is because
+ *	variable traces may modify the variable's value.
+ *
+ * Side effects:
+ *	The value of the given variable is set. If either the array or the
+ *	entry didn't exist then a new variable is created.
+ *
+ *	The reference count is decremented for any old value of the variable
+ *	and incremented for its new value. If the new value for the variable
+ *	is not the same one referenced by newValuePtr (perhaps as a result
+ *	of a variable trace), then newValuePtr's ref count is left unchanged
+ *	by Tcl_ObjSetVar2. newValuePtr's ref count is also left unchanged if
+ *	we are appending it as a string value: that is, if "flags" includes
+ *	TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
+ *
+ *	The reference count for the returned object is _not_ incremented: if
+ *	you want to keep a reference to the object you must increment its
+ *	ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
     Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be looked up. */
-    char *part1;		/* If part2 is NULL, this is name of scalar
-				 * variable.  Otherwise it is name of array. */
-    char *part2;		/* Name of an element within array, or NULL. */
-    char *newValue;		/* New value for variable. */
+				 * to be found. */
+    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
+				 * an array (if part2 is non-NULL) or the
+				 * name of a variable. */
+    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
+				 * the name of an element in the array
+				 * part1Ptr. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
     int flags;			/* Various flags that tell how to set value:
-				 * any of TCL_GLOBAL_ONLY, TCL_APPEND_VALUE,
+				 * any of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
 				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
-				 * PART1_NOT_PARSED. */
+				 * TCL_PARSE_PART1. */
 {
+    Interp *iPtr = (Interp *) interp;
     register Var *varPtr;
-    register Interp *iPtr = (Interp *) interp;
-    int length, listFlags;
     Var *arrayPtr;
-    char *result;
+    Tcl_Obj *oldValuePtr;
+    Tcl_Obj *resultPtr = NULL;
+    char *part1, *bytes;
+    char *part2 = NULL;
+    int length, result;
+
+    /*
+     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
 
-    varPtr = LookupVar(interp, part1, part2, flags, "set", CRT_PART1|CRT_PART2,
-	    &arrayPtr);
+    part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
+    if (part2Ptr != NULL) {
+	part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
+    }
+    
+    varPtr = TclLookupVar(interp, part1, part2, flags, "set",
+	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return NULL;
     }
 
     /*
-     * If the variable's hPtr field is NULL, it means that this is an
-     * upvar to an array element where the array was deleted, leaving
-     * the element dangling at the end of the upvar.  Generate an error
-     * (allowing the variable to be reset would screw up our storage
+     * If the variable is in a hashtable and its hPtr field is NULL, then we
+     * have an upvar to an array element where the array was deleted,
+     * leaving the element dangling at the end of the upvar. Generate an
+     * error (allowing the variable to be reset would screw up our storage
      * allocation and is meaningless anyway).
      */
 
-    if (varPtr->hPtr == NULL) {
+    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, part1, part2, "set", danglingUpvar);
 	}
@@ -494,133 +1175,794 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
     }
 
     /*
-     * Clear the variable's current value unless this is an
-     * append operation.
+     * It's an error to try to set an array variable itself.
      */
 
-    if (varPtr->flags & VAR_ARRAY) {
+    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, part1, part2, "set", isArray);
 	}
 	return NULL;
     }
-    if (!(flags & TCL_APPEND_VALUE) || (varPtr->flags & VAR_UNDEFINED)) {
-	varPtr->valueLength = 0;
+
+    /*
+     * At this point, if we were appending, we used to call read traces: we
+     * treated append as a read-modify-write. However, it seemed unlikely to
+     * us that a real program would be interested in such reads being done
+     * during a set operation.
+     */
+
+    /*
+     * Set the variable's new value. If appending, append the new value to
+     * the variable, either as a list element or as a string. Also, if
+     * appending, then if the variable's old value is unshared we can modify
+     * it directly, otherwise we must create a new copy to modify: this is
+     * "copy on write".
+     */
+
+    oldValuePtr = varPtr->value.objPtr;
+    if (flags & TCL_APPEND_VALUE) {
+	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
+	    Tcl_DecrRefCount(oldValuePtr);     /* discard old value */
+	    varPtr->value.objPtr = NULL;
+	    oldValuePtr = NULL;
+	}
+	if (flags & TCL_LIST_ELEMENT) {	       /* append list element */
+	    if (oldValuePtr == NULL) {
+		TclNewObj(oldValuePtr);
+		varPtr->value.objPtr = oldValuePtr;
+		Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
+	    } else if (Tcl_IsShared(oldValuePtr)) {
+		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+		Tcl_DecrRefCount(oldValuePtr);
+		oldValuePtr = varPtr->value.objPtr;
+		Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
+	    }
+	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
+		    newValuePtr);
+	    if (result != TCL_OK) {
+		return NULL;
+	    }
+	} else {		               /* append string */
+	    /*
+	     * We append newValuePtr's bytes but don't change its ref count.
+	     */
+
+	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
+	    if (oldValuePtr == NULL) {
+		varPtr->value.objPtr = Tcl_NewStringObj(bytes, length);
+		Tcl_IncrRefCount(varPtr->value.objPtr);
+	    } else {
+		if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */
+		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+		    TclDecrRefCount(oldValuePtr);
+		    oldValuePtr = varPtr->value.objPtr;
+		    Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
+		}
+		Tcl_AppendToObj(oldValuePtr, bytes, length);
+	    }
+	}
+    } else {
+	if (flags & TCL_LIST_ELEMENT) {	       /* set var to list element */
+	    int neededBytes, listFlags;
+
+	    /*
+	     * We set the variable to the result of converting newValuePtr's
+	     * string rep to a list element. We do not change newValuePtr's
+	     * ref count.
+	     */
+
+	    if (oldValuePtr != NULL) {
+		Tcl_DecrRefCount(oldValuePtr); /* discard old value */
+	    }
+	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
+	    neededBytes = Tcl_ScanElement(bytes, &listFlags);
+	    oldValuePtr = Tcl_NewObj();
+	    oldValuePtr->bytes = (char *)
+		    ckalloc((unsigned) (neededBytes + 1));
+	    oldValuePtr->length = Tcl_ConvertElement(bytes,
+		    oldValuePtr->bytes, listFlags);
+	    varPtr->value.objPtr = oldValuePtr;
+	    Tcl_IncrRefCount(varPtr->value.objPtr);
+	} else if (newValuePtr != oldValuePtr) {
+	    varPtr->value.objPtr = newValuePtr;
+	    Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
+	    if (oldValuePtr != NULL) {
+		TclDecrRefCount(oldValuePtr);   /* discard old value */
+	    }
+	}
+    }
+    TclSetVarScalar(varPtr);
+    TclClearVarUndefined(varPtr);
+    if (arrayPtr != NULL) {
+	TclClearVarUndefined(arrayPtr);
     }
 
     /*
-     * Call read trace if variable is being appended to.
+     * Invoke any write traces for the variable.
      */
 
-    if ((flags & TCL_APPEND_VALUE) && ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
-	char *msg;
-	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|PART1_NOT_PARSED)) | TCL_TRACE_READS);
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	char *msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
+	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_WRITES);
 	if (msg != NULL) {
-	    VarErrMsg(interp, part1, part2, "read", msg);
-	    result = NULL;
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, "set", msg);
+	    }
 	    goto cleanup;
 	}
-    } 
+    }
 
     /*
-     * Compute how many total bytes will be needed for the variable's
-     * new value (leave space for a separating space between list
-     * elements).  Allocate new space for the value if needed.
+     * Return the variable's value unless the variable was changed in some
+     * gross way by a trace (e.g. it was unset and then recreated as an
+     * array). 
      */
 
-    if (flags & TCL_LIST_ELEMENT) {
-	length = Tcl_ScanElement(newValue, &listFlags) + 1;
-    } else {
-	length = strlen(newValue);
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
     }
-    length += varPtr->valueLength;
-    if (length >= varPtr->valueSpace) {
-	char *newValue;
-	int newSize;
 
-	newSize = 2*varPtr->valueSpace;
-	if (newSize <= length) {
-	    newSize = length + 1;
+    /*
+     * A trace changed the value in some gross way. Return an empty string
+     * object.
+     */
+    
+    resultPtr = iPtr->emptyObjPtr;
+
+    /*
+     * If the variable doesn't exist anymore and no-one's using it, then
+     * free up the relevant structures and hash table entries.
+     */
+
+    cleanup:
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, arrayPtr);
+    }
+    return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetIndexedScalar --
+ *
+ *	Change the Tcl object value of a local scalar variable in the active
+ *	procedure, given its compile-time allocated index in the procedure's
+ *	array of local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable given by localIndex. If the specified variable doesn't
+ *	exist, or there is a clash in array usage, or an error occurs while
+ *	executing variable traces, then NULL is returned and a message will
+ *	be left in the interpreter's result if leaveErrorMsg is 1. Note
+ *	that the returned object may not be the same one referenced by
+ *	newValuePtr; this is because variable traces may modify the
+ *	variable's value.
+ *
+ * Side effects:
+ *	The value of the given variable is set. The reference count is
+ *	decremented for any old value of the variable and incremented for
+ *	its new value. If as a result of a variable trace the new value for
+ *	the variable is not the same one referenced by newValuePtr, then
+ *	newValuePtr's ref count is left unchanged. The ref count for the
+ *	returned object is _not_ incremented to reflect the returned
+ *	reference; if you want to keep a reference to the object you must
+ *	increment its ref count yourself. This procedure does not create
+ *	new variables, but only sets those recognized at compile time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    int localIndex;		/* Index of variable in procedure's array
+				 * of local variables. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * the interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    register Var *varPtr;	/* Points to the variable's in-frame Var
+				 * structure. */
+    char *varName;		/* Name of the local variable. */
+    Tcl_Obj *oldValuePtr;
+    Tcl_Obj *resultPtr = NULL;
+
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x, no compiled locals\n",
+		    localIndex, (unsigned int) varFramePtr);
+	panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
+	      (unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x with %i locals\n",
+		    localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclSetIndexedScalar: bad local index %i in frame 0x%x",
+	      localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+    
+    varPtr = &(compiledLocals[localIndex]);
+    varName = varPtr->name;
+
+    /*
+     * If varPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(varPtr)) {
+	varPtr = varPtr->value.linkPtr;
+    }
+
+    /*
+     * If the variable is in a hashtable and its hPtr field is NULL, then we
+     * have an upvar to an array element where the array was deleted,
+     * leaving the element dangling at the end of the upvar. Generate an
+     * error (allowing the variable to be reset would screw up our storage
+     * allocation and is meaningless anyway).
+     */
+
+    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, varName, NULL, "set", danglingUpvar);
 	}
-	if (newSize < 24) {
-	    /*
-	     * Don't waste time with teensy-tiny variables;  we'll
-	     * just end up expanding them later.
-	     */
+	return NULL;
+    }
+
+    /*
+     * It's an error to try to set an array variable itself.
+     */
+
+    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, varName, NULL, "set", isArray);
+	}
+	return NULL;
+    }
+
+    /*
+     * Set the variable's new value and discard its old value. We don't
+     * append with this "set" procedure so the old value isn't needed.
+     */
+
+    oldValuePtr = varPtr->value.objPtr;
+    if (newValuePtr != oldValuePtr) {        /* set new value */
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);       /* var is another ref to obj */
+	if (oldValuePtr != NULL) {
+	    TclDecrRefCount(oldValuePtr);    /* discard old value */
+	}
+    }
+    TclSetVarScalar(varPtr);
+    TclClearVarUndefined(varPtr);
+
+    /*
+     * Invoke any write traces for the variable.
+     */
+
+    if (varPtr->tracePtr != NULL) {
+	char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr,
+	        varName, (char *) NULL, TCL_TRACE_WRITES);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, varName, NULL, "set", msg);
+	    }
+	    goto cleanup;
+	}
+    }
+
+    /*
+     * Return the variable's value unless the variable was changed in some
+     * gross way by a trace (e.g. it was unset and then recreated as an
+     * array). If it was changed is a gross way, just return an empty string
+     * object.
+     */
+
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    resultPtr = Tcl_NewObj();
+
+    /*
+     * If the variable doesn't exist anymore and no-one's using it, then
+     * free up the relevant structures and hash table entries.
+     */
+
+    cleanup:
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, NULL);
+    }
+    return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetElementOfIndexedArray --
+ *
+ *	Change the Tcl object value of an element in a local array
+ *	variable. The element is named by the object elemPtr while the array
+ *	is specified by its index in the active procedure's array of
+ *	compiler allocated local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	element. If the specified array or element doesn't exist, or there
+ *	is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result if leaveErrorMsg is 1. Note that the
+ *	returned object may not be the same one referenced by newValuePtr;
+ *	this is because variable traces may modify the variable's value.
+ *
+ * Side effects:
+ *	The value of the given array element is set. The reference count is
+ *	decremented for any old value of the element and incremented for its
+ *	new value. If as a result of a variable trace the new value for the
+ *	element is not the same one referenced by newValuePtr, then
+ *	newValuePtr's ref count is left unchanged. The ref count for the
+ *	returned object is _not_ incremented to reflect the returned
+ *	reference; if you want to keep a reference to the object you must
+ *	increment its ref count yourself. This procedure will not create new
+ *	array variables, but only sets elements of those arrays recognized
+ *	at compile time. However, if the entry doesn't exist then a new
+ *	variable is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
+        leaveErrorMsg)
+    Tcl_Interp *interp;		/* Command interpreter in which the array is
+				 * to be found. */
+    int localIndex;		/* Index of array variable in procedure's
+				 * array of local variables. */
+    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
+				 * an element to set in the array. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
+    int leaveErrorMsg;		/* 1 if to leave an error message in
+				 * the interpreter's result on an error.
+				 * Otherwise no error message is left. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+				/* Points to the procedure call frame whose
+				 * variables are currently in use. Same as
+				 * the current procedure's frame, if any,
+				 * unless an "uplevel" is executing. */
+    Var *compiledLocals = varFramePtr->compiledLocals;
+    Var *arrayPtr;		/* Points to the array's in-frame Var
+				 * structure. */
+    char *arrayName;		/* Name of the local array. */
+    char *elem;
+    Tcl_HashEntry *hPtr;
+    Var *varPtr = NULL;		/* Points to the element's Var structure
+				 * that we return. */
+    Tcl_Obj *resultPtr = NULL;
+    Tcl_Obj *oldValuePtr;
+    int new;
+    
+#ifdef TCL_COMPILE_DEBUG
+    Proc *procPtr = varFramePtr->procPtr;
+    int localCt = procPtr->numCompiledLocals;
+
+    if (compiledLocals == NULL) {
+	fprintf(stderr, "\nTclSetElementOfIndexedArray: can't set element of local %i in frame 0x%x, no compiled locals\n",
+		    localIndex, (unsigned int) varFramePtr);
+	panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
+	      (unsigned int) varFramePtr);
+    }
+    if ((localIndex < 0) || (localIndex >= localCt)) {
+	fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n",
+		    localIndex, (unsigned int) varFramePtr, localCt);
+	panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x",
+	      localIndex, (unsigned int) varFramePtr);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    /*
+     * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
+    arrayPtr = &(compiledLocals[localIndex]);
+    arrayName = arrayPtr->name;
+
+    /*
+     * If arrayPtr is a link variable, we have a reference to some variable
+     * that was created through an "upvar" or "global" command, or we have a
+     * reference to a variable in an enclosing namespace. Traverse through
+     * any links until we find the referenced variable.
+     */
+	
+    while (TclIsVarLink(arrayPtr)) {
+	arrayPtr = arrayPtr->value.linkPtr;
+    }
 
-	    newSize = 24;
+    /*
+     * Make sure we're dealing with an array.
+     */
+
+    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
+	TclSetVarArray(arrayPtr);
+	arrayPtr->value.tablePtr =
+	        (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
+	TclClearVarUndefined(arrayPtr);
+    } else if (!TclIsVarArray(arrayPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "set", needArray);
 	}
-	newValue = (char *) ckalloc((unsigned) newSize);
-	if (varPtr->valueSpace > 0) {
-	    strcpy(newValue, varPtr->value.string);
-	    ckfree(varPtr->value.string);
+	goto errorReturn;
+    } 
+
+    /*
+     * Look up the element.
+     */
+
+    hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
+    if (new) {
+	if (arrayPtr->searchPtr != NULL) {
+	    DeleteSearches(arrayPtr);
 	}
-	varPtr->valueSpace = newSize;
-	varPtr->value.string = newValue;
+	varPtr = NewVar();
+	Tcl_SetHashValue(hPtr, varPtr);
+	varPtr->hPtr = hPtr;
+        varPtr->nsPtr = varFramePtr->nsPtr;
+	TclSetVarArrayElement(varPtr);
     }
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
 
     /*
-     * Append the new value to the variable, either as a list
-     * element or as a string.
+     * It's an error to try to set an array variable itself.
      */
 
-    if (flags & TCL_LIST_ELEMENT) {
-	char *dst = varPtr->value.string + varPtr->valueLength;
+    if (TclIsVarArray(varPtr)) {
+	if (leaveErrorMsg) {
+	    VarErrMsg(interp, arrayName, elem, "set", isArray);
+	}
+	goto errorReturn;
+    }
+
+    /*
+     * Set the variable's new value and discard the old one. We don't
+     * append with this "set" procedure so the old value isn't needed.
+     */
 
-	if (TclNeedSpace(varPtr->value.string, dst)) {
-	    *dst = ' ';
-	    dst++;
-	    varPtr->valueLength++;
+    oldValuePtr = varPtr->value.objPtr;
+    if (newValuePtr != oldValuePtr) {	     /* set new value */
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);       /* var is another ref to obj */
+	if (oldValuePtr != NULL) {
+	    TclDecrRefCount(oldValuePtr);    /* discard old value */
 	}
-	varPtr->valueLength += Tcl_ConvertElement(newValue, dst, listFlags);
-    } else {
-	strcpy(varPtr->value.string + varPtr->valueLength, newValue);
-	varPtr->valueLength = length;
     }
-    varPtr->flags &= ~VAR_UNDEFINED;
+    TclSetVarScalar(varPtr);
+    TclClearVarUndefined(varPtr);
 
     /*
-     * Invoke any write traces for the variable.
+     * Invoke any write traces for the element variable.
      */
 
     if ((varPtr->tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	char *msg;
-
-	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|PART1_NOT_PARSED))
-		| TCL_TRACE_WRITES);
+	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
+		TCL_TRACE_WRITES);
 	if (msg != NULL) {
-	    VarErrMsg(interp, part1, part2, "set", msg);
-	    result = NULL;
-	    goto cleanup;
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, arrayName, elem, "set", msg);
+	    }
+	    goto errorReturn;
 	}
     }
 
     /*
-     * If the variable was changed in some gross way by a trace (e.g.
-     * it was unset and then recreated as an array) then just return
-     * an empty string;  otherwise return the variable's current
-     * value.
+     * Return the element's value unless it was changed in some gross way by
+     * a trace (e.g. it was unset and then recreated as an array). If it was
+     * changed is a gross way, just return an empty string object.
      */
 
-    if (!(varPtr->flags & (VAR_UNDEFINED|VAR_UPVAR|VAR_ARRAY))) {
-	return varPtr->value.string;
+    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
     }
-    result = "";
+    
+    resultPtr = Tcl_NewObj();
 
     /*
-     * If the variable doesn't exist anymore and no-one's using it,
-     * then free up the relevant structures and hash table entries.
+     * An error. If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
      */
 
-    cleanup:
-    if (varPtr->flags & VAR_UNDEFINED) {
-	CleanupVar(varPtr, arrayPtr);
+    errorReturn:
+    if (varPtr != NULL) {
+	if (TclIsVarUndefined(varPtr)) {
+	    CleanupVar(varPtr, NULL); /* note: array isn't in hashtable */
+	}
     }
-    return result;
+    return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrVar2 --
+ *
+ *	Given a two-part variable name, which may refer either to a scalar
+ *	variable or an element of an array, increment the Tcl object value
+ *	of the variable by a specified amount.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable. If the specified variable doesn't exist, or there is a
+ *	clash in array usage, or an error occurs while executing variable
+ *	traces, then NULL is returned and a message will be left in
+ *	the interpreter's result.
+ *
+ * Side effects:
+ *	The value of the given variable is incremented by the specified
+ *	amount. If either the array or the entry didn't exist then a new
+ *	variable is created. The ref count for the returned object is _not_
+ *	incremented to reflect the returned reference; if you want to keep a
+ *	reference to the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    Tcl_Obj *part1Ptr;		/* Points to an object holding the name of
+				 * an array (if part2 is non-NULL) or the
+				 * name of a variable. */
+    Tcl_Obj *part2Ptr;		/* If non-null, points to an object holding
+				 * the name of an element in the array
+				 * part1Ptr. */
+    long incrAmount;		/* Amount to be added to variable. */
+    int part1NotParsed;		/* 1 if part1 hasn't yet been parsed into
+				 * an array name and index (if any). */
+{
+    register Tcl_Obj *varValuePtr;
+    Tcl_Obj *resultPtr;
+    int createdNewObj;		/* Set 1 if var's value object is shared
+				 * so we must increment a copy (i.e. copy
+				 * on write). */
+    long i;
+    int flags, result;
+
+    flags = TCL_LEAVE_ERR_MSG;
+    if (part1NotParsed) {
+	flags |= TCL_PARSE_PART1;
+    }
+    
+    varValuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+    if (varValuePtr == NULL) {
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
+    }
+
+    /*
+     * Increment the variable's value. If the object is unshared we can
+     * modify it directly, otherwise we must create a new copy to modify:
+     * this is "copy on write". Then free the variable's old string
+     * representation, if any, since it will no longer be valid.
+     */
+
+    createdNewObj = 0;
+    if (Tcl_IsShared(varValuePtr)) {
+	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	createdNewObj = 1;
+    }
+    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
+    if (result != TCL_OK) {
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+	}
+	return NULL;
+    }
+    Tcl_SetLongObj(varValuePtr, (i + incrAmount));
+
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr,
+	    flags);
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrIndexedScalar --
+ *
+ *	Increments the Tcl object value of a local scalar variable in the
+ *	active procedure, given its compile-time allocated index in the
+ *	procedure's array of local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	variable given by localIndex. If the specified variable doesn't
+ *	exist, or there is a clash in array usage, or an error occurs while
+ *	executing variable traces, then NULL is returned and a message will
+ *	be left in the interpreter's result. 
+ *
+ * Side effects:
+ *	The value of the given variable is incremented by the specified
+ *	amount. The ref count for the returned object is _not_ incremented
+ *	to reflect the returned reference; if you want to keep a reference
+ *	to the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrIndexedScalar(interp, localIndex, incrAmount)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be found. */
+    int localIndex;		/* Index of variable in procedure's array
+				 * of local variables. */
+    long incrAmount;		/* Amount to be added to variable. */
+{
+    register Tcl_Obj *varValuePtr;
+    Tcl_Obj *resultPtr;
+    int createdNewObj;		/* Set 1 if var's value object is shared
+				 * so we must increment a copy (i.e. copy
+				 * on write). */
+    long i;
+    int result;
+
+    varValuePtr = TclGetIndexedScalar(interp, localIndex,
+                                      /*leaveErrorMsg*/ 1);
+    if (varValuePtr == NULL) {
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
+    }
+
+    /*
+     * Reach into the object's representation to extract and increment the
+     * variable's value. If the object is unshared we can modify it
+     * directly, otherwise we must create a new copy to modify: this is
+     * "copy on write". Then free the variable's old string representation,
+     * if any, since it will no longer be valid.
+     */
+
+    createdNewObj = 0;
+    if (Tcl_IsShared(varValuePtr)) {
+	createdNewObj = 1;
+	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+    }
+    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
+    if (result != TCL_OK) {
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+	}
+	return NULL;
+    }
+    Tcl_SetLongObj(varValuePtr, (i + incrAmount));
+
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr,
+				    /*leaveErrorMsg*/ 1);
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrElementOfIndexedArray --
+ *
+ *	Increments the Tcl object value of an element in a local array
+ *	variable. The element is named by the object elemPtr while the array
+ *	is specified by its index in the active procedure's array of
+ *	compiler allocated local variables.
+ *
+ * Results:
+ *	Returns a pointer to the Tcl_Obj holding the new value of the
+ *	element. If the specified array or element doesn't exist, or there
+ *	is a clash in array usage, or an error occurs while executing
+ *	variable traces, then NULL is returned and a message will be left in
+ *	the interpreter's result.
+ *
+ * Side effects:
+ *	The value of the given array element is incremented by the specified
+ *	amount. The ref count for the returned object is _not_ incremented
+ *	to reflect the returned reference; if you want to keep a reference
+ *	to the object you must increment its ref count yourself. If the
+ *	entry doesn't exist then a new variable is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
+    Tcl_Interp *interp;		/* Command interpreter in which the array is
+				 * to be found. */
+    int localIndex;		/* Index of array variable in procedure's
+				 * array of local variables. */
+    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
+				 * an element to increment in the array. */
+    long incrAmount;		/* Amount to be added to variable. */
+{
+    register Tcl_Obj *varValuePtr;
+    Tcl_Obj *resultPtr;
+    int createdNewObj;		/* Set 1 if var's value object is shared
+				 * so we must increment a copy (i.e. copy
+				 * on write). */
+    long i;
+    int result;
+
+    varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr,
+				              /*leaveErrorMsg*/ 1);
+    if (varValuePtr == NULL) {
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
+    }
+
+    /*
+     * Reach into the object's representation to extract and increment the
+     * variable's value. If the object is unshared we can modify it
+     * directly, otherwise we must create a new copy to modify: this is
+     * "copy on write". Then free the variable's old string representation,
+     * if any, since it will no longer be valid.
+     */
+
+    createdNewObj = 0;
+    if (Tcl_IsShared(varValuePtr)) {
+	createdNewObj = 1;
+	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+    }
+    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
+    if (result != TCL_OK) {
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+	}
+	return NULL;
+    }
+    Tcl_SetLongObj(varValuePtr, (i + incrAmount));
+    
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr,
+					    varValuePtr,
+                                            /*leaveErrorMsg*/ 1);
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return resultPtr;
 }
 
 /*
@@ -651,10 +1993,11 @@ Tcl_UnsetVar(interp, varName, flags)
 				 * either a scalar name or an array name
 				 * or an element in an array. */
     int flags;			/* OR-ed combination of any of
-				 * TCL_GLOBAL_ONLY or TCL_LEAVE_ERR_MSG. */
+				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
+				 * TCL_LEAVE_ERR_MSG. */
 {
     return Tcl_UnsetVar2(interp, varName, (char *) NULL,
-	    flags | PART1_NOT_PARSED);
+	    (flags | TCL_PARSE_PART1));
 }
 
 /*
@@ -685,20 +2028,24 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
     char *part1;		/* Name of variable or array. */
     char *part2;		/* Name of element within array or NULL. */
     int flags;			/* OR-ed combination of any of
-				 * TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG,
-				 * or PART1_NOT_PARSED. */
+				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_LEAVE_ERR_MSG, or
+				 * TCL_PARSE_PART1. */
 {
-    Var *varPtr, dummyVar;
+    Var dummyVar;
+    Var *varPtr, *dummyVarPtr;
     Interp *iPtr = (Interp *) interp;
     Var *arrayPtr;
     ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
     int result;
 
-    varPtr = LookupVar(interp, part1, part2, flags, "unset", 0,  &arrayPtr);
+    varPtr = TclLookupVar(interp, part1, part2, flags, "unset",
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
-    result = (varPtr->flags & VAR_UNDEFINED) ? TCL_ERROR : TCL_OK;
+    result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
 
     if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
 	DeleteSearches(arrayPtr);
@@ -707,28 +2054,29 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
     /*
      * The code below is tricky, because of the possibility that
      * a trace procedure might try to access a variable being
-     * deleted.  To handle this situation gracefully, do things
+     * deleted. To handle this situation gracefully, do things
      * in three steps:
      * 1. Copy the contents of the variable to a dummy variable
-     *    structure, and mark the original structure as undefined.
-     * 2. Invoke traces and clean up the variable, using the copy.
+     *    structure, and mark the original Var structure as undefined.
+     * 2. Invoke traces and clean up the variable, using the dummy copy.
      * 3. If at the end of this the original variable is still
      *    undefined and has no outstanding references, then delete
      *	  it (but it could have gotten recreated by a trace).
      */
 
     dummyVar = *varPtr;
-    varPtr->valueSpace = 0;
-    varPtr->flags = VAR_UNDEFINED;
+    TclSetVarUndefined(varPtr);
+    TclSetVarScalar(varPtr);
+    varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
     varPtr->tracePtr = NULL;
     varPtr->searchPtr = NULL;
 
     /*
-     * Call trace procedures for the variable being deleted and delete
-     * its traces.  Be sure to abort any other traces for the variable
-     * that are still pending.  Special tricks:
-     * 1. Increment varPtr's refCount around this:  CallTraces will
-     *    use dummyVar so it won't increment varPtr's refCount.
+     * Call trace procedures for the variable being deleted. Then delete
+     * its traces. Be sure to abort any other traces for the variable
+     * that are still pending. Special tricks:
+     * 1. We need to increment varPtr's refCount around this: CallTraces
+     *    will use dummyVar so it won't increment varPtr's refCount itself.
      * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to
      *    call unset traces even if other traces are pending.
      */
@@ -738,14 +2086,13 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
 	varPtr->refCount++;
 	dummyVar.flags &= ~VAR_TRACE_ACTIVE;
 	(void) CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|PART1_NOT_PARSED))
-		| TCL_TRACE_UNSETS);
+		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_UNSETS);
 	while (dummyVar.tracePtr != NULL) {
 	    VarTrace *tracePtr = dummyVar.tracePtr;
 	    dummyVar.tracePtr = tracePtr->nextPtr;
 	    ckfree((char *) tracePtr);
 	}
-	for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+	for (activePtr = iPtr->activeTracePtr;  activePtr != NULL;
 		activePtr = activePtr->nextPtr) {
 	    if (activePtr->varPtr == varPtr) {
 		activePtr->nextTracePtr = NULL;
@@ -755,28 +2102,34 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
     }
 
     /*
-     * If the variable is an array, delete all of its elements.  This
-     * must be done after calling the traces on the array, above (that's
-     * the way traces are defined).
+     * If the variable is an array, delete all of its elements. This must be
+     * done after calling the traces on the array, above (that's the way
+     * traces are defined). If it is a scalar, "discard" its object
+     * (decrement the ref count of its object, if any).
      */
 
-    if (dummyVar.flags & VAR_ARRAY) {
-	DeleteArray(iPtr, part1, &dummyVar,
-	    (flags & TCL_GLOBAL_ONLY) | TCL_TRACE_UNSETS);
+    dummyVarPtr = &dummyVar;
+    if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
+	DeleteArray(iPtr, part1, dummyVarPtr,
+	    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
     }
-    if (dummyVar.valueSpace > 0) {
-	ckfree(dummyVar.value.string);
+    if (TclIsVarScalar(dummyVarPtr)
+	    && (dummyVarPtr->value.objPtr != NULL)) {
+	objPtr = dummyVarPtr->value.objPtr;
+	TclDecrRefCount(objPtr);
+	dummyVarPtr->value.objPtr = NULL;
     }
-    if (result == TCL_ERROR) {
+    if (result != TCL_OK) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, part1, part2, "unset", 
-		    (arrayPtr == NULL) ? noSuchVar : noSuchElement);
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
 	}
     }
 
     /*
-     * Finally, if the variable is truly not in use then free up its
-     * record and remove it from the hash table.
+     * Finally, if the variable is truly not in use then free up its Var
+     * structure and remove it from its hash table, if any. The ref count of
+     * its value object, if any, was decremented above.
      */
 
     CleanupVar(varPtr, arrayPtr);
@@ -812,13 +2165,14 @@ Tcl_TraceVar(interp, varName, flags, proc, clientData)
 				 * to signify an array reference. */
     int flags;			/* OR-ed collection of bits, including any
 				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
+				 * TCL_NAMESPACE_ONLY. */
     Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
 				 * invoked upon varName. */
     ClientData clientData;	/* Arbitrary argument to pass to proc. */
 {
     return Tcl_TraceVar2(interp, varName, (char *) NULL,
-	    flags | PART1_NOT_PARSED, proc, clientData);
+	    (flags | TCL_PARSE_PART1), proc, clientData);
 }
 
 /*
@@ -852,8 +2206,9 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
 				 * as-a-whole. */
     int flags;			/* OR-ed collection of bits, including any
 				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
-				 * PART1_NOT_PARSED. */
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY and
+				 * TCL_PARSE_PART1. */
     Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
 				 * invoked upon varName. */
     ClientData clientData;	/* Arbitrary argument to pass to proc. */
@@ -861,8 +2216,8 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
     Var *varPtr, *arrayPtr;
     register VarTrace *tracePtr;
 
-    varPtr = LookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG),
-	    "trace", CRT_PART1|CRT_PART2, &arrayPtr);
+    varPtr = TclLookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG),
+	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -874,8 +2229,8 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
     tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
     tracePtr->traceProc = proc;
     tracePtr->clientData = clientData;
-    tracePtr->flags = flags &
-	    (TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS);
+    tracePtr->flags = 
+	    flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
     tracePtr->nextPtr = varPtr->tracePtr;
     varPtr->tracePtr = tracePtr;
     return TCL_OK;
@@ -901,18 +2256,19 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
 
 void
 Tcl_UntraceVar(interp, varName, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter containing traced variable. */
-    char *varName;		/* Name of variable;  may end with "(index)"
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *varName;		/* Name of variable; may end with "(index)"
 				 * to signify an array reference. */
     int flags;			/* OR-ed collection of bits describing
 				 * current trace, including any of
 				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY
+				 * and TCL_NAMESPACE_ONLY. */
     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
     ClientData clientData;	/* Arbitrary argument to pass to proc. */
 {
-    Tcl_UntraceVar2(interp, varName, (char *) NULL, flags | PART1_NOT_PARSED,
-	    proc, clientData);
+    Tcl_UntraceVar2(interp, varName, (char *) NULL,
+		    (flags | TCL_PARSE_PART1), proc, clientData);
 }
 
 /*
@@ -935,7 +2291,7 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
 
 void
 Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter containing traced variable. */
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
     char *part1;		/* Name of variable or array. */
     char *part2;		/* Name of element within array;  NULL means
 				 * trace applies to scalar variable or array
@@ -943,8 +2299,9 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
     int flags;			/* OR-ed collection of bits describing
 				 * current trace, including any of
 				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
-				 * PART1_NOT_PARSED. */
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY and
+				 * TCL_PARSE_PART1. */
     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
     ClientData clientData;	/* Arbitrary argument to pass to proc. */
 {
@@ -954,15 +2311,16 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
     Interp *iPtr = (Interp *) interp;
     ActiveVarTrace *activePtr;
 
-    varPtr = LookupVar(interp, part1, part2,
-	    flags & (TCL_GLOBAL_ONLY|PART1_NOT_PARSED), (char *) NULL, 0,
-	    &arrayPtr);
+    varPtr = TclLookupVar(interp, part1, part2,
+	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1),
+	    /*msg*/ (char *) NULL,
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return;
     }
 
     flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
-    for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
+    for (tracePtr = varPtr->tracePtr, prevPtr = NULL;  ;
 	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
 	if (tracePtr == NULL) {
 	    return;
@@ -975,11 +2333,11 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
 
     /*
      * The code below makes it possible to delete traces while traces
-     * are active:  it makes sure that the deleted trace won't be
+     * are active: it makes sure that the deleted trace won't be
      * processed by CallTraces.
      */
 
-    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+    for (activePtr = iPtr->activeTracePtr;  activePtr != NULL;
 	    activePtr = activePtr->nextPtr) {
 	if (activePtr->nextTracePtr == tracePtr) {
 	    activePtr->nextTracePtr = tracePtr->nextPtr;
@@ -997,7 +2355,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
      * unset and unused, then free up the variable.
      */
 
-    if (varPtr->flags & VAR_UNDEFINED) {
+    if (TclIsVarUndefined(varPtr)) {
 	CleanupVar(varPtr, (Var *) NULL);
     }
 }
@@ -1033,7 +2391,8 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
     Tcl_Interp *interp;		/* Interpreter containing variable. */
     char *varName;		/* Name of variable;  may end with "(index)"
 				 * to signify an array reference. */
-    int flags;			/* 0 or TCL_GLOBAL_ONLY. */
+    int flags;			/* 0, TCL_GLOBAL_ONLY, or
+				 * TCL_NAMESPACE_ONLY. */
     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
     ClientData prevClientData;	/* If non-NULL, gives last value returned
 				 * by this procedure, so this call will
@@ -1042,7 +2401,7 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
 				 * first trace. */
 {
     return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
-	    flags | PART1_NOT_PARSED, proc, prevClientData);
+	    (flags | TCL_PARSE_PART1), proc, prevClientData);
 }
 
 /*
@@ -1069,8 +2428,9 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
     char *part2;		/* Name of element within array;  NULL means
 				 * trace applies to scalar variable or array
 				 * as-a-whole. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY and
-				 * PART1_NOT_PARSED. */
+    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, and
+				 * TCL_PARSE_PART1. */
     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
     ClientData prevClientData;	/* If non-NULL, gives last value returned
 				 * by this procedure, so this call will
@@ -1081,9 +2441,10 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
     register VarTrace *tracePtr;
     Var *varPtr, *arrayPtr;
 
-    varPtr = LookupVar(interp, part1, part2,
-	    flags & (TCL_GLOBAL_ONLY|PART1_NOT_PARSED), (char *) NULL, 0,
-	    &arrayPtr);
+    varPtr = TclLookupVar(interp, part1, part2,
+	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1),
+	    /*msg*/ (char *) NULL,
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return NULL;
     }
@@ -1094,7 +2455,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
 
     tracePtr = varPtr->tracePtr;
     if (prevClientData != NULL) {
-	for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
 	    if ((tracePtr->clientData == prevClientData)
 		    && (tracePtr->traceProc == proc)) {
 		tracePtr = tracePtr->nextPtr;
@@ -1102,7 +2463,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
 	    }
 	}
     }
-    for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
 	if (tracePtr->traceProc == proc) {
 	    return tracePtr->clientData;
 	}
@@ -1113,65 +2474,13 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SetCmd --
+ * Tcl_UnsetObjCmd --
  *
- *	This procedure is invoked to process the "set" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "unset" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
- *
- * Side effects:
- *	A variable's value may be changed.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tcl_SetCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
-{
-    if (argc == 2) {
-	char *value;
-
-	value = Tcl_GetVar2(interp, argv[1], (char *) NULL,
-		TCL_LEAVE_ERR_MSG|PART1_NOT_PARSED);
-	if (value == NULL) {
-	    return TCL_ERROR;
-	}
-	interp->result = value;
-	return TCL_OK;
-    } else if (argc == 3) {
-	char *result;
-
-	result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
-		TCL_LEAVE_ERR_MSG|PART1_NOT_PARSED);
-	if (result == NULL) {
-	    return TCL_ERROR;
-	}
-	interp->result = result;
-	return TCL_OK;
-    } else {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " varName ?newValue?\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_UnsetCmd --
- *
- *	This procedure is invoked to process the "unset" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	See the user documentation.
@@ -1181,22 +2490,28 @@ Tcl_SetCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_UnsetCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_UnsetObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int i;
+    register int i;
+    register char *name;
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " varName ?varName ...?\"", (char *) NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
 	return TCL_ERROR;
     }
-    for (i = 1; i < argc; i++) {
-	if (Tcl_UnsetVar2(interp, argv[i], (char *) NULL,
-		TCL_LEAVE_ERR_MSG|PART1_NOT_PARSED) != TCL_OK) {
+    
+    for (i = 1;  i < objc;  i++) {
+	/*
+	 * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
+	 */
+
+	name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	if (Tcl_UnsetVar2(interp, name, (char *) NULL,
+	        (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1)) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     }
@@ -1206,13 +2521,13 @@ Tcl_UnsetCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendCmd --
+ * Tcl_AppendObjCmd --
  *
- *	This procedure is invoked to process the "append" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "append" 
+ *	Tcl command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	A variable's value may be changed.
@@ -1222,52 +2537,53 @@ Tcl_UnsetCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_AppendCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_AppendObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
+    register Tcl_Obj *varValuePtr = NULL;
+    					/* Initialized to avoid compiler
+				         * warning. */
     int i;
-    char *result = NULL;		/* (Initialization only needed to keep
-					 * the compiler from complaining) */
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " varName ?value value ...?\"", (char *) NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
 	return TCL_ERROR;
     }
-    if (argc == 2) {
-	result = Tcl_GetVar2(interp, argv[1], (char *) NULL,
-		TCL_LEAVE_ERR_MSG|PART1_NOT_PARSED);
-	if (result == NULL) {
-	    return TCL_ERROR;
-	}
-	interp->result = result;
-	return TCL_OK;
-    }
 
-    for (i = 2; i < argc; i++) {
-	result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[i],
-		TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG|PART1_NOT_PARSED);
-	if (result == NULL) {
+    if (objc == 2) {
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	        (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (varValuePtr == NULL) {
 	    return TCL_ERROR;
 	}
+    } else {
+	for (i = 2;  i < objc;  i++) {
+	    varValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+		objv[i],
+		(TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	    if (varValuePtr == NULL) {
+		return TCL_ERROR;
+	    }
+	}
     }
-    interp->result = result;
+    
+    Tcl_SetObjResult(interp, varValuePtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LappendCmd --
+ * Tcl_LappendObjCmd --
  *
- *	This procedure is invoked to process the "lappend" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "lappend" 
+ *	Tcl command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	A variable's value may be changed.
@@ -1277,53 +2593,149 @@ Tcl_AppendCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_LappendCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_LappendObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int i;
-    char *result = NULL;		/* (Initialization only needed to keep
-					 * the compiler from complaining) */
+    Tcl_Obj *varValuePtr, *newValuePtr;
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired, createdNewObj, i, j;
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " varName ?value value ...?\"", (char *) NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
 	return TCL_ERROR;
     }
-    if (argc == 2) {
-	result = Tcl_GetVar2(interp, argv[1], (char *) NULL,
-		TCL_LEAVE_ERR_MSG|PART1_NOT_PARSED);
-	if (result == NULL) {
-	    return TCL_ERROR;
+    
+    if (objc == 2) {
+	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	    (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (newValuePtr == NULL) {
+	    /*
+	     * The variable doesn't exist yet. Just create it with an empty
+	     * initial value.
+	     */
+	    
+	    Tcl_Obj *nullObjPtr = Tcl_NewObj();
+	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
+		    nullObjPtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	    if (newValuePtr == NULL) {
+		Tcl_DecrRefCount(nullObjPtr); /* free unneeded object */
+		return TCL_ERROR;
+	    }
 	}
-	interp->result = result;
-	return TCL_OK;
-    }
+    } else {
+	/*
+	 * We have arguments to append. We used to call Tcl_ObjSetVar2 to
+	 * append each argument one at a time to ensure that traces were run
+	 * for each append step. We now append the arguments all at once
+	 * because it's faster. Note that a read trace and a write trace for
+	 * the variable will now each only be called once. Also, if the
+	 * variable's old value is unshared we modify it directly, otherwise
+	 * we create a new copy to modify: this is "copy on write".
+	 */
 
-    for (i = 2; i < argc; i++) {
-	result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[i],
-		TCL_APPEND_VALUE|TCL_LIST_ELEMENT|TCL_LEAVE_ERR_MSG
-		|PART1_NOT_PARSED);
-	if (result == NULL) {
+	createdNewObj = 0;
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	        TCL_PARSE_PART1);
+	if (varValuePtr == NULL) { /* no old value: append to new obj */
+	    varValuePtr = Tcl_NewObj(); 
+	    createdNewObj = 1;
+	} else if (Tcl_IsShared(varValuePtr)) {	
+	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	    createdNewObj = 1;
+	}
+
+	/*
+	 * Convert the variable's old value to a list object if necessary.
+	 */
+
+	if (varValuePtr->typePtr != &tclListType) {
+	    int result = tclListType.setFromAnyProc(interp, varValuePtr);
+	    if (result != TCL_OK) {
+		if (createdNewObj) {
+		    Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
+		}
+		return result;
+	    }
+	}
+	listRepPtr = (List *) varValuePtr->internalRep.otherValuePtr;
+	elemPtrs = listRepPtr->elements;
+	numElems = listRepPtr->elemCount;
+
+	/*
+	 * If there is no room in the current array of element pointers,
+	 * allocate a new, larger array and copy the pointers to it.
+	 */
+	
+	numRequired = numElems + (objc-2);
+	if (numRequired > listRepPtr->maxElemCount) {
+	    int newMax = (2 * numRequired);
+	    Tcl_Obj **newElemPtrs = (Tcl_Obj **)
+		    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+	    
+	    memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
+		    (size_t) (numElems * sizeof(Tcl_Obj *)));
+	    listRepPtr->maxElemCount = newMax;
+	    listRepPtr->elements = newElemPtrs;
+	    ckfree((char *) elemPtrs);
+	    elemPtrs = newElemPtrs;
+	}
+
+	/*
+	 * Insert the new elements at the end of the list.
+	 */
+
+	for (i = 2, j = numElems;  i < objc;  i++, j++) {
+            elemPtrs[j] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
+        }
+	listRepPtr->elemCount = numRequired;
+
+	/*
+	 * Invalidate and free any old string representation since it no
+	 * longer reflects the list's internal representation.
+	 */
+
+	Tcl_InvalidateStringRep(varValuePtr);
+
+	/*
+	 * Now store the list object back into the variable. If there is an
+	 * error setting the new value, decrement its ref count if it
+	 * was new.
+	 */
+	
+	newValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+		varValuePtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (newValuePtr == NULL) {
+	    if (createdNewObj) {
+		Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */
+	    }
 	    return TCL_ERROR;
 	}
     }
-    interp->result = result;
+
+    /*
+     * Set the interpreter's object result to refer to the variable's value
+     * object.
+     */
+
+    Tcl_SetObjResult(interp, newValuePtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ArrayCmd --
+ * Tcl_ArrayObjCmd --
  *
- *	This procedure is invoked to process the "array" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "array" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl result object.
  *
  * Side effects:
  *	See the user documentation.
@@ -1333,65 +2745,63 @@ Tcl_LappendCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_ArrayCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_ArrayObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int c, notArray;
-    size_t length;
-    Var *varPtr = NULL;		/* Initialization needed only to prevent
-				 * compiler warning. */
+    Var *varPtr, *arrayPtr;
     Tcl_HashEntry *hPtr;
-    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+    int notArray, c;
+    char *varName, *option;
+    int length, result;
 
-    if (argc < 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option arrayName ?arg ...?\"", (char *) NULL);
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
 	return TCL_ERROR;
     }
 
     /*
      * Locate the array variable (and it better be an array).
+     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
      */
 
-    if (iPtr->varFramePtr == NULL) {
-	hPtr = Tcl_FindHashEntry(&iPtr->globalTable, argv[2]);
-    } else {
-	hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, argv[2]);
-    }
+    varName = TclGetStringFromObj(objv[2], (int *) NULL);
+    varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
+            /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     notArray = 0;
-    if (hPtr == NULL) {
+    if (varPtr == NULL) {
 	notArray = 1;
     } else {
-	varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	if (varPtr->flags & VAR_UPVAR) {
-	    varPtr = varPtr->value.upvarPtr;
-	}
-	if (!(varPtr->flags & VAR_ARRAY)) {
+	if (!TclIsVarArray(varPtr)) {
 	    notArray = 1;
 	}
     }
 
     /*
      * Dispatch based on the option.
+     * THIS FAILS IF THE OPTIONS OBJECT'S STRING REP HAS A NULL BYTE.
      */
 
-    c = argv[1][0];
-    length = strlen(argv[1]);
-    if ((c == 'a') && (strncmp(argv[1], "anymore", length) == 0)) {
+    option = TclGetStringFromObj(objv[1], (int *) NULL);
+    c = option[0];
+    length = strlen(option);
+    if ((c == 'a')
+	    && (strncmp(option, "anymore", (unsigned) length) == 0)) {
 	ArraySearch *searchPtr;
+	char *searchId;
 
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " anymore arrayName searchId\"", (char *) NULL);
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "anymore arrayName searchId");
 	    return TCL_ERROR;
 	}
 	if (notArray) {
 	    goto error;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, argv[2], argv[3]);
+	searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
 	if (searchPtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -1400,37 +2810,40 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
 
 	    if (searchPtr->nextEntry != NULL) {
 		varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
-		if (!(varPtr2->flags & VAR_UNDEFINED)) {
+		if (!TclIsVarUndefined(varPtr2)) {
 		    break;
 		}
 	    }
 	    searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
 	    if (searchPtr->nextEntry == NULL) {
-		interp->result = "0";
+		Tcl_SetIntObj(resultPtr, 0);
 		return TCL_OK;
 	    }
 	}
-	interp->result = "1";
+	Tcl_SetIntObj(resultPtr, 1);
 	return TCL_OK;
-    } else if ((c == 'd') && (strncmp(argv[1], "donesearch", length) == 0)) {
+    } else if ((c == 'd')
+	    && (strncmp(option, "donesearch", (unsigned) length) == 0)) {
 	ArraySearch *searchPtr, *prevPtr;
+	char *searchId;
 
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " donesearch arrayName searchId\"", (char *) NULL);
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "donesearch arrayName searchId");
 	    return TCL_ERROR;
 	}
 	if (notArray) {
 	    goto error;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, argv[2], argv[3]);
+	searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
 	if (searchPtr == NULL) {
 	    return TCL_ERROR;
 	}
 	if (varPtr->searchPtr == searchPtr) {
 	    varPtr->searchPtr = searchPtr->nextPtr;
 	} else {
-	    for (prevPtr = varPtr->searchPtr; ; prevPtr = prevPtr->nextPtr) {
+	    for (prevPtr = varPtr->searchPtr;  ;
+		    prevPtr = prevPtr->nextPtr) {
 		if (prevPtr->nextPtr == searchPtr) {
 		    prevPtr->nextPtr = searchPtr->nextPtr;
 		    break;
@@ -1438,80 +2851,115 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
 	    }
 	}
 	ckfree((char *) searchPtr);
-    } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " exists arrayName\"", (char *) NULL);
+    } else if ((c == 'e')
+	    && (strncmp(option, "exists", (unsigned) length) == 0)) {
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "exists arrayName");
 	    return TCL_ERROR;
 	}
-	interp->result = (notArray) ? "0" : "1";
-    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+	Tcl_SetIntObj(resultPtr, !notArray);
+    } else if ((c == 'g')
+	    && (strncmp(option, "get", (unsigned) length) == 0)) {
 	Tcl_HashSearch search;
 	Var *varPtr2;
+	char *pattern = NULL;
 	char *name;
+	Tcl_Obj *namePtr, *valuePtr;
 
-	if ((argc != 3) && (argc != 4)) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " get arrayName ?pattern?\"", (char *) NULL);
+	if ((objc != 3) && (objc != 4)) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "get arrayName ?pattern?");
 	    return TCL_ERROR;
 	}
 	if (notArray) {
 	    return TCL_OK;
 	}
+	if (objc == 4) {
+	    pattern = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	}
 	for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+		hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
 	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-	    if (varPtr2->flags & VAR_UNDEFINED) {
+	    if (TclIsVarUndefined(varPtr2)) {
 		continue;
 	    }
 	    name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-	    if ((argc == 4) && !Tcl_StringMatch(name, argv[3])) {
-		continue;
+	    if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
+		continue;	/* element name doesn't match pattern */
+	    }
+	    
+	    namePtr = Tcl_NewStringObj(name, -1);
+	    result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
+	    if (result != TCL_OK) {
+		Tcl_DecrRefCount(namePtr); /* free unneeded name object */
+		return result;
+	    }
+	    
+	    if (varPtr2->value.objPtr == NULL) {
+		TclNewObj(valuePtr);
+	    } else {
+		valuePtr = varPtr2->value.objPtr;
+	    }
+	    result = Tcl_ListObjAppendElement(interp, resultPtr, valuePtr);
+	    if (result != TCL_OK) {
+		if (varPtr2->value.objPtr == NULL) {
+		    Tcl_DecrRefCount(valuePtr); /* free unneeded object */
+		}
+		return result;
 	    }
-	    Tcl_AppendElement(interp, name);
-	    Tcl_AppendElement(interp, varPtr2->value.string);
 	}
-    } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)
+    } else if ((c == 'n')
+	    && (strncmp(option, "names", (unsigned) length) == 0)
 	    && (length >= 2)) {
 	Tcl_HashSearch search;
 	Var *varPtr2;
+	char *pattern = NULL;
 	char *name;
+	Tcl_Obj *namePtr;
 
-	if ((argc != 3) && (argc != 4)) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " names arrayName ?pattern?\"", (char *) NULL);
+	if ((objc != 3) && (objc != 4)) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "names arrayName ?pattern?");
 	    return TCL_ERROR;
 	}
 	if (notArray) {
 	    return TCL_OK;
 	}
+	if (objc == 4) {
+	    pattern = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	}
 	for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
 		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
 	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-	    if (varPtr2->flags & VAR_UNDEFINED) {
+	    if (TclIsVarUndefined(varPtr2)) {
 		continue;
 	    }
 	    name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-	    if ((argc == 4) && !Tcl_StringMatch(name, argv[3])) {
-		continue;
+	    if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
+		continue;	/* element name doesn't match pattern */
+	    }
+
+	    namePtr = Tcl_NewStringObj(name, -1);
+	    result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
+	    if (result != TCL_OK) {
+		Tcl_DecrRefCount(namePtr); /* free unneeded name object */
+		return result;
 	    }
-	    Tcl_AppendElement(interp, name);
 	}
-    } else if ((c == 'n') && (strncmp(argv[1], "nextelement", length) == 0)
+    } else if ((c == 'n')
+	    && (strncmp(option, "nextelement", (unsigned) length) == 0)
 	    && (length >= 2)) {
 	ArraySearch *searchPtr;
+	char *searchId;
 	Tcl_HashEntry *hPtr;
 
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " nextelement arrayName searchId\"",
-		    (char *) NULL);
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "nextelement arrayName searchId");
 	    return TCL_ERROR;
 	}
 	if (notArray) {
 	    goto error;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, argv[2], argv[3]);
+	searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
 	if (searchPtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -1528,70 +2976,70 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
 		searchPtr->nextEntry = NULL;
 	    }
 	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-	    if (!(varPtr2->flags & VAR_UNDEFINED)) {
+	    if (!TclIsVarUndefined(varPtr2)) {
 		break;
 	    }
 	}
-	interp->result = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-    } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)
+	Tcl_SetStringObj(resultPtr,
+	        Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1);
+    } else if ((c == 's')
+	    && (strncmp(option, "set", (unsigned) length) == 0)
 	    && (length >= 2)) {
-	char **valueArgv;
-	int valueArgc, i, result;
+	Tcl_Obj **elemPtrs;
+	int listLen, i, result;
 
-	if (argc != 4) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " set arrayName list\"", (char *) NULL);
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "set arrayName list");
 	    return TCL_ERROR;
 	}
-	if (Tcl_SplitList(interp, argv[3], &valueArgc, &valueArgv) != TCL_OK) {
-	    return TCL_ERROR;
+	result = Tcl_ListObjGetElements(interp, objv[3], &listLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    return result;
 	}
-	result = TCL_OK;
-	if (valueArgc & 1) {
-	    interp->result = "list must have an even number of elements";
-	    result = TCL_ERROR;
-	    goto setDone;
+	if (listLen & 1) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                    "list must have an even number of elements", -1);
+	    return TCL_ERROR;
 	}
-	for (i = 0; i < valueArgc; i += 2) {
-	    if (Tcl_SetVar2(interp, argv[2], valueArgv[i], valueArgv[i+1],
+	for (i = 0;  i < listLen;  i += 2) {
+	    if (Tcl_ObjSetVar2(interp, objv[2], elemPtrs[i], elemPtrs[i+1],
 		    TCL_LEAVE_ERR_MSG) == NULL) {
 		result = TCL_ERROR;
 		break;
 	    }
 	}
-	setDone:
-	ckfree((char *) valueArgv);
 	return result;
-    } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
+    } else if ((c == 's')
+	    && (strncmp(option, "size", (unsigned) length) == 0)
 	    && (length >= 2)) {
 	Tcl_HashSearch search;
 	Var *varPtr2;
 	int size;
 
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " size arrayName\"", (char *) NULL);
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "size arrayName");
 	    return TCL_ERROR;
 	}
 	size = 0;
 	if (!notArray) {
 	    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+		    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
 		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-		if (varPtr2->flags & VAR_UNDEFINED) {
+		if (TclIsVarUndefined(varPtr2)) {
 		    continue;
 		}
 		size++;
 	    }
 	}
-	sprintf(interp->result, "%d", size);
-    } else if ((c == 's') && (strncmp(argv[1], "startsearch", length) == 0)
+	Tcl_SetIntObj(resultPtr, size);
+    } else if ((c == 's')
+	    && (strncmp(option, "startsearch", (unsigned) length) == 0)
 	    && (length >= 2)) {
 	ArraySearch *searchPtr;
 
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " startsearch arrayName\"", (char *) NULL);
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "startsearch arrayName");
 	    return TCL_ERROR;
 	}
 	if (notArray) {
@@ -1600,13 +3048,14 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
 	searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
 	if (varPtr->searchPtr == NULL) {
 	    searchPtr->id = 1;
-	    Tcl_AppendResult(interp, "s-1-", argv[2], (char *) NULL);
+	    Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
+		    (char *) NULL);
 	} else {
 	    char string[20];
 
 	    searchPtr->id = varPtr->searchPtr->id + 1;
-	    sprintf(string, "%d", searchPtr->id);
-	    Tcl_AppendResult(interp, "s-", string, "-", argv[2],
+	    TclFormatInt(string, searchPtr->id);
+	    Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
 		    (char *) NULL);
 	}
 	searchPtr->varPtr = varPtr;
@@ -1615,7 +3064,7 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
 	searchPtr->nextPtr = varPtr->searchPtr;
 	varPtr->searchPtr = searchPtr;
     } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
+	Tcl_AppendStringsToObj(resultPtr, "bad option \"", option,
 		"\": should be anymore, donesearch, exists, ",
 		"get, names, nextelement, ",
 		"set, size, or startsearch", (char *) NULL);
@@ -1624,7 +3073,7 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
     return TCL_OK;
 
     error:
-    Tcl_AppendResult(interp, "\"", argv[2], "\" isn't an array",
+    Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
 	    (char *) NULL);
     return TCL_ERROR;
 }
@@ -1638,83 +3087,168 @@ Tcl_ArrayCmd(dummy, interp, argc, argv)
  *	commands.
  *
  * Results:
- *	A standard Tcl completion code.  If an error occurs then an
+ *	A standard Tcl completion code. If an error occurs then an
  *	error message is left in iPtr->result.
  *
  * Side effects:
- *	The variable given by myName is linked to the variable in
- *	framePtr given by otherP1 and otherP2, so that references to
- *	myName are redirected to the other variable like a symbolic
-*	link.
+ *	The variable given by myName is linked to the variable in framePtr
+ *	given by otherP1 and otherP2, so that references to myName are
+ *	redirected to the other variable like a symbolic link.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-MakeUpvar(iPtr, framePtr, otherP1, otherP2, myName, flags)
-    Interp *iPtr;		/* Interpreter containing variables.  Used
+MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
+    Interp *iPtr;		/* Interpreter containing variables. Used
 				 * for error messages, too. */
     CallFrame *framePtr;	/* Call frame containing "other" variable.
-				 * NULL means use global context. */
+				 * NULL means use global :: context. */
     char *otherP1, *otherP2;	/* Two-part name of variable in framePtr. */
-    char *myName;		/* Name of variable in local table, which
-				 * will refer to otherP1/P2.  Must be a
-				 * scalar. */
-    int flags;			/* 0 or TCL_GLOBAL_ONLY: indicates scope of
-				 * myName. */
+    int otherFlags;		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of "other" variable. */
+    char *myName;		/* Name of variable which will refer to
+				 * otherP1/otherP2. Must be a scalar. */
+    int myFlags;		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of myName. */
 {
     Tcl_HashEntry *hPtr;
     Var *otherPtr, *varPtr, *arrayPtr;
-    CallFrame *savedFramePtr;
-    int new;
+    CallFrame *varFramePtr;
+    CallFrame *savedFramePtr = NULL;  /* Init. to avoid compiler warning. */
+    Tcl_HashTable *tablePtr;
+    Namespace *nsPtr, *altNsPtr, *dummyNsPtr;
+    char *tail;
+    int new, result;
 
     /*
-     * In order to use LookupVar to find "other", temporarily replace
-     * the current frame pointer in the interpreter.
+     * Find "other" in "framePtr". If not looking up other in just the
+     * current namespace, temporarily replace the current var frame
+     * pointer in the interpreter in order to use TclLookupVar.
      */
 
-    savedFramePtr = iPtr->varFramePtr;
-    iPtr->varFramePtr = framePtr;
-    otherPtr = LookupVar((Tcl_Interp *) iPtr, otherP1, otherP2,
-	    TCL_LEAVE_ERR_MSG, "access", CRT_PART1|CRT_PART2, &arrayPtr);
-    iPtr->varFramePtr = savedFramePtr;
+    if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
+	savedFramePtr = iPtr->varFramePtr;
+	iPtr->varFramePtr = framePtr;
+    }
+    otherPtr = TclLookupVar((Tcl_Interp *) iPtr, otherP1, otherP2,
+	    (otherFlags | TCL_LEAVE_ERR_MSG), "access",
+            /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+    if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
+	iPtr->varFramePtr = savedFramePtr;
+    }
     if (otherPtr == NULL) {
 	return TCL_ERROR;
     }
-    if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
-	hPtr = Tcl_CreateHashEntry(&iPtr->globalTable, myName, &new);
-    } else {
-	hPtr = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable, myName, &new);
+
+    /*
+     * Now create a hashtable entry for "myName". Create it as either a
+     * namespace variable or as a local variable in a procedure call
+     * frame. Interpret myName as a namespace variable if:
+     *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
+     *    2) there is no active frame (we're at the global :: scope),
+     *    3) the active frame was pushed to define the namespace context
+     *       for a "namespace eval" or "namespace inscope" command,
+     *    4) the name has namespace qualifiers ("::"s).
+     * If creating myName in the active procedure, look first in the
+     * frame's array of compiler-allocated local variables, then in its
+     * hashtable for runtime-created local variables. Create that
+     * procedure's local variable hashtable if necessary.
+     */
+
+    varFramePtr = iPtr->varFramePtr;
+    if ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+	        || (varFramePtr == NULL)
+	        || !varFramePtr->isProcCallFrame
+	        || (strstr(myName, "::") != NULL)) {
+	result = TclGetNamespaceForQualName((Tcl_Interp *) iPtr, myName,
+                (Namespace *) NULL, (myFlags | TCL_LEAVE_ERR_MSG),
+                &nsPtr, &altNsPtr, &dummyNsPtr, &tail);
+        if (result != TCL_OK) {
+	    return result;
+        }
+        if (nsPtr == NULL) {
+            nsPtr = altNsPtr;
+        }
+        if (nsPtr == NULL) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
+                myName, "\": unknown namespace", (char *) NULL);
+            return TCL_ERROR;
+        }
+	hPtr = Tcl_CreateHashEntry(&nsPtr->varTable, tail, &new);
+	if (new) {
+	    varPtr = NewVar();
+	    Tcl_SetHashValue(hPtr, varPtr);
+	    varPtr->hPtr = hPtr;
+            varPtr->nsPtr = nsPtr;
+	} else {
+	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+	}
+    } else {			/* look in the call frame */
+	Proc *procPtr = varFramePtr->procPtr;
+	int localCt = procPtr->numCompiledLocals;
+	CompiledLocal *localPtr = procPtr->firstLocalPtr;
+	Var *localVarPtr = varFramePtr->compiledLocals;
+	int nameLen = strlen(myName);
+	int i;
+
+	varPtr = NULL;
+	for (i = 0;  i < localCt;  i++) {
+	    if (!localPtr->isTemp) {
+		char *localName = localVarPtr->name;
+		if ((myName[0] == localName[0])
+		        && (nameLen == localPtr->nameLength)
+		        && (strcmp(myName, localName) == 0)) {
+		    varPtr = localVarPtr;
+		    new = 0;
+		    break;
+		}
+	    }
+	    localVarPtr++;
+	    localPtr = localPtr->nextPtr;
+	}
+	if (varPtr == NULL) {	/* look in frame's local var hashtable */
+	    tablePtr = varFramePtr->varTablePtr;
+	    if (tablePtr == NULL) {
+		tablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+		Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+		varFramePtr->varTablePtr = tablePtr;
+	    }
+	    hPtr = Tcl_CreateHashEntry(tablePtr, myName, &new);
+	    if (new) {
+		varPtr = NewVar();
+		Tcl_SetHashValue(hPtr, varPtr);
+		varPtr->hPtr = hPtr;
+                varPtr->nsPtr = varFramePtr->nsPtr;
+	    } else {
+		varPtr = (Var *) Tcl_GetHashValue(hPtr);
+	    }
+	}
     }
-    if (new) {
-	varPtr = NewVar();
-	Tcl_SetHashValue(hPtr, varPtr);
-	varPtr->hPtr = hPtr;
-    } else {
+
+    if (!new) {
 	/*
-	 * The variable already exists.  Make sure that this variable
-	 * isn't also "otherVar" (avoid circular links).  Also, if it's
-	 * not an upvar then it's an error.  If it is an upvar, then
+	 * The variable already exists. Make sure this variable "varPtr"
+	 * isn't the same as "otherPtr" (avoid circular links). Also, if
+	 * it's not an upvar then it's an error. If it is an upvar, then
 	 * just disconnect it from the thing it currently refers to.
 	 */
 
-	varPtr = (Var *) Tcl_GetHashValue(hPtr);
 	if (varPtr == otherPtr) {
-	    iPtr->result = "can't upvar from variable to itself";
+	    Tcl_SetResult((Tcl_Interp *) iPtr,
+		    "can't upvar from variable to itself", TCL_STATIC);
 	    return TCL_ERROR;
 	}
-	if (varPtr->flags & VAR_UPVAR) {
-	    Var *upvarPtr;
-
-	    upvarPtr = varPtr->value.upvarPtr;
-	    if (upvarPtr == otherPtr) {
+	if (TclIsVarLink(varPtr)) {
+	    Var *linkPtr = varPtr->value.linkPtr;
+	    if (linkPtr == otherPtr) {
 		return TCL_OK;
 	    }
-	    upvarPtr->refCount--;
-	    if (upvarPtr->flags & VAR_UNDEFINED) {
-		CleanupVar(upvarPtr, (Var *) NULL);
+	    linkPtr->refCount--;
+	    if (TclIsVarUndefined(linkPtr)) {
+		CleanupVar(linkPtr, (Var *) NULL);
 	    }
-	} else if (!(varPtr->flags & VAR_UNDEFINED)) {
+	} else if (!TclIsVarUndefined(varPtr)) {
 	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
 		"\" already exists", (char *) NULL);
 	    return TCL_ERROR;
@@ -1724,8 +3258,9 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, myName, flags)
 	    return TCL_ERROR;
 	}
     }
-    varPtr->flags = (varPtr->flags & ~VAR_UNDEFINED) | VAR_UPVAR;
-    varPtr->value.upvarPtr = otherPtr;
+    TclSetVarLink(varPtr);
+    TclClearVarUndefined(varPtr);
+    varPtr->value.linkPtr = otherPtr;
     otherPtr->refCount++;
     return TCL_OK;
 }
@@ -1735,17 +3270,18 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, myName, flags)
  *
  * Tcl_UpVar --
  *
- *	Delete a variable, so that it may not be accessed anymore.
+ *	This procedure links one variable to another, just like
+ *	the "upvar" command.
  *
  * Results:
- *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
- *	if the variable can't be unset.  In the event of an error,
- *	if the TCL_LEAVE_ERR_MSG flag is set then an error message
- *	is left in interp->result.
+ *	A standard Tcl completion code.  If an error occurs then
+ *	an error message is left in interp->result.
  *
  * Side effects:
- *	If varName is defined as a local or global variable in interp,
- *	it is deleted.
+ *	The variable in frameName whose name is given by varName becomes
+ *	accessible under the name localName, so that references to
+ *	localName are redirected to the other variable like a symbolic
+ *	link.
  *
  *----------------------------------------------------------------------
  */
@@ -1756,12 +3292,12 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
 				 * to be looked up. */
     char *frameName;		/* Name of the frame containing the source
 				 * variable, such as "1" or "#0". */
-    char *varName;		/* Name of a variable in interp.  May be
-				 * either a scalar name or an element
-				 * in an array. */
-    char *localName;		/* Destination variable name. */
-    int flags;			/* Either 0 or TCL_GLOBAL_ONLY;  indicates
-				 * whether localName is local or global. */
+    char *varName;		/* Name of a variable in interp to link to.
+				 * May be either a scalar name or an
+				 * element in an array. */
+    char *localName;		/* Name of link variable. */
+    int flags;			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of localName. */
 {
     int result;
     CallFrame *framePtr;
@@ -1773,14 +3309,13 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
     }
 
     /*
-     * Figure out whether this is an array reference, then call
-     * Tcl_UpVar2 to do all the real work.
+     * Figure out whether varName is an array reference, then call
+     * MakeUpvar to do all the real work.
      */
 
-    for (p = varName; *p != '\0'; p++) {
+    for (p = varName;  *p != '\0';  p++) {
 	if (*p == '(') {
 	    char *openParen = p;
-
 	    do {
 		p++;
 	    } while (*p != '\0');
@@ -1791,7 +3326,7 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
 	    *openParen = '\0';
 	    *p = '\0';
 	    result = MakeUpvar((Interp *) interp, framePtr, varName,
-		    openParen+1, localName, flags);
+		    openParen+1, 0, localName, flags);
 	    *openParen = '(';
 	    *p = ')';
 	    return result;
@@ -1800,7 +3335,7 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
 
     scalar:
     return MakeUpvar((Interp *) interp, framePtr, varName, (char *) NULL,
-	    localName, flags);
+	    0, localName, flags);
 }
 
 /*
@@ -1817,8 +3352,8 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
  *
  * Side effects:
  *	The variable in frameName whose name is given by part1 and
- *	part2 becomes accessible under the name newName, so that
- *	references to newName are redirected to the other variable
+ *	part2 becomes accessible under the name localName, so that
+ *	references to localName are redirected to the other variable
  *	like a symbolic link.
  *
  *----------------------------------------------------------------------
@@ -1830,9 +3365,11 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
 				 * for error messages too. */
     char *frameName;		/* Name of the frame containing the source
 				 * variable, such as "1" or "#0". */
-    char *part1, *part2;	/* Two parts of source variable name. */
-    char *localName;		/* Destination variable name. */
-    int flags;			/* TCL_GLOBAL_ONLY or 0. */
+    char *part1, *part2;	/* Two parts of source variable name to
+				 * link to. */
+    char *localName;		/* Name of link variable. */
+    int flags;			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of localName. */
 {
     int result;
     CallFrame *framePtr;
@@ -1841,20 +3378,74 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
     if (result == -1) {
 	return TCL_ERROR;
     }
-    return MakeUpvar((Interp *) interp, framePtr, part1, part2,
+    return MakeUpvar((Interp *) interp, framePtr, part1, part2, 0,
 	    localName, flags);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GlobalCmd --
+ * Tcl_GetVariableFullName --
  *
- *	This procedure is invoked to process the "global" Tcl command.
- *	See the user documentation for details on what it does.
+ *	Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this
+ *	procedure appends to an object the namespace variable's full
+ *	name, qualified by a sequence of parent namespace names.
  *
  * Results:
- *	A standard Tcl result value.
+ *      None.
+ *
+ * Side effects:
+ *      The variable's fully-qualified name is appended to the string
+ *	representation of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetVariableFullName(interp, variable, objPtr)
+    Tcl_Interp *interp;	        /* Interpreter containing the variable. */
+    Tcl_Var variable;		/* Token for the variable returned by a
+				 * previous call to Tcl_FindNamespaceVar. */
+    Tcl_Obj *objPtr;		/* Points to the object onto which the
+				 * variable's full name is appended. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Var *varPtr = (Var *) variable;
+    char *name;
+
+    /*
+     * Add the full name of the containing namespace (if any), followed by
+     * the "::" separator, then the variable name.
+     */
+
+    if (varPtr != NULL) {
+	if (!TclIsVarArrayElement(varPtr)) {
+	    if (varPtr->nsPtr != NULL) {
+		Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
+		if (varPtr->nsPtr != iPtr->globalNsPtr) {
+		    Tcl_AppendToObj(objPtr, "::", 2);
+		}
+	    }
+	    if (varPtr->name != NULL) {
+		Tcl_AppendToObj(objPtr, varPtr->name, -1);
+	    } else if (varPtr->hPtr != NULL) {
+		name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr);
+		Tcl_AppendToObj(objPtr, name, -1);
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobalObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "global" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	See the user documentation.
@@ -1862,30 +3453,185 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_GlobalCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_GlobalObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    register Interp *iPtr = (Interp *) interp;
+    Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *objPtr;
+    char *varName;
+    register char *tail;
+    int result, i;
 
-    if (argc < 2) {
-	Tcl_AppendResult((Tcl_Interp *) iPtr, "wrong # args: should be \"",
-		argv[0], " varName ?varName ...?\"", (char *) NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
 	return TCL_ERROR;
     }
-    if (iPtr->varFramePtr == NULL) {
+
+    /*
+     * If we are not executing inside a Tcl procedure, just return.
+     */
+    
+    if ((iPtr->varFramePtr == NULL)
+	    || !iPtr->varFramePtr->isProcCallFrame) {
 	return TCL_OK;
     }
 
-    for (argc--, argv++; argc > 0; argc--, argv++) {
-	if (MakeUpvar(iPtr, (CallFrame *) NULL, *argv, (char *) NULL, *argv, 0)
-		!= TCL_OK) {
+    for (i = 1;  i < objc;  i++) {
+	/*
+	 * Make a local variable linked to its counterpart in the global ::
+	 * namespace.
+	 */
+	
+	objPtr = objv[i];
+	varName = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+
+	/*
+	 * The variable name might have a scope qualifier, but the name for
+         * the local "link" variable must be the simple name at the tail.
+	 */
+
+	for (tail = varName;  *tail != '\0';  tail++) {
+	    /* empty body */
+	}
+        while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+            tail--;
+	}
+        if (*tail == ':') {
+            tail++;
+	}
+
+	/*
+	 * Link to the variable "varName" in the global :: namespace.
+	 */
+	
+	result = MakeUpvar(iPtr, (CallFrame *) NULL,
+		varName, (char *) NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
+	        /*myName*/ tail, /*myFlags*/ 0);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VariableObjCmd --
+ *
+ *	Invoked to implement the "variable" command that creates one or more
+ *	global variables. Handles the following syntax:
+ *
+ *	    variable ?name value...? name ?value?
+ *
+ *	One or more variables can be created. The variables are initialized
+ *	with the specified values. The value for the last variable is
+ *	optional.
+ *
+ *	If the variable does not exist, it is created and given the optional
+ *	value. If it already exists, it is simply set to the optional
+ *	value. Normally, "name" is an unqualified name, so it is created in
+ *	the current namespace. If it includes namespace qualifiers, it can
+ *	be created in another namespace.
+ *
+ *	If the variable command is executed inside a Tcl procedure, it
+ *	creates a local variable linked to the newly-created namespace
+ *	variable.
+ *
+ * Results:
+ *	Returns TCL_OK if the variable is found or created. Returns
+ *	TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error message
+ *	as the result in the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_VariableObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *varName, *tail;
+    Var *varPtr, *arrayPtr;
+    Tcl_Obj *varValuePtr;
+    int i, result;
+
+    for (i = 1;  i < objc;  i = i+2) {
+	/*
+	 * Look up each variable in the current namespace context, creating
+	 * it if necessary.
+	 */
+	
+	varName = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+	varPtr = TclLookupVar(interp, varName, (char *) NULL,
+                (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
+                /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
+
+	/*
+	 * If a value was specified, set the variable to that value.
+	 * Otherwise, if the variable is new, leave it undefined.
+	 * (If the variable already exists and no value was specified,
+	 * leave its value unchanged; just create the local link if
+	 * we're in a Tcl procedure).
+	 */
+
+	if (i+1 < objc) {	/* a value was specified */
+	    varValuePtr = Tcl_ObjSetVar2(interp, objv[i], (Tcl_Obj *) NULL,
+		    objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+	    if (varValuePtr == NULL) {
+		return TCL_ERROR;
+	    }
+	}	
+
+	/*
+	 * If we are executing inside a Tcl procedure, create a local
+	 * variable linked to the new namespace variable "varName".
+	 */
+
+	if ((iPtr->varFramePtr != NULL)
+	        && iPtr->varFramePtr->isProcCallFrame) {
+	    /*
+	     * varName might have a scope qualifier, but the name for the
+	     * local "link" variable must be the simple name at the tail.
+	     */
+
+	    for (tail = varName;  *tail != '\0';  tail++) {
+		/* empty body */
+	    }
+	    while ((tail > varName)
+		    && ((*tail != ':') || (*(tail-1) != ':'))) {
+		tail--;
+	    }
+	    if (*tail == ':') {
+		tail++;
+	    }
+	    
+	    /*
+	     * Create a local link "tail" to the variable "varName" in the
+	     * current namespace.
+	     */
+	    
+	    result = MakeUpvar(iPtr, (CallFrame *) NULL,
+		    /*otherP1*/ varName, /*otherP2*/ (char *) NULL,
+                    /*otherFlags*/ TCL_NAMESPACE_ONLY,
+		    /*myName*/ tail, /*myFlags*/ 0);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
     }
     return TCL_OK;
 }
@@ -1893,13 +3639,13 @@ Tcl_GlobalCmd(dummy, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UpvarCmd --
+ * Tcl_UpvarObjCmd --
  *
- *	This procedure is invoked to process the "upvar" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "upvar"
+ *	Tcl command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result value.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	See the user documentation.
@@ -1909,48 +3655,51 @@ Tcl_GlobalCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 int
-Tcl_UpvarCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Tcl_UpvarObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    int result;
     CallFrame *framePtr;
+    char *frameSpec, *otherVarName, *myVarName;
     register char *p;
+    int result;
 
-    if (argc < 3) {
+    if (objc < 3) {
 	upvarSyntax:
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" ?level? otherVar localVar ?otherVar localVar ...?\"",
-		(char *) NULL);
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?level? otherVar localVar ?otherVar localVar ...?");
 	return TCL_ERROR;
     }
 
     /*
-     * Find the hash table containing the variable being referenced.
+     * Find the call frame containing each of the "other variables" to be
+     * linked to. FAILS IF objv[1]'s STRING REP CONTAINS NULLS.
      */
 
-    result = TclGetFrame(interp, argv[1], &framePtr);
+    frameSpec = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    result = TclGetFrame(interp, frameSpec, &framePtr);
     if (result == -1) {
 	return TCL_ERROR;
     }
-    argc -= result+1;
-    if ((argc & 1) != 0) {
+    objc -= result+1;
+    if ((objc & 1) != 0) {
 	goto upvarSyntax;
     }
-    argv += result+1;
+    objv += result+1;
 
     /*
-     * Iterate over all the pairs of (other variable, local variable)
-     * names.  For each pair, divide the other variable name into two
-     * parts, then call MakeUpvar to do all the work of creating linking
-     * it to the local variable.
+     * Iterate over each (other variable, local variable) pair.
+     * Divide the other variable name into two parts, then call
+     * MakeUpvar to do all the work of linking it to the local variable.
      */
 
-    for ( ; argc > 0; argc -= 2, argv += 2) {
-	for (p = argv[0]; *p != 0; p++) {
+    for ( ;  objc > 0;  objc -= 2, objv += 2) {
+	myVarName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+	otherVarName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+	for (p = otherVarName;  *p != 0;  p++) {
 	    if (*p == '(') {
 		char *openParen = p;
 
@@ -1963,15 +3712,17 @@ Tcl_UpvarCmd(dummy, interp, argc, argv)
 		}
 		*openParen = '\0';
 		*p = '\0';
-		result = MakeUpvar(iPtr, framePtr, argv[0], openParen+1,
-			argv[1], 0);
+		result = MakeUpvar(iPtr, framePtr,
+		        otherVarName, openParen+1, /*otherFlags*/ 0,
+			myVarName, /*flags*/ 0);
 		*openParen = '(';
 		*p = ')';
 		goto checkResult;
 	    }
 	}
 	scalar:
-	result = MakeUpvar(iPtr, framePtr, argv[0], (char *) NULL, argv[1], 0);
+	result = MakeUpvar(iPtr, framePtr, otherVarName, (char *) NULL, 0,
+	        myVarName, /*flags*/ 0);
 
 	checkResult:
 	if (result != TCL_OK) {
@@ -1988,19 +3739,19 @@ Tcl_UpvarCmd(dummy, interp, argc, argv)
  *
  *	This procedure is invoked to find and invoke relevant
  *	trace procedures associated with a particular operation on
- *	a variable.  This procedure invokes traces both on the
+ *	a variable. This procedure invokes traces both on the
  *	variable and on its containing array (where relevant).
  *
  * Results:
  *	The return value is NULL if no trace procedures were invoked, or
  *	if all the invoked trace procedures returned successfully.
- *	The return value is non-zero if a trace procedure returned an
+ *	The return value is non-NULL if a trace procedure returned an
  *	error (in this case no more trace procedures were invoked after
- *	the error was returned).  In this case the return value is a
+ *	the error was returned). In this case the return value is a
  *	pointer to a static string describing the error.
  *
  * Side effects:
- *	Almost anything can happen, depending on trace;  this procedure
+ *	Almost anything can happen, depending on trace; this procedure
  *	itself doesn't have any side effects.
  *
  *----------------------------------------------------------------------
@@ -2008,22 +3759,20 @@ Tcl_UpvarCmd(dummy, interp, argc, argv)
 
 static char *
 CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
-    Interp *iPtr;			/* Interpreter containing variable. */
-    register Var *arrayPtr;		/* Pointer to array variable that
-					 * contains the variable, or NULL if
-					 * the variable isn't an element of an
-					 * array. */
-    Var *varPtr;			/* Variable whose traces are to be
-					 * invoked. */
-    char *part1, *part2;		/* Variable's two-part name. */
-    int flags;				/* Flags to pass to trace procedures:
-					 * indicates what's happening to
-					 * variable, plus other stuff like
-					 * TCL_GLOBAL_ONLY and
-					 * TCL_INTERP_DESTROYED.   May also
-					 * contain PART1_NOT_PARSEd, which
-					 * should not be passed through
-					 * to callbacks. */
+    Interp *iPtr;		/* Interpreter containing variable. */
+    register Var *arrayPtr;	/* Pointer to array variable that contains
+				 * the variable, or NULL if the variable
+				 * isn't an element of an array. */
+    Var *varPtr;		/* Variable whose traces are to be
+				 * invoked. */
+    char *part1, *part2;	/* Variable's two-part name. */
+    int flags;			/* Flags passed to trace procedures:
+				 * indicates what's happening to variable,
+				 * plus other stuff like TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, and
+				 * TCL_INTERP_DESTROYED. May also contain
+				 * TCL_PARSE_PART1, which should not be
+				 * passed through to callbacks. */
 {
     register VarTrace *tracePtr;
     ActiveVarTrace active;
@@ -2052,7 +3801,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
      */
 
     copiedName = 0;
-    if (flags & PART1_NOT_PARSED) {
+    if (flags & TCL_PARSE_PART1) {
 	for (p = part1; ; p++) {
 	    if (*p == 0) {
 		break;
@@ -2076,7 +3825,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
 	    }
 	}
     }
-    flags &= ~PART1_NOT_PARSED;
+    flags &= ~TCL_PARSE_PART1;
 
     /*
      * Invoke traces on the array containing the variable, if relevant.
@@ -2154,13 +3903,15 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
  *
  * NewVar --
  *
- *	Create a new variable with a given amount of storage
- *	space.
+ *	Create a new heap-allocated variable that will eventually be
+ *	entered into a hashtable.
  *
  * Results:
- *	The return value is a pointer to the new variable structure.
- *	The variable will not be part of any hash table yet.  Its
- *	initial value is empty.
+ *	The return value is a pointer to the new variable structure. It is
+ *	marked as a scalar variable (and not a link or array variable). Its
+ *	value initially is NULL. The variable is not part of any hash table
+ *	yet. Since it will be in a hashtable and not in a call frame, its
+ *	name field is set NULL. It is initially marked as undefined.
  *
  * Side effects:
  *	Storage gets allocated.
@@ -2174,14 +3925,14 @@ NewVar()
     register Var *varPtr;
 
     varPtr = (Var *) ckalloc(sizeof(Var));
-    varPtr->valueLength = 0;
-    varPtr->valueSpace = 0;
-    varPtr->value.string = NULL;
+    varPtr->value.objPtr = NULL;
+    varPtr->name = NULL;
+    varPtr->nsPtr = NULL;
     varPtr->hPtr = NULL;
     varPtr->refCount = 0;
     varPtr->tracePtr = NULL;
     varPtr->searchPtr = NULL;
-    varPtr->flags = VAR_UNDEFINED;
+    varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
     return varPtr;
 }
 
@@ -2210,7 +3961,7 @@ ParseSearchId(interp, varPtr, varName, string)
     Var *varPtr;		/* Array variable search is for. */
     char *varName;		/* Name of array variable that search is
 				 * supposed to be for. */
-    char *string;		/* String containing id of search.  Must have
+    char *string;		/* String containing id of search. Must have
 				 * form "search-num-var" where "num" is a
 				 * decimal number and "var" is a variable
 				 * name. */
@@ -2292,9 +4043,9 @@ DeleteSearches(arrayVarPtr)
  * TclDeleteVars --
  *
  *	This procedure is called to recycle all the storage space
- *	associated with a table of variables.  For this procedure
+ *	associated with a table of variables. For this procedure
  *	to work correctly, it must not be possible for any of the
- *	variable in the table to be accessed from Tcl commands
+ *	variables in the table to be accessed from Tcl commands
  *	(e.g. from trace procedures).
  *
  * Results:
@@ -2313,39 +4064,50 @@ TclDeleteVars(iPtr, tablePtr)
     Tcl_HashTable *tablePtr;	/* Hash table containing variables to
 				 * delete. */
 {
+    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
     Tcl_HashSearch search;
     Tcl_HashEntry *hPtr;
     register Var *varPtr;
-    Var *upvarPtr;
+    Var *linkPtr;
     int flags;
     ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+
+    /*
+     * Determine what flags to pass to the trace callback procedures.
+     */
 
     flags = TCL_TRACE_UNSETS;
-    if (tablePtr == &iPtr->globalTable) {
-	flags |= TCL_INTERP_DESTROYED | TCL_GLOBAL_ONLY;
+    if (tablePtr == &iPtr->globalNsPtr->varTable) {
+	flags |= (TCL_INTERP_DESTROYED | TCL_GLOBAL_ONLY);
+    } else if (tablePtr == &currNsPtr->varTable) {
+	flags |= TCL_NAMESPACE_ONLY;
     }
-    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+
+    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&search)) {
 	varPtr = (Var *) Tcl_GetHashValue(hPtr);
 
 	/*
 	 * For global/upvar variables referenced in procedures, decrement
 	 * the reference count on the variable referred to, and free
-	 * the referenced variable if it's no longer needed.  Don't delete
+	 * the referenced variable if it's no longer needed. Don't delete
 	 * the hash entry for the other variable if it's in the same table
-	 * as us:  this will happen automatically later on.
+	 * as us: this will happen automatically later on.
 	 */
 
-	if (varPtr->flags & VAR_UPVAR) {
-	    upvarPtr = varPtr->value.upvarPtr;
-	    upvarPtr->refCount--;
-	    if ((upvarPtr->refCount == 0) && (upvarPtr->flags & VAR_UNDEFINED)
-		    && (upvarPtr->tracePtr == NULL)) {
-		if (upvarPtr->hPtr == NULL) {
-		    ckfree((char *) upvarPtr);
-		} else if (upvarPtr->hPtr->tablePtr != tablePtr) {
-		    Tcl_DeleteHashEntry(upvarPtr->hPtr);
-		    ckfree((char *) upvarPtr);
+	if (TclIsVarLink(varPtr)) {
+	    linkPtr = varPtr->value.linkPtr;
+	    linkPtr->refCount--;
+	    if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
+		    && (linkPtr->tracePtr == NULL)
+		    && (linkPtr->flags & VAR_IN_HASHTABLE)) {
+		if (linkPtr->hPtr == NULL) {
+		    ckfree((char *) linkPtr);
+		} else if (linkPtr->hPtr->tablePtr != tablePtr) {
+		    Tcl_DeleteHashEntry(linkPtr->hPtr);
+		    ckfree((char *) linkPtr);
 		}
 	    }
 	}
@@ -2353,14 +4115,22 @@ TclDeleteVars(iPtr, tablePtr)
 	/*
 	 * Invoke traces on the variable that is being deleted, then
 	 * free up the variable's space (no need to free the hash entry
-	 * here, unless we're dealing with a global variable:  the
+	 * here, unless we're dealing with a global variable: the
 	 * hash entries will be deleted automatically when the whole
-	 * table is deleted).
+	 * table is deleted). Note that we give CallTraces the variable's
+	 * fully-qualified name so that any called trace procedures can
+	 * refer to these variables being deleted.
 	 */
 
 	if (varPtr->tracePtr != NULL) {
+	    objPtr = Tcl_NewObj();
+	    Tcl_IncrRefCount(objPtr); /* until done with traces */
+	    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
 	    (void) CallTraces(iPtr, (Var *) NULL, varPtr,
-		    Tcl_GetHashKey(tablePtr, hPtr), (char *) NULL, flags);
+		    Tcl_GetStringFromObj(objPtr, (int *) NULL),
+		    (char *) NULL, flags);
+	    Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
+
 	    while (varPtr->tracePtr != NULL) {
 		VarTrace *tracePtr = varPtr->tracePtr;
 		varPtr->tracePtr = tracePtr->nextPtr;
@@ -2373,37 +4143,29 @@ TclDeleteVars(iPtr, tablePtr)
 		}
 	    }
 	}
-	if (varPtr->flags & VAR_ARRAY) {
-	    DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr, flags);
+	    
+	if (TclIsVarArray(varPtr)) {
+	    DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
+	            flags);
 	}
-	if (varPtr->valueSpace > 0) {
-	    /*
-	     * SPECIAL TRICK:  it's possible that the interpreter's result
-	     * currently points to this variable (for example, a "set" or
-	     * "lappend" command was the last command in a procedure that's
-	     * being returned from).  If this is the case, then just pass
-	     * ownership of the value string to the Tcl interpreter.
-	     */
-
-	    if (iPtr->result == varPtr->value.string) {
-		iPtr->freeProc = TCL_DYNAMIC;
-	    } else {
-		ckfree(varPtr->value.string);
-	    }
-	    varPtr->valueSpace = 0;
+	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
+	    objPtr = varPtr->value.objPtr;
+	    TclDecrRefCount(objPtr);
+	    varPtr->value.objPtr = NULL;
 	}
 	varPtr->hPtr = NULL;
 	varPtr->tracePtr = NULL;
-	varPtr->flags = VAR_UNDEFINED;
+	TclSetVarUndefined(varPtr);
+	TclSetVarScalar(varPtr);
 
 	/*
 	 * Recycle the variable's memory space if there aren't any upvar's
-	 * pointing to it.  If there are upvars, then the variable will
-	 * get freed when the last upvar goes away.
+	 * pointing to it. If there are upvars to this variable, then the
+	 * variable will get freed when the last upvar goes away.
 	 */
 
 	if (varPtr->refCount == 0) {
-	    ckfree((char *) varPtr);
+	    ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */
 	}
     }
     Tcl_DeleteHashTable(tablePtr);
@@ -2412,6 +4174,111 @@ TclDeleteVars(iPtr, tablePtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclDeleteCompiledLocalVars --
+ *
+ *	This procedure is called to recycle storage space associated with
+ *	the compiler-allocated array of local variables in a procedure call
+ *	frame. This procedure resembles TclDeleteVars above except that each
+ *	variable is stored in a call frame and not a hash table. For this
+ *	procedure to work correctly, it must not be possible for any of the
+ *	variable in the table to be accessed from Tcl commands (e.g. from
+ *	trace procedures).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteCompiledLocalVars(iPtr, framePtr)
+    Interp *iPtr;		/* Interpreter to which variables belong. */
+    CallFrame *framePtr;	/* Procedure call frame containing
+				 * compiler-assigned local variables to
+				 * delete. */
+{
+    register Var *varPtr;
+    int flags;			/* Flags passed to trace procedures. */
+    Var *linkPtr;
+    ActiveVarTrace *activePtr;
+    int numLocals, i;
+
+    flags = TCL_TRACE_UNSETS;
+    numLocals = framePtr->numCompiledLocals;
+    varPtr = framePtr->compiledLocals;
+    for (i = 0;  i < numLocals;  i++) {
+	/*
+	 * For global/upvar variables referenced in procedures, decrement
+	 * the reference count on the variable referred to, and free
+	 * the referenced variable if it's no longer needed. Don't delete
+	 * the hash entry for the other variable if it's in the same table
+	 * as us: this will happen automatically later on.
+	 */
+
+	if (TclIsVarLink(varPtr)) {
+	    linkPtr = varPtr->value.linkPtr;
+	    linkPtr->refCount--;
+	    if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
+		    && (linkPtr->tracePtr == NULL)
+		    && (linkPtr->flags & VAR_IN_HASHTABLE)) {
+		if (linkPtr->hPtr == NULL) {
+		    ckfree((char *) linkPtr);
+		} else {
+		    Tcl_DeleteHashEntry(linkPtr->hPtr);
+		    ckfree((char *) linkPtr);
+		}
+	    }
+	}
+
+	/*
+	 * Invoke traces on the variable that is being deleted. Then delete
+	 * the variable's trace records.
+	 */
+
+	if (varPtr->tracePtr != NULL) {
+	    (void) CallTraces(iPtr, (Var *) NULL, varPtr,
+		    varPtr->name, (char *) NULL, flags);
+	    while (varPtr->tracePtr != NULL) {
+		VarTrace *tracePtr = varPtr->tracePtr;
+		varPtr->tracePtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+	    }
+	    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+		    activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	}
+
+        /*
+	 * Now if the variable is an array, delete its element hash table.
+	 * Otherwise, if it's a scalar variable, decrement the ref count
+	 * of its value.
+	 */
+	    
+	if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) {
+	    DeleteArray(iPtr, varPtr->name, varPtr, flags);
+	}
+	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
+	    TclDecrRefCount(varPtr->value.objPtr);
+	    varPtr->value.objPtr = NULL;
+	}
+	varPtr->hPtr = NULL;
+	varPtr->tracePtr = NULL;
+	TclSetVarUndefined(varPtr);
+	TclSetVarScalar(varPtr);
+	varPtr++;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * DeleteArray --
  *
  *	This procedure is called to free up everything in an array
@@ -2424,8 +4291,9 @@ TclDeleteVars(iPtr, tablePtr)
  *
  * Side effects:
  *	All storage associated with varPtr's array elements is deleted
- *	(including the hash table).  Delete trace procedures for
- *	array elements are invoked.
+ *	(including the array's hash table). Deletion trace procedures for
+ *	array elements are invoked, then deleted. Any pending traces for
+ *	array elements are also deleted.
  *
  *----------------------------------------------------------------------
  */
@@ -2438,33 +4306,24 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
     Var *varPtr;			/* Pointer to variable structure. */
     int flags;				/* Flags to pass to CallTraces:
 					 * TCL_TRACE_UNSETS and sometimes
-					 * TCL_INTERP_DESTROYED and/or
+					 * TCL_INTERP_DESTROYED,
+					 * TCL_NAMESPACE_ONLY, or
 					 * TCL_GLOBAL_ONLY. */
 {
     Tcl_HashSearch search;
     register Tcl_HashEntry *hPtr;
     register Var *elPtr;
     ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
 
     DeleteSearches(varPtr);
     for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
 	elPtr = (Var *) Tcl_GetHashValue(hPtr);
-	if (elPtr->valueSpace != 0) {
-	    /*
-	     * SPECIAL TRICK:  it's possible that the interpreter's result
-	     * currently points to this element (for example, a "set" or
-	     * "lappend" command was the last command in a procedure that's
-	     * being returned from).  If this is the case, then just pass
-	     * ownership of the value string to the Tcl interpreter.
-	     */
-
-	    if (iPtr->result == elPtr->value.string) {
-		iPtr->freeProc = TCL_DYNAMIC;
-	    } else {
-		ckfree(elPtr->value.string);
-	    }
-	    elPtr->valueSpace = 0;
+	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
+	    objPtr = elPtr->value.objPtr;
+	    TclDecrRefCount(objPtr);
+	    elPtr->value.objPtr = NULL;
 	}
 	elPtr->hPtr = NULL;
 	if (elPtr->tracePtr != NULL) {
@@ -2483,9 +4342,10 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
 		}
 	    }
 	}
-	elPtr->flags = VAR_UNDEFINED;
+	TclSetVarUndefined(elPtr);
+	TclSetVarScalar(elPtr);
 	if (elPtr->refCount == 0) {
-	    ckfree((char *) elPtr);
+	    ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
 	}
     }
     Tcl_DeleteHashTable(varPtr->value.tablePtr);
@@ -2497,17 +4357,19 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
  *
  * CleanupVar --
  *
- *	This procedure is called when it looks like it may be OK
- *	to free up the variable's record and hash table entry, and
- *	those of its containing parent.  It's called, for example,
- *	when a trace on a variable deletes the variable.
+ *	This procedure is called when it looks like it may be OK to free up
+ *	a variable's storage. If the variable is in a hashtable, its Var
+ *	structure and hash table entry will be freed along with those of its
+ *	containing array, if any. This procedure is called, for example,
+ *	when a trace on a variable deletes a variable.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If the variable (or its containing array) really is dead then
- *	its record, and possibly its hash table entry, gets freed up.
+ *	If the variable (or its containing array) really is dead and in a
+ *	hashtable, then its Var structure, and possibly its hash table
+ *	entry, is freed up.
  *
  *----------------------------------------------------------------------
  */
@@ -2520,56 +4382,57 @@ CleanupVar(varPtr, arrayPtr)
 				 * NULL if this variable isn't an array
 				 * element. */
 {
-    if ((varPtr->flags & VAR_UNDEFINED) && (varPtr->refCount == 0)
-	    && (varPtr->tracePtr == NULL)) {
+    if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)
+	    && (varPtr->tracePtr == NULL)
+	    && (varPtr->flags & VAR_IN_HASHTABLE)) {
 	if (varPtr->hPtr != NULL) {
 	    Tcl_DeleteHashEntry(varPtr->hPtr);
 	}
 	ckfree((char *) varPtr);
     }
     if (arrayPtr != NULL) {
-	if ((arrayPtr->flags & VAR_UNDEFINED) && (arrayPtr->refCount == 0)
-		&& (arrayPtr->tracePtr == NULL)) {
+	if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
+		&& (arrayPtr->tracePtr == NULL)
+	        && (arrayPtr->flags & VAR_IN_HASHTABLE)) {
 	    if (arrayPtr->hPtr != NULL) {
 		Tcl_DeleteHashEntry(arrayPtr->hPtr);
 	    }
 	    ckfree((char *) arrayPtr);
 	}
     }
-    return;
 }
-
 /*
  *----------------------------------------------------------------------
  *
  * VarErrMsg --
  *
- *	Generate a reasonable error message describing why a variable
- *	operation failed.
+ *      Generate a reasonable error message describing why a variable
+ *      operation failed.
  *
  * Results:
- *	None.
+ *      None.
  *
  * Side effects:
- *	Interp->result is reset to hold a message identifying the
- *	variable given by part1 and part2 and describing why the
- *	variable operation failed.
+ *      Interp->result is reset to hold a message identifying the
+ *      variable given by part1 and part2 and describing why the
+ *      variable operation failed.
  *
  *----------------------------------------------------------------------
  */
 
 static void
 VarErrMsg(interp, part1, part2, operation, reason)
-    Tcl_Interp *interp;		/* Interpreter in which to record message. */
-    char *part1, *part2;	/* Variable's two-part name. */
-    char *operation;		/* String describing operation that failed,
-				 * e.g. "read", "set", or "unset". */
-    char *reason;		/* String describing why operation failed. */
+    Tcl_Interp *interp;         /* Interpreter in which to record message. */
+    char *part1, *part2;        /* Variable's two-part name. */
+    char *operation;            /* String describing operation that failed,
+                                 * e.g. "read", "set", or "unset". */
+    char *reason;               /* String describing why operation failed. */
 {
     Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "can't ", operation, " \"", part1, (char *) NULL);
+    Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
+		     (char *) NULL);
     if (part2 != NULL) {
-	Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
+        Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
     }
     Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
 }
diff --git a/contrib/tcl/library/http1.0/http.tcl b/contrib/tcl/library/http1.0/http.tcl
new file mode 100644
index 0000000..366b3ed
--- /dev/null
+++ b/contrib/tcl/library/http1.0/http.tcl
@@ -0,0 +1,371 @@
+# http.tcl
+# Client-side HTTP for GET, POST, and HEAD commands.
+# These routines can be used in untrusted code that uses the Safesock
+# security policy.
+# These procedures use a callback interface to avoid using vwait,
+# which is not defined in the safe base.
+#
+# SCCS: @(#) http.tcl 1.6 97/05/20 18:09:27
+#
+# See the http.n man page for documentation
+
+package provide http 1.0
+
+array set http {
+    -accept */*
+    -proxyhost {}
+    -proxyport {}
+    -useragent {Tcl http client package 1.0}
+    -proxyfilter httpProxyRequired
+}
+proc http_config {args} {
+    global http
+    set options [lsort [array names http -*]]
+    set usage [join $options ", "]
+    if {[llength $args] == 0} {
+	set result {}
+	foreach name $options {
+	    lappend result $name $http($name)
+	}
+	return $result
+    }
+    regsub -all -- - $options {} options
+    set pat ^-([join $options |])$
+    if {[llength $args] == 1} {
+	set flag [lindex $args 0]
+	if {[regexp -- $pat $flag]} {
+	    return $http($flag)
+	} else {
+	    return -code error "Unknown option $flag, must be: $usage"
+	}
+    } else {
+	foreach {flag value} $args {
+	    if [regexp -- $pat $flag] {
+		set http($flag) $value
+	    } else {
+		return -code error "Unknown option $flag, must be: $usage"
+	    }
+	}
+    }
+}
+
+ proc httpFinish { token {errormsg ""} } {
+    upvar #0 $token state
+    global errorInfo errorCode
+    if {[string length $errormsg] != 0} {
+	set state(error) [list $errormsg $errorInfo $errorCode]
+	set state(status) error
+    }
+    catch {close $state(sock)}
+    catch {after cancel $state(after)}
+    if {[info exists state(-command)]} {
+	if {[catch {eval $state(-command) {$token}} err]} {
+	    if {[string length $errormsg] == 0} {
+		set state(error) [list $err $errorInfo $errorCode]
+		set state(status) error
+	    }
+	}
+	unset state(-command)
+    }
+}
+proc http_reset { token {why reset} } {
+    upvar #0 $token state
+    set state(status) $why
+    catch {fileevent $state(sock) readable {}}
+    httpFinish $token
+    if {[info exists state(error)]} {
+	set errorlist $state(error)
+	unset state(error)
+	eval error $errorlist
+    }
+}
+proc http_get { url args } {
+    global http
+    if ![info exists http(uid)] {
+	set http(uid) 0
+    }
+    set token http#[incr http(uid)]
+    upvar #0 $token state
+    http_reset $token
+    array set state {
+	-blocksize 	8192
+	-validate 	0
+	-headers 	{}
+	-timeout 	0
+	state		header
+	meta		{}
+	currentsize	0
+	totalsize	0
+        type            text/html
+        body            {}
+	status		""
+    }
+    set options {-blocksize -channel -command -handler -headers \
+		-progress -query -validate -timeout}
+    set usage [join $options ", "]
+    regsub -all -- - $options {} options
+    set pat ^-([join $options |])$
+    foreach {flag value} $args {
+	if [regexp $pat $flag] {
+	    # Validate numbers
+	    if {[info exists state($flag)] && \
+		    [regexp {^[0-9]+$} $state($flag)] && \
+		    ![regexp {^[0-9]+$} $value]} {
+		return -code error "Bad value for $flag ($value), must be integer"
+	    }
+	    set state($flag) $value
+	} else {
+	    return -code error "Unknown option $flag, can be: $usage"
+	}
+    }
+    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)} $url \
+	    x proto host y port srvurl]} {
+	error "Unsupported URL: $url"
+    }
+    if {[string length $port] == 0} {
+	set port 80
+    }
+    if {[string length $proto] == 0} {
+	set url http://$url
+    }
+    set state(url) $url
+    if {![catch {$http(-proxyfilter) $host} proxy]} {
+	set phost [lindex $proxy 0]
+	set pport [lindex $proxy 1]
+    }
+    if {$state(-timeout) > 0} {
+	set state(after) [after $state(-timeout) [list http_reset $token timeout]]
+    }
+    if {[info exists phost] && [string length $phost]} {
+	set srvurl $url
+	set s [socket $phost $pport]
+    } else {
+	set s [socket $host $port]
+    }
+    set state(sock) $s
+
+    # Send data in cr-lf format, but accept any line terminators
+
+    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
+
+    # The following is disallowed in safe interpreters, but the socket
+    # is already in non-blocking mode in that case.
+
+    catch {fconfigure $s -blocking off}
+    set len 0
+    set how GET
+    if {[info exists state(-query)]} {
+	set len [string length $state(-query)]
+	if {$len > 0} {
+	    set how POST
+	}
+    } elseif {$state(-validate)} {
+	set how HEAD
+    }
+    puts $s "$how $srvurl HTTP/1.0"
+    puts $s "Accept: $http(-accept)"
+    puts $s "Host: $host"
+    puts $s "User-Agent: $http(-useragent)"
+    foreach {key value} $state(-headers) {
+	regsub -all \[\n\r\]  $value {} value
+	set key [string trim $key]
+	if {[string length $key]} {
+	    puts $s "$key: $value"
+	}
+    }
+    if {$len > 0} {
+	puts $s "Content-Length: $len"
+	puts $s "Content-Type: application/x-www-form-urlencoded"
+	puts $s ""
+	fconfigure $s -translation {auto binary}
+	puts $s $state(-query)
+    } else {
+	puts $s ""
+    }
+    flush $s
+    fileevent $s readable [list httpEvent $token]
+    if {! [info exists state(-command)]} {
+	http_wait $token
+    }
+    return $token
+}
+proc http_data {token} {
+    upvar #0 $token state
+    return $state(body)
+}
+proc http_status {token} {
+    upvar #0 $token state
+    return $state(status)
+}
+proc http_code {token} {
+    upvar #0 $token state
+    return $state(http)
+}
+proc http_size {token} {
+    upvar #0 $token state
+    return $state(currentsize)
+}
+
+ proc httpEvent {token} {
+    upvar #0 $token state
+    set s $state(sock)
+
+    if [eof $s] then {
+	httpEof $token
+	return
+    }
+    if {$state(state) == "header"} {
+	set n [gets $s line]
+	if {$n == 0} {
+	    set state(state) body
+	    if ![regexp -nocase ^text $state(type)] {
+		# Turn off conversions for non-text data
+		fconfigure $s -translation binary
+	    }
+	    if {[info exists state(-channel)] &&
+		    ![info exists state(-handler)]} {
+		# Initiate a sequence of background fcopies
+		fileevent $s readable {}
+		httpCopyStart $s $token
+	    }
+	} elseif {$n > 0} {
+	    if [regexp -nocase {^content-type:(.+)$} $line x type] {
+		set state(type) [string trim $type]
+	    }
+	    if [regexp -nocase {^content-length:(.+)$} $line x length] {
+		set state(totalsize) [string trim $length]
+	    }
+	    if [regexp -nocase {^([^:]+):(.+)$} $line x key value] {
+		lappend state(meta) $key $value
+	    } elseif {[regexp ^HTTP $line]} {
+		set state(http) $line
+	    }
+	}
+    } else {
+	if [catch {
+	    if {[info exists state(-handler)]} {
+		set n [eval $state(-handler) {$s $token}]
+	    } else {
+		set block [read $s $state(-blocksize)]
+		set n [string length $block]
+		if {$n >= 0} {
+		    append state(body) $block
+		}
+	    }
+	    if {$n >= 0} {
+		incr state(currentsize) $n
+	    }
+	} err] {
+	    httpFinish $token $err
+	} else {
+	    if [info exists state(-progress)] {
+		eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
+	    }
+	}
+    }
+}
+ proc httpCopyStart {s token} {
+    upvar #0 $token state
+    if [catch {
+	fcopy $s $state(-channel) -size $state(-blocksize) -command \
+	    [list httpCopyDone $token]
+    } err] {
+	httpFinish $token $err
+    }
+}
+ proc httpCopyDone {token count} {
+    upvar #0 $token state
+    set s $state(sock)
+    incr state(currentsize) $count
+    if [info exists state(-progress)] {
+	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
+    }
+    if [eof $s] {
+	httpEof $token
+    } else {
+	httpCopyStart $s $token
+    }
+}
+ proc httpEof {token} {
+    upvar #0 $token state
+    if {$state(state) == "header"} {
+	# Premature eof
+	set state(status) eof
+    } else {
+	set state(status) ok
+    }
+    set state(state) eof
+    httpFinish $token
+}
+proc http_wait {token} {
+    upvar #0 $token state
+    if {![info exists state(status)] || [string length $state(status)] == 0} {
+	vwait $token\(status)
+    }
+    if {[info exists state(error)]} {
+	set errorlist $state(error)
+	unset state(error)
+	eval error $errorlist
+    }
+    return $state(status)
+}
+
+# Call http_formatQuery with an even number of arguments, where the first is
+# a name, the second is a value, the third is another name, and so on.
+
+proc http_formatQuery {args} {
+    set result ""
+    set sep ""
+    foreach i $args {
+	append result  $sep [httpMapReply $i]
+	if {$sep != "="} {
+	    set sep =
+	} else {
+	    set sep &
+	}
+    }
+    return $result
+}
+
+# do x-www-urlencoded character mapping
+# The spec says: "non-alphanumeric characters are replaced by '%HH'"
+# 1 leave alphanumerics characters alone
+# 2 Convert every other character to an array lookup
+# 3 Escape constructs that are "special" to the tcl parser
+# 4 "subst" the result, doing all the array substitutions
+ 
+ proc httpMapReply {string} {
+    global httpFormMap
+    set alphanumeric	a-zA-Z0-9
+    if ![info exists httpFormMap] {
+	 
+	for {set i 1} {$i <= 256} {incr i} {
+	    set c [format %c $i]
+	    if {![string match \[$alphanumeric\] $c]} {
+		set httpFormMap($c) %[format %.2x $i]
+	    }
+	}
+	# These are handled specially
+	array set httpFormMap {
+	    " " +   \n %0d%0a
+	}
+    }
+    regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string
+    regsub -all \n $string {\\n} string
+    regsub -all \t $string {\\t} string
+    regsub -all {[][{})\\]\)} $string {\\&} string
+    return [subst $string]
+}
+
+# Default proxy filter. 
+ proc httpProxyRequired {host} {
+    global http
+    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
+	if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {
+	    set http(-proxyport) 8080
+	}
+	return [list $http(-proxyhost) $http(-proxyport)]
+    } else {
+	return {}
+    }
+}
diff --git a/contrib/tcl/library/http1.0/pkgIndex.tcl b/contrib/tcl/library/http1.0/pkgIndex.tcl
new file mode 100644
index 0000000..ab6170f
--- /dev/null
+++ b/contrib/tcl/library/http1.0/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.0
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script.  It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands.  When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}]
diff --git a/contrib/tcl/library/init.tcl b/contrib/tcl/library/init.tcl
index 2a7cb49..43bd37c 100644
--- a/contrib/tcl/library/init.tcl
+++ b/contrib/tcl/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# SCCS: @(#) init.tcl 1.57 96/07/23 08:53:03
+# SCCS: @(#) init.tcl 1.79 97/06/24 17:18:54
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -15,13 +15,27 @@
 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
+package require -exact Tcl 8.0
+
+# Compute the auto path to use in this interpreter.
+
 if [catch {set auto_path $env(TCLLIBPATH)}] {
     set auto_path ""
 }
 if {[lsearch -exact $auto_path [info library]] < 0} {
     lappend auto_path [info library]
 }
+catch {
+    foreach dir $tcl_pkgPath {
+	if {[lsearch -exact $auto_path $dir] < 0} {
+	    lappend auto_path $dir
+	}
+    }
+    unset dir
+}
+
+# Conditionalize for presence of exec.
+
 package unknown tclPkgUnknown
 if {[info commands exec] == ""} {
 
@@ -33,6 +47,7 @@ if {[info commands exec] == ""} {
 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
@@ -69,10 +84,6 @@ proc unknown args {
 	# 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;
@@ -88,7 +99,7 @@ proc unknown args {
 	if $msg {
 	    set errorCode $savedErrorCode
 	    set errorInfo $savedErrorInfo
-	    set code [catch {uplevel $args} msg]
+	    set code [catch {uplevel 1 $args} msg]
 	    if {$code ==  1} {
 		#
 		# Strip the last five lines off the error stack (they're
@@ -107,16 +118,22 @@ proc unknown args {
     if {([info level] == 1) && ([info script] == "") \
 	    && [info exists tcl_interactive] && $tcl_interactive} {
 	if ![info exists auto_noexec] {
-	    if [auto_execok $name] {
+	    set new [auto_execok $name]
+	    if {$new != ""} {
 		set errorCode $savedErrorCode
 		set errorInfo $savedErrorInfo
-		return [uplevel exec >&@stdout <@stdin $args]
+		set redir ""
+		if {[info commands console] == ""} {
+		    set redir ">&@stdout <@stdin"
+		}
+		return [uplevel exec $redir $new [lrange $args 1 end]]
 	    }
 	}
 	set errorCode $savedErrorCode
 	set errorInfo $savedErrorInfo
 	if {$name == "!!"} {
-	    return [uplevel {history redo}]
+#	    return [uplevel {history redo}]
+	    return -code error "!! is disabled until history is fixed in Tcl8.0"
 	}
 	if [regexp {^!(.+)$} $name dummy event] {
 	    return [uplevel [list history redo $event]]
@@ -124,7 +141,15 @@ proc unknown args {
 	if [regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new] {
 	    return [uplevel [list history substitute $old $new]]
 	}
-	set cmds [info commands $name*]
+
+	set ret [catch {set cmds [info commands $name*]} msg]
+	if {[string compare $name "::"] == 0} {
+	    set name ""
+	}
+	if {$ret != 0} {
+	    return -code $ret -errorcode $errorCode \
+		"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
+	}
 	if {[llength $cmds] == 1} {
 	    return [uplevel [lreplace $args 0 0 $cmds]]
 	}
@@ -165,35 +190,45 @@ proc auto_load cmd {
 	}
     }
     set auto_oldpath $auto_path
+
+    # Check if we are a safe interpreter. In that case, we support only
+    # newer format tclIndex files.
+
+    set issafe [interp issafe]
     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]]}] {
+	if {$issafe} {
+	    catch {source [file join $dir tclIndex]}
+	} elseif [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
+	} else {
+	    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]]"
 		    }
-		    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"
 		}
-	    } else {
-		error "[file join $dir tclIndex] isn't a proper Tcl index file"
+	    } msg]
+	    if {$f != ""} {
+		close $f
+	    }
+	    if $error {
+		error $msg $errorInfo $errorCode
 	    }
-	} msg]
-	if {$f != ""} {
-	    close $f
-	}
-	if $error {
-	    error $msg $errorInfo $errorCode
 	}
     }
     if [info exists auto_index($cmd)] {
@@ -209,9 +244,11 @@ 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.
+# Returns string that indicates name of program to execute if 
+# name corresponds to a shell builtin or an executable in the
+# Windows search path, or "" otherwise.  Builds an associative 
+# array auto_execs that caches information about previous checks, 
+# for speed.
 #
 # Arguments: 
 # name -			Name of a command.
@@ -224,47 +261,69 @@ if {[string compare $tcl_platform(platform) windows] == 0} {
 # components are separated with semicolons, not colons as under Unix.
 #
 proc auto_execok name {
-    global auto_execs env
+    global auto_execs env tcl_platform
 
     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
+    set auto_execs($name) ""
+
+    if {[lsearch -exact {cls copy date del erase dir echo mkdir md rename 
+	    ren rmdir rd time type ver vol} $name] != -1} {
+	return [set auto_execs($name) [list $env(COMSPEC) /c $name]]
+    }
+
+    if {[llength [file split $name]] != 1} {
+	foreach ext {{} .com .exe .bat} {
+	    set file ${name}${ext}
+	    if {[file exists $file] && ![file isdirectory $file]} {
+		return [set auto_execs($name) [list $file]]
 	    }
 	}
-	return $auto_execs($name)
+	return ""
     }
-    if {! [info exists env(PATH)]} {
-	if [info exists env(Path)] {
-	    set path $env(Path)
-	} else {
-	    return 0
+
+    set path "[file dirname [info nameof]];.;"
+    if {[info exists env(WINDIR)]} {
+	set windir $env(WINDIR) 
+    }
+    if {[info exists windir]} {
+	if {$tcl_platform(os) == "Windows NT"} {
+	    append path "$windir/system32;"
 	}
-    } else {
-	set path $env(PATH)
+	append path "$windir/system;$windir;"
+    }
+
+    if {[info exists env(PATH)]} {
+	append path $env(PATH)
     }
+
     foreach dir [split $path {;}] {
 	if {$dir == ""} {
 	    set dir .
 	}
-	foreach ext {{} .exe .bat .cmd} {
+	foreach ext {{} .com .exe .bat} {
 	    set file [file join $dir ${name}${ext}]
 	    if {[file exists $file] && ![file isdirectory $file]} {
-		set auto_execs($name) 1
-		return 1
+		return [set auto_execs($name) [list $file]]
 	    }
 	}
     }
-    return 0
+    return ""
 }
 
 } else {
 
+# auto_execok --
+#
+# Returns string that indicates name of program to execute if 
+# name corresponds to an executable in the path. Builds an associative 
+# array auto_execs that caches information about previous checks, 
+# for speed.
+#
+# Arguments: 
+# name -			Name of a command.
+
 # Unix version.
 #
 proc auto_execok name {
@@ -273,10 +332,10 @@ proc auto_execok name {
     if [info exists auto_execs($name)] {
 	return $auto_execs($name)
     }
-    set auto_execs($name) 0
-    if {[file pathtype $name] != "relative"} {
+    set auto_execs($name) ""
+    if {[llength [file split $name]] != 1} {
 	if {[file executable $name] && ![file isdirectory $name]} {
-	    set auto_execs($name) 1
+	    set auto_execs($name) [list $name]
 	}
 	return $auto_execs($name)
     }
@@ -286,11 +345,11 @@ proc auto_execok name {
 	}
 	set file [file join $dir $name]
 	if {[file executable $file] && ![file isdirectory $file]} {
-	    set auto_execs($name) 1
-	    return 1
+	    set auto_execs($name) [list $file]
+	    return $auto_execs($name)
 	}
     }
-    return 0
+    return ""
 }
 
 }
@@ -524,11 +583,30 @@ proc tclPkgSetup {dir pkg version files} {
     }
 }
 
+# tclMacPkgSearch --
+# The procedure is used on the Macintosh to search a given directory for files
+# with a TEXT resource named "pkgIndex".  If it exists it is sourced in to the
+# interpreter to setup the package database.
+
+proc tclMacPkgSearch {dir} {
+    foreach x [glob -nocomplain [file join $dir *.shlb]] {
+	if [file isfile $x] {
+	    set res [resource open $x]
+	    foreach y [resource list TEXT $res] {
+		if {$y == "pkgIndex"} {source -rsrc pkgIndex}
+	    }
+	    resource close $res
+	}
+    }
+}
+
 # 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.
+# the auto_path directories and their immediate children looking for
+# pkgIndex.tcl files and sources any such files that are found to setup
+# the package database.  (On the Macintosh we also search for pkgIndex
+# TEXT resources in all files.)
 #
 # Arguments:
 # name -		Name of desired package.  Not used.
@@ -536,16 +614,47 @@ proc tclPkgSetup {dir pkg version files} {
 # exact -		Either "-exact" or omitted.  Not used.
 
 proc tclPkgUnknown {name version {exact {}}} {
-    global auto_path
+    global auto_path tcl_platform env dir
 
     if ![info exists auto_path] {
 	return
     }
+    if {[info exists dir]} {
+	set save_dir $dir
+    }
     for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {
+	foreach file [glob -nocomplain [file join [lindex $auto_path $i] \
+		* pkgIndex.tcl]] {
+	    set dir [file dirname $file]
+	    if [catch {source $file} msg] {
+		puts stderr \
+		    "error reading package index file $file: $msg"
+	    }
+	}
 	set dir [lindex $auto_path $i]
 	set file [file join $dir pkgIndex.tcl]
 	if [file readable $file] {
-	    source $file
+	    if [catch {source $file} msg] {
+		puts stderr \
+		    "error reading package index file $file: $msg"
+	    }
+	}
+	# On the Macintosh we also look in the resource fork 
+	# of shared libraries
+	if {$tcl_platform(platform) == "macintosh"} {
+	    set dir [lindex $auto_path $i]
+	    tclMacPkgSearch $dir
+	    foreach x [glob -nocomplain [file join $dir *]] {
+		if [file isdirectory $x] {
+		    set dir $x
+		    tclMacPkgSearch $dir
+		}
+	    }
 	}
     }
+    if {[info exists save_dir]} {
+	set dir $save_dir
+    } else {
+	unset dir
+    }
 }
diff --git a/contrib/tcl/library/ldAout.tcl b/contrib/tcl/library/ldAout.tcl
index 5a92893..7914508 100644
--- a/contrib/tcl/library/ldAout.tcl
+++ b/contrib/tcl/library/ldAout.tcl
@@ -18,7 +18,7 @@
 #	its .o file placed before all others in the command; then
 #	"ld" is executed to bind the objects together.
 #
-# SCCS: @(#) ldAout.tcl 1.10 96/05/18 16:40:42
+# SCCS: @(#) ldAout.tcl 1.12 96/11/30 17:11:02
 #
 # Copyright (c) 1995, by General Electric Company. All rights reserved.
 #
@@ -44,12 +44,10 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
   # 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]
     }
   }
 
@@ -112,7 +110,6 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
     }
   }
   lappend libdirs /lib /usr/lib
-  lappend libraries -lm -lc
 
   # MIPS -- If there are corresponding G0 libraries, replace the
   # ordinary ones with the G0 ones.
@@ -140,9 +137,15 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
     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"
+  if [regexp {\.a$} $outputFile] {
+    set shlib_suffix .a
+  } else {
+    set shlib_suffix ""
+  }
+  if [regexp {\..*$} $outputFile match] {
+    set l [expr [string length $m] - [string length $match]]
+  } else {
+    error "Output file does not appear to have a suffix"
   }
   set modName [string tolower [string range $m 0 [expr $l-1]]]
   if [regexp {^lib} $modName] {
@@ -212,16 +215,24 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
 
   # Now compose and execute the ld command that packages the module
 
+  if {$shlib_suffix == ".a"} {
+    set ldCommand "ar cr $outputFile"
+    regsub { -o} $tail {} tail
+  } else {
   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
+  if {$shlib_suffix == ".a"} {
+    exec ranlib $outputFile
+  }
 
   # Clean up working files
 
diff --git a/contrib/tcl/library/safeinit.tcl b/contrib/tcl/library/safeinit.tcl
new file mode 100644
index 0000000..e1ce1a0
--- /dev/null
+++ b/contrib/tcl/library/safeinit.tcl
@@ -0,0 +1,461 @@
+# safeinit.tcl --
+#
+# This code runs in a master to manage a safe slave with Safe Tcl.
+# See the safe.n man page for details.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) safeinit.tcl 1.38 97/06/20 12:57:39
+
+# This procedure creates a safe slave, initializes it with the
+# safe base and installs the aliases for the security policy mechanism.
+
+proc tcl_safeCreateInterp {slave} {
+    global auto_path
+
+    # Create the slave.
+    interp create -safe $slave
+
+    # Set its auto_path
+    interp eval $slave [list set auto_path $auto_path]
+
+    # And initialize it.
+    return [tcl_safeInitInterp $slave]
+}
+
+# This procedure applies the initializations to an already existing
+# interpreter. It is useful when you want to enable an interpreter
+# created with "interp create -safe" to use security policies.
+
+proc tcl_safeInitInterp {slave} {
+    upvar #0 tclSafe$slave state
+    global tcl_library tk_library auto_path tcl_platform
+
+    # These aliases let the slave load files to define new commands
+
+    interp alias $slave source {} tclSafeAliasSource $slave
+    interp alias $slave load {} tclSafeAliasLoad $slave
+
+    # This alias lets the slave have access to a subset of the 'file'
+    # command functionality.
+    tclAliasSubset $slave file file dir.* join root.* ext.* tail \
+	path.* split
+
+    # This alias interposes on the 'exit' command and cleanly terminates
+    # the slave.
+    interp alias $slave exit {} tcl_safeDeleteInterp $slave
+
+    # Source init.tcl into the slave, to get auto_load and other
+    # procedures defined:
+
+    if {$tcl_platform(platform) == "macintosh"} {
+	if {[catch {interp eval $slave [list source -rsrc Init]}]} {
+	    if {[catch {interp eval $slave \
+			[list source [file join $tcl_library init.tcl]]}]} {
+		error "can't source init.tcl into slave $slave"
+	    }
+	}
+    } else {
+	if {[catch {interp eval $slave \
+			[list source [file join $tcl_library init.tcl]]}]} {
+	    error "can't source init.tcl into slave $slave"
+	}
+    }
+
+    # Loading packages into slaves is handled by their master.
+    # This is overloaded to deal with regular packages and security policies
+
+    interp alias $slave tclPkgUnknown {} tclSafeAliasPkgUnknown $slave
+    interp eval $slave {package unknown tclPkgUnknown}
+
+    # We need a helper procedure to define a $dir variable and then
+    # do a source of the pkgIndex.tcl file
+    interp eval $slave \
+	[list proc tclPkgSource {dir args} {
+		if {[llength $args] == 2} {
+		    source [lindex $args 0] [lindex $args 1]
+		} else {
+		    source [lindex $args 0]
+		}
+	      }]
+
+    # Let the slave inherit a few variables
+    foreach varName \
+	{tcl_library tcl_version tcl_patchLevel \
+	 tcl_platform(platform) auto_path} {
+	upvar #0 $varName var
+	interp eval $slave [list set $varName $var]
+    }
+
+    # Other variables are predefined with set values
+    foreach {varName value} {
+	    auto_noexec 1
+	    errorCode {}
+	    errorInfo {}
+	    env() {}
+	    argv0 {}
+	    argv {}
+	    argc 0
+	    tcl_interactive 0
+	    } {
+	interp eval $slave [list set $varName $value]
+    }
+
+    # If auto_path is not set in the slave, set it to empty so it has
+    # a value and exists. Otherwise auto_loading and package require
+    # will complain.
+
+    interp eval $slave {
+	if {![info exists auto_path]} {
+	    set auto_path {}
+	}
+    }
+
+    # If we have Tk, make the slave have the same library as us:
+
+    if {[info exists tk_library]} {
+        interp eval $slave [list set tk_library $tk_library]
+    }
+
+    # Stub out auto-exec mechanism in slave
+    interp eval $slave [list proc auto_execok {name} {return {}}]
+
+    return $slave
+}
+
+# This procedure deletes a safe slave managed by Safe Tcl and
+# cleans up associated state:
+
+proc tcl_safeDeleteInterp {slave args} {
+    upvar #0 tclSafe$slave state
+
+    # If the slave has a policy loaded, clean it up now.
+    if {[info exists state(policyLoaded)]} {
+	set policy $state(policyLoaded)
+	set proc ${policy}_PolicyCleanup
+	if {[string compare [info proc $proc] $proc] == 0} {
+	    $proc $slave
+	}
+    }
+
+    # Discard the global array of state associated with the slave, and
+    # delete the interpreter.
+    catch {unset state}
+    catch {interp delete $slave}
+
+    return
+}
+
+# This procedure computes the global security policy search path.
+
+proc tclSafeComputePolicyPath {} {
+    global auto_path tclSafeAutoPathComputed tclSafePolicyPath
+
+    set recompute 0
+    if {(![info exists tclSafePolicyPath]) ||
+	    ("$tclSafePolicyPath" == "")} {
+	set tclSafePolicyPath ""
+	set tclSafeAutoPathComputed ""
+	set recompute 1
+    }
+    if {"$tclSafeAutoPathComputed" != "$auto_path"} {
+	set recompute 1
+	set tclSafeAutoPathComputed $auto_path
+    }
+    if {$recompute == 1} {
+	set tclSafePolicyPath ""
+	foreach i $auto_path {
+	    lappend tclSafePolicyPath [file join $i policies]
+	}
+    }
+    return $tclSafePolicyPath
+}
+
+# ---------------------------------------------------------------------------
+# ---------------------------------------------------------------------------
+
+# tclSafeAliasSource is the target of the "source" alias in safe interpreters.
+
+proc tclSafeAliasSource {slave args} {
+    global auto_path errorCode errorInfo
+
+    if {[llength $args] == 2} {
+	if {[string compare "-rsrc" [lindex $args 0]] != 0} {
+	    return -code error "incorrect arguments to source"
+	}
+	if {[catch {interp invokehidden $slave source -rsrc [lindex $args 1]} \
+		 msg]} {
+	    return -code error $msg
+	}
+    } else {
+	set file [lindex $args 0]
+	if {[catch {tclFileInPath $file $auto_path $slave} msg]} {
+	    return -code error "permission denied"
+	}
+	set errorInfo ""
+	if {[catch {interp invokehidden $slave source $file} msg]} {
+	    return -code error $msg
+	}
+    }
+    return $msg
+}
+
+# tclSafeAliasLoad is the target of the "load" alias in safe interpreters.
+
+proc tclSafeAliasLoad {slave file args} {
+    global auto_path
+
+    if {[llength $args] == 2} {
+	# Trying to load into another interpreter
+	# Allow this for a child of the slave, or itself
+	set other [lindex $args 1]
+	foreach x $slave y $other {
+	    if {[string length $x] == 0} {
+		break
+	    } elseif {[string compare $x $y] != 0} {
+		return -code error "permission denied"
+	    }
+	}
+	set slave $other
+    }
+
+    if {[string length $file] && \
+		[catch {tclFileInPath $file $auto_path $slave} msg]} {
+	return -code error "permission denied"
+    }
+    if {[catch {
+	switch [llength $args] {
+	    0 {
+		interp invokehidden $slave load $file
+	    }
+	    1 -
+	    2 {
+		interp invokehidden $slave load $file [lindex $args 0]
+	    }
+	    default {
+		error "too many arguments to load"
+	    }
+	}
+    } msg]} {
+	return -code error $msg
+    }
+    return $msg
+}
+
+# tclFileInPath raises an error if the file is not found in
+# the list of directories contained in path.
+
+proc tclFileInPath {file path slave} {
+    set realcheckpath [tclSafeCheckAutoPath $path $slave]
+    set pwd [pwd]
+    if {[file isdirectory $file]} {
+	error "$file: not found"
+    }
+    set parent [file dirname $file]
+    if {[catch {cd $parent} msg]} {
+	error "$file: not found"
+    }
+    set realfilepath [file split [pwd]]
+    foreach dir $realcheckpath {
+	set match 1
+	foreach a [file split $dir] b $realfilepath {
+	    if {[string length $a] == 0} {
+		break
+	    } elseif {[string compare $a $b] != 0} {
+		set match 0
+		break
+	    }
+	}
+	if {$match} {
+	    cd $pwd
+	    return 1
+	}
+    }
+    cd $pwd
+    error "$file: not found"
+}
+
+# This procedure computes our expanded copy of the path, as needed.
+# It returns the path after expanding out all aliases.
+
+proc tclSafeCheckAutoPath {path slave} {
+    global auto_path
+    upvar #0 tclSafe$slave state
+
+    if {![info exists state(expanded_auto_path)]} {
+	# Compute for the first time:
+	set state(cached_auto_path) $path
+    } elseif {"$state(cached_auto_path)" != "$path"} {
+	# The value of our path changed, so recompute:
+	set state(cached_auto_path) $path
+    } else {
+	# No change: no need to recompute.
+	return $state(expanded_auto_path)
+    }
+
+    set pwd [pwd]
+    set state(expanded_auto_path) ""
+    foreach dir $state(cached_auto_path) {
+	if {![catch {cd $dir}]} {
+	    lappend state(expanded_auto_path) [pwd]
+	}
+    }
+    cd $pwd
+    return $state(expanded_auto_path)
+}
+
+proc tclSafeAliasPkgUnknown {slave package version {exact {}}} {
+    tclSafeLoadPkg $slave $package $version $exact
+}
+
+proc tclSafeLoadPkg {slave package version exact} {
+    if {[string length $version] == 0} {
+	set version 1.0
+    }
+    tclSafeLoadPkgInternal $slave $package $version $exact 0
+}
+
+proc tclSafeLoadPkgInternal {slave package version exact round} {
+    global auto_path
+    upvar #0 tclSafe$slave state
+
+    # Search the policy path again; it might have changed in the meantime.
+
+    if {$round == 1} {
+	tclSafeResearchPolicyPath
+
+	if {[tclSafeLoadPolicy $slave $package $version]} {
+	    return
+	}
+    }
+
+    # Try to load as a policy.
+
+    if [tclSafeLoadPolicy $slave $package $version] {
+	return
+    }
+
+    # The package is not a security policy, so do the regular setup.
+
+    # Here we run tclPkgUnknown in the master, but we hijack
+    # the source command so the setup ends up happening in the slave.
+
+    rename source source.orig
+    proc source {args} "upvar dir dir
+	interp eval [list $slave] tclPkgSource \[list \$dir\] \$args"
+
+    if [catch {tclPkgUnknown $package $version $exact} err] {
+	global errorInfo
+
+	rename source {}
+	rename source.orig source
+
+	error "$err\n$errorInfo"
+    }
+    rename source {}
+    rename source.orig source
+
+    # If we are in the first round, check if the package
+    # is now known in the slave:
+
+    if {$round == 0} {
+        set ifneeded \
+		[interp eval $slave [list package ifneeded $package $version]]
+
+	if {"$ifneeded" == ""} {
+	    return [tclSafeLoadPkgInternal $slave $package $version $exact 1]
+	}
+    }
+}
+
+proc tclSafeResearchPolicyPath {} {
+    global tclSafePolicyPath auto_index auto_path
+
+    # If there was no change, do not search again.
+
+    if {![info exists tclSafePolicyPath]} {
+	set tclSafePolicyPath ""
+    }
+    set oldPolicyPath $tclSafePolicyPath
+    set newPolicyPath [tclSafeComputePolicyPath]
+    if {"$newPolicyPath" == "$oldPolicyPath"} {
+	return
+    }
+
+    # Loop through the path from back to front so early directories
+    # end up overriding later directories.  This code is like auto_load,
+    # but only new-style tclIndex files (version 2) are supported.
+
+    for {set i [expr [llength $newPolicyPath] - 1]} \
+	    {$i >= 0} \
+	    {incr i -1} {
+	set dir [lindex $newPolicyPath $i]
+        set file [file join $dir tclIndex]
+	if {[file exists $file]} {
+	    if {[catch {source $file} msg]} {
+		puts stderr "error sourcing $file: $msg"
+	    }
+	}
+	foreach file [lsort [glob -nocomplain [file join $dir *]]] {
+	    if {[file isdir $file]} {
+		set dir $file
+		set file [file join $file tclIndex]
+		if {[file exists $file]} {
+		    if {[catch {source $file} msg]} {
+			puts stderr "error sourcing $file: $msg"
+		    }
+		}
+	    }
+	}
+    }
+}
+
+proc tclSafeLoadPolicy {slave package version} {
+    upvar #0 tclSafe$slave state
+    global auto_index
+
+    set proc ${package}_PolicyInit
+
+    if {[info command $proc] == "$proc" ||
+	    [info exists auto_index($proc)]} {
+	if [info exists state(policyLoaded)] {
+	    error "security policy $state(policyLoaded) already loaded"
+	}	
+	$proc $slave $version
+	interp eval $slave [list package provide $package $version]
+	set state(policyLoaded) $package
+	return 1
+    } else {
+	return 0
+    }
+}
+# This procedure enables access from a safe interpreter to only a subset of
+# the subcommands of a command:
+
+proc tclSafeSubset {command okpat args} {
+    set subcommand [lindex $args 0]
+    if {[regexp $okpat $subcommand]} {
+	return [eval {$command $subcommand} [lrange $args 1 end]]
+    }
+    error "not allowed to invoke subcommand $subcommand of $command"
+}
+
+# This procedure installs an alias in a slave that invokes "safesubset"
+# in the master to execute allowed subcommands. It precomputes the pattern
+# of allowed subcommands; you can use wildcards in the pattern if you wish
+# to allow subcommand abbreviation.
+#
+# Syntax is: tclAliasSubset slave alias target subcommand1 subcommand2...
+
+proc tclAliasSubset {slave alias target args} {
+    set pat ^(; set sep ""
+    foreach sub $args {
+	append pat $sep$sub
+	set sep |
+    }
+    append pat )\$
+    interp alias $slave $alias {} tclSafeSubset $target $pat
+}
diff --git a/contrib/tcl/library/tclIndex b/contrib/tcl/library/tclIndex
index 98ceff1..a0acc86 100644
--- a/contrib/tcl/library/tclIndex
+++ b/contrib/tcl/library/tclIndex
@@ -6,6 +6,28 @@
 # element name is the name of a command and the value is
 # a script that loads the command.
 
+set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]
+set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]
+set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]
+set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]
+set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]
+set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]
+set auto_index(tcl_safeCreateInterp) [list source [file join $dir safeinit.tcl]]
+set auto_index(tcl_safeInitInterp) [list source [file join $dir safeinit.tcl]]
+set auto_index(tcl_safeDeleteInterp) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeComputePolicyPath) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeAliasSource) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeAliasLoad) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclFileInPath) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeCheckAutoPath) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeAliasPkgUnknown) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeLoadPkg) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeLoadPkgInternal) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeResearchPolicyPath) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeLoadPolicy) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclSafeSubset) [list source [file join $dir safeinit.tcl]]
+set auto_index(tclAliasSubset) [list source [file join $dir safeinit.tcl]]
 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]]
@@ -14,6 +36,5 @@ 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(tclMacPkgSearch) [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]]
diff --git a/contrib/tcl/library/word.tcl b/contrib/tcl/library/word.tcl
new file mode 100644
index 0000000..64639f22
--- /dev/null
+++ b/contrib/tcl/library/word.tcl
@@ -0,0 +1,135 @@
+# word.tcl --
+#
+# This file defines various procedures for computing word boundaries
+# in strings.  This file is primarily needed so Tk text and entry
+# widgets behave properly for different platforms.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# SCCS: @(#) word.tcl 1.2 96/11/20 14:07:22
+# 
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# The following variables are used to determine which characters are
+# interpreted as white space.  
+
+if {$tcl_platform(platform) == "windows"} {
+    # Windows style - any but space, tab, or newline
+    set tcl_wordchars "\[^ \t\n\]"
+    set tcl_nonwordchars "\[ \t\n\]"
+} else {
+    # Motif style - any number, letter, or underscore
+    set tcl_wordchars {[a-zA-Z0-9_]}
+    set tcl_nonwordchars {[^a-zA-Z0-9_]}
+}
+
+# tcl_wordBreakAfter --
+#
+# This procedure returns the index of the first word boundary
+# after the starting point in the given string, or -1 if there
+# are no more boundaries in the given string.  The index returned refers
+# to the first character of the pair that comprises a boundary.
+#
+# Arguments:
+# str -		String to search.
+# start -	Index into string specifying starting point.
+
+proc tcl_wordBreakAfter {str start} {
+    global tcl_nonwordchars tcl_wordchars
+    set str [string range $str $start end]
+    if [regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result] {
+	return [expr [lindex $result 1] + $start]
+    }
+    return -1
+}
+
+# tcl_wordBreakBefore --
+#
+# This procedure returns the index of the first word boundary
+# before the starting point in the given string, or -1 if there
+# are no more boundaries in the given string.  The index returned
+# refers to the second character of the pair that comprises a boundary.
+#
+# Arguments:
+# str -		String to search.
+# start -	Index into string specifying starting point.
+
+proc tcl_wordBreakBefore {str start} {
+    global tcl_nonwordchars tcl_wordchars
+    if {[string compare $start end] == 0} {
+	set start [string length $str]
+    }
+    if [regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result] {
+	return [lindex $result 1]
+    }
+    return -1
+}
+
+# tcl_endOfWord --
+#
+# This procedure returns the index of the first end-of-word location
+# after a starting index in the given string.  An end-of-word location
+# is defined to be the first whitespace character following the first
+# non-whitespace character after the starting point.  Returns -1 if
+# there are no more words after the starting point.
+#
+# Arguments:
+# str -		String to search.
+# start -	Index into string specifying starting point.
+
+proc tcl_endOfWord {str start} {
+    global tcl_nonwordchars tcl_wordchars
+    if [regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
+	    [string range $str $start end] result] {
+	return [expr [lindex $result 1] + $start]
+    }
+    return -1
+}
+
+# tcl_startOfNextWord --
+#
+# This procedure returns the index of the first start-of-word location
+# after a starting index in the given string.  A start-of-word
+# location is defined to be a non-whitespace character following a
+# whitespace character.  Returns -1 if there are no more start-of-word
+# locations after the starting point.
+#
+# Arguments:
+# str -		String to search.
+# start -	Index into string specifying starting point.
+
+proc tcl_startOfNextWord {str start} {
+    global tcl_nonwordchars tcl_wordchars
+    if [regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
+	    [string range $str $start end] result] {
+	return [expr [lindex $result 1] + $start]
+    }
+    return -1
+}
+
+# tcl_startOfPreviousWord --
+#
+# This procedure returns the index of the first start-of-word location
+# before a starting index in the given string.
+#
+# Arguments:
+# str -		String to search.
+# start -	Index into string specifying starting point.
+
+proc tcl_startOfPreviousWord {str start} {
+    global tcl_nonwordchars tcl_wordchars
+    if {[string compare $start end] == 0} {
+	set start [string length $str]
+    }
+    if [regexp -indices \
+	    "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
+	    [string range $str 0 [expr $start - 1]] result word] {
+	return [lindex $word 0]
+    }
+    return -1
+}
diff --git a/contrib/tcl/tests/append.test b/contrib/tcl/tests/append.test
index 2be7194..6733454 100644
--- a/contrib/tcl/tests/append.test
+++ b/contrib/tcl/tests/append.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) append.test 1.14 96/04/05 15:28:42
+# SCCS: @(#) append.test 1.16 97/04/09 11:29:33
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -86,43 +86,47 @@ test append-4.6 {lappend command} {
 test append-4.7 {lappend command} {
     set x "a\{"
     lappend x abc
-} "a{ abc"
+} "a\\\{ abc"
 test append-4.8 {lappend command} {
     set x "\\\{"
     lappend x abc
 } "\\{ abc"
 test append-4.9 {lappend command} {
     set x " \{"
-    lappend x abc
-} " {abc"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
 test append-4.10 {lappend command} {
     set x "	\{"
-    lappend x abc
-} "	{abc"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
 test append-4.11 {lappend command} {
     set x "\{\{\{"
-    lappend x abc
-} "{{{abc"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
 test append-4.12 {lappend command} {
     set x "x \{\{\{"
-    lappend x abc
-} "x {{{abc"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
 test append-4.13 {lappend command} {
     set x "x\{\{\{"
     lappend x abc
-} "x{{{ abc"
+} "x\\\{\\\{\\\{ abc"
 test append-4.14 {lappend command} {
     set x " "
     lappend x abc
-} " abc"
+} "abc"
 test append-4.15 {lappend command} {
     set x "\\ "
     lappend x abc
-} "\\  abc"
+} "{ } abc"
 test append-4.16 {lappend command} {
     set x "x "
     lappend x abc
 } "x abc"
+test append-4.17 {lappend command} {
+    catch {unset x}
+    lappend x
+} {}
 
 proc check {var size} {
     set l [llength $var]
@@ -152,7 +156,3 @@ test append-6.2 {lappend errors} {
     set x ""
     list [catch {lappend x(0) 44} msg] $msg
 } {1 {can't set "x(0)": variable isn't array}}
-test append-6.3 {lappend errors} {
-    catch {unset x}
-    list [catch {lappend x} msg] $msg
-} {1 {can't read "x": no such variable}}
diff --git a/contrib/tcl/tests/basic.test b/contrib/tcl/tests/basic.test
new file mode 100644
index 0000000..d2f3701
--- /dev/null
+++ b/contrib/tcl/tests/basic.test
@@ -0,0 +1,381 @@
+# This file contains tests for the tclBasic.c source file. Tests appear in
+# the same order as the C code that they test. The set of tests is
+# currently incomplete since it currently includes only new tests for
+# code changed for the addition of Tcl namespaces. Other variable-
+# related tests appear in several other test files including
+# assocd.test, cmdInfo.test, eval.test, expr.test, interp.test,
+# and trace.test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) basic.test 1.6 97/06/20 14:51:18
+#
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {namespace delete test_ns_basic}
+catch {interp delete test_interp}
+catch {rename p ""}
+catch {rename q ""}
+catch {rename cmd ""}
+catch {unset x}
+
+test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} {
+    catch {interp delete test_interp}
+    interp create test_interp
+    interp eval test_interp {
+        namespace eval test_ns_basic {
+            proc p {} {
+                return [namespace current]
+            }
+        }
+    }
+    list [interp eval test_interp {test_ns_basic::p}] \
+         [interp delete test_interp]
+} {::test_ns_basic {}}
+
+test basic-2.1 {DeleteInterpProc, destroys interp's global namespace} {
+    catch {interp delete test_interp}
+    interp create test_interp
+    interp eval test_interp {
+        namespace eval test_ns_basic {
+            namespace export p
+            proc p {} {
+                return [namespace current]
+            }
+        }
+        namespace eval test_ns_2 {
+            namespace import ::test_ns_basic::p
+            variable v 27
+            proc q {} {
+                variable v
+                return "[p] $v"
+            }
+        }
+    }
+    list [interp eval test_interp {test_ns_2::q}] \
+         [interp eval test_interp {namespace delete ::}] \
+         [catch {interp eval test_interp {set a 123}} msg] $msg \
+         [interp delete test_interp]
+} {{::test_ns_basic 27} {} 1 {invalid command name "set"} {}}
+
+test basic-3.1 {HiddenCmdsDeleteProc, invalidate cached refs to deleted hidden cmd} {
+    catch {interp delete test_interp}
+    interp create test_interp
+    interp eval test_interp {
+        proc p {} {
+            return 27
+        }
+    }
+    interp alias {} localP test_interp p
+    list [interp eval test_interp {p}] \
+         [localP] \
+         [test_interp hide p] \
+         [catch {localP} msg] $msg \
+         [interp delete test_interp] \
+         [catch {localP} msg] $msg
+} {27 27 {} 1 {invalid command name "p"} {} 1 {invalid command name "localP"}}
+
+test basic-4.1 {Tcl_HideCommand, names of hidden cmds can't have namespace qualifiers} {
+    catch {interp delete test_interp}
+    interp create test_interp
+    interp eval test_interp {
+        namespace eval test_ns_basic {
+            proc p {} {
+                return [namespace current]
+            }
+        }
+    }
+    list [catch {test_interp hide test_ns_basic::p} msg] $msg \
+         [interp delete test_interp]
+} {1 {hidden command names can't have namespace qualifiers} {}}
+test basic-4.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespace} {
+    catch {namespace delete test_ns_basic}
+    catch {rename cmd ""}
+    proc cmd {} {   ;# note that this is global
+        return [namespace current]
+    }
+    namespace eval test_ns_basic {
+        proc hideCmd {} {
+            interp hide {} cmd
+        }
+        proc exposeCmd {} {
+            interp expose {} cmd
+        }
+        proc callCmd {} {
+            cmd
+        }
+    }
+    list [test_ns_basic::callCmd] \
+         [test_ns_basic::hideCmd] \
+         [catch {cmd} msg] $msg \
+         [test_ns_basic::exposeCmd] \
+         [test_ns_basic::callCmd] \
+         [namespace delete test_ns_basic]
+} {:: {} 1 {invalid command name "cmd"} {} :: {}}
+
+test basic-5.1 {Tcl_ExposeCommand, an exposed cmd goes back to its containing namespace unless cmd name has namespace qualifiers} {
+    catch {namespace delete test_ns_basic}
+    catch {rename cmd ""}
+    proc cmd {} {   ;# note that this is global
+        return [namespace current]
+    }
+    namespace eval test_ns_basic {
+        proc hideCmd {} {
+            interp hide {} cmd
+        }
+        proc exposeCmd {} {
+            interp expose {} cmd ::test_ns_basic::newCmd
+        }
+        proc callCmd {} {
+            cmd
+        }
+    }
+    list [test_ns_basic::callCmd] \
+         [test_ns_basic::hideCmd] \
+         [test_ns_basic::exposeCmd] \
+         [test_ns_basic::newCmd] \
+         [namespace delete test_ns_basic]
+} {:: {} {} :: {}}
+test basic-5.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
+    catch {rename p ""}
+    catch {rename cmd ""}
+    proc p {} {
+        cmd
+    }
+    proc cmd {} {
+        return 42
+    }
+    list [p] \
+         [interp hide {} cmd] \
+         [proc cmd {} {return Hello}] \
+         [cmd] \
+         [rename cmd ""] \
+         [interp expose {} cmd] \
+         [p]
+} {42 {} {} Hello {} {} 42}
+
+if {[info commands testcreatecommand] != {}} {
+    test basic-6.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {
+        catch {eval namespace delete [namespace children :: test_ns_*]}
+        list [testcreatecommand create] \
+             [test_ns_basic::createdcommand] \
+             [testcreatecommand delete]
+    } {{} {CreatedCommandProc in ::test_ns_basic} {}}
+    test basic-6.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {
+        catch {eval namespace delete [namespace children :: test_ns_*]}
+        catch {rename value:at: ""}
+        list [testcreatecommand create2] \
+             [value:at:] \
+             [testcreatecommand delete2]
+    } {{} {CreatedCommandProc2 in ::} {}}
+}
+test basic-6.3 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_basic {}
+    proc test_ns_basic::cmd {} {  ;# proc requires that ns already exist
+        return [namespace current]
+    }
+    list [test_ns_basic::cmd] \
+         [namespace delete test_ns_basic]
+} {::test_ns_basic {}}
+
+test basic-7.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename cmd ""}
+    namespace eval test_ns_basic {
+        proc p {} {
+            return "p in [namespace current]"
+        }
+    }
+    list [test_ns_basic::p] \
+         [rename test_ns_basic::p test_ns_basic::q] \
+         [test_ns_basic::q] 
+} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
+test basic-7.2 {TclRenameCommand, existing cmd must be found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
+} {1 {can't rename "test_ns_basic::p": command doesn't exist}}
+test basic-7.3 {TclRenameCommand, delete cmd if new name is empty} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_basic {
+        proc p {} {
+            return "p in [namespace current]"
+        }
+    }
+    list [info commands test_ns_basic::*] \
+         [rename test_ns_basic::p ""] \
+         [info commands test_ns_basic::*]
+} {::test_ns_basic::p {} {}}
+test basic-7.4 {TclRenameCommand, bad new name} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_basic {
+        proc p {} {
+            return "p in [namespace current]"
+        }
+    }
+    rename test_ns_basic::p :::george::martha
+} {}
+test basic-7.5 {TclRenameCommand, new name must not already exist} {
+    namespace eval test_ns_basic {
+        proc q {} {
+            return 42
+        }
+    }
+    list [catch {rename test_ns_basic::q :::george::martha} msg] $msg
+} {1 {can't rename to ":::george::martha": command already exists}}
+test basic-7.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    catch {rename q ""}
+    proc p {} {
+        return "p in [namespace current]"
+    }
+    proc q {} {
+        return "q in [namespace current]"
+    }
+    namespace eval test_ns_basic {
+        proc callP {} {
+            p
+        }
+    }
+    list [test_ns_basic::callP] \
+         [rename q test_ns_basic::p] \
+         [test_ns_basic::callP]
+} {{p in ::} {} {q in ::}}
+
+test basic-8.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    catch {rename q ""}
+    catch {unset x}
+    set x [namespace eval test_ns_basic::test_ns_basic2 {
+        # the following creates a cmd in the global namespace
+        testcmdtoken create p
+    }]
+    list [testcmdtoken name $x] \
+         [rename ::p q] \
+         [testcmdtoken name $x]
+} {{p ::p} {} {q ::q}}
+test basic-8.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {
+    catch {rename q ""}
+    set x [testcmdtoken create test_ns_basic::test_ns_basic2::p]
+    list [testcmdtoken name $x] \
+         [rename test_ns_basic::test_ns_basic2::p q] \
+         [testcmdtoken name $x]
+} {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
+
+test namespace-9.1 {Tcl_GetCommandFullName} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_basic1 {
+        namespace export cmd*
+        proc cmd1 {} {}
+        proc cmd2 {} {}
+    }
+    namespace eval test_ns_basic2 {
+        namespace export *
+        namespace import ::test_ns_basic1::*
+        proc p {} {}
+    }
+    namespace eval test_ns_basic3 {
+        namespace import ::test_ns_basic2::*
+        proc q {} {}
+        list [namespace which -command foreach] \
+             [namespace which -command q] \
+             [namespace which -command p] \
+             [namespace which -command cmd1] \
+             [namespace which -command ::test_ns_basic2::cmd2]
+    }
+} {::foreach ::test_ns_basic3::q ::test_ns_basic3::p ::test_ns_basic3::cmd1 ::test_ns_basic2::cmd2}
+
+test basic-10.1 {Tcl_DeleteCommand2, invalidate all compiled code if cmd has compile proc} {
+    catch {interp delete test_interp}
+    catch {unset x}
+    interp create test_interp
+    interp eval test_interp {
+        proc useSet {} {
+            return [set a 123]
+        }
+    }
+    set x [interp eval test_interp {useSet}]
+    interp eval test_interp {
+        rename set ""
+        proc set {args} {
+            return "set called with $args"
+        }
+    }
+    list $x \
+         [interp eval test_interp {useSet}] \
+         [interp delete test_interp]
+} {123 {set called with a 123} {}}
+test basic-10.2 {Tcl_DeleteCommand2, deleting commands changes command epoch} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    proc p {} {
+        return "global p"
+    }
+    namespace eval test_ns_basic {
+        proc p {} {
+            return "namespace p"
+        }
+        proc callP {} {
+            p
+        }
+    }
+    list [test_ns_basic::callP] \
+         [rename test_ns_basic::p ""] \
+         [test_ns_basic::callP]
+} {{namespace p} {} {global p}}
+test basic-10.3 {Tcl_DeleteCommand2, delete imported cmds that refer to a deleted cmd} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    namespace eval test_ns_basic {
+        namespace export p
+        proc p {} {return 42}
+    }
+    namespace eval test_ns_basic2 {
+        namespace import ::test_ns_basic::*
+        proc callP {} {
+            p
+        }
+    }
+    list [test_ns_basic2::callP] \
+         [info commands test_ns_basic2::*] \
+         [rename test_ns_basic::p ""] \
+         [catch {test_ns_basic2::callP} msg] $msg \
+         [info commands test_ns_basic2::*]
+} {42 {::test_ns_basic2::callP ::test_ns_basic2::p} {} 1 {invalid command name "p"} ::test_ns_basic2::callP}
+
+test basic-11.1 {TclObjInvoke, lookup of "unknown" command} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {interp delete test_interp}
+    interp create test_interp
+    interp eval test_interp {
+        proc unknown {args} {
+            return "global unknown"
+        }
+        namespace eval test_ns_basic {
+            proc unknown {args} {
+                return "namespace unknown"
+            }
+        }
+    }
+    list [interp alias test_interp newAlias test_interp doesntExist] \
+         [catch {interp eval test_interp {newAlias}} msg] $msg \
+         [interp delete test_interp]
+} {newAlias 0 {global unknown} {}}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {namespace delete george}
+catch {interp delete test_interp}
+catch {rename p ""}
+catch {rename q ""}
+catch {rename cmd ""}
+catch {rename value:at: ""}
+catch {unset x}
diff --git a/contrib/tcl/tests/binary.test b/contrib/tcl/tests/binary.test
new file mode 100644
index 0000000..13e1f8a
--- /dev/null
+++ b/contrib/tcl/tests/binary.test
@@ -0,0 +1,1374 @@
+# This file tests the tclBinary.c file and the "binary" Tcl command. 
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) binary.test 1.6 97/05/13 15:56:39
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
+    list [catch {binary} msg] $msg
+} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
+test binary-1.2 {Tcl_BinaryObjCmd: bad args} {
+    list [catch {binary foo} msg] $msg
+} {1 {bad option "foo": must be format, or scan}}
+
+test binary-1.3 {Tcl_BinaryObjCmd: format error} {
+    list [catch {binary f} msg] $msg
+} {1 {wrong # args: should be "binary f formatString ?arg arg ...?"}}
+test binary-1.4 {Tcl_BinaryObjCmd: format} {
+    binary format ""
+} {}
+
+
+
+test binary-2.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format a } msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-2.2 {Tcl_BinaryObjCmd: format} {
+    binary format a0 foo
+} {}
+test binary-2.3 {Tcl_BinaryObjCmd: format} {
+    binary format a f
+} {f}
+test binary-2.4 {Tcl_BinaryObjCmd: format} {
+    binary format a foo
+} {f}
+test binary-2.5 {Tcl_BinaryObjCmd: format} {
+    binary format a3 foo
+} {foo}
+test binary-2.6 {Tcl_BinaryObjCmd: format} {
+    binary format a5 foo
+} foo\x00\x00
+test binary-2.7 {Tcl_BinaryObjCmd: format} {
+    binary format a*a3 foobarbaz blat
+} foobarbazbla
+test binary-2.8 {Tcl_BinaryObjCmd: format} {
+    binary format a*X3a2 foobar x
+} foox\x00r
+
+test binary-3.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format A} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-3.2 {Tcl_BinaryObjCmd: format} {
+    binary format A0 f
+} {}
+test binary-3.3 {Tcl_BinaryObjCmd: format} {
+    binary format A f
+} {f}
+test binary-3.4 {Tcl_BinaryObjCmd: format} {
+    binary format A foo
+} {f}
+test binary-3.5 {Tcl_BinaryObjCmd: format} {
+    binary format A3 foo
+} {foo}
+test binary-3.6 {Tcl_BinaryObjCmd: format} {
+    binary format A5 foo
+} {foo  }
+test binary-3.7 {Tcl_BinaryObjCmd: format} {
+    binary format A*A3 foobarbaz blat
+} foobarbazbla
+test binary-3.8 {Tcl_BinaryObjCmd: format} {
+    binary format A*X3A2 foobar x
+} {foox r}
+
+test binary-4.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format B} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-4.2 {Tcl_BinaryObjCmd: format} {
+    binary format B0 1
+} {}
+test binary-4.3 {Tcl_BinaryObjCmd: format} {
+    binary format B 1
+} \x80
+test binary-4.4 {Tcl_BinaryObjCmd: format} {
+    binary format B* 010011
+} \x4c
+test binary-4.5 {Tcl_BinaryObjCmd: format} {
+    binary format B8 01001101
+} \x4d
+test binary-4.6 {Tcl_BinaryObjCmd: format} {
+    binary format A2X2B9 oo 01001101
+} \x4d\x00
+test binary-4.7 {Tcl_BinaryObjCmd: format} {
+    binary format B9 010011011010
+} \x4d\x80
+test binary-4.8 {Tcl_BinaryObjCmd: format} {
+    binary format B2B3 10 010
+} \x80\x40
+test binary-4.9 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format B1B5 1 foo} msg] $msg
+} {1 {expected binary string but got "foo" instead}}
+
+test binary-5.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format b} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-5.2 {Tcl_BinaryObjCmd: format} {
+    binary format b0 1
+} {}
+test binary-5.3 {Tcl_BinaryObjCmd: format} {
+    binary format b 1
+} \x01
+test binary-5.4 {Tcl_BinaryObjCmd: format} {
+    binary format b* 010011
+} 2
+test binary-5.5 {Tcl_BinaryObjCmd: format} {
+    binary format b8 01001101
+} \xb2
+test binary-5.6 {Tcl_BinaryObjCmd: format} {
+    binary format A2X2b9 oo 01001101
+} \xb2\x00
+test binary-5.7 {Tcl_BinaryObjCmd: format} {
+    binary format b9 010011011010
+} \xb2\x01
+test binary-5.8 {Tcl_BinaryObjCmd: format} {
+    binary format b17 1
+} \x01\00\00
+test binary-5.9 {Tcl_BinaryObjCmd: format} {
+    binary format b2b3 10 010
+} \x01\x02
+test binary-5.10 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format b1b5 1 foo} msg] $msg
+} {1 {expected binary string but got "foo" instead}}
+
+test binary-6.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format h} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-6.2 {Tcl_BinaryObjCmd: format} {
+    binary format h0 1
+} {}
+test binary-6.3 {Tcl_BinaryObjCmd: format} {
+    binary format h 1
+} \x01
+test binary-6.4 {Tcl_BinaryObjCmd: format} {
+    binary format h c
+} \x0c
+test binary-6.5 {Tcl_BinaryObjCmd: format} {
+    binary format h* baadf00d
+} \xab\xda\x0f\xd0
+test binary-6.6 {Tcl_BinaryObjCmd: format} {
+    binary format h4 c410
+} \x4c\x01
+test binary-6.7 {Tcl_BinaryObjCmd: format} {
+    binary format h6 c4102
+} \x4c\x01\x02
+test binary-6.8 {Tcl_BinaryObjCmd: format} {
+    binary format h5 c41020304
+} \x4c\x01\x02
+test binary-6.9 {Tcl_BinaryObjCmd: format} {
+    binary format a3X3h5 foo 2
+} \x02\x00\x00
+test binary-6.10 {Tcl_BinaryObjCmd: format} {
+    binary format h2h3 23 456
+} \x32\x54\x06
+test binary-6.11 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format h2 foo} msg] $msg
+} {1 {expected hexadecimal string but got "foo" instead}}
+
+test binary-7.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format H} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-7.2 {Tcl_BinaryObjCmd: format} {
+    binary format H0 1
+} {}
+test binary-7.3 {Tcl_BinaryObjCmd: format} {
+    binary format H 1
+} \x10
+test binary-7.4 {Tcl_BinaryObjCmd: format} {
+    binary format H c
+} \xc0
+test binary-7.5 {Tcl_BinaryObjCmd: format} {
+    binary format H* baadf00d
+} \xba\xad\xf0\x0d
+test binary-7.6 {Tcl_BinaryObjCmd: format} {
+    binary format H4 c410
+} \xc4\x10
+test binary-7.7 {Tcl_BinaryObjCmd: format} {
+    binary format H6 c4102
+} \xc4\x10\x20
+test binary-7.8 {Tcl_BinaryObjCmd: format} {
+    binary format H5 c41023304
+} \xc4\x10\x20
+test binary-7.9 {Tcl_BinaryObjCmd: format} {
+    binary format a3X3H5 foo 2
+} \x20\x00\x00
+test binary-7.10 {Tcl_BinaryObjCmd: format} {
+    binary format H2H3 23 456
+} \x23\x45\x60
+test binary-7.11 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format H2 foo} msg] $msg
+} {1 {expected hexadecimal string but got "foo" instead}}
+
+test binary-8.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format c} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-8.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format c blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-8.3 {Tcl_BinaryObjCmd: format} {
+    binary format c0 0x50
+} {}
+test binary-8.4 {Tcl_BinaryObjCmd: format} {
+    binary format c 0x50
+} P
+test binary-8.5 {Tcl_BinaryObjCmd: format} {
+    binary format c 0x5052
+} R
+test binary-8.6 {Tcl_BinaryObjCmd: format} {
+    binary format c2 {0x50 0x52}
+} PR
+test binary-8.7 {Tcl_BinaryObjCmd: format} {
+    binary format c2 {0x50 0x52 0x53}
+} PR
+test binary-8.8 {Tcl_BinaryObjCmd: format} {
+    binary format c* {0x50 0x52}
+} PR
+test binary-8.9 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format c2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-8.10 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    list [catch {binary format c $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-8.11 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    binary format c1 $a
+} P
+
+test binary-9.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format s} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-9.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format s blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-9.3 {Tcl_BinaryObjCmd: format} {
+    binary format s0 0x50
+} {}
+test binary-9.4 {Tcl_BinaryObjCmd: format} {
+    binary format s 0x50
+} P\x00
+test binary-9.5 {Tcl_BinaryObjCmd: format} {
+    binary format s 0x5052
+} RP
+test binary-9.6 {Tcl_BinaryObjCmd: format} {
+    binary format s 0x505251 0x53
+} QR
+test binary-9.7 {Tcl_BinaryObjCmd: format} {
+    binary format s2 {0x50 0x52}
+} P\x00R\x00
+test binary-9.8 {Tcl_BinaryObjCmd: format} {
+    binary format s* {0x5051 0x52}
+} QPR\x00
+test binary-9.9 {Tcl_BinaryObjCmd: format} {
+    binary format s2 {0x50 0x52 0x53} 0x54
+} P\x00R\x00
+test binary-9.10 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format s2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-9.11 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    list [catch {binary format s $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-9.12 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    binary format s1 $a
+} P\x00
+
+test binary-10.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format S} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-10.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format S blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-10.3 {Tcl_BinaryObjCmd: format} {
+    binary format S0 0x50
+} {}
+test binary-10.4 {Tcl_BinaryObjCmd: format} {
+    binary format S 0x50
+} \x00P
+test binary-10.5 {Tcl_BinaryObjCmd: format} {
+    binary format S 0x5052
+} PR
+test binary-10.6 {Tcl_BinaryObjCmd: format} {
+    binary format S 0x505251 0x53
+} RQ
+test binary-10.7 {Tcl_BinaryObjCmd: format} {
+    binary format S2 {0x50 0x52}
+} \x00P\x00R
+test binary-10.8 {Tcl_BinaryObjCmd: format} {
+    binary format S* {0x5051 0x52}
+} PQ\x00R
+test binary-10.9 {Tcl_BinaryObjCmd: format} {
+    binary format S2 {0x50 0x52 0x53} 0x54
+} \x00P\x00R
+test binary-10.10 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format S2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-10.11 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    list [catch {binary format S $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-10.12 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    binary format S1 $a
+} \x00P
+
+test binary-11.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format i} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-11.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format i blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-11.3 {Tcl_BinaryObjCmd: format} {
+    binary format i0 0x50
+} {}
+test binary-11.4 {Tcl_BinaryObjCmd: format} {
+    binary format i 0x50
+} P\x00\x00\x00
+test binary-11.5 {Tcl_BinaryObjCmd: format} {
+    binary format i 0x5052
+} RP\x00\x00
+test binary-11.6 {Tcl_BinaryObjCmd: format} {
+    binary format i 0x505251 0x53
+} QRP\x00
+test binary-11.7 {Tcl_BinaryObjCmd: format} {
+    binary format i1 {0x505251 0x53}
+} QRP\x00
+test binary-11.8 {Tcl_BinaryObjCmd: format} {
+    binary format i 0x53525150
+} PQRS
+test binary-11.9 {Tcl_BinaryObjCmd: format} {
+    binary format i2 {0x50 0x52}
+} P\x00\x00\x00R\x00\x00\x00
+test binary-11.10 {Tcl_BinaryObjCmd: format} {
+    binary format i* {0x50515253 0x52}
+} SRQPR\x00\x00\x00
+test binary-11.11 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format i2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-11.12 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    list [catch {binary format i $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-11.13 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    binary format i1 $a
+} P\x00\x00\x00
+
+test binary-12.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format I} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-12.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format I blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-12.3 {Tcl_BinaryObjCmd: format} {
+    binary format I0 0x50
+} {}
+test binary-12.4 {Tcl_BinaryObjCmd: format} {
+    binary format I 0x50
+} \x00\x00\x00P
+test binary-12.5 {Tcl_BinaryObjCmd: format} {
+    binary format I 0x5052
+} \x00\x00PR
+test binary-12.6 {Tcl_BinaryObjCmd: format} {
+    binary format I 0x505251 0x53
+} \x00PRQ
+test binary-12.7 {Tcl_BinaryObjCmd: format} {
+    binary format I1 {0x505251 0x53}
+} \x00PRQ
+test binary-12.8 {Tcl_BinaryObjCmd: format} {
+    binary format I 0x53525150
+} SRQP
+test binary-12.9 {Tcl_BinaryObjCmd: format} {
+    binary format I2 {0x50 0x52}
+} \x00\x00\x00P\x00\x00\x00R
+test binary-12.10 {Tcl_BinaryObjCmd: format} {
+    binary format I* {0x50515253 0x52}
+} PQRS\x00\x00\x00R
+test binary-12.11 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format i2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-12.12 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    list [catch {binary format I $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-12.13 {Tcl_BinaryObjCmd: format} {
+    set a {0x50 0x51}
+    binary format I1 $a
+} \x00\x00\x00P
+
+test binary-13.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format f} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-13.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format f blat} msg] $msg
+} {1 {expected floating-point number but got "blat"}}
+test binary-13.3 {Tcl_BinaryObjCmd: format} {
+    binary format f0 1.6
+} {}
+test binary-13.4 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format f 1.6
+} \x3f\xcc\xcc\xcd
+test binary-13.5 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format f 1.6
+} \xcd\xcc\xcc\x3f
+test binary-13.6 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format f* {1.6 3.4}
+} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
+test binary-13.7 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format f* {1.6 3.4}
+} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
+test binary-13.8 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format f2 {1.6 3.4}
+} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
+test binary-13.9 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format f2 {1.6 3.4}
+} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
+test binary-13.10 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format f2 {1.6 3.4 5.6}
+} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
+test binary-13.11 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format f2 {1.6 3.4 5.6}
+} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
+test binary-13.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable macOrUnix} {
+    binary format f -3.402825e+38
+} \x00\x80\x00\x00
+test binary-13.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable pcOnly} {
+    binary format f -3.402825e+38
+} \x00\x00\x80\x00
+test binary-13.14 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format f2 {1.6}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-13.15 {Tcl_BinaryObjCmd: format} {
+    set a {1.6 3.4}
+    list [catch {binary format f $a} msg] $msg
+} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+test binary-13.16 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    set a {1.6 3.4}
+    binary format f1 $a
+} \x3f\xcc\xcc\xcd
+test binary-13.17 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    set a {1.6 3.4}
+    binary format f1 $a
+} \xcd\xcc\xcc\x3f
+
+test binary-14.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format d} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-14.2 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format d blat} msg] $msg
+} {1 {expected floating-point number but got "blat"}}
+test binary-14.3 {Tcl_BinaryObjCmd: format} {
+    binary format d0 1.6
+} {}
+test binary-14.4 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format d 1.6
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a
+test binary-14.5 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format d 1.6
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f
+test binary-14.6 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format d* {1.6 3.4}
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
+test binary-14.7 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format d* {1.6 3.4}
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
+test binary-14.8 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format d2 {1.6 3.4}
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
+test binary-14.9 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format d2 {1.6 3.4}
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
+test binary-14.10 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    binary format d2 {1.6 3.4 5.6}
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
+test binary-14.11 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    binary format d2 {1.6 3.4 5.6}
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
+test binary-14.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable unixOnly} {
+    binary format d NaN
+} \x7f\xff\xff\xff\xff\xff\xff\xff
+test binary-14.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable macOnly} {
+    binary format d NaN
+} \x7f\xf8\x02\xa0\x00\x00\x00\x00
+test binary-14.14 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format d2 {1.6}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-14.15 {Tcl_BinaryObjCmd: format} {
+    set a {1.6 3.4}
+    list [catch {binary format d $a} msg] $msg
+} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+test binary-14.16 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    set a {1.6 3.4}
+    binary format d1 $a
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a
+test binary-14.17 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+    set a {1.6 3.4}
+    binary format d1 $a
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f
+
+test binary-15.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format ax*a "y" "z"} msg] $msg
+} {1 {cannot use "*" in format string with "x"}}
+test binary-15.2 {Tcl_BinaryObjCmd: format} {
+    binary format axa "y" "z"
+} y\x00z
+test binary-15.3 {Tcl_BinaryObjCmd: format} {
+    binary format ax3a "y" "z"
+} y\x00\x00\x00z
+test binary-15.4 {Tcl_BinaryObjCmd: format} {
+    binary format a*X3x3a* "foo" "z"
+} \x00\x00\x00z
+
+test binary-16.1 {Tcl_BinaryObjCmd: format} {
+    binary format a*X*a "foo" "z"
+} zoo
+test binary-16.2 {Tcl_BinaryObjCmd: format} {
+    binary format aX3a "y" "z"
+} z
+test binary-16.3 {Tcl_BinaryObjCmd: format} {
+    binary format a*Xa* "foo" "zy"
+} fozy
+test binary-16.4 {Tcl_BinaryObjCmd: format} {
+    binary format a*X3a "foobar" "z"
+} foozar
+test binary-16.5 {Tcl_BinaryObjCmd: format} {
+    binary format a*X3aX2a "foobar" "z" "b"
+} fobzar
+
+test binary-17.1 {Tcl_BinaryObjCmd: format} {
+    binary format @1
+} \x00
+test binary-17.2 {Tcl_BinaryObjCmd: format} {
+    binary format @5a2 "ab"
+} \x00\x00\x00\x00\x00\x61\x62
+test binary-17.3 {Tcl_BinaryObjCmd: format} {
+    binary format {a*  @0  a2 @* a*} "foobar" "ab" "blat"
+} abobarblat
+
+test binary-18.1 {Tcl_BinaryObjCmd: format} {
+    list [catch {binary format u0a3 abc abd} msg] $msg
+} {1 {bad field specifier "u"}}
+
+
+test binary-19.1 {Tcl_BinaryObjCmd: errors} {
+    list [catch {binary s} msg] $msg
+} {1 {wrong # args: should be "binary s value formatString ?varName varName ...?"}}
+test binary-19.2 {Tcl_BinaryObjCmd: errors} {
+    list [catch {binary scan foo} msg] $msg
+} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
+test binary-19.3 {Tcl_BinaryObjCmd: scan} {
+    binary scan {} {}
+} 0
+
+test binary-20.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc a} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-20.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan abc a arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-20.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 abc
+    list [binary scan abc a0 arg1] $arg1
+} {1 {}}
+test binary-20.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc a* arg1] $arg1
+} {1 abc}
+test binary-20.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc a5 arg1] [info exist arg1]
+} {0 0}
+test binary-20.6 {Tcl_BinaryObjCmd: scan} {
+    set arg1 foo
+    list [binary scan abc a2 arg1] $arg1
+} {1 ab}
+test binary-20.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
+} {2 ab cd}
+test binary-20.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc a2 arg1(a)] $arg1(a)
+} {1 ab}
+test binary-20.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc a arg1(a)] $arg1(a)
+} {1 a}
+
+test binary-21.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc A} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-21.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan abc A arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-21.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 abc
+    list [binary scan abc A0 arg1] $arg1
+} {1 {}}
+test binary-21.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc A* arg1] $arg1
+} {1 abc}
+test binary-21.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc A5 arg1] [info exist arg1]
+} {0 0}
+test binary-21.6 {Tcl_BinaryObjCmd: scan} {
+    set arg1 foo
+    list [binary scan abc A2 arg1] $arg1
+} {1 ab}
+test binary-21.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
+} {2 ab cd}
+test binary-21.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc A2 arg1(a)] $arg1(a)
+} {1 ab}
+test binary-21.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc A2 arg1(a)] $arg1(a)
+} {1 ab}
+test binary-21.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc A arg1(a)] $arg1(a)
+} {1 a}
+test binary-21.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan "abc def \x00  " A* arg1] $arg1
+} {1 {abc def}}
+test binary-21.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan "abc def \x00ghi  " A* arg1] $arg1
+} [list 1 "abc def \x00ghi"]
+
+test binary-22.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc b} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-22.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 b* arg1] $arg1
+} {1 0100101011001010}
+test binary-22.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 b arg1] $arg1
+} {1 0}
+test binary-22.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 b1 arg1] $arg1
+} {1 0}
+test binary-22.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 b0 arg1] $arg1
+} {1 {}}
+test binary-22.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 b5 arg1] $arg1
+} {1 01001}
+test binary-22.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 b8 arg1] $arg1
+} {1 01001010}
+test binary-22.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 b14 arg1] $arg1
+} {1 01001010110010}
+test binary-22.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 b14 arg1] $arg1
+} {0 foo}
+test binary-22.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 b1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-22.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
+} {2 11100 1110000110100000}
+
+
+test binary-23.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc B} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-23.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 B* arg1] $arg1
+} {1 0101001001010011}
+test binary-23.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 B arg1] $arg1
+} {1 1}
+test binary-23.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 B1 arg1] $arg1
+} {1 1}
+test binary-23.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 B0 arg1] $arg1
+} {1 {}}
+test binary-23.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 B5 arg1] $arg1
+} {1 01010}
+test binary-23.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 B8 arg1] $arg1
+} {1 01010010}
+test binary-23.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 B14 arg1] $arg1
+} {1 01010010010100}
+test binary-23.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 B14 arg1] $arg1
+} {0 foo}
+test binary-23.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 B1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-23.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
+} {2 01110 1000011100000101}
+
+test binary-24.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc h} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-24.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 h* arg1] $arg1
+} {1 253a}
+test binary-24.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xc2\xa3 h arg1] $arg1
+} {1 2}
+test binary-24.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 h1 arg1] $arg1
+} {1 2}
+test binary-24.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 h0 arg1] $arg1
+} {1 {}}
+test binary-24.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xf2\x53 h2 arg1] $arg1
+} {1 2f}
+test binary-24.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 h3 arg1] $arg1
+} {1 253}
+test binary-24.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 h3 arg1] $arg1
+} {0 foo}
+test binary-24.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 h1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-24.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
+} {2 07 7850}
+
+test binary-25.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc H} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-25.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 H* arg1] $arg1
+} {1 52a3}
+test binary-25.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xc2\xa3 H arg1] $arg1
+} {1 c}
+test binary-25.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x82\x53 H1 arg1] $arg1
+} {1 8}
+test binary-25.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 H0 arg1] $arg1
+} {1 {}}
+test binary-25.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xf2\x53 H2 arg1] $arg1
+} {1 f2}
+test binary-25.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\x53 H3 arg1] $arg1
+} {1 525}
+test binary-25.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 H3 arg1] $arg1
+} {0 foo}
+test binary-25.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 H1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-25.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
+} {2 70 8705}
+
+test binary-26.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc c} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-26.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c* arg1] $arg1
+} {1 {82 -93}}
+test binary-26.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c arg1] $arg1
+} {1 82}
+test binary-26.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c1 arg1] $arg1
+} {1 82}
+test binary-26.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c0 arg1] $arg1
+} {1 {}}
+test binary-26.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c2 arg1] $arg1
+} {1 {82 -93}}
+test binary-26.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xff c arg1] $arg1
+} {1 -1}
+test binary-26.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 c3 arg1] $arg1
+} {0 foo}
+test binary-26.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 c1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-26.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
+} {2 {112 -121} 5}
+
+test binary-27.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc s} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-27.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
+} {1 {-23726 21587}}
+test binary-27.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
+} {1 -23726}
+test binary-27.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 s1 arg1] $arg1
+} {1 -23726}
+test binary-27.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 s0 arg1] $arg1
+} {1 {}}
+test binary-27.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
+} {1 {-23726 21587}}
+test binary-27.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 s1 arg1] $arg1
+} {0 foo}
+test binary-27.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 s1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-27.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
+} {2 {-23726 21587} 5}
+
+test binary-28.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc S} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-28.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
+} {1 21155}
+test binary-28.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 S1 arg1] $arg1
+} {1 21155}
+test binary-28.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 S0 arg1] $arg1
+} {1 {}}
+test binary-28.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 S1 arg1] $arg1
+} {0 foo}
+test binary-28.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53 S1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-28.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
+} {2 {21155 21332} 5}
+
+test binary-29.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc i} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-29.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-29.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
+} {1 1414767442}
+test binary-29.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
+} {1 1414767442}
+test binary-29.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53 i0 arg1] $arg1
+} {1 {}}
+test binary-29.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-29.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 i1 arg1] $arg1
+} {0 foo}
+test binary-29.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53\x53\x54 i1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-29.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
+} {2 {1414767442 67305985} 5}
+
+test binary-30.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc I} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-30.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-30.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
+} {1 1386435412}
+test binary-30.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
+} {1 1386435412}
+test binary-30.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53 I0 arg1] $arg1
+} {1 {}}
+test binary-30.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-30.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 I1 arg1] $arg1
+} {0 foo}
+test binary-30.8 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x52\x53\x53\x54 I1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-30.9 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
+} {2 {1386435412 16909060} 5}
+
+test binary-31.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc f} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-31.2 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
+} {1 {1.6000000238418579 3.4000000953674316}}
+test binary-31.3 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
+} {1 {1.6000000238418579 3.4000000953674316}}
+test binary-31.4 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
+} {1 1.6000000238418579}
+test binary-31.5 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
+} {1 1.6000000238418579}
+test binary-31.6 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
+} {1 1.6000000238418579}
+test binary-31.7 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
+} {1 1.6000000238418579}
+test binary-31.8 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
+} {1 {}}
+test binary-31.9 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
+} {1 {}}
+test binary-31.10 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
+} {1 {1.6000000238418579 3.4000000953674316}}
+test binary-31.11 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
+} {1 {1.6000000238418579 3.4000000953674316}}
+test binary-31.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 f1 arg1] $arg1
+} {0 foo}
+test binary-31.13 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-31.14 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2
+} {2 {1.6000000238418579 3.4000000953674316} 5}
+test binary-31.15 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
+} {2 {1.6000000238418579 3.4000000953674316} 5}
+
+test binary-32.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abc d} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-32.2 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
+} {1 {1.6000000000000001 3.3999999999999999}}
+test binary-32.3 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1
+} {1 {1.6000000000000001 3.3999999999999999}}
+test binary-32.4 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1
+} {1 1.6000000000000001}
+test binary-32.5 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1
+} {1 1.6000000000000001}
+test binary-32.6 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
+} {1 1.6000000000000001}
+test binary-32.7 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
+} {1 1.6000000000000001}
+test binary-32.8 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
+} {1 {}}
+test binary-32.9 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
+} {1 {}}
+test binary-32.10 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
+} {1 {1.6000000000000001 3.3999999999999999}}
+test binary-32.11 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1
+} {1 {1.6000000000000001 3.3999999999999999}}
+test binary-32.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan \x52 d1 arg1] $arg1
+} {0 foo}
+test binary-32.13 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    set arg1 1
+    list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-32.14 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
+} {2 {1.6000000000000001 3.3999999999999999} 5}
+test binary-32.15 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2
+} {2 {1.6000000000000001 3.3999999999999999} 5}
+
+test binary-33.1 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
+} {2 ab def}
+test binary-33.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-33.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-33.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-33.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x1a1 arg1] $arg1
+} {1 b}
+test binary-33.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x5a1 arg1] $arg1
+} {1 f}
+test binary-33.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x0a1 arg1] $arg1
+} {1 a}
+
+test binary-34.1 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
+} {2 ab bcd}
+test binary-34.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
+} {2 abc abc}
+test binary-34.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
+} {2 abc abc}
+test binary-34.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abc X20a3 arg1] $arg1
+} {1 abc}
+test binary-34.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x*X1a1 arg1] $arg1
+} {1 f}
+test binary-34.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x*X5a1 arg1] $arg1
+} {1 b}
+test binary-34.7 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x3X0a1 arg1] $arg1
+} {1 d}
+
+test binary-35.1 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    list [catch {binary scan abcdefg a2@a3 arg1 arg2} msg] $msg
+} {1 {missing count for "@" field specifier}}
+test binary-35.2 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-35.3 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    catch {unset arg2}
+    set arg2 foo
+    list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-35.4 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef @2a3 arg1] $arg1
+} {1 cde}
+test binary-35.5 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x*@1a1 arg1] $arg1
+} {1 b}
+test binary-35.6 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan abcdef x*@0a1 arg1] $arg1
+} {1 a}
+
+test binary-36.1 {Tcl_BinaryObjCmd: scan} {
+    list [catch {binary scan abcdef u0a3} msg] $msg
+} {1 {bad field specifier "u"}}
+
+# GetFormatSpec is pretty thoroughly tested above, but there are a few
+# cases we should text explicitly
+
+test binary-37.1 {GetFormatSpec: whitespace} {
+    binary format "a3 a5     a3" foo barblat baz
+} foobarblbaz
+test binary-37.2 {GetFormatSpec: whitespace} {
+    binary format "      " foo
+} {}
+test binary-37.3 {GetFormatSpec: whitespace} {
+    binary format "     a3" foo
+} foo
+test binary-37.4 {GetFormatSpec: whitespace} {
+    binary format "" foo
+} {}
+test binary-37.5 {GetFormatSpec: whitespace} {
+    binary format "" foo
+} {}
+test binary-37.6 {GetFormatSpec: whitespace} {
+    binary format "     a3   " foo
+} foo
+test binary-37.7 {GetFormatSpec: numbers} {
+    list [catch {binary scan abcdef "x-1" foo} msg] $msg
+} {1 {bad field specifier "-"}}
+test binary-37.8 {GetFormatSpec: numbers} {
+    catch {unset arg1}
+    set arg1 foo
+    list [binary scan abcdef "a0x3" arg1] $arg1
+} {1 {}}
+
+# FormatNumber is thoroughly tested above, so we don't have any explicit tests
+
+test binary-38.1 {ScanNumber: sign extension} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c2 arg1] $arg1
+} {1 {82 -93}}
+test binary-38.2 {ScanNumber: sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
+} {1 {513 -32511 386 -32127}}
+test binary-38.3 {ScanNumber: sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
+} {1 {258 385 -32255 -32382}}
+test binary-38.4 {ScanNumber: sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
+} {1 {33620225 16843137 16876033 25297153 -2130640639}}
+test binary-38.5 {ScanNumber: sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
+} {1 {16843010 -2130640639 25297153 16876033 16843137}}
+
+test binary-39.1 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+    catch {unset arg1}
+    list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
+} {1 -NaN}
+test binary-39.2 {ScanNumber: floating point overflow} {nonPortable macOnly} {
+    catch {unset arg1}
+    list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
+} {1 -NAN(255)}
+test binary-39.3 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
+    catch {unset arg1}
+    set result [binary scan \xff\xff\xff\xff f1 arg1]
+    if {([string compare $arg1 -1.\#QNAN] == 0)
+	|| ([string compare $arg1 -NAN] == 0)} {
+	lappend result success
+    } else {
+	lappend result failure
+    }
+} {1 success}
+test binary-39.4 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+    catch {unset arg1}
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
+} {1 -NaN}
+test binary-39.5 {ScanNumber: floating point overflow} {nonPortable macOnly} {
+    catch {unset arg1}
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
+} {1 -NAN(255)}
+test binary-39.6 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
+    catch {unset arg1}
+    set result [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1]
+    if {([string compare $arg1 -1.\#QNAN] == 0)
+	|| ([string compare $arg1 -NAN] == 0)} {
+	lappend result success
+    } else {
+	lappend result failure
+    }
+} {1 success}
diff --git a/contrib/tcl/tests/clock.test b/contrib/tcl/tests/clock.test
index cf8d94b..b75ee32 100644
--- a/contrib/tcl/tests/clock.test
+++ b/contrib/tcl/tests/clock.test
@@ -4,12 +4,12 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) clock.test 1.6 96/07/23 16:16:43
+# SCCS: @(#) clock.test 1.14 97/06/02 10:18:12
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -18,7 +18,7 @@ test clock-1.1 {clock tests} {
 } {1 {wrong # args: should be "clock option ?arg ...?"}}
 test clock-1.2 {clock tests} {
     list [catch {clock foo} msg] $msg
-} {1 {unknown option "foo": must be clicks, format, scan, or seconds}}
+} {1 {bad option "foo": must be clicks, format, scan, or seconds}}
 
 # clock clicks
 test clock-2.1 {clock clicks tests} {
@@ -27,7 +27,7 @@ test clock-2.1 {clock clicks tests} {
 } {}
 test clock-2.2 {clock clicks tests} {
     list [catch {clock clicks foo} msg] $msg
-} {1 {wrong # arguments: must be "clock clicks"}}
+} {1 {wrong # args: should be "clock clicks"}}
 test clock-2.3 {clock clicks tests} {
     set start [clock clicks]
     after 10
@@ -42,26 +42,35 @@ test clock-3.1 {clock format tests} {unixOnly} {
 } {Sun Nov 04 03:02:46 AM 1990}
 test clock-3.2 {clock format tests} {
     list [catch {clock format} msg] $msg
-} {1 {wrong # args: clock format clockval ?-format string? ?-gmt boolean?}}
+} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean?"}}
 test clock-3.3 {clock format tests} {
     list [catch {clock format foo} msg] $msg
-} {1 {expected unsigned time but got "foo"}}
+} {1 {expected integer but got "foo"}}
 test clock-3.4 {clock format tests} {unixOrPc} {
     set clockval 657687766
     clock format $clockval -format "%a %b %d %I:%M:%S %p %Y" -gmt true
 } "Sun Nov 04 03:02:46 AM 1990"
 test clock-3.5 {clock format tests} {
     list [catch {clock format a b c d e g} msg] $msg
-} {1 {wrong # args: clock format clockval ?-format string? ?-gmt boolean?}}
-test clock-3.6 {clock format tests} {unixOrPc} {
+} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean?"}}
+test clock-3.6 {clock format tests} {unixOrPc nonPortable} {
     set clockval -1
     clock format $clockval -format "%a %b %d %I:%M:%S %p %Y" -gmt true
 } "Wed Dec 31 11:59:59 PM 1969"
+test clock-3.7 {clock format tests} {
+    list [catch {clock format 123 -bad arg} msg] $msg
+} {1 {bad switch "-bad": must be -format, or -gmt}}
+test clock-3.8 {clock format tests} {
+    clock format 123 -format "x"
+} x
+test clock-3.9 {clock format tests} {
+    clock format 123 -format ""
+} ""
 
 # clock scan
 test clock-4.1 {clock scan tests} {
     list [catch {clock scan} msg] $msg
-} {1 {wrong # args: clock scan dateString ?-base clockValue? ?-gmt boolean?}}
+} {1 {wrong # args: should be "clock scan dateString ?-base clockValue? ?-gmt boolean?"}}
 test clock-4.2 {clock scan tests} {
     list [catch {clock scan "bad-string"} msg] $msg
 } {1 {unable to convert date-time string "bad-string"}}
@@ -90,6 +99,18 @@ test clock-4.8 {clock scan tests} {
     set time [clock scan "Oct 23,1992 15:00" -gmt true]
     clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
 } {Oct 23,1992 15:00 GMT}
+test clock-4.9 {clock scan tests} {
+    list [catch {clock scan "Jan 12" -bad arg} msg] $msg
+} {1 {bad switch "-bad": must be -base, or -gmt}}
+# The following two two tests test the two year date policy
+test clock-4.10 {clock scan tests} {
+    set time [clock scan "1/1/71" -gmt true]
+    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Jan 01,1971 00:00 GMT}
+test clock-4.11 {clock scan tests} {
+    set time [clock scan "1/1/37" -gmt true]
+    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Jan 01,2037 00:00 GMT}
 
 # clock seconds
 test clock-5.1 {clock seconds tests} {
@@ -98,7 +119,7 @@ test clock-5.1 {clock seconds tests} {
 } {}
 test clock-5.2 {clock seconds tests} {
     list [catch {clock seconds foo} msg] $msg
-} {1 {wrong # arguments: must be "clock seconds"}}
+} {1 {wrong # args: should be "clock seconds"}}
 test clock-5.3 {clock seconds tests} {
     set start [clock seconds]
     after 2000
@@ -106,3 +127,21 @@ test clock-5.3 {clock seconds tests} {
     expr "$end > $start"
 } {1}
 
+# The following dates check certain roll over dates
+set day [expr 24 * 60 * 60]
+test clock-6.1 {clock roll over dates} {
+    set time [clock scan "12/31/1998" -gmt true]
+    clock format [expr $time + $day] -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Jan 01,1999 00:00 GMT}
+test clock-6.2 {clock roll over dates} {
+    set time [clock scan "12/31/1999" -gmt true]
+    clock format [expr $time + $day] -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Jan 01,2000 00:00 GMT}
+test clock-6.3 {clock roll over dates} {
+    set time [clock scan "2/28/2000" -gmt true]
+    clock format [expr $time + $day] -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Feb 29,2000 00:00 GMT}
+test clock-6.4 {clock roll over dates} {
+    set time [clock scan "2/29/2000" -gmt true]
+    clock format [expr $time + $day] -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Mar 01,2000 00:00 GMT}
diff --git a/contrib/tcl/tests/cmdAH.test b/contrib/tcl/tests/cmdAH.test
index 97c5bdd..cbf3ae7 100644
--- a/contrib/tcl/tests/cmdAH.test
+++ b/contrib/tcl/tests/cmdAH.test
@@ -4,196 +4,230 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1996 by Sun Microsystems, Inc.
+# Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) cmdAH.test 1.9 96/07/01 14:38:19
+# SCCS: @(#) cmdAH.test 1.30 97/06/23 18:17:47
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
 global env
 set platform [testgetplatform]
 
-test cmdah-1.1 {Tcl_FileCmd} {
+test cmdAH-1.1 {Tcl_FileObjCmd} {
     list [catch file msg] $msg
-} {1 {wrong # args: should be "file option name ?arg ...?"}}
-test cmdah-1.2 {Tcl_FileCmd} {
+} {1 {wrong # args: should be "file option ?arg ...?"}}
+test cmdAH-1.2 {Tcl_FileObjCmd} {
     list [catch {file x} msg] $msg
-} {1 {wrong # args: should be "file option name ?arg ...?"}}
+} {1 {bad option "x": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-1.3 {Tcl_FileObjCmd} {
+    list [catch {file atime} msg] $msg
+} {1 {wrong # args: should be "file atime name ?arg ...?"}}
+
+
+#volume
+
+test cmdAH-2.1 {Tcl_FileObjCmd: volumes} {
+    list [catch {file volumes x} msg] $msg	
+} {1 {wrong # args: should be "file volumes"}}
+test cmdAH-2.2 {Tcl_FileObjCmd: volumes} {
+	set volumeList [file volumes]
+	if { [llength $volumeList] == 0 } {
+		set result 0
+	} else {
+		set result 1
+	}	
+} {1}
+test cmdAH-2.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {
+    set volumeList [file volumes]
+    catch [list glob -nocomplain [lindex $volumeList 0]*]
+} {0}
+test cmdAH-2.4 {Tcl_FileObjCmd: volumes} {pcOnly} {
+    set volumeList [file volumes]
+    list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
+} {0 1 0}
+
+# attributes
+
+test cmdAH-3.1 {Tcl_FileObjCmd - file attrs} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file}] [file delete -force foo.file]
+} {0 {}}
 
 # dirname
 
-test cmdah-2.1 {Tcl_FileCmd: dirname} {
+test cmdAH-4.1 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname a b} msg] $msg
 } {1 {wrong # args: should be "file dirname name"}}
-test cmdah-2.2 {Tcl_FileCmd: dirname} {
+test cmdAH-4.2 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     file dirname /a/b
 } /a
-test cmdah-2.3 {Tcl_FileCmd: dirname} {
+test cmdAH-4.3 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     file dirname {}
 } .
-test cmdah-2.4 {Tcl_FileCmd: dirname} {
+test cmdAH-4.4 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     file dirname {}
 } :
-test cmdah-2.5 {Tcl_FileCmd: dirname} {
+test cmdAH-4.5 {Tcl_FileObjCmd: dirname} {
     testsetplatform win
     file dirname {}
 } .
-test cmdah-2.6 {Tcl_FileCmd: dirname} {
+test cmdAH-4.6 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     file dirname .def
 } .
-test cmdah-2.7 {Tcl_FileCmd: dirname} {
+test cmdAH-4.7 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     file dirname a
 } :
-test cmdah-2.8 {Tcl_FileCmd: dirname} {
+test cmdAH-4.8 {Tcl_FileObjCmd: dirname} {
     testsetplatform win
     file dirname a
 } .
-test cmdah-2.9 {Tcl_FileCmd: dirname} {
+test cmdAH-4.9 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
-    file d a/b/c.d
+    file dirname a/b/c.d
 } a/b
-test cmdah-2.10 {Tcl_FileCmd: dirname} {
+test cmdAH-4.10 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     file dirname a/b.c/d
 } a/b.c
-test cmdah-2.11 {Tcl_FileCmd: dirname} {
+test cmdAH-4.11 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     file dirname /.
 } /
-test cmdah-2.12 {Tcl_FileCmd: dirname} {
+test cmdAH-4.12 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname /} msg] $msg
 } {0 /}
-test cmdah-2.13 {Tcl_FileCmd: dirname} {
+test cmdAH-4.13 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname /foo} msg] $msg
 } {0 /}
-test cmdah-2.14 {Tcl_FileCmd: dirname} {
+test cmdAH-4.14 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname //foo} msg] $msg
 } {0 /}
-test cmdah-2.15 {Tcl_FileCmd: dirname} {
+test cmdAH-4.15 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname //foo/bar} msg] $msg
 } {0 /foo}
-test cmdah-2.16 {Tcl_FileCmd: dirname} {
+test cmdAH-4.16 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname {//foo\/bar/baz}} msg] $msg
 } {0 {/foo\/bar}}
-test cmdah-2.17 {Tcl_FileCmd: dirname} {
+test cmdAH-4.17 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
 } {0 {/foo\/bar/baz}}
-test cmdah-2.18 {Tcl_FileCmd: dirname} {
+test cmdAH-4.18 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname /foo//} msg] $msg
 } {0 /}
-test cmdah-2.19 {Tcl_FileCmd: dirname} {
+test cmdAH-4.19 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname ./a} msg] $msg
 } {0 .}
-test cmdah-2.20 {Tcl_FileCmd: dirname} {
+test cmdAH-4.20 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname a/.a} msg] $msg
 } {0 a}
-test cmdah-2.21 {Tcl_FileCmd: dirname} {
+test cmdAH-4.21 {Tcl_FileObjCmd: dirname} {
     testsetplatform windows
     list [catch {file dirname c:foo} msg] $msg
 } {0 c:}
-test cmdah-2.22 {Tcl_FileCmd: dirname} {
+test cmdAH-4.22 {Tcl_FileObjCmd: dirname} {
     testsetplatform windows
     list [catch {file dirname c:} msg] $msg
 } {0 c:}
-test cmdah-2.23 {Tcl_FileCmd: dirname} {
+test cmdAH-4.23 {Tcl_FileObjCmd: dirname} {
     testsetplatform windows
     list [catch {file dirname c:/} msg] $msg
 } {0 c:/}
-test cmdah-2.24 {Tcl_FileCmd: dirname} {
+test cmdAH-4.24 {Tcl_FileObjCmd: dirname} {
     testsetplatform windows
     list [catch {file dirname {c:\foo}} msg] $msg
 } {0 c:/}
-test cmdah-2.25 {Tcl_FileCmd: dirname} {
+test cmdAH-4.25 {Tcl_FileObjCmd: dirname} {
     testsetplatform windows
     list [catch {file dirname {//foo/bar/baz}} msg] $msg
 } {0 //foo/bar}
-test cmdah-2.26 {Tcl_FileCmd: dirname} {
+test cmdAH-4.26 {Tcl_FileObjCmd: dirname} {
     testsetplatform windows
     list [catch {file dirname {//foo/bar}} msg] $msg
 } {0 //foo/bar}
-test cmdah-2.27 {Tcl_FileCmd: dirname} {
+test cmdAH-4.27 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname :} msg] $msg
 } {0 :}
-test cmdah-2.28 {Tcl_FileCmd: dirname} {
+test cmdAH-4.28 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname :Foo} msg] $msg
 } {0 :}
-test cmdah-2.29 {Tcl_FileCmd: dirname} {
+test cmdAH-4.29 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname Foo:} msg] $msg
 } {0 Foo:}
-test cmdah-2.30 {Tcl_FileCmd: dirname} {
+test cmdAH-4.30 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname Foo:bar} msg] $msg
 } {0 Foo:}
-test cmdah-2.31 {Tcl_FileCmd: dirname} {
+test cmdAH-4.31 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname :Foo:bar} msg] $msg
 } {0 :Foo}
-test cmdah-2.32 {Tcl_FileCmd: dirname} {
+test cmdAH-4.32 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname ::} msg] $msg
 } {0 :}
-test cmdah-2.33 {Tcl_FileCmd: dirname} {
+test cmdAH-4.33 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname :::} msg] $msg
 } {0 ::}
-test cmdah-2.34 {Tcl_FileCmd: dirname} {
+test cmdAH-4.34 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname /foo/bar/} msg] $msg
 } {0 foo:}
-test cmdah-2.35 {Tcl_FileCmd: dirname} {
+test cmdAH-4.35 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname /foo/bar} msg] $msg
 } {0 foo:}
-test cmdah-2.36 {Tcl_FileCmd: dirname} {
+test cmdAH-4.36 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname /foo} msg] $msg
 } {0 foo:}
-test cmdah-2.37 {Tcl_FileCmd: dirname} {
+test cmdAH-4.37 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname foo} msg] $msg
 } {0 :}
-test cmdah-2.38 {Tcl_FileCmd: dirname} {
+test cmdAH-4.38 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname ~/foo} msg] $msg
 } {0 ~}
-test cmdah-2.39 {Tcl_FileCmd: dirname} {
+test cmdAH-4.39 {Tcl_FileObjCmd: dirname} {
     testsetplatform unix
     list [catch {file dirname ~bar/foo} msg] $msg
 } {0 ~bar}
-test cmdah-2.40 {Tcl_FileCmd: dirname} {
+test cmdAH-4.40 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname ~bar/foo} msg] $msg
 } {0 ~bar:}
-test cmdah-2.41 {Tcl_FileCmd: dirname} {
+test cmdAH-4.41 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname ~/foo} msg] $msg
 } {0 ~:}
-test cmdah-2.42 {Tcl_FileCmd: dirname} {
+test cmdAH-4.42 {Tcl_FileObjCmd: dirname} {
     testsetplatform mac
     list [catch {file dirname ~:baz} msg] $msg
 } {0 ~:}
-test cmdah-2.43 {Tcl_FileCmd: dirname} {
+test cmdAH-4.43 {Tcl_FileObjCmd: dirname} {
     global env
     set temp $env(HOME)
     set env(HOME) "/home/test"
@@ -202,7 +236,7 @@ test cmdah-2.43 {Tcl_FileCmd: dirname} {
     set env(HOME) $temp
     set result
 } {0 /home}
-test cmdah-2.44 {Tcl_FileCmd: dirname} {
+test cmdAH-4.44 {Tcl_FileObjCmd: dirname} {
     global env
     set temp $env(HOME)
     set env(HOME) "~"
@@ -211,7 +245,7 @@ test cmdah-2.44 {Tcl_FileCmd: dirname} {
     set env(HOME) $temp
     set result
 } {0 ~}
-test cmdah-2.45 {Tcl_FileCmd: dirname} {
+test cmdAH-4.45 {Tcl_FileObjCmd: dirname} {
     global env
     set temp $env(HOME)
     set env(HOME) "/home/test"
@@ -220,7 +254,7 @@ test cmdah-2.45 {Tcl_FileCmd: dirname} {
     set env(HOME) $temp
     set result
 } {0 /home}
-test cmdah-2.46 {Tcl_FileCmd: dirname} {
+test cmdAH-4.46 {Tcl_FileObjCmd: dirname} {
     global env
     set temp $env(HOME)
     set env(HOME) "/home/test"
@@ -232,171 +266,171 @@ test cmdah-2.46 {Tcl_FileCmd: dirname} {
 
 # tail
 
-test cmdah-3.1 {Tcl_FileCmd: tail} {
+test cmdAH-5.1 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     list [catch {file tail a b} msg] $msg
 } {1 {wrong # args: should be "file tail name"}}
-test cmdah-3.2 {Tcl_FileCmd: tail} {
+test cmdAH-5.2 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail /a/b
 } b
-test cmdah-3.3 {Tcl_FileCmd: tail} {
+test cmdAH-5.3 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail {}
 } {}
-test cmdah-3.4 {Tcl_FileCmd: tail} {
+test cmdAH-5.4 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail {}
 } {}
-test cmdah-3.5 {Tcl_FileCmd: tail} {
+test cmdAH-5.5 {Tcl_FileObjCmd: tail} {
     testsetplatform win
     file tail {}
 } {}
-test cmdah-3.6 {Tcl_FileCmd: tail} {
+test cmdAH-5.6 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail .def
 } .def
-test cmdah-3.7 {Tcl_FileCmd: tail} {
+test cmdAH-5.7 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail a
 } a
-test cmdah-3.8 {Tcl_FileCmd: tail} {
+test cmdAH-5.8 {Tcl_FileObjCmd: tail} {
     testsetplatform win
     file tail a
 } a
-test cmdah-3.9 {Tcl_FileCmd: tail} {
+test cmdAH-5.9 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file ta a/b/c.d
 } c.d
-test cmdah-3.10 {Tcl_FileCmd: tail} {
+test cmdAH-5.10 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail a/b.c/d
 } d
-test cmdah-3.11 {Tcl_FileCmd: tail} {
+test cmdAH-5.11 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail /.
 } .
-test cmdah-3.12 {Tcl_FileCmd: tail} {
+test cmdAH-5.12 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail /
 } {}
-test cmdah-3.13 {Tcl_FileCmd: tail} {
+test cmdAH-5.13 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail /foo
 } foo
-test cmdah-3.14 {Tcl_FileCmd: tail} {
+test cmdAH-5.14 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail //foo
 } foo
-test cmdah-3.15 {Tcl_FileCmd: tail} {
+test cmdAH-5.15 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail //foo/bar
 } bar
-test cmdah-3.16 {Tcl_FileCmd: tail} {
+test cmdAH-5.16 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail {//foo\/bar/baz}
 } baz
-test cmdah-3.17 {Tcl_FileCmd: tail} {
+test cmdAH-5.17 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail {//foo\/bar/baz/blat}
 } blat
-test cmdah-3.18 {Tcl_FileCmd: tail} {
+test cmdAH-5.18 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail /foo//
 } foo
-test cmdah-3.19 {Tcl_FileCmd: tail} {
+test cmdAH-5.19 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail ./a
 } a
-test cmdah-3.20 {Tcl_FileCmd: tail} {
+test cmdAH-5.20 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail a/.a
 } .a
-test cmdah-3.21 {Tcl_FileCmd: tail} {
+test cmdAH-5.21 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail c:foo
 } foo
-test cmdah-3.22 {Tcl_FileCmd: tail} {
+test cmdAH-5.22 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail c:
 } {}
-test cmdah-3.23 {Tcl_FileCmd: tail} {
+test cmdAH-5.23 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail c:/
 } {}
-test cmdah-3.24 {Tcl_FileCmd: tail} {
+test cmdAH-5.24 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail {c:\foo}
 } foo
-test cmdah-3.25 {Tcl_FileCmd: tail} {
+test cmdAH-5.25 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail {//foo/bar/baz}
 } baz
-test cmdah-3.26 {Tcl_FileCmd: tail} {
+test cmdAH-5.26 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail {//foo/bar}
 } {}
-test cmdah-3.27 {Tcl_FileCmd: tail} {
+test cmdAH-5.27 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail :
 } :
-test cmdah-3.28 {Tcl_FileCmd: tail} {
+test cmdAH-5.28 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail :Foo
 } Foo
-test cmdah-3.29 {Tcl_FileCmd: tail} {
+test cmdAH-5.29 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail Foo:
 } {}
-test cmdah-3.30 {Tcl_FileCmd: tail} {
+test cmdAH-5.30 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail Foo:bar
 } bar
-test cmdah-3.31 {Tcl_FileCmd: tail} {
+test cmdAH-5.31 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail :Foo:bar
 } bar
-test cmdah-3.32 {Tcl_FileCmd: tail} {
+test cmdAH-5.32 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail ::
 } ::
-test cmdah-3.33 {Tcl_FileCmd: tail} {
+test cmdAH-5.33 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail :::
 } ::
-test cmdah-3.34 {Tcl_FileCmd: tail} {
+test cmdAH-5.34 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail /foo/bar/
 } bar
-test cmdah-3.35 {Tcl_FileCmd: tail} {
+test cmdAH-5.35 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail /foo/bar
 } bar
-test cmdah-3.36 {Tcl_FileCmd: tail} {
+test cmdAH-5.36 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail /foo
 } {}
-test cmdah-3.37 {Tcl_FileCmd: tail} {
+test cmdAH-5.37 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail foo
 } foo
-test cmdah-3.38 {Tcl_FileCmd: tail} {
+test cmdAH-5.38 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail ~:foo
 } foo
-test cmdah-3.39 {Tcl_FileCmd: tail} {
+test cmdAH-5.39 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail ~bar:foo
 } foo
-test cmdah-3.40 {Tcl_FileCmd: tail} {
+test cmdAH-5.40 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail ~bar/foo
 } foo
-test cmdah-3.41 {Tcl_FileCmd: tail} {
+test cmdAH-5.41 {Tcl_FileObjCmd: tail} {
     testsetplatform mac
     file tail ~/foo
 } foo
-test cmdah-3.42 {Tcl_FileCmd: tail} {
+test cmdAH-5.42 {Tcl_FileObjCmd: tail} {
     global env
     set temp $env(HOME)
     set env(HOME) "/home/test"
@@ -405,7 +439,7 @@ test cmdah-3.42 {Tcl_FileCmd: tail} {
     set env(HOME) $temp
     set result
 } test
-test cmdah-3.43 {Tcl_FileCmd: tail} {
+test cmdAH-5.43 {Tcl_FileObjCmd: tail} {
     global env
     set temp $env(HOME)
     set env(HOME) "~"
@@ -414,7 +448,7 @@ test cmdah-3.43 {Tcl_FileCmd: tail} {
     set env(HOME) $temp
     set result
 } {}
-test cmdah-3.44 {Tcl_FileCmd: tail} {
+test cmdAH-5.44 {Tcl_FileObjCmd: tail} {
     global env
     set temp $env(HOME)
     set env(HOME) "/home/test"
@@ -423,7 +457,7 @@ test cmdah-3.44 {Tcl_FileCmd: tail} {
     set env(HOME) $temp
     set result
 } test
-test cmdah-3.45 {Tcl_FileCmd: tail} {
+test cmdAH-5.45 {Tcl_FileObjCmd: tail} {
     global env
     set temp $env(HOME)
     set env(HOME) "/home/test"
@@ -432,166 +466,166 @@ test cmdah-3.45 {Tcl_FileCmd: tail} {
     set env(HOME) $temp
     set result
 } test
-test cmdah-3.46 {Tcl_FileCmd: tail} {
+test cmdAH-5.46 {Tcl_FileObjCmd: tail} {
     testsetplatform unix
     file tail {f.oo\bar/baz.bat}
 } baz.bat
-test cmdah-3.47 {Tcl_FileCmd: tail} {
+test cmdAH-5.47 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail c:foo
 } foo
-test cmdah-3.48 {Tcl_FileCmd: tail} {
+test cmdAH-5.48 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail c:
 } {}
-test cmdah-3.49 {Tcl_FileCmd: tail} {
+test cmdAH-5.49 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail c:/foo
 } foo
-test cmdah-3.50 {Tcl_FileCmd: tail} {
+test cmdAH-5.50 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail {c:/foo\bar}
 } bar
-test cmdah-3.51 {Tcl_FileCmd: tail} {
+test cmdAH-5.51 {Tcl_FileObjCmd: tail} {
     testsetplatform windows
     file tail {foo\bar}
 } bar
 
 # rootname
 
-test cmdah-4.1 {Tcl_FileCmd: rootname} {
+test cmdAH-6.1 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     list [catch {file rootname a b} msg] $msg
 } {1 {wrong # args: should be "file rootname name"}}
-test cmdah-4.2 {Tcl_FileCmd: rootname} {
+test cmdAH-6.2 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname {}
 } {}
-test cmdah-4.3 {Tcl_FileCmd: rootname} {
+test cmdAH-6.3 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file ro foo
 } foo
-test cmdah-4.4 {Tcl_FileCmd: rootname} {
+test cmdAH-6.4 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname foo.
 } foo
-test cmdah-4.5 {Tcl_FileCmd: rootname} {
+test cmdAH-6.5 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname .foo
 } {}
-test cmdah-4.6 {Tcl_FileCmd: rootname} {
+test cmdAH-6.6 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname abc.def
 } abc
-test cmdah-4.7 {Tcl_FileCmd: rootname} {
+test cmdAH-6.7 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname abc.def.ghi
 } abc.def
-test cmdah-4.8 {Tcl_FileCmd: rootname} {
+test cmdAH-6.8 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname a/b/c.d
 } a/b/c
-test cmdah-4.9 {Tcl_FileCmd: rootname} {
+test cmdAH-6.9 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname a/b.c/d
 } a/b.c/d
-test cmdah-4.10 {Tcl_FileCmd: rootname} {
+test cmdAH-6.10 {Tcl_FileObjCmd: rootname} {
     testsetplatform unix
     file rootname a/b.c/
 } a/b.c/
-test cmdah-4.11 {Tcl_FileCmd: rootname} {
+test cmdAH-6.11 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file ro foo
 } foo
-test cmdah-4.12 {Tcl_FileCmd: rootname} {
+test cmdAH-6.12 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname {}
 } {}
-test cmdah-4.13 {Tcl_FileCmd: rootname} {
+test cmdAH-6.13 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname foo.
 } foo
-test cmdah-4.14 {Tcl_FileCmd: rootname} {
+test cmdAH-6.14 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname .foo
 } {}
-test cmdah-4.15 {Tcl_FileCmd: rootname} {
+test cmdAH-6.15 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname abc.def
 } abc
-test cmdah-4.16 {Tcl_FileCmd: rootname} {
+test cmdAH-6.16 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname abc.def.ghi
 } abc.def
-test cmdah-4.17 {Tcl_FileCmd: rootname} {
+test cmdAH-6.17 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname a:b:c.d
 } a:b:c
-test cmdah-4.18 {Tcl_FileCmd: rootname} {
+test cmdAH-6.18 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname a:b.c:d
 } a:b.c:d
-test cmdah-4.19 {Tcl_FileCmd: rootname} {
+test cmdAH-6.19 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname a/b/c.d
 } a/b/c
-test cmdah-4.20 {Tcl_FileCmd: rootname} {
+test cmdAH-6.20 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname a/b.c/d
 } a/b.c/d
-test cmdah-4.21 {Tcl_FileCmd: rootname} {
+test cmdAH-6.21 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname /a.b
 } /a
-test cmdah-4.22 {Tcl_FileCmd: rootname} {
+test cmdAH-6.22 {Tcl_FileObjCmd: rootname} {
     testsetplatform mac
     file rootname foo.c:
 } foo.c:
-test cmdah-4.23 {Tcl_FileCmd: rootname} {
+test cmdAH-6.23 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname {}
 } {}
-test cmdah-4.24 {Tcl_FileCmd: rootname} {
+test cmdAH-6.24 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file ro foo
 } foo
-test cmdah-4.25 {Tcl_FileCmd: rootname} {
+test cmdAH-6.25 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname foo.
 } foo
-test cmdah-4.26 {Tcl_FileCmd: rootname} {
+test cmdAH-6.26 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname .foo
 } {}
-test cmdah-4.27 {Tcl_FileCmd: rootname} {
+test cmdAH-6.27 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname abc.def
 } abc
-test cmdah-4.28 {Tcl_FileCmd: rootname} {
+test cmdAH-6.28 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname abc.def.ghi
 } abc.def
-test cmdah-4.29 {Tcl_FileCmd: rootname} {
+test cmdAH-6.29 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname a/b/c.d
 } a/b/c
-test cmdah-4.30 {Tcl_FileCmd: rootname} {
+test cmdAH-6.30 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname a/b.c/d
 } a/b.c/d
-test cmdah-4.31 {Tcl_FileCmd: rootname} {
+test cmdAH-6.31 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname a\\b.c\\
 } a\\b.c\\
-test cmdah-4.32 {Tcl_FileCmd: rootname} {
+test cmdAH-6.32 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname a\\b\\c.d
 } a\\b\\c
-test cmdah-4.33 {Tcl_FileCmd: rootname} {
+test cmdAH-6.33 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname a\\b.c\\d
 } a\\b.c\\d
-test cmdah-4.34 {Tcl_FileCmd: rootname} {
+test cmdAH-6.34 {Tcl_FileObjCmd: rootname} {
     testsetplatform windows
     file rootname a\\b.c\\
 } a\\b.c\\
@@ -599,7 +633,7 @@ set num 35
 foreach outer { {} a .a a. a.a } {
   foreach inner { {} a .a a. a.a } {
     set thing [format %s/%s $outer $inner]
-    test cmdah-4.$num {Tcl_FileCmd: rootname and extension options} {
+;   test cmdAH-6.$num {Tcl_FileObjCmd: rootname and extension options} {
 	testsetplatform unix
 	format %s%s [file rootname $thing] [file ext $thing]
     } $thing
@@ -609,199 +643,210 @@ foreach outer { {} a .a a. a.a } {
 
 # extension
 
-test cmdah-5.1 {Tcl_FileCmd: extension} {
+test cmdAH-7.1 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     list [catch {file extension a b} msg] $msg
 } {1 {wrong # args: should be "file extension name"}}
-test cmdah-5.2 {Tcl_FileCmd: extension} {
+test cmdAH-7.2 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension {}
 } {}
-test cmdah-5.3 {Tcl_FileCmd: extension} {
+test cmdAH-7.3 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file ext foo
 } {}
-test cmdah-5.4 {Tcl_FileCmd: extension} {
+test cmdAH-7.4 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension foo.
 } .
-test cmdah-5.5 {Tcl_FileCmd: extension} {
+test cmdAH-7.5 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension .foo
 } .foo
-test cmdah-5.6 {Tcl_FileCmd: extension} {
+test cmdAH-7.6 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension abc.def
 } .def
-test cmdah-5.7 {Tcl_FileCmd: extension} {
+test cmdAH-7.7 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension abc.def.ghi
 } .ghi
-test cmdah-5.8 {Tcl_FileCmd: extension} {
+test cmdAH-7.8 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension a/b/c.d
 } .d
-test cmdah-5.9 {Tcl_FileCmd: extension} {
+test cmdAH-7.9 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension a/b.c/d
 } {}
-test cmdah-5.10 {Tcl_FileCmd: extension} {
+test cmdAH-7.10 {Tcl_FileObjCmd: extension} {
     testsetplatform unix
     file extension a/b.c/
 } {}
-test cmdah-5.11 {Tcl_FileCmd: extension} {
+test cmdAH-7.11 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file ext foo
 } {}
-test cmdah-5.12 {Tcl_FileCmd: extension} {
+test cmdAH-7.12 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension {}
 } {}
-test cmdah-5.13 {Tcl_FileCmd: extension} {
+test cmdAH-7.13 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension foo.
 } .
-test cmdah-5.14 {Tcl_FileCmd: extension} {
+test cmdAH-7.14 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension .foo
 } .foo
-test cmdah-5.15 {Tcl_FileCmd: extension} {
+test cmdAH-7.15 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension abc.def
 } .def
-test cmdah-5.16 {Tcl_FileCmd: extension} {
+test cmdAH-7.16 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension abc.def.ghi
 } .ghi
-test cmdah-5.17 {Tcl_FileCmd: extension} {
+test cmdAH-7.17 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension a:b:c.d
 } .d
-test cmdah-5.18 {Tcl_FileCmd: extension} {
+test cmdAH-7.18 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension a:b.c:d
 } {}
-test cmdah-5.19 {Tcl_FileCmd: extension} {
+test cmdAH-7.19 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension a/b/c.d
 } .d
-test cmdah-5.20 {Tcl_FileCmd: extension} {
+test cmdAH-7.20 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension a/b.c/d
 } {}
-test cmdah-5.21 {Tcl_FileCmd: extension} {
+test cmdAH-7.21 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension /a.b
 } .b
-test cmdah-5.22 {Tcl_FileCmd: extension} {
+test cmdAH-7.22 {Tcl_FileObjCmd: extension} {
     testsetplatform mac
     file extension foo.c:
 } {}
-test cmdah-5.23 {Tcl_FileCmd: extension} {
+test cmdAH-7.23 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension {}
 } {}
-test cmdah-5.24 {Tcl_FileCmd: extension} {
+test cmdAH-7.24 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file ext foo
 } {}
-test cmdah-5.25 {Tcl_FileCmd: extension} {
+test cmdAH-7.25 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension foo.
 } .
-test cmdah-5.26 {Tcl_FileCmd: extension} {
+test cmdAH-7.26 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension .foo
 } .foo
-test cmdah-5.27 {Tcl_FileCmd: extension} {
+test cmdAH-7.27 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension abc.def
 } .def
-test cmdah-5.28 {Tcl_FileCmd: extension} {
+test cmdAH-7.28 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension abc.def.ghi
 } .ghi
-test cmdah-5.29 {Tcl_FileCmd: extension} {
+test cmdAH-7.29 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension a/b/c.d
 } .d
-test cmdah-5.30 {Tcl_FileCmd: extension} {
+test cmdAH-7.30 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension a/b.c/d
 } {}
-test cmdah-5.31 {Tcl_FileCmd: extension} {
+test cmdAH-7.31 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension a\\b.c\\
 } {}
-test cmdah-5.32 {Tcl_FileCmd: extension} {
+test cmdAH-7.32 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension a\\b\\c.d
 } .d
-test cmdah-5.33 {Tcl_FileCmd: extension} {
+test cmdAH-7.33 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension a\\b.c\\d
 } {}
-test cmdah-5.34 {Tcl_FileCmd: extension} {
+test cmdAH-7.34 {Tcl_FileObjCmd: extension} {
     testsetplatform windows
     file extension a\\b.c\\
 } {}
+set num 35
+foreach value {a..b a...b a.c..b ..b} result {..b ...b ..b ..b} {
+    foreach p {unix mac windows} {
+;	test cmdAH-7.$num {Tcl_FileObjCmd: extension} "
+	    testsetplatform $p
+	    file extension $value
+	" $result
+	incr num
+    }
+}
 
 # pathtype
 
-test cmdah-6.1 {Tcl_FileCmd: pathtype} {
+test cmdAH-8.1 {Tcl_FileObjCmd: pathtype} {
     testsetplatform unix
     list [catch {file pathtype a b} msg] $msg
 } {1 {wrong # args: should be "file pathtype name"}}
-test cmdah-6.2 {Tcl_FileCmd: pathtype} {
+test cmdAH-8.2 {Tcl_FileObjCmd: pathtype} {
     testsetplatform unix
     file pathtype /a
 } absolute
-test cmdah-6.3 {Tcl_FileCmd: pathtype} {
+test cmdAH-8.3 {Tcl_FileObjCmd: pathtype} {
     testsetplatform unix
     file p a
 } relative
-test cmdah-6.4 {Tcl_FileCmd: pathtype} {
+test cmdAH-8.4 {Tcl_FileObjCmd: pathtype} {
     testsetplatform windows
     file pathtype c:a
 } volumerelative
 
 # split
 
-test cmdah-7.1 {Tcl_FileCmd: split} {
+test cmdAH-9.1 {Tcl_FileObjCmd: split} {
     testsetplatform unix
     list [catch {file split a b} msg] $msg
 } {1 {wrong # args: should be "file split name"}}
-test cmdah-7.2 {Tcl_FileCmd: split} {
+test cmdAH-9.2 {Tcl_FileObjCmd: split} {
     testsetplatform unix
     file split a
 } a
-test cmdah-7.3 {Tcl_FileCmd: split} {
+test cmdAH-9.3 {Tcl_FileObjCmd: split} {
     testsetplatform unix
     file split a/b
 } {a b}
 
 # join
 
-test cmdah-8.1 {Tcl_FileCmd: join} {
+test cmdAH-10.1 {Tcl_FileObjCmd: join} {
     testsetplatform unix
     file join a
 } a
-test cmdah-8.2 {Tcl_FileCmd: join} {
+test cmdAH-10.2 {Tcl_FileObjCmd: join} {
     testsetplatform unix
     file join a b
 } a/b
-test cmdah-8.3 {Tcl_FileCmd: join} {
+test cmdAH-10.3 {Tcl_FileObjCmd: join} {
     testsetplatform unix
     file join a b c d
 } a/b/c/d
 
 # error handling of Tcl_TranslateFileName
 
-test cmdah-9.1 {Tcl_FileCmd} {
+test cmdAH-11.1 {Tcl_FileObjCmd} {
     testsetplatform unix
-    list [catch {file readable ~_bad_user} msg] $msg
+    list [catch {file atime ~_bad_user} msg] $msg
 } {1 {user "_bad_user" doesn't exist}}
 
+testsetplatform $platform
 makeFile abcde gorp.file
 makeDirectory dir.file
 
@@ -809,14 +854,14 @@ makeDirectory dir.file
 # Can't run on macintosh - requires chmod
 if {$tcl_platform(platform) != "macintosh"} {
 
-test cmdah-10.1 {Tcl_FileCmd: readable} {
+test cmdAH-12.1 {Tcl_FileObjCmd: readable} {
     list [catch {file readable a b} msg] $msg
 } {1 {wrong # args: should be "file readable name"}}
 catch {exec chmod 444 gorp.file}
-test cmdah-10.2 {Tcl_FileCmd: readable} {unixExecs} {file readable gorp.file} 1
+test cmdAH-12.2 {Tcl_FileObjCmd: readable} {unixExecs} {file readable gorp.file} 1
 catch {exec chmod 333 gorp.file}
 if {$user != "root"} {
-    test cmdah-10.3 {Tcl_FileCmd: readable} {unixOnly} {
+    test cmdAH-12.3 {Tcl_FileObjCmd: readable} {unixOnly} {
 	file reada gorp.file
     } 0
 }
@@ -826,48 +871,47 @@ if {$user != "root"} {
 # Can't run on macintosh - requires chmod
 if {$tcl_platform(platform) != "macintosh"} {
 
-test cmdah-11.1 {Tcl_FileCmd: writable} {
+test cmdAH-13.1 {Tcl_FileObjCmd: writable} {
     list [catch {file writable a b} msg] $msg
 } {1 {wrong # args: should be "file writable name"}}
 catch {exec chmod 555 gorp.file}
 if {$user != "root"} {
-    test cmdah-11.2 {Tcl_FileCmd: writable} {unixExecs} {
+    test cmdAH-13.2 {Tcl_FileObjCmd: writable} {unixExecs} {
 	file writable gorp.file
     } 0
 }
 catch {exec chmod 222 gorp.file}
-test cmdah-11.3 {Tcl_FileCmd: writable} {unixExecs} {file w gorp.file} 1
+test cmdAH-13.3 {Tcl_FileObjCmd: writable} {unixExecs} {file w gorp.file} 1
 }
 
 # executable
 # Can't run on macintosh - requires chmod
 if {$tcl_platform(platform) != "macintosh"} {
 
-test cmdah-12.1 {Tcl_FileCmd: executable} {unixExecs} {
+test cmdAH-14.1 {Tcl_FileObjCmd: executable} {unixExecs} {
     list [catch {file executable a b} msg] $msg
 } {1 {wrong # args: should be "file executable name"}}
 catch {exec chmod 000 dir.file}
 if {$user != "root"} {
-    test cmdah-12.2 {Tcl_FileCmd: executable} {unixOnly} {
+    test cmdAH-14.2 {Tcl_FileObjCmd: executable} {unixOnly} {
 	file executable gorp.file
     } 0
 }
 catch {exec chmod 775 gorp.file}
-test cmdah-12.3 {Tcl_FileCmd: executable} {unixExecs} {file exe gorp.file} 1
+test cmdAH-14.3 {Tcl_FileObjCmd: executable} {unixExecs} {file exe gorp.file} 1
 }
 
 # exists
 
-test cmdah-13.1 {Tcl_FileCmd: exists} {
+test cmdAH-15.1 {Tcl_FileObjCmd: exists} {
     list [catch {file exists a b} msg] $msg
 } {1 {wrong # args: should be "file exists name"}}
 catch {exec chmod 777 dir.file}
-removeFile [file join dir.file gorp.file]
-removeFile gorp.file
-removeDirectory dir.file
-removeFile link.file
-test cmdah-13.2 {Tcl_FileCmd: exists} {file exists gorp.file} 0
-test cmdah-13.3 {Tcl_FileCmd: exists} {
+file delete -force dir.file  
+file delete gorp.file
+file delete link.file
+test cmdAH-15.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
+test cmdAH-15.3 {Tcl_FileObjCmd: exists} {
     file exists [file join dir.file gorp.file]
 } 0
 catch {
@@ -875,94 +919,109 @@ catch {
     makeDirectory dir.file
     makeFile 12345 [file join dir.file gorp.file]
 }
-test cmdah-13.4 {Tcl_FileCmd: exists} {unixExecs} {file exists gorp.file} 1
-test cmdah-13.5 {Tcl_FileCmd: exists} {unixExecs} {
-    file exi [file join dir.file gorp.file]
+test cmdAH-15.4 {Tcl_FileObjCmd: exists} {unixExecs} {file exists gorp.file} 1
+test cmdAH-15.5 {Tcl_FileObjCmd: exists} {unixExecs} {
+    file exists [file join dir.file gorp.file]
 } 1
 
+# nativename
+test cmdAH-15.6 {Tcl_FileObjCmd: nativename} {
+    testsetplatform unix
+    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
+} {0 a/b {}}
+test cmdAH-15.7 {Tcl_FileObjCmd: nativename} {
+    testsetplatform windows
+    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
+} {0 {a\b} {}}
+test cmdAH-15.8 {Tcl_FileObjCmd: nativename} {
+    testsetplatform mac
+    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
+} {0 :a:b {}}
+
 # The test below has to be done in /tmp rather than the current
 # directory in order to guarantee (?) a local file system:  some
 # NFS file systems won't do the stuff below correctly.
 
 if {$tcl_platform(platform) == "unix"} {
-    removeFile /tmp/tcl.foo.dir/file
+    file delete /tmp/tcl.foo.dir/file
     removeDirectory /tmp/tcl.foo.dir
     makeDirectory /tmp/tcl.foo.dir
     makeFile 12345 /tmp/tcl.foo.dir/file
     exec chmod 000 /tmp/tcl.foo.dir
     if {$user != "root"} {
-	test cmdah-13.3 {Tcl_FileCmd: exists} {
+	test cmdAH-15.9 {Tcl_FileObjCmd: exists} {
 	    file exists /tmp/tcl.foo.dir/file
 	} 0
     }
     exec chmod 775 /tmp/tcl.foo.dir
-    removeFile /tmp/tcl.foo.dir/file
+    file delete /tmp/tcl.foo.dir/file
     removeDirectory /tmp/tcl.foo.dir
 }
 
 # Stat related commands
 
-removeFile gorp.file
+testsetplatform $platform
+file delete gorp.file
 makeFile "Test string" gorp.file
 catch {exec chmod 765 gorp.file}
 
 # atime
 
-test cmdah-14.1 {Tcl_FileCmd: atime} {
+test cmdAH-16.1 {Tcl_FileObjCmd: atime} {
     list [catch {file atime a b} msg] $msg
 } {1 {wrong # args: should be "file atime name"}}
-test cmdah-14.2 {Tcl_FileCmd: atime} {
+test cmdAH-16.2 {Tcl_FileObjCmd: atime} {
     catch {unset stat}
     file stat gorp.file stat
     list [expr {[file mtime gorp.file] == $stat(mtime)}] \
 	    [expr {[file atime gorp.file] == $stat(atime)}]
 } {1 1}
-test cmdah-12.1 {Tcl_FileCmd: atime} {
+test cmdAH-16.3 {Tcl_FileObjCmd: atime} {
     string tolower [list [catch {file atime _bogus_} msg] \
 	    $msg $errorCode]
 } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
 
 # isdirectory
 
-test cmdah-15.1 {Tcl_FileCmd: isdirectory} {
+test cmdAH-17.1 {Tcl_FileObjCmd: isdirectory} {
     list [catch {file isdirectory a b} msg] $msg
 } {1 {wrong # args: should be "file isdirectory name"}}
-test cmdah-15.2 {Tcl_FileCmd: isdirectory} {file isdirectory gorp.file} 0
-test cmdah-15.3 {Tcl_FileCmd: isdirectory} {unixExecs} {file isd dir.file} 1
+test cmdAH-17.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory gorp.file} 0
+test cmdAH-17.3 {Tcl_FileObjCmd: isdirectory} {unixExecs} {file isd dir.file} 1
 
 # isfile
 
-test cmdah-15.4 {Tcl_FileCmd: isfile} {
+test cmdAH-18.1 {Tcl_FileObjCmd: isfile} {
     list [catch {file isfile a b} msg] $msg
 } {1 {wrong # args: should be "file isfile name"}}
-test cmdah-15.5 {Tcl_FileCmd: isfile} {file isfile gorp.file} 1
-test cmdah-15.6 {Tcl_FileCmd: isfile} {file isfile dir.file} 0
+test cmdAH-18.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
+test cmdAH-18.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0
 
 # lstat and readlink:  don't run these tests everywhere, since not all
 # sites will have symbolic links
 
 catch {exec ln -s gorp.file link.file}
-test cmdah-16.1 {Tcl_FileCmd: lstat} {unixExecs} {
+test cmdAH-19.1 {Tcl_FileObjCmd: lstat} {unixExecs} {
     list [catch {file lstat a} msg] $msg
 } {1 {wrong # args: should be "file lstat name varName"}}
-test cmdah-16.2 {Tcl_FileCmd: lstat} {unixExecs} {
+test cmdAH-19.2 {Tcl_FileObjCmd: lstat} {unixExecs} {
     list [catch {file lstat a b c} msg] $msg
 } {1 {wrong # args: should be "file lstat name varName"}}
-test cmdah-16.3 {Tcl_FileCmd: lstat} {unixOnly nonPortable} {
+test cmdAH-19.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
     catch {unset stat}
     file lstat link.file stat
     lsort [array names stat]
 } {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdah-16.4 {Tcl_FileCmd: lstat} {unixOnly nonPortable} {
+test cmdAH-19.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
     catch {unset stat}
     file lstat link.file stat
     list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
 } {1 511 link}
-test cmdah-16.5 {Tcl_FileCmd: lstat errors} {nonPortable} {
+test cmdAH-19.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
     string tolower [list [catch {file lstat _bogus_ stat} msg] \
 	    $msg $errorCode]
 } {1 {couldn't lstat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdah-16.6 {Tcl_FileCmd: lstat errors} {unixExecs nonPortable} {
+test cmdAH-19.6 {Tcl_FileObjCmd: lstat errors} {unixExecs nonPortable} {
     catch {unset x}
     set x 44
     list [catch {file lstat gorp.file x} msg] $msg $errorCode
@@ -971,10 +1030,10 @@ catch {unset stat}
 
 # mtime 
 
-test cmdah-17.1 {Tcl_FileCmd: mtime} {
+test cmdAH-20.1 {Tcl_FileObjCmd: mtime} {
     list [catch {file mtime a b} msg] $msg
 } {1 {wrong # args: should be "file mtime name"}}
-test cmdah-17.2 {Tcl_FileCmd: mtime} {unixExecs} {
+test cmdAH-20.2 {Tcl_FileObjCmd: mtime} {unixExecs} {
     set old [file mtime gorp.file]
     after 2000
     set f [open gorp.file w]
@@ -983,54 +1042,75 @@ test cmdah-17.2 {Tcl_FileCmd: mtime} {unixExecs} {
     set new [file mtime gorp.file]
     expr {($new > $old) && ($new <= ($old+5))}
 } {1}
-test cmdah-17.3 {Tcl_FileCmd: mtime} {unixExecs} {
+test cmdAH-20.3 {Tcl_FileObjCmd: mtime} {unixExecs} {
     catch {unset stat}
     file stat gorp.file stat
     list [expr {[file mtime gorp.file] == $stat(mtime)}] \
 	    [expr {[file atime gorp.file] == $stat(atime)}]
 } {1 1}
-test cmdah-17.4 {Tcl_FileCmd: mtime} {unixExecs} {
+test cmdAH-20.4 {Tcl_FileObjCmd: mtime} {unixExecs} {
     string tolower [list [catch {file mtime _bogus_} msg] $msg \
 	    $errorCode]
 } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-20.5 {Tcl_FileObjCmd: mtime} {
+    # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
+    # On other platforms, just use a file in the local directory.
+
+    if {$tcl_platform(platform) == "unix"} {
+	 set name /tmp/tcl.test
+    } else {
+	set name tf
+    }
+
+    # Borland file times were off by timezone.  Make sure that a new file's
+    # time is correct.  10 seconds variance is allowed used due to slow
+    # networks or clock skew on a network drive.
+
+    file delete -force $name
+    close [open $name w]
+    set a [expr abs([clock seconds]-[file mtime $name])<10]
+    file delete $name
+    set a
+} {1}
+
 
 # owned
 
-test cmdah-18.1 {Tcl_FileCmd: owned} {
+test cmdAH-21.1 {Tcl_FileObjCmd: owned} {
     list [catch {file owned a b} msg] $msg
 } {1 {wrong # args: should be "file owned name"}}
-test cmdah-18.2 {Tcl_FileCmd: owned} {unixExecs} {file owned gorp.file} 1
+test cmdAH-21.2 {Tcl_FileObjCmd: owned} {unixExecs} {file owned gorp.file} 1
 if {$user != "root"} {
-    test cmdah-18.3 {Tcl_FileCmd: owned} {unixOnly} {file owned /} 0
+    test cmdAH-21.3 {Tcl_FileObjCmd: owned} {unixOnly} {file owned /} 0
 }
 
 # readlink
 
-test cmdah-19.1 {Tcl_FileCmd: readlink} {
+test cmdAH-22.1 {Tcl_FileObjCmd: readlink} {
     list [catch {file readlink a b} msg] $msg
 } {1 {wrong # args: should be "file readlink name"}}
-test cmdah-19.2 {Tcl_FileCmd: readlink} {unixOnly nonPortable} {
+test cmdAH-22.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
     file readlink link.file
 } gorp.file
-test cmdah-19.3 {Tcl_FileCmd: readlink errors} {unixOnly nonPortable} {
+test cmdAH-22.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
     list [catch {file readlink _bogus_} msg] [string tolower $msg] \
 	    [string tolower $errorCode]
 } {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdah-19.4 {Tcl_FileCmd: readlink errors} {macOnly nonPortable} {
+test cmdAH-22.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {
     list [catch {file readlink _bogus_} msg] [string tolower $msg] \
 	    [string tolower $errorCode]
 } {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdah-19.5 {Tcl_FileCmd: readlink errors} {pcOnly nonPortable} {
+test cmdAH-22.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {
     list [catch {file readlink _bogus_} msg] [string tolower $msg] \
 	    [string tolower $errorCode]
 } {1 {couldn't readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
 
 # size
 
-test cmdah-20.1 {Tcl_FileCmd: size} {
+test cmdAH-23.1 {Tcl_FileObjCmd: size} {
     list [catch {file size a b} msg] $msg
 } {1 {wrong # args: should be "file size name"}}
-test cmdah-20.2 {Tcl_FileCmd: size} {
+test cmdAH-23.2 {Tcl_FileObjCmd: size} {
     set oldsize [file size gorp.file]
     set f [open gorp.file a]
     fconfigure $f -translation lf -eofchar {}
@@ -1038,37 +1118,38 @@ test cmdah-20.2 {Tcl_FileCmd: size} {
     close $f
     expr {[file size gorp.file] - $oldsize}
 } {10}
-test cmdah-20.3 {Tcl_FileCmd: size} {
+test cmdAH-23.3 {Tcl_FileObjCmd: size} {
     string tolower [list [catch {file size _bogus_} msg] $msg \
 	    $errorCode]
 } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
 
 # stat
 
+testsetplatform $platform
 makeFile "Test string" gorp.file
 catch {exec chmod 765 gorp.file}
 
-test cmdah-21.1 {Tcl_FileCmd: stat} {
+test cmdAH-24.1 {Tcl_FileObjCmd: stat} {
     list [catch {file stat _bogus_} msg] $msg $errorCode
 } {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdah-21.2 {Tcl_FileCmd: stat} {
+test cmdAH-24.2 {Tcl_FileObjCmd: stat} {
     list [catch {file stat _bogus_ a b} msg] $msg $errorCode
 } {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdah-21.3 {Tcl_FileCmd: stat} {
+test cmdAH-24.3 {Tcl_FileObjCmd: stat} {
     catch {unset stat}
     file stat gorp.file stat
     lsort [array names stat]
 } {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdah-21.4 {Tcl_FileCmd: stat} {unixOnly} {
+test cmdAH-24.4 {Tcl_FileObjCmd: stat} {unixOnly} {
     catch {unset stat}
     file stat gorp.file stat
     list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type)
 } {1 12 501 file}
-test cmdah-21.5 {Tcl_FileCmd: stat} {
+test cmdAH-24.5 {Tcl_FileObjCmd: stat} {
     string tolower [list [catch {file stat _bogus_ stat} msg] \
 	    $msg $errorCode]
 } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdah-21.6 {Tcl_FileCmd: stat} {
+test cmdAH-24.6 {Tcl_FileObjCmd: stat} {
     catch {unset x}
     set x 44
     list [catch {file stat gorp.file x} msg] $msg $errorCode
@@ -1077,60 +1158,60 @@ catch {unset stat}
 
 # type
 
-removeFile link.file
+file delete link.file
 
-test cmdah-22.1 {Tcl_FileCmd: type} {
+test cmdAH-25.1 {Tcl_FileObjCmd: type} {
     list [catch {file size a b} msg] $msg
 } {1 {wrong # args: should be "file size name"}}
-test cmdah-22.2 {Tcl_FileCmd: type} {unixExecs} {
+test cmdAH-25.2 {Tcl_FileObjCmd: type} {unixExecs} {
     file type dir.file
 } directory
-test cmdah-22.3 {Tcl_FileCmd: type} {
+test cmdAH-25.3 {Tcl_FileObjCmd: type} {
     file type gorp.file
 } file
-test cmdah-22.4 {Tcl_FileCmd: type} {unixOnly nonPortable} {
+test cmdAH-25.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
     exec ln -s a/b/c link.file
     set result [file type link.file]
-    removeFile link.file
+    file delete link.file
     set result
 } link
-test cmdah-22.5 {Tcl_FileCmd: type} {
+test cmdAH-25.5 {Tcl_FileObjCmd: type} {
     string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
 } {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
 
 # Error conditions
 
-test cmdah-23.1 {error conditions} {
+test cmdAH-26.1 {error conditions} {
     list [catch {file gorp x} msg] $msg
-} {1 {bad option "gorp": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.2 {error conditions} {
+} {1 {bad option "gorp": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.2 {error conditions} {
     list [catch {file ex x} msg] $msg
-} {1 {bad option "ex": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.3 {error conditions} {
+} {1 {ambiguous option "ex": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.3 {error conditions} {
     list [catch {file is x} msg] $msg
-} {1 {bad option "is": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.4 {error conditions} {
-    list [catch {file n x} msg] $msg
-} {1 {bad option "n": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.5 {error conditions} {
+} {1 {ambiguous option "is": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.4 {error conditions} {
+    list [catch {file z x} msg] $msg
+} {1 {bad option "z": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.5 {error conditions} {
     list [catch {file read x} msg] $msg
-} {1 {bad option "read": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.6 {error conditions} {
+} {1 {ambiguous option "read": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.6 {error conditions} {
     list [catch {file s x} msg] $msg
-} {1 {bad option "s": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.7 {error conditions} {
+} {1 {ambiguous option "s": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.7 {error conditions} {
     list [catch {file t x} msg] $msg
-} {1 {bad option "t": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}}
-test cmdah-23.8 {error conditions} {
+} {1 {ambiguous option "t": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-26.8 {error conditions} {
     list [catch {file dirname ~woohgy} msg] $msg
 } {1 {user "woohgy" doesn't exist}}
 
-catch {exec chmod 777 dir.file}
-removeFile dir.file/gorp.file
-removeFile gorp.file
-removeDirectory dir.file
-removeFile link.file
-
 testsetplatform $platform
 catch {unset platform}
+
+catch {exec chmod 777 dir.file}
+file delete -force dir.file
+file delete gorp.file
+file delete link.file
+
 concat ""
diff --git a/contrib/tcl/tests/cmdIL.test b/contrib/tcl/tests/cmdIL.test
new file mode 100644
index 0000000..55210a1
--- /dev/null
+++ b/contrib/tcl/tests/cmdIL.test
@@ -0,0 +1,250 @@
+# This file contains a collection of tests for the procedures in the
+# file tclCmdIL.c.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) cmdIL.test 1.15 97/05/22 16:38:11
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
+    list [catch {lsort} msg] $msg
+} {1 {wrong # args: should be "lsort ?options? list"}}
+test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
+    list [catch {lsort -foo {1 3 2 5}} msg] $msg
+} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -integer, or -real}}
+test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
+    lsort {d e c b a \{ d35 d300}
+} {a b c d d300 d35 e \{}
+test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} {
+    lsort -integer -ascii {d e c b a d35 d300}
+} {a b c d d300 d35 e}
+test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} {
+    list [catch {lsort -command {1 3 2 5}} msg] $msg
+} {1 {"-command" option must be followed by comparison command}}
+test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} {
+    proc cmp {a b} {
+	expr {[string match x* $b] - [string match x* $a]}
+    }
+    lsort -command cmp {x1 abc x2 def x3 x4}
+} {x1 x2 x3 x4 abc def}
+test cmdIL-1.7 {Tcl_LsortObjCmd procedure, -decreasing option} {
+    lsort -decreasing {d e c b a d35 d300}
+} {e d35 d300 d c b a}
+test cmdIL-1.8 {Tcl_LsortObjCmd procedure, -dictionary option} {
+    lsort -dictionary {d e c b a d35 d300}
+} {a b c d d35 d300 e}
+test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -increasing option} {
+    lsort -decreasing -increasing {d e c b a d35 d300}
+} {a b c d d300 d35 e}
+test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -index option} {
+    list [catch {lsort -index {1 3 2 5}} msg] $msg
+} {1 {"-index" option must be followed by list index}}
+test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
+    list [catch {lsort -index foo {1 3 2 5}} msg] $msg
+} {1 {expected integer but got "foo"}}
+test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
+    lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
+} {1 {2 25} {3 16 42} {10 20 50 100}}
+test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
+    lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}}
+} {{3 16 42} {10 20 50} {1 25 100}}
+test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -integer option} {
+    lsort -integer {24 6 300 18}
+} {6 18 24 300}
+test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
+    list [catch {lsort -integer {1 3 2.4}} msg] $msg
+} {1 {expected integer but got "2.4"}}
+test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -real option} {
+    lsort -real {24.2 6e3 150e-1}
+} {150e-1 24.2 6e3}
+test cmdIL-1.17 {Tcl_LsortObjCmd procedure, bogus list} {
+    list [catch {lsort "1 2 3 \{ 4"} msg] $msg
+} {1 {unmatched open brace in list}}
+test cmdIL-1.18 {Tcl_LsortObjCmd procedure, empty list} {
+    lsort {}
+} {}
+
+# Can't think of any good tests for the MergeSort and MergeLists
+# procedures, except a bunch of random lists to sort.
+
+test cmdIL-2.1 {MergeSort and MergeLists procedures} {
+    set result {}
+    set r 1435753299
+    proc rand {} {
+	global r
+	set r [expr (16807 * $r) % (0x7fffffff)]
+    }
+    for {set i 0} {$i < 150} {incr i} {
+	set x {}
+	for {set j 0} {$j < $i} {incr j} {
+	    lappend x [expr [rand] & 0xfff]
+	}
+	set y [lsort -integer $x]
+	set old -1
+	foreach el $y {
+	    if {$el < $old} {
+		append result "list {$x} sorted to {$y}, element $el out of order\n"
+		break
+	    }
+	    set old $el
+	}
+    }
+    set result
+} {}
+
+test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} {
+    set x 0
+    proc cmp {a b} {
+	global x
+	incr x
+	error "error #$x"
+    }
+    list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
+	    $msg $x
+} {1 {error #1} 1}
+test cmdIL-3.2 {SortCompare procedure, -index option} {
+    list [catch {lsort -integer -index 2 "\\\{ {30 40 50}"} msg] $msg
+} {1 {unmatched open brace in list}}
+test cmdIL-3.3 {SortCompare procedure, -index option} {
+    list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
+} {1 {element 2 missing from sublist "20 10"}}
+test cmdIL-3.4 {SortCompare procedure, -index option} {
+    list [catch {lsort -integer -index 2 "{a b c} \\\{"} msg] $msg
+} {1 {unmatched open brace in list}}
+test cmdIL-3.5 {SortCompare procedure, -index option} {
+    list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
+} {1 {element 2 missing from sublist "15"}}
+test cmdIL-3.6 {SortCompare procedure, -index option} {
+    lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
+} {{3 25 20} {2 5 25} {1 15 30}}
+test cmdIL-3.7 {SortCompare procedure, -ascii option} {
+    lsort -ascii {d e c b a d35 d300 100 20}
+} {100 20 a b c d d300 d35 e}
+test cmdIL-3.8 {SortCompare procedure, -dictionary option} {
+    lsort -dictionary {d e c b a d35 d300 100 20}
+} {20 100 a b c d d35 d300 e}
+test cmdIL-3.9 {SortCompare procedure, -integer option} {
+    list [catch {lsort -integer {x 3}} msg] $msg
+} {1 {expected integer but got "x"}}
+test cmdIL-3.10 {SortCompare procedure, -integer option} {
+    list [catch {lsort -integer {3 q}} msg] $msg
+} {1 {expected integer but got "q"}}
+test cmdIL-3.11 {SortCompare procedure, -integer option} {
+    lsort -integer {35 21 0x20 30 023 100 8}
+} {8 023 21 30 0x20 35 100}
+test cmdIL-3.12 {SortCompare procedure, -real option} {
+    list [catch {lsort -real {6...4 3}} msg] $msg
+} {1 {expected floating-point number but got "6...4"}}
+test cmdIL-3.13 {SortCompare procedure, -real option} {
+    list [catch {lsort -real {3 1x7}} msg] $msg
+} {1 {expected floating-point number but got "1x7"}}
+test cmdIL-3.14 {SortCompare procedure, -real option} {
+    lsort -real {24 2.5e01 16.7 85e-1 10.004}
+} {85e-1 10.004 16.7 24 2.5e01}
+test cmdIL-3.15 {SortCompare procedure, -command option} {
+    proc cmp {a b} {
+	error "comparison error"
+    }
+    list [catch {lsort -command cmp {48 6}} msg] $msg $errorInfo
+} {1 {comparison error} {comparison error
+    while executing
+"error "comparison error""
+    (procedure "cmp" line 1)
+    invoked from within
+"cmp 48 6"
+    (-compare command)
+    invoked from within
+"lsort -command cmp {48 6}"}}
+test cmdIL-3.16 {SortCompare procedure, -command option, long command} {
+    proc cmp {dummy a b} {
+	string compare $a $b
+    }
+    lsort -command {cmp {this argument is very very long in order to make the dstring overflow its statically allocated space}} {{this first element is also long in order to help expand the dstring} {the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring}}
+} {{the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring} {this first element is also long in order to help expand the dstring}}
+test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} {
+    proc cmp {a b} {
+	return foow
+    }
+    list [catch {lsort -command cmp {48 6}} msg] $msg
+} {1 {-compare command returned non-numeric result}}
+test cmdIL-3.18 {SortCompare procedure, -command option} {
+    proc cmp {a b} {
+	expr $b - $a
+    }
+    lsort -command cmp {48 6 18 22 21 35 36}
+} {48 36 35 22 21 18 6}
+test cmdIL-3.19 {SortCompare procedure, -decreasing option} {
+    lsort -decreasing -integer {35 21 0x20 30 023 100 8}
+} {100 35 0x20 30 21 023 8}
+
+test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} {
+    lsort -dictionary {a003b a03b}
+} {a03b a003b}
+test cmdIL-4.2 {DictionaryCompare procedure, numerics, leading zeros} {
+    lsort -dictionary {a3b a03b}
+} {a3b a03b}
+test cmdIL-4.3 {DictionaryCompare procedure, numerics, leading zeros} {
+    lsort -dictionary {a3b A03b}
+} {A03b a3b}
+test cmdIL-4.4 {DictionaryCompare procedure, numerics, leading zeros} {
+    lsort -dictionary {a3b a03B}
+} {a3b a03B}
+test cmdIL-4.5 {DictionaryCompare procedure, numerics, different lengths} {
+    lsort -dictionary {a321b a03210b}
+} {a321b a03210b}
+test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} {
+    lsort -dictionary {a03210b a321b}
+} {a321b a03210b}
+test cmdIL-4.7 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {48 6a 18b 22a 21aa 35 36}
+} {6a 18b 21aa 22a 35 36 48}
+test cmdIL-4.8 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a123x a123b}
+} {a123b a123x}
+test cmdIL-4.9 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a123b a123x}
+} {a123b a123x}
+test cmdIL-4.10 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b aab}
+} {a1b aab}
+test cmdIL-4.11 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b a!b}
+} {a!b a1b}
+test cmdIL-4.12 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b2c a1b1c}
+} {a1b1c a1b2c}
+test cmdIL-4.13 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b2c a1b3c}
+} {a1b2c a1b3c}
+test cmdIL-4.14 {DictionaryCompare procedure, long numbers} {
+    lsort -dictionary {a7654884321988762b a7654884321988761b}
+} {a7654884321988761b a7654884321988762b}
+test cmdIL-4.15 {DictionaryCompare procedure, long numbers} {
+    lsort -dictionary {a8765488432198876b a7654884321988761b}
+} {a7654884321988761b a8765488432198876b}
+test cmdIL-4.16 {DictionaryCompare procedure, case} {
+    lsort -dictionary {aBCd abcc}
+} {abcc aBCd}
+test cmdIL-4.17 {DictionaryCompare procedure, case} {
+    lsort -dictionary {aBCd abce}
+} {aBCd abce}
+test cmdIL-4.18 {DictionaryCompare procedure, case} {
+    lsort -dictionary {abcd ABcc}
+} {ABcc abcd}
+test cmdIL-4.19 {DictionaryCompare procedure, case} {
+    lsort -dictionary {abcd ABce}
+} {abcd ABce}
+test cmdIL-4.20 {DictionaryCompare procedure, case} {
+    lsort -dictionary {abCD ABcd}
+} {ABcd abCD}
+test cmdIL-4.21 {DictionaryCompare procedure, case} {
+    lsort -dictionary {ABcd aBCd}
+} {ABcd aBCd}
+test cmdIL-4.22 {DictionaryCompare procedure, case} {
+    lsort -dictionary {ABcd AbCd}
+} {ABcd AbCd}
diff --git a/contrib/tcl/tests/cmdInfo.test b/contrib/tcl/tests/cmdInfo.test
index 3034929..14267ac 100644
--- a/contrib/tcl/tests/cmdInfo.test
+++ b/contrib/tcl/tests/cmdInfo.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) cmdinfo.test 1.5 96/04/05 15:28:12
+# SCCS: @(#) cmdInfo.test 1.10 97/06/20 14:51:12
 
 if {[info commands testcmdinfo] == {}} {
     puts "This application hasn't been compiled with the \"testcmdinfo\""
@@ -25,7 +25,7 @@ if {[string compare test [info procs test]] == 1} then {source defs}
 test cmdinfo-1.1 {command procedure and clientData} {
     testcmdinfo create x1
     testcmdinfo get x1
-} {CmdProc1 original CmdDelProc1 original}
+} {CmdProc1 original CmdDelProc1 original :: stringProc}
 test cmdinfo-1.2 {command procedure and clientData} {
     testcmdinfo create x1
     x1
@@ -34,7 +34,7 @@ test cmdinfo-1.3 {command procedure and clientData} {
     testcmdinfo create x1
     testcmdinfo modify x1
     testcmdinfo get x1
-} {CmdProc2 new_command_data CmdDelProc2 new_delete_data}
+} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
 test cmdinfo-1.4 {command procedure and clientData} {
     testcmdinfo create x1
     testcmdinfo modify x1
@@ -62,13 +62,37 @@ test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {
     testcmdinfo modify non_existent
 } 0
 
-test cmdinfo-4.1 {Tcl_GetCommandName procedure} {
+test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} {
     set x [testcmdtoken create x1]
     rename x1 newName
     set y [testcmdtoken name $x]
     rename newName x1
-    lappend y [testcmdtoken name $x]
-} {newName x1}
+    eval lappend y [testcmdtoken name $x]
+} {newName ::newName x1 ::x1}
 
+catch {rename newTestCmd {}}
+catch {rename newTestCmd2 {}}
+
+test cmdinfo-5.1 {Names for commands created when inside namespaces} {
+    # create namespace cmdInfoNs1
+    namespace eval cmdInfoNs1 {}   ;# creates namespace cmdInfoNs1
+    # create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it
+    set x [namespace eval cmdInfoNs1::cmdInfoNs2 {
+        # the following creates a cmd in the global namespace
+        testcmdtoken create testCmd
+    }]
+    set y [testcmdtoken name $x]
+    rename ::testCmd newTestCmd
+    eval lappend y [testcmdtoken name $x]
+} {testCmd ::testCmd newTestCmd ::newTestCmd}
+
+test cmdinfo-6.1 {Names for commands created when outside namespaces} {
+    set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
+    set y [testcmdtoken name $x]
+    rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
+    eval lappend y [testcmdtoken name $x]
+} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
+
+catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
 catch {rename x1 ""}
 concat {}
diff --git a/contrib/tcl/tests/compile.test b/contrib/tcl/tests/compile.test
new file mode 100644
index 0000000..6d8e032
--- /dev/null
+++ b/contrib/tcl/tests/compile.test
@@ -0,0 +1,108 @@
+# This file contains tests for the file tclCompile.c.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) compile.test 1.5 97/06/25 11:43:49
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# The following tests are very incomplete, although the rest of the
+# test suite covers this file fairly well.
+
+catch {rename p ""}
+catch {namespace delete test_ns_compile}
+catch {unset x}
+catch {unset y}
+catch {unset a}
+
+test compile-1.1 {TclCompileDollarVar: global scalar name with ::s} {
+    catch {unset x}
+    set x 123
+    list $::x [expr {[lsearch -exact [info globals] x] != 0}]
+} {123 1}
+test compile-1.2 {TclCompileDollarVar: global scalar name with ::s} {
+    catch {unset y}
+    proc p {} {
+        set ::y 789
+        return $::y
+    }
+    list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
+} {789 789 1}
+test compile-1.3 {TclCompileDollarVar: global array name with ::s} {
+    catch {unset a}
+    set ::a(1) 2
+    list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}]
+} {2 3 3 1}
+test compile-1.4 {TclCompileDollarVar: global scalar name with ::s} {
+    catch {unset a}
+    proc p {} {
+        set ::a(1) 1
+        return $::a($::a(1))
+    }
+    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
+} {1 1 1}
+
+test compile-2.1 {TclCompileSetCmd: global scalar names with ::s} {
+    catch {unset x}
+    catch {unset y}
+    set x 123
+    proc p {} {
+        set ::y 789
+        return $::y
+    }
+    list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
+         [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
+} {123 1 789 789 1}
+test compile-2.2 {TclCompileSetCmd: global array names with ::s} {
+    catch {unset a}
+    set ::a(1) 2
+    proc p {} {
+        set ::a(1) 1
+        return $::a($::a(1))
+    }
+    list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
+} {2 1 3 3 1}
+test compile-2.3 {TclCompileSetCmd: namespace var names with ::s} {
+    catch {namespace delete test_ns_compile}
+    catch {unset x}
+    namespace eval test_ns_compile {
+        variable v hello
+        variable arr
+        set ::x $::test_ns_compile::v
+	set ::test_ns_compile::arr(1) 123
+    }
+    list $::x $::test_ns_compile::arr(1)
+} {hello 123}
+
+test compile-3.1 {CollectArgInfo: binary data} {
+    list [catch "string length \000foo" msg] $msg
+} {0 4}
+test compile-3.2 {CollectArgInfo: binary data} {
+    list [catch "string length foo\000" msg] $msg
+} {0 4}
+test compile-3.3 {CollectArgInfo: handle "]" at end of command properly} {
+    set x ]
+} {]}
+
+test compile-4.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} {
+    proc p {} {
+        set x {}
+        eval $x
+        append x { }
+        eval $x
+    }
+    p
+} {}
+
+catch {rename p ""}
+catch {namespace delete test_ns_compile}
+catch {unset x}
+catch {unset y}
+catch {unset a}
diff --git a/contrib/tcl/tests/concat.test b/contrib/tcl/tests/concat.test
index b86aeed..d0222e9 100644
--- a/contrib/tcl/tests/concat.test
+++ b/contrib/tcl/tests/concat.test
@@ -5,12 +5,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# 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.
 #
-# SCCS: @(#) concat.test 1.8 96/02/16 08:55:43
+# SCCS: @(#) concat.test 1.10 96/12/20 18:53:31
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -27,13 +27,20 @@ test concat-1.4 {special characters} {
     concat a\{ {b \{c d} \{d
 } "a{ b \\{c d {d"
 
-test concat-2.1 {error: no arguments} {
+test concat-2.1 {error: one empty argument} {
+    concat {}
+} {}
+
+test concat-3.1 {error: no arguments} {
     list [catch concat msg] $msg
 } {0 {}}
 
-test concat-3.1 {pruning off extra white space} {
+test concat-4.1 {pruning off extra white space} {
     concat {} {a b c}
 } {a b c}
-test concat-3.2 {pruning off extra white space} {
+test concat-4.2 {pruning off extra white space} {
     concat x y "  a b c	\n\t  " "   "  " def "
 } {x y a b c def}
+test concat-4.3 {pruning off extra white space sets length correctly} {
+    llength [concat { {{a}} }]
+} 1
diff --git a/contrib/tcl/tests/defs b/contrib/tcl/tests/defs
index 62f1e4c..ead6aeb 100644
--- a/contrib/tcl/tests/defs
+++ b/contrib/tcl/tests/defs
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) defs 1.38 96/07/24 17:18:20
+# SCCS: @(#) defs 1.52 97/06/24 11:13:36
 
 if ![info exists VERBOSE] {
     set VERBOSE 0
@@ -22,10 +22,16 @@ if ![info exists TESTS] {
 # variable to prevent some tests from running at all.
 
 set user {}
-catch {set user [exec whoami]}
-if {$user == "root"} {
-    puts stdout "Warning: you're executing as root.  I'll have to"
-    puts stdout "skip some of the tests, since they'll fail as root."
+if {$tcl_platform(platform) == "unix"} {
+    catch {set user [exec whoami]}
+    if {$user == ""} {
+        catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+    }
+    if {$user == ""} {set user root}
+    if {$user == "root"} {
+        puts stdout "Warning: you're executing as root.  I'll have to"
+        puts stdout "skip some of the tests, since they'll fail as root."
+    }
 }
 
 # Some of the tests don't work on some system configurations due to
@@ -35,8 +41,6 @@ if {$user == "root"} {
 # "doAllTests" in this directory is used to indicate that the non-portable
 # tests should be run.
 
-set doNonPortableTests [file exists doAllTests]
-
 # If there is no "memory" command (because memory debugging isn't
 # enabled), generate a dummy command that does nothing.
 
@@ -67,17 +71,28 @@ if {[info commands memory] == ""} {
 #			that it is safe to run non-portable tests.
 #	tempNotPc -	The inverse of pcOnly.  This flag is used to
 #			temporarily disable a test.
+#	tempNotMac -	The inverse of macOnly.  This flag is used to
+#			temporarily disable a test.
 #	nonBlockFiles - 1 means this platform supports setting files into
 #			nonblocking mode.
 #	asyncPipeClose- 1 means this platform supports async flush and
 #			async close on a pipe.
 #	unixExecs     - 1 means this machine has commands such as 'cat',
 #			'echo' etc available.
+#	notIfCompiled -	1 means this that it is safe to run tests that
+#                       might fail if the bytecode compiler is used. This
+#                       element is set 1 if the file "doAllTests" exists in
+#                       this directory. Normally, this element is 0 so that
+#                       tests that fail with the bytecode compiler are
+#			skipped. As of 11/2/96 these are the history tests
+#			since they depend on accurate source location
+#			information.
 
 catch {unset testConfig}
 if {$tcl_platform(platform) == "unix"} {
     set testConfig(unixOnly) 1
     set testConfig(tempNotPc) 1
+    set testConfig(tempNotMac) 1
 } else {
     set testConfig(unixOnly) 0
 } 
@@ -88,6 +103,7 @@ if {$tcl_platform(platform) == "macintosh"} {
     set testConfig(macOnly) 0
 } 
 if {$tcl_platform(platform) == "windows"} {
+    set testConfig(tempNotMac) 1
     set testConfig(pcOnly) 1
 } else {
     set testConfig(pcOnly) 0
@@ -95,15 +111,45 @@ if {$tcl_platform(platform) == "windows"} {
 set testConfig(unixOrPc) [expr $testConfig(unixOnly) || $testConfig(pcOnly)]
 set testConfig(macOrPc) [expr $testConfig(macOnly) || $testConfig(pcOnly)]
 set testConfig(macOrUnix) [expr $testConfig(macOnly) || $testConfig(unixOnly)]
-set testConfig(nonPortable) [file exists doAllTests]
+set testConfig(nonPortable)   [file exists doAllTests]
+set testConfig(notIfCompiled) [file exists doAllCompilerTests]
+
+set testConfig(unix)	$testConfig(unixOnly)
+set testConfig(mac)	$testConfig(macOnly)
+set testConfig(pc)	$testConfig(pcOnly)
+
+set testConfig(nt)	[expr {$tcl_platform(os) == "Windows NT"}]
+set testConfig(95)	[expr {$tcl_platform(os) == "Windows 95"}]
+set testConfig(win32s)	[expr {$tcl_platform(os) == "Win32s"}]
+
+# The following config switches are used to mark tests that crash on
+# certain platforms, so that they can be reactivated again when the
+# underlying problem is fixed.
+
+set testConfig(winCrash) $testConfig(macOrUnix)
+set testConfig(macCrash) $testConfig(unixOrPc)
+set testConfig(unixCrash) $testConfig(macOrPc)
 
-set f [open defs r]
-if {[expr [catch {fconfigure $f -blocking off}]] == 0} {
+if {[catch {set f [open defs r]}]} {
     set testConfig(nonBlockFiles) 1
 } else {
-    set testConfig(nonBlockFiles) 0
+    if {[expr [catch {fconfigure $f -blocking off}]] == 0} {
+	set testConfig(nonBlockFiles) 1
+    } else {
+	set testConfig(nonBlockFiles) 0
+    }
+    close $f
+}
+
+trace variable testConfig r safeFetch
+
+proc safeFetch {n1 n2 op} {
+    global testConfig 
+
+    if {($n2 != {}) && ([info exists testConfig($n2)] == 0)} {
+	set testConfig($n2) 0
+    }
 }
-close $f
 
 # Test for SCO Unix - cannot run async flushing tests because a potential
 # problem with select is apparently interfering. (Mark Diekhans).
@@ -169,6 +215,10 @@ if {($testConfig(unixExecs) == 1) && ($tcl_platform(platform) == "windows")} {
     } else {
 	catch {exec rm -r removeMe}
     }
+    if {$testConfig(unixExecs) == 0} {
+	puts stdout "Warning: Unix-style executables are not available, so"
+	puts stdout "some tests will be skipped."
+    }
 }    
 
 proc print_verbose {name description script code answer} {
@@ -240,12 +290,35 @@ proc test {name description script answer args} {
 	set constraints $script
 	set script $answer
 	set answer [lindex $args 0]
-	foreach constraint $constraints {
-	    if {![info exists testConfig($constraint)]
-		    || !$testConfig($constraint)} {
-		return
+	set doTest 0
+	if {[string match {*[$\[]*} $constraints] != 0} {
+	    # full expression, e.g. {$foo > [info tclversion]}
+
+	    catch {set doTest [uplevel #0 expr $constraints]}
+	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
+	    # something like {a || b} should be turned into 
+	    # $testConfig(a) || $testConfig(b).
+
+ 	    regsub -all {[.a-zA-Z0-9]+} $constraints {$testConfig(&)} c
+	    catch {set doTest [eval expr $c]}
+	} else {
+	    # just simple constraints such as {unixOnly fonts}.
+
+	    set doTest 1
+	    foreach constraint $constraints {
+		if {![info exists testConfig($constraint)]
+			|| !$testConfig($constraint)} {
+		    set doTest 0
+		    break
+		}
 	    }
 	}
+	if {$doTest == 0} {
+	    if $VERBOSE then {
+		puts stdout "++++ $name SKIPPED: $constraints"
+	    }
+	    return	
+	}
     } else {
 	error "wrong # args: must be \"test name description ?constraints? script answer\""
     }
@@ -298,30 +371,15 @@ proc makeFile {contents name} {
 }
 
 proc removeFile {name} {
-    global tcl_platform testConfig
-    if {$tcl_platform(platform) == "macintosh"} {
-	catch {rm -f $name}
-    } else {
-	catch {exec rm -f $name}
-    }
+    file delete $name
 }
 
 proc makeDirectory {name} {
-    global tcl_platform testConfig
-    if {$tcl_platform(platform) == "macintosh"} {
-	catch {mkdir $name}
-    } else {
-	catch {exec mkdir $name}
-    }
+    file mkdir $name
 }
 
 proc removeDirectory {name} {
-    global tcl_platform testConfig
-    if {$tcl_platform(platform) == "macintosh"} {
-	catch {rmdir $name}
-    } else {
-	catch {exec rm -rf $name}
-    }
+    file delete -force $name
 }
 
 proc viewFile {name} {
@@ -345,4 +403,4 @@ if {$tcltest == "{}"} {
     puts "Unable to find tcltest executable, multiple process tests will fail."
 }
 
-
+    
diff --git a/contrib/tcl/tests/dstring.test b/contrib/tcl/tests/dstring.test
index 2ae157a..93a84d4 100644
--- a/contrib/tcl/tests/dstring.test
+++ b/contrib/tcl/tests/dstring.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) dstring.test 1.8 96/02/16 08:55:46
+# SCCS: @(#) dstring.test 1.10 96/10/08 17:40:02
 
 if {[info commands testdstring] == {}} {
     puts "This application hasn't been compiled with the \"testdstring\""
@@ -153,7 +153,7 @@ test dstring-3.4 {nested sublists} {
     testdstring element last
     testdstring get
 } {before {during more} last}
-test dstring-3.4 {nested sublists} {
+test dstring-3.5 {nested sublists} {
     testdstring free
     testdstring element "\{"
     testdstring start
@@ -183,6 +183,7 @@ test dstring-5.1 {copying to result} {
 } xyz
 test dstring-5.2 {copying to result} {
     testdstring free
+    catch {unset a}
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
diff --git a/contrib/tcl/tests/error.test b/contrib/tcl/tests/error.test
index 9adbe05..3421edc 100644
--- a/contrib/tcl/tests/error.test
+++ b/contrib/tcl/tests/error.test
@@ -5,12 +5,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# 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.
 #
-# SCCS: @(#) error.test 1.14 96/02/16 08:55:48
+# SCCS: @(#) error.test 1.18 96/11/07 18:36:09
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -42,9 +42,7 @@ test error-1.3 {simple errors from commands} {
     set errorInfo
 } {wrong # args: should be "string compare string1 string2"
     while executing
-"string compare"
-    invoked from within
-"format [string compare]..."}
+"format [string compare]"}
 
 test error-1.4 {simple errors from commands} {
     catch {error glorp} b
@@ -64,10 +62,6 @@ test error-1.7 {simple errors from commands} {
     set b
 } {wrong # args: should be "catch command ?varName?"}
 
-test error-2.1 {simple errors from commands} {
-    catch catch
-} 1
-
 # Check errors nested in procedures.  Also check the optional argument
 # to "error" to generate a new error trace.
 
@@ -86,7 +80,7 @@ test error-2.3 {errors in nested procedures} {
 } {Human-generated
     while executing
 "error {Human-generated}"
-    (procedure "foo" line 4)
+    (procedure "foo" line 1)
     invoked from within
 "foo"}
 
@@ -104,9 +98,7 @@ test error-2.6 {errors in nested procedures} {
     set errorInfo
 } {glorp2
     while executing
-"error glorp2"
-    invoked from within
-"format [error glorp2]..."
+"format [error glorp2]"
     (procedure "foo2" line 1)
     invoked from within
 "foo2"}
diff --git a/contrib/tcl/tests/eval.test b/contrib/tcl/tests/eval.test
index dcd2ea8..48ee9ce 100644
--- a/contrib/tcl/tests/eval.test
+++ b/contrib/tcl/tests/eval.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) eval.test 1.7 96/02/16 08:55:49
+# SCCS: @(#) eval.test 1.9 96/09/10 13:50:39
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -47,7 +47,7 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
 } "test error
     while executing
 \"error \"test error\"\"
-    (\"eval\" body line 3)
+    (\"eval\" body line 1)
     invoked from within
 \"eval {
 	set a 1
diff --git a/contrib/tcl/tests/event.test b/contrib/tcl/tests/event.test
index b48ee22..6741836 100644
--- a/contrib/tcl/tests/event.test
+++ b/contrib/tcl/tests/event.test
@@ -1,14 +1,14 @@
 # This file contains a collection of tests for the procedures in the file
-# tclEvent.c, which includes the "after", "update", and "vwait" Tcl
+# tclEvent.c, which includes the "update", and "vwait" Tcl
 # commands.  Sourcing this file into Tcl runs the tests and generates
 # output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# "@(#) event.test 1.20 96/04/09 15:54:05"
+# "@(#) event.test 1.27 97/06/23 18:21:18"
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -110,6 +110,7 @@ if {[catch {testfilehandler create 0 off off}] == 0 } {
     } {0 0}
 
     test event-4.1 {FileHandlerEventProc, race between event and disabling } {
+	update
 	testfilehandler close
 	testfilehandler create 2 disabled disabled
 	testfilehandler create 1 readable writable
@@ -128,6 +129,7 @@ if {[catch {testfilehandler create 0 off off}] == 0 } {
 	set result
     } {{0 1} {1 1} {1 2} {0 0}}
     test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off } {
+	update
 	testfilehandler close
 	testfilehandler create 1 readable writable
 	testfilehandler create 2 readable writable
@@ -145,147 +147,7 @@ if {[catch {testfilehandler create 0 off off}] == 0 } {
     update
 }
 
-test event-5.1 {Tcl_CreateTimerHandler procedure} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x ""
-    foreach i {100 200 1000 50 150} {
-	after $i lappend x $i
-    }
-    after 200
-    update
-    set x
-} {50 100 150 200}
-
-test event-6.1 {Tcl_DeleteTimerHandler procedure} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x ""
-    foreach i {100 200 300 50 150} {
-	after $i lappend x $i
-    }
-    after cancel lappend x 150
-    after cancel lappend x 50
-    after 200
-    update
-    set x
-} {100 200}
-
-if {[info commands testmodal] != ""} {
-    test event-7.1 {Tcl_CreateModalTimeout and Tcl_DeleteModalTimeout procedures} {
-	update
-	set x {}
-	set result {}
-	testmodal create 50 first
-	testmodal create 200 second
-	after 100
-	testmodal eventnotimers
-	lappend result $x
-	after 150
-	testmodal eventnotimers
-	lappend result $x
-	testmodal delete
-	testmodal eventnotimers
-	lappend result $x
-	testmodal eventnotimers
-	lappend result $x
-	testmodal delete
-	testmodal eventnotimers
-	lappend result $x
-    } {{} second {second first} {second first first} {second first first}}
-    
-    test event-8.1 {TimerHandlerSetupProc procedure, choosing correct timer} {
-	update
-	set x {}
-	after 100 {lappend x normal}
-	testmodal create 200 modal
-	vwait x
-	testmodal delete
-	set x
-    } {normal}
-    test event-8.2 {TimerHandlerSetupProc procedure, choosing correct timer} {
-	update
-	set x {}
-	after 200 {lappend x normal}
-	testmodal create 100 modal
-	vwait x
-	testmodal delete
-	set x
-    } {modal}
-}
-
-# No tests for TimerHandlerCheckProc:  it's already tested by other tests
-# above and below.
-
-test event-9.1 {TimerHandlerEventProc procedure} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    foreach i {100 200 300} {
-	after $i lappend x $i
-    }
-    after 100
-    set result ""
-    set x ""
-    update
-    lappend result $x
-    after 100
-    update
-    lappend result $x
-    after 100
-    update
-    lappend result $x
-} {100 {100 200} {100 200 300}}
-
-# No tests for Tcl_DoWhenIdle:  it's already tested by other tests
-# below.
-
-test event-10.1 {Tk_CancelIdleCall procedure} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x before
-    set y before
-    set z before
-    after idle set x after1
-    after idle set y after2
-    after idle set z after3
-    after cancel set y after2
-    update idletasks
-    concat $x $y $z
-} {after1 before after3}
-test event-10.2 {Tk_CancelIdleCall procedure} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x before
-    set y before
-    set z before
-    after idle set x after1
-    after idle set y after2
-    after idle set z after3
-    after cancel set x after1
-    update idletasks
-    concat $x $y $z
-} {before after2 after3}
-
-test event-11.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x 1
-    set y 23
-    after idle {incr x; after idle {incr x; after idle {incr x}}}
-    after idle {incr y}
-    vwait x
-    set result "$x $y"
-    update idletasks
-    lappend result $x
-} {2 24 4}
-
-test event-12.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
     catch {rename bgerror {}}
     proc bgerror msg {
 	global errorInfo errorCode x
@@ -305,7 +167,7 @@ test event-12.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
     while executing
 "open non_existent"
     ("after" script)} {POSIX ENOENT {no such file or directory}}}}
-test event-12.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
     catch {rename bgerror {}}
     proc bgerror msg {
 	global x
@@ -320,7 +182,7 @@ test event-12.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
     set x
 } {{a simple error}}
 
-test event-13.1 {BgErrorDeleteProc procedure} {
+test event-6.1 {BgErrorDeleteProc procedure} {
     catch {interp delete foo}
     interp create foo
     foo eval {
@@ -346,20 +208,20 @@ test event-13.1 {BgErrorDeleteProc procedure} {
 } {Unmodified
 }
 
-test event-14.1 {tkerror/bgerror backwards compabitility} {
+test event-7.1 {tkerror/bgerror backwards compabitility} {
     catch {rename bgerror {}}
     proc tkerror {x y} {
 	return [expr $x + $y]
     }
     list [tkerror 4 7] [bgerror 8 -3]
 } {11 5}
-test event-14.2 {tkerror/bgerror backwards compabitility} {
+test event-7.2 {tkerror/bgerror backwards compabitility} {
     proc bgerror {x y} {
 	return [expr 1 + $x + $y]
     }
     list [tkerror 6 -2] [bgerror 7 2]
 } {5 10}
-test event-14.3 {tkerror/bgerror backwards compabitility} {
+test event-7.3 {tkerror/bgerror backwards compabitility} {
     proc bgerror {x y} {
 	return [expr 1 + $x + $y]
     }
@@ -367,7 +229,7 @@ test event-14.3 {tkerror/bgerror backwards compabitility} {
     rename tkerror {}
     lappend result [info commands bgerror] [info commands tkerror]
 } {bgerror tkerror {} {}}
-test event-14.4 {tkerror/bgerror backwards compabitility} {
+test event-7.4 {tkerror/bgerror backwards compabitility} {
     proc tkerror {x y} {
 	return [expr 1 + $x + $y]
     }
@@ -375,14 +237,14 @@ test event-14.4 {tkerror/bgerror backwards compabitility} {
     rename bgerror {}
     lappend result [info commands bgerror] [info commands tkerror]
 } {bgerror tkerror {} {}}
-test event-14.5 {tkerror/bgerror backwards compabitility} {
+test event-7.5 {tkerror/bgerror backwards compabitility} {
     proc tkerror {x y} {
 	return [expr 1 + $x + $y]
     }
     rename tkerror foo
     list [info commands bgerror] [info commands tkerror] [foo 4 3]
 } {{} {} 8}
-test event-14.6 {tkerror/bgerror backwards compabitility} {
+test event-7.6 {tkerror/bgerror backwards compabitility} {
     proc bgerror {x y} {
 	return [expr 1 + $x + $y]
     }
@@ -390,26 +252,26 @@ test event-14.6 {tkerror/bgerror backwards compabitility} {
     rename bgerror foo
     list [info commands bgerror] [info commands tkerror] [foo 4 3]
 } {{} {} 8}
-test event-14.7 {tkerror/bgerror backwards compabitility} {
+test event-7.7 {tkerror/bgerror backwards compabitility} {
     proc foo args {return $args}
     catch {rename tkerror {}}
     rename foo tkerror
     list [info commands bgerror] [info commands tkerror] [info commands foo] [tkerror a b c d]
 } {bgerror tkerror {} {a b c d}}
-test event-14.8 {tkerror/bgerror backwards compabitility} {
+test event-7.8 {tkerror/bgerror backwards compabitility} {
     proc foo args {return $args}
     catch {rename bgerror {}}
     rename foo bgerror
     list [info commands bgerror] [info commands tkerror] [info commands foo] [tkerror a b c d]
 } {bgerror tkerror {} {a b c d}}
-test event-14.9 {tkerror/bgerror backwards compabitility} {
+test event-7.9 {tkerror/bgerror backwards compabitility} {
     proc bgerror args {return $args}
     list [catch {rename bgerror tkerror} msg] $msg
 } {1 {can't rename to "tkerror": command already exists}}
-rename bgerror {}
+catch {rename bgerror {}}
 
 if {[info commands testexithandler] != ""} {
-    test event-15.1 {Tcl_CreateExitHandler procedure} {unixOrPc} {
+    test event-8.1 {Tcl_CreateExitHandler procedure} {unixOrPc} {
 	set child [open |[list [info nameofexecutable]] r+]
 	puts $child "testexithandler create 41; testexithandler create 4"
 	puts $child "testexithandler create 6; exit"
@@ -422,7 +284,7 @@ even 4
 odd 41
 }
 
-    test event-16.1 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
+    test event-9.1 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
 	set child [open |[list [info nameofexecutable]] r+]
 	puts $child "testexithandler create 41; testexithandler create 4"
 	puts $child "testexithandler create 6; testexithandler delete 41"
@@ -435,7 +297,7 @@ odd 41
 even 6
 even 4
 }
-    test event-16.2 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
+    test event-9.2 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
 	set child [open |[list [info nameofexecutable]] r+]
 	puts $child "testexithandler create 41; testexithandler create 4"
 	puts $child "testexithandler create 6; testexithandler delete 4"
@@ -448,7 +310,7 @@ even 4
 even 6
 odd 41
 }
-    test event-16.3 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
+    test event-9.3 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
 	set child [open |[list [info nameofexecutable]] r+]
 	puts $child "testexithandler create 41; testexithandler create 4"
 	puts $child "testexithandler create 6; testexithandler delete 6"
@@ -461,7 +323,7 @@ odd 41
 even 4
 odd 41
 }
-    test event-16.4 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
+    test event-9.4 {Tcl_DeleteExitHandler procedure} {unixOrPc} {
 	set child [open |[list [info nameofexecutable]] r+]
 	puts $child "testexithandler create 41; testexithandler delete 41"
 	puts $child "testexithandler create 16; exit"
@@ -473,301 +335,25 @@ odd 41
 }
 }
 
-test event-17.1 {Tcl_Exit procedure} {unixOrPc} {
+test event-10.1 {Tcl_Exit procedure} {unixOrPc} {
     set child [open |[list [info nameofexecutable]] r+]
     puts $child "exit 3"
     list [catch {close $child} msg] $msg [lindex $errorCode 0] \
         [lindex $errorCode 2]
 } {1 {child process exited abnormally} CHILDSTATUS 3}
 
-test event-18.1 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after} msg] $msg
-} {1 {wrong # args: should be "after option ?arg arg ...?"}}
-test event-18.2 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after 2x} msg] $msg
-} {1 {expected integer but got "2x"}}
-test event-18.3 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after gorp} msg] $msg
-} {1 {bad argument "gorp": must be cancel, idle, info, or a number}}
-test event-18.4 {Tcl_AfterCmd procedure, ms argument} {
-    set x before
-    after 400 {set x after}
-    after 200
-    update
-    set y $x
-    after 400
-    update
-    list $y $x
-} {before after}
-test event-18.5 {Tcl_AfterCmd procedure, ms argument} {
-    set x before
-    after 300 set x after
-    after 200
-    update
-    set y $x
-    after 200
-    update
-    list $y $x
-} {before after}
-test event-18.6 {Tcl_AfterCmd procedure, cancel option} {
-    list [catch {after cancel} msg] $msg
-} {1 {wrong # args: should be "after cancel id|command"}}
-test event-18.7 {Tcl_AfterCmd procedure, cancel option} {
-    after cancel after#1
-} {}
-test event-18.8 {Tcl_AfterCmd procedure, cancel option} {
-    after cancel {foo bar}
-} {}
-test event-18.9 {Tcl_AfterCmd procedure, cancel option} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x before
-    set y [after 100 set x after]
-    after cancel $y
-    after 200
-    update
-    set x
-} {before}
-test event-18.10 {Tcl_AfterCmd procedure, cancel option} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x before
-    after 100 set x after
-    after cancel {set x after}
-    after 200
-    update
-    set x
-} {before}
-test event-18.11 {Tcl_AfterCmd procedure, cancel option} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x before
-    after 100 set x after
-    set id [after 300 set x after]
-    after cancel $id
-    after 200
-    update
-    set y $x
-    set x cleared
-    after 200
-    update
-    list $y $x
-} {after cleared}
-test event-18.12 {Tcl_AfterCmd procedure, cancel option} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x first
-    after idle lappend x second
-    after idle lappend x third
-    set i [after idle lappend x fourth]
-    after cancel {lappend x second}
-    after cancel $i
-    update idletasks
-    set x
-} {first third}
-test event-18.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set x first
-    after idle lappend x second
-    after idle lappend x third
-    set i [after idle lappend x fourth]
-    after cancel lappend x second
-    after cancel $i
-    update idletasks
-    set x
-} {first third}
-test event-18.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    set id [
-	after 100 {
-	    set x done
-	    after cancel $id
-	}
-    ]
-    vwait x
-} {}
-test event-18.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    interp create x
-    x eval {set a before; set b before; after idle {set a a-after};
-	    after idle {set b b-after}}
-    set result [llength [x eval after info]]
-    lappend result [llength [after info]]
-    after cancel {set b b-after}
-    set a aaa
-    set b bbb
-    x eval {after cancel set a a-after}
-    update idletasks
-    lappend result $a $b [x eval {list $a $b}]
-    interp delete x
-    set result
-} {2 0 aaa bbb {before b-after}}
-test event-18.16 {Tcl_AfterCmd procedure, idle option} {
-    list [catch {after idle} msg] $msg
-} {1 {wrong # args: should be "after idle script script ..."}}
-test event-18.17 {Tcl_AfterCmd procedure, idle option} {
-    set x before
-    after idle {set x after}
-    set y $x
-    update idletasks
-    list $y $x
-} {before after}
-test event-18.18 {Tcl_AfterCmd procedure, idle option} {
-    set x before
-    after idle set x after
-    set y $x
-    update idletasks
-    list $y $x
-} {before after}
-set event1 [after idle event 1]
-set event2 [after 1000 event 2]
-interp create x
-set childEvent [x eval {after idle event in child}]
-test event-18.19 {Tcl_AfterCmd, info option} {
-    lsort [after info]
-} "$event1 $event2"
-test event-18.20 {Tcl_AfterCmd, info option} {
-    list [catch {after info a b} msg] $msg
-} {1 {wrong # args: should be "after info ?id?"}}
-test event-18.21 {Tcl_AfterCmd, info option} {
-    list [catch {after info $childEvent} msg] $msg
-} "1 {event \"$childEvent\" doesn't exist}"
-test event-18.22 {Tcl_AfterCmd, info option} {
-    list [after info $event1] [after info $event2]
-} {{{event 1} idle} {{event 2} timer}}
-after cancel $event1
-after cancel $event2
-interp delete x
-
-set event [after idle foo bar]
-scan $event after#%d id
-test event-19.1 {GetAfterEvent procedure} {
-    list [catch {after info xfter#$id} msg] $msg
-} "1 {event \"xfter#$id\" doesn't exist}"
-test event-19.2 {GetAfterEvent procedure} {
-    list [catch {after info afterx$id} msg] $msg
-} "1 {event \"afterx$id\" doesn't exist}"
-test event-19.3 {GetAfterEvent procedure} {
-    list [catch {after info after#ab} msg] $msg
-} {1 {event "after#ab" doesn't exist}}
-test event-19.4 {GetAfterEvent procedure} {
-    list [catch {after info after#} msg] $msg
-} {1 {event "after#" doesn't exist}}
-test event-19.5 {GetAfterEvent procedure} {
-    list [catch {after info after#${id}x} msg] $msg
-} "1 {event \"after#${id}x\" doesn't exist}"
-test event-19.6 {GetAfterEvent procedure} {
-    list [catch {after info afterx[expr $id+1]} msg] $msg
-} "1 {event \"afterx[expr $id+1]\" doesn't exist}"
-after cancel $event
-
-test event-20.1 {AfterProc procedure} {
-    set x before
-    proc foo {} {
-	set x untouched
-	after 100 {set x after}
-	after 200
-	update
-	return $x
-    }
-    list [foo] $x
-} {untouched after}
-test event-20.2 {AfterProc procedure} {
-    catch {rename bgerror {}}
-    proc bgerror msg {
-	global x errorInfo
-	set x [list $msg $errorInfo]
-    }
-    set x empty
-    after 100 {error "After error"}
-    after 200
-    set y $x
-    update
-    catch {rename bgerror {}}
-    list $y $x
-} {empty {{After error} {After error
-    while executing
-"error "After error""
-    ("after" script)}}}
-test event-20.3 {AfterProc procedure, deleting handler from itself} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    proc foo {} {
-	global x
-	set x {}
-	foreach i [after info] {
-	    lappend x [after info $i]
-	}
-	after cancel foo
-    }
-    after idle foo
-    after 1000 {error "I shouldn't ever have executed"}
-    update idletasks
-    set x
-} {{{error "I shouldn't ever have executed"} timer}}
-test event-20.4 {AfterProc procedure, deleting handler from itself} {
-    foreach i [after info] {
-	after cancel $i
-    }
-    proc foo {} {
-	global x
-	set x {}
-	foreach i [after info] {
-	    lappend x [after info $i]
-	}
-	after cancel foo
-    }
-    after 1000 {error "I shouldn't ever have executed"}
-    after idle foo
-    update idletasks
-    set x
-} {{{error "I shouldn't ever have executed"} timer}}
-    foreach i [after info] {
-	after cancel $i
-    }
-
-test event-21.1 {AfterCleanupProc procedure} {
-    catch {interp delete x}
-    interp create x
-    x eval {after 200 {
-	lappend x after
-	puts "part 1: this message should not appear"
-    }}
-    after 200 {lappend x after2}
-    x eval {after 200 {
-	lappend x after3
-	puts "part 2: this message should not appear"
-    }}
-    after 200 {lappend x after4}
-    x eval {after 200 {
-	lappend x after5
-	puts "part 3: this message should not appear"
-    }}
-    interp delete x
-    set x before
-    after 300
-    update
-    set x
-} {before after2 after4}
-
-test event-22.1 {Tcl_VwaitCmd procedure} {
+test event-11.1 {Tcl_VwaitCmd procedure} {
     list [catch {vwait} msg] $msg
 } {1 {wrong # args: should be "vwait name"}}
-test event-22.2 {Tcl_VwaitCmd procedure} {
+test event-11.2 {Tcl_VwaitCmd procedure} {
     list [catch {vwait a b} msg] $msg
 } {1 {wrong # args: should be "vwait name"}}
-test event-22.3 {Tcl_VwaitCmd procedure} {
+test event-11.3 {Tcl_VwaitCmd procedure} {
+    catch {unset x}
+    set x 1
+    list [catch {vwait x(1)} msg] $msg
+} {1 {can't trace "x(1)": variable isn't array}}
+test event-11.4 {Tcl_VwaitCmd procedure} {
     foreach i [after info] {
 	after cancel $i
     }
@@ -782,13 +368,57 @@ test event-22.3 {Tcl_VwaitCmd procedure} {
     list [vwait y] $x $y $z $q
 } {{} x-done y-done before q-done}
 
-test event-23.1 {Tcl_UpdateCmd procedure} {
+foreach i [after info] {
+    after cancel $i
+}
+
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {
+    set f1 [open test1 w]
+    proc accept {s args} {
+	puts $s foobar
+	close $s
+    }
+    set s1 [socket -server accept 5000]
+    set s2 [socket 127.0.0.1 5000]
+    close $s1
+    set x 0
+    set y 0
+    set z 0
+    fileevent $s2 readable { incr z }
+    vwait z
+    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
+    fileevent $s2 readable { incr y; if { $x == 3 } { set z done } }
+    vwait z
+    close $f1
+    close $s2
+    file delete test1 test2
+    list $x $y $z
+} {3 3 done}
+test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
+    file delete test1 test2
+    set f1 [open test1 w]
+    set f2 [open test2 w]
+    set x 0
+    set y 0
+    set z 0
+    update
+    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
+    fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
+    vwait z
+    close $f1
+    close $f2
+    file delete test1 test2
+    list $x $y $z
+} {3 3 done}
+
+
+test event-12.1 {Tcl_UpdateCmd procedure} {
     list [catch {update a b} msg] $msg
 } {1 {wrong # args: should be "update ?idletasks?"}}
-test event-23.2 {Tcl_UpdateCmd procedure} {
+test event-12.2 {Tcl_UpdateCmd procedure} {
     list [catch {update bogus} msg] $msg
 } {1 {bad option "bogus": must be idletasks}}
-test event-23.3 {Tcl_UpdateCmd procedure} {
+test event-12.3 {Tcl_UpdateCmd procedure} {
     foreach i [after info] {
 	after cancel $i
     }
@@ -801,7 +431,7 @@ test event-23.3 {Tcl_UpdateCmd procedure} {
     update idletasks
     list $x $y $z
 } {before after {after, y = after}}
-test event-23.4 {Tcl_UpdateCmd procedure} {
+test event-12.4 {Tcl_UpdateCmd procedure} {
     foreach i [after info] {
 	after cancel $i
     }
@@ -817,7 +447,7 @@ test event-23.4 {Tcl_UpdateCmd procedure} {
 } {x-done before z-done}
 
 if {[info commands testfilehandler] != ""} {
-    test event-24.1 {Tcl_WaitForFile procedure, readable} unixOnly {
+    test event-13.1 {Tcl_WaitForFile procedure, readable} unixOnly {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -830,7 +460,7 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	list $result $x
     } {{} {no timeout}}
-    test event-24.2 {Tcl_WaitForFile procedure, readable} unixOnly {
+    test event-13.2 {Tcl_WaitForFile procedure, readable} unixOnly {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -843,7 +473,7 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	list $result $x
     } {{} timeout}
-    test event-24.3 {Tcl_WaitForFile procedure, readable} unixOnly {
+    test event-13.3 {Tcl_WaitForFile procedure, readable} unixOnly {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -857,7 +487,7 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	list $result $x
     } {readable {no timeout}}
-    test event-24.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
+    test event-13.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -871,7 +501,7 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	list $result $x
     } {{} {no timeout}}
-    test event-24.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
+    test event-13.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -885,7 +515,7 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	list $result $x
     } {{} timeout}
-    test event-24.6 {Tcl_WaitForFile procedure, writable} unixOnly {
+    test event-13.6 {Tcl_WaitForFile procedure, writable} unixOnly {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -898,7 +528,7 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	list $result $x
     } {writable {no timeout}}
-    test event-24.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly {
+    test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly {
 	foreach i [after info] {
 	    after cancel $i
 	}
@@ -912,7 +542,10 @@ if {[info commands testfilehandler] != ""} {
 	testfilehandler close
 	lappend result $x
     } {{} {} {timeout idle}}
-    test event-24.8 {Tcl_WaitForFile procedure, waiting indefinitely} unixOnly {
+}
+
+if {[info commands testfilewait] != ""} {
+    test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} unixOnly {
 	set f [open "|sleep 2" r]
 	set result ""
 	lappend result [testfilewait $f readable 100]
diff --git a/contrib/tcl/tests/exec.test b/contrib/tcl/tests/exec.test
index 75dd359..4b00c44 100644
--- a/contrib/tcl/tests/exec.test
+++ b/contrib/tcl/tests/exec.test
@@ -5,12 +5,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) exec.test 1.53 96/04/12 16:33:37
+# SCCS: @(#) exec.test 1.56 97/06/20 13:27:37
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -21,16 +21,11 @@ if {[info commands exec] == ""} {
     return
 }
 
-# This procedure generates a shell command to be passed to exec
-# to mask the differences between Unix and PC shells.
-
-proc shellCmd {string} {
-    global tcl_platform
-    if {$tcl_platform(platform) == "unix"} {
-	return "sh -c \"$string\""
-    } else {
-	return "sh -c {\"$string\"}"
-    }
+proc cat {name} {
+    set f [open $name r]
+    set x [read -nonewline $f]
+    close $f
+    set x
 }
 
 # Basic operations.
@@ -118,12 +113,12 @@ test exec-4.1 {redirecting output and stderr to file} {unixExecs} {
     exec cat gorp.file
 } "test output"
 test exec-4.2 {redirecting output and stderr to file} {unixExecs} {
-    list [eval exec [shellCmd "echo foo bar 1>&2"] >&gorp.file] \
+    list [exec sh -c "echo foo bar 1>&2" >&gorp.file] \
 	    [exec cat gorp.file]
 } {{} {foo bar}}
 test exec-4.3 {redirecting output and stderr to file} {unixExecs} {
     exec echo "first line" > gorp.file
-    list [eval exec [shellCmd "echo foo bar 1>&2"] >>&gorp.file] \
+    list [exec sh -c "echo foo bar 1>&2" >>&gorp.file] \
 	    [exec cat gorp.file]
 } "{} {first line\nfoo bar}"
 test exec-4.4 {redirecting output and stderr to file} {unixExecs} {
@@ -140,8 +135,8 @@ test exec-4.5 {redirecting output and stderr to file} {unixExecs} {
     set f [open gorp.file w]
     puts $f "Line 1"
     flush $f
-    eval exec >&@ $f [shellCmd "echo foo bar 1>&2"]
-    eval exec >&@$f [shellCmd "echo xyzzy 1>&2"]
+    exec >&@ $f sh -c "echo foo bar 1>&2"
+    exec >&@$f sh -c "echo xyzzy 1>&2"
     puts $f "Line 3"
     close $f
     exec cat gorp.file
@@ -181,14 +176,14 @@ test exec-5.7 {redirecting input from file} {unixExecs} {
 # I/O redirection: standard error through a pipeline.
 
 test exec-6.1 {redirecting stderr through a pipeline} {unixExecs} {
-    eval exec [shellCmd "echo foo bar"] |& cat
+    exec sh -c "echo foo bar" |& cat
 } "foo bar"
 test exec-6.2 {redirecting stderr through a pipeline} {unixExecs} {
-    eval exec [shellCmd "echo foo bar 1>&2"] |& cat
+    exec sh -c "echo foo bar 1>&2" |& cat
 } "foo bar"
 test exec-6.3 {redirecting stderr through a pipeline} {unixExecs} {
-    eval exec [shellCmd "echo foo bar 1>&2"] \
-	|& [shellCmd "echo second msg 1>&2; cat"] |& cat
+    exec sh -c "echo foo bar 1>&2" \
+	|& sh -c "echo second msg 1>&2; cat" |& cat
 } "second msg\nfoo bar"
 
 # I/O redirection: combinations.
@@ -223,21 +218,21 @@ test exec-9.2 {commands returning errors} {unixExecs} {
     string tolower [list [catch {exec echo foo | foo123} msg] $msg $errorCode]
 } {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
 test exec-9.3 {commands returning errors} {unixExecs} {
-    list [catch {eval exec sleep 1 | [shellCmd "exit 43"] | sleep 1} msg] $msg
+    list [catch {exec sleep 1 | sh -c "exit 43" | sleep 1} msg] $msg
 } {1 {child process exited abnormally}}
 test exec-9.4 {commands returning errors} {unixExecs} {
-    list [catch {eval exec [shellCmd "exit 43"] | echo "foo bar"} msg] $msg
+    list [catch {exec sh -c "exit 43" | echo "foo bar"} msg] $msg
 } {1 {foo bar
 child process exited abnormally}}
 test exec-9.5 {commands returning errors} {unixExecs} {
     list [catch {exec gorp456 | echo a b c} msg] [string tolower $msg]
 } {1 {couldn't execute "gorp456": no such file or directory}}
 test exec-9.6 {commands returning errors} {unixExecs} {
-    list [catch {eval exec [shellCmd "echo error msg 1>&2"]} msg] $msg
+    list [catch {exec sh -c "echo error msg 1>&2"} msg] $msg
 } {1 {error msg}}
 test exec-9.7 {commands returning errors} {unixExecs} {
-    list [catch {eval exec [shellCmd "echo error msg 1>&2"] \
-		     | [shellCmd "echo error msg 1>&2"]} msg] $msg
+    list [catch {exec sh -c "echo error msg 1>&2" \
+		     | sh -c "echo error msg 1>&2"} msg] $msg
 } {1 {error msg
 error msg}}
 
@@ -408,16 +403,16 @@ test exec-14.4 {-- switch} {
 
 test exec-15.1 {standard error redirection} {unixExecs} {
     exec echo "First line" > gorp.file
-    list [eval exec [shellCmd "echo foo bar 1>&2"] 2> gorp.file] \
+    list [exec sh -c "echo foo bar 1>&2" 2> gorp.file] \
 	    [exec cat gorp.file]
 } {{} {foo bar}}
 test exec-15.2 {standard error redirection} {unixExecs} {
-    list [eval exec [shellCmd "echo foo bar 1>&2"] | echo biz baz >gorp.file \
+    list [exec sh -c "echo foo bar 1>&2" | echo biz baz >gorp.file \
 	    2> gorp.file2] [exec cat gorp.file] \
 	    [exec cat gorp.file2]
 } {{} {biz baz} {foo bar}}
 test exec-15.3 {standard error redirection} {unixExecs} {
-    list [eval exec [shellCmd "echo foo bar 1>&2"] | echo biz baz 2>gorp.file \
+    list [exec sh -c "echo foo bar 1>&2" | echo biz baz 2>gorp.file \
 	    > gorp.file2] [exec cat gorp.file] \
 	    [exec cat gorp.file2]
 } {{} {foo bar} {biz baz}}
@@ -425,7 +420,7 @@ test exec-15.4 {standard error redirection} {unixExecs} {
     set f [open gorp.file w]
     puts $f "Line 1"
     flush $f
-    eval exec [shellCmd "echo foo bar 1>&2"] 2>@ $f
+    exec sh -c "echo foo bar 1>&2" 2>@ $f
     puts $f "Line 3"
     close $f
     exec cat gorp.file
@@ -434,12 +429,12 @@ foo bar
 Line 3}
 test exec-15.5 {standard error redirection} {unixExecs} {
     exec echo "First line" > gorp.file
-    eval exec [shellCmd "echo foo bar 1>&2"] 2>> gorp.file
+    exec sh -c "echo foo bar 1>&2" 2>> gorp.file
     exec cat gorp.file
 } {First line
 foo bar}
 test exec-15.6 {standard error redirection} {unixExecs} {
-    eval exec [shellCmd "echo foo bar 1>&2"] > gorp.file2 2> gorp.file \
+    exec sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \
 	    >& gorp.file 2> gorp.file2 | echo biz baz
     list [exec cat gorp.file] [exec cat gorp.file2]
 } {{biz baz} {foo bar}}
@@ -454,13 +449,13 @@ test exec-16.1 {flush output before exec} {unixExecs} {
 } {First line
 Second line
 Third line}
-test exec-16.2 {flush output before exec} {unixExecs} {
+test exec-16.2 {flush output before exec} {} {
     set f [open gorp.file w]
     puts $f "First line"
-    eval exec [shellCmd "echo Second line 1>&2"] >&@ $f > gorp.file2
+    exec [lindex $tcltest 0] << {puts stderr {Second line}} >&@ $f > gorp.file2
     puts $f "Third line"
     close $f
-    exec cat gorp.file
+    cat gorp.file
 } {First line
 Second line
 Third line}
diff --git a/contrib/tcl/tests/execute.test b/contrib/tcl/tests/execute.test
new file mode 100644
index 0000000..6c63750
--- /dev/null
+++ b/contrib/tcl/tests/execute.test
@@ -0,0 +1,113 @@
+# This file contains tests for the tclExecute.c source file. Tests appear
+# in the same order as the C code that they test. The set of tests is
+# currently incomplete since it currently includes only new tests for
+# code changed for the addition of Tcl namespaces. Other execution-
+# related tests appear in several other test files including
+# namespace.test, basic.test, eval.test, for.test, etc.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) execute.test 1.3 97/06/20 14:51:19
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename foo ""}
+catch {unset x}
+catch {unset y}
+catch {unset msg}
+
+test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {unset x}
+    catch {unset y}
+    namespace eval test_ns_1 {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_1::test_ns_2 {
+        namespace import ::test_ns_1::*
+    }
+    set x "test_ns_1::"
+    set y "test_ns_2::"
+    list [namespace which -command ${x}${y}cmd1] \
+         [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
+         [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
+} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
+test execute-1.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename foo ""}
+    catch {unset l}
+    proc foo {} {
+        return "global foo"
+    }
+    namespace eval test_ns_1 {
+        proc whichFoo {} {
+            return [namespace which -command foo]
+        }
+    }
+    set l ""
+    lappend l [test_ns_1::whichFoo]
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return "namespace foo"
+        }
+    }
+    lappend l [test_ns_1::whichFoo]
+    set l
+} {::foo ::test_ns_1::foo}
+test execute-1.3 {Tcl_GetCommandFromObj, command never found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename foo ""}
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return "namespace foo"
+        }
+    }
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return "namespace foo"
+        }
+    }
+    list [namespace eval test_ns_1 {namespace which -command foo}] \
+         [rename test_ns_1::foo ""] \
+         [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
+} {::test_ns_1::foo {} 0 {}}
+
+test execute-2.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {unset l}
+    proc {} {} {return {}}
+    {}
+    set l {}
+    lindex {} 0
+    {}
+} {}
+
+test execute-3.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
+    proc {} {} {}
+    proc { } {} {}
+    proc p {} {
+        set x {}
+        $x
+        append x { }
+        $x
+    }
+    p
+} {}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename foo ""}
+catch {rename p ""}
+catch {rename {} ""}
+catch {rename { } ""}
+catch {unset x}
+catch {unset y}
+catch {unset msg}
diff --git a/contrib/tcl/tests/expr-old.test b/contrib/tcl/tests/expr-old.test
new file mode 100644
index 0000000..e25a1eb
--- /dev/null
+++ b/contrib/tcl/tests/expr-old.test
@@ -0,0 +1,904 @@
+# Commands covered: expr
+#
+# This file contains the original set of tests for Tcl's expr command.
+# Since the expr command is now compiled, a new set of tests covering
+# the new implementation is in the file "expr.test". Sourcing this file
+# into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 1991-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) expr-old.test 1.59 97/06/26 14:33:32
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+    set gotT1 0
+    puts "This application hasn't been compiled with the \"T1\" and"
+    puts "\"T2\" math functions, so I'll skip some of the expr tests."
+} else {
+    set gotT1 1
+}
+
+# First, test all of the integer operators individually.
+
+test expr-old-1.1 {integer operators} {expr -4} -4
+test expr-old-1.2 {integer operators} {expr -(1+4)} -5
+test expr-old-1.3 {integer operators} {expr ~3} -4
+test expr-old-1.4 {integer operators} {expr !2} 0
+test expr-old-1.5 {integer operators} {expr !0} 1
+test expr-old-1.6 {integer operators} {expr 4*6} 24
+test expr-old-1.7 {integer operators} {expr 36/12} 3
+test expr-old-1.8 {integer operators} {expr 27/4} 6
+test expr-old-1.9 {integer operators} {expr 27%4} 3
+test expr-old-1.10 {integer operators} {expr 2+2} 4
+test expr-old-1.11 {integer operators} {expr 2-6} -4
+test expr-old-1.12 {integer operators} {expr 1<<3} 8
+test expr-old-1.13 {integer operators} {expr 0xff>>2} 63
+test expr-old-1.14 {integer operators} {expr -1>>2} -1
+test expr-old-1.15 {integer operators} {expr 3>2} 1
+test expr-old-1.16 {integer operators} {expr 2>2} 0
+test expr-old-1.17 {integer operators} {expr 1>2} 0
+test expr-old-1.18 {integer operators} {expr 3<2} 0
+test expr-old-1.19 {integer operators} {expr 2<2} 0
+test expr-old-1.20 {integer operators} {expr 1<2} 1
+test expr-old-1.21 {integer operators} {expr 3>=2} 1
+test expr-old-1.22 {integer operators} {expr 2>=2} 1
+test expr-old-1.23 {integer operators} {expr 1>=2} 0
+test expr-old-1.24 {integer operators} {expr 3<=2} 0
+test expr-old-1.25 {integer operators} {expr 2<=2} 1
+test expr-old-1.26 {integer operators} {expr 1<=2} 1
+test expr-old-1.27 {integer operators} {expr 3==2} 0
+test expr-old-1.28 {integer operators} {expr 2==2} 1
+test expr-old-1.29 {integer operators} {expr 3!=2} 1
+test expr-old-1.30 {integer operators} {expr 2!=2} 0
+test expr-old-1.31 {integer operators} {expr 7&0x13} 3
+test expr-old-1.32 {integer operators} {expr 7^0x13} 20
+test expr-old-1.33 {integer operators} {expr 7|0x13} 23
+test expr-old-1.34 {integer operators} {expr 0&&1} 0
+test expr-old-1.35 {integer operators} {expr 0&&0} 0
+test expr-old-1.36 {integer operators} {expr 1&&3} 1
+test expr-old-1.37 {integer operators} {expr 0||1} 1
+test expr-old-1.38 {integer operators} {expr 3||0} 1
+test expr-old-1.39 {integer operators} {expr 0||0} 0
+test expr-old-1.40 {integer operators} {expr 3>2?44:66} 44
+test expr-old-1.41 {integer operators} {expr 2>3?44:66} 66
+test expr-old-1.42 {integer operators} {expr 36/5} 7
+test expr-old-1.43 {integer operators} {expr 36%5} 1
+test expr-old-1.44 {integer operators} {expr -36/5} -8
+test expr-old-1.45 {integer operators} {expr -36%5} 4
+test expr-old-1.46 {integer operators} {expr 36/-5} -8
+test expr-old-1.47 {integer operators} {expr 36%-5} -4
+test expr-old-1.48 {integer operators} {expr -36/-5} 7
+test expr-old-1.49 {integer operators} {expr -36%-5} -1
+test expr-old-1.50 {integer operators} {expr +36} 36
+test expr-old-1.51 {integer operators} {expr +--++36} 36
+test expr-old-1.52 {integer operators} {expr +36%+5} 1
+
+# Check the floating-point operators individually, along with
+# automatic conversion to integers where needed.
+
+test expr-old-2.1 {floating-point operators} {format %.6g [expr -4.2]} -4.2
+test expr-old-2.2 {floating-point operators} {
+    format %.6g [expr -(1.1+4.2)]
+} -5.3
+test expr-old-2.3 {floating-point operators} {expr +5.7} 5.7
+test expr-old-2.4 {floating-point operators} {expr +--+-62.0} -62.0
+test expr-old-2.5 {floating-point operators} {expr !2.1} 0
+test expr-old-2.6 {floating-point operators} {expr !0.0} 1
+test expr-old-2.7 {floating-point operators} {format %.6g [expr 4.2*6.3]} 26.46
+test expr-old-2.8 {floating-point operators} {expr 36.0/12.0} 3.0
+test expr-old-2.9 {floating-point operators} {expr 27/4.0} 6.75
+test expr-old-2.10 {floating-point operators} {format %.6g [expr 2.3+2.1]} 4.4
+test expr-old-2.11 {floating-point operators} {format %.6g [expr 2.3-6.5]} -4.2
+test expr-old-2.12 {floating-point operators} {expr 3.1>2.1} 1
+test expr-old-2.13 {floating-point operators} {expr {2.1 > 2.1}} 0
+test expr-old-2.14 {floating-point operators} {expr 1.23>2.34e+1} 0
+test expr-old-2.15 {floating-point operators} {expr 3.45<2.34} 0
+test expr-old-2.16 {floating-point operators} {expr 0.002e3<--200e-2} 0
+test expr-old-2.17 {floating-point operators} {expr 1.1<2.1} 1
+test expr-old-2.18 {floating-point operators} {expr 3.1>=2.2} 1
+test expr-old-2.19 {floating-point operators} {expr 2.345>=2.345} 1
+test expr-old-2.20 {floating-point operators} {expr 1.1>=2.2} 0
+test expr-old-2.21 {floating-point operators} {expr 3.0<=2.0} 0
+test expr-old-2.22 {floating-point operators} {expr 2.2<=2.2} 1
+test expr-old-2.23 {floating-point operators} {expr 2.2<=2.2001} 1
+test expr-old-2.24 {floating-point operators} {expr 3.2==2.2} 0
+test expr-old-2.25 {floating-point operators} {expr 2.2==2.2} 1
+test expr-old-2.26 {floating-point operators} {expr 3.2!=2.2} 1
+test expr-old-2.27 {floating-point operators} {expr 2.2!=2.2} 0
+test expr-old-2.28 {floating-point operators} {expr 0.0&&0.0} 0
+test expr-old-2.29 {floating-point operators} {expr 0.0&&1.3} 0
+test expr-old-2.30 {floating-point operators} {expr 1.3&&0.0} 0
+test expr-old-2.31 {floating-point operators} {expr 1.3&&3.3} 1
+test expr-old-2.32 {floating-point operators} {expr 0.0||0.0} 0
+test expr-old-2.33 {floating-point operators} {expr 0.0||1.3} 1
+test expr-old-2.34 {floating-point operators} {expr 1.3||0.0} 1
+test expr-old-2.35 {floating-point operators} {expr 3.3||0.0} 1
+test expr-old-2.36 {floating-point operators} {
+    format %.6g [expr 3.3>2.3?44.3:66.3]} 44.3
+test expr-old-2.37 {floating-point operators} {
+    format %.6g [expr 2.3>3.3?44.3:66.3]} 66.3
+test expr-old-2.38 {floating-point operators} {
+    list [catch {format %.6g [expr 028.1 + 09.2]} msg] $msg
+} {0 37.3}
+
+# Operators that aren't legal on floating-point numbers
+
+test expr-old-3.1 {illegal floating-point operations} {
+    list [catch {expr ~4.0} msg] $msg
+} {1 {can't use floating-point value as operand of "~"}}
+test expr-old-3.2 {illegal floating-point operations} {
+    list [catch {expr 27%4.0} msg] $msg
+} {1 {can't use floating-point value as operand of "%"}}
+test expr-old-3.3 {illegal floating-point operations} {
+    list [catch {expr 27.0%4} msg] $msg
+} {1 {can't use floating-point value as operand of "%"}}
+test expr-old-3.4 {illegal floating-point operations} {
+    list [catch {expr 1.0<<3} msg] $msg
+} {1 {can't use floating-point value as operand of "<<"}}
+test expr-old-3.5 {illegal floating-point operations} {
+    list [catch {expr 3<<1.0} msg] $msg
+} {1 {can't use floating-point value as operand of "<<"}}
+test expr-old-3.6 {illegal floating-point operations} {
+    list [catch {expr 24.0>>3} msg] $msg
+} {1 {can't use floating-point value as operand of ">>"}}
+test expr-old-3.7 {illegal floating-point operations} {
+    list [catch {expr 24>>3.0} msg] $msg
+} {1 {can't use floating-point value as operand of ">>"}}
+test expr-old-3.8 {illegal floating-point operations} {
+    list [catch {expr 24&3.0} msg] $msg
+} {1 {can't use floating-point value as operand of "&"}}
+test expr-old-3.9 {illegal floating-point operations} {
+    list [catch {expr 24.0|3} msg] $msg
+} {1 {can't use floating-point value as operand of "|"}}
+test expr-old-3.10 {illegal floating-point operations} {
+    list [catch {expr 24.0^3} msg] $msg
+} {1 {can't use floating-point value as operand of "^"}}
+
+# Check the string operators individually.
+
+test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0
+test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0
+test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1
+test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1
+test expr-old-4.5 {string operators} {expr {"abd" < "abd"}} 0
+test expr-old-4.6 {string operators} {expr {"abe" < "abd"}} 0
+test expr-old-4.7 {string operators} {expr {"abc" >= "def"}} 0
+test expr-old-4.8 {string operators} {expr {"def" >= "def"}} 1
+test expr-old-4.9 {string operators} {expr {"g" >= "def"}} 1
+test expr-old-4.10 {string operators} {expr {"abc" <= "abd"}} 1
+test expr-old-4.11 {string operators} {expr {"abd" <= "abd"}} 1
+test expr-old-4.12 {string operators} {expr {"abe" <= "abd"}} 0
+test expr-old-4.13 {string operators} {expr {"abc" == "abd"}} 0
+test expr-old-4.14 {string operators} {expr {"abd" == "abd"}} 1
+test expr-old-4.15 {string operators} {expr {"abc" != "abd"}} 1
+test expr-old-4.16 {string operators} {expr {"abd" != "abd"}} 0
+test expr-old-4.17 {string operators} {expr {"0y" < "0x12"}} 0
+test expr-old-4.18 {string operators} {expr {"." < " "}} 0
+
+# The following tests are non-portable because on some systems "+"
+# and "-" can be parsed as numbers.
+
+test expr-old-4.19 {string operators} {nonPortable} {expr {"0" == "+"}} 0
+test expr-old-4.20 {string operators} {nonPortable} {expr {"0" == "-"}} 0
+test expr-old-4.21 {string operators} {expr {1?"foo":"bar"}} foo
+test expr-old-4.22 {string operators} {expr {0?"foo":"bar"}} bar
+
+# Operators that aren't legal on string operands.
+
+test expr-old-5.1 {illegal string operations} {
+    list [catch {expr {-"a"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+test expr-old-5.2 {illegal string operations} {
+    list [catch {expr {+"a"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-5.3 {illegal string operations} {
+    list [catch {expr {~"a"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "~"}}
+test expr-old-5.4 {illegal string operations} {
+    list [catch {expr {!"a"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "!"}}
+test expr-old-5.5 {illegal string operations} {
+    list [catch {expr {"a"*"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "*"}}
+test expr-old-5.6 {illegal string operations} {
+    list [catch {expr {"a"/"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "/"}}
+test expr-old-5.7 {illegal string operations} {
+    list [catch {expr {"a"%"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "%"}}
+test expr-old-5.8 {illegal string operations} {
+    list [catch {expr {"a"+"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-5.9 {illegal string operations} {
+    list [catch {expr {"a"-"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+test expr-old-5.10 {illegal string operations} {
+    list [catch {expr {"a"<<"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "<<"}}
+test expr-old-5.11 {illegal string operations} {
+    list [catch {expr {"a">>"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of ">>"}}
+test expr-old-5.12 {illegal string operations} {
+    list [catch {expr {"a"&"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "&"}}
+test expr-old-5.13 {illegal string operations} {
+    list [catch {expr {"a"^"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "^"}}
+test expr-old-5.14 {illegal string operations} {
+    list [catch {expr {"a"|"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "|"}}
+test expr-old-5.15 {illegal string operations} {
+    list [catch {expr {"a"&&"b"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-old-5.16 {illegal string operations} {
+    list [catch {expr {"a"||"b"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-old-5.17 {illegal string operations} {
+    list [catch {expr {"a"?4:2}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+
+# Check precedence pairwise.
+
+test expr-old-6.1 {precedence checks} {expr -~3} 4
+test expr-old-6.2 {precedence checks} {expr -!3} 0
+test expr-old-6.3 {precedence checks} {expr -~0} 1
+
+test expr-old-7.1 {precedence checks} {expr 2*4/6} 1
+test expr-old-7.2 {precedence checks} {expr 24/6*3} 12
+test expr-old-7.3 {precedence checks} {expr 24/6/2} 2
+
+test expr-old-8.1 {precedence checks} {expr -2+4} 2
+test expr-old-8.2 {precedence checks} {expr -2-4} -6
+test expr-old-8.3 {precedence checks} {expr +2-4} -2
+
+test expr-old-9.1 {precedence checks} {expr 2*3+4} 10
+test expr-old-9.2 {precedence checks} {expr 8/2+4} 8
+test expr-old-9.3 {precedence checks} {expr 8%3+4} 6
+test expr-old-9.4 {precedence checks} {expr 2*3-1} 5
+test expr-old-9.5 {precedence checks} {expr 8/2-1} 3
+test expr-old-9.6 {precedence checks} {expr 8%3-1} 1
+
+test expr-old-10.1 {precedence checks} {expr 6-3-2} 1
+
+test expr-old-11.1 {precedence checks} {expr 7+1>>2} 2
+test expr-old-11.2 {precedence checks} {expr 7+1<<2} 32
+test expr-old-11.3 {precedence checks} {expr 7>>3-2} 3
+test expr-old-11.4 {precedence checks} {expr 7<<3-2} 14
+
+test expr-old-12.1 {precedence checks} {expr 6>>1>4} 0
+test expr-old-12.2 {precedence checks} {expr 6>>1<2} 0
+test expr-old-12.3 {precedence checks} {expr 6>>1>=3} 1
+test expr-old-12.4 {precedence checks} {expr 6>>1<=2} 0
+test expr-old-12.5 {precedence checks} {expr 6<<1>5} 1
+test expr-old-12.6 {precedence checks} {expr 6<<1<5} 0
+test expr-old-12.7 {precedence checks} {expr 5<=6<<1} 1
+test expr-old-12.8 {precedence checks} {expr 5>=6<<1} 0
+
+test expr-old-13.1 {precedence checks} {expr 2<3<4} 1
+test expr-old-13.2 {precedence checks} {expr 0<4>2} 0
+test expr-old-13.3 {precedence checks} {expr 4>2<1} 0
+test expr-old-13.4 {precedence checks} {expr 4>3>2} 0
+test expr-old-13.5 {precedence checks} {expr 4>3>=2} 0
+test expr-old-13.6 {precedence checks} {expr 4>=3>2} 0
+test expr-old-13.7 {precedence checks} {expr 4>=3>=2} 0
+test expr-old-13.8 {precedence checks} {expr 0<=4>=2} 0
+test expr-old-13.9 {precedence checks} {expr 4>=2<=0} 0
+test expr-old-13.10 {precedence checks} {expr 2<=3<=4} 1
+
+test expr-old-14.1 {precedence checks} {expr 1==4>3} 1
+test expr-old-14.2 {precedence checks} {expr 0!=4>3} 1
+test expr-old-14.3 {precedence checks} {expr 1==3<4} 1
+test expr-old-14.4 {precedence checks} {expr 0!=3<4} 1
+test expr-old-14.5 {precedence checks} {expr 1==4>=3} 1
+test expr-old-14.6 {precedence checks} {expr 0!=4>=3} 1
+test expr-old-14.7 {precedence checks} {expr 1==3<=4} 1
+test expr-old-14.8 {precedence checks} {expr 0!=3<=4} 1
+
+test expr-old-15.1 {precedence checks} {expr 1==3==3} 0
+test expr-old-15.2 {precedence checks} {expr 3==3!=2} 1
+test expr-old-15.3 {precedence checks} {expr 2!=3==3} 0
+test expr-old-15.4 {precedence checks} {expr 2!=1!=1} 0
+
+test expr-old-16.1 {precedence checks} {expr 2&3==2} 0
+test expr-old-16.2 {precedence checks} {expr 1&3!=3} 0
+
+test expr-old-17.1 {precedence checks} {expr 7&3^0x10} 19
+test expr-old-17.2 {precedence checks} {expr 7^0x10&3} 7
+
+test expr-old-18.1 {precedence checks} {expr 7^0x10|3} 23
+test expr-old-18.2 {precedence checks} {expr 7|0x10^3} 23
+
+test expr-old-19.1 {precedence checks} {expr 7|3&&1} 1
+test expr-old-19.2 {precedence checks} {expr 1&&3|7} 1
+test expr-old-19.3 {precedence checks} {expr 0&&1||1} 1
+test expr-old-19.4 {precedence checks} {expr 1||1&&0} 1
+
+test expr-old-20.1 {precedence checks} {expr 1||0?3:4} 3
+test expr-old-20.2 {precedence checks} {expr 1?0:4||1} 0
+test expr-old-20.3 {precedence checks} {expr 1?2:0?3:4} 2
+test expr-old-20.4 {precedence checks} {expr 0?2:0?3:4} 4
+test expr-old-20.5 {precedence checks} {expr 1?2?3:4:0} 3
+test expr-old-20.6 {precedence checks} {expr 0?2?3:4:0} 0
+
+# Parentheses.
+
+test expr-old-21.1 {parenthesization} {expr (2+4)*6} 36
+test expr-old-21.2 {parenthesization} {expr (1?0:4)||1} 1
+test expr-old-21.3 {parenthesization} {expr +(3-4)} -1
+
+# Embedded commands and variable names.
+
+set a 16 
+test expr-old-22.1 {embedded variables} {expr {2*$a}} 32 
+test expr-old-22.2 {embedded variables} {
+    set x -5
+    set y 10
+    expr {$x + $y}
+} {5} 
+test expr-old-22.3 {embedded variables} {
+    set x "  -5"
+    set y "  +10"
+    expr {$x + $y}
+} {5}
+test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
+test expr-old-22.5 {embedded commands and variables} {
+    list [catch {expr {12 - [bad_command_name]}} msg] $msg
+} {1 {invalid command name "bad_command_name"}}
+
+# Double-quotes and things inside them.
+
+test expr-old-23.1 {double quotes} {expr {"abc"}} abc
+test expr-old-23.2 {double quotes} {
+    set a 189
+    expr {"$a.bc"}
+} 189.bc
+test expr-old-23.3 {double quotes} {
+    set b2 xyx
+    expr {"$b2$b2$b2.[set b2].[set b2]"}
+} xyxxyxxyx.xyx.xyx
+test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22
+test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc}
+test expr-old-23.6 {double quotes} {
+    catch {unset bogus__}
+    list [catch {expr {"$bogus__"}} msg] $msg
+} {1 {can't read "bogus__": no such variable}}
+test expr-old-23.7 {double quotes} {
+    list [catch {expr {"a[error Testing]bc"}} msg] $msg
+} {1 Testing}
+test expr-old-23.8 {double quotes} {
+    list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg
+} {0 1}
+
+# Numbers in various bases.
+
+test expr-old-24.1 {numbers in different bases} {expr 0x20} 32
+test expr-old-24.2 {numbers in different bases} {expr 015} 13
+
+# Conversions between various data types.
+
+test expr-old-25.1 {type conversions} {expr 2+2.5} 4.5
+test expr-old-25.2 {type conversions} {expr 2.5+2} 4.5
+test expr-old-25.3 {type conversions} {expr 2-2.5} -0.5
+test expr-old-25.4 {type conversions} {format %.6g [expr 2/2.5]} 0.8
+test expr-old-25.5 {type conversions} {expr 2>2.5} 0
+test expr-old-25.6 {type conversions} {expr 2.5>2} 1
+test expr-old-25.7 {type conversions} {expr 2<2.5} 1
+test expr-old-25.8 {type conversions} {expr 2>=2.5} 0
+test expr-old-25.9 {type conversions} {expr 2<=2.5} 1
+test expr-old-25.10 {type conversions} {expr 2==2.5} 0
+test expr-old-25.11 {type conversions} {expr 2!=2.5} 1
+test expr-old-25.12 {type conversions} {expr 2>"ab"} 0
+test expr-old-25.13 {type conversions} {expr {2>" "}} 1
+test expr-old-25.14 {type conversions} {expr {"24.1a" > 24.1}} 1
+test expr-old-25.15 {type conversions} {expr {24.1 > "24.1a"}} 0
+test expr-old-25.16 {type conversions} {expr 2+2.5} 4.5
+test expr-old-25.17 {type conversions} {expr 2+2.5} 4.5
+test expr-old-25.18 {type conversions} {expr 2.0e2} 200.0
+test expr-old-25.19 {type conversions} {format %.6g [expr 2.0e15]} 2e+15
+test expr-old-25.20 {type conversions} {expr 10.0} 10.0
+
+# Various error conditions.
+
+test expr-old-26.1 {error conditions} {
+    list [catch {expr 2+"a"} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-26.2 {error conditions} {
+    list [catch {expr 2+4*} msg] $msg
+} {1 {syntax error in expression "2+4*"}}
+test expr-old-26.3 {error conditions} {
+    list [catch {expr 2+4*(} msg] $msg
+} {1 {syntax error in expression "2+4*("}}
+catch {unset _non_existent_}
+test expr-old-26.4 {error conditions} {
+    list [catch {expr 2+$_non_existent_} msg] $msg
+} {1 {can't read "_non_existent_": no such variable}}
+set a xx
+test expr-old-26.5 {error conditions} {
+    list [catch {expr {2+$a}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-26.6 {error conditions} {
+    list [catch {expr {2+[set a]}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-26.7 {error conditions} {
+    list [catch {expr {2+(4}} msg] $msg
+} {1 {syntax error in expression "2+(4"}}
+test expr-old-26.8 {error conditions} {
+    list [catch {expr 2/0} msg] $msg $errorCode
+} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
+test expr-old-26.9 {error conditions} {
+    list [catch {expr 2%0} msg] $msg $errorCode
+} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
+test expr-old-26.10 {error conditions} {
+    list [catch {expr 2.0/0.0} msg] $msg $errorCode
+} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
+test expr-old-26.11 {error conditions} {
+    list [catch {expr 2#} msg] $msg
+} {1 {syntax error in expression "2#"}}
+test expr-old-26.12 {error conditions} {
+    list [catch {expr a.b} msg] $msg
+} {1 {syntax error in expression "a.b"}}
+test expr-old-26.13 {error conditions} {
+    list [catch {expr {"a"/"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "/"}}
+test expr-old-26.14 {error conditions} {
+    list [catch {expr 2:3} msg] $msg
+} {1 {syntax error in expression "2:3"}}
+test expr-old-26.15 {error conditions} {
+    list [catch {expr a@b} msg] $msg
+} {1 {syntax error in expression "a@b"}}
+test expr-old-26.16 {error conditions} {
+    list [catch {expr a[b} msg] $msg
+} {1 {missing close-bracket or close-brace}}
+test expr-old-26.17 {error conditions} {
+    list [catch {expr a`b} msg] $msg
+} {1 {syntax error in expression "a`b"}}
+test expr-old-26.18 {error conditions} {
+    list [catch {expr \"a\"\{b} msg] $msg
+} {1 {missing close-brace}}
+test expr-old-26.19 {error conditions} {
+    list [catch {expr a} msg] $msg
+} {1 {syntax error in expression "a"}}
+test expr-old-26.20 {error conditions} {
+    list [catch expr msg] $msg
+} {1 {wrong # args: should be "expr arg ?arg ...?"}}
+
+# Cancelled evaluation.
+
+test expr-old-27.1 {cancelled evaluation} {
+    set a 1
+    expr {0&&[set a 2]}
+    set a
+} 1
+test expr-old-27.2 {cancelled evaluation} {
+    set a 1
+    expr {1||[set a 2]}
+    set a
+} 1
+test expr-old-27.3 {cancelled evaluation} {
+    set a 1
+    expr {0?[set a 2]:1}
+    set a
+} 1
+test expr-old-27.4 {cancelled evaluation} {
+    set a 1
+    expr {1?2:[set a 2]}
+    set a
+} 1
+catch {unset x}
+test expr-old-27.5 {cancelled evaluation} {
+    list [catch {expr {[info exists x] && $x}} msg] $msg
+} {0 0}
+test expr-old-27.6 {cancelled evaluation} {
+    list [catch {expr {0 && [concat $x]}} msg] $msg
+} {0 0}
+test expr-old-27.7 {cancelled evaluation} {
+    set one 1
+    list [catch {expr {1 || 1/$one}} msg] $msg
+} {0 1}
+test expr-old-27.8 {cancelled evaluation} {
+    list [catch {expr {1 || -"string"}} msg] $msg
+} {0 1}
+test expr-old-27.9 {cancelled evaluation} {
+    list [catch {expr {1 || ("string" * ("x" && "y"))}} msg] $msg
+} {0 1}
+test expr-old-27.10 {cancelled evaluation} {
+    set x -1.0
+    list [catch {expr {($x > 0) ? round(log($x)) : 0}} msg] $msg
+} {0 0}
+test expr-old-27.11 {cancelled evaluation} {
+    list [catch {expr {0 && foo}} msg] $msg
+} {1 {syntax error in expression "0 && foo"}}
+test expr-old-27.12 {cancelled evaluation} {
+    list [catch {expr {0 ? 1 : foo}} msg] $msg
+} {1 {syntax error in expression "0 ? 1 : foo"}}
+
+# Tcl_ExprBool as used in "if" statements
+
+test expr-old-28.1 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {2} {set a 2}
+    set a
+} 2
+test expr-old-28.2 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {0} {set a 2}
+    set a
+} 1
+test expr-old-28.3 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {1.2} {set a 2}
+    set a
+} 2
+test expr-old-28.4 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {-1.1} {set a 2}
+    set a
+} 2
+test expr-old-28.5 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {0.0} {set a 2}
+    set a
+} 1
+test expr-old-28.6 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {"YES"} {set a 2}
+    set a
+} 2
+test expr-old-28.7 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {"no"} {set a 2}
+    set a
+} 1
+test expr-old-28.8 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {"true"} {set a 2}
+    set a
+} 2
+test expr-old-28.9 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {"fAlse"} {set a 2}
+    set a
+} 1
+test expr-old-28.10 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {"on"} {set a 2}
+    set a
+} 2
+test expr-old-28.11 {Tcl_ExprBoolean usage} {
+    set a 1
+    if {"Off"} {set a 2}
+    set a
+} 1
+test expr-old-28.12 {Tcl_ExprBool usage} {
+    list [catch {if {"abc"} {}} msg] $msg
+} {1 {expected boolean value but got "abc"}}
+test expr-old-28.13 {Tcl_ExprBool usage} {
+    list [catch {if {"ogle"} {}} msg] $msg
+} {1 {expected boolean value but got "ogle"}}
+test expr-old-28.14 {Tcl_ExprBool usage} {
+    list [catch {if {"o"} {}} msg] $msg
+} {1 {expected boolean value but got "o"}}
+
+# Operands enclosed in braces
+
+test expr-old-29.1 {braces} {expr {{abc}}} abc
+test expr-old-29.2 {braces} {expr {{00010}}} 8
+test expr-old-29.3 {braces} {format %.6g [expr {{3.1200000}}]} 3.12
+test expr-old-29.4 {braces} {expr {{a{b}{1 {2 3}}c}}} "a{b}{1 {2 3}}c"
+test expr-old-29.5 {braces} {
+    list [catch {expr "\{abc"} msg] $msg
+} {1 {missing close-brace}}
+
+# Very long values
+
+test expr-old-30.1 {long values} {
+    set a "0000 1111 2222 3333 4444"
+    set a "$a | $a | $a | $a | $a"
+    set a "$a || $a || $a || $a || $a"
+    expr {$a}
+} {0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444}
+test expr-old-30.2 {long values} {
+    set a "000000000000000000000000000000"
+    set a "$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a${a}5"
+    expr $a
+} 5
+
+# Expressions spanning multiple arguments
+
+test expr-old-31.1 {multiple arguments to expr command} {
+    expr 4 + ( 6 *12) -3
+} 73
+test expr-old-31.2 {multiple arguments to expr command} {
+    list [catch {expr 2 + (3 + 4} msg] $msg
+} {1 {syntax error in expression "2 + (3 + 4"}}
+test expr-old-31.3 {multiple arguments to expr command} {
+    list [catch {expr 2 + 3 +} msg] $msg
+} {1 {syntax error in expression "2 + 3 +"}}
+test expr-old-31.4 {multiple arguments to expr command} {
+    list [catch {expr 2 + 3 )} msg] $msg
+} {1 {syntax error in expression "2 + 3 )"}}
+
+# Math functions
+
+test expr-old-32.1 {math functions in expressions} {
+    format %.6g [expr acos(0.5)]
+} {1.0472}
+test expr-old-32.2 {math functions in expressions} {
+    format %.6g [expr asin(0.5)]
+} {0.523599}
+test expr-old-32.3 {math functions in expressions} {
+    format %.6g [expr atan(1.0)]
+} {0.785398}
+test expr-old-32.4 {math functions in expressions} {
+    format %.6g [expr atan2(2.0, 2.0)]
+} {0.785398}
+test expr-old-32.5 {math functions in expressions} {
+    format %.6g [expr ceil(1.999)]
+} {2}
+test expr-old-32.6 {math functions in expressions} {
+    format %.6g [expr cos(.1)]
+} {0.995004}
+test expr-old-32.7 {math functions in expressions} {
+    format %.6g [expr cosh(.1)]
+} {1.005}
+test expr-old-32.8 {math functions in expressions} {
+    format %.6g [expr exp(1.0)]
+} {2.71828}
+test expr-old-32.9 {math functions in expressions} {
+    format %.6g [expr floor(2.000)]
+} {2}
+test expr-old-32.10 {math functions in expressions} {
+    format %.6g [expr floor(2.001)]
+} {2}
+test expr-old-32.11 {math functions in expressions} {
+    format %.6g [expr fmod(7.3, 3.2)]
+} {0.9}
+test expr-old-32.12 {math functions in expressions} {
+    format %.6g [expr hypot(3.0, 4.0)]
+} {5}
+test expr-old-32.13 {math functions in expressions} {
+    format %.6g [expr log(2.8)]
+} {1.02962}
+test expr-old-32.14 {math functions in expressions} {
+    format %.6g [expr log10(2.8)]
+} {0.447158}
+test expr-old-32.15 {math functions in expressions} {
+    format %.6g [expr pow(2.1, 3.1)]
+} {9.97424}
+test expr-old-32.16 {math functions in expressions} {
+    format %.6g [expr sin(.1)]
+} {0.0998334}
+test expr-old-32.17 {math functions in expressions} {
+    format %.6g [expr sinh(.1)]
+} {0.100167}
+test expr-old-32.18 {math functions in expressions} {
+    format %.6g [expr sqrt(2.0)]
+} {1.41421}
+test expr-old-32.19 {math functions in expressions} {
+    format %.6g [expr tan(0.8)]
+} {1.02964}
+test expr-old-32.20 {math functions in expressions} {
+    format %.6g [expr tanh(0.8)]
+} {0.664037}
+test expr-old-32.21 {math functions in expressions} {
+    format %.6g [expr abs(-1.8)]
+} {1.8}
+test expr-old-32.22 {math functions in expressions} {
+    expr abs(10.0)
+} {10.0}
+test expr-old-32.23 {math functions in expressions} {
+    format %.6g [expr abs(-4)]
+} {4}
+test expr-old-32.24 {math functions in expressions} {
+    format %.6g [expr abs(66)]
+} {66}
+test expr-old-32.25 {math functions in expressions} {nonPortable} {
+    list [catch {expr abs(0x80000000)} msg] $msg
+} {1 {integer value too large to represent}}
+test expr-old-32.26 {math functions in expressions} {
+    expr double(1)
+} {1.0}
+test expr-old-32.27 {math functions in expressions} {
+    format %.6g [expr double(1.1)]
+} {1.1}
+test expr-old-32.28 {math functions in expressions} {
+    expr int(1)
+} {1}
+test expr-old-32.29 {math functions in expressions} {
+    expr int(1.4)
+} {1}
+test expr-old-32.30 {math functions in expressions} {
+    expr int(1.6)
+} {1}
+test expr-old-32.31 {math functions in expressions} {
+    expr int(-1.4)
+} {-1}
+test expr-old-32.32 {math functions in expressions} {
+    expr int(-1.6)
+} {-1}
+test expr-old-32.33 {math functions in expressions} {
+    list [catch {expr int(1e60)} msg] $msg
+} {1 {integer value too large to represent}}
+test expr-old-32.34 {math functions in expressions} {
+    list [catch {expr int(-1e60)} msg] $msg
+} {1 {integer value too large to represent}}
+test expr-old-32.35 {math functions in expressions} {
+    expr round(1.49)
+} {1}
+test expr-old-32.36 {math functions in expressions} {
+    expr round(1.51)
+} {2}
+test expr-old-32.37 {math functions in expressions} {
+    expr round(-1.49)
+} {-1}
+test expr-old-32.38 {math functions in expressions} {
+    expr round(-1.51)
+} {-2}
+test expr-old-32.39 {math functions in expressions} {
+    list [catch {expr round(1e60)} msg] $msg
+} {1 {integer value too large to represent}}
+test expr-old-32.40 {math functions in expressions} {
+    list [catch {expr round(-1e60)} msg] $msg
+} {1 {integer value too large to represent}}
+test expr-old-32.41 {math functions in expressions} {
+    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
+} {0 16.0}
+test expr-old-32.42 {math functions in expressions} {
+    list [catch {expr hypot(5*.8,3)} msg] $msg
+} {0 5.0}
+if $gotT1 {
+    test expr-old-32.43 {math functions in expressions} {
+	expr 2*T1()
+    } 246
+    test expr-old-32.44 {math functions in expressions} {
+	expr T2()*3
+    } 1035
+}
+test expr-old-32.45 {math functions in expressions} {
+    expr (0 <= rand()) && (rand() < 1)
+} {1}
+test expr-old-32.46 {math functions in expressions} {
+    list [catch {expr rand(24)} msg] $msg
+} {1 {syntax error in expression "rand(24)"}}
+test expr-old-32.47 {math functions in expressions} {
+    list [catch {expr srand()} msg] $msg
+} {1 {syntax error in expression "srand()"}}
+test expr-old-32.48 {math functions in expressions} {
+    list [catch {expr srand(3.79)} msg] $msg
+} {1 {can't use floating-point value as argument to srand}}
+test expr-old-32.49 {math functions in expressions} {
+    list [catch {expr srand("")} msg] $msg
+} {1 {can't use non-numeric string as argument to srand}}
+test expr-old-32.50 {math functions in expressions} {
+    set result [expr round(srand(12345) * 1000)]
+    for {set i 0} {$i < 10} {incr i} {
+	lappend result [expr round(rand() * 1000)]
+    }
+    set result
+} {97 834 948 36 12 51 766 585 914 784 333}
+test expr-old-32.51 {math functions in expressions} {
+    list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg
+} {1 {can't use non-numeric string as argument to srand}}
+
+test expr-old-33.1 {conversions and fancy args to math functions} {
+    expr hypot ( 3 , 4 )
+} 5.0
+test expr-old-33.2 {conversions and fancy args to math functions} {
+    expr hypot ( (2.0+1.0) , 4 )
+} 5.0
+test expr-old-33.3 {conversions and fancy args to math functions} {
+    expr hypot ( 3 , (3.0 + 1.0) )
+} 5.0
+test expr-old-33.4 {conversions and fancy args to math functions} {
+    format %.6g [expr cos(acos(0.1))]
+} 0.1
+
+test expr-old-34.1 {errors in math functions} {
+    list [catch {expr func_2(1.0)} msg] $msg
+} {1 {unknown math function "func_2"}}
+test expr-old-34.2 {errors in math functions} {
+    list [catch {expr func|(1.0)} msg] $msg
+} {1 {syntax error in expression "func|(1.0)"}}
+test expr-old-34.3 {errors in math functions} {
+    list [catch {expr {hypot("a b", 2.0)}} msg] $msg
+} {1 {argument to math function didn't have numeric value}}
+test expr-old-34.4 {errors in math functions} {
+    list [catch {expr hypot(1.0 2.0)} msg] $msg
+} {1 {syntax error in expression "hypot(1.0 2.0)"}}
+test expr-old-34.5 {errors in math functions} {
+    list [catch {expr hypot(1.0, 2.0} msg] $msg
+} {1 {syntax error in expression "hypot(1.0, 2.0"}}
+test expr-old-34.6 {errors in math functions} {
+    list [catch {expr hypot(1.0 ,} msg] $msg
+} {1 {syntax error in expression "hypot(1.0 ,"}}
+test expr-old-34.7 {errors in math functions} {
+    list [catch {expr hypot(1.0)} msg] $msg
+} {1 {too few arguments for math function}}
+test expr-old-34.8 {errors in math functions} {
+    list [catch {expr hypot(1.0, 2.0, 3.0)} msg] $msg
+} {1 {too many arguments for math function}}
+test expr-old-34.9 {errors in math functions} {
+    list [catch {expr acos(-2.0)} msg] $msg $errorCode
+} {1 {domain error: argument not in valid range} {ARITH DOMAIN {domain error: argument not in valid range}}}
+test expr-old-34.10 {errors in math functions} {nonPortable} {
+    list [catch {expr pow(-3, 1000001)} msg] $msg $errorCode
+} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
+test expr-old-34.11 {errors in math functions} {
+    list [catch {expr pow(3, 1000001)} msg] $msg $errorCode
+} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
+test expr-old-34.12 {errors in math functions} {
+    list [catch {expr -14.0*exp(100000)} msg] $msg $errorCode
+} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
+test expr-old-34.13 {errors in math functions} {
+    list [catch {expr int(1.0e30)} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+test expr-old-34.14 {errors in math functions} {
+    list [catch {expr int(-1.0e30)} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+test expr-old-34.15 {errors in math functions} {
+    list [catch {expr round(1.0e30)} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+test expr-old-34.16 {errors in math functions} {
+    list [catch {expr round(-1.0e30)} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+if $gotT1 {
+    test expr-old-34.17 {errors in math functions} {
+	list [catch {expr T1(4)} msg] $msg
+    } {1 {syntax error in expression "T1(4)"}}
+}
+
+test expr-old-36.1 {ExprLooksLikeInt procedure} {
+    list [catch {expr 0289} msg] $msg
+} {1 {syntax error in expression "0289"}}
+test expr-old-36.2 {ExprLooksLikeInt procedure} {
+    set x 0289
+    list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-36.3 {ExprLooksLikeInt procedure} {
+    list [catch {format %.6g [expr 0289.1]} msg] $msg
+} {0 289.1}
+test expr-old-36.4 {ExprLooksLikeInt procedure} {
+    set x 0289.1
+    list [catch {format %.6g [expr {$x+1}]} msg] $msg
+} {0 290.1}
+test expr-old-36.5 {ExprLooksLikeInt procedure} {
+    set x {  +22}
+    list [catch {expr {$x+1}} msg] $msg
+} {0 23}
+test expr-old-36.6 {ExprLooksLikeInt procedure} {
+    set x {	-22}
+    list [catch {expr {$x+1}} msg] $msg
+} {0 -21}
+test expr-old-36.7 {ExprLooksLikeInt procedure} {nonPortable unixOnly} {
+    list [catch {expr nan} msg] $msg
+} {1 {domain error: argument not in valid range}}
+test expr-old-36.8 {ExprLooksLikeInt procedure} {
+    list [catch {expr 78e1} msg] $msg
+} {0 780.0}
+test expr-old-36.9 {ExprLooksLikeInt procedure} {
+    list [catch {expr 24E1} msg] $msg
+} {0 240.0}
+test expr-old-36.10 {ExprLooksLikeInt procedure} {nonPortable unixOnly} {
+    list [catch {expr 78e} msg] $msg
+} {1 {syntax error in expression "78e"}}
+
+test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} {
+    testexprlong
+} {This is a result: 5}
+
+
+
+# Special test for Pentium arithmetic bug of 1994:
+
+if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
+    puts "Warning: this machine contains a defective Pentium processor"
+    puts "that performs arithmetic incorrectly.  I recommend that you"
+    puts "call Intel customer service immediately at 1-800-628-8686"
+    puts "to request a replacement processor."
+}
diff --git a/contrib/tcl/tests/expr.test b/contrib/tcl/tests/expr.test
index d5dbab5..481e3ab 100644
--- a/contrib/tcl/tests/expr.test
+++ b/contrib/tcl/tests/expr.test
@@ -1,16 +1,15 @@
-# Commands covered:  expr
+# Commands covered: expr
 #
 # This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
+# built-in commands. Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) expr.test 1.48 96/02/16 08:55:51
+# SCCS: @(#) expr.test 1.29 97/06/23 18:46:25
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -22,869 +21,616 @@ if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
     set gotT1 1
 }
 
-# First, test all of the integer operators individually.
+# procedures used below
 
-test expr-1.1 {integer operators} {expr -4} -4
-test expr-1.2 {integer operators} {expr -(1+4)} -5
-test expr-1.3 {integer operators} {expr ~3} -4
-test expr-1.4 {integer operators} {expr !2} 0
-test expr-1.5 {integer operators} {expr !0} 1
-test expr-1.6 {integer operators} {expr 4*6} 24
-test expr-1.7 {integer operators} {expr 36/12} 3
-test expr-1.8 {integer operators} {expr 27/4} 6
-test expr-1.9 {integer operators} {expr 27%4} 3
-test expr-1.10 {integer operators} {expr 2+2} 4
-test expr-1.11 {integer operators} {expr 2-6} -4
-test expr-1.12 {integer operators} {expr 1<<3} 8
-test expr-1.13 {integer operators} {expr 0xff>>2} 63
-test expr-1.14 {integer operators} {expr -1>>2} -1
-test expr-1.15 {integer operators} {expr 3>2} 1
-test expr-1.16 {integer operators} {expr 2>2} 0
-test expr-1.17 {integer operators} {expr 1>2} 0
-test expr-1.18 {integer operators} {expr 3<2} 0
-test expr-1.19 {integer operators} {expr 2<2} 0
-test expr-1.20 {integer operators} {expr 1<2} 1
-test expr-1.21 {integer operators} {expr 3>=2} 1
-test expr-1.22 {integer operators} {expr 2>=2} 1
-test expr-1.23 {integer operators} {expr 1>=2} 0
-test expr-1.24 {integer operators} {expr 3<=2} 0
-test expr-1.25 {integer operators} {expr 2<=2} 1
-test expr-1.26 {integer operators} {expr 1<=2} 1
-test expr-1.27 {integer operators} {expr 3==2} 0
-test expr-1.28 {integer operators} {expr 2==2} 1
-test expr-1.29 {integer operators} {expr 3!=2} 1
-test expr-1.30 {integer operators} {expr 2!=2} 0
-test expr-1.31 {integer operators} {expr 7&0x13} 3
-test expr-1.32 {integer operators} {expr 7^0x13} 20
-test expr-1.33 {integer operators} {expr 7|0x13} 23
-test expr-1.34 {integer operators} {expr 0&&1} 0
-test expr-1.35 {integer operators} {expr 0&&0} 0
-test expr-1.36 {integer operators} {expr 1&&3} 1
-test expr-1.37 {integer operators} {expr 0||1} 1
-test expr-1.38 {integer operators} {expr 3||0} 1
-test expr-1.39 {integer operators} {expr 0||0} 0
-test expr-1.40 {integer operators} {expr 3>2?44:66} 44
-test expr-1.41 {integer operators} {expr 2>3?44:66} 66
-test expr-1.42 {integer operators} {expr 36/5} 7
-test expr-1.43 {integer operators} {expr 36%5} 1
-test expr-1.44 {integer operators} {expr -36/5} -8
-test expr-1.45 {integer operators} {expr -36%5} 4
-test expr-1.46 {integer operators} {expr 36/-5} -8
-test expr-1.47 {integer operators} {expr 36%-5} -4
-test expr-1.48 {integer operators} {expr -36/-5} 7
-test expr-1.49 {integer operators} {expr -36%-5} -1
-test expr-1.50 {integer operators} {expr +36} 36
-test expr-1.51 {integer operators} {expr +--++36} 36
-test expr-1.52 {integer operators} {expr +36%+5} 1
-
-# Check the floating-point operators individually, along with
-# automatic conversion to integers where needed.
-
-test expr-2.1 {floating-point operators} {expr -4.2} -4.2
-test expr-2.2 {floating-point operators} {expr -(1.1+4.2)} -5.3
-test expr-2.3 {floating-point operators} {expr +5.7} 5.7
-test expr-2.4 {floating-point operators} {expr +--+-62.0} -62.0
-test expr-2.5 {floating-point operators} {expr !2.1} 0
-test expr-2.6 {floating-point operators} {expr !0.0} 1
-test expr-2.7 {floating-point operators} {expr 4.2*6.3} 26.46
-test expr-2.8 {floating-point operators} {expr 36.0/12.0} 3.0
-test expr-2.9 {floating-point operators} {expr 27/4.0} 6.75
-test expr-2.10 {floating-point operators} {expr 2.3+2.1} 4.4
-test expr-2.11 {floating-point operators} {expr 2.3-6.5} -4.2
-test expr-2.12 {floating-point operators} {expr 3.1>2.1} 1
-test expr-2.13 {floating-point operators} {expr {2.1 > 2.1}} 0
-test expr-2.14 {floating-point operators} {expr 1.23>2.34e+1} 0
-test expr-2.15 {floating-point operators} {expr 3.45<2.34} 0
-test expr-2.16 {floating-point operators} {expr 0.002e3<--200e-2} 0
-test expr-2.17 {floating-point operators} {expr 1.1<2.1} 1
-test expr-2.18 {floating-point operators} {expr 3.1>=2.2} 1
-test expr-2.19 {floating-point operators} {expr 2.345>=2.345} 1
-test expr-2.20 {floating-point operators} {expr 1.1>=2.2} 0
-test expr-2.21 {floating-point operators} {expr 3.0<=2.0} 0
-test expr-2.22 {floating-point operators} {expr 2.2<=2.2} 1
-test expr-2.23 {floating-point operators} {expr 2.2<=2.2001} 1
-test expr-2.24 {floating-point operators} {expr 3.2==2.2} 0
-test expr-2.25 {floating-point operators} {expr 2.2==2.2} 1
-test expr-2.26 {floating-point operators} {expr 3.2!=2.2} 1
-test expr-2.27 {floating-point operators} {expr 2.2!=2.2} 0
-test expr-2.28 {floating-point operators} {expr 0.0&&0.0} 0
-test expr-2.29 {floating-point operators} {expr 0.0&&1.3} 0
-test expr-2.30 {floating-point operators} {expr 1.3&&0.0} 0
-test expr-2.31 {floating-point operators} {expr 1.3&&3.3} 1
-test expr-2.32 {floating-point operators} {expr 0.0||0.0} 0
-test expr-2.33 {floating-point operators} {expr 0.0||1.3} 1
-test expr-2.34 {floating-point operators} {expr 1.3||0.0} 1
-test expr-2.35 {floating-point operators} {expr 3.3||0.0} 1
-test expr-2.36 {floating-point operators} {expr 3.3>2.3?44.3:66.3} 44.3
-test expr-2.37 {floating-point operators} {expr 2.3>3.3?44.3:66.3} 66.3
-test expr-2.38 {floating-point operators} {
-    list [catch {expr 028.1 + 09.2} msg] $msg
-} {0 37.3}
-
-# Operators that aren't legal on floating-point numbers
+proc put_hello_char {c} {
+    global a
+    append a [format %c $c]
+    return $c
+}
+proc hello_world {} {
+    global a
+    set a ""
+    set L1 [set l0 [set h_1 [set q 0]]]
+    for {put_hello_char [expr [put_hello_char [expr [set h 7]*10+2]]+29]} {$l0?[put_hello_char $l0]
+        :!$h_1} {put_hello_char $ll;expr {$L1==2?[set ll [expr 32+0-0+[set bar 0]]]:0}} {expr {[incr L1]==[expr 1+([string length "abc"]-[string length "abc"])]
+        ?[set ll [set l0 [expr 54<<1]]]:$ll==108&&$L1<3?
+        [incr ll [expr 1|1<<1]; set ll $ll; set ll $ll; set ll $ll; set ll $ll; set l0 [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]; set l0; set l0 $l0; set l0; set l0]:$L1==4&&$ll==32?[set ll [expr 19+$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+[set foo [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]]]]
+        :[set q [expr $q-$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]};expr {$L1==5?[incr ll -8; set ll $ll; set ll]:$q&&$h1&&1};expr {$L1==4+2
+        ?[incr ll 3]:[expr ([string length "abc"]-[string length "abc"])+1]};expr {$ll==($h<<4)+2+0&&$L1!=6?[incr ll -6]:[set h1 [expr 100+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]}
+        expr {$L1!=1<<3?[incr q [expr ([string length "abc"]-[string length "abc"])-1]]:[set h_1 [set ll $h1]]}
+    }
+    set a
+}
 
-test expr-3.1 {illegal floating-point operations} {
-    list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value as operand of "~"}}
-test expr-3.2 {illegal floating-point operations} {
-    list [catch {expr 27%4.0} msg] $msg
-} {1 {can't use floating-point value as operand of "%"}}
-test expr-3.3 {illegal floating-point operations} {
-    list [catch {expr 27.0%4} msg] $msg
-} {1 {can't use floating-point value as operand of "%"}}
-test expr-3.4 {illegal floating-point operations} {
-    list [catch {expr 1.0<<3} msg] $msg
-} {1 {can't use floating-point value as operand of "<<"}}
-test expr-3.5 {illegal floating-point operations} {
-    list [catch {expr 3<<1.0} msg] $msg
-} {1 {can't use floating-point value as operand of "<<"}}
-test expr-3.6 {illegal floating-point operations} {
-    list [catch {expr 24.0>>3} msg] $msg
-} {1 {can't use floating-point value as operand of ">>"}}
-test expr-3.7 {illegal floating-point operations} {
-    list [catch {expr 24>>3.0} msg] $msg
-} {1 {can't use floating-point value as operand of ">>"}}
-test expr-3.8 {illegal floating-point operations} {
-    list [catch {expr 24&3.0} msg] $msg
-} {1 {can't use floating-point value as operand of "&"}}
-test expr-3.9 {illegal floating-point operations} {
-    list [catch {expr 24.0|3} msg] $msg
-} {1 {can't use floating-point value as operand of "|"}}
-test expr-3.10 {illegal floating-point operations} {
-    list [catch {expr 24.0^3} msg] $msg
-} {1 {can't use floating-point value as operand of "^"}}
+proc 12days {a b c} {
+    global xxx
+    expr {1<$a?[expr {$a<3?[12days -79 -13 [string range $c [12days -87 \
+	[expr 1-$b] [string range $c [12days -86 0 [string range $c 1 end]] \
+	end]] end]]:1};expr {$a<$b?[12days [expr $a+1] $b $c]:3};expr {[12days \
+	-94 [expr $a-27] $c]&&$a==2?$b<13?[12days 2 [expr $b+1] "%s %d %d\n"]:9
+	:16}]:$a<0?$a<-72?[12days $b $a "@n'+,#'/*\{\}w+/w#cdnr/+,\{\}r/*de\}+,/*\{*+,/w\{%+,/w#q#n+,/#\{l+,/n\{n+,/+#n+,/#;#q#n+,/+k#;*+,/'r :'d*'3,\}\{w+K w'K:'+\}e#';dq#'l q#'+d'K#!/+k#;q#'r\}eKK#\}w'r\}eKK\{nl\]'/#;#q#n')\{)#\}w')\{)\{nl\]'/+#n';d\}rw' i;# )\{nl\]!/n\{n#'; r\{#w'r nc\{nl\]'/#\{l,+'K \{rw' iK\{;\[\{nl\]'/w#q#n'wk nw' iwk\{KK\{nl\]!/w\{%'l##w#' i; :\{nl\]'/*\{q#'ld;r'\}\{nlwb!/*de\}'c ;;\{nl'-\{\}rw\]'/+,\}##'*\}#nc,',#nw\]'/+kd'+e\}+;#'rdq#w! nr'/ ') \}+\}\{rl#'\{n' ')# \}'+\}##(!!/"]
+	:$a<-50?[string compare [format %c $b] [string index $c 0]]==0?[append \
+	xxx [string index $c 31];scan [string index $c 31] %c x;set x]
+	:[12days -65 $b [string range $c 1 end]]:[12days [expr ([string compare \
+	[string index $c 0] "/"]==0)+$a] $b [string range $c 1 end]]:0<$a
+	?[12days 2 2 "%s"]:[string compare [string index $c 0] "/"]==0||
+	[12days 0 [12days -61 [scan [string index $c 0] %c x; set x] \
+	"!ek;dc i@bK'(q)-\[w\]*%n+r3#l,\{\}:\nuwloca-O;m .vpbks,fxntdCeghiry"] \
+	[string range $c 1 end]]}
+}
+proc do_twelve_days {} {
+    global xxx
+    set xxx ""
+    12days 1 1 1
+    string length $xxx
+}
 
-# Check the string operators individually.
+# start of tests
 
-test expr-4.1 {string operators} {expr {"abc" > "def"}} 0
-test expr-4.2 {string operators} {expr {"def" > "def"}} 0
-test expr-4.3 {string operators} {expr {"g" > "def"}} 1
-test expr-4.4 {string operators} {expr {"abc" < "abd"}} 1
-test expr-4.5 {string operators} {expr {"abd" < "abd"}} 0
-test expr-4.6 {string operators} {expr {"abe" < "abd"}} 0
-test expr-4.7 {string operators} {expr {"abc" >= "def"}} 0
-test expr-4.8 {string operators} {expr {"def" >= "def"}} 1
-test expr-4.9 {string operators} {expr {"g" >= "def"}} 1
-test expr-4.10 {string operators} {expr {"abc" <= "abd"}} 1
-test expr-4.11 {string operators} {expr {"abd" <= "abd"}} 1
-test expr-4.12 {string operators} {expr {"abe" <= "abd"}} 0
-test expr-4.13 {string operators} {expr {"abc" == "abd"}} 0
-test expr-4.14 {string operators} {expr {"abd" == "abd"}} 1
-test expr-4.15 {string operators} {expr {"abc" != "abd"}} 1
-test expr-4.16 {string operators} {expr {"abd" != "abd"}} 0
-test expr-4.17 {string operators} {expr {"0y" < "0x12"}} 1
-test expr-4.18 {string operators} {expr {"." < " "}} 0
+catch {unset a b i x}
 
-# The following tests are non-portable because on some systems "+"
-# and "-" can be parsed as numbers.
+test expr-1.1 {TclCompileExprCmd: no expression} {
+    list [catch {expr  } msg] $msg
+} {1 {wrong # args: should be "expr arg ?arg ...?"}}
+test expr-1.2 {TclCompileExprCmd: one expression word} {
+    expr -25
+} -25
+test expr-1.3 {TclCompileExprCmd: two expression words} {
+    format %.6g [expr -8.2   -6]
+} -14.2
+test expr-1.4 {TclCompileExprCmd: five expression words} {
+    expr 20 - 5 +10 -7
+} 18
+test expr-1.5 {TclCompileExprCmd: quoted expression word} {
+    expr "0005"
+} 5
+test expr-1.6 {TclCompileExprCmd: quoted expression word} {
+    catch {expr "0005"zxy} msg
+    set msg
+} {quoted string doesn't terminate properly}
+test expr-1.7 {TclCompileExprCmd: expression word in braces} {
+    expr {-0005}
+} -5
+test expr-1.8 {TclCompileExprCmd: expression word in braces} {
+    expr {{-0x1234}}
+} -4660
+test expr-1.9 {TclCompileExprCmd: expression word in braces} {
+    catch {expr {-0005}foo} msg
+    set msg
+} {argument word in braces doesn't terminate properly}
+test expr-1.10 {TclCompileExprCmd: other expression word in braces} {
+    expr 4*[llength "6 2"]
+} 8
+test expr-1.11 {TclCompileExprCmd: expression word terminated by ;} {
+    expr 4*[llength "6 2"];
+} 8
+test expr-1.12 {TclCompileExprCmd: inlined expr (in "catch") inside other catch} {
+    set a xxx
+    catch {
+	# Might not be a number
+	set a [expr 10*$a]
+    }
+} 1
+test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
+    set a xxx
+    set x 27;  set bool {$x};  if $bool {set a foo}
+    set a
+} foo
+
+test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
+    expr double(5*[llength "6 2"])
+} 10.0
+test expr-2.2 {TclCompileExpr: error in expr} {
+    catch {expr 2**3} msg
+    set msg
+} {syntax error in expression "2**3"}
+test expr-2.3 {TclCompileExpr: junk after legal expr} {
+    catch {expr 7*[llength "a b"]foo} msg
+    set msg
+} {syntax error in expression "7*2foo"}
+test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
+    expr {0001}
+} 1
 
-test expr-4.19 {string operators} {nonPortable} {expr {"0" == "+"}} 0
-test expr-4.20 {string operators} {nonPortable} {expr {"0" == "-"}} 0
-test expr-4.21 {string operators} {expr {1?"foo":"bar"}} foo
-test expr-4.22 {string operators} {expr {0?"foo":"bar"}} bar
+test expr-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
+test expr-3.2 {CompileCondExpr: error in lor expr} {
+    catch {expr x||3} msg
+    set msg
+} {syntax error in expression "x||3"} 
+test expr-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
+test expr-3.4 {CompileCondExpr: error compiling true arm} {
+    catch {expr 3>2?2**3:66} msg
+    set msg
+} {syntax error in expression "3>2?2**3:66"}
+test expr-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
+test expr-3.6 {CompileCondExpr: error compiling false arm} {
+    catch {expr 2>3?44:2**3} msg
+    set msg
+} {syntax error in expression "2>3?44:2**3"}
+test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} {unixOnly nonPortable} {
+    puts "Note: doing test expr-3.7 which can take several minutes to run"
+    hello_world
+} {Hello world}
+catch {unset xxx}
+test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} {unixOnly nonPortable} {
+    puts "Note: doing test expr-3.8 which can take several minutes to run"
+    do_twelve_days
+} 2358
+catch {unset xxx}
+
+test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
+test expr-4.2 {CompileLorExpr: error in land expr} {
+    catch {expr x&&3} msg
+    set msg
+} {syntax error in expression "x&&3"} 
+test expr-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1
+test expr-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1
+test expr-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1
+test expr-4.6 {CompileLorExpr: error compiling lor arm} {
+    catch {expr 2**3||4.0} msg
+    set msg
+} {syntax error in expression "2**3||4.0"}
+test expr-4.7 {CompileLorExpr: error compiling lor arm} {
+    catch {expr 1.3||2**3} msg
+    set msg
+} {syntax error in expression "1.3||2**3"}
+test expr-4.8 {CompileLorExpr: error compiling lor arms} {
+    list [catch {expr {"a"||"b"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-4.9 {CompileLorExpr: long lor arm} {
+    set a "abcdefghijkl"
+    set i 7
+    expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
+} 1
 
-# Operators that aren't legal on string operands.
+test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
+test expr-5.2 {CompileLandExpr: error in bitor expr} {
+    catch {expr x|3} msg
+    set msg
+} {syntax error in expression "x|3"} 
+test expr-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0
+test expr-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0
+test expr-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1
+test expr-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1
+test expr-5.7 {CompileLandExpr: error compiling land arm} {
+    catch {expr 2**3&&4.0} msg
+    set msg
+} {syntax error in expression "2**3&&4.0"}
+test expr-5.8 {CompileLandExpr: error compiling land arm} {
+    catch {expr 1.3&&2**3} msg
+    set msg
+} {syntax error in expression "1.3&&2**3"}
+test expr-5.9 {CompileLandExpr: error compiling land arm} {
+    list [catch {expr {"a"&&"b"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-5.10 {CompileLandExpr: long land arms} {
+    set a "abcdefghijkl"
+    set i 7
+    expr {[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]}
+} 1
 
-test expr-5.1 {illegal string operations} {
-    list [catch {expr {-"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
-test expr-5.2 {illegal string operations} {
-    list [catch {expr {+"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test expr-5.3 {illegal string operations} {
-    list [catch {expr {~"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "~"}}
-test expr-5.4 {illegal string operations} {
-    list [catch {expr {!"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "!"}}
-test expr-5.5 {illegal string operations} {
-    list [catch {expr {"a"*"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "*"}}
-test expr-5.6 {illegal string operations} {
-    list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
-test expr-5.7 {illegal string operations} {
-    list [catch {expr {"a"%"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "%"}}
-test expr-5.8 {illegal string operations} {
-    list [catch {expr {"a"+"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test expr-5.9 {illegal string operations} {
-    list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
-test expr-5.10 {illegal string operations} {
-    list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "<<"}}
-test expr-5.11 {illegal string operations} {
-    list [catch {expr {"a">>"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of ">>"}}
-test expr-5.12 {illegal string operations} {
-    list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "&"}}
-test expr-5.13 {illegal string operations} {
+test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
+test expr-6.2 {CompileBitXorExpr: error in bitand expr} {
+    catch {expr x|3} msg
+    set msg
+} {syntax error in expression "x|3"} 
+test expr-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20
+test expr-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19
+test expr-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7
+test expr-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8
+test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} {
+    catch {expr 2**3|6} msg
+    set msg
+} {syntax error in expression "2**3|6"}
+test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} {
+    catch {expr 2^x} msg
+    set msg
+} {syntax error in expression "2^x"}
+test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
+    list [catch {expr {24.0^3}} msg] $msg
+} {1 {can't use floating-point value as operand of "^"}}
+test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
     list [catch {expr {"a"^"b"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "^"}}
-test expr-5.14 {illegal string operations} {
-    list [catch {expr {"a"|"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "|"}}
-test expr-5.15 {illegal string operations} {
-    list [catch {expr {"a"&&"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "&&"}}
-test expr-5.16 {illegal string operations} {
-    list [catch {expr {"a"||"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "||"}}
-test expr-5.17 {illegal string operations} {
-    list [catch {expr {"a"?4:2}} msg] $msg
-} {1 {can't use non-numeric string as operand of "?"}}
-
-# Check precedence pairwise.
-
-test expr-6.1 {precedence checks} {expr -~3} 4
-test expr-6.2 {precedence checks} {expr -!3} 0
-test expr-6.3 {precedence checks} {expr -~0} 1
-
-test expr-7.1 {precedence checks} {expr 2*4/6} 1
-test expr-7.2 {precedence checks} {expr 24/6*3} 12
-test expr-7.3 {precedence checks} {expr 24/6/2} 2
-
-test expr-8.1 {precedence checks} {expr -2+4} 2
-test expr-8.2 {precedence checks} {expr -2-4} -6
-test expr-8.3 {precedence checks} {expr +2-4} -2
-
-test expr-9.1 {precedence checks} {expr 2*3+4} 10
-test expr-9.2 {precedence checks} {expr 8/2+4} 8
-test expr-9.3 {precedence checks} {expr 8%3+4} 6
-test expr-9.4 {precedence checks} {expr 2*3-1} 5
-test expr-9.5 {precedence checks} {expr 8/2-1} 3
-test expr-9.6 {precedence checks} {expr 8%3-1} 1
-
-test expr-10.1 {precedence checks} {expr 6-3-2} 1
-
-test expr-11.1 {precedence checks} {expr 7+1>>2} 2
-test expr-11.2 {precedence checks} {expr 7+1<<2} 32
-test expr-11.3 {precedence checks} {expr 7>>3-2} 3
-test expr-11.4 {precedence checks} {expr 7<<3-2} 14
-
-test expr-12.1 {precedence checks} {expr 6>>1>4} 0
-test expr-12.2 {precedence checks} {expr 6>>1<2} 0
-test expr-12.3 {precedence checks} {expr 6>>1>=3} 1
-test expr-12.4 {precedence checks} {expr 6>>1<=2} 0
-test expr-12.5 {precedence checks} {expr 6<<1>5} 1
-test expr-12.6 {precedence checks} {expr 6<<1<5} 0
-test expr-12.7 {precedence checks} {expr 5<=6<<1} 1
-test expr-12.8 {precedence checks} {expr 5>=6<<1} 0
-
-test expr-13.1 {precedence checks} {expr 2<3<4} 1
-test expr-13.2 {precedence checks} {expr 0<4>2} 0
-test expr-13.3 {precedence checks} {expr 4>2<1} 0
-test expr-13.4 {precedence checks} {expr 4>3>2} 0
-test expr-13.5 {precedence checks} {expr 4>3>=2} 0
-test expr-13.6 {precedence checks} {expr 4>=3>2} 0
-test expr-13.7 {precedence checks} {expr 4>=3>=2} 0
-test expr-13.8 {precedence checks} {expr 0<=4>=2} 0
-test expr-13.9 {precedence checks} {expr 4>=2<=0} 0
-test expr-13.10 {precedence checks} {expr 2<=3<=4} 1
-
-test expr-14.1 {precedence checks} {expr 1==4>3} 1
-test expr-14.2 {precedence checks} {expr 0!=4>3} 1
-test expr-14.3 {precedence checks} {expr 1==3<4} 1
-test expr-14.4 {precedence checks} {expr 0!=3<4} 1
-test expr-14.5 {precedence checks} {expr 1==4>=3} 1
-test expr-14.6 {precedence checks} {expr 0!=4>=3} 1
-test expr-14.7 {precedence checks} {expr 1==3<=4} 1
-test expr-14.8 {precedence checks} {expr 0!=3<=4} 1
-
-test expr-15.1 {precedence checks} {expr 1==3==3} 0
-test expr-15.2 {precedence checks} {expr 3==3!=2} 1
-test expr-15.3 {precedence checks} {expr 2!=3==3} 0
-test expr-15.4 {precedence checks} {expr 2!=1!=1} 0
-
-test expr-16.1 {precedence checks} {expr 2&3==2} 0
-test expr-16.2 {precedence checks} {expr 1&3!=3} 0
-
-test expr-17.1 {precedence checks} {expr 7&3^0x10} 19
-test expr-17.2 {precedence checks} {expr 7^0x10&3} 7
-
-test expr-18.1 {precedence checks} {expr 7^0x10|3} 23
-test expr-18.2 {precedence checks} {expr 7|0x10^3} 23
-
-test expr-19.1 {precedence checks} {expr 7|3&&1} 1
-test expr-19.2 {precedence checks} {expr 1&&3|7} 1
-test expr-19.3 {precedence checks} {expr 0&&1||1} 1
-test expr-19.4 {precedence checks} {expr 1||1&&0} 1
-
-test expr-20.1 {precedence checks} {expr 1||0?3:4} 3
-test expr-20.2 {precedence checks} {expr 1?0:4||1} 0
-test expr-20.3 {precedence checks} {expr 1?2:0?3:4} 2
-test expr-20.4 {precedence checks} {expr 0?2:0?3:4} 4
-test expr-20.5 {precedence checks} {expr 1?2?3:4:0} 3
-test expr-20.6 {precedence checks} {expr 0?2?3:4:0} 0
-
-# Parentheses.
-
-test expr-21.1 {parenthesization} {expr (2+4)*6} 36
-test expr-21.2 {parenthesization} {expr (1?0:4)||1} 1
-test expr-21.3 {parenthesization} {expr +(3-4)} -1
-
-# Embedded commands and variable names.
-
-set a 16
-test expr-22.1 {embedded variables} {expr {2*$a}} 32
-test expr-22.2 {embedded variables} {
-    set x -5
-    set y 10
-    expr {$x + $y}
-} {5}
-test expr-22.3 {embedded variables} {
-    set x "  -5"
-    set y "  +10"
-    expr {$x + $y}
-} {5}
-test expr-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
-test expr-22.5 {embedded commands and variables} {
-    list [catch {expr {12 - [bad_command_name]}} msg] $msg
-} {1 {invalid command name "bad_command_name"}}
-
-# Double-quotes and things inside them.
-
-test expr-23.1 {double quotes} {expr {"abc"}} abc
-test expr-23.2 {double quotes} {
-    set a 189
-    expr {"$a.bc"}
-} 189.bc
-test expr-23.3 {double quotes} {
-    set b2 xyx
-    expr {"$b2$b2$b2.[set b2].[set b2]"}
-} xyxxyxxyx.xyx.xyx
-test expr-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22
-test expr-23.5 {double quotes} {expr {"\*bc"}} {*bc}
-test expr-23.6 {double quotes} {
-    catch {unset bogus__}
-    list [catch {expr {"$bogus__"}} msg] $msg
-} {1 {can't read "bogus__": no such variable}}
-test expr-23.7 {double quotes} {
-    list [catch {expr {"a[error Testing]bc"}} msg] $msg
-} {1 Testing}
-test expr-23.8 {double quotes} {
-    list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg
-} {0 1}
-
-# Numbers in various bases.
 
-test expr-24.1 {numbers in different bases} {expr 0x20} 32
-test expr-24.2 {numbers in different bases} {expr 015} 13
-
-# Conversions between various data types.
-
-test expr-25.1 {type conversions} {expr 2+2.5} 4.5
-test expr-25.2 {type conversions} {expr 2.5+2} 4.5
-test expr-25.3 {type conversions} {expr 2-2.5} -0.5
-test expr-25.4 {type conversions} {expr 2/2.5} 0.8
-test expr-25.5 {type conversions} {expr 2>2.5} 0
-test expr-25.6 {type conversions} {expr 2.5>2} 1
-test expr-25.7 {type conversions} {expr 2<2.5} 1
-test expr-25.8 {type conversions} {expr 2>=2.5} 0
-test expr-25.9 {type conversions} {expr 2<=2.5} 1
-test expr-25.10 {type conversions} {expr 2==2.5} 0
-test expr-25.11 {type conversions} {expr 2!=2.5} 1
-test expr-25.12 {type conversions} {expr 2>"ab"} 0
-test expr-25.13 {type conversions} {expr {2>" "}} 1
-test expr-25.14 {type conversions} {expr {"24.1a" > 24.1}} 1
-test expr-25.15 {type conversions} {expr {24.1 > "24.1a"}} 0
-test expr-25.16 {type conversions} {expr 2+2.5} 4.5
-test expr-25.17 {type conversions} {expr 2+2.5} 4.5
-test expr-25.18 {type conversions} {expr 2.0e2} 200.0
-test expr-25.19 {type conversions} {expr 2.0e15} 2e+15
-test expr-25.20 {type conversions} {expr 10.0} 10.0
+test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
+test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
+test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
+test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
+test expr-7.5 {CompileBitAndExpr: error in equality expr} {
+    catch {expr x==3} msg
+    set msg
+} {syntax error in expression "x==3"} 
+test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
+test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
+test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
+test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
+test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} {
+    catch {expr 2**3&6} msg
+    set msg
+} {syntax error in expression "2**3&6"}
+test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} {
+    catch {expr 2&x} msg
+    set msg
+} {syntax error in expression "2&x"}
+test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
+    list [catch {expr {24.0&3}} msg] $msg
+} {1 {can't use floating-point value as operand of "&"}}
+test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
+    list [catch {expr {"a"&"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "&"}}
 
-# Various error conditions.
+test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
+test expr-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
+test expr-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
+test expr-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
+test expr-8.5 {CompileEqualityExpr: error in relational expr} {
+    catch {expr x>3} msg
+    set msg
+} {syntax error in expression "x>3"} 
+test expr-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0
+test expr-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1
+test expr-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1
+test expr-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1
+test expr-8.10 {CompileEqualityExpr: error compiling equality arm} {
+    catch {expr 2**3==6} msg
+    set msg
+} {syntax error in expression "2**3==6"}
+test expr-8.11 {CompileEqualityExpr: error compiling equality arm} {
+    catch {expr 2!=x} msg
+    set msg
+} {syntax error in expression "2!=x"}
+
+
+test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
+test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
+test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
+test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
+test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+    expr {1<<31}
+} -2147483648
+test expr-9.6 {CompileRelationalExpr: error in shift expr} {
+    catch {expr x>>3} msg
+    set msg
+} {syntax error in expression "x>>3"} 
+test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
+test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
+test expr-9.9 {CompileRelationalExpr: error compiling relational arm} {
+    catch {expr 2**3>6} msg
+    set msg
+} {syntax error in expression "2**3>6"}
+test expr-9.10 {CompileRelationalExpr: error compiling relational arm} {
+    catch {expr 2<x} msg
+    set msg
+} {syntax error in expression "2<x"}
+
+test expr-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
+test expr-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
+test expr-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
+test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test expr-10.5 {CompileShiftExpr: error in add expr} {
+    catch {expr x+3} msg
+    set msg
+} {syntax error in expression "x+3"}
+test expr-10.6 {CompileShiftExpr: simple shift exprs} {expr 0xff>>0x3} 31
+test expr-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936
+test expr-10.8 {CompileShiftExpr: error compiling shift arm} {
+    catch {expr 2**3>>6} msg
+    set msg
+} {syntax error in expression "2**3>>6"}
+test expr-10.9 {CompileShiftExpr: error compiling shift arm} {
+    catch {expr 2<<x} msg
+    set msg
+} {syntax error in expression "2<<x"}
+test expr-10.10 {CompileShiftExpr: runtime error} {
+    list [catch {expr {24.0>>43}} msg] $msg
+} {1 {can't use floating-point value as operand of ">>"}}
+test expr-10.11 {CompileShiftExpr: runtime error} {
+    list [catch {expr {"a"<<"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "<<"}}
 
-test expr-26.1 {error conditions} {
-    list [catch {expr 2+"a"} msg] $msg
+test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
+test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
+test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
+test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test expr-11.5 {CompileAddExpr: error in multiply expr} {
+    catch {expr x*3} msg
+    set msg
+} {syntax error in expression "x*3"}
+test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
+test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
+test expr-11.8 {CompileAddExpr: error compiling add arm} {
+    catch {expr 2**3+6} msg
+    set msg
+} {syntax error in expression "2**3+6"}
+test expr-11.9 {CompileAddExpr: error compiling add arm} {
+    catch {expr 2-x} msg
+    set msg
+} {syntax error in expression "2-x"}
+test expr-11.10 {CompileAddExpr: runtime error} {
+    list [catch {expr {24.0+"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "+"}}
-test expr-26.2 {error conditions} {
-    list [catch {expr 2+4*} msg] $msg
-} {1 {syntax error in expression "2+4*"}}
-test expr-26.3 {error conditions} {
-    list [catch {expr 2+4*(} msg] $msg
-} {1 {syntax error in expression "2+4*("}}
-catch {unset _non_existent_}
-test expr-26.4 {error conditions} {
-    list [catch {expr 2+$_non_existent_} msg] $msg
-} {1 {can't read "_non_existent_": no such variable}}
-set a xx
-test expr-26.5 {error conditions} {
-    list [catch {expr {2+$a}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test expr-26.6 {error conditions} {
-    list [catch {expr {2+[set a]}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test expr-26.7 {error conditions} {
-    list [catch {expr {2+(4}} msg] $msg
-} {1 {unmatched parentheses in expression "2+(4"}}
-test expr-26.8 {error conditions} {
-    list [catch {expr 2/0} msg] $msg $errorCode
-} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
-test expr-26.9 {error conditions} {
-    list [catch {expr 2%0} msg] $msg $errorCode
-} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
-test expr-26.10 {error conditions} {
-    list [catch {expr 2.0/0.0} msg] $msg $errorCode
-} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
-test expr-26.11 {error conditions} {
-    list [catch {expr 2#} msg] $msg
-} {1 {syntax error in expression "2#"}}
-test expr-26.12 {error conditions} {
-    list [catch {expr a.b} msg] $msg
-} {1 {syntax error in expression "a.b"}}
-test expr-26.13 {error conditions} {
+test expr-11.11 {CompileAddExpr: runtime error} {
+    list [catch {expr {"a"-"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+test expr-11.12 {CompileAddExpr: runtime error} {
+    list [catch {expr {3/0}} msg] $msg
+} {1 {divide by zero}}
+test expr-11.13 {CompileAddExpr: runtime error} {
+    list [catch {expr {2.3/0.0}} msg] $msg
+} {1 {divide by zero}}
+
+test expr-12.1 {CompileMultiplyExpr: just unary expr} {expr ~4} -5
+test expr-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5
+test expr-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0
+test expr-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
+test expr-12.5 {CompileMultiplyExpr: error in unary expr} {
+    catch {expr ~x} msg
+    set msg
+} {syntax error in expression "~x"}
+test expr-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765
+test expr-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2
+test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} {
+    catch {expr 2*3%%6} msg
+    set msg
+} {syntax error in expression "2*3%%6"}
+test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} {
+    catch {expr 2*x} msg
+    set msg
+} {syntax error in expression "2*x"}
+test expr-12.10 {CompileMultiplyExpr: runtime error} {
+    list [catch {expr {24.0*"xx"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "*"}}
+test expr-12.11 {CompileMultiplyExpr: runtime error} {
     list [catch {expr {"a"/"b"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "/"}}
-test expr-26.14 {error conditions} {
-    list [catch {expr 2:3} msg] $msg
-} {1 {can't have : operator without ? first}}
-test expr-26.15 {error conditions} {
-    list [catch {expr a@b} msg] $msg
-} {1 {syntax error in expression "a@b"}}
-test expr-26.16 {error conditions} {
-    list [catch {expr a[b} msg] $msg
-} {1 {missing close-bracket}}
-test expr-26.17 {error conditions} {
-    list [catch {expr a`b} msg] $msg
-} {1 {syntax error in expression "a`b"}}
-test expr-26.18 {error conditions} {
-    list [catch {expr \"a\"\{b} msg] $msg
-} {1 {missing close-brace}}
-test expr-26.19 {error conditions} {
-    list [catch {expr a} msg] $msg
-} {1 {syntax error in expression "a"}}
-test expr-26.20 {error conditions} {
-    list [catch expr msg] $msg
-} {1 {wrong # args: should be "expr arg ?arg ...?"}}
-
-# Cancelled evaluation.
-
-test expr-27.1 {cancelled evaluation} {
-    set a 1
-    expr {0&&[set a 2]}
-    set a
-} 1
-test expr-27.2 {cancelled evaluation} {
-    set a 1
-    expr {1||[set a 2]}
-    set a
-} 1
-test expr-27.3 {cancelled evaluation} {
-    set a 1
-    expr {0?[set a 2]:1}
-    set a
-} 1
-test expr-27.4 {cancelled evaluation} {
-    set a 1
-    expr {1?2:[set a 2]}
-    set a
-} 1
-catch {unset x}
-test expr-27.5 {cancelled evaluation} {
-    list [catch {expr {[info exists x] && $x}} msg] $msg
-} {0 0}
-test expr-27.6 {cancelled evaluation} {
-    list [catch {expr {0 && [concat $x]}} msg] $msg
-} {0 0}
-test expr-27.7 {cancelled evaluation} {
-    set one 1
-    list [catch {expr {1 || 1/$one}} msg] $msg
-} {0 1}
-test expr-27.8 {cancelled evaluation} {
-    list [catch {expr {1 || -"string"}} msg] $msg
-} {0 1}
-test expr-27.9 {cancelled evaluation} {
-    list [catch {expr {1 || ("string" * ("x" && "y"))}} msg] $msg
-} {0 1}
-test expr-27.10 {cancelled evaluation} {
-    set x -1.0
-    list [catch {expr {($x > 0) ? round(log($x)) : 0}} msg] $msg
-} {0 0}
-
-# Tcl_ExprBool as used in "if" statements
-
-test expr-28.1 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {2} {set a 2}
-    set a
-} 2
-test expr-28.2 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {0} {set a 2}
-    set a
-} 1
-test expr-28.3 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {1.2} {set a 2}
-    set a
-} 2
-test expr-28.4 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {-1.1} {set a 2}
-    set a
-} 2
-test expr-28.5 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {0.0} {set a 2}
-    set a
-} 1
-test expr-28.6 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {"YES"} {set a 2}
-    set a
-} 2
-test expr-28.7 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {"no"} {set a 2}
-    set a
-} 1
-test expr-28.8 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {"true"} {set a 2}
-    set a
-} 2
-test expr-28.9 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {"fAlse"} {set a 2}
-    set a
-} 1
-test expr-28.10 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {"on"} {set a 2}
-    set a
-} 2
-test expr-28.11 {Tcl_ExprBoolean usage} {
-    set a 1
-    if {"Off"} {set a 2}
-    set a
-} 1
-test expr-28.12 {Tcl_ExprBool usage} {
-    list [catch {if {"abc"} {}} msg] $msg
-} {1 {expected boolean value but got "abc"}}
-test expr-28.13 {Tcl_ExprBool usage} {
-    list [catch {if {"ogle"} {}} msg] $msg
-} {1 {expected boolean value but got "ogle"}}
-test expr-28.14 {Tcl_ExprBool usage} {
-    list [catch {if {"o"} {}} msg] $msg
-} {1 {expected boolean value but got "o"}}
-
-# Operands enclosed in braces
 
-test expr-29.1 {braces} {expr {{abc}}} abc
-test expr-29.2 {braces} {expr {{00010}}} 8
-test expr-29.3 {braces} {expr {{3.1200000}}} 3.12
-test expr-29.4 {braces} {expr {{a{b}{1 {2 3}}c}}} "a{b}{1 {2 3}}c"
-test expr-29.5 {braces} {
-    list [catch {expr "\{abc"} msg] $msg
-} {1 {missing close-brace}}
-
-# Very long values
-
-test expr-30.1 {long values} {
-    set a "0000 1111 2222 3333 4444"
-    set a "$a | $a | $a | $a | $a"
-    set a "$a || $a || $a || $a || $a"
-    expr {$a}
-} {0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 || 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444 | 0000 1111 2222 3333 4444}
-test expr-30.2 {long values} {
-    set a "000000000000000000000000000000"
-    set a "$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a${a}5"
+test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
+test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
+test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
+test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
+test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
+test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
+test expr-13.8 {CompileUnaryExpr: error compiling unary expr} {
+    catch {expr ~x} msg
+    set msg
+} {syntax error in expression "~x"}
+test expr-13.9 {CompileUnaryExpr: error compiling unary expr} {
+    catch {expr !1.x} msg
+    set msg
+} {syntax error in expression "!1.x"}
+test expr-13.10 {CompileUnaryExpr: runtime error} {
+    list [catch {expr {~"xx"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "~"}}
+test expr-13.11 {CompileUnaryExpr: runtime error} {
+    list [catch {expr ~4.0} msg] $msg
+} {1 {can't use floating-point value as operand of "~"}}
+test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
+test expr-13.13 {CompileUnaryExpr: just primary expr} {
+    set a 27
     expr $a
-} 5
-
-# Expressions spanning multiple arguments
-
-test expr-31.1 {multiple arguments to expr command} {
-    expr 4 + ( 6 *12) -3
-} 73
-test expr-31.2 {multiple arguments to expr command} {
-    list [catch {expr 2 + (3 + 4} msg] $msg
-} {1 {unmatched parentheses in expression "2 + (3 + 4"}}
-test expr-31.3 {multiple arguments to expr command} {
-    list [catch {expr 2 + 3 +} msg] $msg
-} {1 {syntax error in expression "2 + 3 +"}}
-test expr-31.4 {multiple arguments to expr command} {
-    list [catch {expr 2 + 3 )} msg] $msg
-} {1 {syntax error in expression "2 + 3 )"}}
-
-# Math functions
-
-test expr-32.1 {math functions in expressions} {
-    expr acos(0.5)
-} {1.0472}
-test expr-32.2 {math functions in expressions} {
-    expr asin(0.5)
-} {0.523599}
-test expr-32.3 {math functions in expressions} {
-    expr atan(1.0)
-} {0.785398}
-test expr-32.4 {math functions in expressions} {
-    expr atan2(2.0, 2.0)
-} {0.785398}
-test expr-32.5 {math functions in expressions} {
-    expr ceil(1.999)
-} {2.0}
-test expr-32.6 {math functions in expressions} {
-    expr cos(.1)
-} {0.995004}
-test expr-32.7 {math functions in expressions} {
-    expr cosh(.1)
-} {1.005}
-test expr-32.8 {math functions in expressions} {
-    expr exp(1.0)
-} {2.71828}
-test expr-32.9 {math functions in expressions} {
-    expr floor(2.000)
-} {2.0}
-test expr-32.10 {math functions in expressions} {
-    expr floor(2.001)
-} {2.0}
-test expr-32.11 {math functions in expressions} {
-    expr fmod(7.3, 3.2)
-} {0.9}
-test expr-32.12 {math functions in expressions} {
-    expr hypot(3.0, 4.0)
-} {5.0}
-test expr-32.13 {math functions in expressions} {
-    expr log(2.8)
-} {1.02962}
-test expr-32.14 {math functions in expressions} {
-    expr log10(2.8)
-} {0.447158}
-test expr-32.15 {math functions in expressions} {
-    expr pow(2.1, 3.1)
-} {9.97424}
-test expr-32.16 {math functions in expressions} {
-    expr sin(.1)
-} {0.0998334}
-test expr-32.17 {math functions in expressions} {
-    expr sinh(.1)
-} {0.100167}
-test expr-32.18 {math functions in expressions} {
-    expr sqrt(2.0)
-} {1.41421}
-test expr-32.19 {math functions in expressions} {
-    expr tan(0.8)
-} {1.02964}
-test expr-32.20 {math functions in expressions} {
-    expr tanh(0.8)
-} {0.664037}
-test expr-32.21 {math functions in expressions} {
-    expr abs(-1.8)
-} {1.8}
-test expr-32.22 {math functions in expressions} {
-    expr abs(10.0)
-} {10.0}
-test expr-32.23 {math functions in expressions} {
-    expr abs(-4)
-} {4}
-test expr-32.24 {math functions in expressions} {
-    expr abs(66)
-} {66}
-test expr-32.25 {math functions in expressions} {nonPortable} {
-    list [catch {expr abs(0x80000000)} msg] $msg
-} {1 {integer value too large to represent}}
-test expr-32.26 {math functions in expressions} {
-    expr double(1)
-} {1.0}
-test expr-32.27 {math functions in expressions} {
-    expr double(1.1)
-} {1.1}
-test expr-32.28 {math functions in expressions} {
-    expr int(1)
-} {1}
-test expr-32.29 {math functions in expressions} {
-    expr int(1.4)
-} {1}
-test expr-32.30 {math functions in expressions} {
-    expr int(1.6)
-} {1}
-test expr-32.31 {math functions in expressions} {
-    expr int(-1.4)
-} {-1}
-test expr-32.32 {math functions in expressions} {
-    expr int(-1.6)
-} {-1}
-test expr-32.33 {math functions in expressions} {
-    list [catch {expr int(1e60)} msg] $msg
-} {1 {integer value too large to represent}}
-test expr-32.34 {math functions in expressions} {
-    list [catch {expr int(-1e60)} msg] $msg
-} {1 {integer value too large to represent}}
-test expr-32.35 {math functions in expressions} {
-    expr round(1.49)
-} {1}
-test expr-32.36 {math functions in expressions} {
-    expr round(1.51)
-} {2}
-test expr-32.37 {math functions in expressions} {
-    expr round(-1.49)
-} {-1}
-test expr-32.38 {math functions in expressions} {
-    expr round(-1.51)
-} {-2}
-test expr-32.39 {math functions in expressions} {
-    list [catch {expr round(1e60)} msg] $msg
-} {1 {integer value too large to represent}}
-test expr-32.40 {math functions in expressions} {
-    list [catch {expr round(-1e60)} msg] $msg
-} {1 {integer value too large to represent}}
-test expr-32.41 {math functions in expressions} {
-    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
-} {0 16.0}
-test expr-32.42 {math functions in expressions} {
-    list [catch {expr hypot(5*.8,3)} msg] $msg
-} {0 5.0}
+} 27
+test expr-13.14 {CompileUnaryExpr: just primary expr} {
+    expr double(27)
+} 27.0
+test expr-13.15 {CompileUnaryExpr: just primary expr} {expr "123"} 123
+test expr-13.16 {CompileUnaryExpr: error in primary expr} {
+    catch {expr [set]} msg
+    set msg
+} {wrong # args: should be "set varName ?newValue?"}
+test expr-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
+test expr-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
+test expr-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
+test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
+test expr-14.6 {CompilePrimaryExpr: literal primary} {
+    format %.6g [expr 3.1400000]
+} 3.14
+test expr-14.7 {CompilePrimaryExpr: literal primary} {expr {{abcde}<{abcdef}}} 1
+test expr-14.8 {CompilePrimaryExpr: literal primary} {expr {{abc\
+def} < {abcdef}}} 1
+test expr-14.9 {CompilePrimaryExpr: literal primary} {expr {{abc\tde} > {abc\tdef}}} 0
+test expr-14.10 {CompilePrimaryExpr: literal primary} {expr {{123}}} 123
+test expr-14.11 {CompilePrimaryExpr: var reference primary} {
+    set i 789
+    list [expr {$i}] [expr $i]
+} {789 789}
+test expr-14.12 {CompilePrimaryExpr: var reference primary} {
+    set i {789}    ;# test expr's aggressive conversion to numeric semantics
+    list [expr {$i}] [expr $i]
+} {789 789}
+test expr-14.13 {CompilePrimaryExpr: var reference primary} {
+    catch {unset a}
+    set a(foo) foo
+    set a(bar) bar
+    set a(123) 123
+    set result ""
+    lappend result [expr $a(123)] [expr {$a(bar)<$a(foo)}]
+    catch {unset a}
+    set result
+} {123 1}
+test expr-14.14 {CompilePrimaryExpr: var reference primary} {
+    set i 123    ;# test "$var.0" floating point conversion hack
+    list [expr $i] [expr $i.0] [expr $i.0/12.0]
+} {123 123.0 10.25}
+test expr-14.15 {CompilePrimaryExpr: var reference primary} {
+    set i 123
+    catch {expr $i.2} msg
+    set msg
+} 123.2
+test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
+    catch {expr {$a(foo}} msg
+    set errorInfo
+} {missing )
+    (parsing index for array "a")
+    while compiling
+"expr"}
+test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+    expr $
+} $
+test expr-14.18 {CompilePrimaryExpr: quoted string primary} {
+    expr "21"
+} 21
+test expr-14.19 {CompilePrimaryExpr: quoted string primary} {
+    set i 123
+    set x 456
+    format %.6g [expr "$i+$x"]
+} 579
+test expr-14.20 {CompilePrimaryExpr: quoted string primary} {
+    set i 3
+    set x 6
+    format %.6g [expr 2+"$i.$x"]
+} 5.6
+test expr-14.21 {CompilePrimaryExpr: error in quoted string primary} {
+    catch {expr "[set]"} msg
+    set msg
+} {wrong # args: should be "set varName ?newValue?"}
+test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
+    expr {[set i 123; set i]}
+} 123
+test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
+    catch {expr {[set]}} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    while compiling
+"expr"}
+test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} {
+    catch {expr {[set i}} msg
+    set errorInfo
+} {missing close-bracket or close-brace
+    while compiling
+"set"
+    while compiling
+"expr"}
+test expr-14.25 {CompilePrimaryExpr: math function primary} {
+    format %.6g [expr exp(1.0)]
+} 2.71828
+test expr-14.26 {CompilePrimaryExpr: math function primary} {
+    format %.6g [expr pow(2.0+0.1,3.0+0.1)]
+} 9.97424
+test expr-14.27 {CompilePrimaryExpr: error in math function primary} {
+    catch {expr sinh::(2.0)} msg
+    set errorInfo
+} {syntax error in expression "sinh::(2.0)"
+    while executing
+"expr sinh::(2.0)"}
+test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
+    expr 2+(3*4)
+} 14
+test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} {
+    catch {expr 2+(3*[set])} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    while compiling
+"expr"}
+test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
+    catch {expr 2+(3*(4+5)} msg
+    set errorInfo
+} {syntax error in expression "2+(3*(4+5)"
+    while executing
+"expr 2+(3*(4+5)"}
+test expr-14.31 {CompilePrimaryExpr: unexpected token} {
+    catch {expr @} msg
+    set errorInfo
+} {syntax error in expression "@"
+    while executing
+"expr @"}
+
+test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
+    catch {expr sinh2.0)} msg
+    set errorInfo
+} {syntax error in expression "sinh2.0)"
+    while executing
+"expr sinh2.0)"}
+test expr-15.2 {CompileMathFuncCall: unknown math function} {
+    catch {expr whazzathuh(1)} msg
+    set errorInfo
+} {unknown math function "whazzathuh"
+    while executing
+"expr whazzathuh(1)"}
+test expr-15.3 {CompileMathFuncCall: too many arguments} {
+    catch {expr sin(1,2,3)} msg
+    set errorInfo
+} {too many arguments for math function
+    while executing
+"expr sin(1,2,3)"}
+test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} {
+    catch {expr sin()} msg
+    set errorInfo
+} {syntax error in expression "sin()"
+    while executing
+"expr sin()"}
+test expr-15.5 {CompileMathFuncCall: too few arguments} {
+    catch {expr pow(1)} msg
+    set errorInfo
+} {too few arguments for math function
+    while executing
+"expr pow(1)"}
+test expr-15.6 {CompileMathFuncCall: missing ')'} {
+    catch {expr sin(1} msg
+    set errorInfo
+} {syntax error in expression "sin(1"
+    while executing
+"expr sin(1"}
 if $gotT1 {
-    test expr-32.43 {math functions in expressions} {
+    test expr-15.7 {CompileMathFuncCall: call registered math function} {
 	expr 2*T1()
     } 246
-    test expr-32.44 {math functions in expressions} {
+    test expr-15.8 {CompileMathFuncCall: call registered math function} {
 	expr T2()*3
     } 1035
-}
-
-test expr-33.1 {conversions and fancy args to math functions} {
-    expr hypot ( 3 , 4 )
-} 5.0
-test expr-33.2 {conversions and fancy args to math functions} {
-    expr hypot ( (2.0+1.0) , 4 )
-} 5.0
-test expr-33.3 {conversions and fancy args to math functions} {
-    expr hypot ( 3 , (3.0 + 1.0) )
-} 5.0
-test expr-33.4 {conversions and fancy args to math functions} {
-    expr cos(acos(0.1))
-} 0.1
 
-test expr-34.1 {errors in math functions} {
-    list [catch {expr func_2(1.0)} msg] $msg
-} {1 {unknown math function "func_2"}}
-test expr-34.2 {errors in math functions} {
-    list [catch {expr func|(1.0)} msg] $msg
-} {1 {syntax error in expression "func|(1.0)"}}
-test expr-34.3 {errors in math functions} {
-    list [catch {expr {hypot("a b", 2.0)}} msg] $msg
-} {1 {argument to math function didn't have numeric value}}
-test expr-34.4 {errors in math functions} {
-    list [catch {expr hypot(1.0 2.0)} msg] $msg
-} {1 {syntax error in expression "hypot(1.0 2.0)"}}
-test expr-34.5 {errors in math functions} {
-    list [catch {expr hypot(1.0, 2.0} msg] $msg
-} {1 {syntax error in expression "hypot(1.0, 2.0"}}
-test expr-34.6 {errors in math functions} {
-    list [catch {expr hypot(1.0 ,} msg] $msg
-} {1 {syntax error in expression "hypot(1.0 ,"}}
-test expr-34.7 {errors in math functions} {
-    list [catch {expr hypot(1.0)} msg] $msg
-} {1 {too few arguments for math function}}
-test expr-34.8 {errors in math functions} {
-    list [catch {expr hypot(1.0, 2.0, 3.0)} msg] $msg
-} {1 {too many arguments for math function}}
-test expr-34.9 {errors in math functions} {
-    list [catch {expr acos(-2.0)} msg] $msg $errorCode
-} {1 {domain error: argument not in valid range} {ARITH DOMAIN {domain error: argument not in valid range}}}
-test expr-34.10 {errors in math functions} {nonPortable} {
-    list [catch {expr pow(-3, 1000001)} msg] $msg $errorCode
-} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
-test expr-34.11 {errors in math functions} {
-    list [catch {expr pow(3, 1000001)} msg] $msg $errorCode
-} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
-test expr-34.12 {errors in math functions} {
-    list [catch {expr -14.0*exp(100000)} msg] $msg $errorCode
-} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
-test expr-34.13 {errors in math functions} {
-    list [catch {expr int(1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-test expr-34.14 {errors in math functions} {
-    list [catch {expr int(-1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-test expr-34.15 {errors in math functions} {
-    list [catch {expr round(1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-test expr-34.16 {errors in math functions} {
-    list [catch {expr round(-1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-if $gotT1 {
-    test expr-34.17 {errors in math functions} {
-	list [catch {expr T1(4)} msg] $msg
-    } {1 {syntax error in expression "T1(4)"}}
+    test expr-15.9 {CompileMathFuncCall: call registered math function} {
+	expr T3(21, 37)
+    } 37
+    test expr-15.10 {CompileMathFuncCall: call registered math function} {
+	expr T3(21.2, 37)
+    } 37.0
+    test expr-15.11 {CompileMathFuncCall: call registered math function} {
+	expr T3(-21.2, -17.5)
+    } -17.5
 }
 
-catch {unset tcl_precision}
-test expr-35.1 {tcl_precision variable} {
-    expr 2.0/3
-} 0.666667
-set tcl_precision 1
-test expr-35.2 {tcl_precision variable} {
-    expr 2.0/3
-} 0.7
-test expr-35.3 {tcl_precision variable} {
-    expr 2.0/3
-} 0.7
-test expr-35.4 {tcl_precision variable} {
-    list [catch {set tcl_precision 0} msg] $msg [expr 2.0/3]
-} {1 {can't set "tcl_precision": improper value for precision} 0.7}
-test expr-35.5 {tcl_precision variable} {
-    list [catch {set tcl_precision 101} msg] $msg [expr 2.0/3]
-} {1 {can't set "tcl_precision": improper value for precision} 0.7}
-test expr-35.6 {tcl_precision variable} {
-    list [catch {set tcl_precision {}} msg] $msg [expr 2.0/3]
-} {1 {can't set "tcl_precision": improper value for precision} 0.7}
-test expr-35.7 {tcl_precision variable} {
-    list [catch {set tcl_precision {1 2 3}} msg] $msg [expr 2.0/3]
-} {1 {can't set "tcl_precision": improper value for precision} 0.7}
-catch {unset tcl_precision}
-test expr-35.8 {tcl_precision variable} {
-    expr 2.0/3
-} 0.666667
-
-test expr-36.1 {ExprLooksLikeInt procedure} {
-    list [catch {expr 0289} msg] $msg
-} {1 {syntax error in expression "0289"}}
-test expr-36.2 {ExprLooksLikeInt procedure} {
-    set x 0289
-    list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test expr-36.3 {ExprLooksLikeInt procedure} {
-    list [catch {expr 0289.1} msg] $msg
-} {0 289.1}
-test expr-36.4 {ExprLooksLikeInt procedure} {
-    set x 0289.1
-    list [catch {expr {$x+1}} msg] $msg
-} {0 290.1}
-test expr-36.5 {ExprLooksLikeInt procedure} {
-    set x {  +22}
-    list [catch {expr {$x+1}} msg] $msg
-} {0 23}
-test expr-36.6 {ExprLooksLikeInt procedure} {
-    set x {	-22}
-    list [catch {expr {$x+1}} msg] $msg
-} {0 -21}
-test expr-36.7 {ExprLooksLikeInt procedure} {nonPortable unixOnly} {
-    list [catch {expr nan} msg] $msg
-} {1 {domain error: argument not in valid range}}
-test expr-36.8 {ExprLooksLikeInt procedure} {
-    list [catch {expr 78e1} msg] $msg
-} {0 780.0}
-test expr-36.9 {ExprLooksLikeInt procedure} {
-    list [catch {expr 24E1} msg] $msg
-} {0 240.0}
-test expr-36.10 {ExprLooksLikeInt procedure} {nonPortable unixOnly} {
-    list [catch {expr 78e} msg] $msg
-} {1 {syntax error in expression "78e"}}
-
-
-# Special test for Pentium arithmetic bug of 1994:
-
-if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
-    puts "Warning: this machine contains a defective Pentium processor"
-    puts "that performs arithmetic incorrectly.  I recommend that you"
-    puts "call Intel customer service immediately at 1-800-628-8686"
-    puts "to request a replacement processor."
-}
+# Check "expr" and computed command names.
+
+test expr-16.1 {expr and computed command names} {
+    set i 0
+    set z expr
+    $z 1+2
+} 3
+
+# Check correct conversion of operands to numbers: If the string looks like
+# an integer, convert to integer. Otherwise, if the string looks like a
+# double, convert to double.
+
+test expr-17.1 {expr and conversion of operands to numbers} {
+    set x [lindex 11 0]
+    catch {expr int($x)}
+    expr {$x}
+} 11
+
+# Check "expr" and interpreter result object resetting before appending
+# an error msg during evaluation of exprs not in {}s
+
+test expr-18.1 {expr and interpreter result object resetting} {
+    proc p {} {
+        set t  10.0
+        set x  2.0
+        set dx 0.2
+        set f  {$dx-$x/10}
+        set g  {-$x/5}
+        set center 1.0
+        set x  [expr $x-$center]
+        set dx [expr $dx+$g]
+        set x  [expr $x+$f+$center]
+        set x  [expr $x+$f+$center]
+        set y  [expr round($x)]
+    }
+    p
+} 3
diff --git a/contrib/tcl/tests/fCmd.test b/contrib/tcl/tests/fCmd.test
new file mode 100644
index 0000000..f53da0c
--- /dev/null
+++ b/contrib/tcl/tests/fCmd.test
@@ -0,0 +1,2083 @@
+# This file tests the tclFCmd.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) fCmd.test 1.30 97/06/23 17:29:36
+#
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+set platform [testgetplatform]
+
+if {$user == "root"} {
+    puts "Skipping fCmd tests.  They depend on not being able to write to"
+    puts "certain directories.  It would be too dangerous to run them as root."
+    return
+}
+
+if {"[info commands testchmod]" != "testchmod"} {
+    puts "Skipping fCmd tests. This application does not seem to have the"
+    puts "testchmod command that is needed to run these tests."
+    return
+}
+
+proc createfile {file {string a}} {
+    set f [open $file w]
+    puts -nonewline $f $string
+    close $f
+    return $string
+}
+
+# 
+# checkcontent --
+#
+#  Ensures that file "file" contains only the string "matchString"
+#  returns 0 if the file does not exist, or has a different content
+#
+proc checkcontent {file matchString} {
+    if {[catch {
+	set f [open $file]
+	set fileString [read $f]
+	close $f 
+    }]} {
+	return 0
+    }
+    return [string match $matchString $fileString]
+}
+
+proc openup {path} {
+    testchmod 777 $path
+    if {[file isdirectory $path]} {
+	catch {
+	    foreach p [glob [file join $path *]] {
+		openup $p
+	    }
+	}
+    }
+}
+
+proc cleanup {args} {
+    foreach p ". $args" {
+	set x ""
+	catch {
+	    set x [glob [file join $p tf*] [file join $p td*]]
+	}
+	foreach file $x {
+	    if {[catch {file delete -force -- $file}]} {
+		openup $file
+		file delete -force -- $file
+	    }
+	}
+    }
+}
+
+proc contents {file} {
+    set f [open $file r]
+    set r [read $f]
+    close $f
+    set r
+}
+
+set testConfig(NT) 0
+set testConfig(95) 0
+
+switch $tcl_platform(os) {
+    "Windows NT" {set testConfig(NT) 1}
+    "Windows 95" {set testConfig(95) 1}
+}
+
+set testConfig(fileSharing) 0
+set testConfig(notFileSharing) 1
+
+if {$tcl_platform(platform) == "macintosh"} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    if {[catch {file attributes foo.dir -readonly 1}] == 0} {
+    	set testConfig(fileSharing) 1
+    	set testConfig(notFileSharing) 0
+    }
+    file delete -force foo.dir
+}
+
+set testConfig(xdev) 0
+
+if {$tcl_platform(platform) == "unix"} {
+    if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
+	set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
+	set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
+	if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
+	    set testConfig(xdev) 1
+	}
+    }
+}
+
+set root [lindex [file split [pwd]] 0]
+
+# A really long file name
+# length of long is 1216 chars, which should be greater than any static
+# buffer or allowable filename.
+
+set long "abcdefghihjllmnopqrstuvwxyz01234567890"
+append long $long
+append long $long
+append long $long
+append long $long
+append long $long
+
+test fCmd-1.1 {TclFileRenameCmd} {
+    cleanup
+    createfile tf1
+    file rename tf1 tf2
+    glob tf*
+} {tf2}
+
+test fCmd-2.1 {TclFileCopyCmd} {
+    cleanup
+    createfile tf1
+    file copy tf1 tf2
+    lsort [glob tf*]
+} {tf1 tf2}
+
+test fCmd-3.1 {FileCopyRename: FileForceOption fails} {
+    list [catch {file rename -xyz} msg] $msg
+} {1 {bad option "-xyz": should be -force or --}}
+test fCmd-3.2 {FileCopyRename: not enough args} {
+    list [catch {file rename xyz} msg] $msg
+} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
+test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {
+    list [catch {file rename xyz ~nonexistantuser} msg] $msg
+} {1 {user "nonexistantuser" doesn't exist}}
+test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {
+    cleanup
+    list [catch {file copy tf1 ~} msg] $msg
+} {1 {error copying "tf1": no such file or directory}}
+test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {
+    cleanup
+    list [catch {file rename tf1 tf2 tf3} msg] $msg
+} {1 {error renaming: target "tf3" is not a directory}}
+test fCmd-3.6 {FileCopyRename: target tf3 is not a directory: !S_ISDIR(target)} {
+    cleanup
+    createfile tf3
+    list [catch {file rename tf1 tf2 tf3} msg] $msg
+} {1 {error renaming: target "tf3" is not a directory}}
+test fCmd-3.7 {FileCopyRename: target exists & is directory} {
+    cleanup
+    file mkdir td1
+    createfile tf1 tf1
+    file rename tf1 td1
+    contents [file join td1 tf1]
+} {tf1}
+test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {
+    cleanup
+    list [catch {file rename tf1 tf2 tf3} msg] $msg
+} {1 {error renaming: target "tf3" is not a directory}}
+test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {
+    cleanup
+    list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
+} {1 {error copying: target "tf3" is not a directory}}
+test fCmd-3.10 {FileCopyRename: just 2 arguments} {
+    cleanup
+    createfile tf1 tf1
+    file rename tf1 tf2
+    contents tf2
+} {tf1}
+test fCmd-3.11 {FileCopyRename: just 2 arguments} {
+    cleanup
+    createfile tf1 tf1
+    file rename -force -force -- tf1 tf2
+    contents tf2
+} {tf1}
+test fCmd-3.12 {FileCopyRename: move each source: 1 source} {
+    cleanup
+    createfile tf1 tf1
+    file mkdir td1
+    file rename tf1 td1
+    contents [file join td1 tf1]
+} {tf1}
+test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {
+    cleanup
+    createfile tf1 tf1
+    createfile tf2 tf2
+    createfile tf3 tf3
+    createfile tf4 tf4
+    file mkdir td1
+    file rename tf1 tf2 tf3 tf4 td1
+    list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
+	[contents [file join td1 tf3]] [contents [file join td1 tf4]]
+} {tf1 tf2 tf3 tf4}
+test fCmd-3.14 {FileCopyRename: FileBasename fails} {
+    cleanup
+    file mkdir td1
+    list [catch {file rename ~nonexistantuser td1} msg] $msg
+} {1 {user "nonexistantuser" doesn't exist}}
+test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {unixOrPc} {
+    cleanup
+    file mkdir td1
+    list [catch {file rename / td1} msg] $msg
+} {1 {error renaming "/" to "td1": file already exists}}
+test fCmd-3.16 {FileCopyRename: break on first error} {
+    cleanup
+    createfile tf1 
+    createfile tf2 
+    createfile tf3 
+    createfile tf4 
+    file mkdir td1
+    createfile [file join td1 tf3]
+    list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
+} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
+
+test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {
+    cleanup
+    file mkdir td1
+    glob td*
+} {td1}
+test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {
+    cleanup
+    file mkdir td1 td2 td3
+    lsort [glob td*]
+} {td1 td2 td3}
+test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {
+    cleanup
+    createfile tf1
+    catch {file mkdir td1 td2 tf1 td3 td4}
+    glob td1 td2 tf1 td3 td4
+} {td1 td2 tf1}
+test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {
+    cleanup
+    list [catch {file mkdir ~nonexistantuser} msg] $msg
+} {1 {user "nonexistantuser" doesn't exist}}
+test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} {
+    cleanup
+    list [catch {file mkdir ""} msg] $msg
+} {1 {can't create directory "": no such file or directory}}
+test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {
+    cleanup
+    file mkdir td1
+    glob td1
+} {td1}
+test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {
+    cleanup
+    file mkdir [file join td1 td2 td3 td4]
+    glob td1 [file join td1 td2]
+} "td1 [file join td1 td2]"
+test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {
+    cleanup
+    file mkdir td1
+    set x [file exist td1]
+    file mkdir td1
+    list $x [file exist td1]
+} {1 1}
+test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {
+    cleanup
+    createfile tf1
+    list [catch {file mkdir tf1} msg] $msg
+} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
+test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {
+    cleanup
+    file mkdir td1
+    set x [file exist td1]
+    file mkdir td1
+    list $x [file exist td1]
+} {1 1}
+test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {unixOnly} {
+    cleanup
+    file mkdir td1/td2/td3
+    testchmod 000 td1/td2
+    set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
+    testchmod 755 td1/td2
+    set msg
+} {1 {can't create directory "td1/td2/td3": permission denied}}
+test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
+    cleanup
+    list [catch {file mkdir nonexistantvolume:} msg] $msg
+} {1 {can't create directory "nonexistantvolume:": invalid argument}}
+test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {
+    cleanup
+    set x [file exist td1]
+    file mkdir td1
+    list $x [file exist td1]
+} {0 1}
+test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly nonPortable} {
+    cleanup
+    list [catch {file mkdir /tf1} msg] $msg
+} {1 {can't create directory "/tf1": permission denied}}
+test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
+    list [catch {file mkdir ${root}:} msg] $msg
+} [subst {1 {can't create directory "${root}:": no such file or directory}}]
+test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {
+    cleanup
+    file mkdir tf1
+    file exists tf1
+} {1}
+
+test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {
+    list [catch {file delete -xyz} msg] $msg
+} {1 {bad option "-xyz": should be -force or --}}
+test fCmd-5.2 {TclFileDeleteCmd: not enough args} {
+    list [catch {file delete -force -force} msg] $msg
+} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
+test fCmd-5.3 {TclFileDeleteCmd: 1 file} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    file mkdir td1
+    file delete tf2
+    glob tf* td*
+} {tf1 td1}
+test fCmd-5.4 {TclFileDeleteCmd: multiple files} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    file mkdir td1
+    set x [list [file exist tf1] [file exist tf2] [file exist td1]]
+    file delete tf1 td1 tf2
+    lappend x [file exist tf1] [file exist tf2] [file exist tf3]
+} {1 1 1 0 0 0}
+test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {unixOrPc} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    file mkdir td1
+    catch {file delete tf1 td1 $root tf2}
+    list [file exist tf1] [file exist tf2] [file exist td1]
+} {0 1 0}
+test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {
+    list [catch {file delete ~nonexistantuser} msg] $msg
+} {1 {user "nonexistantuser" doesn't exist}}
+test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {
+    catch {file delete ~/tf1}
+    createfile ~/tf1
+    file delete ~/tf1
+} {}
+test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {
+    cleanup
+    set x [file exist tf1]
+    file delete tf1
+    list $x [file exist tf1]
+} {0 0}    
+test fCmd-5.9 {TclFileDeleteCmd: is directory} {
+    cleanup
+    file mkdir td1
+    file delete td1
+    file exist td1
+} {0}
+test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {
+    cleanup
+    file mkdir td1/td2
+    list [catch {file delete td1} msg] $msg
+} {1 {error deleting "td1": directory not empty}}
+
+test fCmd-6.1 {CopyRenameOneFile: bad source} {
+    # can't test this, because it's caught by FileCopyRename
+} {}
+test fCmd-6.2 {CopyRenameOneFile: bad target} {
+    # can't test this, because it's caught by FileCopyRename
+} {}
+test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {
+    cleanup
+    list [catch {file rename tf1 tf2} msg] $msg
+} {1 {error renaming "tf1": no such file or directory}}
+test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {
+    cleanup
+    createfile tf1
+    file rename tf1 tf2
+    glob tf*
+} {tf2}
+test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {
+    cleanup
+    createfile tf1
+    file rename tf1 tf2
+    glob tf*
+} {tf2}
+test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly} {
+    cleanup
+    file mkdir td1
+    testchmod 000 td1
+    createfile tf1
+    set msg [list [catch {file rename tf1 td1} msg] $msg]
+    testchmod 755 td1
+    set msg
+} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
+test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {95} {
+    cleanup
+    createfile tf1
+    list [catch {file rename tf1 $long} msg] $msg
+} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
+test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
+    cleanup
+    createfile tf1
+    list [catch {file rename tf1 $long} msg] $msg
+} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
+test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly} {
+    cleanup
+    createfile tf1
+    file rename tf1 tf2
+    glob tf*
+} {tf2}
+test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    list [catch {file rename tf1 tf2} msg] $msg
+} {1 {error renaming "tf1" to "tf2": file already exists}}
+test fCmd-6.11 {CopyRenameOneFile: force == 0} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    list [catch {file rename tf1 tf2} msg] $msg
+} {1 {error renaming "tf1" to "tf2": file already exists}}
+test fCmd-6.12 {CopyRenameOneFile: force != 0} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    file rename -force tf1 tf2
+    glob tf*
+} {tf2}
+test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {
+    cleanup
+    file mkdir td1
+    file mkdir td2
+    createfile [file join td2 td1]
+    list [catch {file rename -force td1 td2} msg] $msg
+} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
+test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {
+    cleanup
+    createfile tf1
+    file mkdir [file join td1 tf1]
+    list [catch {file rename -force tf1 td1} msg] $msg
+} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {
+    cleanup
+    file mkdir [file join td1 td2]
+    file mkdir td2
+    createfile [file join td2 tf1]
+    file rename -force td2 td1
+    file exists [file join td1 td2 tf1]
+} {1}
+test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {
+    cleanup
+    file mkdir [file join td1 td2]
+    createfile [file join td1 td2 tf1]
+    file mkdir td2
+    list [catch {file rename -force td2 td1} msg] $msg
+} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
+test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {
+    cleanup
+    list [catch {file rename -force $root tf1} msg] $msg
+} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
+test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {
+    cleanup
+    file mkdir [file join td1 td2]
+    createfile [file join td1 td2 tf1]
+    file mkdir td2
+    list [catch {file rename -force td2 td1} msg] $msg
+} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
+test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly} {
+    cleanup /tmp
+    createfile tf1
+    file rename tf1 /tmp
+    glob tf* /tmp/tf1
+} {/tmp/tf1}
+test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
+    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
+    file mkdir c:/tcl8975@
+    if [catch {file rename c:/tcl8975@ d:/}] {
+	list d:/tcl8975@
+    } else {
+	set msg [glob c:/tcl8975@ d:/tcl8975@]
+	file delete -force d:/tcl8975@
+	set msg
+    }
+} {d:/tcl8975@}
+test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} {unixOnly} {
+    cleanup /tmp
+    file mkdir td1
+    file rename td1 /tmp
+    glob td* /tmp/td*
+} {/tmp/td1}
+test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} {unixOnly} {
+    cleanup /tmp
+    createfile tf1
+    file rename tf1 /tmp
+    glob tf* /tmp/tf*
+} {/tmp/tf1}
+test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
+    cleanup /tmp
+    file mkdir td1/td2/td3
+    exec chmod 000 td1
+    set msg [list [catch {file rename td1 /tmp} msg] $msg]
+    exec chmod 755 td1
+    set msg 
+} {1 {error renaming "td1": permission denied}}
+test fCmd-6.24 {CopyRenameOneFile: error uses original name} {unixOnly} {
+    cleanup
+    file mkdir ~/td1/td2
+    exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
+    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
+    exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
+    file delete -force ~/td1
+    set msg
+} {1 {error copying "~/td1": permission denied}}
+test fCmd-6.25 {CopyRenameOneFile: error uses original name} {unixOnly} {
+    cleanup
+    file mkdir td2
+    file mkdir ~/td1
+    exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
+    set msg [list [catch {file copy td2 ~/td1} msg] $msg]
+    exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
+    file delete -force ~/td1
+    set msg
+} {1 {error copying "td2" to "~/td1/td2": permission denied}}
+test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} {unixOnly} {
+    cleanup
+    file mkdir ~/td1/td2
+    exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2]
+    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
+    exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2]
+    file delete -force ~/td1
+    set msg
+} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
+test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
+    cleanup /tmp
+    file mkdir td1/td2/td3
+    file mkdir /tmp/td1
+    createfile /tmp/td1/tf1
+    list [catch {file rename -force td1 /tmp} msg] $msg
+} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
+test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
+    cleanup /tmp
+    file mkdir td1/td2/td3
+    exec chmod 000 td1/td2/td3 
+    set msg [list [catch {file rename td1 /tmp} msg] $msg]
+    exec chmod 755 td1/td2/td3 
+    set msg
+} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
+test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} {unixOnly xdev} {
+    cleanup /tmp
+    file mkdir td1/td2/td3
+    file rename td1 /tmp
+    glob td* /tmp/td1/t*
+} {/tmp/td1/td2}
+test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} {unixOnly nonPortable} {
+    cleanup
+    if [file exists /kernel] {
+        set msg [list [catch {file rename /kernel td1} msg] $msg]
+	set a1 {1 {can't unlink "/kernel": permission denied}}
+	expr {$msg == $a1}
+    } else {
+        list 1
+    }
+} {1}
+test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} {unixOnly xdev} {
+    catch {cleanup /tmp}
+    file mkdir /tmp/td1
+    createfile /tmp/td1/tf1
+    file rename /tmp/td1/tf1 tf1
+    list [file exists /tmp/td1/tf1] [file exists tf1]
+} {0 1}
+test fCmd-6.32 {CopyRenameOneFile: copy} {
+    cleanup
+    list [catch {file copy tf1 tf2} msg] $msg
+} {1 {error copying "tf1": no such file or directory}}
+catch {cleanup /tmp}
+
+test fCmd-7.1 {FileForceOption: none} {
+    cleanup
+    file mkdir [file join tf1 tf2]
+    list [catch {file delete tf1} msg] $msg
+} {1 {error deleting "tf1": directory not empty}}
+test fCmd-7.2 {FileForceOption: -force} {
+    cleanup
+    file mkdir [file join tf1 tf2]
+    file delete -force tf1
+} {}
+test fCmd-7.3 {FileForceOption: --} {
+    createfile -tf1
+    file delete -- -tf1
+} {}
+test fCmd-7.4 {FileForceOption: bad option} {
+    createfile -tf1
+    set msg [list [catch {file delete -tf1} msg] $msg]
+    file delete -- -tf1
+    set msg
+} {1 {bad option "-tf1": should be -force or --}}
+test fCmd-7.5 {FileForceOption: multiple times through loop} {
+    createfile --
+    createfile -force
+    file delete -force -force -- -- -force
+    list [catch {glob -- -- -force} msg] $msg
+} {1 {no files matched glob patterns "-- -force"}}
+
+test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOnly nonPortable} {
+    list [catch {file rename ~$user /} msg] $msg
+} "1 {error renaming \"~$user\" to \"/[file tail ~$user]\": permission denied}"
+
+test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
+    cleanup
+    file mkdir td1
+    list [catch {file rename td1 /} msg] $msg
+} {1 {error renaming "td1" to "/td1": permission denied}}
+test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {
+    cleanup
+    list [catch {file rename tf1 tf2} msg] $msg
+} {1 {error renaming "tf1": no such file or directory}}
+test fCmd-9.3 {file rename: comprehensive: file to new name} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    testchmod 444 tf2
+    file rename tf1 tf3
+    file rename tf2 tf4
+    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
+} {{tf3 tf4} 1 0}    
+test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc} {
+    cleanup
+    file mkdir td1 td2
+    testchmod 555 td2
+    file rename td1 td3
+    file rename td2 td4
+    list [lsort [glob td*]] [file writable td3] [file writable td4]
+} {{td3 td4} 1 0}    
+test fCmd-9.5 {file rename: comprehensive: file to self} {
+    cleanup
+    createfile tf1 tf1
+    createfile tf2 tf2
+    testchmod 444 tf2
+    file rename -force tf1 tf1
+    file rename -force tf2 tf2
+    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
+} {tf1 tf2 1 0}    
+test fCmd-9.6 {file rename: comprehensive: dir to self} {unixOrPc} {
+    cleanup
+    file mkdir td1
+    file mkdir td2
+    testchmod 555 td2
+    file rename -force td1 .
+    file rename -force td2 .
+    list [lsort [glob td*]] [file writable td1] [file writable td2]
+} {{td1 td2} 1 0}    
+test fCmd-9.7 {file rename: comprehensive: file to existing file} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    createfile tfs1
+    createfile tfs2
+    createfile tfs3
+    createfile tfs4
+    createfile tfd1
+    createfile tfd2
+    createfile tfd3
+    createfile tfd4
+    testchmod 444 tfs3
+    testchmod 444 tfs4
+    testchmod 444 tfd2
+    testchmod 444 tfd4
+    set msg [list [catch {file rename tf1 tf2} msg] $msg]
+    file rename -force tfs1 tfd1
+    file rename -force tfs2 tfd2
+    file rename -force tfs3 tfd3
+    file rename -force tfs4 tfd4
+    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
+} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
+test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {
+    # Under unix, you can rename a read-only directory, but you can't
+    # move it into another directory.
+
+    cleanup
+    file mkdir td1
+    file mkdir [file join td2 td1]
+    file mkdir tds1
+    file mkdir tds2
+    file mkdir tds3
+    file mkdir tds4
+    file mkdir [file join tdd1 tds1]
+    file mkdir [file join tdd2 tds2]
+    file mkdir [file join tdd3 tds3]
+    file mkdir [file join tdd4 tds4]
+    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
+	testchmod 555 tds3
+	testchmod 555 tds4
+    }
+    if {$tcl_platform(platform) != "macintosh"} {
+    	testchmod 555 [file join tdd2 tds2]
+    	testchmod 555 [file join tdd4 tds4]
+    }
+    set msg [list [catch {file rename td1 td2} msg] $msg]
+    file rename -force tds1 tdd1
+    file rename -force tds2 tdd2
+    file rename -force tds3 tdd3
+    file rename -force tds4 tdd4
+    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
+	set w3 [file writable [file join tdd3 tds3]]
+	set w4 [file writable [file join tdd4 tds4]]
+    } else {
+	set w3 0
+	set w4 0
+    }
+    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
+    [file writable [file join tdd2 tds2]] $w3 $w4
+} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
+test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {
+    cleanup
+    file mkdir tds1
+    file mkdir tds2
+    file mkdir [file join tdd1 tds1 xxx]
+    file mkdir [file join tdd2 tds2 xxx]
+    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
+	testchmod 555 tds2
+    }
+    set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
+    set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
+    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
+	set w2 [file writable tds2]
+    } else {
+	set w2 0
+    }
+    list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
+} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
+test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    file mkdir td1
+    testchmod 444 tf2
+    file rename tf1 [file join td1 tf3]
+    file rename tf2 [file join td1 tf4]
+    list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \
+    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
+} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {
+    cleanup
+    file mkdir td1
+    file mkdir td2
+    file mkdir td3
+    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
+	testchmod 555 td2
+    }
+    file rename td1 [file join td3 td3]
+    file rename td2 [file join td3 td4]
+    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
+	set w4 [file writable [file join td3 td4]]
+    } else {
+        set w4 0
+    }
+    list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
+    [file writable [file join td3 td3]] $w4
+} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
+test fCmd-9.12 {file rename: comprehensive: target exists} {
+    cleanup
+    file mkdir [file join td1 td2] [file join td2 td1]
+    if {$tcl_platform(platform) != "macintosh"} {
+    	testchmod 555 [file join td2 td1]
+    }
+    file mkdir [file join td3 td4] [file join td4 td3]
+    file rename -force td3 td4
+    set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \
+    [catch {file rename td1 td2} msg] $msg]
+    if {$tcl_platform(platform) != "macintosh"} {
+    	testchmod 755 [file join td2 td1]
+    }
+    set msg
+} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
+test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {
+    cleanup
+    file mkdir [file join td1 td2] [file join td2 td1 td4]
+    list [catch {file rename -force td1 td2} msg] $msg
+} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
+test fCmd-9.14 {file rename: comprehensive: dir into self} {
+    cleanup
+    file mkdir td1
+    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
+} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
+test fCmd-9.15 {file rename: comprehensive: source and target incompatible} {
+    cleanup
+    file mkdir td1
+    createfile tf1
+    list [catch {file rename -force td1 tf1} msg] $msg
+} {1 {can't overwrite file "tf1" with directory "td1"}}
+test fCmd-9.16 {file rename: comprehensive: source and target incompatible} {
+    cleanup
+    file mkdir td1/tf1
+    createfile tf1
+    list [catch {file rename -force tf1 td1} msg] $msg
+} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+
+test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {
+    cleanup
+    list [catch {file copy tf1 tf2} msg] $msg
+} {1 {error copying "tf1": no such file or directory}}
+test fCmd-10.2 {file copy: comprehensive: file to new name} {
+    cleanup
+    createfile tf1 tf1
+    createfile tf2 tf2
+    testchmod 444 tf2
+    file copy tf1 tf3
+    file copy tf2 tf4
+    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
+} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
+test fCmd-10.3 {file copy: comprehensive: dir to new name} {unixOrPc} {
+    cleanup
+    file mkdir [file join td1 tdx]
+    file mkdir [file join td2 tdy]
+    testchmod 555 td2
+    file copy td1 td3
+    file copy td2 td4
+    set msg [list [lsort [glob td*]] [glob [file join td3 t*]] \
+	    [glob [file join td4 t*]] [file writable td3] [file writable td4]]
+    if {$tcl_platform(platform) != "macintosh"} {
+    	testchmod 755 td2
+    	testchmod 755 td4
+    }
+    set msg
+} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
+test fCmd-10.4 {file copy: comprehensive: file to existing file} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    createfile tfs1
+    createfile tfs2
+    createfile tfs3
+    createfile tfs4
+    createfile tfd1
+    createfile tfd2
+    createfile tfd3
+    createfile tfd4
+    testchmod 444 tfs3
+    testchmod 444 tfs4
+    testchmod 444 tfd2
+    testchmod 444 tfd4
+    set msg [list [catch {file copy tf1 tf2} msg] $msg]
+    file copy -force tfs1 tfd1
+    file copy -force tfs2 tfd2
+    file copy -force tfs3 tfd3
+    file copy -force tfs4 tfd4
+    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
+} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
+test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {
+    cleanup
+    file mkdir td1
+    file mkdir [file join td2 td1]
+    file mkdir tds1
+    file mkdir tds2
+    file mkdir tds3
+    file mkdir tds4
+    file mkdir [file join tdd1 tds1]
+    file mkdir [file join tdd2 tds2]
+    file mkdir [file join tdd3 tds3]
+    file mkdir [file join tdd4 tds4]
+    if {$tcl_platform(platform) != "macintosh"} {
+	testchmod 555 tds3
+	testchmod 555 tds4
+	testchmod 555 [file join tdd2 tds2]
+	testchmod 555 [file join tdd4 tds4]
+    }
+    set a1 [list [catch {file copy td1 td2} msg] $msg]
+    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
+    set a3 [catch {file copy -force tds2 tdd2}]
+    set a4 [catch {file copy -force tds3 tdd3}]
+    set a5 [catch {file copy -force tds4 tdd4}]
+    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 
+} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
+test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} {unixOrPc} {
+    cleanup
+    file mkdir tds1
+    file mkdir tds2
+    file mkdir [file join tdd1 tds1 xxx]
+    file mkdir [file join tdd2 tds2 xxx]
+    testchmod 555 tds2
+    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
+    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
+    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
+} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
+test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    file mkdir td1
+    testchmod 444 tf2
+    file copy tf1 [file join td1 tf3]
+    file copy tf2 [file join td1 tf4]
+    list [lsort [glob tf*]] [lsort [glob [file join td1 t*]]] \
+    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
+} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} {unixOrPc} {
+    cleanup
+    file mkdir td1
+    file mkdir td2
+    file mkdir td3
+    testchmod 555 td2
+    file copy td1 [file join td3 td3]
+    file copy td2 [file join td3 td4]
+    list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
+    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
+} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
+test fCmd-10.9 {file copy: comprehensive: source and target incompatible} {
+    cleanup
+    file mkdir td1
+    createfile tf1
+    list [catch {file copy -force td1 tf1} msg] $msg
+} {1 {can't overwrite file "tf1" with directory "td1"}}
+test fCmd-10.10 {file copy: comprehensive: source and target incompatible} {
+    cleanup
+    file mkdir [file join td1 tf1]
+    createfile tf1
+    list [catch {file copy -force tf1 td1} msg] $msg
+} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+cleanup    
+
+# old tests    
+
+test fCmd-11.1 {TclFileRenameCmd: -- option } {
+    catch {file delete -force -- -tfa1}
+    set s [createfile -tfa1]
+    file rename -- -tfa1 tfa2
+    set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
+    file delete tfa2
+    set result
+} {1}
+
+test fCmd-11.2 {TclFileRenameCmd: bad option } {
+    catch {file delete -force -- tfa1}
+    set s [createfile tfa1]
+    set r1 [catch {file rename -x tfa1 tfa2}]
+    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
+    file delete tfa1
+    set result
+} {1}
+
+test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
+    catch {file rename -- }
+} {1}
+
+test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {
+     global env
+     set temp $env(HOME)
+     unset env(HOME)
+     set result [catch {file rename tfa ~/foobar }]
+     set env(HOME) $temp
+     set result
+ } {1}
+
+test fCmd-11.5 {TclFileRenameCmd: more than one source and target is not a directory} {
+    catch {file delete -force -- tfa1 tfa2 tfa3}
+    createfile tfa1 
+    createfile tfa2 
+    createfile tfa3 
+    set result [catch {file rename tfa1 tfa2 tfa3}]
+    file delete tfa1 tfa2 tfa3
+    set result
+} {1}
+
+test fCmd-11.6 {TclFileRenameCmd: : single file into directory  } {
+    catch {file delete -force -- tfa1 tfad}
+    set s [createfile tfa1]
+    file mkdir tfad
+    file rename tfa1 tfad
+    set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
+    file delete -force tfad
+    set result
+} {1}
+
+test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory  } {
+    catch {file delete -force -- tfa1 tfa2 tfad}
+    set s1 [createfile tfa1 ]
+    set s2 [createfile tfa2 ]
+    file mkdir tfad
+    file rename tfa1 tfa2 tfad
+    set r1 [checkcontent tfad/tfa1 $s1]
+    set r2 [checkcontent tfad/tfa2 $s2]
+    
+    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
+	    
+    file delete -force tfad
+    set result
+} {1}
+
+test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory } {
+    catch {file delete -force -- tfa tfad}
+    set s [createfile tfa ]
+    file mkdir tfad
+    file mkdir tfad/tfa
+    set r1 [catch {file rename tfa tfad}]
+    set r2 [checkcontent tfa $s]
+    set r3 [file isdir tfad]
+    set result [expr $r1 && $r2 && $r3 ]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+#
+# Coverage tests for renamefile() ;
+#
+test fCmd-12.1 {renamefile: source filename translation failing} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME)
+    set result [catch {file rename ~/tfa1 tfa2}]
+    set env(HOME) $temp
+    set result
+} {1}
+
+test fCmd-12.2 {renamefile: src filename translation failing} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME)
+    set s [createfile tfa1]
+    file mkdir tfad
+    set result [catch {file rename tfa1 ~/tfa2 tfad}]
+    set env(HOME) $temp
+    file delete -force tfad
+    set result
+} {1}
+
+test fCmd-12.3 {renamefile: stat failing on source} {
+    catch {file delete -force -- tfa1 tfa2}
+    set r1 [catch {file rename tfa1 tfa2}]
+    expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
+} {1}
+
+test fCmd-12.4 {renamefile: error renaming file to directory } {
+    catch {file delete -force -- tfa tfad}
+    set s1 [createfile tfa ]
+    file mkdir tfad
+    file mkdir tfad/tfa
+    set r1 [catch {file rename tfa tfad}]
+    set r2 [checkcontent tfa $s1]
+    set r3 [file isdir tfad/tfa]
+    set result [expr $r1 && $r2 && $r3]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-12.5 {renamefile: error renaming directory to file } {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa
+    file mkdir tfad
+    set s [createfile tfad/tfa]
+    set r1 [catch {file rename tfa tfad}]
+    set r2 [checkcontent tfad/tfa $s]
+    set r3 [file isdir tfad]
+    set r4 [file isdir tfa]
+    set result [expr $r1 && $r2 && $r3 && $r4 ]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-12.6 {renamefile: TclRenameFile succeeding } {
+    catch {file delete -force -- tfa1 tfa2}
+    set s [createfile tfa1]
+    file rename tfa1 tfa2
+    set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
+    file delete tfa2
+    set result
+} {1}
+
+test fCmd-12.7 {renamefile: renaming directory into offspring} {
+    catch {file delete -force -- tfad}
+    file mkdir tfad
+    file mkdir tfad/dir
+    set result [catch {file rename tfad tfad/dir}]
+    file delete -force tfad 
+    set result
+} {1}
+
+test fCmd-12.8 {renamefile: generic error } {unixOnly} {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    file mkdir tfa/dir
+    exec chmod 555 tfa
+    set result [catch {file rename tfa/dir tfa2}]
+    exec chmod 777 tfa
+    file delete -force tfa
+    set result
+} {1}
+
+
+test fCmd-12.9 {renamefile: moving a file across volumes } {unixOnly} {
+    catch {file delete -force -- tfa /tmp/tfa}
+    set s [createfile tfa ]
+    file rename tfa /tmp
+    set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
+    file delete /tmp/tfa
+    set result
+} {1}
+
+test fCmd-12.10 {renamefile: moving a directory across volumes } {unixOnly} {
+    catch {file delete -force -- tfad /tmp/tfad}
+    file mkdir tfad
+    set s [createfile tfad/a ]
+    file rename tfad /tmp
+    set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
+    file delete -force /tmp/tfad
+    set result
+} {1}
+
+#
+# Coverage tests for TclCopyFilesCmd()
+#
+test fCmd-13.1 {TclCopyFilesCmd: -force option } {
+    catch {file delete -force -- tfa1}
+    set s [createfile tfa1]
+    file copy -force  tfa1 tfa2
+    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+    file delete tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-13.2 {TclCopyFilesCmd: -- option } {
+    catch {file delete -force -- tfa1}
+    set s [createfile -tfa1]
+    file copy --  -tfa1 tfa2
+    set result [expr [checkcontent tfa2 $s] &&  [checkcontent -tfa1 $s]]
+    file delete -- -tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-13.3 {TclCopyFilesCmd: bad option } {
+    catch {file delete -force -- tfa1}
+    set s [createfile tfa1]
+    set r1 [catch {file copy -x tfa1 tfa2}]
+    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
+    file delete tfa1
+    set result
+} {1}
+
+test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {
+    catch {file copy -- }
+} {1}
+
+test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
+     global env
+     set temp $env(HOME)
+    unset env(HOME)
+     set result [catch {file copy tfa ~/foobar }]
+     set env(HOME) $temp
+     set result
+ } {1}
+
+test fCmd-13.6 {TclCopyFilesCmd: more than one source and target is not a directory} {
+    catch {file delete -force -- tfa1 tfa2 tfa3}
+    createfile tfa1 
+    createfile tfa2 
+    createfile tfa3 
+    set result [catch {file copy tfa1 tfa2 tfa3}]
+    file delete tfa1 tfa2 tfa3
+    set result
+} {1}
+
+test fCmd-13.7 {TclCopyFilesCmd: : single file into directory  } {
+    catch {file delete -force -- tfa1 tfad}
+    set s [createfile tfa1]
+    file mkdir tfad
+    file copy tfa1 tfad
+    set result [expr [checkcontent tfad/tfa1 $s] &&  [checkcontent tfa1 $s]]
+    file delete -force tfad tfa1
+    set result
+} {1}
+
+test fCmd-13.8 {TclCopyFilesCmd: : multiple files into directory  } {
+    catch {file delete -force -- tfa1 tfa2 tfad}
+    set s1 [createfile tfa1 ]
+    set s2 [createfile tfa2 ]
+    file mkdir tfad
+    file copy tfa1 tfa2 tfad
+    set r1 [checkcontent tfad/tfa1 $s1]
+    set r2 [checkcontent tfad/tfa2 $s2]
+    set r3 [checkcontent tfa1 $s1]
+    set r4 [checkcontent tfa2 $s2]
+    set result [expr $r1 && $r2 && $r3 && $r4 ]
+	    
+    file delete -force tfad tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory } {
+    catch {file delete -force -- tfa tfad}
+    set s [createfile tfa ]
+    file mkdir tfad
+    file mkdir tfad/tfa
+    set r1 [catch {file copy tfa tfad}]
+    set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
+    set r3 [file isdir tfad]
+    set result [expr $r1 && $r2 && $r3 ]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+#
+# Coverage tests for copyfile()
+# 
+test fCmd-14.1 {copyfile: source filename translation failing} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME)
+    set result [catch {file copy ~/tfa1 tfa2}]
+    set env(HOME) $temp
+    set result
+} {1}
+
+test fCmd-14.2 {copyfile: dst filename translation failing} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME)
+    set s [createfile tfa1]
+    file mkdir tfad
+    set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
+    set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
+    set env(HOME) $temp
+    file delete -force tfa1 tfad
+    set result
+} {1}
+
+test fCmd-14.3 {copyfile: stat failing on source} {
+    catch {file delete -force -- tfa1 tfa2}
+    set r1 [catch {file copy tfa1 tfa2}]
+    expr $r1 && ![file exists tfa1] && ![file exists tfa2]
+} {1}
+
+test fCmd-14.4 {copyfile: error copying file to directory } {
+    catch {file delete -force -- tfa tfad}
+    set s1 [createfile tfa ]
+    file mkdir tfad
+    file mkdir tfad/tfa
+    set r1 [catch {file copy tfa tfad}]
+    set r2 [checkcontent tfa $s1]
+    set r3 [file isdir tfad]
+    set r4 [file isdir tfad/tfa]
+    set result [expr $r1 && $r2 && $r3 && $r4 ]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+ test fCmd-14.5 {copyfile: error copying directory to file } {
+     catch {file delete -force -- tfa tfad}
+     file mkdir tfa
+     file mkdir tfad
+     set s [createfile tfad/tfa]
+     set r1 [catch {file copy tfa tfad}]
+     set r2 [checkcontent tfad/tfa $s]
+     set r3 [file isdir tfad]
+     set r4 [file isdir tfa]
+     set result [expr $r1 && $r2 && $r3 && $r4 ]
+     file delete -force tfa tfad
+     set result
+} {1}
+
+test fCmd-14.6 {copyfile: copy file succeeding } {
+    catch {file delete -force -- tfa tfa2}
+    set s [createfile tfa]
+    file copy tfa tfa2
+    set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]
+    file delete tfa tfa2
+    set result
+} {1}
+
+test fCmd-14.7 {copyfile: copy directory succeeding } {
+    catch {file delete -force -- tfa tfa2}
+    file mkdir tfa
+    set s [createfile tfa/file]
+    file copy tfa tfa2
+    set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
+    file delete -force tfa tfa2
+    set result
+} {1}
+
+test fCmd-14.8 {copyfile: copy directory failing } {unixOnly} {
+    catch {file delete -force -- tfa}
+    file mkdir tfa/dir/a/b/c
+    exec chmod 000 tfa/dir
+    set r1 [catch {file copy tfa tfa2}]
+    exec chmod 777 tfa/dir
+    set result $r1
+    file delete -force tfa tfa2
+    set result
+} {1}
+
+#
+# Coverage tests for TclMkdirCmd()
+#
+test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME) 
+    set result [catch {file mkdir ~/tfa}]
+    set env(HOME) $temp
+    set result
+} {1}
+#
+# Can Tcl_SplitPath return argc == 0? If so them we need a
+# test for that code.
+#
+test fCmd-15.2 {TclMakeDirsCmd - one directory } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    set result [file isdirectory tfa]
+    file delete tfa
+    set result
+} {1}
+
+test fCmd-15.3 {TclMakeDirsCmd: - two directories } {
+    catch {file delete -force -- tfa1 tfa2}
+    file mkdir tfa1 tfa2
+    set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
+    file delete tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-15.4 {TclMakeDirsCmd - stat failing } {unixOnly} {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    createfile tfa/file
+    exec chmod 000 tfa
+    set result [catch {file mkdir tfa/file}]
+    exec chmod 777 tfa
+    file delete -force tfa
+    set result
+} {1}
+
+test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa/a/b/c
+    set result [file isdir tfa/a/b/c]
+    file delete -force tfa
+    set result
+} {1}
+
+    
+test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file } {
+    catch {file delete -force -- tfa}
+    set s [createfile tfa]
+    set r1 [catch {file mkdir tfa}]
+    set r2 [file isdir tfa]
+    set r3 [file exists tfa]
+    set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
+    file delete tfa
+    set result
+} {1}
+
+test fCmd-15.7 {TclMakeDirsCmd - making several directories } {
+    catch {file delete -force -- tfa1 tfa2}
+    file mkdir tfa1 tfa2/a/b/c
+    set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
+    file delete -force tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {
+    file mkdir tfa
+    file mkdir tfa
+    set result [file isdir tfa]
+    file delete tfa
+    set result
+} {1}
+
+
+# Coverage tests for TclDeleteFilesCommand()
+test fCmd-16.1 { test the -- argument } {
+    catch {file delete -force -- tfa}
+    createfile tfa
+    file delete -- tfa
+    file exists tfa
+} {0}
+
+test fCmd-16.2 { test the -force and -- arguments } {
+    catch {file delete -force -- tfa}
+    createfile tfa
+    file delete -force -- tfa
+    file exists tfa
+} {0}
+
+test fCmd-16.3 { test bad option } {
+    catch {file delete -force -- tfa}
+    createfile tfa
+    set result [catch {file delete -dog tfa}]
+    file delete tfa
+    set result
+} {1}
+
+test fCmd-16.4 { test not enough args } {
+    catch {file delete}
+} {1}
+
+test fCmd-16.5 { test not enough args with options } {
+    catch {file delete --}
+} {1}
+
+test fCmd-16.6 {delete: source filename translation failing} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME)
+    set result [catch {file delete ~/tfa}]
+    set env(HOME) $temp
+    set result
+} {1}
+
+test fCmd-16.7 {remove a non-empty directory without -force } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    createfile tfa/a
+    set result [catch  {file delete tfa }]
+    file delete -force tfa
+    set result
+} {1}
+
+test fCmd-16.8 {remove a normal file } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    createfile tfa/a
+    set result [catch  {file delete tfa }]
+    file delete -force tfa
+    set result
+} {1}
+
+test fCmd-16.9 {error while deleting file } {unixOnly} {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    createfile tfa/a
+    exec chmod 555 tfa
+    set result [catch  {file delete tfa/a }]
+    #######
+    #######  If any directory in a tree that is being removed does not 
+    #######  have write permission, the process will fail!
+    #######  This is also the case with "rm -rf"
+    #######
+    exec chmod 777 tfa
+    file delete -force tfa
+    set result
+} {1}
+
+test fCmd-16.10 {deleting multiple files } {
+    catch {file delete -force -- tfa1 tfa2}
+    createfile tfa1
+    createfile tfa2
+    file delete tfa1 tfa2
+    expr ![file exists tfa1] && ![file exists tfa2]
+} {1}
+
+test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {
+    catch {file delete -force -- tfa}
+    file delete tfa
+    set result 1
+} {1}
+
+# More coverage tests for mkpath()
+ test fCmd-17.1 {mkdir stat failing on target but not ENOENT } {unixOnly} {
+     catch {file delete -force -- tfa1}
+     file mkdir tfa1
+     exec chmod 555 tfa1
+     set result [catch {file mkdir tfa1/tfa2}]
+     exec chmod 777 tfa1
+     file delete -force tfa1
+     set result
+} {1}
+
+test fCmd-17.2 {mkdir several levels deep - relative } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa/a/b
+    set result [file isdir tfa/a/b ]
+    file delete tfa/a/b tfa/a tfa
+    set result
+} {1}
+
+test fCmd-17.3 {mkdir several levels deep - absolute } {
+    catch {file delete -force -- tfa}
+    set f [file join [pwd] tfa a ]
+    file mkdir $f
+    set result [file isdir $f ]
+    file delete $f [file join [pwd] tfa]
+    set result
+} {1}
+
+#
+# Functionality tests for TclFileRenameCmd()
+#
+
+test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} {
+    catch {file delete -force -- tfad}
+    file mkdir tfad/dir
+    cd tfad/dir
+    set s [createfile foo ]
+    file rename  foo bar
+    file rename bar ./foo
+    file rename ./foo bar
+    file rename ./bar ./foo
+    file rename foo ../dir/bar
+    file rename ../dir/bar ./foo
+    file rename ../../tfad/dir/foo ../../tfad/dir/bar
+    file rename [file join [pwd] bar] foo
+    file rename foo [file join [pwd] bar]
+    set result [expr [checkcontent bar $s] && ![file exists foo]]
+    cd ../..
+    file delete -force tfad
+    set result
+} {1}
+
+test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant } {
+    catch {file delete -force -- tfa1 tfa2}
+    file mkdir tfa1
+    file rename tfa1 tfa2
+    set result [expr [file exists tfa2] && ![file exists tfa1]]
+    file delete tfa2
+    set result
+} {1}
+
+test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory  } {
+    catch {file delete -force -- tfa1 tfad1 tfad2}
+    set s [createfile tfa1 ]
+    file mkdir tfad1 tfad2
+    file rename tfa1 tfad1 tfad2
+    set r1 [checkcontent  tfad2/tfa1 $s]
+    set r2 [file isdir tfad2/tfad1]
+    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
+    file delete tfad2/tfa1
+    file delete -force tfad2
+    set result
+} {1}
+
+test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir } {
+    catch {file delete -force -- tfa tfad}
+    set s [createfile tfa ]
+    file mkdir tfad
+    set r1 [catch {file rename tfad tfa}]
+    set r2 [checkcontent tfa $s]
+    set r3 [file isdir tfad]
+    set result [expr $r1 && $r2 && $r3 ]
+    file delete tfa tfad
+    set result
+} {1}
+
+test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir } {
+    catch {file delete -force -- tfa tfad}
+    set s [createfile tfa ]
+    file mkdir tfad/tfa
+    set r1 [catch {file rename tfa tfad}]
+    set r2 [checkcontent tfa $s]
+    set r3 [file isdir tfad/tfa]
+    set result [expr $r1 && $r2 && $r3 ]
+    file delete -force  tfa tfad
+    set result
+} {1}
+
+#
+# On Windows there is no easy way to determine if two files are the same
+#
+test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix}  {
+    catch {file delete -force -- tfa}
+    set s [createfile tfa]
+    set r1 [catch {file rename tfa tfa}]
+    set result [expr $r1 && [checkcontent tfa $s]]
+    file delete tfa
+    set result
+} {1}
+
+test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa tfad/tfa
+    set r1 [catch {file rename tfa tfad}]
+    set result [expr $r1 && [file isdir tfa]]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa tfad/tfa
+    file rename -force tfa tfad
+    set result [expr ![file isdir tfa]]
+    file delete -force tfad
+    set result
+} {1}
+
+test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa tfad/tfa/file
+    set r1 [catch {file rename tfa tfad}]
+    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa tfad/tfa/file
+    set r1 [catch {file rename -force tfa tfad}]
+    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {
+    catch {file delete -force -- tfa1}
+    set r1 [catch {file rename tfa1 tfa2}]
+    set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
+} {1}
+
+test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} {unixOnly} {
+    catch {file delete -force -- tfa1 tfa2 tfa3}
+	
+    set s [createfile tfa1]
+    exec ln -s tfa1 tfa2
+    file rename tfa2 tfa3
+    set t [file type tfa3]
+    set result [expr { $t == "link" }]
+    file delete tfa1 tfa3
+    set result
+} {1}
+
+test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} {unixOnly} {
+    catch {file delete -force -- tfa1 tfa2 tfa3}
+	
+    file mkdir tfa1
+    exec ln -s tfa1 tfa2
+    file rename tfa2 tfa3
+    set t [file type tfa3]
+    set result [expr { $t == "link" }]
+    file delete tfa1 tfa3
+    set result
+} {1}
+
+test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} {unixOnly} {
+    catch {file delete -force -- tfa1 tfa2 tfa3}
+	
+    file mkdir tfa1/a/b/c/d
+    file mkdir tfa2
+    set f [file join [pwd] tfa1/a/b] 
+    set f2 [file join [pwd] {tfa2/b alias}]
+    exec ln -s $f $f2
+    file rename {tfa2/b alias/c} tfa3
+    set r1 [file isdir tfa3]
+    set r2 [file exists tfa1/a/b/c]
+    set result [expr $r1 && !$r2]
+    file delete -force tfa1 tfa2 tfa3
+    set result
+} {1}
+
+test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} {unixOnly} {
+    catch {file delete -force -- tfa1 tfa2 tfalink}
+	
+    file mkdir tfa1
+    set s [createfile tfa2]
+    exec ln -s tfa1 tfalink
+
+    file rename tfa2 tfalink
+    set result [checkcontent tfa1/tfa2 $s ]
+    file delete -force tfa1 tfalink
+    set result
+} {1}
+
+test fCmd-18.16 {TclFileRenameCmd : rename a dangling symlink} {unixOnly} {
+    catch {file delete -force -- tfa1 tfalink}
+	
+    file mkdir tfa1
+    exec ln -s tfa1 tfalink
+    file delete tfa1 
+    file rename tfalink tfa2
+    set result [expr [string compare [file type tfa2] "link"] == 0]
+    file delete tfa2
+    set result
+} {1}
+
+
+#
+# Coverage tests for TclUnixRmdir
+#
+test fCmd-19.1 { remove empty directory } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    file delete tfa
+    file exists tfa
+} {0}
+
+test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly} {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    file mkdir tfa/a
+    exec chmod 555 tfa
+    set result [catch {file delete tfa/a}]
+    exec chmod 777 tfa
+    file delete -force tfa
+    set result
+} {1}
+
+test fCmd-19.3 { recursive remove } {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    file mkdir tfa/a
+    file delete -force tfa
+    file exists tfa
+} {0}
+
+#
+# TclUnixDeleteFile and TraversalDelete are covered by tests from the 
+# TclDeleteFilesCmd suite
+#
+#
+
+#
+# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
+#
+
+test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } {unixOnly} {
+    catch {file delete -force -- tfa}
+    file mkdir tfa
+    file mkdir tfa/a
+    exec chmod 000 tfa/a
+    set result [catch {file delete -force tfa}]
+    exec chmod 777 tfa/a
+    file delete -force tfa
+    set result
+} {1}
+
+
+#
+# Feature testing for TclCopyFilesCmd
+# 
+test fCmd-21.1 {copy : single file to nonexistant } {
+    catch {file delete -force -- tfa1 tfa2}
+    set s [createfile tfa1]
+    file copy tfa1 tfa2
+    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+    file delete tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-21.2 {copy : single dir to nonexistant } {
+    catch {file delete -force -- tfa1 tfa2}
+    file mkdir tfa1
+    file copy tfa1 tfa2
+    set result [expr [file isdir tfa2] && [file isdir tfa1]]
+    file delete tfa1 tfa2
+    set result
+} {1}
+
+test fCmd-21.3 {copy : single file into directory  } {
+    catch {file delete -force -- tfa1 tfad}
+    set s [createfile tfa1]
+    file mkdir tfad
+    file copy tfa1 tfad
+    set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
+    file delete -force tfa1 tfad
+    set result
+} {1}
+
+test fCmd-21.4 {copy : more than one source and target is not a directory} {
+    catch {file delete -force -- tfa1 tfa2 tfa3}
+    createfile tfa1 
+    createfile tfa2 
+    createfile tfa3 
+    set result [catch {file copy tfa1 tfa2 tfa3}]
+    file delete tfa1 tfa2 tfa3
+    set result
+} {1}
+
+test fCmd-21.5 {copy : multiple files into directory  } {
+    catch {file delete -force -- tfa1 tfa2 tfad}
+    set s1 [createfile tfa1 ]
+    set s2 [createfile tfa2 ]
+    file mkdir tfad
+    file copy tfa1 tfa2 tfad
+    set r1 [checkcontent tfad/tfa1 $s1]
+    set r2 [checkcontent tfad/tfa2 $s2]
+    set r3 [checkcontent tfa1 $s1]
+    set r4 [checkcontent tfa2 $s2]
+    set result [expr $r1 && $r2 && $r3 && $r4]
+    file delete -force tfa1 tfa2 tfad
+    set result
+} {1}
+
+test fCmd-21.6 {copy : mixed dirs and files into directory  } {notFileSharing} {
+    catch {file delete -force -- tfa1 tfad1 tfad2}
+    set s [createfile tfa1 ]
+    file mkdir tfad1 tfad2
+    file copy tfa1 tfad1 tfad2
+    set r1 [checkcontent [file join tfad2 tfa1] $s]
+    set r2 [file isdir [file join tfad2 tfad1]]
+    set r3 [checkcontent tfa1 $s]
+    set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
+    file delete -force tfa1 tfad1 tfad2
+    set result
+} {1}
+
+test fCmd-21.7 {TclCopyFilesCmd : copy a dangling link } {unixOnly} {
+    file mkdir tfad1
+    exec ln -s tfad1 tfalink
+    file delete tfad1
+    file copy tfalink tfalink2
+    set result [string match [file type tfalink2] link]
+    file delete tfalink tfalink2 
+    set result
+} {1}
+
+test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly} {
+    file mkdir tfad1
+    exec ln -s tfad1 tfalink
+    file copy tfalink tfalink2
+    set r1 [file type tfalink]
+    set r2 [file type tfalink2]
+    set r3 [file isdir tfad1]
+    set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}]
+    file delete tfad1 tfalink tfalink2
+    set result
+} {1}
+
+test fCmd-21.9 {TclCopyFilesCmd : copy dir with a link in it } {unixOnly} {
+    file mkdir tfad1
+    exec ln -s "[pwd]/tfad1" tfad1/tfalink
+    file copy tfad1 tfad2
+    set result [string match [file type tfad2/tfalink] link]
+    file delete -force tfad1 tfad2
+    set result
+} {1}
+
+test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa [file join tfad tfa]
+    set r1 [catch {file copy tfa tfad}]
+    set result [expr $r1 && [file isdir tfa]]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa [file join tfad tfa file]
+    set r1 [catch {file copy tfa tfad}]
+    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
+    file delete -force tfa tfad
+    set result
+} {1}
+
+test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} {
+    catch {file delete -force -- tfa tfad}
+    file mkdir tfa [file join tfad tfa file]
+    set r1 [catch {file copy -force tfa tfad}]
+    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
+    file delete -force tfa tfad
+    set result
+} {1}
+   
+#
+# Coverage testing for TclpRenameFile
+#
+test fCmd-22.1 { TclpRenameFile : rename and overwrite in a single dir } {
+    catch {file delete -force -- tfa1 tfa2}
+    set s [createfile tfa1]
+    set s2 [createfile tfa2 q]
+	
+    set r1 [catch {rename tfa1 tfa2}]
+    file rename -force tfa1 tfa2
+    set result [expr $r1 && [checkcontent tfa2 $s]]
+    file delete [glob tfa1 tfa2]
+    set result
+} {1}
+
+test fCmd-22.2 { TclpRenameFile : attempt to overwrite itself } {macOrUnix} {
+    catch {file delete -force -- tfa1}
+    set s [createfile tfa1]	
+    file rename -force tfa1 tfa1
+    set result [checkcontent tfa1 $s]
+    file delete tfa1 
+    set result
+} {1}
+
+test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {
+    catch {file delete -force -- d1 tfad}
+    file mkdir d1 [file join tfad d1]
+    set r1 [catch {file rename d1 tfad}]
+    set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
+    file delete -force d1 tfad
+    set result
+} {1}
+
+test fCmd-22.4 { TclpRenameFile : rename dir to dir several levels deep } {
+    catch {file delete -force -- d1 tfad}
+    file mkdir d1 [file join tfad a b c]
+    file rename d1 [file join tfad a b c d1]
+    set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
+    file delete -force [glob d1 tfad]
+    set result
+} {1}
+
+
+#
+# TclMacCopyFile needs to be redone.
+#
+test fCmd-22.5 { TclMacCopyFile : copy and overwrite in a single dir } {
+    catch {file delete -force -- tfa1 tfa2}
+    set s [createfile tfa1]
+    set s2 [createfile tfa2 q]
+
+    set r1 [catch {file copy tfa1 tfa2}]
+    file copy -force tfa1 tfa2
+    set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+    file delete tfa1 tfa2
+    set result
+} {1}
+
+#
+# TclMacMkdir - basic cases are covered elsewhere.
+# Error cases are not covered.
+#
+
+#
+# TclMacRmdir
+# Error cases are not covered.
+#
+
+test fCmd-23.1 { TclMacRmdir : trying to remove a nonempty directory } {
+    catch {file delete -force -- tfad}
+	
+    file mkdir [file join tfad dir]
+	
+    set result [catch {file delete tfad}]
+    file delete -force tfad 
+    set result
+} {1}
+
+#
+# TclMacDeleteFile	
+# Error cases are not covered.
+#
+test fCmd-24.1 { TclMacDeleteFile : deleting a normal file } {
+    catch {file delete -force -- tfa1}
+	
+    createfile tfa1
+    file delete tfa1
+    file exists tfa1
+} {0}
+
+#
+# TclMacCopyDirectory
+# Error cases are not covered.
+#
+test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} {notFileSharing} {
+    catch {file delete -force -- tfad1 tfad2}
+		
+    file mkdir [file join tfad1 a b c]
+    file copy tfad1 tfad2
+    set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
+    file delete -force tfad1 tfad2
+    set result
+} {1}
+
+test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {notFileSharing} {
+    catch {file delete -force -- tfad1 tfad2}
+		
+    file mkdir tfad1
+    file copy tfad1 tfad2
+    set result [expr [file isdir tfad1] && [file isdir tfad2]]
+    file delete tfad1 tfad2
+    set result
+} {1}
+
+test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} {notFileSharing} {
+    catch {file delete -force -- tfad1 tfad2}
+		
+    file mkdir [file join tfad1 x y z]
+    file mkdir [file join tfad2 dir]
+    file copy tfad1 [file join tfad2 dir]
+    set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
+    file delete -force tfad1 tfad2
+    set result
+} {1}
+
+#
+# Functionality tests for TclDeleteFilesCmd
+#
+
+test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly} {
+    catch {file delete -force -- tfad1 tfad2}
+		
+    file mkdir tfad1
+    exec ln -s tfad1 tfalink
+    file delete tfalink
+
+    set r1 [file isdir tfad1]
+    set r2 [file exists tfalink]
+    
+    set result [expr $r1 && !$r2]
+    file delete tfad1
+    set result
+} {1}
+
+test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly} {
+    catch {file delete -force -- tfad1 tfad2}
+		
+    file mkdir tfad1
+    file mkdir tfad2
+    exec ln -s tfad1 [file join tfad2 link]
+    file delete -force tfad2
+
+    set r1 [file isdir tfad1]
+    set r2 [file exists tfad2]
+    
+    set result [expr $r1 && !$r2]
+    file delete tfad1
+    set result
+} {1}
+
+test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly} {
+    catch {file delete -force -- tfad1 tfad2}
+		
+    file mkdir tfad1
+    exec ln -s tfad1 tfad2
+    file delete tfad1
+    file delete tfad2
+
+    set r1 [file exists tfad1]
+    set r2 [file exists tfad2]
+    
+    set result [expr !$r1 && !$r2]
+    set result
+} {1}
+
+test fCmd-27.1 {TclFileAttrsCmd - wrong # args} {
+    list [catch {file attributes a b c d} msg] $msg
+} {1 {wrong # args: must be "file attributes name ?option? ?value? ?option value? ..."}}
+test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {
+    testsetplatform unix
+    list [catch {file attributes ~_bad_user} msg] $msg [testsetplatform $platform]
+} {1 {user "_bad_user" doesn't exist} {}}
+test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
+    catch {file delete -force -- foo.tmp}
+    createfile foo.tmp
+    list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
+} {0 1 {}}
+test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
+    catch {file delete -force -- foo.tmp}
+    createfile foo.tmp
+    set attrs [file attributes foo.tmp]
+    list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
+} {0 {}}
+
+set testConfig(tclGroup) 0
+if {($tcl_platform(platform) == "macintosh") \
+	|| ($tcl_platform(platform) == "windows")} {
+    set testConfig(tclGroup) 1
+} elseif {[catch {exec {groups}} groupList] == 0} {
+    if {[lsearch $groupList tcl] != -1} {
+	set testConfig(tclGroup) 1
+    }
+}
+
+test fCmd-27.5 {TclFileAttrsCmd - setting one option} {tclGroup} {
+    catch {file delete -force -- foo.tmp}
+    createfile foo.tmp
+    set attrs [file attributes foo.tmp]
+    list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
+} {0 {} {}}
+test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {tclGroup} {
+    catch {file delete -force -- foo.tmp}
+    createfile foo.tmp
+    set attrs [file attributes foo.tmp]
+    list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
+} {0 {} {}}
+
+cleanup
diff --git a/contrib/tcl/tests/fileName.test b/contrib/tcl/tests/fileName.test
index abb3eb8..f7f4594 100644
--- a/contrib/tcl/tests/fileName.test
+++ b/contrib/tcl/tests/fileName.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) fileName.test 1.23 96/07/31 11:46:11
+# SCCS: @(#) fileName.test 1.28 97/06/23 17:30:15
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -1095,14 +1095,11 @@ test filename-11.13 {Tcl_GlobCmd} {
 catch {
     set oldhome $env(HOME)
     set env(HOME) [pwd]
-    removeDirectory globTest
-    makeDirectory globTest
-    makeDirectory globTest/a1
-    makeDirectory globTest/a2
-    makeDirectory globTest/a3
-    makeDirectory globTest/a1/b1
-    makeDirectory globTest/a1/b2
-    makeDirectory globTest/a2/b3
+    file delete -force globTest
+    file mkdir globTest/a1/b1
+    file mkdir globTest/a1/b2
+    file mkdir globTest/a2/b3
+    file mkdir globTest/a3
     close [open globTest/x1.c w]
     close [open globTest/y1.c w]
     close [open globTest/z1.c w]
@@ -1140,7 +1137,7 @@ if {$tcl_platform(platform) == "macintosh"} {
 }
 set x1 x1.c
 set y1 y1.c
-test filename-12.4 {simple globbing} {unixOrPC} {
+test filename-12.4 {simple globbing} {unixOrPc} {
     lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
 } "$globPreResult$x1 $globPreResult$y1"
 test filename-12.5 {simple globbing} {unixExecs} {
@@ -1183,89 +1180,89 @@ test filename-13.10 {globbing with brace substitution} {unixExecs} {
 test filename-13.11 {globbing with brace substitution} {unixOrPc unixExecs} {
     list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
 } {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
-test filename-13.11 {globbing with brace substitution} {macOnly} {
+test filename-13.12 {globbing with brace substitution} {macOnly} {
     list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
 } {0 {:globTest:x1.c :globTest:x,z1.c :globTest:z1.c}}
-test filename-13.12 {globbing with brace substitution} {unixExecs} {
+test filename-13.13 {globbing with brace substitution} {unixExecs} {
     lsort [glob globTest/{a,b,x,y}1.c]
 } [list $globPreResult$x1 $globPreResult$y1]
-test filename-13.13 {globbing with brace substitution} {unixOrPc unixExecs} {
+test filename-13.14 {globbing with brace substitution} {unixOrPc unixExecs} {
     lsort [glob {globTest/{x1,y2,weird name}.c}]
 } {{globTest/weird name.c} globTest/x1.c}
-test filename-13.13 {globbing with brace substitution} {macOnly} {
+test filename-13.15 {globbing with brace substitution} {macOnly} {
     lsort [glob {globTest/{x1,y2,weird name}.c}]
 } {{:globTest:weird name.c} :globTest:x1.c}
-test filename-13.14 {globbing with brace substitution} {unixOrPc unixExecs} {
+test filename-13.16 {globbing with brace substitution} {unixOrPc unixExecs} {
     lsort [glob globTest/{x1.c,a1/*}]
 } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
-test filename-13.14 {globbing with brace substitution} {macOnly} {
+test filename-13.17 {globbing with brace substitution} {macOnly} {
     lsort [glob globTest/{x1.c,a1/*}]
 } {:globTest:a1:b1 :globTest:a1:b2 :globTest:x1.c}
-test filename-13.15 {globbing with brace substitution} {unixOrPc unixExecs} {
+test filename-13.18 {globbing with brace substitution} {unixOrPc unixExecs} {
     lsort [glob globTest/{x1.c,{a},a1/*}]
 } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
-test filename-13.15 {globbing with brace substitution} {macOnly} {
+test filename-13.19 {globbing with brace substitution} {macOnly} {
     lsort [glob globTest/{x1.c,{a},a1/*}]
 } {:globTest:a1:b1 :globTest:a1:b2 :globTest:x1.c}
-test filename-13.16 {globbing with brace substitution} {unixOrPc unixExecs} {
+test filename-13.20 {globbing with brace substitution} {unixOrPc unixExecs} {
     lsort [glob globTest/{a,x}1/*/{x,y}*]
 } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-13.16 {globbing with brace substitution} {macOnly} {
+test filename-13.21 {globbing with brace substitution} {macOnly} {
     lsort [glob globTest/{a,x}1/*/{x,y}*]
 } {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
-test filename-13.17 {globbing with brace substitution} {unixExecs} {
+test filename-13.22 {globbing with brace substitution} {unixExecs} {
     list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
 } {1 {unmatched open-brace in file name}}
 
 test filename-14.1 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob g*/*.c]
 } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.1 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.2 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob g*/*.c]
 } {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.2 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.3 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob globTest/?1.c]
 } {globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.2 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob globTest/?1.c]
 } {:globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.3 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.5 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob */*/*/*.c]
 } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-14.3 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob */*/*/*.c]
 } {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
-test filename-14.4 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.7 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob globTest/*]
 } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.8 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob globTest/*]
 } {:globTest:.1 :globTest:a1 :globTest:a2 :globTest:a3 {:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.5 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.9 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob globTest/.*]
 } {globTest/. globTest/.. globTest/.1}
-test filename-14.5 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.10 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob globTest/.*]
 } {:globTest:.1}
-test filename-14.6 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.11 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob globTest/*/*]
 } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
-test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.12 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob globTest/*/*]
 } {:globTest:a1:b1 :globTest:a1:b2 :globTest:a2:b3}
-test filename-14.7 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.13 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob {globTest/[xyab]1.*}]
 } {globTest/x1.c globTest/y1.c}
-test filename-14.7 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.14 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob {globTest/[xyab]1.*}]
 } {:globTest:x1.c :globTest:y1.c}
-test filename-14.8 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.15 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     lsort [glob globTest/*/]
 } {globTest/a1/ globTest/a2/ globTest/a3/}
-test filename-14.8 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.16 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob globTest/*/]
 } {:globTest:a1: :globTest:a2: :globTest:a3:}
-test filename-14.9 {asterisks, question marks, and brackets} {unixExecs} {
+test filename-14.17 {asterisks, question marks, and brackets} {unixExecs} {
     global env
     set temp $env(HOME)
     set env(HOME) [file join $env(HOME) globTest]
@@ -1273,25 +1270,25 @@ test filename-14.9 {asterisks, question marks, and brackets} {unixExecs} {
     set env(HOME) $temp
     set result
 } [list 0 [list [file join $env(HOME) globTest z1.c]]]
-test filename-14.10 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
+test filename-14.18 {asterisks, question marks, and brackets} {unixExecs unixOrPc} {
     list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
 } {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
-test filename-14.10 {asterisks, question marks, and brackets} {macOnly} {
+test filename-14.19 {asterisks, question marks, and brackets} {macOnly} {
     list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
 } {0 {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}}
-test filename-14.11 {asterisks, question marks, and brackets} {
+test filename-14.20 {asterisks, question marks, and brackets} {
     list [catch {glob -nocomplain goo/*} msg] $msg
 } {0 {}}
-test filename-14.12 {asterisks, question marks, and brackets} {
+test filename-14.21 {asterisks, question marks, and brackets} {
     list [catch {glob globTest/*/gorp} msg] $msg
 } {1 {no files matched glob pattern "globTest/*/gorp"}}
-test filename-14.13 {asterisks, question marks, and brackets} {
+test filename-14.22 {asterisks, question marks, and brackets} {
     list [catch {glob goo/* x*z foo?q} msg] $msg
 } {1 {no files matched glob patterns "goo/* x*z foo?q"}}
-test filename-14.14 {slash globbing} {unixOrPc} {
+test filename-14.23 {slash globbing} {unixOrPc} {
     glob /
 } /
-test filename-14.15 {slash globbing} {pcOnly} {
+test filename-14.24 {slash globbing} {pcOnly} {
     glob {\\}
 } /
 
@@ -1327,9 +1324,9 @@ if {$tcl_platform(platform) == "unix"} {
 if {$tcl_platform(platform) == "windows"} {
     set temp [pwd]
     cd c:/
-    exec rm -rf globTest
     catch {
-	exec mkdir globTest
+	removeDirectory globTest
+	makeDirectory globTest
 	close [open globTest/x1.BAT w]
 	close [open globTest/y1.Bat w]
 	close [open globTest/z1.bat w]
@@ -1369,12 +1366,12 @@ if {$tcl_platform(platform) == "windows"} {
 	lsort [glob c:\\\\globTest\\\\*.bat]
     } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
 
-    exec rm -rf globTest
+    removeDirectory globTest
 
     if $testConfig(nonPortable) {
 	cd //gaspode/d
-	exec rm -rf globTest
-	exec mkdir globTest
+	removeDirectory globTest
+	makeDirectory globTest
 
 	close [open globTest/x1.BAT w]
 	close [open globTest/y1.Bat w]
@@ -1387,7 +1384,7 @@ if {$tcl_platform(platform) == "windows"} {
 	    glob {\\\\gaspode\\d\\*Test}
 	} //gaspode/d/globTest
 
-	exec rm -rf globTest
+	removeDirectory globTest
     }	    
 
     cd $temp
diff --git a/contrib/tcl/tests/for-old.test b/contrib/tcl/tests/for-old.test
new file mode 100644
index 0000000..354f3d6
--- /dev/null
+++ b/contrib/tcl/tests/for-old.test
@@ -0,0 +1,66 @@
+# Commands covered:  for, continue, break
+#
+# This file contains the original set of tests for Tcl's for command.
+# Since the for command is now compiled, a new set of tests covering
+# the new implementation is in the file "for.test". Sourcing this file
+# into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# 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.
+#
+# SCCS: @(#) for-old.test 1.14 97/01/13 13:42:18
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Check "for" and its use of continue and break.
+
+catch {unset a i}
+test for-old-1.1 {for tests} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3 4 5}
+test for-old-1.2 {for tests} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 continue
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3 5}
+test for-old-1.3 {for tests} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3}
+test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1
+test for-old-1.5 {for tests} {
+    catch {for 1 2 3} msg
+    set msg
+} {wrong # args: should be "for start test next command"}
+test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
+test for-old-1.7 {for tests} {
+    catch {for 1 2 3 4 5} msg
+    set msg
+} {wrong # args: should be "for start test next command"}
+test for-old-1.8 {for tests} {
+    set a {xyz}
+    for {set i 1} {$i<6} {set i [expr $i+1]} {}
+    set a
+} xyz
+test for-old-1.9 {for tests} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
+	set a [concat $a $i]
+    }
+    set a
+} {1 2 3}
diff --git a/contrib/tcl/tests/for.test b/contrib/tcl/tests/for.test
index 16d8c9c..7b518fe 100644
--- a/contrib/tcl/tests/for.test
+++ b/contrib/tcl/tests/for.test
@@ -1,211 +1,592 @@
-# Commands covered:  foreach, for, continue, break
+# Commands covered:  for, continue, break
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 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.
 #
-# SCCS: @(#) for.test 1.11 96/02/16 08:55:55
+# SCCS: @(#) for.test 1.9 97/06/23 18:40:35
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
-# Basic "foreach" operation.
+# Basic "for" operation.
 
-test for-1.1 {basic foreach tests} {
+test for-1.1 {TclCompileForCmd: missing initial command} {
+    list [catch {for} msg] $msg
+} {1 {wrong # args: should be "for start test next command"}}
+test for-1.2 {TclCompileForCmd: error in initial command} {
+    list [catch {for {set}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
+    while compiling
+"for"}}
+catch {unset i}
+test for-1.3 {TclCompileForCmd: missing test expression} {
+    catch {for {set i 0}} msg
+    set msg
+} {wrong # args: should be "for start test next command"}
+test for-1.4 {TclCompileForCmd: error in test expression} {
+    catch {for {set i 0} {$i<}} msg
+    set errorInfo
+} {wrong # args: should be "for start test next command"
+    while compiling
+"for"}
+test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
+    set i 0
+    for {} "$i > 5" {incr i} {}
+} {}
+test for-1.6 {TclCompileForCmd: missing "next" command} {
+    catch {for {set i 0} {$i < 5}} msg
+    set msg
+} {wrong # args: should be "for start test next command"}
+test for-1.7 {TclCompileForCmd: missing command body} {
+    catch {for {set i 0} {$i < 5} {incr i}} msg
+    set msg
+} {wrong # args: should be "for start test next command"}
+test for-1.8 {TclCompileForCmd: error compiling command body} {
+    catch {for {set i 0} {$i < 5} {incr i} {set}} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    ("for" body line 1)
+    while compiling
+"for"}
+catch {unset a}
+test for-1.9 {TclCompileForCmd: simple command body} {
     set a {}
-    foreach i {a b c d} {
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
 	set a [concat $a $i]
     }
     set a
-} {a b c d}
-test for-1.2 {basic foreach tests} {
+} {1 2 3}
+test for-1.10 {TclCompileForCmd: command body in quotes} {
+    set a {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
+    set a
+} {xxxxx}
+test for-1.11 {TclCompileForCmd: computed command body} {
+    catch {unset x1}
+    catch {unset bb}
+    catch {unset x2}
+    set x1 {append a x1; }
+    set bb {break}
+    set x2 {; append a x2}
     set a {}
-    foreach i {a b {{c d} e} {123 {{x}}}} {
-	set a [concat $a $i]
-    }
+    for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
     set a
-} {a b {c d} e 123 {{x}}}
-test for-1.3 {basic foreach tests} {catch {foreach} msg} 1
-test for-1.4 {basic foreach tests} {
-    catch {foreach} msg
-    set msg
-} {wrong # args: should be "foreach varList list ?varList list ...? command"}
-test for-1.5 {basic foreach tests} {catch {foreach i} msg} 1
-test for-1.6 {basic foreach tests} {
-    catch {foreach i} msg
-    set msg
-} {wrong # args: should be "foreach varList list ?varList list ...? command"}
-test for-1.7 {basic foreach tests} {catch {foreach i j} msg} 1
-test for-1.8 {basic foreach tests} {
-    catch {foreach i j} msg
-    set msg
-} {wrong # args: should be "foreach varList list ?varList list ...? command"}
-test for-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1
-test for-1.10 {basic foreach tests} {
-    catch {foreach i j k l} msg
-    set msg
-} {wrong # args: should be "foreach varList list ?varList list ...? command"}
-test for-1.11 {basic foreach tests} {
+} {x1}
+test for-1.12 {TclCompileForCmd: error in "next" command} {
+    catch {for {set i 0} {$i < 5} {set} {puts $i}} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    ("for" loop-end command)
+    while compiling
+"for"}
+test for-1.13 {TclCompileForCmd: long command body} {
     set a {}
-    foreach i {} {
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
 	set a [concat $a $i]
     }
     set a
+} {1 2 3}
+test for-1.14 {TclCompileForCmd: for command result} {
+    set a [for {set i 0} {$i < 5} {incr i} {}]
+    set a
+} {}
+test for-1.15 {TclCompileForCmd: for command result} {
+    set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
+    set a
 } {}
-test for-1.11 {foreach errors} {
-    list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg
-} {1 {list element in braces followed by "{b}" instead of space}}
-test for-1.12 {foreach errors} {
-    list [catch {foreach a {{1 2}3} {}} msg] $msg
-} {1 {list element in braces followed by "3" instead of space}}
-catch {unset a}
-test for-1.13 {foreach errors} {
-    catch {unset a}
-    set a(0) 44
-    list [catch {foreach a {1 2 3} {}} msg] $msg
-} {1 {couldn't set loop variable: "a"}}
-catch {unset a}
-test for-1.14 {parallel foreach tests} {
-    set x {}
-    foreach {a b} {1 2 3 4} {
-	append x $b $a
-    }
-    set x
-} {2143}
-test for-1.15 {parallel foreach tests} {
-    set x {}
-    foreach {a b} {1 2 3 4 5} {
-	append x $b $a
-    }
-    set x
-} {21435}
-test for-1.16 {parallel foreach tests} {
-    set x {}
-    foreach a {1 2 3} b {4 5 6} {
-	append x $b $a
-    }
-    set x
-} {415263}
-test for-1.17 {parallel foreach tests} {
-    set x {}
-    foreach a {1 2 3} b {4 5 6 7 8} {
-	append x $b $a
-    }
-    set x
-} {41526378}
-test for-1.18 {parallel foreach tests} {
-    set x {}
-    foreach {a b} {a b A B aa bb} c {c C cc CC} {
-	append x $a $b $c
-    }
-    set x
-} {abcABCaabbccCC}
-test for-1.19 {parallel foreach tests} {
-    set x {}
-    foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
-	append x $a $b $c $d $e
-    }
-    set x
-} {111112222233333}
-test for-1.20 {parallel foreach tests} {
-    set x {}
-    foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
-	append x $a $b $c $d $e
-    }
-    set x
-} {1111 2222334}
 
-# Check "continue".
+# Check "for" and "continue".
 
-test for-2.1 {continue tests} {catch continue} 4
-test for-2.2 {continue tests} {
+test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
+    catch {continue foo} msg
+    set msg
+} {wrong # args: should be "continue"}
+test for-2.2 {TclCompileContinueCmd: continue result} {
+    catch continue
+} 4
+test for-2.3 {continue tests} {
     set a {}
-    foreach i {a b c d} {
-	if {[string compare $i "b"] == 0} continue
+    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+	if {$i == 2} continue
 	set a [concat $a $i]
     }
     set a
-} {a c d}
-test for-2.3 {continue tests} {
+} {1 3 4}
+test for-2.4 {continue tests} {
     set a {}
-    foreach i {a b c d} {
-	if {[string compare $i "b"] != 0} continue
+    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+	if {$i != 2} continue
 	set a [concat $a $i]
     }
     set a
-} {b}
-test for-2.4 {continue tests} {catch {continue foo} msg} 1
-test for-2.5 {continue tests} {
-    catch {continue foo} msg
+} {2}
+test for-2.5 {continue tests, nested loops} {
+    set msg {}
+    for {set i 1} {$i <= 4} {incr i} {
+	for {set a 1} {$a <= 2} {incr a} {
+            if {$i>=2 && $a>=2} continue
+            set msg [concat $msg "$i.$a"]
+        }
+    }
     set msg
-} {wrong # args: should be "continue"}
-
-# Check "break".
-
-test for-3.1 {break tests} {catch break} 3
-test for-3.2 {break tests} {
+} {1.1 1.2 2.1 3.1 4.1}
+test for-2.6 {continue tests, long command body} {
     set a {}
-    foreach i {a b c d} {
-	if {[string compare $i "c"] == 0} break
+    for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==2 continue
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
 	set a [concat $a $i]
     }
     set a
-} {a b}
-test for-3.3 {break tests} {catch {break foo} msg} 1
-test for-3.4 {break tests} {
+} {1 3}
+
+# Check "for" and "break".
+
+test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
     catch {break foo} msg
     set msg
 } {wrong # args: should be "break"}
-
-# Check "for" and its use of continue and break.
-
-test for-4.1 {for tests} {
+test for-3.2 {TclCompileBreakCmd: break result} {
+    catch break
+} 3
+test for-3.3 {break tests} {
     set a {}
-    for {set i 1} {$i<6} {set i [expr $i+1]} {
+    for {set i 1} {$i <= 4} {incr i} {
+	if {$i == 3} break
 	set a [concat $a $i]
     }
     set a
-} {1 2 3 4 5}
-test for-4.2 {for tests} {
-    set a {}
-    for {set i 1} {$i<6} {set i [expr $i+1]} {
-	if $i==4 continue
-	set a [concat $a $i]
+} {1 2}
+test for-3.4 {break tests, nested loops} {
+    set msg {}
+    for {set i 1} {$i <= 4} {incr i} {
+	for {set a 1} {$a <= 2} {incr a} {
+            if {$i>=2 && $a>=2} break
+            set msg [concat $msg "$i.$a"]
+        }
     }
-    set a
-} {1 2 3 5}
-test for-4.3 {for tests} {
+    set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test for-3.5 {break tests, long command body} {
     set a {}
     for {set i 1} {$i<6} {set i [expr $i+1]} {
+	if $i==2 continue
+	if $i==5 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
 	if $i==4 break
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
 	set a [concat $a $i]
     }
     set a
-} {1 2 3}
-test for-4.4 {for tests} {catch {for 1 2 3} msg} 1
-test for-4.5 {for tests} {
-    catch {for 1 2 3} msg
-    set msg
-} {wrong # args: should be "for start test next command"}
-test for-4.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
-test for-4.7 {for tests} {
-    catch {for 1 2 3 4 5} msg
-    set msg
-} {wrong # args: should be "for start test next command"}
-test for-4.8 {for tests} {
-    set a {xyz}
-    for {set i 1} {$i<6} {set i [expr $i+1]} {}
-    set a
-} xyz
-test for-4.9 {for tests} {
-    set a {}
-    for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
-	set a [concat $a $i]
+} {1 3}
+# A simplified version of exmh's mail formatting routine to stress "for",
+# "break", "while", and "if".
+proc formatMail {} {
+    array set lines {
+        0 {Return-path: george@tcl} \
+        1 {Return-path: <george@tcl>} \
+        2 {Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)} \
+        3 {	id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700} \
+        4 {Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>} \
+        5 {X-mailer: exmh version 1.6.9 8/22/96} \
+        6 {Mime-version: 1.0} \
+        7 {Content-type: text/plain; charset=iso-8859-1} \
+        8 {Content-transfer-encoding: quoted-printable} \
+        9 {Content-length: 2162} \
+        10 {To: fred} \
+        11 {Subject: tcl7.6} \
+        12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
+        13 {From: George <george@tcl>} \
+        14 {The Tcl 7.6 and Tk 4.2 releases} \
+        15 {} \
+        16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
+        17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
+        18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
+        19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
+        20 {} \
+        21 {} \
+        22 {What's new } \
+        23 {} \
+        24 {The most important changes in the releases are summarized below. See the README} \
+        25 {and changes files in the distributions for more complete information on what has} \
+        26 {changed, including both feature changes and bug fixes. } \
+        27 {} \
+        28 {     There are new options to the file command for copying files (file copy),} \
+        29 {     deleting files and directories (file delete), creating directories (file} \
+        30 {     mkdir), and renaming files (file rename). } \
+        31 {     The implementation of exec has been improved greatly for Windows 95 and} \
+        32 {     Windows NT. } \
+        33 {     There is a new memory allocator for the Macintosh version, which should be} \
+        34 {     more efficient than the old one. } \
+        35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
+        36 {     algorithm produces much better layouts than before, especially where rows or} \
+        37 {     columns were stretchable. } \
+        38 {     There are new commands for creating common dialog boxes:} \
+        39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
+        40 {     tk_messageBox. These use native dialog boxes if they are available. } \
+        41 {     There is a new virtual event mechanism for handling events in a more portable} \
+        42 {     way. See the new command event. It also allows events (both physical and} \
+        43 {     virtual) to be generated dynamically. } \
+        44 {} \
+        45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
+        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
+        47 {should work on these new releases as well. } \
+        48 {} \
+        49 {Obtaining The Releases} \
+        50 {} \
+        51 {Binary Releases} \
+        52 {} \
+        53 {Pre-compiled releases are available for the following platforms: } \
+        54 {} \
+        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
+        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
+        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
+        58 {     tclsh programs, and documentation. } \
+        59 {     Macintosh (both 68K and PowerPC): Fetch} \
+        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
+        61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
+        62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
+        63 {     folder containing all that you need to run Tcl and Tk. } \
+        64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
+        65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
     }
-    set a
-} {1 2 3}
+
+    set result ""
+    set NL "
+"
+    set tag {level= type=text/plain part=0 sel Charset}
+    set ix [lsearch -regexp $tag text/enriched]
+    if {$ix < 0} {
+	set ranges {}
+	set quote 0
+    }
+    set breakrange {6.42 78.0}
+    set F1 [lindex $breakrange 0]
+    set F2 [lindex $breakrange 1]
+    set breakrange [lrange $breakrange 2 end]
+    if {[string length $F1] == 0} {
+	set F1 -1
+	set break 0
+    } else {
+	set break 1
+    }
+
+    set xmailer 0
+    set inheaders 1
+    set last [array size lines]
+    set plen 2
+    for {set L 1} {$L < $last} {incr L} {
+	set line $lines($L)
+	if {$inheaders} {
+	    # Blank or empty line terminates headers
+	    # Leading --- terminates headers
+	    if {[regexp {^[ 	]*$} $line] || [regexp {^--+} $line]} {
+		set inheaders 0
+	    }
+	    if {[regexp -nocase {^x-mailer:} $line]} {
+		continue
+	    }
+	}
+	if $inheaders {
+	    set limit 55
+	} else {
+	    set limit 55
+
+	    # Decide whether or not to break the body line
+
+	    if {$plen > 0} {
+		if {[string first {> } $line] == 0} {
+		    # This is quoted text from previous message, don't reformat
+		    append result $line $NL
+		    if {$quote && !$inheaders} {
+			# Fix from <sarr@umich.edu> to handle text/enriched
+			if {$L > $L1 && $L < $L2 && $line != {}} {
+			    # enriched requires two newlines for each one.
+			    append result $NL
+			} elseif {$L > $L2} {
+			    set L1 [lindex $ranges 0]
+			    set L2 [lindex $ranges 1]
+			    set ranges [lrange $ranges 2 end]
+			    set quote [llength $L1]
+			}
+		    }
+		    continue
+		}
+	    }
+	    if {$F1 < 0} {
+		# Nothing left to format
+		append result $line $NL
+		continue
+	    } elseif {$L < $F1} {
+		# Not yet to formatted block
+		append result $line $NL
+		continue
+	    } elseif {$L > $F2} {
+		# Past formatted block
+		set F1 [lindex $breakrange 0]
+		set F2 [lindex $breakrange 1]
+		set breakrange [lrange $breakrange 2 end]
+		append result $line $NL
+		if {[string length $F1] == 0} {
+		    set F1 -1
+		}
+		continue
+	    }
+	}
+	set climit [expr $limit-1]
+	set cutoff 50
+	set continuation 0
+	
+	while {[string length $line] > $limit} {
+	    for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
+		set char [string index $line $c]
+		if {$char == " " || $char == "\t"} {
+		    break
+		}
+		if {$char == ">"} {	;# Hack for enriched formatting
+		    break
+		}
+	    }
+	    if {$c < $cutoff} {
+		if {! $inheaders} {
+		    set c [expr $limit-1]
+		} else {
+		    set c [string length $line]
+		}
+	    }
+	    set newline [string range $line 0 $c]
+	    if {! $continuation} {
+		append result $newline $NL
+	    } else {
+		append result \ $newline $NL
+	    }
+	    incr c
+	    set line [string trimright [string range $line $c end]]
+	    if {$inheaders} {
+		set continuation 1
+		set limit $climit
+	    }
+	}
+	if {$continuation} {
+	    if {[string length $line] != 0} {
+		append result \ $line $NL
+	    }
+	} else {
+	    append result $line $NL
+	    if {$quote && !$inheaders} {
+		if {$L > $L1 && $L < $L2 && $line != {}} {
+		    # enriched requires two newlines for each one.
+		    append result "" $NL
+		} elseif {$L > $L2} {
+		    set L1 [lindex $ranges 0]
+		    set L2 [lindex $ranges 1]
+		    set ranges [lrange $ranges 2 end]
+		    set quote [llength $L1]
+		}
+	    }
+	}
+    }
+    return $result
+}
+test for-3.6 {break tests} {
+    formatMail
+} {Return-path: <george@tcl>
+Received: from tcl by tcl.Somewhere.COM (SMI-8.6/SMI-SVR4)
+	id LAA10027; Wed, 11 Sep 1996 11:14:53 -0700
+Message-id: <199609111814.LAA10027@tcl.Somewhere.COM>
+Mime-version: 1.0
+Content-type: text/plain; charset=iso-8859-1
+Content-transfer-encoding: quoted-printable
+Content-length: 2162
+To: fred
+Subject: tcl7.6
+Date: Wed, 11 Sep 1996 11:14:53 -0700
+From: George <george@tcl>
+The Tcl 7.6 and Tk 4.2 releases
+
+This page contains information about Tcl 7.6 and Tk4.2,
+ which are the most recent
+releases of the Tcl scripting language and the Tk toolk
+it. The first beta versions of these
+releases were released on August 30, 1996. These releas
+es contain only minor changes,
+so we hope to have only a single beta release and to 
+go final in early October, 1996.
+
+
+What's new 
+
+The most important changes in the releases are summariz
+ed below. See the README
+and changes files in the distributions for more complet
+e information on what has
+changed, including both feature changes and bug fixes. 
+
+     There are new options to the file command for 
+copying files (file copy),
+     deleting files and directories (file delete), 
+creating directories (file
+     mkdir), and renaming files (file rename). 
+     The implementation of exec has been improved great
+ly for Windows 95 and
+     Windows NT. 
+     There is a new memory allocator for the Macintosh 
+version, which should be
+     more efficient than the old one. 
+     Tk's grid geometry manager has been completely 
+rewritten. The layout
+     algorithm produces much better layouts than before
+, especially where rows or
+     columns were stretchable. 
+     There are new commands for creating common dialog 
+boxes:
+     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
+     tk_messageBox. These use native dialog boxes if 
+they are available.
+     There is a new virtual event mechanism for handlin
+g events in a more portable
+     way. See the new command event. It also allows 
+events (both physical and
+     virtual) to be generated dynamically. 
+
+Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 
+7.5 and Tk 4.1 except for
+changes in the C APIs for custom channel drivers. Scrip
+ts written for earlier releases
+should work on these new releases as well. 
+
+Obtaining The Releases
+
+Binary Releases
+
+Pre-compiled releases are available for the following 
+platforms:
+
+     Windows 3.1, Windows 95, and Windows NT: Fetch
+     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then 
+execute it. The file is a
+     self-extracting executable. It will install the 
+Tcl and Tk libraries, the wish and
+     tclsh programs, and documentation. 
+     Macintosh (both 68K and PowerPC): Fetch
+     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. 
+The file is in binhex format,
+     which is understood by Fetch, StuffIt, and many 
+other Mac utilities. The
+     unpacked file is a self-installing executable: 
+double-click on it and it will create a
+     folder containing all that you need to run Tcl 
+and Tk.
+        UNIX (Solaris 2.* and SunOS, other systems 
+soon to follow). Easy to install
+     binary packages are now for sale at the Sun Labs 
+Tcl/Tk Shop. Check it out!
+}
+
+# Check that "break" resets the interpreter's result
+
+test for-4.1 {break must reset the interp result} {
+    catch {
+        set z GLOBTESTDIR/dir2/file2.c
+        if [string match GLOBTESTDIR/dir2/* $z] {
+            break
+        }
+    } j
+    set j
+} {}
+
+# Check "for" and computed command names.
+
+test for-5.1 {for and computed command names} {
+    set j 0
+    set z for
+    $z {set i 0} {$i<10} {incr i} {set j $i}
+    set j
+} 9
diff --git a/contrib/tcl/tests/foreach.test b/contrib/tcl/tests/foreach.test
new file mode 100644
index 0000000..64fffc5
--- /dev/null
+++ b/contrib/tcl/tests/foreach.test
@@ -0,0 +1,203 @@
+# Commands covered:  foreach, continue, break
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) foreach.test 1.7 97/06/23 18:23:42
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset a}
+catch {unset x}
+
+# Basic "foreach" operation.
+
+test foreach-1.1 {basic foreach tests} {
+    set a {}
+    foreach i {a b c d} {
+	set a [concat $a $i]
+    }
+    set a
+} {a b c d}
+test foreach-1.2 {basic foreach tests} {
+    set a {}
+    foreach i {a b {{c d} e} {123 {{x}}}} {
+	set a [concat $a $i]
+    }
+    set a
+} {a b {c d} e 123 {{x}}}
+test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1
+test foreach-1.4 {basic foreach tests} {
+    catch {foreach} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1
+test foreach-1.6 {basic foreach tests} {
+    catch {foreach i} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1
+test foreach-1.8 {basic foreach tests} {
+    catch {foreach i j} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1
+test foreach-1.10 {basic foreach tests} {
+    catch {foreach i j k l} msg
+    set msg
+} {wrong # args: should be "foreach varList list ?varList list ...? command"}
+test foreach-1.11 {basic foreach tests} {
+    set a {}
+    foreach i {} {
+	set a [concat $a $i]
+    }
+    set a
+} {}
+test foreach-1.12 {foreach errors} {
+    list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg
+} {1 {list element in braces followed by "{b}" instead of space}}
+test foreach-1.13 {foreach errors} {
+    list [catch {foreach a {{1 2}3} {}} msg] $msg
+} {1 {list element in braces followed by "3" instead of space}}
+catch {unset a}
+test foreach-1.14 {foreach errors} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {foreach a {1 2 3} {}} msg] $msg
+} {1 {couldn't set loop variable: "a"}}
+test foreach-1.15 {foreach errors} {
+    list [catch {foreach {} {} {}} msg] $msg
+} {1 {foreach varlist is empty}}
+catch {unset a}
+
+test foreach-2.1 {parallel foreach tests} {
+    set x {}
+    foreach {a b} {1 2 3 4} {
+	append x $b $a
+    }
+    set x
+} {2143}
+test foreach-2.2 {parallel foreach tests} {
+    set x {}
+    foreach {a b} {1 2 3 4 5} {
+	append x $b $a
+    }
+    set x
+} {21435}
+test foreach-2.3 {parallel foreach tests} {
+    set x {}
+    foreach a {1 2 3} b {4 5 6} {
+	append x $b $a
+    }
+    set x
+} {415263}
+test foreach-2.4 {parallel foreach tests} {
+    set x {}
+    foreach a {1 2 3} b {4 5 6 7 8} {
+	append x $b $a
+    }
+    set x
+} {41526378}
+test foreach-2.5 {parallel foreach tests} {
+    set x {}
+    foreach {a b} {a b A B aa bb} c {c C cc CC} {
+	append x $a $b $c
+    }
+    set x
+} {abcABCaabbccCC}
+test foreach-2.6 {parallel foreach tests} {
+    set x {}
+    foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+	append x $a $b $c $d $e
+    }
+    set x
+} {111112222233333}
+test foreach-2.7 {parallel foreach tests} {
+    set x {}
+    foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	append x $a $b $c $d $e
+    }
+    set x
+} {1111 2222334}
+test foreach-2.8 {foreach only sets vars if repeating loop} {
+    proc foo {} {
+        set rgb {65535 0 0}
+        foreach {r g b} [set rgb] {}
+        return "r=$r, g=$g, b=$b"
+    }
+    foo
+} {r=65535, g=0, b=0}
+test foreach-2.9 {foreach only supports local scalar variables} {
+    proc foo {} {
+        set x {}
+        foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]}
+        set x
+    }
+    foo
+} {1 2 3 4}
+
+test foreach-3.1 {compiled foreach backward jump works correctly} {
+    catch {unset x}
+    proc foo {arrayName} {
+        upvar 1 $arrayName a
+        set l {}
+        foreach member [array names a] {
+            lappend l [list $member [set a($member)]]
+        }
+        return $l
+    }
+    array set x {0 zero 1 one 2 two 3 three}
+    foo x
+} {{0 zero} {1 one} {2 two} {3 three}}
+
+# Check "continue".
+
+test foreach-4.1 {continue tests} {catch continue} 4
+test foreach-4.2 {continue tests} {
+    set a {}
+    foreach i {a b c d} {
+	if {[string compare $i "b"] == 0} continue
+	set a [concat $a $i]
+    }
+    set a
+} {a c d}
+test foreach-4.3 {continue tests} {
+    set a {}
+    foreach i {a b c d} {
+	if {[string compare $i "b"] != 0} continue
+	set a [concat $a $i]
+    }
+    set a
+} {b}
+test foreach-4.4 {continue tests} {catch {continue foo} msg} 1
+test foreach-4.5 {continue tests} {
+    catch {continue foo} msg
+    set msg
+} {wrong # args: should be "continue"}
+
+# Check "break".
+
+test foreach-5.1 {break tests} {catch break} 3
+test foreach-5.2 {break tests} {
+    set a {}
+    foreach i {a b c d} {
+	if {[string compare $i "c"] == 0} break
+	set a [concat $a $i]
+    }
+    set a
+} {a b}
+test foreach-5.3 {break tests} {catch {break foo} msg} 1
+test foreach-5.4 {break tests} {
+    catch {break foo} msg
+    set msg
+} {wrong # args: should be "break"}
+
+catch {unset a}
+catch {unset x}
diff --git a/contrib/tcl/tests/format.test b/contrib/tcl/tests/format.test
index e6764f3..219327b 100644
--- a/contrib/tcl/tests/format.test
+++ b/contrib/tcl/tests/format.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) format.test 1.23 96/07/31 16:54:50
+# SCCS: @(#) format.test 1.24 96/10/08 17:40:55
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -181,13 +181,13 @@ test format-4.16 {g-format} {
 test format-4.17 {g-format} {
     format "%.3g" .001
 } {0.001}
-test format-4.19 {g-format} {
+test format-4.18 {g-format} {
     format "%.3g" .00001
 } {1e-05}
-test format-4.20 {g-format} {
+test format-4.19 {g-format} {
     format "%#.3g" 1234.0
 } {1.23e+03}
-test format-4.21 {g-format} {
+test format-4.20 {g-format} {
     format "%#.3G" 9999.5
 } {1.00E+04}
 
diff --git a/contrib/tcl/tests/get.test b/contrib/tcl/tests/get.test
index 0713861..50e68bb 100644
--- a/contrib/tcl/tests/get.test
+++ b/contrib/tcl/tests/get.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) get.test 1.5 96/04/09 15:54:33
+# SCCS: @(#) get.test 1.6 96/10/08 17:39:21
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -49,11 +49,11 @@ test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
     set x 0
     list [catch {incr x 4294967294} msg] $msg
 } {0 -2}
-test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
     set x 0
     list [catch {incr x +4294967294} msg] $msg
 } {0 -2}
-test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
     set x 0
     list [catch {incr x -4294967294} msg] $msg
 } {0 2}
diff --git a/contrib/tcl/tests/history.test b/contrib/tcl/tests/history.test
index d5921b6..1d30955 100644
--- a/contrib/tcl/tests/history.test
+++ b/contrib/tcl/tests/history.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) history.test 1.11 96/02/16 08:55:57
+# SCCS: @(#) history.test 1.12 96/03/11 18:06:04
   
 if {[info commands history] == ""} {
     puts stdout "This version of Tcl was built without the history command;\n"
@@ -282,14 +282,14 @@ test history-10.1 {history revision} {
     history a {set a [history e]} exec
     set a
 } {set a 12345}
-test history-10.2 {history revision} {
+test history-10.2 {history revision} {notIfCompiled} {
     set a 0
     history a {set a 12345}
     history a {set a [history e]} exec
     history a foo
     history ev -1
 } {set a {set a 12345}}
-test history-10.3 {history revision} {
+test history-10.3 {history revision} {notIfCompiled} {
     set a 0
     history a {set a 12345}
     history a {set a [history e]} exec
@@ -298,7 +298,7 @@ test history-10.3 {history revision} {
     history a {set a 12345}
     history ev -1
 } {set a {set a 12345}}
-test history-10.4 {history revision} {
+test history-10.4 {history revision} {notIfCompiled} {
     history a {set a 12345}
     history a {history s 123 999} exec
     history a foo
@@ -309,13 +309,13 @@ test history-10.5 {history revision} {
     history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
     set a
 } {word0 {a b}}
-test history-10.6 {history revision} {
+test history-10.6 {history revision} {notIfCompiled} {
     history add {word0 word1 word2 a b c word6}
     history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
     history add foo
     history ev
 } {set a [list word0 {a b}]}
-test history-10.7 {history revision} {
+test history-10.7 {history revision} {notIfCompiled} {
     history add {word0 word1 word2 a b c word6}
     history add {set [history w 3] [list [history w 0] [history w {[ab]}]]} exec
     history add {format b}
@@ -325,7 +325,7 @@ test history-10.7 {history revision} {
     history add foo
     history ev
 } {set [format a] [list abc [format b] {word1 word2 a}]}
-test history-10.8 {history revision} {
+test history-10.8 {history revision} {notIfCompiled} {
     history add {set a 12345}
     concat a b c
     history add {history redo; set b 44} exec
@@ -348,7 +348,7 @@ test history-10.11 {history revision} {
     history add {set a [history w 4-[history word 2]]} exec
     set a
 } {b c word6}
-test history-10.12 {history revision} {
+test history-10.12 {history revision} {notIfCompiled} {
     history add {word0 word1 $ a b c word6}
     history add {set a [history w 4-[history word 2]]} exec
     history add foo
@@ -364,14 +364,14 @@ test history-10.14 {history revision} {
     history add foo
     history e
 } {set a [history word 0; format c]}
-test history-10.15 {history revision even when nested} {
+test history-10.15 {history revision even when nested} {notIfCompiled} {
     proc x {a b} {history word $a $b}
     history add {word1 word2 word3 word4}
     history add {set a [x 1-3 -1]} exec
     history add foo
     history e
 } {set a {word2 word3 word4}}
-test history-10.16 {disable history revision in nested history evals} {
+test history-10.16 {disable history revision in nested history evals} {notIfCompiled} {
     history add {word1 word2 word3 word4}
     history add {set a [history words 0]; history add foo; set a [history words 0]} exec
     history e
diff --git a/contrib/tcl/tests/http.test b/contrib/tcl/tests/http.test
new file mode 100644
index 0000000..3c47c27
--- /dev/null
+++ b/contrib/tcl/tests/http.test
@@ -0,0 +1,367 @@
+# Commands covered:  http_config, http_get, http_wait, http_reset
+#
+# This file contains a collection of tests for the http script library.
+# Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# 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.
+#
+# SCCS: @(#) http.test 1.9 97/06/24 17:32:56
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+
+if [catch {package require http 1.0}] {
+    catch {puts stderr "Cannot find http package"}
+    return
+}
+
+############### The httpd_ procedures implement a stub http server. ########
+proc httpd_init {{port 8015}} {
+    socket -server httpdAccept $port
+}
+proc httpd_log {args} {
+    global httpLog
+    if {[info exists httpLog] && $httpLog} {
+	puts stderr "httpd: [join $args { }]"
+    }
+}
+array set httpdErrors {
+    204 {No Content}
+    400 {Bad Request}
+    404 {Not Found}
+    503 {Service Unavailable}
+    504 {Service Temporarily Unavailable}
+    }
+
+proc httpdError {sock code args} {
+    global httpdErrors
+    puts $sock "$code $httpdErrors($code)"
+    httpd_log "error: [join $args { }]"
+}
+proc httpdAccept {newsock ipaddr port} {
+    global httpd
+    upvar #0 httpd$newsock data
+
+    fconfigure $newsock -blocking 0 -translation {auto crlf}
+    httpd_log $newsock Connect $ipaddr $port
+    set data(ipaddr) $ipaddr
+    fileevent $newsock readable [list httpdRead $newsock]
+}
+
+# read data from a client request
+
+proc httpdRead { sock } {
+    upvar #0 httpd$sock data
+
+    set readCount [gets $sock line]
+    if {![info exists data(state)]} {
+	if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \
+		$line x data(proto) data(url) data(query)] {
+	    set data(state) mime
+	    httpd_log $sock Query $line
+	} else {
+	    httpdError $sock 400
+	    httpd_log $sock Error "bad first line:$line"
+	    httpdSockDone $sock
+	}
+	return
+    }
+
+    # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1
+
+    set state [string compare $readCount 0],$data(state),$data(proto)
+    httpd_log $sock $state
+    switch -- $state {
+	-1,mime,HEAD	-
+	-1,mime,GET	-
+	-1,mime,POST	{
+	    # gets would block
+	    return
+	}
+	0,mime,HEAD	-
+	0,mime,GET	-
+	0,query,POST	{ httpdRespond $sock }
+	0,mime,POST	{ set data(state) query }
+	1,mime,HEAD	-
+	1,mime,POST	-
+	1,mime,GET	{
+	    if [regexp {([^:]+):[ 	]*(.*)}  $line dummy key value] {
+		set data(mime,[string tolower $key]) $value
+	    }
+	}
+	1,query,POST	{
+	    append data(query) $line
+	    httpdRespond $sock
+	}
+	default {
+	    if [eof $sock] {
+		httpd_log $sock Error "unexpected eof on <$data(url)> request"
+	    } else {
+		httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
+	    }
+	    httpdError $sock 404
+	    httpdSockDone $sock
+	}
+    }
+}
+proc httpdSockDone { sock } {
+upvar #0 httpd$sock data
+    unset data
+    close $sock
+}
+
+# Respond to the query.
+
+proc httpdRespond { sock } {
+    global httpd
+    upvar #0 httpd$sock data
+
+    set html "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>$data(proto) $data(url)</h2>
+"
+    if {[info exists data(query)] && [string length $data(query)]} {
+	append html "<h2>Query</h2>\n<dl>\n"
+	foreach {key value} [split $data(query) &=] {
+	    append html "<dt>$key<dd>$value\n"
+	}
+	append html </dl>\n
+    }
+    append html </body></html>
+
+    if {$data(proto) == "HEAD"} {
+	puts $sock "HTTP/1.0 200 OK"
+    } else {
+	puts $sock "HTTP/1.0 200 Data follows"
+    }
+    puts $sock "Date: [clock format [clock clicks]]"
+    puts $sock "Content-Type: text/html"
+    puts $sock "Content-Length: [string length $html]"
+    puts $sock ""
+    if {$data(proto) != "HEAD"} {
+	fconfigure $sock -translation binary
+	puts -nonewline $sock $html
+    }
+    httpd_log $sock Done ""
+    httpdSockDone $sock
+}
+##################### end server ###########################33
+
+set port 8010
+if [catch {httpd_init $port} listen] {
+    puts stderr "Cannot start http server, http test skipped"
+    unset port
+    return
+}
+
+test http-1.1 {http_config} {
+    http_config
+} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
+
+test http-1.2 {http_config} {
+    http_config -proxyfilter
+} httpProxyRequired
+
+test http-1.3 {http_config} {
+    catch {http_config -junk}
+} 1
+
+test http-1.4 {http_config} {
+    http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
+    set x [http_config]
+    http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired
+    set x
+} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
+
+test http-1.5 {http_config} {
+    catch {http_config -proxyhost {} -junk 8080}
+} 1
+
+test http-2.1 {http_reset} {
+    catch {http_reset http#1}
+} 0
+
+test http-3.1 {http_get} {
+    catch {http_get -bogus flag}
+} 1
+test http-3.2 {http_get} {
+    catch {http_get junk} err
+    set err
+} {Unsupported URL: junk}
+
+set tail /a/b/c
+set url [info hostname]:$port/a/b/c
+test http-3.3 {http_get} {
+    set token [http_get $url]
+    http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+proc selfproxy {host} {
+    global port
+    return [list [info hostname] $port]
+}
+test http-3.4 {http_get} {
+    http_config -proxyfilter selfproxy
+    set token [http_get $url]
+    http_config -proxyfilter httpProxyRequired
+    http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET http://$url</h2>
+</body></html>"
+
+test http-3.5 {http_get} {
+    http_config -proxyfilter bogus
+    set token [http_get $url]
+    http_config -proxyfilter httpProxyRequired
+    http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+test http-3.6 {http_get} {
+    set token [http_get $url -headers {Pragma no-cache}]
+    http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+test http-3.7 {http_get} {
+    set token [http_get $url -query Name=Value&Foo=Bar]
+    http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>POST $tail</h2>
+<h2>Query</h2>
+<dl>
+<dt>Name<dd>Value
+<dt>Foo<dd>Bar
+</dl>
+</body></html>"
+
+test http-3.8 {http_get} {
+    set token [http_get $url -validate 1]
+    http_code $token
+} "HTTP/1.0 200 OK"
+
+test http-4.1 {httpEvent} {
+    set token [http_get $url]
+    upvar #0 $token data
+    array set meta $data(meta)
+    expr ($data(totalsize) == $meta(Content-Length))
+} 1
+
+test http-4.2 {httpEvent} {
+    set token [http_get $url]
+    upvar #0 $token data
+    array set meta $data(meta)
+    string compare $data(type) [string trim $meta(Content-Type)]
+} 0
+
+test http-4.3 {httpEvent} {
+    set token [http_get $url]
+    http_code $token
+} {HTTP/1.0 200 Data follows}
+
+test http-4.4 {httpEvent} {
+    set out [open testfile w]
+    set token [http_get $url -channel $out]
+    close $out
+    set in [open testfile]
+    set x [read $in]
+    close $in
+    file delete testfile
+    set x
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+test http-4.5 {httpEvent} {
+    set out [open testfile w]
+    set token [http_get $url -channel $out]
+    close $out
+    upvar #0 $token data
+    file delete testfile
+    expr $data(currentsize) == $data(totalsize)
+} 1
+
+proc myProgress {token total current} {
+    global progress httpLog
+    if {[info exists httpLog] && $httpLog} {
+	puts "progress $total $current"
+    }
+    set progress [list $total $current]
+}
+if 0 {
+    # This test hangs on Windows95 because the client never gets EOF
+    set httpLog 1
+    test http-4.6 {httpEvent} {
+	set token [http_get $url -blocksize 50 -progress myProgress]
+	set progress
+    } {111 111}
+}
+test http-4.7 {httpEvent} {
+    set token [http_get $url -progress myProgress]
+    set progress
+} {111 111}
+test http-4.8 {httpEvent} {
+    set token [http_get $url]
+    http_status $token
+} {ok}
+test http-4.9 {httpEvent} {
+    set token [http_get $url -progress myProgress]
+    http_code $token
+} {HTTP/1.0 200 Data follows}
+test http-4.10 {httpEvent} {
+    set token [http_get $url -progress myProgress]
+    http_size $token
+} {111}
+test http-4.11 {httpEvent} {
+    set token [http_get $url -timeout 1 -command {#}]
+    http_reset $token
+    http_status $token
+} {reset}
+test http-4.12 {httpEvent} {
+    set token [http_get $url -timeout 1 -command {#}]
+    update
+    http_status $token
+} {timeout}
+
+test http-5.1 {http_formatQuery} {
+    http_formatQuery name1 value1 name2 "value two"
+} {name1=value1&name2=value+two}
+
+test http-5.2 {http_formatQuery} {
+    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
+} {name1=%7ebwelch&name2=%a1%a2%a2}
+
+test http-5.3 {http_formatQuery} {
+    http_formatQuery lines "line1\nline2\nline3"
+} {lines=line1%0d%0aline2%0d%0aline3}
+
+test http-6.1 {httpProxyRequired} {
+    http_config -proxyhost [info hostname] -proxyport $port
+    set token [http_get $url]
+    http_wait $token
+    http_config -proxyhost {} -proxyport {}
+    upvar #0 $token data
+    set data(body)
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET http://$url</h2>
+</body></html>"
+
+unset url
+unset port
+close $listen
diff --git a/contrib/tcl/tests/if-old.test b/contrib/tcl/tests/if-old.test
new file mode 100644
index 0000000..abade28
--- /dev/null
+++ b/contrib/tcl/tests/if-old.test
@@ -0,0 +1,156 @@
+# Commands covered:  if
+#
+# This file contains the original set of tests for Tcl's if command.
+# Since the if command is now compiled, a new set of tests covering
+# the new implementation is in the file "if.test". Sourcing this file
+# into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# 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.
+#
+# SCCS: @(#) if-old.test 1.10 96/10/22 11:33:06
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test if-old-1.1 {taking proper branch} {
+    set a {}
+    if 0 {set a 1} else {set a 2}
+    set a
+} 2
+test if-old-1.2 {taking proper branch} {
+    set a {}
+    if 1 {set a 1} else {set a 2}
+    set a
+} 1
+test if-old-1.3 {taking proper branch} {
+    set a {}
+    if 1<2 {set a 1}
+    set a
+} 1
+test if-old-1.4 {taking proper branch} {
+    set a {}
+    if 1>2 {set a 1}
+    set a
+} {}
+test if-old-1.5 {taking proper branch} {
+    set a {}
+    if 0 {set a 1} else {}
+    set a
+} {}
+test if-old-1.5 {taking proper branch} {
+    set a {}
+    if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
+    set a
+} {2}
+test if-old-1.6 {taking proper branch} {
+    set a {}
+    if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
+    set a
+} {3}
+test if-old-1.7 {taking proper branch} {
+    set a {}
+    if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
+    set a
+} {4}
+test if-old-1.8 {taking proper branch, multiline test expr} {
+    set a {}
+    if {($tcl_platform(platform) != "foobar1") && \
+	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
+    set a
+} {3}
+
+
+test if-old-2.1 {optional then-else args} {
+    set a 44
+    if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2}
+    set a
+} 2
+test if-old-2.2 {optional then-else args} {
+    set a 44
+    if 1 then {set a 1} else {set a 2}
+    set a
+} 1
+test if-old-2.3 {optional then-else args} {
+    set a 44
+    if 0 {set a 1} else {set a 2}
+    set a
+} 2
+test if-old-2.4 {optional then-else args} {
+    set a 44
+    if 1 {set a 1} else {set a 2}
+    set a
+} 1
+test if-old-2.5 {optional then-else args} {
+    set a 44
+    if 0 then {set a 1} {set a 2}
+    set a
+} 2
+test if-old-2.6 {optional then-else args} {
+    set a 44
+    if 1 then {set a 1} {set a 2}
+    set a
+} 1
+test if-old-2.7 {optional then-else args} {
+    set a 44
+    if 0 then {set a 1} else {set a 2}
+    set a
+} 2
+test if-old-2.8 {optional then-else args} {
+    set a 44
+    if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4}
+    set a
+} 4
+
+test if-old-3.1 {return value} {
+    if 1 then {set a 22; concat abc}
+} abc
+test if-old-3.2 {return value} {
+    if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
+} def
+test if-old-3.3 {return value} {
+    if 0 then {set a 22; concat abc} else {concat def}
+} def
+test if-old-3.4 {return value} {
+    if 0 then {set a 22; concat abc}
+} {}
+test if-old-3.5 {return value} {
+    if 0 then {set a 22; concat abc} elseif 0 {concat def}
+} {}
+
+test if-old-4.1 {error conditions} {
+    list [catch {if} msg] $msg
+} {1 {wrong # args: no expression after "if" argument}}
+test if-old-4.2 {error conditions} {
+    list [catch {if {[error "error in condition"]} foo} msg] $msg
+} {1 {error in condition}}
+test if-old-4.3 {error conditions} {
+    list [catch {if 2} msg] $msg
+} {1 {wrong # args: no script following "2" argument}}
+test if-old-4.4 {error conditions} {
+    list [catch {if 2 then} msg] $msg
+} {1 {wrong # args: no script following "then" argument}}
+test if-old-4.5 {error conditions} {
+    list [catch {if 2 the} msg] $msg
+} {1 {invalid command name "the"}}
+test if-old-4.6 {error conditions} {
+    list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
+} {1 {error in then clause}}
+test if-old-4.7 {error conditions} {
+    list [catch {if 0 then foo elseif} msg] $msg
+} {1 {wrong # args: no expression after "elseif" argument}}
+test if-old-4.8 {error conditions} {
+    list [catch {if 0 then foo elsei} msg] $msg
+} {1 {invalid command name "elsei"}}
+test if-old-4.9 {error conditions} {
+    list [catch {if 0 then foo elseif 0 bar else} msg] $msg
+} {1 {wrong # args: no script following "else" argument}}
+test if-old-4.10 {error conditions} {
+    list [catch {if 0 then foo elseif 0 bar els} msg] $msg
+} {1 {invalid command name "els"}}
+test if-old-4.11 {error conditions} {
+    list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg
+} {1 {error in else clause}}
diff --git a/contrib/tcl/tests/if.test b/contrib/tcl/tests/if.test
index e5b9ed2..8bc288f 100644
--- a/contrib/tcl/tests/if.test
+++ b/contrib/tcl/tests/if.test
@@ -4,145 +4,502 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 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.
 #
-# SCCS: @(#) if.test 1.8 96/02/16 08:55:59
+# SCCS: @(#) if.test 1.8 97/06/23 18:18:30
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
-test if-1.1 {taking proper branch} {
+# Basic "if" operation.
+
+catch {unset a}
+test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
+    list [catch {if} msg] $msg
+} {1 {wrong # args: no expression after "if" argument}}
+test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
+    list [catch {if {[error "error in condition"]} foo} msg] $msg
+} {1 {error in condition}}
+test if-1.3 {TclCompileIfCmd: error in if/elseif test} {
+    list [catch {if {1+}} msg] $msg $errorInfo
+} {1 {syntax error in expression "1+"} {syntax error in expression "1+"
+    ("if" test expression)
+    while compiling
+"if"}}
+test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
     set a {}
-    if 0 {set a 1} else {set a 2}
+    if {1<2} {set a 1}
     set a
-} 2
-test if-1.2 {taking proper branch} {
+} {1}
+test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
     set a {}
-    if 1 {set a 1} else {set a 2}
+    if 1<2 {set a 1}
     set a
-} 1
-test if-1.3 {taking proper branch} {
+} {1}
+test if-1.6 {TclCompileIfCmd: multiline test expr} {
+    set a {}
+    if {($tcl_platform(platform) != "foobar1") && \
+	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
+    set a
+} 3
+test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} {
+    set a {}
+    if 4>3 then {set a 1}
+    set a
+} {1}
+test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} {
+    set a {}
+    catch {if 1<2 therefore {set a 1}} msg 
+    set msg
+} {invalid command name "therefore"}
+test if-1.9 {TclCompileIfCmd: missing "then" body} {
+    set a {}
+    catch {if 1<2 then} msg 
+    set msg
+} {wrong # args: no script following "then" argument}
+test if-1.10 {TclCompileIfCmd: error in "then" body} {
+    set a {}
+    list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    ("if" body script)
+    while compiling
+"if"}}
+test if-1.11 {TclCompileIfCmd: error in "then" body} {
+    list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
+} {1 {error in then clause}}
+test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
+    set a {}
+    if 27>17 "append a x"
+    set a
+} {x}
+test if-1.13 {TclCompileIfCmd: computed "then" body} {
+    catch {unset x1}
+    catch {unset x2}
+    set a {}
+    set x1 {append a x1}
+    set x2 {; append a x2}
+    set a {}
+    if 1 $x1$x2
+    set a
+} {x1x2}
+test if-1.14 {TclCompileIfCmd: taking proper branch} {
     set a {}
     if 1<2 {set a 1}
     set a
 } 1
-test if-1.4 {taking proper branch} {
+test if-1.15 {TclCompileIfCmd: taking proper branch} {
     set a {}
     if 1>2 {set a 1}
     set a
 } {}
-test if-1.5 {taking proper branch} {
+test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} {
+    catch {unset i}
     set a {}
-    if 0 {set a 1} else {}
+    if 1<2 {
+	set a 1
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 2
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 3
+    }
     set a
-} {}
-test if-1.5 {taking proper branch} {
+} 3
+test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
     set a {}
-    if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
+    list [catch {if {"0 < 3"} {set a 1}} msg] $msg
+} {1 {expected boolean value but got "0 < 3"}}
+
+
+test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} {
+    set a {}
+    if 3>4 {set a 1} elseif 1 {set a 2}
     set a
 } {2}
-test if-1.6 {taking proper branch} {
+# Since "else" is optional, the "elwood" below is treated as a command.
+# But then there shouldn't be any additional argument words for the "if".
+test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} {
     set a {}
-    if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
-    set a
-} {3}
-test if-1.7 {taking proper branch} {
+    catch {if 1<2 {set a 1} elwood {set a 2}} msg 
+    set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
+    set a {}
+    catch {if 1<2 {set a 1} elseif} msg 
+    set msg
+} {wrong # args: no expression after "elseif" argument}
+test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} {
     set a {}
-    if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
+    list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
+} {1 {syntax error in expression "1>"} {syntax error in expression "1>"
+    ("if" test expression)
+    while compiling
+"if"}}
+test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
+    catch {unset i}
+    set a {}
+    if 1>2 {
+	set a 1
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 2
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 3
+    } elseif 1<2 then { #; this if arm should be taken
+	set a 4
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 5
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 6
+    }
     set a
-} {4}
-
+} 6
 
-test if-2.1 {optional then-else args} {
-    set a 44
-    if 0 then {set a 1} elseif 0 then {set a 3} else {set a 2}
-    set a
-} 2
-test if-2.2 {optional then-else args} {
-    set a 44
-    if 1 then {set a 1} else {set a 2}
-    set a
-} 1
-test if-2.3 {optional then-else args} {
-    set a 44
-    if 0 {set a 1} else {set a 2}
+test if-3.1 {TclCompileIfCmd: "else" clause} {
+    set a {}
+    if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
     set a
-} 2
-test if-2.4 {optional then-else args} {
-    set a 44
-    if 1 {set a 1} else {set a 2}
+} 3
+# Since "else" is optional, the "elsex" below is treated as a command.
+# But then there shouldn't be any additional argument words for the "if".
+test if-3.2 {TclCompileIfCmd: keyword other than "else"} {
+    set a {}
+    catch {if 1<2 then {set a 1} elsex {set a 2}} msg 
+    set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+test if-3.3 {TclCompileIfCmd: missing body after "else"} {
+    set a {}
+    catch {if 2<1 {set a 1} else} msg 
+    set msg
+} {wrong # args: no script following "else" argument}
+test if-3.4 {TclCompileIfCmd: error compiling body after "else"} {
+    set a {}
+    catch {if 2<1 {set a 1} else {set}} msg 
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    ("if" else script)
+    while compiling
+"if"}
+test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
+    set a {}
+    catch {if 2<1 {set a 1} else {set a 2} or something} msg 
+    set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+# The following test also checks whether contained loops and other
+# commands are properly relocated because a short jump must be replaced
+# by a "long distance" one.
+test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} {
+    catch {unset i}
+    set a {}
+    if 1>2 {
+	set a 1
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 2
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 3
+    } elseif 1==2 then { #; this if arm should be taken
+	set a 4
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 5
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 6
+    } else {
+	set a 7
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 8
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		if {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 9
+    }
     set a
-} 1
-test if-2.5 {optional then-else args} {
-    set a 44
-    if 0 then {set a 1} {set a 2}
+} 9
+
+test if-4.1 {TclCompileIfCmd: "if" command result} {
+    set a {}
+    set a [if 3<4 {set i 27}]
     set a
-} 2
-test if-2.6 {optional then-else args} {
-    set a 44
-    if 1 then {set a 1} {set a 2}
+} 27
+test if-4.2 {TclCompileIfCmd: "if" command result} {
+    set a {}
+    set a [if 3>4 {set i 27}]
     set a
-} 1
-test if-2.7 {optional then-else args} {
-    set a 44
-    if 0 then {set a 1} else {set a 2}
+} {}
+test if-4.3 {TclCompileIfCmd: "if" command result} {
+    set a {}
+    set a [if 0 {set i 1} elseif 1 {set i 2}]
     set a
 } 2
-test if-2.8 {optional then-else args} {
-    set a 44
-    if 0 then {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} {set a 4}
+test if-4.4 {TclCompileIfCmd: "if" command result} {
+    set a {}
+    set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
     set a
 } 4
-
-test if-3.1 {return value} {
-    if 1 then {set a 22; concat abc}
-} abc
-test if-3.2 {return value} {
+test if-4.5 {TclCompileIfCmd: return value} {
     if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
 } def
-test if-3.3 {return value} {
-    if 0 then {set a 22; concat abc} else {concat def}
-} def
-test if-3.4 {return value} {
-    if 0 then {set a 22; concat abc}
-} {}
-test if-3.5 {return value} {
-    if 0 then {set a 22; concat abc} elseif 0 {concat def}
-} {}
 
-test if-4.1 {error conditions} {
-    list [catch {if} msg] $msg
-} {1 {wrong # args: no expression after "if" argument}}
-test if-4.2 {error conditions} {
-    list [catch {if {[error "error in condition"]}} msg] $msg
-} {1 {error in condition}}
-test if-4.3 {error conditions} {
-    list [catch {if 2} msg] $msg
-} {1 {wrong # args: no script following "2" argument}}
-test if-4.4 {error conditions} {
-    list [catch {if 2 then} msg] $msg
-} {1 {wrong # args: no script following "then" argument}}
-test if-4.5 {error conditions} {
-    list [catch {if 2 the} msg] $msg
-} {1 {invalid command name "the"}}
-test if-4.6 {error conditions} {
-    list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
-} {1 {error in then clause}}
-test if-4.7 {error conditions} {
-    list [catch {if 0 then foo elseif} msg] $msg
-} {1 {wrong # args: no expression after "elseif" argument}}
-test if-4.8 {error conditions} {
-    list [catch {if 0 then foo elsei} msg] $msg
-} {1 {invalid command name "elsei"}}
-test if-4.9 {error conditions} {
-    list [catch {if 0 then foo elseif 0 bar else} msg] $msg
-} {1 {wrong # args: no script following "else" argument}}
-test if-4.10 {error conditions} {
-    list [catch {if 0 then foo elseif 0 bar els} msg] $msg
-} {1 {invalid command name "els"}}
-test if-4.11 {error conditions} {
-    list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg
-} {1 {error in else clause}}
+# Check "if" and computed command names.
+
+test if-5.1 {if and computed command names} {
+    set i 0
+    set z if
+    $z 1 {
+        set i 1
+    }
+    set i
+} 1
diff --git a/contrib/tcl/tests/incr-old.test b/contrib/tcl/tests/incr-old.test
new file mode 100644
index 0000000..8fbd89f
--- /dev/null
+++ b/contrib/tcl/tests/incr-old.test
@@ -0,0 +1,89 @@
+# Commands covered:  incr
+#
+# This file contains the original set of tests for Tcl's incr command.
+# Since the incr command is now compiled, a new set of tests covering
+# the new implementation is in the file "incr.test". Sourcing this file
+# into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# 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.
+#
+# SCCS: @(#) incr-old.test 1.11 96/11/19 16:56:23
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset x}
+
+test incr-old-1.1 {basic incr operation} {
+    set x 23
+    list [incr x] $x
+} {24 24}
+test incr-old-1.2 {basic incr operation} {
+    set x 106
+    list [incr x -5] $x
+} {101 101}
+test incr-old-1.3 {basic incr operation} {
+    set x "  -106"
+    list [incr x 1] $x
+} {-105 -105}
+test incr-old-1.3 {basic incr operation} {
+    set x "  +106"
+    list [incr x 1] $x
+} {107 107}
+
+test incr-old-2.1 {incr errors} {
+    list [catch incr msg] $msg
+} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-old-2.2 {incr errors} {
+    list [catch {incr a b c} msg] $msg
+} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-old-2.3 {incr errors} {
+    catch {unset x}
+    list [catch {incr x} msg] $msg $errorInfo
+} {1 {can't read "x": no such variable} {can't read "x": no such variable
+    (reading value of variable to increment)
+    invoked from within
+"incr x"}}
+test incr-old-2.4 {incr errors} {
+    set x abc
+    list [catch {incr x} msg] $msg $errorInfo
+} {1 {expected integer but got "abc"} {expected integer but got "abc"
+    while executing
+"incr x"}}
+test incr-old-2.5 {incr errors} {
+    set x 123
+    list [catch {incr x 1a} msg] $msg $errorInfo
+} {1 {expected integer but got "1a"} {expected integer but got "1a"
+    while executing
+"incr x 1a"}}
+test incr-old-2.6 {incr errors} {
+    proc readonly args {error "variable is read-only"}
+    set x 123
+    trace var x w readonly
+    list [catch {incr x 1} msg] $msg $errorInfo
+} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+    while executing
+"incr x 1"}}
+catch {unset x}
+test incr-old-2.7 {incr errors} {
+    set x -
+    list [catch {incr x 1} msg] $msg
+} {1 {expected integer but got "-"}}
+test incr-old-2.8 {incr errors} {
+    set x {  -  }
+    list [catch {incr x 1} msg] $msg
+} {1 {expected integer but got "  -  "}}
+test incr-old-2.9 {incr errors} {
+    set x +
+    list [catch {incr x 1} msg] $msg
+} {1 {expected integer but got "+"}}
+test incr-old-2.10 {incr errors} {
+    set x {20 x}
+    list [catch {incr x 1} msg] $msg
+} {1 {expected integer but got "20 x"}}
+
+concat {}
diff --git a/contrib/tcl/tests/incr.test b/contrib/tcl/tests/incr.test
index b9b7fba..30db386f 100644
--- a/contrib/tcl/tests/incr.test
+++ b/contrib/tcl/tests/incr.test
@@ -1,65 +1,228 @@
-# Commands covered:  lreplace
+# Commands covered:  incr
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 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.
 #
-# SCCS: @(#) incr.test 1.8 96/02/16 08:56:00
+# SCCS: @(#) incr.test 1.8 97/06/20 16:53:28
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
-catch {unset x}
+# Basic "incr" operation.
 
-test incr-1.1 {basic incr operation} {
-    set x 23
-    list [incr x] $x
-} {24 24}
-test incr-1.2 {basic incr operation} {
-    set x 106
-    list [incr x -5] $x
-} {101 101}
-test incr-1.3 {basic incr operation} {
-    set x "  -106"
-    list [incr x 1] $x
-} {-105 -105}
-test incr-1.3 {basic incr operation} {
-    set x "  +106"
-    list [incr x 1] $x
-} {107 107}
+catch {unset x}
+catch {unset i}
 
-test incr-2.1 {incr errors} {
-    list [catch incr msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
-test incr-2.2 {incr errors} {
-    list [catch {incr a b c} msg] $msg
+test incr-1.1 {TclCompileIncrCmd: missing variable name} {
+    list [catch {incr} msg] $msg
 } {1 {wrong # args: should be "incr varName ?increment?"}}
-test incr-2.3 {incr errors} {
-    catch {unset x}
-    list [catch {incr x} msg] $msg $errorInfo
-} {1 {can't read "x": no such variable} {can't read "x": no such variable
-    while executing
-"incr x"}}
-test incr-2.4 {incr errors} {
-    set x abc
-    list [catch {incr x} msg] $msg $errorInfo
-} {1 {expected integer but got "abc"} {expected integer but got "abc"
-    (reading value of variable to increment)
-    invoked from within
-"incr x"}}
-test incr-2.5 {incr errors} {
-    set x 123
-    list [catch {incr x 1a} msg] $msg $errorInfo
-} {1 {expected integer but got "1a"} {expected integer but got "1a"
+test incr-1.2 {TclCompileIncrCmd: simple variable name} {
+    set i 10
+    list [incr i] $i
+} {11 11}
+test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
+    set i 10
+    catch {incr "i"xxx} msg
+    set msg
+} {extra characters after close-quote}
+test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
+    set i 17
+    list [incr "i"] $i
+} {18 18}
+test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
+    catch {unset {a simple var}}
+    set {a simple var} 27
+    list [incr {a simple var}] ${a simple var}
+} {28 28}
+test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
+    catch {unset a}
+    set a(foo) 37
+    list [incr a(foo)] $a(foo)
+} {38 38}
+test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
+    set x "i"
+    set i 77
+    list [incr $x 2] $i
+} {79 79}
+test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
+    set x "i"
+    set i 77
+    list [incr [set x] +2] $i
+} {79 79}
+
+test incr-1.9 {TclCompileIncrCmd: increment given} {
+    set i 10
+    list [incr i +07] $i
+} {17 17}
+test incr-1.10 {TclCompileIncrCmd: no increment given} {
+    set i 10
+    list [incr i] $i
+} {11 11}
+
+test incr-1.11 {TclCompileIncrCmd: simple global name} {
+    proc p {} {
+        global i
+        set i 54
+        incr i
+    }
+    p
+} {55}
+test incr-1.12 {TclCompileIncrCmd: simple local name} {
+    proc p {} {
+        set foo 100
+        incr foo
+    }
+    p
+} {101}
+test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
+    proc p {} {
+        incr bar
+    }
+    catch {p} msg
+    set msg
+} {can't read "bar": no such variable}
+test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
+    proc 260locals {} {
+        # create 260 locals
+        set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
+        set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
+        set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
+        set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
+        set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
+        set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
+        set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
+        set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
+        set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
+        set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
+        set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
+        set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
+        set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
+        set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
+        set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
+        set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
+        set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
+        set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
+        set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
+        set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
+        set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
+        set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
+        set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
+        set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
+        set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
+        set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
+        set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
+        set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
+        set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
+        set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
+        set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
+        set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
+        set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
+        set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
+        set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
+        set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
+        set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
+        set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
+        set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
+        set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
+        set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
+        set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
+        set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
+        set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
+        set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
+        set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
+        set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
+        set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
+        set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
+        set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
+        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
+        set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
+        # now increment the last one (local var index > 255)
+        incr z9
+    }
+    260locals
+} {1}
+test incr-1.15 {TclCompileIncrCmd: variable is array} {
+    catch {unset a}
+    set a(foo) 27
+    set x [incr a(foo) 11]
+    catch {unset a}
+    set x
+} 38
+test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
+    catch {unset a}
+    set i 5
+    set a(foo5) 27
+    set x [incr a(foo$i) 11]
+    catch {unset a}
+    set x
+} 38
+
+test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
+    set i 5
+    incr i 123
+} 128
+test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
+    set i 5
+    incr i -100
+} -95
+test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
+    set i 5
+    catch {incr i [set]} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
     (reading increment)
+    while compiling
+"incr"}
+test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
+    set i 25
+    incr i "-100"
+} -75
+test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
+    set i 24
+    incr i {126}
+} 150
+test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
+    set i 5
+    incr i 200000
+} 200005
+test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
+    set i 25
+    incr i 000012345     ;# an octal literal
+} 5374
+test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
+    set i 25
+    catch {incr i 1a} msg
+    set msg
+} {expected integer but got "1a"}
+
+test incr-1.25 {TclCompileIncrCmd: too many arguments} {
+    set i 10
+    catch {incr i 10 20} msg
+    set msg
+} {wrong # args: should be "incr varName ?increment?"}
+
+
+test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
+    list [catch {incr {"foo}} msg] $msg $errorInfo
+} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+    (reading value of variable to increment)
     invoked from within
-"incr x 1a"}}
-test incr-2.6 {incr errors} {
+"incr {"foo}"}}
+test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} {
+    list [catch {incr [set]} msg] $msg $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    while compiling
+"incr"}}
+test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
@@ -68,21 +231,16 @@ test incr-2.6 {incr errors} {
     while executing
 "incr x 1"}}
 catch {unset x}
-test incr-2.7 {incr errors} {
-    set x -
-    list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got "-"}}
-test incr-2.8 {incr errors} {
-    set x {  -  }
+test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
+    set x "  -  "
     list [catch {incr x 1} msg] $msg
 } {1 {expected integer but got "  -  "}}
-test incr-2.9 {incr errors} {
-    set x +
-    list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got "+"}}
-test incr-2.10 {incr errors} {
-    set x {20 x}
-    list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got "20 x"}}
+    
+# Check "incr" and computed command names.
 
-concat {}
+test incr-2.1 {incr and computed command names} {
+    set i 5
+    set z incr
+    $z i -1
+    set i
+} 4
diff --git a/contrib/tcl/tests/indexObj.test b/contrib/tcl/tests/indexObj.test
new file mode 100644
index 0000000..9f30ee0
--- /dev/null
+++ b/contrib/tcl/tests/indexObj.test
@@ -0,0 +1,68 @@
+# This file is a Tcl script to test out the the procedures in file
+# tkIndexObj.c, which implement indexed table lookups.  The tests here
+# are organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) indexObj.test 1.3 97/06/23 18:23:09
+
+if {[info procs test] != "test"} {
+    source defs
+}
+
+if {[info commands testindexobj] == {}} {
+    puts "This application hasn't been compiled with the \"testindexobj\""
+    puts "command, so I can't test Tcl_GetIndexFromObj etc."
+    return 
+}
+
+test indexObj-1.1 {exact match} {
+    testindexobj 1 1 xyz abc def xyz alm
+} {2}
+test indexObj-1.2 {exact match} {
+    testindexobj 1 1 abc abc def xyz alm
+} {0}
+test indexObj-1.3 {exact match} {
+    testindexobj 1 1 alm abc def xyz alm
+} {3}
+test indexObj-1.4 {unique abbreviation} {
+    testindexobj 1 1 xy abc def xalb xyz alm
+} {3}
+test indexObj-1.5 {multiple abbreviations and exact match} {
+    testindexobj 1 1 x abc def xalb xyz alm x
+} {5}
+test indexObj-1.6 {forced exact match} {
+    testindexobj 1 0 xy abc def xalb xy alm
+} {3}
+test indexObj-1.7 {forced exact match} {
+    testindexobj 1 0 x abc def xalb xyz alm x
+} {5}
+
+test indexObj-2.1 {no match} {
+    list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg
+} {1 {bad token "dddd": must be abc, def, xalb, xyz, alm, or x}}
+test indexObj-2.2 {no match} {
+    list [catch {testindexobj 1 1 dddd abc} msg] $msg
+} {1 {bad token "dddd": must be abc}}
+test indexObj-2.3 {no match: no abbreviations} {
+    list [catch {testindexobj 1 0 xy abc def xalb xyz alm} msg] $msg
+} {1 {bad token "xy": must be abc, def, xalb, xyz, or alm}}
+test indexObj-2.4 {ambiguous value} {
+    list [catch {testindexobj 1 1 d dumb daughter a c} msg] $msg
+} {1 {ambiguous token "d": must be dumb, daughter, a, or c}}
+test indexObj-2.5 {omit error message} {
+    list [catch {testindexobj 0 1 d x} msg] $msg
+} {1 {}}
+
+test indexObj-3.1 {cache result to skip next lookup} {
+    testindexobj check 42
+} {42}
+
+test indexObj-4.1 {free old internal representation} {
+    set x {a b}
+    lindex $x 1
+    testindexobj 1 1 $x abc def {a b} zzz
+} {2}
diff --git a/contrib/tcl/tests/info.test b/contrib/tcl/tests/info.test
index 9e8f012..7e7a226 100644
--- a/contrib/tcl/tests/info.test
+++ b/contrib/tcl/tests/info.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) info.test 1.33 96/03/22 12:12:48
+# SCCS: @(#) info.test 1.38 97/05/20 16:35:54
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -33,6 +33,11 @@ test info-1.4 {info args option} {
 test info-1.5 {info args option} {
     list [catch {info args set} msg] $msg
 } {1 {"set" isn't a procedure}}
+test info-1.6 {info args option} {
+    proc t1 {a b} {set c 123; set d $c}
+    t1 1 2
+    info args t1
+} {a b}
 
 test info-2.1 {info body option} {
     proc t1 {} {body of t1}
@@ -45,12 +50,15 @@ test info-2.3 {info body option} {
     list [catch {info args set 1} msg] $msg
 } {1 {wrong # args: should be "info args procname"}}
 
+# "info cmdcount" is no longer accurate for compiled commands! The expected
+# result for info-3.1 used to be "3" and is now "1" since the "set"s have
+# been compiled away.
 test info-3.1 {info cmdcount option} {
     set x [info cmdcount]
     set y 12345
     set z [info cm]
     expr $z-$x
-} 3
+} 1
 test info-3.2 {info body option} {
     list [catch {info cmdcount 1} msg] $msg
 } {1 {wrong # args: should be "info cmdcount"}}
@@ -367,7 +375,7 @@ test info-9.4 {info level option} {
 } {1 t1}
 test info-9.5 {info level option} {
     list [catch {info level 1 2} msg] $msg
-} {1 {wrong # args: should be "info level [number]"}}
+} {1 {wrong # args: should be "info level ?number?"}}
 test info-9.6 {info level option} {
     list [catch {info level 123a} msg] $msg
 } {1 {expected integer but got "123a"}}
@@ -383,7 +391,7 @@ test info-9.9 {info level option} {
     list [catch {t1 -3} msg] $msg
 } {1 {bad level "-3"}}
 
-set savedLibrary tcl_library
+set savedLibrary $tcl_library
 test info-10.1 {info library option} {
     list [catch {info library x} msg] $msg
 } {1 {wrong # args: should be "info library"}}
@@ -433,6 +441,14 @@ test info-12.5 {info locals option} {
     proc t1 {} {return [info locals]}
     t1
 } {}
+test info-12.6 {info locals vs unset compiled locals} {
+    proc t1 {lst} {
+        foreach $lst $lst {}
+        unset lst
+        return [info locals]
+    }
+    lsort [t1 {a b c c d e f}]
+} {a b c d e f}
 
 test info-13.1 {info nameofexecutable option} {
     list [catch {info nameofexecutable foo} msg] $msg
@@ -543,13 +559,13 @@ test info-20.1 {miscellaneous error conditions} {
 } {1 {wrong # args: should be "info option ?arg arg ...?"}}
 test info-20.2 {miscellaneous error conditions} {
     list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": should be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 test info-20.3 {miscellaneous error conditions} {
     list [catch {info c} msg] $msg
-} {1 {bad option "c": should be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 test info-20.4 {miscellaneous error conditions} {
     list [catch {info l} msg] $msg
-} {1 {bad option "l": should be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 test info-20.5 {miscellaneous error conditions} {
     list [catch {info s} msg] $msg
-} {1 {bad option "s": should be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
diff --git a/contrib/tcl/tests/interp.test b/contrib/tcl/tests/interp.test
index c82b901..85aee32 100644
--- a/contrib/tcl/tests/interp.test
+++ b/contrib/tcl/tests/interp.test
@@ -9,10 +9,18 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) interp.test 1.24 96/03/27 10:23:29
+# SCCS: @(#) interp.test 1.52 97/06/23 17:29:50
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
+# The set of hidden commands is platform dependent:
+
+if {"$tcl_platform(platform)" == "macintosh"} {
+    set hidden_cmds {beep cd echo exit fconfigure file glob load ls open pwd socket source vwait}
+} else {
+    set hidden_cmds {cd exec exit fconfigure file glob load open pwd socket source vwait}
+}
+
 foreach i [interp slaves] {
   interp delete $i
 }
@@ -25,7 +33,7 @@ test interp-1.1 {options for interp command} {
 } {1 {wrong # args: should be "interp cmd ?arg ...?"}}
 test interp-1.2 {options for interp command} {
     list [catch {interp frobox} msg] $msg
-} {1 {bad option "frobox": should be alias, aliases, create, delete, exists, eval, issafe, share, slaves, target or transfer}}
+} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
 test interp-1.3 {options for interp command} {
     interp delete
 } ""
@@ -43,13 +51,13 @@ test interp-1.6 {options for interp command} {
 } {1 {wrong # args: should be "interp slaves ?path?"}}
 test interp-1.7 {options for interp command} {
     list [catch {interp hello} msg] $msg
-} {1 {bad option "hello": should be alias, aliases, create, delete, exists, eval, issafe, share, slaves, target or transfer}}
+} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
 test interp-1.8 {options for interp command} {
     list [catch {interp -froboz} msg] $msg
-} {1 {bad option "-froboz": should be alias, aliases, create, delete, exists, eval, issafe, share, slaves, target or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
 test interp-1.9 {options for interp command} {
     list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": should be alias, aliases, create, delete, exists, eval, issafe, share, slaves, target or transfer}} 
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}} 
 test interp-1.10 {options for interp command} {
     list [catch {interp target} msg] $msg
 } {1 {wrong # args: should be "interp target path alias"}}
@@ -131,6 +139,7 @@ test interp-3.11 {testing interp delete} {
     interp delete
 } ""
 test interp-4.1 {testing interp delete} {
+    catch {interp create a}
     interp delete a
 } ""
 test interp-4.2 {testing interp delete} {
@@ -228,18 +237,25 @@ test interp-7.5 {testing basic alias creation} {
 
 # Part 7: testing basic alias invocation
 test interp-8.1 {testing basic alias invocation} {
+    catch {interp create a}
+    a alias foo in_master
     a eval foo s1 s2 s3
 } {seen in master: {s1 s2 s3}}
 test interp-8.2 {testing basic alias invocation} {
+    catch {interp create a}
+    a alias bar in_master a1 a2 a3
     a eval bar s1 s2 s3
 } {seen in master: {a1 a2 a3 s1 s2 s3}}
 
 # Part 8: Testing aliases for non-existent targets
 test interp-9.1 {testing aliases for non-existent targets} {
+    catch {interp create a}
     a alias zop nonexistent-command-in-master
     list [catch {a eval zop} msg] $msg
-} {1 {aliased target "nonexistent-command-in-master" for "zop" not found}}
+} {1 {invalid command name "nonexistent-command-in-master"}}
 test interp-9.2 {testing aliases for non-existent targets} {
+    catch {interp create a}
+    a alias zop nonexistent-command-in-master
     proc nonexistent-command-in-master {} {return i_exist!}
     a eval zop
 } i_exist!
@@ -248,42 +264,59 @@ if {[info command nonexistent-command-in-master] != ""} {
     rename nonexistent-command-in-master {}
 }
 
-# Recreate interpreter b..
-if {![interp exists b]} {
-    interp create b
-}
-
 # Part 9: Aliasing between interpreters
 test interp-10.1 {testing aliasing between interpreters} {
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a
+    interp create b
     interp alias a a_alias b b_alias 1 2 3
 } a_alias
 test interp-10.2 {testing aliasing between interpreters} {
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a
+    interp create b
     b eval {proc b_alias {args} {return [list got $args]}}
+    interp alias a a_alias b b_alias 1 2 3
     a eval a_alias a b c
 } {got {1 2 3 a b c}}
 test interp-10.3 {testing aliasing between interpreters} {
-    b eval {rename b_alias {}}
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a
+    interp create b
+    interp alias a a_alias b b_alias 1 2 3
     list [catch {a eval a_alias a b c} msg] $msg
-} {1 {aliased target "b_alias" for "a_alias" not found}}
+} {1 {invalid command name "b_alias"}}
 test interp-10.4 {testing aliasing between interpreters} {
+    catch {interp delete a}
+    interp create a
+    a alias a_alias puts
     a aliases
-} {foo zop bar a_alias}
+} a_alias
 test interp-10.5 {testing aliasing between interpreters} {
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a
+    interp create b
+    a alias a_alias puts
+    interp alias a a_del b b_del
     interp delete b
     a aliases
-} {foo zop bar}
-
-# Recreate interpreter b..
-if {![interp exists b]} {
-    interp create b
-}
-
+} a_alias
 test interp-10.6 {testing aliasing between interpreters} {
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a
+    interp create b
     interp alias a a_command b b_command a1 a2 a3
     b alias b_command in_master b1 b2 b3
     a eval a_command m1 m2 m3
 } {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
 test interp-10.7 {testing aliases between interpreters} {
+    catch {interp delete a}
+    interp create a
     interp alias "" foo a zoppo
     a eval {proc zoppo {x} {list $x $x $x}}
     set x [foo 33]
@@ -300,13 +333,17 @@ test interp-11.2 {testing interp target} {
     list [catch {interp target nosuchinterpreter foo} msg] $msg
 } {1 {could not find interpreter "nosuchinterpreter"}}
 test interp-11.3 {testing interp target} {
+    catch {interp delete a}
+    interp create a
     a alias boo no_command
     interp target a boo
 } ""
 test interp-11.4 {testing interp target} {
+    catch {interp delete x1}
     interp create x1
     x1 eval interp create x2
     x1 eval x2 eval interp create x3
+    catch {interp delete y1}
     interp create y1
     y1 eval interp create y2
     y1 eval y2 eval interp create y3
@@ -314,6 +351,15 @@ test interp-11.4 {testing interp target} {
     interp target {x1 x2 x3} xcommand
 } {y1 y2 y3}
 test interp-11.5 {testing interp target} {
+    catch {interp delete x1}
+    interp create x1
+    interp create {x1 x2}
+    interp create {x1 x2 x3}
+    catch {interp delete y1}
+    interp create y1
+    interp create {y1 y2}
+    interp create {y1 y2 y3}
+    interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
     list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg
 } {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}}
 
@@ -322,90 +368,139 @@ test interp-12.1 {testing interp issafe} {
     interp issafe
 } 0
 test interp-12.2 {testing interp issafe} {
+    catch {interp delete a}
+    interp create a
     interp issafe a
 } 0
 test interp-12.3 {testing interp issafe} {
+    catch {interp delete a}
+    interp create a
     interp create {a x3} -safe
     interp issafe {a x3}
 } 1
 test interp-12.4 {testing interp issafe} {
+    catch {interp delete a}
+    interp create a
+    interp create {a x3} -safe
     interp create {a x3 foo}
     interp issafe {a x3 foo}
 } 1
 
 # Part 12: testing interpreter object command "issafe" sub-command
 test interp-13.1 {testing foo issafe} {
+    catch {interp delete a}
+    interp create a
     a issafe
 } 0
 test interp-13.2 {testing foo issafe} {
+    catch {interp delete a}
+    interp create a
+    interp create {a x3} -safe
     a eval x3 issafe
 } 1
 test interp-13.3 {testing foo issafe} {
+    catch {interp delete a}
+    interp create a
+    interp create {a x3} -safe
+    interp create {a x3 foo}
     a eval x3 eval foo issafe
 } 1
 
-# part 13: testing interp aliases
+# part 14: testing interp aliases
 test interp-14.1 {testing interp aliases} {
     interp aliases
 } ""
 test interp-14.2 {testing interp aliases} {
-    interp aliases a
-} {boo foo zop bar a_command}
+    catch {interp delete a}
+    interp create a
+    a alias a1 puts
+    a alias a2 puts
+    a alias a3 puts
+    lsort [interp aliases a]
+} {a1 a2 a3}
 test interp-14.3 {testing interp aliases} {
+    catch {interp delete a}
+    interp create a
+    interp create {a x3}
     interp alias {a x3} froboz "" puts
     interp aliases {a x3}
 } froboz
 
+# part 15: testing file sharing
 test interp-15.1 {testing file sharing} {
+    catch {interp delete z}
     interp create z
     z eval close stdout
     list [catch {z eval puts hello} msg] $msg
 } {1 {can not find channel named "stdout"}}
+catch {removeFile file-15.2}
 test interp-15.2 {testing file sharing} {
-    set f [open foo w]
+    catch {interp delete z}
+    interp create z
+    set f [open file-15.2 w]
     interp share "" $f z
     z eval puts $f hello
     z eval close $f
     close $f
 } ""
+catch {removeFile file-15.2}
 test interp-15.3 {testing file sharing} {
+    catch {interp delete xsafe}
     interp create xsafe -safe
     list [catch {xsafe eval puts hello} msg] $msg
 } {1 {can not find channel named "stdout"}}
+catch {removeFile file-15.4}
 test interp-15.4 {testing file sharing} {
-    set f [open foo w]
+    catch {interp delete xsafe}
+    interp create xsafe -safe
+    set f [open file-15.4 w]
     interp share "" $f xsafe
     xsafe eval puts $f hello
     xsafe eval close $f
     close $f
 } ""
+catch {removeFile file-15.4}
 test interp-15.5 {testing file sharing} {
+    catch {interp delete xsafe}
+    interp create xsafe -safe
     interp share "" stdout xsafe
     list [catch {xsafe eval gets stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
+catch {removeFile file-15.6}
 test interp-15.6 {testing file sharing} {
-    set f [open foo w]
+    catch {interp delete xsafe}
+    interp create xsafe -safe
+    set f [open file-15.6 w]
     interp share "" $f xsafe
     set x [list [catch [list xsafe eval gets $f] msg] $msg]
+    xsafe eval close $f
     close $f
     string compare [string tolower $x] \
 		[list 1 [format "channel \"%s\" wasn't opened for reading" $f]]
 } 0
+catch {removeFile file-15.6}
+catch {removeFile file-15.7}
 test interp-15.7 {testing file transferring} {
-    set f [open foo w]
+    catch {interp delete xsafe}
+    interp create xsafe -safe
+    set f [open file-15.7 w]
     interp transfer "" $f xsafe
     xsafe eval puts $f hello
     xsafe eval close $f
 } ""
+catch {removeFile file-15.7}
+catch {removeFile file-15.8}
 test interp-15.8 {testing file transferring} {
-    set f [open foo w]
+    catch {interp delete xsafe}
+    interp create xsafe -safe
+    set f [open file-15.8 w]
     interp transfer "" $f xsafe
     xsafe eval close $f
     set x [list [catch {close $f} msg] $msg]
     string compare [string tolower $x] \
 		[list 1 [format "can not find channel named \"%s\"" $f]]
 } 0
-removeFile foo
+catch {removeFile file-15.8}
 
 #
 # Torture tests for interpreter deletion order
@@ -413,23 +508,27 @@ removeFile foo
 proc kill {} {interp delete xxx}
 
 test interp-15.9 {testing deletion order} {
+    catch {interp delete xxx}
     interp create xxx
     xxx alias kill kill
     list [catch {xxx eval kill} msg] $msg
 } {0 {}}
 test interp-16.1 {testing deletion order} {
+    catch {interp delete xxx}
     interp create xxx
     interp create {xxx yyy}
     interp alias {xxx yyy} kill "" kill
     list [catch {interp eval {xxx yyy} kill} msg] $msg
 } {0 {}}
 test interp-16.2 {testing deletion order} {
+    catch {interp delete xxx}
     interp create xxx
     interp create {xxx yyy}
     interp alias {xxx yyy} kill "" kill
     list [catch {xxx eval yyy eval kill} msg] $msg
 } {0 {}}
 test interp-16.3 {testing deletion order} {
+    catch {interp delete xxx}
     interp create xxx
     interp create ddd
     xxx alias kill kill
@@ -439,6 +538,7 @@ test interp-16.3 {testing deletion order} {
     set x
 } ""
 test interp-16.4 {testing deletion order} {
+    catch {interp delete xxx}
     interp create xxx
     interp create {xxx yyy}
     interp alias {xxx yyy} kill "" kill
@@ -448,33 +548,45 @@ test interp-16.4 {testing deletion order} {
     interp delete ddd
     set x
 } ""
+test interp-16.5 {testing deletion order, bgerror} {
+    catch {interp delete xxx}
+    interp create xxx
+    xxx eval {proc bgerror {args} {exit}}
+    xxx alias exit kill xxx
+    proc kill {i} {interp delete $i}
+    xxx eval after 100 expr a + b
+    set x waiting
+    after 200 {set x done}
+    vwait x
+    interp exists xxx
+} 0
 
 #
 # Alias loop prevention testing.
 #
 
-test interp-16.5 {alias loop prevention} {
+test interp-17.1 {alias loop prevention} {
     list [catch {interp alias {} a {} a} msg] $msg
 } {1 {cannot define or rename alias "a": would create a loop}}
-test interp-17.1 {alias loop prevention} {
+test interp-17.2 {alias loop prevention} {
     catch {interp delete x}
     interp create x
     x alias a loop
     list [catch {interp alias {} loop x a} msg] $msg
 } {1 {cannot define or rename alias "loop": would create a loop}}
-test interp-17.2 {alias loop prevention} {
+test interp-17.3 {alias loop prevention} {
     catch {interp delete x}
     interp create x
     interp alias x a x b
     list [catch {interp alias x b x a} msg] $msg
 } {1 {cannot define or rename alias "b": would create a loop}}
-test interp-17.3 {alias loop prevention} {
+test interp-17.4 {alias loop prevention} {
     catch {interp delete x}
     interp create x
     interp alias x b x a
     list [catch {x eval rename b a} msg] $msg
 } {1 {cannot define or rename alias "b": would create a loop}}
-test interp-17.4 {alias loop prevention} {
+test interp-17.5 {alias loop prevention} {
     catch {interp delete x}
     interp create x
     x alias z l1
@@ -489,27 +601,27 @@ test interp-17.4 {alias loop prevention} {
 #
 
 if {[info commands testinterpdelete] != ""} {
-    test interp-17.5 {testing Tcl_DeleteInterp vs slaves} {
+    test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
 	list [catch {testinterpdelete} msg] $msg
     } {1 {wrong # args: should be "testinterpdelete path"}}
-    test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
+    test interp-18.2 {testing Tcl_DeleteInterp vs slaves} {
 	catch {interp delete a}
 	interp create a
 	testinterpdelete a
     } ""
-    test interp-18.2 {testing Tcl_DeleteInterp vs slaves} {
+    test interp-18.3 {testing Tcl_DeleteInterp vs slaves} {
 	catch {interp delete a}
 	interp create a
 	interp create {a b}
 	testinterpdelete {a b}
     } ""
-    test interp-18.3 {testing Tcl_DeleteInterp vs slaves} {
+    test interp-18.4 {testing Tcl_DeleteInterp vs slaves} {
 	catch {interp delete a}
 	interp create a
 	interp create {a b}
 	testinterpdelete a
     } ""
-    test interp-18.4 {testing Tcl_DeleteInterp vs slaves} {
+    test interp-18.5 {testing Tcl_DeleteInterp vs slaves} {
 	catch {interp delete a}
 	interp create a
 	interp create {a b}
@@ -517,7 +629,7 @@ if {[info commands testinterpdelete] != ""} {
 	proc dodel {x} {testinterpdelete $x}
 	list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
     } {0 {}}
-    test interp-18.5 {testing Tcl_DeleteInterp vs slaves} {
+    test interp-18.6 {testing Tcl_DeleteInterp vs slaves} {
 	catch {interp delete a}
 	interp create a
 	interp create {a b}
@@ -525,7 +637,7 @@ if {[info commands testinterpdelete] != ""} {
 	proc dodel {x} {testinterpdelete $x}
 	list [catch {interp eval {a b} {dodel a}} msg] $msg
     } {0 {}}
-    test interp-18.6 {eval in deleted interp} {
+    test interp-18.7 {eval in deleted interp} {
 	catch {interp delete a}
 	interp create a
 	a eval {
@@ -541,7 +653,7 @@ if {[info commands testinterpdelete] != ""} {
 	proc dela {} {interp delete a}
 	list [catch {a eval dodel} msg] $msg
     } {1 {attempt to call eval in deleted interpreter}}
-    test interp-18.7 {eval in deleted interp} {
+    test interp-18.8 {eval in deleted interp} {
 	catch {interp delete a}
 	interp create a
 	a eval {
@@ -565,6 +677,1184 @@ if {[info commands testinterpdelete] != ""} {
     } {1 {attempt to call eval in deleted interpreter}}
 }
 
+# Test alias deletion
+
+test interp-19.1 {alias deletion} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    set s [interp alias a foo {}]
+    interp delete a
+    set s
+} {}
+test interp-19.2 {alias deletion} {
+    catch {interp delete a}
+    interp create a
+    catch {interp alias a foo {}} msg
+    interp delete a
+    set msg
+} {alias "foo" not found}
+test interp-19.3 {alias deletion} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    interp eval a {rename foo zop}
+    interp alias a foo a zop
+    catch {interp eval a foo} msg
+    interp delete a
+    set msg
+} {invalid command name "zop"}
+test interp-19.4 {alias deletion} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    interp eval a {rename foo zop}
+    catch {interp eval a foo} msg
+    interp delete a
+    set msg
+} {invalid command name "foo"}
+test interp-19.5 {alias deletion} {
+    catch {interp delete a}
+    interp create a
+    interp eval a {proc bar {} {return 1}}
+    interp alias a foo a bar
+    interp eval a {rename foo zop}
+    catch {interp eval a zop} msg
+    interp delete a
+    set msg
+} 1
+test interp-19.6 {alias deletion} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    interp eval a {rename foo zop}
+    interp alias a foo a zop
+    set s [interp aliases a]
+    interp delete a
+    set s
+} foo
+test interp-19.7 {alias deletion, renaming} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    interp eval a rename foo blotz
+    interp alias a foo {}
+    set s [interp aliases a]
+    interp delete a
+    set s
+} {}
+test interp-19.8 {alias deletion, renaming} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    interp eval a rename foo blotz
+    set l ""
+    lappend l [interp aliases a]
+    interp alias a foo {}
+    lappend l [interp aliases a]
+    interp delete a
+    set l
+} {foo {}}
+test interp-19.9 {alias deletion, renaming} {
+    catch {interp delete a}
+    interp create a
+    interp alias a foo a bar
+    interp eval a rename foo blotz
+    interp eval a {proc foo {} {expr 34 * 34}}
+    interp alias a foo {}
+    set l [interp eval a foo]
+    interp delete a
+    set l
+} 1156    
+
+test interp-20.1 {interp hide, interp expose and interp invokehidden} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    a eval {proc foo {} {}}
+    a hide foo
+    catch {a eval foo something} msg
+    interp delete a
+    set msg
+} {invalid command name "foo"}
+test interp-20.2 {interp hide, interp expose and interp invokehidden} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    a hide list
+    set l ""
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    a expose list
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {1 2 3}}
+test interp-20.3 {interp hide, interp expose and interp invokehidden} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    a hide list
+    set l ""
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    lappend l [catch {a invokehidden list 1 2 3} msg]
+    lappend l $msg
+    a expose list
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
+test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    a hide list
+    set l ""
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    lappend l [catch {a invokehidden list {"" 1 2 3}} msg]
+    lappend l $msg
+    a expose list
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
+test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    a hide list
+    set l ""
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    lappend l [catch {a invokehidden list {{} 1 2 3}} msg]
+    lappend l $msg
+    a expose list
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
+test interp-20.6 {interp invokehidden -- eval args} {
+    catch {interp delete a}
+    interp create a
+    a hide list
+    set l ""
+    set z 45
+    lappend l [catch {a invokehidden list $z 1 2 3} msg]
+    lappend l $msg
+    a expose list
+    lappend l [catch {a eval list $z 1 2 3} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {45 1 2 3} 0 {45 1 2 3}}
+test interp-20.7 {interp invokehidden vs variable eval} {
+    catch {interp delete a}
+    interp create a
+    a hide list
+    set z 45
+    set l ""
+    lappend l [catch {a invokehidden list {$z a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {{$z a b c}}}
+test interp-20.8 {interp invokehidden vs variable eval} {
+    catch {interp delete a}
+    interp create a
+    a hide list
+    a eval set z 89
+    set z 45
+    set l ""
+    lappend l [catch {a invokehidden list {$z a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {{$z a b c}}}
+test interp-20.9 {interp invokehidden vs variable eval} {
+    catch {interp delete a}
+    interp create a
+    a hide list
+    a eval set z 89
+    set z 45
+    set l ""
+    lappend l [catch {a invokehidden list $z {$z a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {45 {$z a b c}}}
+test interp-20.10 {interp hide, interp expose and interp invokehidden} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    a eval {proc foo {} {}}
+    interp hide a foo
+    catch {interp eval a foo something} msg
+    interp delete a
+    set msg
+} {invalid command name "foo"}
+test interp-20.11 {interp hide, interp expose and interp invokehidden} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    interp hide a list
+    set l ""
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    interp expose a list
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {1 2 3}}
+test interp-20.12 {interp hide, interp expose and interp invokehidden} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    interp hide a list
+    set l ""
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    lappend l [catch {interp invokehidden a list 1 2 3} msg]
+    lappend l $msg
+    interp expose a list
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
+test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    interp hide a list
+    set l ""
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    lappend l [catch {interp invokehidden a list {"" 1 2 3}} msg]
+    lappend l $msg
+    interp expose a list
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
+test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} {
+    catch {interp delete a}
+    interp create a
+    a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+    interp hide a list
+    set l ""
+    lappend l [catch {interp eval a {list 1 2 3}} msg]
+    lappend l $msg
+    lappend l [catch {interp invokehidden a list {{} 1 2 3}} msg]
+    lappend l $msg
+    interp expose a list
+    lappend l [catch {a eval {list 1 2 3}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
+test interp-20.15 {interp invokehidden -- eval args} {
+    catch {interp delete a}
+    interp create a
+    interp hide a list
+    set l ""
+    set z 45
+    lappend l [catch {interp invokehidden a list $z 1 2 3} msg]
+    lappend l $msg
+    a expose list
+    lappend l [catch {interp eval a list $z 1 2 3} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {45 1 2 3} 0 {45 1 2 3}}
+test interp-20.16 {interp invokehidden vs variable eval} {
+    catch {interp delete a}
+    interp create a
+    interp hide a list
+    set z 45
+    set l ""
+    lappend l [catch {interp invokehidden a list {$z a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {{$z a b c}}}
+test interp-20.17 {interp invokehidden vs variable eval} {
+    catch {interp delete a}
+    interp create a
+    interp hide a list
+    a eval set z 89
+    set z 45
+    set l ""
+    lappend l [catch {interp invokehidden a list {$z a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {{$z a b c}}}
+test interp-20.18 {interp invokehidden vs variable eval} {
+    catch {interp delete a}
+    interp create a
+    interp hide a list
+    a eval set z 89
+    set z 45
+    set l ""
+    lappend l [catch {interp invokehidden a list $z {$z a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {45 {$z a b c}}}
+test interp-20.19 {interp invokehidden vs nested commands} {
+    catch {interp delete a}
+    interp create a
+    a hide list
+    set l [a invokehidden list {[list x y z] f g h} z]
+    interp delete a
+    set l
+} {{[list x y z] f g h} z}
+test interp-20.20 {interp invokehidden vs nested commands} {
+    catch {interp delete a}
+    interp create a
+    a hide list
+    set l [interp invokehidden a list {[list x y z] f g h} z]
+    interp delete a
+    set l
+} {{[list x y z] f g h} z}
+test interp-20.21 {interp hide vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {a hide list} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {}}
+test interp-20.22 {interp hide vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {interp hide a list} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {}}
+test interp-20.23 {interp hide vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {a eval {interp hide {} list}} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {permission denied: safe interpreter cannot hide commands}}
+test interp-20.24 {interp hide vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    set l ""
+    lappend l [catch {a eval {interp hide b list}} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {permission denied: safe interpreter cannot hide commands}}
+test interp-20.25 {interp hide vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    set l ""
+    lappend l [catch {interp hide {a b} list} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {}}
+test interp-20.26 {interp expoose vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {a hide list} msg]    
+    lappend l $msg
+    lappend l [catch {a expose list} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {} 0 {}}
+test interp-20.27 {interp expose vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {interp hide a list} msg]    
+    lappend l $msg
+    lappend l [catch {interp expose a list} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {} 0 {}}
+test interp-20.28 {interp expose vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {a hide list} msg]    
+    lappend l $msg
+    lappend l [catch {a eval {interp expose {} list}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
+test interp-20.29 {interp expose vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [catch {interp hide a list} msg]    
+    lappend l $msg
+    lappend l [catch {a eval {interp expose {} list}} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
+test interp-20.30 {interp expose vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    set l ""
+    lappend l [catch {interp hide {a b} list} msg]    
+    lappend l $msg
+    lappend l [catch {a eval {interp expose b list}} msg]    
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
+test interp-20.31 {interp expose vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    set l ""
+    lappend l [catch {interp hide {a b} list} msg]    
+    lappend l $msg
+    lappend l [catch {interp expose {a b} list} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {0 {} 0 {}}
+test interp-20.32 {interp invokehidden vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp hide a list
+    set l ""
+    lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {not allowed to invoke hidden commands from safe interpreter}}
+test interp-20.33 {interp invokehidden vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp hide a list
+    set l ""
+    lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
+    lappend l $msg
+    lappend l [catch {a invokehidden list a b c} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {not allowed to invoke hidden commands from safe interpreter}\
+0 {a b c}}
+test interp-20.34 {interp invokehidden vs safety} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    interp hide {a b} list
+    set l ""
+    lappend l [catch {a eval {interp invokehidden b list a b c}} msg]
+    lappend l $msg
+    lappend l [catch {interp invokehidden {a b} list a b c} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {not allowed to invoke hidden commands from safe interpreter}\
+0 {a b c}}
+test interp-20.35 {invokehidden at local level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc p1 {} {
+	    set z 90
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a h1
+    }
+    set r [interp eval a p1]
+    interp delete a
+    set r
+} 91
+test interp-20.36 {invokehidden at local level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	set z 90
+	proc p1 {} {
+	    global z
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a h1
+    }
+    set r [interp eval a p1]
+    interp delete a
+    set r
+} 91
+test interp-20.37 {invokehidden at local level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc p1 {} {
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a h1
+    }
+    set r [interp eval a p1]
+    interp delete a
+    set r
+} 91
+test interp-20.38 {invokehidden at global level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc p1 {} {
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a -global h1
+    }
+    set r [catch {interp eval a p1} msg]
+    interp delete a
+    list $r $msg
+} {1 {can't read "z": no such variable}}
+test interp-20.39 {invokehidden at global level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc p1 {} {
+	    global z
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a -global h1
+    }
+    set r [catch {interp eval a p1} msg]
+    interp delete a
+    list $r $msg
+} {0 91}
+test interp-20.40 {safe, invokehidden at local level} {
+    catch {interp delete a}
+    interp create a -safe
+    a eval {
+	proc p1 {} {
+	    set z 90
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a h1
+    }
+    set r [interp eval a p1]
+    interp delete a
+    set r
+} 91
+test interp-20.41 {safe, invokehidden at local level} {
+    catch {interp delete a}
+    interp create a -safe
+    a eval {
+	set z 90
+	proc p1 {} {
+	    global z
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a h1
+    }
+    set r [interp eval a p1]
+    interp delete a
+    set r
+} 91
+test interp-20.42 {safe, invokehidden at local level} {
+    catch {interp delete a}
+    interp create a -safe
+    a eval {
+	proc p1 {} {
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a h1
+    }
+    set r [interp eval a p1]
+    interp delete a
+    set r
+} 91
+test interp-20.43 {invokehidden at global level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc p1 {} {
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a -global h1
+    }
+    set r [catch {interp eval a p1} msg]
+    interp delete a
+    list $r $msg
+} {1 {can't read "z": no such variable}}
+test interp-20.44 {invokehidden at global level} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc p1 {} {
+	    global z
+	    a1
+	    set z
+	}
+	proc h1 {} {
+	    upvar z z
+	    set z 91
+	}
+    }
+    a hide h1
+    a alias a1 a1
+    proc a1 {} {
+	interp invokehidden a -global h1
+    }
+    set r [catch {interp eval a p1} msg]
+    interp delete a
+    list $r $msg
+} {0 91}
+
+test interp-21.1 {interp hidden} {
+    interp hidden {}
+} ""
+test interp-21.2 {interp hidden} {
+    interp hidden
+} ""
+test interp-21.3 {interp hidden vs interp hide, interp expose} {
+    set l ""
+    lappend l [interp hidden]
+    interp hide {} pwd
+    lappend l [interp hidden]
+    interp expose {} pwd
+    lappend l [interp hidden]
+    set l
+} {{} pwd {}}
+test interp-21.4 {interp hidden} {
+    catch {interp delete a}
+    interp create a
+    set l [interp hidden a]
+    interp delete a
+    set l
+} ""
+test interp-21.5 {interp hidden} {
+    catch {interp delete a}
+    interp create -safe a
+    set l [lsort [interp hidden a]]
+    interp delete a
+    set l
+} $hidden_cmds 
+test interp-21.6 {interp hidden vs interp hide, interp expose} {
+    catch {interp delete a}
+    interp create a
+    set l ""
+    lappend l [interp hidden a]
+    interp hide a pwd
+    lappend l [interp hidden a]
+    interp expose a pwd
+    lappend l [interp hidden a]
+    interp delete a
+    set l
+} {{} pwd {}}
+test interp-21.7 {interp hidden} {
+    catch {interp delete a}
+    interp create a
+    set l [a hidden]
+    interp delete a
+    set l
+} ""
+test interp-21.8 {interp hidden} {
+    catch {interp delete a}
+    interp create a -safe
+    set l [lsort [a hidden]]
+    interp delete a
+    set l
+} $hidden_cmds
+test interp-21.9 {interp hidden vs interp hide, interp expose} {
+    catch {interp delete a}
+    interp create a
+    set l ""
+    lappend l [a hidden]
+    a hide pwd
+    lappend l [a hidden]
+    a expose pwd
+    lappend l [a hidden]
+    interp delete a
+    set l
+} {{} pwd {}}
+
+test interp-22.1 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a
+    set l ""
+    lappend l [a issafe]
+    lappend l [a marktrusted]
+    lappend l [a issafe]
+    interp delete a
+    set l
+} {0 {} 0}
+test interp-22.2 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a
+    set l ""
+    lappend l [interp issafe a]
+    lappend l [interp marktrusted a]
+    lappend l [interp issafe a]
+    interp delete a
+    set l
+} {0 {} 0}
+test interp-22.3 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [a issafe]
+    lappend l [a marktrusted]
+    lappend l [a issafe]
+    interp delete a
+    set l
+} {1 {} 0}
+test interp-22.4 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [interp issafe a]
+    lappend l [interp marktrusted a]
+    lappend l [interp issafe a]
+    interp delete a
+    set l
+} {1 {} 0}
+test interp-22.5 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    catch {a eval {interp marktrusted b}} msg
+    interp delete a
+    set msg
+} {"interp marktrusted" can only be invoked from a trusted interpreter}
+test interp-22.6 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    catch {a eval {b marktrusted}} msg
+    interp delete a
+    set msg
+} {"b marktrusted" can only be invoked from a trusted interpreter}
+test interp-22.7 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [interp issafe a]
+    interp marktrusted a
+    interp create {a b}
+    lappend l [interp issafe a]
+    lappend l [interp issafe {a b}]
+    interp delete a
+    set l
+} {1 0 0}
+test interp-22.8 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [interp issafe a]
+    interp create {a b}
+    lappend l [interp issafe {a b}]
+    interp marktrusted a
+    interp create {a c}
+    lappend l [interp issafe a]
+    lappend l [interp issafe {a c}]
+    interp delete a
+    set l
+} {1 1 0 0}
+test interp-22.9 {testing interp marktrusted} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [interp issafe a]
+    interp create {a b}
+    lappend l [interp issafe {a b}]
+    interp marktrusted {a b}
+    lappend l [interp issafe a]
+    lappend l [interp issafe {a b}]
+    interp create {a b c}
+    lappend l [interp issafe {a b c}]
+    interp delete a
+    set l
+} {1 1 1 0 0}
+
+test interp-23.1 {testing hiding vs aliases} {
+    catch {interp delete a}
+    interp create a
+    set l ""
+    lappend l [interp hidden a]
+    a alias bar bar
+    lappend l [interp aliases a]
+    lappend l [interp hidden a]
+    a hide bar
+    lappend l [interp aliases a]
+    lappend l [interp hidden a]
+    a alias bar {}
+    lappend l [interp aliases a]
+    lappend l [interp hidden a]
+    interp delete a
+    set l
+} {{} bar {} bar bar {} {}}
+test interp-23.2 {testing hiding vs aliases} {pc || unix} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [lsort [interp hidden a]]
+    a alias bar bar
+    lappend l [interp aliases a]
+    lappend l [lsort [interp hidden a]]
+    a hide bar
+    lappend l [interp aliases a]
+    lappend l [lsort [interp hidden a]]
+    a alias bar {}
+    lappend l [interp aliases a]
+    lappend l [lsort [interp hidden a]]
+    interp delete a
+    set l
+} {{cd exec exit fconfigure file glob load open pwd socket source vwait} bar {cd exec exit fconfigure file glob load open pwd socket source vwait} bar {bar cd exec exit fconfigure file glob load open pwd socket source vwait} {} {cd exec exit fconfigure file glob load open pwd socket source vwait}} 
+
+test interp-23.3 {testing hiding vs aliases} {macOnly} {
+    catch {interp delete a}
+    interp create a -safe
+    set l ""
+    lappend l [lsort [interp hidden a]]
+    a alias bar bar
+    lappend l [interp aliases a]
+    lappend l [lsort [interp hidden a]]
+    a hide bar
+    lappend l [interp aliases a]
+    lappend l [lsort [interp hidden a]]
+    a alias bar {}
+    lappend l [interp aliases a]
+    lappend l [lsort [interp hidden a]]
+    interp delete a
+    set l
+} {{beep cd echo exit fconfigure file glob load ls open pwd socket source vwait} bar {beep cd echo exit fconfigure file glob load ls open pwd socket source vwait} bar {bar beep cd echo exit fconfigure file glob load ls open pwd socket source vwait} {} {beep cd echo exit fconfigure file glob load ls open pwd socket source vwait}} 
+
+test interp-24.1 {result resetting on error} {
+    catch {interp delete a}
+    interp create a
+    proc foo args {error $args}
+    interp alias a foo {} foo
+    set l [interp eval a {
+	set l {}
+	lappend l [catch {foo 1 2 3} msg]
+	lappend l $msg
+	lappend l [catch {foo 3 4 5} msg]
+	lappend l $msg
+	set l
+    }]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.2 {result resetting on error} {
+    catch {interp delete a}
+    interp create a -safe
+    proc foo args {error $args}
+    interp alias a foo {} foo
+    set l [interp eval a {
+	set l {}
+	lappend l [catch {foo 1 2 3} msg]
+	lappend l $msg
+	lappend l [catch {foo 3 4 5} msg]
+	lappend l $msg
+	set l
+    }]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.3 {result resetting on error} {
+    catch {interp delete a}
+    interp create a
+    interp create {a b}
+    interp eval a {
+	proc foo args {error $args}
+    }
+    interp alias {a b} foo a foo
+    set l [interp eval {a b} {
+	set l {}
+	lappend l [catch {foo 1 2 3} msg]
+	lappend l $msg
+	lappend l [catch {foo 3 4 5} msg]
+	lappend l $msg
+	set l
+    }]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.4 {result resetting on error} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    interp eval a {
+	proc foo args {error $args}
+    }
+    interp alias {a b} foo a foo
+    set l [interp eval {a b} {
+	set l {}
+	lappend l [catch {foo 1 2 3} msg]
+	lappend l $msg
+	lappend l [catch {foo 3 4 5} msg]
+	lappend l $msg
+	set l
+    }]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.5 {result resetting on error} {
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a
+    interp create b
+    interp eval a {
+	proc foo args {error $args}
+    }
+    interp alias b foo a foo
+    set l [interp eval b {
+	set l {}
+	lappend l [catch {foo 1 2 3} msg]
+	lappend l $msg
+	lappend l [catch {foo 3 4 5} msg]
+	lappend l $msg
+	set l
+    }]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.6 {result resetting on error} {
+    catch {interp delete a}
+    catch {interp delete b}
+    interp create a -safe
+    interp create b -safe
+    interp eval a {
+	proc foo args {error $args}
+    }
+    interp alias b foo a foo
+    set l [interp eval b {
+	set l {}
+	lappend l [catch {foo 1 2 3} msg]
+	lappend l $msg
+	lappend l [catch {foo 3 4 5} msg]
+	lappend l $msg
+	set l
+    }]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.7 {result resetting on error} {
+    catch {interp delete a}
+    interp create a
+    interp eval a {
+	proc foo args {error $args}
+    }
+    set l {}
+    lappend l [catch {interp eval a foo 1 2 3} msg]
+    lappend l $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.8 {result resetting on error} {
+    catch {interp delete a}
+    interp create a -safe
+    interp eval a {
+	proc foo args {error $args}
+    }
+    set l {}
+    lappend l [catch {interp eval a foo 1 2 3} msg]
+    lappend l $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.9 {result resetting on error} {
+    catch {interp delete a}
+    interp create a
+    interp create {a b}
+    interp eval {a b} {
+	proc foo args {error $args}
+    }
+    interp eval a {
+	proc foo args {
+	    eval interp eval b foo $args
+	}
+    }
+    set l {}
+    lappend l [catch {interp eval a foo 1 2 3} msg]
+    lappend l $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.10 {result resetting on error} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    interp eval {a b} {
+	proc foo args {error $args}
+    }
+    interp eval a {
+	proc foo args {
+	    eval interp eval b foo $args
+	}
+    }
+    set l {}
+    lappend l [catch {interp eval a foo 1 2 3} msg]
+    lappend l $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg]
+    lappend l $msg
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {3 4 5}}
+test interp-24.11 {result resetting on error} {
+    catch {interp delete a}
+    interp create a
+    interp create {a b}
+    interp eval {a b} {
+	proc foo args {error $args}
+    }
+    interp eval a {
+	proc foo args {
+	    set l {}
+	    lappend l [catch {eval interp eval b foo $args} msg]
+	    lappend l $msg
+	    lappend l [catch {eval interp eval b foo $args} msg]
+	    lappend l $msg
+	    set l
+	}
+    }
+    set l [interp eval a foo 1 2 3]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {1 2 3}}
+test interp-24.12 {result resetting on error} {
+    catch {interp delete a}
+    interp create a -safe
+    interp create {a b}
+    interp eval {a b} {
+	proc foo args {error $args}
+    }
+    interp eval a {
+	proc foo args {
+	    set l {}
+	    lappend l [catch {eval interp eval b foo $args} msg]
+	    lappend l $msg
+	    lappend l [catch {eval interp eval b foo $args} msg]
+	    lappend l $msg
+	    set l
+	}
+    }
+    set l [interp eval a foo 1 2 3]
+    interp delete a
+    set l
+} {1 {1 2 3} 1 {1 2 3}}
+
+unset hidden_cmds
+
+test interp-25.1 {testing aliasing of string commands} {
+    catch {interp delete a}
+    interp create a
+    a alias exec foo		;# Relies on exec being a string command!
+    interp delete a
+} ""
+
 foreach i [interp slaves] {
   interp delete $i
 }
diff --git a/contrib/tcl/tests/io.test b/contrib/tcl/tests/io.test
index 2c85624..c83033b 100644
--- a/contrib/tcl/tests/io.test
+++ b/contrib/tcl/tests/io.test
@@ -11,13 +11,26 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# "@(#) io.test 1.87 96/07/30 11:59:00"
+# SCCS: @(#) io.test 1.119 97/06/23 18:47:01
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
+if {"[info commands testchannel]" != "testchannel"} {
+    puts "Skipping io tests. This application does not seem to have the"
+    puts "testchannel command that is needed to run these tests."
+    return
+}
+
 removeFile test1
 removeFile pipe
 
+set testConfig(umask2) 1
+catch {
+    if {"[exec umask]" != "002"} {
+	set testConfig(umask2) 0
+    }
+}
+
 # set up a long data file for some of the following tests
 
 set f [open longfile w]
@@ -209,6 +222,42 @@ test io-1.7 {Tcl_GetChannel: stdio name translation} {
     interp delete z
     set result
 } {{} {} {can not find channel named "stderr"}}
+test io-1.8 {reuse of stdio special channels} {unixOnly} {
+    removeFile script
+    removeFile test1
+    set f [open script w]
+    puts $f {
+	close stderr
+	set f [open test1 w]
+	puts stderr hello
+	close $f
+	set f [open test1 r]
+	puts [gets $f]
+    }
+    close $f
+    set f [open "|$tcltest script" r]
+    set c [gets $f]
+    close $f
+    set c
+} hello
+test io-1.9 {reuse of stdio special channels} {unixOnly} {
+    removeFile script
+    removeFile test1
+    set f [open script w]
+    puts $f {
+	set f [open test1 w]
+	puts $f hello
+	close $f
+	close stderr
+	set f [open "|cat test1" r]
+	puts [gets $f]
+    }
+    close $f
+    set f [open "|$tcltest script" r]
+    set c [gets $f]
+    close $f
+    set c
+} hello
 
 # Must add test function for testing Tcl_CreateCloseHandler and
 # Tcl_DeleteCloseHandler.
@@ -216,38 +265,47 @@ test io-1.7 {Tcl_GetChannel: stdio name translation} {
 # Test channel table management. The functions tested are
 # GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,
 # Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel.
+#
+# These functions use "eof stdin" to ensure that the standard
+# channels are added to the channel table of the interpreter.
 
-test io-3.1 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-2.1 {GetChannelTable, DeleteChannelTable on std handles} {
+    set l1 [testchannel refcount stdin]
+    eof stdin
     interp create x
     set l ""
-    lappend l [testchannel refcount stdin]
+    lappend l [expr [testchannel refcount stdin] - $l1]
     x eval {eof stdin}
-    lappend l [testchannel refcount stdin]
+    lappend l [expr [testchannel refcount stdin] - $l1]
     interp delete x
-    lappend l [testchannel refcount stdin]
+    lappend l [expr [testchannel refcount stdin] - $l1]
     set l
-} {2 2 1}
-test io-3.2 {GetChannelTable, DeleteChannelTable on std handles} {
+} {0 1 0}
+test io-2.2 {GetChannelTable, DeleteChannelTable on std handles} {
+    set l1 [testchannel refcount stdout]
+    eof stdin
     interp create x
     set l ""
-    lappend l [testchannel refcount stdout]
+    lappend l [expr [testchannel refcount stdout] - $l1]
     x eval {eof stdout}
-    lappend l [testchannel refcount stdout]
+    lappend l [expr [testchannel refcount stdout] - $l1]
     interp delete x
-    lappend l [testchannel refcount stdout]
+    lappend l [expr [testchannel refcount stdout] - $l1]
     set l
-} {2 2 1}
-test io-3.3 {GetChannelTable, DeleteChannelTable on std handles} {
+} {0 1 0}
+test io-2.3 {GetChannelTable, DeleteChannelTable on std handles} {
+    set l1 [testchannel refcount stderr]
+    eof stdin
     interp create x
     set l ""
-    lappend l [testchannel refcount stderr]
+    lappend l [expr [testchannel refcount stderr] - $l1]
     x eval {eof stderr}
-    lappend l [testchannel refcount stderr]
+    lappend l [expr [testchannel refcount stderr] - $l1]
     interp delete x
-    lappend l [testchannel refcount stderr]
+    lappend l [expr [testchannel refcount stderr] - $l1]
     set l
-} {2 2 1}
-test io-3.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+} {0 1 0}
+test io-2.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
     removeFile test1
     set l ""
     set f [open test1 w]
@@ -261,7 +319,7 @@ test io-3.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
     string compare [string tolower $l] \
 	[list 1 [format "can not find channel named \"%s\"" $f]]
 } 0
-test io-3.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-2.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
     removeFile test1
     set l ""
     set f [open test1 w]
@@ -282,7 +340,7 @@ test io-3.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
     string compare [string tolower $l] \
 	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
 } 0
-test io-3.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-2.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
     removeFile test1
     set l ""
     set f [open test1 w]
@@ -301,20 +359,20 @@ test io-3.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
     string compare [string tolower $l] \
 	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
 } 0
-test io-3.7 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
+test io-2.7 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
     eof stdin
 } 0
-test io-3.6 {testing Tcl_GetChannel, user opened handle} {
+test io-2.8 {testing Tcl_GetChannel, user opened handle} {
     removeFile test1
     set f [open test1 w]
     set x [eof $f]
     close $f
     set x
 } 0
-test io-3.8 {Tcl_GetChannel, channel not found} {
+test io-2.9 {Tcl_GetChannel, channel not found} {
     list [catch {eof file34} msg] $msg
 } {1 {can not find channel named "file34"}}
-test io-3.9 {Tcl_CreateChannel, insertion into channel table} {
+test io-2.10 {Tcl_CreateChannel, insertion into channel table} {
     removeFile test1
     set f [open test1 w]
     set l ""
@@ -335,21 +393,21 @@ test io-3.9 {Tcl_CreateChannel, insertion into channel table} {
 # Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
 # not tested because files do not use the instance data.
 
-test io-4.1 {Tcl_GetChannelName} {
+test io-3.1 {Tcl_GetChannelName} {
     removeFile test1
     set f [open test1 w]
     set n [testchannel name $f]
     close $f
     string compare $n $f
 } 0
-test io-4.2 {Tcl_GetChannelType} {
+test io-3.2 {Tcl_GetChannelType} {
     removeFile test1
     set f [open test1 w]
     set t [testchannel type $f]
     close $f
     string compare $t file
 } 0
-test io-4.3 {Tcl_GetChannelFile, input} {
+test io-3.3 {Tcl_GetChannelFile, input} {
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
     puts $f "1234567890\n098765432"
@@ -362,7 +420,7 @@ test io-4.3 {Tcl_GetChannelFile, input} {
     close $f
     set l
 } {10 11}
-test io-4.4 {Tcl_GetChannelFile, output} {
+test io-3.4 {Tcl_GetChannelFile, output} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -380,7 +438,7 @@ test io-4.4 {Tcl_GetChannelFile, output} {
 
 # Test flushing. The functions tested here are FlushChannel.
 
-test io-5.1 {FlushChannel, no output buffered} {
+test io-4.1 {FlushChannel, no output buffered} {
     removeFile test1
     set f [open test1 w]
     flush $f
@@ -388,7 +446,7 @@ test io-5.1 {FlushChannel, no output buffered} {
     close $f
     set s
 } 0
-test io-5.2 {FlushChannel, some output buffered} {
+test io-4.2 {FlushChannel, some output buffered} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -401,7 +459,7 @@ test io-5.2 {FlushChannel, some output buffered} {
     lappend l [file size test1]
     set l
 } {0 6 6}
-test io-5.3 {FlushChannel, implicit flush on close} {
+test io-4.3 {FlushChannel, implicit flush on close} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -412,7 +470,7 @@ test io-5.3 {FlushChannel, implicit flush on close} {
     lappend l [file size test1]
     set l
 } {0 6}
-test io-5.4 {FlushChannel, implicit flush when buffer fills} {
+test io-4.4 {FlushChannel, implicit flush when buffer fills} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -428,7 +486,7 @@ test io-5.4 {FlushChannel, implicit flush when buffer fills} {
     close $f
     set l
 } {0 60 72}
-test io-5.5 {FlushChannel, implicit flush when buffer fills and on close} {unixOrPc} {
+test io-4.5 {FlushChannel, implicit flush when buffer fills and on close} {unixOrPc} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -buffersize 60 -eofchar {}
@@ -442,7 +500,7 @@ test io-5.5 {FlushChannel, implicit flush when buffer fills and on close} {unixO
     lappend l [file size test1]
     set l
 } {0 60 72}
-test io-5.6 {FlushChannel, async flushing, async close} {unixOrPc asyncPipeClose} {
+test io-4.6 {FlushChannel, async flushing, async close} {unixOrPc asyncPipeClose} {
     removeFile pipe
     removeFile output
     set f [open pipe w]
@@ -481,7 +539,7 @@ test io-5.6 {FlushChannel, async flushing, async close} {unixOrPc asyncPipeClose
 
 # Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.
 
-test io-6.1 {CloseChannel called when all references are dropped} {
+test io-5.1 {CloseChannel called when all references are dropped} {
     removeFile test1
     set f [open test1 w]
     interp create x
@@ -494,7 +552,7 @@ test io-6.1 {CloseChannel called when all references are dropped} {
     close $f
     set l
 } {2 1}
-test io-6.2 {CloseChannel called when all references are dropped} {
+test io-5.2 {CloseChannel called when all references are dropped} {
     removeFile test1
     set f [open test1 w]
     interp create x
@@ -509,7 +567,7 @@ test io-6.2 {CloseChannel called when all references are dropped} {
     close $f
     set l
 } abcdef
-test io-6.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose tempNotPc nonPortable} {
+test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose tempNotPc nonPortable} {
     removeFile pipe
     removeFile output
     set f [open pipe w]
@@ -552,13 +610,8 @@ test io-6.3 {CloseChannel, not called before output queue is empty} {unixOrPc as
     } else {
         set result ok
     }
-    #
-    # Wait for the flush to finish
-    #
-    catch {vwait x}
-    set result
 } ok
-test io-6.4 {Tcl_Close} {
+test io-5.4 {Tcl_Close} {
     removeFile test1
     set l ""
     lappend l [lsort [testchannel open]]
@@ -571,7 +624,7 @@ test io-6.4 {Tcl_Close} {
 		$consoleFileNames]
     string compare $l $x
 } 0
-test io-6.5 {Tcl_Close vs standard handles} {unixOnly} {
+test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
     removeFile script
     set f [open script w]
     puts $f {
@@ -588,10 +641,10 @@ test io-6.5 {Tcl_Close vs standard handles} {unixOnly} {
 # Test output on channels. The functions tested are Tcl_Write
 # and Tcl_Flush.
 
-test io-7.1 {Tcl_Write, channel not writable} {
+test io-6.1 {Tcl_Write, channel not writable} {
     list [catch {puts stdin hello} msg] $msg
 } {1 {channel "stdin" wasn't opened for writing}}
-test io-7.2 {Tcl_Write, empty string} {
+test io-6.2 {Tcl_Write, empty string} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -eofchar {}
@@ -599,7 +652,7 @@ test io-7.2 {Tcl_Write, empty string} {
     close $f
     file size test1
 } 0
-test io-7.3 {Tcl_Write, nonempty string} {
+test io-6.3 {Tcl_Write, nonempty string} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -eofchar {}
@@ -607,7 +660,7 @@ test io-7.3 {Tcl_Write, nonempty string} {
     close $f
     file size test1
 } 5
-test io-7.4 {Tcl_Write, buffering in full buffering mode} {
+test io-6.4 {Tcl_Write, buffering in full buffering mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -buffering full -eofchar {}
@@ -621,7 +674,7 @@ test io-7.4 {Tcl_Write, buffering in full buffering mode} {
     close $f
     set l
 } {6 0 0 6}
-test io-7.5 {Tcl_Write, buffering in line buffering mode} {
+test io-6.5 {Tcl_Write, buffering in line buffering mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -buffering line -eofchar {}
@@ -635,7 +688,7 @@ test io-7.5 {Tcl_Write, buffering in line buffering mode} {
     close $f
     set l
 } {5 0 0 11}
-test io-7.6 {Tcl_Write, buffering in no buffering mode} {
+test io-6.6 {Tcl_Write, buffering in no buffering mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -buffering none -eofchar {}
@@ -649,7 +702,7 @@ test io-7.6 {Tcl_Write, buffering in no buffering mode} {
     close $f
     set l
 } {0 5 0 11}
-test io-7.7 {Tcl_Flush, full buffering} {
+test io-6.7 {Tcl_Flush, full buffering} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -buffering full -eofchar {}
@@ -666,7 +719,7 @@ test io-7.7 {Tcl_Flush, full buffering} {
     close $f
     set l
 } {5 0 11 0 0 11}
-test io-7.8 {Tcl_Flush, full buffering} {
+test io-6.8 {Tcl_Flush, full buffering} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -buffering line
@@ -686,10 +739,10 @@ test io-7.8 {Tcl_Flush, full buffering} {
     close $f
     set l
 } {5 0 0 5 0 11 0 11}
-test io-7.9 {Tcl_Flush, channel not writable} {
+test io-6.9 {Tcl_Flush, channel not writable} {
     list [catch {flush stdin} msg] $msg
 } {1 {channel "stdin" wasn't opened for writing}}
-test io-7.10 {Tcl_Write, looping and buffering} {
+test io-6.10 {Tcl_Write, looping and buffering} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -701,7 +754,7 @@ test io-7.10 {Tcl_Write, looping and buffering} {
     close $f1
     file size test1
 } 387
-test io-7.11 {Tcl_Write, no newline, implicit flush} {
+test io-6.11 {Tcl_Write, no newline, implicit flush} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -eofchar {}
@@ -713,7 +766,7 @@ test io-7.11 {Tcl_Write, no newline, implicit flush} {
     close $f2
     file size test1
 } 377
-test io-7.12 {Tcl_Write on a pipe} {unixOrPc} {
+test io-6.12 {Tcl_Write on a pipe} {unixOrPc} {
     removeFile test1
     removeFile pipe
     set f1 [open pipe w]
@@ -738,7 +791,7 @@ test io-7.12 {Tcl_Write on a pipe} {unixOrPc} {
     close $f2
     set y
 } ok
-test io-7.13 {Tcl_Write to a pipe, line buffered} {unixOrPc} {
+test io-6.13 {Tcl_Write to a pipe, line buffered} {unixOrPc} {
     removeFile test1
     removeFile pipe
     set f1 [open pipe w]
@@ -767,7 +820,7 @@ test io-7.13 {Tcl_Write to a pipe, line buffered} {unixOrPc} {
     close $f2
     set y
 } ok
-test io-7.14 {Tcl_Write, buffering and implicit flush at close} {
+test io-6.14 {Tcl_Write, buffering and implicit flush at close} {
     removeFile test3
     set f [open test3 w]
     puts -nonewline $f "Text1"
@@ -779,7 +832,7 @@ test io-7.14 {Tcl_Write, buffering and implicit flush at close} {
     close $f
     set x
 } {Text1 Text 2 Text 3}
-test io-7.15 {Tcl_Flush, channel not open for writing} {
+test io-6.15 {Tcl_Flush, channel not open for writing} {
     removeFile test1
     set fd [open test1 w]
     close $fd
@@ -789,14 +842,14 @@ test io-7.15 {Tcl_Flush, channel not open for writing} {
     string compare $x \
 	[list 1 "channel \"$fd\" wasn't opened for writing"]
 } 0
-test io-7.16 {Tcl_Flush on pipe opened only for reading} {unixOrPc unixExecs} {
+test io-6.16 {Tcl_Flush on pipe opened only for reading} {unixOrPc unixExecs} {
     set fd [open "|cat longfile" r]
     set x [list [catch {flush $fd} msg] $msg]
     catch {close $fd}
     string compare $x \
 	[list 1 "channel \"$fd\" wasn't opened for writing"]
 } 0
-test io-7.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
+test io-6.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf
@@ -808,7 +861,7 @@ test io-7.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
     close $f1
     set x
 } 18
-test io-7.18 {Tcl_Write and Tcl_Flush intermixed} {
+test io-6.18 {Tcl_Write and Tcl_Flush intermixed} {
     removeFile test1
     set x ""
     set f1 [open test1 w]
@@ -827,7 +880,7 @@ test io-7.18 {Tcl_Write and Tcl_Flush intermixed} {
     close $f1
     set x
 } {18 24 30}
-test io-7.19 {Explicit and implicit flushes} {
+test io-6.19 {Explicit and implicit flushes} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -845,7 +898,7 @@ test io-7.19 {Explicit and implicit flushes} {
     lappend x [file size test1]
     set x
 } {18 24 30}
-test io-7.20 {Implicit flush when buffer is full} {
+test io-6.20 {Implicit flush when buffer is full} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -863,7 +916,7 @@ test io-7.20 {Implicit flush when buffer is full} {
     lappend z [file size test1]
     set z
 } {4096 12288 12600}
-test io-7.21 {Tcl_Flush to pipe} {unixOrPc} {
+test io-6.21 {Tcl_Flush to pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {set x [read stdin 6]}
@@ -877,7 +930,7 @@ test io-7.21 {Tcl_Flush to pipe} {unixOrPc} {
     catch {close $f1}
     set x
 } "read 6 characters"
-test io-7.22 {Tcl_Flush called at other end of pipe} {unixOrPc} {
+test io-6.22 {Tcl_Flush called at other end of pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {
@@ -900,7 +953,7 @@ test io-7.22 {Tcl_Flush called at other end of pipe} {unixOrPc} {
     close $f1
     set x
 } {hello hello bye}
-test io-7.23 {Tcl_Flush and line buffering at end of pipe} {unixOrPc} {
+test io-6.23 {Tcl_Flush and line buffering at end of pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {
@@ -920,7 +973,7 @@ test io-7.23 {Tcl_Flush and line buffering at end of pipe} {unixOrPc} {
     close $f1
     set x
 } {hello hello bye}
-test io-7.24 {Tcl_Write and Tcl_Flush move end of file} {
+test io-6.24 {Tcl_Write and Tcl_Flush move end of file} {
     set f [open test3 w]
     puts $f "Line 1"
     puts $f "Line 2"
@@ -936,7 +989,7 @@ test io-7.24 {Tcl_Write and Tcl_Flush move end of file} {
     set x
 } {{} {Line 1
 Line 2}}
-test io-7.25 {Implicit flush with Tcl_Flush to command pipelines} {unixOrPc unixExecs} {
+test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {unixOrPc unixExecs} {
     removeFile test3
     set f [open "| cat | cat > test3" w]
     puts $f "Line 1"
@@ -950,7 +1003,7 @@ test io-7.25 {Implicit flush with Tcl_Flush to command pipelines} {unixOrPc unix
 } {Line 1
 Line 2
 }    
-test io-7.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc unixExecs} {
+test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc unixExecs} {
     set f [open "| cat -u" r+]
     puts $f "Line1"
     flush $f
@@ -958,7 +1011,7 @@ test io-7.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc unixExe
     close $f
     set x
 } {Line1}
-test io-7.27 {Tcl_Flush on closed pipeline} {unixOrPc tempNotPc} {
+test io-6.27 {Tcl_Flush on closed pipeline} {unixOrPc tempNotPc} {
     removeFile pipe
     set f [open pipe w]
     puts $f {exit}
@@ -986,7 +1039,7 @@ test io-7.27 {Tcl_Flush on closed pipeline} {unixOrPc tempNotPc} {
     regsub {".*":} $x {"":} x
     string tolower $x
 } {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
-test io-7.28 {Tcl_Write, lf mode} {
+test io-6.28 {Tcl_Write, lf mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -996,7 +1049,7 @@ test io-7.28 {Tcl_Write, lf mode} {
     close $f
     set s
 } 21
-test io-7.29 {Tcl_Write, cr mode} {
+test io-6.29 {Tcl_Write, cr mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar {}
@@ -1004,7 +1057,7 @@ test io-7.29 {Tcl_Write, cr mode} {
     close $f
     file size test1
 } 21
-test io-7.30 {Tcl_Write, crlf mode} {
+test io-6.30 {Tcl_Write, crlf mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar {}
@@ -1012,7 +1065,7 @@ test io-7.30 {Tcl_Write, crlf mode} {
     close $f
     file size test1
 } 25
-test io-7.31 {Tcl_Write, background flush} {unixOrPc} {
+test io-6.31 {Tcl_Write, background flush} {unixOrPc} {
     removeFile pipe
     removeFile output
     set f [open pipe w]
@@ -1048,7 +1101,7 @@ test io-7.31 {Tcl_Write, background flush} {unixOrPc} {
         set result ok
     }
 } ok
-test io-7.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClose} {
+test io-6.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClose} {
     removeFile pipe
     removeFile output
     set f [open pipe w]
@@ -1085,7 +1138,7 @@ test io-7.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClo
         set result ok
     }
 } ok
-test io-7.33 {Tcl_Flush, implicit flush on exit} {unixOrPc} {
+test io-6.33 {Tcl_Flush, implicit flush on exit} {unixOrPc} {
     set f [open script w]
     puts $f {
 	set f [open test1 w]
@@ -1104,7 +1157,8 @@ test io-7.33 {Tcl_Flush, implicit flush on exit} {unixOrPc} {
 bye
 strange
 }
-test io-7.34 {Tcl_Close, async flush on close, using sockets} {
+
+test io-6.34 {Tcl_Close, async flush on close, using sockets} {tempNotMac} {
     set c 0
     set x running
     set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
@@ -1140,7 +1194,7 @@ test io-7.34 {Tcl_Close, async flush on close, using sockets} {
     vwait x
     set c
 } 2000
-test io-7.35 {Tcl_Close vs fileevent vs multiple interpreters} {
+test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {
     catch {interp delete x}
     catch {interp delete y}
     interp create x
@@ -1181,7 +1235,7 @@ test io-7.35 {Tcl_Close vs fileevent vs multiple interpreters} {
 
 # Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
 
-test io-8.1 {Tcl_Write lf, Tcl_Read lf} {
+test io-7.1 {Tcl_Write lf, Tcl_Read lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1193,7 +1247,7 @@ test io-8.1 {Tcl_Write lf, Tcl_Read lf} {
     close $f
     set x
 } "hello\nthere\nand\nhere\n"
-test io-8.2 {Tcl_Write lf, Tcl_Read cr} {
+test io-7.2 {Tcl_Write lf, Tcl_Read cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1205,7 +1259,7 @@ test io-8.2 {Tcl_Write lf, Tcl_Read cr} {
     close $f
     set x
 } "hello\nthere\nand\nhere\n"
-test io-8.3 {Tcl_Write lf, Tcl_Read crlf} {
+test io-7.3 {Tcl_Write lf, Tcl_Read crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1217,7 +1271,7 @@ test io-8.3 {Tcl_Write lf, Tcl_Read crlf} {
     close $f
     set x
 } "hello\nthere\nand\nhere\n"
-test io-8.4 {Tcl_Write cr, Tcl_Read cr} {
+test io-7.4 {Tcl_Write cr, Tcl_Read cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1229,7 +1283,7 @@ test io-8.4 {Tcl_Write cr, Tcl_Read cr} {
     close $f
     set x
 } "hello\nthere\nand\nhere\n"
-test io-8.5 {Tcl_Write cr, Tcl_Read lf} {
+test io-7.5 {Tcl_Write cr, Tcl_Read lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1241,7 +1295,7 @@ test io-8.5 {Tcl_Write cr, Tcl_Read lf} {
     close $f
     set x
 } "hello\rthere\rand\rhere\r"
-test io-8.6 {Tcl_Write cr, Tcl_Read crlf} {
+test io-7.6 {Tcl_Write cr, Tcl_Read crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1253,7 +1307,7 @@ test io-8.6 {Tcl_Write cr, Tcl_Read crlf} {
     close $f
     set x 
 } "hello\rthere\rand\rhere\r"
-test io-8.7 {Tcl_Write crlf, Tcl_Read crlf} {
+test io-7.7 {Tcl_Write crlf, Tcl_Read crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1265,7 +1319,7 @@ test io-8.7 {Tcl_Write crlf, Tcl_Read crlf} {
     close $f
     set x
 } "hello\nthere\nand\nhere\n"
-test io-8.8 {Tcl_Write crlf, Tcl_Read lf} {
+test io-7.8 {Tcl_Write crlf, Tcl_Read lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1277,7 +1331,7 @@ test io-8.8 {Tcl_Write crlf, Tcl_Read lf} {
     close $f
     set x
 } "hello\r\nthere\r\nand\r\nhere\r\n"
-test io-8.9 {Tcl_Write crlf, Tcl_Read cr} {
+test io-7.9 {Tcl_Write crlf, Tcl_Read cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1289,7 +1343,7 @@ test io-8.9 {Tcl_Write crlf, Tcl_Read cr} {
     close $f
     set x
 } "hello\n\nthere\n\nand\n\nhere\n\n"
-test io-8.10 {Tcl_Write lf, Tcl_Read auto} {
+test io-7.10 {Tcl_Write lf, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1305,7 +1359,7 @@ there
 and
 here
 } auto}
-test io-8.11 {Tcl_Write cr, Tcl_Read auto} {
+test io-7.11 {Tcl_Write cr, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1321,7 +1375,7 @@ there
 and
 here
 } auto}
-test io-8.12 {Tcl_Write crlf, Tcl_Read auto} {
+test io-7.12 {Tcl_Write crlf, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1338,7 +1392,7 @@ and
 here
 } auto}
 
-test io-8.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
+test io-7.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1355,7 +1409,7 @@ test io-8.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
     string length $c
 } [expr 700*15+1]
 
-test io-8.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
+test io-7.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1372,7 +1426,7 @@ test io-8.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
     string length $c
 } [expr 700*15+1]
 
-test io-8.15 {Tcl_Write mixed, Tcl_Read auto} {
+test io-7.15 {Tcl_Write mixed, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1388,7 +1442,7 @@ there
 and
 here
 }
-test io-8.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
+test io-7.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1404,7 +1458,7 @@ there
 and
 here
 }
-test io-8.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
+test io-7.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -eofchar \x1a -translation lf
@@ -1420,7 +1474,7 @@ there
 and
 here
 }
-test io-8.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
+test io-7.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1440,7 +1494,7 @@ test io-8.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
     close $f
     set l
 } {abc def 0 {} 1 {} 1}
-test io-8.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
+test io-7.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1460,7 +1514,7 @@ test io-8.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
     close $f
     set l
 } {abc def 0 {} 1 {} 1}
-test io-8.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
+test io-7.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -1482,7 +1536,7 @@ test io-8.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
     close $f
     set l
 } "abc def 0 \x1aghi 0 qrs 0 {} 1"
-test io-8.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
+test io-7.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -1500,7 +1554,7 @@ test io-8.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
     close $f
     set l
 } {0 1 {} 1}
-test io-8.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
+test io-7.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -1518,7 +1572,7 @@ test io-8.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
     close $f
     set l
 } {0 1 {} 1}
-test io-8.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
+test io-7.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1532,7 +1586,7 @@ test io-8.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
     close $f
     list $c $e
 } {8 1}
-test io-8.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
+test io-7.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1546,7 +1600,7 @@ test io-8.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
     close $f
     list $c $e
 } {8 1}
-test io-8.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
+test io-7.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1560,7 +1614,7 @@ test io-8.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
     close $f
     list $c $e
 } {8 1}
-test io-8.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
+test io-7.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1574,7 +1628,7 @@ test io-8.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
     close $f
     list $c $e
 } {8 1}
-test io-8.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
+test io-7.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1588,7 +1642,7 @@ test io-8.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
     close $f
     list $c $e
 } {8 1}
-test io-8.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
+test io-7.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1605,7 +1659,7 @@ test io-8.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
 
 # Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.
 
-test io-9.1 {Tcl_Write lf, Tcl_Gets auto} {
+test io-8.1 {Tcl_Write lf, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1622,7 +1676,7 @@ test io-9.1 {Tcl_Write lf, Tcl_Gets auto} {
     close $f
     set l
 } {hello 6 auto there 12 auto}
-test io-9.2 {Tcl_Write cr, Tcl_Gets auto} {
+test io-8.2 {Tcl_Write cr, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1639,7 +1693,7 @@ test io-9.2 {Tcl_Write cr, Tcl_Gets auto} {
     close $f
     set l
 } {hello 6 auto there 12 auto}
-test io-9.3 {Tcl_Write crlf, Tcl_Gets auto} {
+test io-8.3 {Tcl_Write crlf, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1656,7 +1710,7 @@ test io-9.3 {Tcl_Write crlf, Tcl_Gets auto} {
     close $f
     set l
 } {hello 7 auto there 14 auto}
-test io-9.4 {Tcl_Write lf, Tcl_Gets lf} {
+test io-8.4 {Tcl_Write lf, Tcl_Gets lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1674,7 +1728,7 @@ test io-9.4 {Tcl_Write lf, Tcl_Gets lf} {
     close $f
     set l
 } {hello 6 lf there 12 lf}
-test io-9.5 {Tcl_Write lf, Tcl_Gets cr} {
+test io-8.5 {Tcl_Write lf, Tcl_Gets cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1694,7 +1748,7 @@ test io-9.5 {Tcl_Write lf, Tcl_Gets cr} {
     close $f
     set l
 } {20 21 cr 1 {} 21 cr 1}
-test io-9.6 {Tcl_Write lf, Tcl_Gets crlf} {
+test io-8.6 {Tcl_Write lf, Tcl_Gets crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1714,7 +1768,7 @@ test io-9.6 {Tcl_Write lf, Tcl_Gets crlf} {
     close $f
     set l
 } {20 21 crlf 1 {} 21 crlf 1}
-test io-9.7 {Tcl_Write cr, Tcl_Gets cr} {
+test io-8.7 {Tcl_Write cr, Tcl_Gets cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1734,7 +1788,7 @@ test io-9.7 {Tcl_Write cr, Tcl_Gets cr} {
     close $f
     set l
 } {hello 6 cr 0 there 12 cr 0}
-test io-9.8 {Tcl_Write cr, Tcl_Gets lf} {
+test io-8.8 {Tcl_Write cr, Tcl_Gets lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1754,7 +1808,7 @@ test io-9.8 {Tcl_Write cr, Tcl_Gets lf} {
     close $f
     set l
 } {21 21 lf 1 {} 21 lf 1}
-test io-9.9 {Tcl_Write cr, Tcl_Gets crlf} {
+test io-8.9 {Tcl_Write cr, Tcl_Gets crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -1774,7 +1828,7 @@ test io-9.9 {Tcl_Write cr, Tcl_Gets crlf} {
     close $f
     set l
 } {21 21 crlf 1 {} 21 crlf 1}
-test io-9.10 {Tcl_Write crlf, Tcl_Gets crlf} {
+test io-8.10 {Tcl_Write crlf, Tcl_Gets crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1794,7 +1848,7 @@ test io-9.10 {Tcl_Write crlf, Tcl_Gets crlf} {
     close $f
     set l
 } {hello 7 crlf 0 there 14 crlf 0}
-test io-9.11 {Tcl_Write crlf, Tcl_Gets cr} {
+test io-8.11 {Tcl_Write crlf, Tcl_Gets cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1814,7 +1868,7 @@ test io-9.11 {Tcl_Write crlf, Tcl_Gets cr} {
     close $f
     set l
 } {hello 6 cr 0 6 13 cr 0}
-test io-9.12 {Tcl_Write crlf, Tcl_Gets lf} {
+test io-8.12 {Tcl_Write crlf, Tcl_Gets lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -1834,7 +1888,7 @@ test io-9.12 {Tcl_Write crlf, Tcl_Gets lf} {
     close $f
     set l
 } {6 7 lf 0 6 14 lf 0}
-test io-9.13 {binary mode is synonym of lf mode} {
+test io-8.13 {binary mode is synonym of lf mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation binary
@@ -1846,7 +1900,7 @@ test io-9.13 {binary mode is synonym of lf mode} {
 # Test io-9.14 has been removed because "auto" output translation mode is
 # not supoprted.
 #
-test io-9.15 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-8.14 {Tcl_Write mixed, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1865,7 +1919,7 @@ test io-9.15 {Tcl_Write mixed, Tcl_Gets auto} {
     close $f
     set l
 } {hello there and here 0 {} 1}
-test io-9.16 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-8.15 {Tcl_Write mixed, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1884,7 +1938,7 @@ test io-9.16 {Tcl_Write mixed, Tcl_Gets auto} {
     close $f
     set l
 } {hello there and here 0 {} 1}
-test io-9.17 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-8.16 {Tcl_Write mixed, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1902,7 +1956,7 @@ test io-9.17 {Tcl_Write mixed, Tcl_Gets auto} {
     close $f
     set l
 } {hello there and here 0 {} 1}
-test io-9.18 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-8.17 {Tcl_Write mixed, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1921,7 +1975,7 @@ test io-9.18 {Tcl_Write mixed, Tcl_Gets auto} {
     close $f
     set l
 } {hello there and here 0 {} 1}
-test io-9.19 {Tcl_Write ^Z at end, Tcl_Gets auto} {
+test io-8.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1941,7 +1995,7 @@ test io-9.19 {Tcl_Write ^Z at end, Tcl_Gets auto} {
     close $f
     set l
 } {hello there and here 0 {} 1}
-test io-9.20 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
+test io-8.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -eofchar \x1a -translation lf
@@ -1960,7 +2014,7 @@ test io-9.20 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
     close $f
     set l
 } {hello there and here 0 {} 1}
-test io-9.21 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
+test io-8.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1979,7 +2033,7 @@ test io-9.21 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.22 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
+test io-8.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -1997,7 +2051,7 @@ test io-9.22 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
+test io-8.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -2019,7 +2073,7 @@ test io-9.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
     close $f
     set l
 } "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test io-9.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
+test io-8.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar {}
@@ -2041,7 +2095,7 @@ test io-9.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
     close $f
     set l
 } "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test io-9.25 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
+test io-8.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar {}
@@ -2063,7 +2117,7 @@ test io-9.25 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
     close $f
     set l
 } "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test io-9.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
+test io-8.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -2081,7 +2135,7 @@ test io-9.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.27 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
+test io-8.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -2099,7 +2153,7 @@ test io-9.27 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
+test io-8.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar {}
@@ -2117,7 +2171,7 @@ test io-9.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.29 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
+test io-8.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar {}
@@ -2135,7 +2189,7 @@ test io-9.29 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
+test io-8.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar {}
@@ -2153,7 +2207,7 @@ test io-9.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.31 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
+test io-8.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar {}
@@ -2171,7 +2225,7 @@ test io-9.31 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
     close $f
     set l
 } {abc def 0 {} 1}
-test io-9.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+test io-8.31 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -2190,7 +2244,7 @@ test io-9.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
     close $f
     string length $c
 } [expr 700*15+1]
-test io-9.33 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+test io-8.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -2213,19 +2267,19 @@ test io-9.33 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
 
 # Test Tcl_Read and buffering.
 
-test io-10.1 {Tcl_Read, channel not readable} {
+test io-9.1 {Tcl_Read, channel not readable} {
     list [catch {read stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
-test io-10.2 {Tcl_Read, zero byte count} {
+test io-9.2 {Tcl_Read, zero byte count} {
     read stdin 0
 } ""
-test io-10.3 {Tcl_Read, negative byte count} {
+test io-9.3 {Tcl_Read, negative byte count} {
     set f [open longfile r]
     set l [list [catch {read $f -1} msg] $msg]
     close $f
     set l
 } {1 {bad argument "-1": should be "nonewline"}}
-test io-10.4 {Tcl_Read, positive byte count} {
+test io-9.4 {Tcl_Read, positive byte count} {
     set f [open longfile r]
     set x [read $f 1024]
     set s [string length $x]
@@ -2233,7 +2287,7 @@ test io-10.4 {Tcl_Read, positive byte count} {
     close $f
     set s
 } 1024
-test io-10.5 {Tcl_Read, multiple buffers} {
+test io-9.5 {Tcl_Read, multiple buffers} {
     set f [open longfile r]
     fconfigure $f -buffersize 100
     set x [read $f 1024]
@@ -2242,7 +2296,7 @@ test io-10.5 {Tcl_Read, multiple buffers} {
     close $f
     set s
 } 1024
-test io-10.6 {Tcl_Read, very large read} {
+test io-9.6 {Tcl_Read, very large read} {
     set f1 [open longfile r]
     set z [read $f1 1000000]
     close $f1
@@ -2254,7 +2308,7 @@ test io-10.6 {Tcl_Read, very large read} {
     }
     set x
 } ok
-test io-10.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+test io-9.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
     set f1 [open longfile r]
     fconfigure $f1 -blocking off
     set z [read $f1 20]
@@ -2266,7 +2320,7 @@ test io-10.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
     }
     set x
 } ok
-test io-10.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+test io-9.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
     set f1 [open longfile r]
     fconfigure $f1 -blocking off
     set z [read $f1 1000000]
@@ -2279,7 +2333,7 @@ test io-10.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
     }
   set x
 } ok
-test io-10.9 {Tcl_Read, read to end of file} {
+test io-9.9 {Tcl_Read, read to end of file} {
     set f1 [open longfile r]
     set z [read $f1]
     close $f1
@@ -2291,7 +2345,7 @@ test io-10.9 {Tcl_Read, read to end of file} {
     }
     set x
 } ok
-test io-10.10 {Tcl_Read from a pipe} {unixOrPc} {
+test io-9.10 {Tcl_Read from a pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {puts [gets stdin]}
@@ -2303,7 +2357,7 @@ test io-10.10 {Tcl_Read from a pipe} {unixOrPc} {
     close $f1
     set x
 } "hello\n"
-test io-10.11 {Tcl_Read from a pipe} {unixOrPc} {
+test io-9.11 {Tcl_Read from a pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {puts [gets stdin]}
@@ -2322,7 +2376,7 @@ test io-10.11 {Tcl_Read from a pipe} {unixOrPc} {
 } {{hello
 } {hello
 }}
-test io-10.12 {Tcl_Read, -nonewline} {
+test io-9.12 {Tcl_Read, -nonewline} {
     removeFile test1
     set f1 [open test1 w]
     puts $f1 hello
@@ -2334,7 +2388,7 @@ test io-10.12 {Tcl_Read, -nonewline} {
     set c
 } {hello
 bye}
-test io-10.13 {Tcl_Read, -nonewline} {
+test io-9.13 {Tcl_Read, -nonewline} {
     removeFile test1
     set f1 [open test1 w]
     puts $f1 hello
@@ -2346,7 +2400,7 @@ test io-10.13 {Tcl_Read, -nonewline} {
     list [string length $c] $c
 } {9 {hello
 bye}}
-test io-10.14 {Tcl_Read, reading in small chunks} {
+test io-9.14 {Tcl_Read, reading in small chunks} {
     removeFile test1
     set f [open test1 w]
     puts $f "Two lines: this one"
@@ -2359,7 +2413,7 @@ test io-10.14 {Tcl_Read, reading in small chunks} {
 } {T wo { lines: this one
 and this one
 }}
-test io-10.15 {Tcl_Read, asking for more input than available} {
+test io-9.15 {Tcl_Read, asking for more input than available} {
     removeFile test1
     set f [open test1 w]
     puts $f "Two lines: this one"
@@ -2372,7 +2426,7 @@ test io-10.15 {Tcl_Read, asking for more input than available} {
 } {Two lines: this one
 and this one
 }
-test io-10.16 {Tcl_Read, read to end of file with -nonewline} {
+test io-9.16 {Tcl_Read, read to end of file with -nonewline} {
     removeFile test1
     set f [open test1 w]
     puts $f "Two lines: this one"
@@ -2387,7 +2441,7 @@ and this one}
 
 # Test Tcl_Gets.
 
-test io-11.1 {Tcl_Gets, reading what was written} {
+test io-10.1 {Tcl_Gets, reading what was written} {
     removeFile test1
     set f1 [open test1 w]
     set y "first line"
@@ -2402,7 +2456,7 @@ test io-11.1 {Tcl_Gets, reading what was written} {
     close $f1
     set z
 } ok
-test io-11.2 {Tcl_Gets into variable} {
+test io-10.2 {Tcl_Gets into variable} {
     set f1 [open longfile r]
     set c [gets $f1 x]
     set l [string length x]
@@ -2413,7 +2467,7 @@ test io-11.2 {Tcl_Gets into variable} {
     close $f1
     set z
 } ok
-test io-11.3 {Tcl_Gets from pipe} {unixOrPc} {
+test io-10.3 {Tcl_Gets from pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {puts [gets stdin]}
@@ -2429,7 +2483,7 @@ test io-11.3 {Tcl_Gets from pipe} {unixOrPc} {
     }
     set z
 } ok
-test io-11.4 {Tcl_Gets with long line} {
+test io-10.4 {Tcl_Gets with long line} {
     removeFile test3
     set f [open test3 w]
     puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
@@ -2443,13 +2497,13 @@ test io-11.4 {Tcl_Gets with long line} {
     close $f
     set x
 } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test io-11.5 {Tcl_Gets with long line} {
+test io-10.5 {Tcl_Gets with long line} {
     set f [open test3]
     set x [gets $f y]
     close $f
     list $x $y
 } {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test io-11.6 {Tcl_Gets and end of file} {
+test io-10.6 {Tcl_Gets and end of file} {
     removeFile test3
     set f [open test3 w]
     puts -nonewline $f "Test1\nTest2"
@@ -2465,7 +2519,7 @@ test io-11.6 {Tcl_Gets and end of file} {
     close $f
     set x
 } {5 Test1 5 Test2 -1 {}}
-test io-11.7 {Tcl_Gets and bad variable} {
+test io-10.7 {Tcl_Gets and bad variable} {
     set f [open test3 w]
     puts $f "Line 1"
     puts $f "Line 2"
@@ -2477,7 +2531,7 @@ test io-11.7 {Tcl_Gets and bad variable} {
     close $f
     set result
 } {1 {can't set "x(0)": variable isn't array}}
-test io-11.8 {Tcl_Gets, exercising double buffering} {
+test io-10.8 {Tcl_Gets, exercising double buffering} {
     set f [open test3 w]
     fconfigure $f -translation lf -eofchar {}
     set x ""
@@ -2490,7 +2544,7 @@ test io-11.8 {Tcl_Gets, exercising double buffering} {
     close $f
     set y
 } 100
-test io-11.9 {Tcl_Gets, exercising double buffering} {
+test io-10.9 {Tcl_Gets, exercising double buffering} {
     set f [open test3 w]
     fconfigure $f -translation lf -eofchar {}
     set x ""
@@ -2503,7 +2557,7 @@ test io-11.9 {Tcl_Gets, exercising double buffering} {
     close $f
     set y
 } 200
-test io-11.10 {Tcl_Gets, exercising double buffering} {
+test io-10.10 {Tcl_Gets, exercising double buffering} {
     set f [open test3 w]
     fconfigure $f -translation lf -eofchar {}
     set x ""
@@ -2519,14 +2573,14 @@ test io-11.10 {Tcl_Gets, exercising double buffering} {
 
 # Test Tcl_Seek and Tcl_Tell.
 
-test io-12.1 {Tcl_Seek to current position at start of file} {
+test io-11.1 {Tcl_Seek to current position at start of file} {
     set f1 [open longfile r]
     seek $f1 0 current
     set c [tell $f1]
     close $f1
     set c
 } 0
-test io-12.2 {Tcl_Seek to offset from start} {
+test io-11.2 {Tcl_Seek to offset from start} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2539,7 +2593,7 @@ test io-12.2 {Tcl_Seek to offset from start} {
     close $f1
     set c
 } 10
-test io-12.3 {Tcl_Seek to end of file} {
+test io-11.3 {Tcl_Seek to end of file} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2552,7 +2606,7 @@ test io-12.3 {Tcl_Seek to end of file} {
     close $f1
     set c
 } 54
-test io-12.4 {Tcl_Seek to offset from end of file} {
+test io-11.4 {Tcl_Seek to offset from end of file} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2565,7 +2619,7 @@ test io-12.4 {Tcl_Seek to offset from end of file} {
     close $f1
     set c
 } 44
-test io-12.5 {Tcl_Seek to offset from current position} {
+test io-11.5 {Tcl_Seek to offset from current position} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2579,7 +2633,7 @@ test io-12.5 {Tcl_Seek to offset from current position} {
     close $f1
     set c
 } 20
-test io-12.6 {Tcl_Seek to offset from end of file} {
+test io-11.6 {Tcl_Seek to offset from end of file} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2594,7 +2648,7 @@ test io-12.6 {Tcl_Seek to offset from end of file} {
     list $c $r
 } {44 {rstuvwxyz
 }}
-test io-12.7 {Tcl_Seek to offset from end of file, then to current position} {
+test io-11.7 {Tcl_Seek to offset from end of file, then to current position} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2610,14 +2664,14 @@ test io-12.7 {Tcl_Seek to offset from end of file, then to current position} {
     close $f1
     list $c1 $r1 $c2
 } {44 rstuv 49}
-test io-12.8 {Tcl_Seek on pipes: not supported} {unixOrPc} {
+test io-11.8 {Tcl_Seek on pipes: not supported} {unixOrPc} {
     set f1 [open "|$tcltest" r+]
     set x [list [catch {seek $f1 0 current} msg] $msg]
     close $f1
     regsub {".*":} $x {"":} x
     string tolower $x
 } {1 {error during seek on "": invalid argument}}
-test io-12.9 {Tcl_Seek, testing buffered input flushing} {
+test io-11.9 {Tcl_Seek, testing buffered input flushing} {
     removeFile test3
     set f [open test3 w]
     fconfigure $f -eofchar {}
@@ -2640,7 +2694,7 @@ test io-12.9 {Tcl_Seek, testing buffered input flushing} {
     close $f
     set x
 } {a d a l Y {} b}
-test io-12.10 {Tcl_Seek testing flushing of buffered input} {
+test io-11.10 {Tcl_Seek testing flushing of buffered input} {
     set f [open test3 w]
     fconfigure $f -translation lf
     puts $f xyz\n123
@@ -2654,7 +2708,7 @@ test io-12.10 {Tcl_Seek testing flushing of buffered input} {
     list $x [viewFile test3]
 } "xyz {xyz
 456}"
-test io-12.11 {Tcl_Seek testing flushing of buffered output} {
+test io-11.11 {Tcl_Seek testing flushing of buffered output} {
     set f [open test3 w]
     puts $f xyz\n123
     close $f
@@ -2665,7 +2719,7 @@ test io-12.11 {Tcl_Seek testing flushing of buffered output} {
     close $f
     list $x [viewFile test3]
 } "zzy xyzzy"
-test io-12.12 {Tcl_Seek testing combination of write, seek back and read} {
+test io-11.12 {Tcl_Seek testing combination of write, seek back and read} {
     set f [open test3 w]
     fconfigure $f -translation lf -eofchar {}
     puts $f xyz\n123
@@ -2682,14 +2736,14 @@ test io-12.12 {Tcl_Seek testing combination of write, seek back and read} {
 } {14 {xyz
 123
 xyzzy} zzy}
-test io-12.13 {Tcl_Tell at start of file} {
+test io-11.13 {Tcl_Tell at start of file} {
     removeFile test1
     set f1 [open test1 w]
     set p [tell $f1]
     close $f1
     set p
 } 0
-test io-12.14 {Tcl_Tell after seek to end of file} {
+test io-11.14 {Tcl_Tell after seek to end of file} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2702,7 +2756,7 @@ test io-12.14 {Tcl_Tell after seek to end of file} {
     close $f1
     set c1
 } 54
-test io-12.15 {Tcl_Tell combined with seeking} {
+test io-11.15 {Tcl_Tell combined with seeking} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -2717,13 +2771,13 @@ test io-12.15 {Tcl_Tell combined with seeking} {
     close $f1
     list $c1 $c2
 } {10 20}
-test io-12.16 {Tcl_tell on pipe: always -1} {unixOrPc} {
+test io-11.16 {Tcl_tell on pipe: always -1} {unixOrPc} {
     set f1 [open "|$tcltest" r+]
     set c [tell $f1]
     close $f1
     set c
 } -1
-test io-12.17 {Tcl_Tell on pipe: always -1} {unixOrPc} {
+test io-11.17 {Tcl_Tell on pipe: always -1} {unixOrPc} {
     set f1 [open "|$tcltest" r+]
     puts $f1 {puts hello}
     flush $f1
@@ -2732,7 +2786,7 @@ test io-12.17 {Tcl_Tell on pipe: always -1} {unixOrPc} {
     close $f1
     set c
 } -1
-test io-12.18 {Tcl_Tell combined with seeking and reading} {
+test io-11.18 {Tcl_Tell combined with seeking and reading} {
     removeFile test2
     set f [open test2 w]
     fconfigure $f -translation lf -eofchar {}
@@ -2752,7 +2806,7 @@ test io-12.18 {Tcl_Tell combined with seeking and reading} {
     close $f
     set x
 } {0 3 2 12 30}
-test io-12.19 {Tcl_Tell combined with opening in append mode} {
+test io-11.19 {Tcl_Tell combined with opening in append mode} {
     set f [open test3 w]
     fconfigure $f -translation lf -eofchar {}
     puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -2763,7 +2817,7 @@ test io-12.19 {Tcl_Tell combined with opening in append mode} {
     close $f
     set c
 } 54
-test io-12.20 {Tcl_Tell combined with writing} {
+test io-11.20 {Tcl_Tell combined with writing} {
     set f [open test3 w]
     set l ""
     seek $f 29 start
@@ -2781,7 +2835,7 @@ test io-12.20 {Tcl_Tell combined with writing} {
 
 # Test Tcl_Eof
 
-test io-13.1 {Tcl_Eof} {
+test io-12.1 {Tcl_Eof} {
     removeFile test1
     set f [open test1 w]
     puts $f hello
@@ -2800,7 +2854,7 @@ test io-13.1 {Tcl_Eof} {
     close $f
     set x
 } {0 0 0 0 1 1}
-test io-13.2 {Tcl_Eof with pipe} {unixOrPc} {
+test io-12.2 {Tcl_Eof with pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {gets stdin}
@@ -2818,7 +2872,7 @@ test io-13.2 {Tcl_Eof with pipe} {unixOrPc} {
     close $f1
     set x
 } {0 0 0 1}
-test io-13.3 {Tcl_Eof with pipe} {unixOrPc} {
+test io-12.3 {Tcl_Eof with pipe} {unixOrPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {gets stdin}
@@ -2840,7 +2894,7 @@ test io-13.3 {Tcl_Eof with pipe} {unixOrPc} {
     close $f1
     set x
 } {0 0 0 1 1 1}
-test io-13.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
+test io-12.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
     removeFile test1
     set f [open test1 w]
     close $f
@@ -2852,7 +2906,7 @@ test io-13.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
     close $f
     set l
 } {{} 1}
-test io-13.5 {Tcl_Eof, eof detection on nonblocking pipe} {unixOrPc} {
+test io-12.5 {Tcl_Eof, eof detection on nonblocking pipe} {unixOrPc} {
     removeFile pipe
     set f [open pipe w]
     puts $f {
@@ -2866,7 +2920,7 @@ test io-13.5 {Tcl_Eof, eof detection on nonblocking pipe} {unixOrPc} {
     close $f
     set l
 } {{} 1}
-test io-13.6 {Tcl_Eof, eof char, lf write, auto read} {
+test io-12.6 {Tcl_Eof, eof char, lf write, auto read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar \x1a
@@ -2880,7 +2934,7 @@ test io-13.6 {Tcl_Eof, eof char, lf write, auto read} {
     close $f
     list $s $l $e
 } {9 8 1}
-test io-13.7 {Tcl_Eof, eof char, lf write, lf read} {
+test io-12.7 {Tcl_Eof, eof char, lf write, lf read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar \x1a
@@ -2894,7 +2948,7 @@ test io-13.7 {Tcl_Eof, eof char, lf write, lf read} {
     close $f
     list $s $l $e
 } {9 8 1}
-test io-13.8 {Tcl_Eof, eof char, cr write, auto read} {
+test io-12.8 {Tcl_Eof, eof char, cr write, auto read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -2908,7 +2962,7 @@ test io-13.8 {Tcl_Eof, eof char, cr write, auto read} {
     close $f
     list $s $l $e
 } {9 8 1}
-test io-13.9 {Tcl_Eof, eof char, cr write, cr read} {
+test io-12.9 {Tcl_Eof, eof char, cr write, cr read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -2922,7 +2976,7 @@ test io-13.9 {Tcl_Eof, eof char, cr write, cr read} {
     close $f
     list $s $l $e
 } {9 8 1}
-test io-13.10 {Tcl_Eof, eof char, crlf write, auto read} {
+test io-12.10 {Tcl_Eof, eof char, crlf write, auto read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar \x1a
@@ -2936,7 +2990,7 @@ test io-13.10 {Tcl_Eof, eof char, crlf write, auto read} {
     close $f
     list $s $l $e
 } {11 8 1}
-test io-13.11 {Tcl_Eof, eof char, crlf write, crlf read} {
+test io-12.11 {Tcl_Eof, eof char, crlf write, crlf read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar \x1a
@@ -2950,7 +3004,7 @@ test io-13.11 {Tcl_Eof, eof char, crlf write, crlf read} {
     close $f
     list $s $l $e
 } {11 8 1}
-test io-13.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
+test io-12.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -2965,7 +3019,7 @@ test io-13.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
     close $f
     list $c $l $e
 } {17 8 1}
-test io-13.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
+test io-12.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf -eofchar {}
@@ -2980,7 +3034,7 @@ test io-13.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
     close $f
     list $c $l $e
 } {17 8 1}
-test io-13.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
+test io-12.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar {}
@@ -2995,7 +3049,7 @@ test io-13.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
     close $f
     list $c $l $e
 } {17 8 1}
-test io-13.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
+test io-12.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr -eofchar {}
@@ -3010,7 +3064,7 @@ test io-13.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
     close $f
     list $c $l $e
 } {17 8 1}
-test io-13.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
+test io-12.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar {}
@@ -3025,7 +3079,7 @@ test io-13.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
     close $f
     list $c $l $e
 } {21 8 1}
-test io-13.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
+test io-12.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf -eofchar {}
@@ -3043,7 +3097,7 @@ test io-13.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
 
 # Test Tcl_InputBlocked
 
-test io-14.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
+test io-13.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
     set f1 [open "|$tcltest" r+]
     puts $f1 {puts hello_from_pipe}
     flush $f1
@@ -3062,7 +3116,7 @@ test io-14.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
     close $f1
     set x
 } {{} 1 hello 0 {} 1}
-test io-14.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
+test io-13.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
     set f1 [open "|$tcltest" r+]
     fconfigure $f1 -buffering line
     puts $f1 {puts hello_from_pipe}
@@ -3076,7 +3130,7 @@ test io-14.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
     close $f1
     set x
 } {hello_from_pipe 0 {} 0 1}
-test io-14.3 {Tcl_InputBlocked vs files, short read} {
+test io-13.3 {Tcl_InputBlocked vs files, short read} {
     removeFile test1
     set f [open test1 w]
     puts $f abcdefghijklmnop
@@ -3092,11 +3146,11 @@ test io-14.3 {Tcl_InputBlocked vs files, short read} {
     close $f
     set l
 } {0 abc 0 defghijklmnop 0 1}
-test io-14.4 {Tcl_InputBlocked vs files, event driven read} {
+test io-13.4 {Tcl_InputBlocked vs files, event driven read} {
     proc in {f} {
-        global l
+        global l x
 	lappend l [read $f 3]
-	if {[eof $f]} {lappend l eof; close $f}
+	if {[eof $f]} {lappend l eof; close $f; set x done}
     }
     removeFile test1
     set f [open test1 w]
@@ -3105,11 +3159,11 @@ test io-14.4 {Tcl_InputBlocked vs files, event driven read} {
     set f [open test1 r]
     set l ""
     fileevent $f readable [list in $f]
-    update
+    vwait x
     set l
 } {abc def ghi jkl mno {p
 } eof}
-test io-14.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
+test io-13.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
     removeFile test1
     set f [open test1 w]
     puts $f abcdefghijklmnop
@@ -3126,11 +3180,11 @@ test io-14.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles
     close $f
     set l
 } {0 abc 0 defghijklmnop 0 1}
-test io-14.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
+test io-13.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
     proc in {f} {
-        global l
+        global l x
 	lappend l [read $f 3]
-	if {[eof $f]} {lappend l eof; close $f}
+	if {[eof $f]} {lappend l eof; close $f; set x done}
     }
     removeFile test1
     set f [open test1 w]
@@ -3140,14 +3194,14 @@ test io-14.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
     fconfigure $f -blocking off
     set l ""
     fileevent $f readable [list in $f]
-    update
+    vwait x
     set l
 } {abc def ghi jkl mno {p
 } eof}
 
 # Test Tcl_InputBuffered
 
-test io-15.1 {Tcl_InputBuffered} {
+test io-14.1 {Tcl_InputBuffered} {
     set f [open longfile r]
     fconfigure $f -buffersize 4096
     read $f 3
@@ -3157,7 +3211,7 @@ test io-15.1 {Tcl_InputBuffered} {
     close $f
     set l
 } {4093 3}
-test io-15.2 {Tcl_InputBuffered, test input flushing on seek} {
+test io-14.2 {Tcl_InputBuffered, test input flushing on seek} {
     set f [open longfile r]
     fconfigure $f -buffersize 4096
     read $f 3
@@ -3173,13 +3227,13 @@ test io-15.2 {Tcl_InputBuffered, test input flushing on seek} {
 
 # Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
 
-test io-16.1 {Tcl_GetChannelBufferSize, default buffer size} {
+test io-15.1 {Tcl_GetChannelBufferSize, default buffer size} {
     set f [open longfile r]
     set s [fconfigure $f -buffersize]
     close $f
     set s
 } 4096
-test io-16.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
+test io-15.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
     set f [open longfile r]
     set l ""
     lappend l [fconfigure $f -buffersize]
@@ -3201,7 +3255,7 @@ test io-16.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
 
 # Test Tcl_SetChannelOption, Tcl_GetChannelOption
 
-test io-17.1 {Tcl_GetChannelOption} {
+test io-16.1 {Tcl_GetChannelOption} {
     removeFile test1
     set f1 [open test1 w]
     set x [fconfigure $f1 -blocking]
@@ -3211,14 +3265,14 @@ test io-17.1 {Tcl_GetChannelOption} {
 #
 # Test 17.2 was removed.
 #
-test io-17.3 {Tcl_GetChannelOption} {
+test io-16.2 {Tcl_GetChannelOption} {
     removeFile test1
     set f1 [open test1 w]
     set x [fconfigure $f1 -buffering]
     close $f1
     set x
 } full
-test io-17.4 {Tcl_GetChannelOption} {
+test io-16.3 {Tcl_GetChannelOption} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -buffering line
@@ -3226,7 +3280,7 @@ test io-17.4 {Tcl_GetChannelOption} {
     close $f1
     set x
 } line
-test io-17.5 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
+test io-16.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
     removeFile test1
     set f1 [open test1 w]
     set l ""
@@ -3242,7 +3296,7 @@ test io-17.5 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
     close $f1
     set l
 } {full line none line full}
-test io-17.6 {Tcl_GetChannelOption, invariance} {
+test io-16.5 {Tcl_GetChannelOption, invariance} {
     removeFile test1
     set f1 [open test1 w]
     set l ""
@@ -3252,7 +3306,7 @@ test io-17.6 {Tcl_GetChannelOption, invariance} {
     close $f1
     set l
 } {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
-test io-17.7 {Tcl_SetChannelOption, multiple options} {
+test io-16.6 {Tcl_SetChannelOption, multiple options} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -buffering line
@@ -3262,7 +3316,7 @@ test io-17.7 {Tcl_SetChannelOption, multiple options} {
     close $f1
     set x
 } 10
-test io-17.8 {Tcl_SetChannelOption, buffering, translation} {
+test io-16.7 {Tcl_SetChannelOption, buffering, translation} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf
@@ -3276,7 +3330,7 @@ test io-17.8 {Tcl_SetChannelOption, buffering, translation} {
     close $f1
     set x
 } {0 21}
-test io-17.9 {Tcl_SetChannelOption, different buffering options} {
+test io-16.8 {Tcl_SetChannelOption, different buffering options} {
     removeFile test1
     set f1 [open test1 w]
     set l ""
@@ -3296,7 +3350,7 @@ test io-17.9 {Tcl_SetChannelOption, different buffering options} {
     lappend l [file size test1]
     set l
 } {5 10 10 10 20 20}
-test io-17.10 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
+test io-16.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
     removeFile test1
     set f1 [open test1 w]
     close $f1
@@ -3312,7 +3366,7 @@ test io-17.10 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
     close $f1
     set x
 } {1 0 {} {} 0 1}
-test io-17.11 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
+test io-16.10 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {gets stdin}
@@ -3342,7 +3396,7 @@ test io-17.11 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
     close $f1
     set x
 } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
-test io-17.12 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+test io-16.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -buffersize -10
@@ -3350,7 +3404,7 @@ test io-17.12 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
     close $f
     set x
 } 4096
-test io-17.13 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
+test io-16.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -buffersize 10000000
@@ -3358,7 +3412,7 @@ test io-17.13 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
     close $f
     set x
 } 4096
-test io-17.14 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+test io-16.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -buffersize 40000
@@ -3367,7 +3421,7 @@ test io-17.14 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
     set x
 } 40000
 
-test io-18.1 {POSIX open access modes: RDWR} {
+test io-17.1 {POSIX open access modes: RDWR} {
     removeFile test3
     set f [open test3 w]
     puts $f xyzzy
@@ -3382,7 +3436,7 @@ test io-18.1 {POSIX open access modes: RDWR} {
     close $f
     set x
 } {zzy abzzy}
-test io-18.2 {POSIX open access modes: CREAT} {unixOnly} {
+test io-17.2 {POSIX open access modes: CREAT} {unixOnly} {
     removeFile test3
     set f [open test3 {WRONLY CREAT} 0600]
     file stat test3 stats
@@ -3394,7 +3448,7 @@ test io-18.2 {POSIX open access modes: CREAT} {unixOnly} {
     close $f
     set x
 } {0600 {line 1}}
-test io-18.3 {POSIX open access modes: CREAT} {unixOnly nonPortable} {
+test io-17.3 {POSIX open access modes: CREAT} {unixOnly nonPortable umask2} {
     # This test only works if your umask is 2, like ouster's.
     removeFile test3
     set f [open test3 {WRONLY CREAT}]
@@ -3402,7 +3456,7 @@ test io-18.3 {POSIX open access modes: CREAT} {unixOnly nonPortable} {
     file stat test3 stats
     format "0%o" [expr $stats(mode)&0777]
 } 0664
-test io-18.4 {POSIX open access modes: CREAT} {
+test io-17.4 {POSIX open access modes: CREAT} {
     removeFile test3
     set f [open test3 w]
     fconfigure $f -eofchar {}
@@ -3417,7 +3471,7 @@ test io-18.4 {POSIX open access modes: CREAT} {
     close $f
     set x
 } abzzy
-test io-18.5 {POSIX open access modes: APPEND} {
+test io-17.5 {POSIX open access modes: APPEND} {
     removeFile test3
     set f [open test3 w]
     fconfigure $f -translation lf -eofchar {}
@@ -3438,7 +3492,7 @@ test io-18.5 {POSIX open access modes: APPEND} {
     close $f
     set x
 } {{new line} abc}
-test io-18.6 {POSIX open access modes: EXCL} {
+test io-17.6 {POSIX open access modes: EXCL} {
     removeFile test3
     set f [open test3 w]
     puts $f xyzzy
@@ -3447,7 +3501,7 @@ test io-18.6 {POSIX open access modes: EXCL} {
     regsub " already " $msg " " msg
     string tolower $msg
 } {1 {couldn't open "test3": file exists}}
-test io-18.7 {POSIX open access modes: EXCL} {
+test io-17.7 {POSIX open access modes: EXCL} {
     removeFile test3
     set f [open test3 {WRONLY CREAT EXCL}]
     fconfigure $f -eofchar {}
@@ -3455,7 +3509,7 @@ test io-18.7 {POSIX open access modes: EXCL} {
     close $f
     viewFile test3
 } {A test line}
-test io-18.8 {POSIX open access modes: TRUNC} {
+test io-17.8 {POSIX open access modes: TRUNC} {
     removeFile test3
     set f [open test3 w]
     puts $f xyzzy
@@ -3468,7 +3522,7 @@ test io-18.8 {POSIX open access modes: TRUNC} {
     close $f
     set x
 } abc
-test io-18.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
+test io-17.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
     removeFile test3
     set f [open test3 {WRONLY NONBLOCK CREAT}]
     puts $f "NONBLOCK test"
@@ -3478,7 +3532,7 @@ test io-18.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
     close $f
     set x
 } {NONBLOCK test}
-test io-18.10 {POSIX open access modes: RDONLY} {
+test io-17.10 {POSIX open access modes: RDONLY} {
     set f [open test1 w]
     puts $f "two lines: this one"
     puts $f "and this"
@@ -3490,15 +3544,15 @@ test io-18.10 {POSIX open access modes: RDONLY} {
 	[list {two lines: this one} 1 \
 		[format "channel \"%s\" wasn't opened for writing" $f]]
 } 0
-test io-18.11 {POSIX open access modes: RDONLY} {
+test io-17.11 {POSIX open access modes: RDONLY} {
     removeFile test3
     string tolower [list [catch {open test3 RDONLY} msg] $msg]
 } {1 {couldn't open "test3": no such file or directory}}
-test io-18.12 {POSIX open access modes: WRONLY} {
+test io-17.12 {POSIX open access modes: WRONLY} {
     removeFile test3
     string tolower [list [catch {open test3 WRONLY} msg] $msg]
 } {1 {couldn't open "test3": no such file or directory}}
-test io-18.13 {POSIX open access modes: WRONLY} {
+test io-17.13 {POSIX open access modes: WRONLY} {
     makeFile xyzzy test3
     set f [open test3 WRONLY]
     fconfigure $f -eofchar {}
@@ -3510,11 +3564,11 @@ test io-18.13 {POSIX open access modes: WRONLY} {
     string compare [string tolower $x] \
 	[list 1 "channel \"$f\" wasn't opened for reading" abzzy]
 } 0
-test io-18.14 {POSIX open access modes: RDWR} {
+test io-17.14 {POSIX open access modes: RDWR} {
     removeFile test3
     string tolower [list [catch {open test3 RDWR} msg] $msg]
 } {1 {couldn't open "test3": no such file or directory}}
-test io-18.15 {POSIX open access modes: RDWR} {
+test io-17.15 {POSIX open access modes: RDWR} {
     makeFile xyzzy test3
     set f [open test3 RDWR]
     puts -nonewline $f "ab"
@@ -3524,7 +3578,7 @@ test io-18.15 {POSIX open access modes: RDWR} {
     lappend x [viewFile test3]
 } {zzy abzzy}
 if {![file exists ~/_test_] && [file writable ~]} {
-    test io-18.16 {tilde substitution in open} {
+    test io-17.16 {tilde substitution in open} {
 	set f [open ~/_test_ w]
 	puts $f "Some text"
 	close $f
@@ -3533,7 +3587,7 @@ if {![file exists ~/_test_] && [file writable ~]} {
 	set x
     } 1
 }
-test io-18.17 {tilde substitution in open} {
+test io-17.17 {tilde substitution in open} {
     set home $env(HOME)
     unset env(HOME)
     set x [list [catch {open ~/foo} msg] $msg]
@@ -3541,19 +3595,19 @@ test io-18.17 {tilde substitution in open} {
     set x
 } {1 {couldn't find HOME environment variable to expand path}}
 
-test io-19.1 {Tcl_FileeventCmd: errors} {
+test io-18.1 {Tcl_FileeventCmd: errors} {
     list [catch {fileevent foo} msg] $msg
 } {1 {wrong # args: must be "fileevent channelId event ?script?}}
-test io-19.2 {Tcl_FileeventCmd: errors} {
+test io-18.2 {Tcl_FileeventCmd: errors} {
     list [catch {fileevent foo bar baz q} msg] $msg
 } {1 {wrong # args: must be "fileevent channelId event ?script?}}
-test io-19.3 {Tcl_FileeventCmd: errors} {
+test io-18.3 {Tcl_FileeventCmd: errors} {
     list [catch {fileevent gorp readable} msg] $msg
 } {1 {can not find channel named "gorp"}}
-test io-19.4 {Tcl_FileeventCmd: errors} {
+test io-18.4 {Tcl_FileeventCmd: errors} {
     list [catch {fileevent gorp writable} msg] $msg
 } {1 {can not find channel named "gorp"}}
-test io-19.5 {Tcl_FileeventCmd: errors} {
+test io-18.5 {Tcl_FileeventCmd: errors} {
     list [catch {fileevent gorp who-knows} msg] $msg
 } {1 {bad event name "who-knows": must be readable or writable}}
 
@@ -3563,10 +3617,10 @@ test io-19.5 {Tcl_FileeventCmd: errors} {
 
 set f [open foo w+]
 
-test io-20.1 {Tcl_FileeventCmd: creating, deleting, querying} {
+test io-19.1 {Tcl_FileeventCmd: creating, deleting, querying} {
     list [fileevent $f readable] [fileevent $f writable]
 } {{} {}}
-test io-20.2 {Tcl_FileeventCmd: replacing} {
+test io-19.2 {Tcl_FileeventCmd: replacing} {
     set result {}
     fileevent $f r "first script"
     lappend result [fileevent $f readable]
@@ -3588,7 +3642,7 @@ if {($tcl_platform(platform) != "macintosh") && \
 catch {set f2 [open {|cat -u} r+]}
 catch {set f3 [open {|cat -u} r+]}
 
-test io-21.1 {Tcl_FileeventCmd: creating, deleting, querying} {
+test io-20.1 {Tcl_FileeventCmd: creating, deleting, querying} {
     set result {}
     fileevent $f readable "script 1"
     lappend result [fileevent $f readable] [fileevent $f writable]
@@ -3599,7 +3653,7 @@ test io-21.1 {Tcl_FileeventCmd: creating, deleting, querying} {
     fileevent $f writable {}
     lappend result [fileevent $f readable] [fileevent $f writable]
 } {{script 1} {} {script 1} {write script} {} {write script} {} {}}
-test io-21.2 {Tcl_FileeventCmd: deleting when many present} {
+test io-20.2 {Tcl_FileeventCmd: deleting when many present} {
     set result {}
     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
     fileevent $f r "read f"
@@ -3614,7 +3668,7 @@ test io-21.2 {Tcl_FileeventCmd: deleting when many present} {
     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
 } {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
 
-test io-22.1 {FileEventProc procedure: normal read event} {
+test io-21.1 {FileEventProc procedure: normal read event} {
     fileevent $f2 readable {
 	set x [gets $f2]; fileevent $f2 readable {}
     }
@@ -3623,7 +3677,7 @@ test io-22.1 {FileEventProc procedure: normal read event} {
     vwait x
     set x
 } {text}
-test io-22.2 {FileEventProc procedure: error in read event} {
+test io-21.2 {FileEventProc procedure: error in read event} {
     proc bgerror args {
 	global x
 	set x $args
@@ -3635,7 +3689,7 @@ test io-22.2 {FileEventProc procedure: error in read event} {
     rename bgerror {}
     list $x [fileevent $f2 readable]
 } {bogus {}}
-test io-22.3 {FileEventProc procedure: normal write event} {
+test io-21.3 {FileEventProc procedure: normal write event} {
     fileevent $f2 writable {
 	lappend x "triggered"
 	incr count -1
@@ -3650,7 +3704,7 @@ test io-22.3 {FileEventProc procedure: normal write event} {
     vwait x
     set x
 } {initial triggered triggered triggered}
-test io-22.4 {FileEventProc procedure: eror in write event} {
+test io-21.4 {FileEventProc procedure: eror in write event} {
     proc bgerror args {
 	global x
 	set x $args
@@ -3661,7 +3715,7 @@ test io-22.4 {FileEventProc procedure: eror in write event} {
     rename bgerror {}
     list $x [fileevent $f2 writable]
 } {bad-write {}}
-test io-22.5 {FileEventProc procedure: end of file} {unixOrPc unixExecs} {
+test io-21.5 {FileEventProc procedure: end of file} {unixOrPc unixExecs} {
     set f4 [open {|cat << foo} r]
     fileevent $f4 readable {
 	if {[gets $f4 line] < 0} {
@@ -3687,7 +3741,7 @@ catch {close $f3}
 
 close $f
 makeFile "foo bar" foo
-test io-23.1 {DeleteFileEvent, cleanup on close} {
+test io-22.1 {DeleteFileEvent, cleanup on close} {
     set f [open foo r]
     fileevent $f readable {
 	lappend x "binding triggered: \"[gets $f]\""
@@ -3695,10 +3749,11 @@ test io-23.1 {DeleteFileEvent, cleanup on close} {
     }
     close $f
     set x initial
-    update
+    after 100 { set y done }
+    vwait y
     set x
 } {initial}
-test io-23.2 {DeleteFileEvent, cleanup on close} {
+test io-22.2 {DeleteFileEvent, cleanup on close} {
     set f [open foo r]
     set f2 [open foo r]
     fileevent $f readable {
@@ -3715,7 +3770,7 @@ test io-23.2 {DeleteFileEvent, cleanup on close} {
     close $f2
     set x
 } {initial {f2 triggered: "foo bar"}}
-test io-23.3 {DeleteFileEvent, cleanup on close} {
+test io-22.3 {DeleteFileEvent, cleanup on close} {
     set f [open foo r]
     set f2 [open foo r]
     set f3 [open foo r]
@@ -3741,7 +3796,7 @@ test io-23.3 {DeleteFileEvent, cleanup on close} {
 
 if {[info commands testfevent] == "testfevent"} {
 
-test io-24.1 {Tcl event loop vs multiple interpreters} {
+test io-23.1 {Tcl event loop vs multiple interpreters} {
     testfevent create
     testfevent cmd {
         set f [open foo r]
@@ -3751,11 +3806,12 @@ test io-24.1 {Tcl event loop vs multiple interpreters} {
             fileevent $f readable {}
         }
     } 
+    after 1	;# We must delay because Windows takes a little time to notice
     update
     testfevent cmd {close $f}
     list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
 } {{f triggered: foo bar} after}
-test io-24.2 {Tcl event loop vs multiple interpreters} {
+test io-23.2 {Tcl event loop vs multiple interpreters} {
     testfevent create
     testfevent cmd {
         set x 0
@@ -3764,7 +3820,7 @@ test io-24.2 {Tcl event loop vs multiple interpreters} {
         set x
     }
 } {triggered}
-test io-24.3 {Tcl event loop vs multiple interpreters} {
+test io-23.3 {Tcl event loop vs multiple interpreters} {
     testfevent create
     testfevent cmd {
         set x 0
@@ -3778,7 +3834,7 @@ test io-24.3 {Tcl event loop vs multiple interpreters} {
     }
 } {0 0 {0 timer}}
 
-test io-25.1 {fileevent vs multiple interpreters} {
+test io-24.1 {fileevent vs multiple interpreters} {
     set f [open foo r]
     set f2 [open foo r]
     set f3 [open foo r]
@@ -3797,7 +3853,7 @@ test io-25.1 {fileevent vs multiple interpreters} {
     close $f3
     set x
 } {{} {script 1} {} {sript 3}}
-test io-25.2 {deleting fileevent on interpreter delete} {
+test io-24.2 {deleting fileevent on interpreter delete} {
     set f [open foo r]
     set f2 [open foo r]
     set f3 [open foo r]
@@ -3818,7 +3874,7 @@ test io-25.2 {deleting fileevent on interpreter delete} {
     close $f4
     set x
 } {{script 1} {} {} {script 4}}
-test io-25.3 {deleting fileevent on interpreter delete} {
+test io-24.3 {deleting fileevent on interpreter delete} {
     set f [open foo r]
     set f2 [open foo r]
     set f3 [open foo r]
@@ -3839,7 +3895,7 @@ test io-25.3 {deleting fileevent on interpreter delete} {
     close $f4
     set x
 } {{script 1} {script 2} {} {}}
-test io-25.4 {file events on shared files and multiple interpreters} {
+test io-24.4 {file events on shared files and multiple interpreters} {
     set f [open foo r]
     set f2 [open foo r]
     testfevent create
@@ -3855,7 +3911,7 @@ test io-25.4 {file events on shared files and multiple interpreters} {
     close $f2
     set x
 } {{script 3} {script 1} {script 2}}
-test io-25.5 {file events on shared files, deleting file events} {
+test io-24.5 {file events on shared files, deleting file events} {
     set f [open foo r]
     testfevent create
     testfevent share $f
@@ -3868,7 +3924,7 @@ test io-25.5 {file events on shared files, deleting file events} {
     close $f
     set x
 } {{} {script 2}}
-test io-25.6 {file events on shared files, deleting file events} {
+test io-24.6 {file events on shared files, deleting file events} {
     set f [open foo r]
     testfevent create
     testfevent share $f
@@ -3886,7 +3942,7 @@ test io-25.6 {file events on shared files, deleting file events} {
 
 # The above curly closes the test for presence of the "testfevent" command.
 
-test io-26.1 {testing readability conditions} {
+test io-25.1 {testing readability conditions} {
     set f [open bar w]
     puts $f abcdefg
     puts $f abcdefg
@@ -3911,7 +3967,7 @@ test io-26.1 {testing readability conditions} {
     vwait x
     list $x $l
 } {done {called called called called called called called}}
-test io-26.2 {testing readability conditions} {nonBlockFiles} {
+test io-25.2 {testing readability conditions} {nonBlockFiles} {
     set f [open bar w]
     puts $f abcdefg
     puts $f abcdefg
@@ -3937,7 +3993,7 @@ test io-26.2 {testing readability conditions} {nonBlockFiles} {
     vwait x
     list $x $l
 } {done {called called called called called called called}}
-test io-26.3 {testing readability conditions} {unixOnly nonBlockFiles} {
+test io-25.3 {testing readability conditions} {unixOnly nonBlockFiles} {
     set f [open bar w]
     puts $f abcdefg
     puts $f abcdefg
@@ -3981,7 +4037,7 @@ test io-26.3 {testing readability conditions} {unixOnly nonBlockFiles} {
     close $f
     list $x $l
 } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
-test io-26.4 {lf write, testing readability, ^Z termination, auto read mode} {
+test io-25.4 {lf write, testing readability, ^Z termination, auto read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -4006,7 +4062,7 @@ test io-26.4 {lf write, testing readability, ^Z termination, auto read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.5 {lf write, testing readability, ^Z in middle, auto read mode} {
+test io-25.5 {lf write, testing readability, ^Z in middle, auto read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -4031,7 +4087,7 @@ test io-26.5 {lf write, testing readability, ^Z in middle, auto read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.6 {cr write, testing readability, ^Z termination, auto read mode} {
+test io-25.6 {cr write, testing readability, ^Z termination, auto read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -4056,7 +4112,7 @@ test io-26.6 {cr write, testing readability, ^Z termination, auto read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.7 {cr write, testing readability, ^Z in middle, auto read mode} {
+test io-25.7 {cr write, testing readability, ^Z in middle, auto read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -4081,7 +4137,7 @@ test io-26.7 {cr write, testing readability, ^Z in middle, auto read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.8 {crlf write, testing readability, ^Z termination, auto read mode} {
+test io-25.8 {crlf write, testing readability, ^Z termination, auto read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -4106,7 +4162,7 @@ test io-26.8 {crlf write, testing readability, ^Z termination, auto read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
+test io-25.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -4131,7 +4187,7 @@ test io-26.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.10 {lf write, testing readability, ^Z in middle, lf read mode} {
+test io-25.10 {lf write, testing readability, ^Z in middle, lf read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -4156,7 +4212,7 @@ test io-26.10 {lf write, testing readability, ^Z in middle, lf read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.11 {lf write, testing readability, ^Z termination, lf read mode} {
+test io-25.11 {lf write, testing readability, ^Z termination, lf read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation lf
@@ -4181,7 +4237,7 @@ test io-26.11 {lf write, testing readability, ^Z termination, lf read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.12 {cr write, testing readability, ^Z in middle, cr read mode} {
+test io-25.12 {cr write, testing readability, ^Z in middle, cr read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -4206,7 +4262,7 @@ test io-26.12 {cr write, testing readability, ^Z in middle, cr read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.13 {cr write, testing readability, ^Z termination, cr read mode} {
+test io-25.13 {cr write, testing readability, ^Z termination, cr read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation cr
@@ -4231,7 +4287,7 @@ test io-26.13 {cr write, testing readability, ^Z termination, cr read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
+test io-25.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -4256,7 +4312,7 @@ test io-26.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
     vwait x
     list $c $l
 } {3 {abc def {}}}
-test io-26.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
+test io-25.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
     removeFile test1
     set f [open test1 w]
     fconfigure $f -translation crlf
@@ -4282,6 +4338,119 @@ test io-26.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
     list $c $l
 } {3 {abc def {}}}
 
+test io-26.1 {testing crlf reading, leftover cr disgorgment} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "a\rb\rc\r\n"
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [file size test1]
+    fconfigure $f -translation crlf
+    lappend l [read $f 1]
+    lappend l [tell $f]
+    lappend l [read $f 1]
+    lappend l [tell $f]
+    lappend l [read $f 1]
+    lappend l [tell $f]
+    lappend l [read $f 1]
+    lappend l [tell $f]
+    lappend l [read $f 1]
+    lappend l [tell $f]
+    lappend l [read $f 1]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    lappend l [read $f 1]
+    lappend l [eof $f]
+    close $f
+    set l
+} "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
+} 7 0 {} 1"
+test io-26.2 {testing crlf reading, leftover cr disgorgment} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "a\rb\rc\r\n"
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [file size test1]
+    fconfigure $f -translation crlf
+    lappend l [read $f 2]
+    lappend l [tell $f]
+    lappend l [read $f 2]
+    lappend l [tell $f]
+    lappend l [read $f 2]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    lappend l [read $f 2]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
+test io-26.3 {testing crlf reading, leftover cr disgorgment} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "a\rb\rc\r\n"
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [file size test1]
+    fconfigure $f -translation crlf
+    lappend l [read $f 3]
+    lappend l [tell $f]
+    lappend l [read $f 3]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    lappend l [read $f 3]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
+test io-26.4 {testing crlf reading, leftover cr disgorgment} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "a\rb\rc\r\n"
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [file size test1]
+    fconfigure $f -translation crlf
+    lappend l [read $f 3]
+    lappend l [tell $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
+test io-26.5 {testing crlf reading, leftover cr disgorgment} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "a\rb\rc\r\n"
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [file size test1]
+    fconfigure $f -translation crlf
+    lappend l [set x [gets $f]]
+    lappend l [tell $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} [list 7 a\rb\rc 7 {} 7 1]
+    
 test io-27.1 {testing handler deletion} {
     removeFile test1
     set f [open test1 w]
@@ -4441,6 +4610,395 @@ test io-27.6 {testing handler deletion vs reentrant calls} {
 	      {first after update}]
 } 0
 
+test io-28.1 {Test old socket deletion on Macintosh} {tempNotMac} {
+    set x 0
+    set result ""
+    proc accept {s a p} {
+	global x wait
+	fconfigure $s -blocking off
+	puts $s "sock[incr x]"
+	close $s
+	set wait done
+    }
+    set ss [socket -server accept 2831]
+    set wait ""
+    set cs [socket [info hostname] 2831]
+    vwait wait
+    lappend result [gets $cs]
+    close $cs
+
+    set wait ""
+    set cs [socket [info hostname] 2831]
+    vwait wait
+    lappend result [gets $cs]
+    close $cs
+
+    set wait ""
+    set cs [socket [info hostname] 2831]
+    vwait wait
+    lappend result [gets $cs]
+    close $cs
+
+    set wait ""
+    set cs [socket [info hostname] 2831]
+    vwait wait
+    lappend result [gets $cs]
+    close $cs
+    close $ss
+    set result
+} {sock1 sock2 sock3 sock4}
+
+test io-29.1 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fcopy $f1 $f2 -command { # }
+    catch { fcopy $f1 $f2 } msg
+    close $f1
+    close $f2
+    string compare $msg "channel \"$f1\" is busy"
+} {0}
+test io-29.2 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    set f3 [open io.test]
+    fcopy $f1 $f2 -command { # }
+    catch { fcopy $f3 $f2 } msg
+    close $f1
+    close $f2
+    close $f3
+    string compare $msg "channel \"$f2\" is busy"
+} {0}
+test io-29.3 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation cr -blocking 0
+    set s0 [fcopy $f1 $f2]
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    set s1 [file size io.test]
+    set s2 [file size test1]
+    if {("$s1" == "$s2") && ($s0 == $s1)} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-29.4 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation cr -blocking 0
+    fcopy $f1 $f2 -size 40
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    lappend result [file size test1]
+} {0 0 40}
+test io-29.5 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation lf -blocking 0
+    fcopy $f1 $f2 -size -1
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    set s1 [file size io.test]
+    set s2 [file size test1]
+    if {"$s1" == "$s2"} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-29.6 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation lf -blocking 0
+    set s0 [fcopy $f1 $f2 -size [expr [file size io.test] + 5]]
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    set s1 [file size io.test]
+    set s2 [file size test1]
+    if {("$s1" == "$s2") && ($s0 == $s1)} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-29.7 {TclCopyChannel} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation lf -blocking 0
+    fcopy $f1 $f2
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    set s1 [file size io.test]
+    set s2 [file size test1]
+    close $f1
+    close $f2
+    if {"$s1" == "$s2"} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-29.8 {TclCopyChannel} {unixOrPc} {
+    removeFile test1
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	puts ready
+	gets stdin
+	set f1 [open io.test r]
+	puts [read $f1 100]
+	close $f1
+    }
+    close $f1
+    set f1 [open "|$tcltest pipe" r+]
+    gets $f1
+    puts $f1 ready
+    flush $f1
+    set f2 [open test1 w]
+    set s0 [fcopy $f1 $f2 -size 40]
+    catch {close $f1}
+    close $f2
+    list $s0 [file size test1]
+} {40 40}
+
+test io-30.1 {CopyData} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation cr -blocking 0
+    fcopy $f1 $f2 -size 0
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    lappend result [file size test1]
+} {0 0 0}
+test io-30.2 {CopyData} {
+    removeFile test1
+    set f1 [open io.test]
+    set f2 [open test1 w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation cr -blocking 0
+    fcopy $f1 $f2 -command {set s0}
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    vwait s0
+    close $f1
+    close $f2
+    set s1 [file size io.test]
+    set s2 [file size test1]
+    if {("$s1" == "$s2") && ($s0 == $s1)} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-30.3 {CopyData: background read underflow} {unixOnly} {
+    removeFile test1
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	puts ready
+	flush stdout				;# Don't assume line buffered!
+	fcopy stdin stdout -command { set x }
+	vwait x
+	set f [open test1 w]
+	fconfigure $f -translation lf
+	puts $f "done"
+	close $f
+    }
+    close $f1
+    set f1 [open "|$tcltest pipe" r+]
+    set result [gets $f1]
+    puts $f1 line1
+    flush $f1
+    lappend result [gets $f1]
+    puts $f1 line2
+    flush $f1
+    lappend result [gets $f1]
+    close $f1
+    after 500
+    set f [open test1]
+    lappend result [read $f]
+    close $f
+    set result
+} "ready line1 line2 {done\n}"
+test io-30.4 {CopyData: background write overflow} {unixOnly} {
+    set big aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n
+    for {set x 0} {$x < 12} {incr x} {
+	append big $big
+    }
+    removeFile test1
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	puts ready
+	fcopy stdin stdout -command { set x }
+	vwait x
+	set f [open test1 w]
+	fconfigure $f -translation lf
+	puts $f "done"
+	close $f
+    }
+    close $f1
+    set f1 [open "|$tcltest pipe" r+]
+    set result [gets $f1]
+    fconfigure $f1 -blocking 0
+    puts $f1 $big
+    flush $f1
+    after 500
+    set result ""
+    fileevent $f1 read {
+	append result [read $f1 1024]
+	if {[string length $result] >= [string length $big]} {
+	    set x done
+	}
+    }
+    vwait x
+    close $f1
+    set big {}
+    set x
+} done
+
+proc FcopyTestAccept {sock args} {
+    after 1000 "close $sock"
+}
+proc FcopyTestDone {bytes {error {}}} {
+    global fcopyTestDone
+    if {[string length $error]} {
+	set fcopyTestDone 1
+    } else {
+	set fcopyTestDone 0
+    }
+}
+if [catch {socket -server FcopyTestAccept 2828} listen] {
+    puts stderr "Skipping fcopy error test"
+} else {
+    test io-30.5 {CopyData: error during fcopy} {
+	set in [open io.test]	;# 126 K
+	set out [socket localhost 2828]
+	catch {unset fcopyTestDone}
+	close $listen	;# This means the socket open never really succeeds
+	fcopy $in $out -command FcopyTestDone
+	if ![info exists fcopyTestDone] {
+	    vwait fcopyTestDone
+	}
+	close $in
+	close $out
+	set fcopyTestDone
+    } 1
+}
+
+test io-31.1 {Recursive channel events} {
+    # This test checks to see if file events are delivered during recursive
+    # event loops when there is buffered data on the channel.
+
+    proc accept {s a p} {
+	global as
+	fconfigure $s -translation lf
+	puts $s "line 1\nline2\nline3"
+	flush $s
+	set as $s
+    }
+    proc readit {s next} {
+	global result x
+	lappend result $next
+	if {$next == 1} {
+	    fileevent $s readable [list readit $s 2]
+	    vwait x
+	}
+	incr x
+    }
+    set ss [socket -server accept 2828]
+
+    # We need to delay on some systems until the creation of the
+    # server socket completes.
+
+    set done 0
+    for {set i 0} {$i < 10} {incr i} {
+	if {![catch {set cs [socket [info hostname] 2828]}]} {
+	    set done 1
+	    break
+	}
+	after 100
+    }
+    if {$done == 0} {
+	close $ss
+	error "failed to connect to server"
+    }
+    set result {}
+    set x 0
+    vwait as
+    fconfigure $cs -translation lf
+    lappend result [gets $cs]
+    fconfigure $cs -blocking off
+    fileevent $cs readable [list readit $cs 1]
+    set a [after 2000 { set x failure }]
+    vwait x
+    after cancel $a
+    close $as
+    close $ss
+    close $cs
+    list $result $x
+} {{{line 1} 1 2} 2}
+test io-31.2 {Testing for busy-wait in recursive channel events} {
+    set s [socket -server accept 3939]
+    proc accept {s a p} {
+	global counter
+
+	set counter 0
+	fconfigure $s -blocking off -buffering line -translation lf
+	fileevent $s readable "doit $s"
+    }
+    proc doit {s} {
+	global counter
+
+	incr counter
+	set l [gets $s]
+	if {"$l" == ""} {
+	    fileevent $s readable "doit1 $s"
+	    after 1000 newline
+	}
+    }
+    proc doit1 {s} {
+	global counter
+
+	incr counter
+	set l [gets $s]
+	close $s
+    }
+    proc producer {} {
+	global writer
+
+	set writer [socket localhost 3939]
+	fconfigure $writer -buffering line
+	puts -nonewline $writer hello
+	flush $writer
+    }
+    proc newline {} {
+	global writer done
+
+	puts $writer hello
+	flush $writer
+	set done 1
+    }
+    producer
+    vwait done
+    close $writer
+    close $s
+    set counter
+} 1
+
 removeFile longfile
 removeFile script
 removeFile output
@@ -4449,6 +5007,8 @@ removeFile pipe
 removeFile my_script
 removeFile foo
 removeFile bar
+removeFile test2
+removeFile test3
 
 set x ""
 unset x
diff --git a/contrib/tcl/tests/ioCmd.test b/contrib/tcl/tests/ioCmd.test
index 18eb5ec..149d6c7 100644
--- a/contrib/tcl/tests/ioCmd.test
+++ b/contrib/tcl/tests/ioCmd.test
@@ -1,5 +1,5 @@
 # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
-#		    fblocked, fconfigure, open, channel
+#		    fblocked, fconfigure, open, channel, fcopy
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# "@(#) iocmd.test 1.37 96/04/12 11:44:23"
+# "@(#) ioCmd.test 1.47 97/06/23 18:21:31"
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -20,92 +20,103 @@ removeFile pipe
 
 set executable [list [info nameofexecutable]]
 
-#test iocmd-1.0 {copyfile command} {
-#    list [catch {copyfile a b c d e f} msg] $msg
-#} {1 {wrong # args: should be "copyfile inChanId outChanId ?chunkSize?"}}
-#test iocmd-1.1 {copyfile command} {
-#    list [catch {copyfile f1} msg] $msg
-#} {1 {wrong # args: should be "copyfile inChanId outChanId ?chunkSize?"}}
-#test iocmd-1.2 {copyfile command} {
-#    list [catch {copyfile f1 f2} msg] $msg
-#} {1 {can not find channel named "f1"}}
-#test iocmd-1.3 {copyfile command} {
-#    list [catch {copyfile stdin f2} msg] $msg
-#} {1 {can not find channel named "f2"}}
-#test iocmd-1.4 {copyfile command} {
-#    list [catch {copyfile stdin stdout booboo} msg] $msg
-#} {1 {expected integer but got "booboo"}}
-#test iocmd-1.5 {copyfile command} {
-#    list [catch {copyfile stdout stdin} msg] $msg
-#} {1 {channel "stdout" wasn't opened for reading}}
-#test iocmd-1.6 {copyfile command} {
-#    list [catch {copyfile stdin stdin} msg] $msg
-#} {1 {channel "stdin" wasn't opened for writing}}
-
-test iocmd-2.1 {puts command} {
+test iocmd-1.1 {puts command} {
    list [catch {puts} msg] $msg
 } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
-test iocmd-2.2 {puts command} {
+test iocmd-1.2 {puts command} {
    list [catch {puts a b c d e f g} msg] $msg
 } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
-test iocmd-2.3 {puts command} {
+test iocmd-1.3 {puts command} {
    list [catch {puts froboz -nonewline kablooie} msg] $msg
 } {1 {bad argument "kablooie": should be "nonewline"}}
-test iocmd-2.4 {puts command} {
+test iocmd-1.4 {puts command} {
    list [catch {puts froboz hello} msg] $msg
 } {1 {can not find channel named "froboz"}}
-test iocmd-2.5 {puts command} {
+test iocmd-1.5 {puts command} {
    list [catch {puts stdin hello} msg] $msg
 } {1 {channel "stdin" wasn't opened for writing}}
+test iocmd-1.6 {puts command} {
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts -nonewline $f foobar
+    close $f
+    file size test1
+} 6
+test iocmd-1.7 {puts command} {
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f foobar
+    close $f
+    file size test1
+} 7
+test iocmd-1.8 {puts command} {
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts -nonewline $f [binary format a4a5 foo bar]
+    close $f
+    file size test1
+} 9
+
 
-test iocmd-3.0 {flush command} {
+test iocmd-2.1 {flush command} {
    list [catch {flush} msg] $msg
 } {1 {wrong # args: should be "flush channelId"}}
-test iocmd-3.1 {flush command} {
+test iocmd-2.2 {flush command} {
    list [catch {flush a b c d e} msg] $msg
 } {1 {wrong # args: should be "flush channelId"}}
-test iocmd-3.3 {flush command} {
+test iocmd-2.3 {flush command} {
    list [catch {flush foo} msg] $msg
 } {1 {can not find channel named "foo"}}
-test iocmd-3.4 {flush command} {
+test iocmd-2.4 {flush command} {
    list [catch {flush stdin} msg] $msg
 } {1 {channel "stdin" wasn't opened for writing}}
 
-test iocmd-4.0 {gets command} {
+test iocmd-3.1 {gets command} {
    list [catch {gets} msg] $msg
 } {1 {wrong # args: should be "gets channelId ?varName?"}}
-test iocmd-4.1 {gets command} {
+test iocmd-3.2 {gets command} {
    list [catch {gets a b c d e f g} msg] $msg
 } {1 {wrong # args: should be "gets channelId ?varName?"}}
-test iocmd-4.2 {gets command} {
+test iocmd-3.3 {gets command} {
    list [catch {gets aaa} msg] $msg
 } {1 {can not find channel named "aaa"}}
-test iocmd-4.2 {gets command} {
+test iocmd-3.4 {gets command} {
    list [catch {gets stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
+test iocmd-3.5 {gets command} {
+    set f [open test1 w]
+    puts $f [binary format a4a5 foo bar]
+    close $f
+    set f [open test1 r]
+    set result [gets $f]
+    close $f
+    set x foo\x00
+    set x "${x}bar\x00\x00"
+    string compare $x $result
+} 0
 
-test iocmd-5.0 {read command} {
+test iocmd-4.1 {read command} {
    list [catch {read} msg] $msg
 } {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
-test iocmd-5.1 {read command} {
+test iocmd-4.2 {read command} {
    list [catch {read a b c d e f g h} msg] $msg
 } {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
-test iocmd-5.2 {read command} {
+test iocmd-4.3 {read command} {
    list [catch {read aaa} msg] $msg
 } {1 {can not find channel named "aaa"}}
-test iocmd-5.3 {read command} {
+test iocmd-4.4 {read command} {
    list [catch {read -nonewline} msg] $msg
 } {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
-test iocmd-5.4 {read command} {
+test iocmd-4.5 {read command} {
    list [catch {read -nonew file4} msg] $msg $errorCode
 } {1 {can not find channel named "-nonew"} NONE}
-test iocmd-5.5 {read command} {
+test iocmd-4.6 {read command} {
    list [catch {read stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
-test iocmd-5.6 {read command} {
+test iocmd-4.7 {read command} {
    list [catch {read -nonewline stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
-test iocmd-5.23 {read command with incorrect combination of arguments} {
+test iocmd-4.8 {read command with incorrect combination of arguments} {
     removeFile test1
     set f [open test1 w]
     puts $f "Two lines: this one"
@@ -116,82 +127,82 @@ test iocmd-5.23 {read command with incorrect combination of arguments} {
     close $f
     set x
 } {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"} NONE}
-test iocmd-5.24 {read command} {
+test iocmd-4.9 {read command} {
     list [catch {read stdin foo} msg] $msg $errorCode
 } {1 {bad argument "foo": should be "nonewline"} NONE}
-test iocmd-5.25 {read command} {
+test iocmd-4.10 {read command} {
     list [catch {read file107} msg] $msg $errorCode
 } {1 {can not find channel named "file107"} NONE}
-test iocmd-5.26 {read command} {
+test iocmd-4.11 {read command} {
     set f [open test3 w]
     set x [list [catch {read $f} msg] $msg $errorCode]
     close $f
     string compare [string tolower $x] \
 	[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
 } 0
-test iocmd-5.27 {read command} {
+test iocmd-4.12 {read command} {
     set f [open test1]
     set x [list [catch {read $f 12z} msg] $msg $errorCode]
     close $f
     set x
 } {1 {expected integer but got "12z"} NONE}
 
-test iocmd-6.0 {seek command} {
+test iocmd-5.1 {seek command} {
     list [catch {seek} msg] $msg
 } {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-6.1 {seek command} {
+test iocmd-5.2 {seek command} {
     list [catch {seek a b c d e f g} msg] $msg
 } {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-6.2 {seek command} {
+test iocmd-5.3 {seek command} {
     list [catch {seek stdin gugu} msg] $msg
 } {1 {expected integer but got "gugu"}}
-test iocmd-6.3 {seek command} {
+test iocmd-5.4 {seek command} {
     list [catch {seek stdin 100 gugu} msg] $msg
 } {1 {bad origin "gugu": should be start, current, or end}}
 
-test iocmd-7.0 {tell command} {
+test iocmd-6.1 {tell command} {
     list [catch {tell} msg] $msg
 } {1 {wrong # args: should be "tell channelId"}}
-test iocmd-7.1 {tell command} {
+test iocmd-6.2 {tell command} {
     list [catch {tell a b c d e} msg] $msg
 } {1 {wrong # args: should be "tell channelId"}}
-test iocmd-7.2 {tell command} {
+test iocmd-6.3 {tell command} {
     list [catch {tell aaa} msg] $msg
 } {1 {can not find channel named "aaa"}}
 
-test iocmd-8.0 {close command} {
+test iocmd-7.1 {close command} {
     list [catch {close} msg] $msg
 } {1 {wrong # args: should be "close channelId"}}
-test iocmd-8.1 {close command} {
+test iocmd-7.2 {close command} {
     list [catch {close a b c d e} msg] $msg
 } {1 {wrong # args: should be "close channelId"}}
-test iocmd-8.2 {close command} {
+test iocmd-7.3 {close command} {
     list [catch {close aaa} msg] $msg
 } {1 {can not find channel named "aaa"}}
 
-test iocmd-9.0 {fconfigure command} {
+test iocmd-8.1 {fconfigure command} {
     list [catch {fconfigure} msg] $msg
 } {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
-test iocmd-9.1 {fconfigure command} {
+test iocmd-8.2 {fconfigure command} {
     list [catch {fconfigure a b c d e f} msg] $msg
 } {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
-test iocmd-9.2 {fconfigure command} {
+test iocmd-8.3 {fconfigure command} {
     list [catch {fconfigure a b} msg] $msg
 } {1 {can not find channel named "a"}}
-test iocmd-9.3 {fconfigure command} {
+test iocmd-8.4 {fconfigure command} {
     removeFile test1
     set f1 [open test1 w]
     set x [list [catch {fconfigure $f1 froboz} msg] $msg]
     close $f1
     set x
-} {1 {bad option "froboz": must be -blocking, -buffering, -buffersize, -eofchar, -translation, or a channel type specific option}}
-test iocmd-9.4 {fconfigure command} {
+} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+test iocmd-8.5 {fconfigure command} {
     list [catch {fconfigure stdin -buffering froboz} msg] $msg
 } {1 {bad value for -buffering: must be one of full, line, or none}}
-test iocmd-9.4 {fconfigure command} {
+test iocmd-8.6 {fconfigure command} {
     list [catch {fconfigure stdin -translation froboz} msg] $msg
 } {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}}
-test iocmd-9.5 {fconfigure command} {
+test iocmd-8.7 {fconfigure command} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
@@ -199,7 +210,7 @@ test iocmd-9.5 {fconfigure command} {
     close $f1
     set x
 } {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -translation lf}
-test iocmd-9.6 {fconfigure command} {
+test iocmd-8.8 {fconfigure command} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
@@ -210,7 +221,7 @@ test iocmd-9.6 {fconfigure command} {
     close $f1
     set x
 } {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -translation lf}}
-test iocmd-9.7 {fconfigure command} {
+test iocmd-8.9 {fconfigure command} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
@@ -219,60 +230,118 @@ test iocmd-9.7 {fconfigure command} {
     close $f1
     set x
 } {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -translation lf}
-test iocmd-9.8 {fconfigure command} {
+test iocmd-8.10 {fconfigure command} {
     list [catch {fconfigure a b} msg] $msg
 } {1 {can not find channel named "a"}}
-test iocmd-9.9 {fconfigure command} {
+test iocmd-8.11 {fconfigure command} {
     list [catch {fconfigure stdout -froboz blarfo} msg] $msg
-} {1 {bad option "-froboz": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}}
-test iocmd-9.10 {fconfigure command} {
+} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+test iocmd-8.12 {fconfigure command} {
     list [catch {fconfigure stdout -b blarfo} msg] $msg
-} {1 {bad option "-b": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}}
-test iocmd-9.11 {fconfigure command} {
+} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+test iocmd-8.13 {fconfigure command} {
     list [catch {fconfigure stdout -buffer blarfo} msg] $msg
-} {1 {bad option "-buffer": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}}
-test iocmd-9.12 {fconfigure command} {
+} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+test iocmd-8.14 {fconfigure command} {
     fconfigure stdin -buffers
 } 4096
+proc iocmdSSETUP {} {
+  uplevel {
+	set srv [socket -server iocmdSRV 0];
+	set port [lindex [fconfigure $srv -sockname] 2];
+	proc iocmdSRV {sock ip port} {close $sock}
+	set cli [socket localhost $port];
+  }
+}
+proc iocmdSSHTDWN {} {
+  uplevel {
+	close $cli;
+	close $srv;
+	unset cli srv port
+	rename iocmdSRV {}
+  }
+}
+
+test iocmd-8.15 {fconfigure command / tcp channel} {
+	iocmdSSETUP
+	set r [list [catch {fconfigure $cli -blah} msg] $msg];
+	iocmdSSHTDWN
+	set r;
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, -peername, or -sockname}}
+test iocmd-8.16 {fconfigure command / tcp channel} {
+	iocmdSSETUP
+	set r [expr [lindex [fconfigure $cli -peername] 2]==$port];
+	iocmdSSHTDWN
+	set r
+} 1
+test iocmd-8.17 {fconfigure command / tcp channel} {nonPortable} {
+	# It is possible that you don't get the connection reset by peer
+        # error but rather a valid answer. depends of the tcp implementation
+	iocmdSSETUP
+	update;
+	puts $cli "blah"; flush $cli; # that flush could/should fail too
+	update;
+	set r [list [catch {fconfigure $cli -peername} msg] $msg];
+	iocmdSSHTDWN
+	regsub -all {can([^:])+: } $r {} r;
+	set r
+} {1 {connection reset by peer}}
+test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unixOnly} {
+	# might fail if /dev/ttya is unavailable
+	set tty [open /dev/ttya]
+	set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
+	close $tty;
+	set r;
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, or -mode}}
+test iocmd-8.19 {fconfigure command / win tty channel} {pcOnly} {
+	# might fail if com1 is unavailable
+	set tty [open com1]
+	set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
+	close $tty;
+	set r;
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, or -mode}}
 
-test iocmd-10.1 {eof command} {
+test iocmd-9.1 {eof command} {
     list [catch {eof} msg] $msg $errorCode
 } {1 {wrong # args: should be "eof channelId"} NONE}
-test iocmd-10.2 {eof command} {
+test iocmd-9.2 {eof command} {
     list [catch {eof a b} msg] $msg $errorCode
 } {1 {wrong # args: should be "eof channelId"} NONE}
-test iocmd-10.3 {eof command} {
+test iocmd-9.3 {eof command} {
     catch {close file100}
     list [catch {eof file100} msg] $msg $errorCode
 } {1 {can not find channel named "file100"} NONE}
 
-test iocmd-11.0 {fblocked command} {
+test iocmd-10.1 {fblocked command} {
     list [catch {fblocked} msg] $msg
 } {1 {wrong # args: should be "fblocked channelId"}}
-test iocmd-11.1 {fblocked command} {
+test iocmd-10.2 {fblocked command} {
     list [catch {fblocked a b c d e f g} msg] $msg
 } {1 {wrong # args: should be "fblocked channelId"}}
-test iocmd-11.2 {fblocked command} {
+test iocmd-10.3 {fblocked command} {
     list [catch {fblocked file1000} msg] $msg
 } {1 {can not find channel named "file1000"}}
-test iocmd-11.3 {fblocked command} {
+test iocmd-10.4 {fblocked command} {
     list [catch {fblocked stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
-test iocmd-11.4 {fblocked command} {
+test iocmd-10.5 {fblocked command} {
     fblocked stdin
 } 0
 
-test iocmd-12.1 {I/O to command pipelines} {unixOrPc unixExecs} {
-    list [catch {open "| cat < test1 > test3" w} msg] $msg $errorCode
+removeFile test5
+test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
+    set f [open test4 w]
+    close $f
+    list [catch {open "| cat < test4 > test5" w} msg] $msg $errorCode
 } {1 {can't write input to command: standard input was redirected} NONE}
-test iocmd-12.2 {I/O to command pipelines} {unixOrPc unixExecs} {
-    list [catch {open "| echo > test3" r} msg] $msg $errorCode
+test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
+    list [catch {open "| echo > test5" r} msg] $msg $errorCode
 } {1 {can't read output from command: standard output was redirected} NONE}
-test iocmd-12.3 {I/O to command pipelines} {unixOrPc unixExecs} {
-    list [catch {open "| echo > test3" r+} msg] $msg $errorCode
+test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
+    list [catch {open "| echo > test5" r+} msg] $msg $errorCode
 } {1 {can't read output from command: standard output was redirected} NONE}
 
-test iocmd-13.1 {POSIX open access modes: RDONLY} {
+test iocmd-12.1 {POSIX open access modes: RDONLY} {
     removeFile test1
     set f [open test1 w]
     puts $f "Two lines: this one"
@@ -284,18 +353,18 @@ test iocmd-13.1 {POSIX open access modes: RDONLY} {
     string compare $x \
 	"{Two lines: this one} 1 [list [format "channel \"%s\" wasn't opened for writing" $f]]"
 } 0
-test iocmd-13.2 {POSIX open access modes: RDONLY} {
+test iocmd-12.2 {POSIX open access modes: RDONLY} {
     removeFile test3
     string tolower [list [catch {open test3 RDONLY} msg] $msg]
 } {1 {couldn't open "test3": no such file or directory}}
-test iocmd-13.3 {POSIX open access modes: WRONLY} {
+test iocmd-12.3 {POSIX open access modes: WRONLY} {
     removeFile test3
     string tolower [list [catch {open test3 WRONLY} msg] $msg]
 } {1 {couldn't open "test3": no such file or directory}}
 #
 # Test 13.4 relies on assigning the same channel name twice.
 #
-test iocmd-13.4 {POSIX open access modes: WRONLY} {unixOnly} {
+test iocmd-12.4 {POSIX open access modes: WRONLY} {unixOnly} {
     removeFile test3
     set f [open test3 w]
     fconfigure $f -eofchar {}
@@ -314,80 +383,128 @@ test iocmd-13.4 {POSIX open access modes: WRONLY} {unixOnly} {
     set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy]
     string compare $x $y
 } 0
-test iocmd-13.5 {POSIX open access modes: RDWR} {
+test iocmd-12.5 {POSIX open access modes: RDWR} {
     removeFile test3
     string tolower [list [catch {open test3 RDWR} msg] $msg]
 } {1 {couldn't open "test3": no such file or directory}}
-test iocmd-13.15 {POSIX open access modes: errors} {
+test iocmd-12.6 {POSIX open access modes: errors} {
     concat [catch {open test3 "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
 } "1 unmatched open brace in list
 unmatched open brace in list
     while processing open access modes \"FOO {BAR BAZ\"
     invoked from within
 \"open test3 \"FOO \\{BAR BAZ\"\""
-test iocmd-13.16 {POSIX open access modes: errors} {
+test iocmd-12.7 {POSIX open access modes: errors} {
   list [catch {open test3 {FOO BAR BAZ}} msg] $msg
 } {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}}
-test iocmd-13.17 {POSIX open access modes: errors} {
+test iocmd-12.8 {POSIX open access modes: errors} {
     list [catch {open test3 {TRUNC CREAT}} msg] $msg
 } {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
 
-test iocmd-14.1 {errors in open command} {
+test iocmd-13.1 {errors in open command} {
     list [catch {open} msg] $msg
 } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
-test iocmd-14.2 {errors in open command} {
+test iocmd-13.2 {errors in open command} {
     list [catch {open a b c d} msg] $msg
 } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
-test iocmd-14.3 {errors in open command} {
+test iocmd-13.3 {errors in open command} {
     list [catch {open test1 x} msg] $msg
 } {1 {illegal access mode "x"}}
-test iocmd-14.4 {errors in open command} {
+test iocmd-13.4 {errors in open command} {
     list [catch {open test1 rw} msg] $msg
 } {1 {illegal access mode "rw"}}
-test iocmd-14.5 {errors in open command} {
+test iocmd-13.5 {errors in open command} {
     list [catch {open test1 r+1} msg] $msg
 } {1 {illegal access mode "r+1"}}
-test iocmd-14.6 {errors in open command} {
+test iocmd-13.6 {errors in open command} {
     string tolower [list [catch {open _non_existent_} msg] $msg $errorCode]
 } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
 
-test iocmd-15.1 {file id parsing errors} {
+test iocmd-14.1 {file id parsing errors} {
     list [catch {eof gorp} msg] $msg $errorCode
 } {1 {can not find channel named "gorp"} NONE}
-test iocmd-15.2 {file id parsing errors} {
+test iocmd-14.2 {file id parsing errors} {
     list [catch {eof filex} msg] $msg
 } {1 {can not find channel named "filex"}}
-test iocmd-15.3 {file id parsing errors} {
+test iocmd-14.3 {file id parsing errors} {
     list [catch {eof file12a} msg] $msg
 } {1 {can not find channel named "file12a"}}
-test iocmd-15.4 {file id parsing errors} {
+test iocmd-14.4 {file id parsing errors} {
     list [catch {eof file123} msg] $msg
 } {1 {can not find channel named "file123"}}
-test iocmd-15.5 {file id parsing errors} {
+test iocmd-14.5 {file id parsing errors} {
     list [catch {eof stdout} msg] $msg
 } {0 0}
-test iocmd-15.6 {file id parsing errors} {
+test iocmd-14.6 {file id parsing errors} {
     list [catch {eof stdin} msg] $msg
 } {0 0}
-test iocmd-15.7 {file id parsing errors} {
+test iocmd-14.7 {file id parsing errors} {
     list [catch {eof stdout} msg] $msg
 } {0 0}
-test iocmd-15.8 {file id parsing errors} {
+test iocmd-14.8 {file id parsing errors} {
     list [catch {eof stderr} msg] $msg
 } {0 0}
-test iocmd-15.9 {file id parsing errors} {
+test iocmd-14.9 {file id parsing errors} {
     list [catch {eof stderr1} msg] $msg
 } {1 {can not find channel named "stderr1"}}
-set f [open test1]
+set f [open test1 w]
 close $f
 set expect "1 {can not find channel named \"$f\"}"
-test iocmd-15.10 {file id parsing errors} {
+test iocmd-14.10 {file id parsing errors} {
     list [catch {eof $f} msg] $msg
 } $expect
 
+test iocmd-15.1 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy} msg] $msg
+} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
+test iocmd-15.2 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy 1} msg] $msg
+} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
+test iocmd-15.3 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy 1 2 3 4 5 6 7} msg] $msg
+} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
+test iocmd-15.4 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy 1 2 3} msg] $msg
+} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
+test iocmd-15.5 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy 1 2 3 4 5} msg] $msg
+} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
+set f [open test1 w]
+close $f
+set rfile [open test1 r]
+set wfile [open test2 w]
+test iocmd-15.6 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy foo $wfile} msg] $msg
+} {1 {can not find channel named "foo"}}
+test iocmd-15.7 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy $rfile foo} msg] $msg
+} {1 {can not find channel named "foo"}}
+test iocmd-15.8 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy $wfile $wfile} msg] $msg
+} "1 {channel \"$wfile\" wasn't opened for reading}"
+test iocmd-15.9 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy $rfile $rfile} msg] $msg
+} "1 {channel \"$rfile\" wasn't opened for writing}"
+test iocmd-15.10 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy $rfile $wfile foo bar} msg] $msg
+} {1 {bad switch "foo": must be -size, or -command}}
+test iocmd-15.11 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy $rfile $wfile -size foo} msg] $msg
+} {1 {expected integer but got "foo"}}
+test iocmd-15.12 {Tcl_FcopyObjCmd} {
+    list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
+} {1 {expected integer but got "foo"}}
+
+close $rfile
+close $wfile
+
 removeFile test1
 removeFile test2
 removeFile test3
+removeFile test4
+# delay long enough for background processes to finish
+after 500
+removeFile test5
 removeFile pipe
 removeFile output
 set x ""
diff --git a/contrib/tcl/tests/lindex.test b/contrib/tcl/tests/lindex.test
index 66ff3ac..fa2c1c6 100644
--- a/contrib/tcl/tests/lindex.test
+++ b/contrib/tcl/tests/lindex.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) lindex.test 1.5 96/02/16 08:56:03
+# SCCS: @(#) lindex.test 1.7 97/02/27 16:53:56
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -49,7 +49,7 @@ test lindex-2.2 {error conditions} {
 } {1 {wrong # args: should be "lindex list index"}}
 test lindex-2.3 {error conditions} {
     list [catch {lindex 1 2a2} msg] $msg
-} {1 {expected integer but got "2a2"}}
+} {1 {bad index "2a2": must be integer or "end"}}
 test lindex-2.4 {error conditions} {
     list [catch {lindex "a \{" 2} msg] $msg
 } {1 {unmatched open brace in list}}
diff --git a/contrib/tcl/tests/link.test b/contrib/tcl/tests/link.test
index 570a6ee..25eefb1 100644
--- a/contrib/tcl/tests/link.test
+++ b/contrib/tcl/tests/link.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) link.test 1.10 96/02/16 08:56:05
+# SCCS: @(#) link.test 1.12 97/01/21 21:16:04
 
 if {[info commands testlink] == {}} {
     puts "This application hasn't been compiled with the \"testlink\""
@@ -38,14 +38,14 @@ test link-1.2 {reading C variables from Tcl} {
 
 test link-2.1 {writing C variables from Tcl} {
     testlink delete
-    testlink set 43 1.23 4 -
+    testlink set 43 1.21 4 -
     testlink create 1 1 1 1
     set int "00721"
-    set real -8e13
+    set real -10.5
     set bool true
     set string abcdef
     concat [testlink get] $int $real $bool $string
-} {465 -8e+13 1 abcdef 00721 -8e13 true abcdef}
+} {465 -10.5 1 abcdef 00721 -10.5 true abcdef}
 test link-2.2 {writing bad values into variables} {
     testlink delete
     testlink set 43 1.23 4 -
@@ -86,12 +86,12 @@ test link-3.2 {read-only variables} {
 
 test link-4.1 {unsetting linked variables} {
     testlink delete
-    testlink set -6 -2.1 0 stringValue
+    testlink set -6 -2.5 0 stringValue
     testlink create 1 1 1 1
     unset int real bool string
     list [catch {set int} msg] $msg [catch {set real} msg] $msg \
 	    [catch {set bool} msg] $msg [catch {set string} msg] $msg
-} {0 -6 0 -2.1 0 0 0 stringValue}
+} {0 -6 0 -2.5 0 0 0 stringValue}
 test link-4.2 {unsetting linked variables} {
     testlink delete
     testlink set -6 -2.1 0 stringValue
@@ -106,22 +106,22 @@ test link-4.2 {unsetting linked variables} {
 
 test link-5.1 {unlinking variables} {
     testlink delete
-    testlink set -6 -2.1 0 stringValue
+    testlink set -6 -2.25 0 stringValue
     testlink delete
     set int xx1
     set real qrst
     set bool bogus
     set string 12345
     testlink get
-} {-6 -2.1 0 stringValue}
+} {-6 -2.25 0 stringValue}
 test link-5.2 {unlinking variables} {
     testlink delete
-    testlink set -6 -2.1 0 stringValue
+    testlink set -6 -2.25 0 stringValue
     testlink create 1 1 1 1
     testlink delete
     testlink set 25 14.7 7 -
     list $int $real $bool $string
-} {-6 -2.1 0 stringValue}
+} {-6 -2.25 0 stringValue}
 
 test link-6.1 {errors in setting up link} {
     testlink delete
@@ -182,9 +182,9 @@ test link-7.5 {access to linked variables via upvar} {
     }
     testlink delete
     testlink create 1 1 1 1
-    testlink set -4 16.3 {} {}
+    testlink set -4 16.75 {} {}
     list [catch x msg] $msg $real
-} {1 {can't set "y": variable must have real value} 16.3}
+} {1 {can't set "y": variable must have real value} 16.75}
 test link-7.6 {access to linked variables via upvar} {
     proc x {} {
 	upvar bool y
@@ -223,6 +223,10 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {
     trace vdelete int w x
     set x
 } {}
+test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {
+    testlink create 0 0 0 0
+    list [catch {testlink update 47 {} {} {}} msg] $msg $int
+} {0 {} 47}
 
 testlink delete
 foreach i {int real bool string} {
diff --git a/contrib/tcl/tests/linsert.test b/contrib/tcl/tests/linsert.test
index a77a907..6611394 100644
--- a/contrib/tcl/tests/linsert.test
+++ b/contrib/tcl/tests/linsert.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) linsert.test 1.8 96/02/16 08:56:07
+# SCCS: @(#) linsert.test 1.13 97/02/27 16:53:19
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -37,7 +37,7 @@ test linsert-1.7 {linsert command} {
 } {1 2 one two \{three {$four} 3 4 5}
 test linsert-1.8 {linsert command} {
     linsert {\{one \$two \{three \ four \ five} 2 a b c
-} {\{one \$two a b c \{three \ four \ five}
+} {\{one {$two} a b c \{three { four} { five}}
 test linsert-1.9 {linsert command} {
     linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b}
 } {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
@@ -49,10 +49,10 @@ test linsert-1.11 {linsert command} {
 } {{}}
 test linsert-1.12 {linsert command} {
     linsert {a b "c c" d e} 3 1
-} {a b "c c" 1 d e}
+} {a b {c c} 1 d e}
 test linsert-1.13 {linsert command} {
     linsert { a b c d} 0 1 2
-} {1 2  a b c d}
+} {1 2 a b c d}
 test linsert-1.14 {linsert command} {
     linsert {a b c {d e f}} 4 1 2
 } {a b c {d e f} 1 2}
@@ -80,7 +80,15 @@ test linsert-2.2 {linsert errors} {
 } {1 {wrong # args: should be "linsert list index element ?element ...?"}}
 test linsert-2.3 {linsert errors} {
     list [catch {linsert a 12x 2} msg] $msg
-} {1 {expected integer but got "12x"}}
+} {1 {bad index "12x": must be integer or "end"}}
 test linsert-2.4 {linsert errors} {
     list [catch {linsert \{ 12 2} msg] $msg
 } {1 {unmatched open brace in list}}
+
+test linsert-3.1 {linsert won't modify shared argument objects} {
+    proc p {} {
+        linsert "a b c" 1 "x y"
+        return "a b c"
+    }
+    p
+} "a b c"
diff --git a/contrib/tcl/tests/list.test b/contrib/tcl/tests/list.test
index e901391..6c59f20 100644
--- a/contrib/tcl/tests/list.test
+++ b/contrib/tcl/tests/list.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) list.test 1.20 96/02/16 08:56:09
+# SCCS: @(#) list.test 1.22 97/06/23 18:19:17
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -44,15 +44,17 @@ test list-1.24 {basic tests} {list} {}
 # For the next round of tests create a list and then pick it apart
 # with "index" to make sure that we get back exactly what went in.
 
+test list-2.1 {placeholder} {
+} {}
 set num 1
 proc lcheck {a b c} {
     global num d
     set d [list $a $b $c]
-    test list-2.$num {what goes in must come out} {lindex $d 0} $a
+;   test list-2.$num {what goes in must come out} {lindex $d 0} $a
     set num [expr $num+1]
-    test list-2.$num {what goes in must come out} {lindex $d 1} $b
+;   test list-2.$num {what goes in must come out} {lindex $d 1} $b
     set num [expr $num+1]
-    test list-2.$num {what goes in must come out} {lindex $d 2} $c
+;   test list-2.$num {what goes in must come out} {lindex $d 2} $c
     set num [expr $num+1]
 }
 lcheck a b c
@@ -71,3 +73,35 @@ lcheck xyz \\ 1\\\n2
 lcheck "{ab}\\" "{ab}xy" abc
 
 concat {}
+
+# Check that tclListObj.c's SetListFromAny handles possible overlarge
+# string rep lengths in the source object.
+
+proc slowsort list {
+    set result {}
+    set last [expr [llength $list] - 1]
+    while {$last > 0} {
+	set minIndex [expr [llength $list] - 1]
+	set min [lindex $list $last]
+	set i [expr $minIndex-1]
+	while {$i >= 0} {
+	    if {[string compare [lindex $list $i] $min] < 0} {
+		set minIndex $i
+		set min [lindex $list $i]
+	    }
+	    set i [expr $i-1]
+	}
+	set result [concat $result [list $min]]
+	if {$minIndex == 0} {
+	    set list [lrange $list 1 end]
+	} else {
+	    set list [concat [lrange $list 0 [expr $minIndex-1]] \
+			  [lrange $list [expr $minIndex+1] end]]
+	}
+	set last [expr $last-1]
+    }
+    return [concat $result $list]
+}
+test list-3.1 {SetListFromAny and lrange/concat results} {
+    slowsort {fred julie alex carol bill annie}
+} {alex annie bill carol fred julie}
diff --git a/contrib/tcl/tests/listObj.test b/contrib/tcl/tests/listObj.test
new file mode 100644
index 0000000..00eb7c6
--- /dev/null
+++ b/contrib/tcl/tests/listObj.test
@@ -0,0 +1,176 @@
+# Functionality covered: operation of the procedures in tclListObj.c that
+# implement the Tcl type manager for the list object type.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1995-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.
+#
+# SCCS: @(#) listObj.test 1.9 97/06/10 15:28:11
+
+if {[info commands testobj] == {}} {
+    puts "This application hasn't been compiled with the \"testobj\""
+    puts "command, so I can't test the Tcl type and object support."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset x}
+test listobj-1.1 {Tcl_GetListObjType} {
+    set t [testobj types]
+    set first [string first "list" $t]
+    set result [expr {$first != -1}]
+} {1}
+
+test listobj-2.1 {Tcl_ListObjForObjArray, use in lappend} {
+    catch {unset x}
+    list [lappend x 1 abc def] [lappend x 1 ghi jkl] $x
+} {{1 abc def} {1 abc def 1 ghi jkl} {1 abc def 1 ghi jkl}}
+test listobj-2.2 {Tcl_ListObjForObjArray, use in ObjInterpProc} {
+    proc return_args {args} {
+        return $args
+    }
+    list [return_args] [return_args x] [return_args x y]
+} {{} x {x y}}
+
+test listobj-3.1 {Tcl_ListObjAppend, list conversion} {
+    catch {unset x}
+    list [lappend x 1 2 abc "long string"] $x
+} {{1 2 abc {long string}} {1 2 abc {long string}}}
+test listobj-3.2 {Tcl_ListObjAppend, list conversion} {
+    set x ""
+    list [lappend x first second] [lappend x third fourth] $x
+} {{first second} {first second third fourth} {first second third fourth}}
+test listobj-3.3 {Tcl_ListObjAppend, list conversion} {
+    set x "abc def"
+    list [lappend x first second] $x
+} {{abc def first second} {abc def first second}}
+test listobj-3.4 {Tcl_ListObjAppend, error in conversion} {
+    set x " \{"
+    list [catch {lappend x abc def} msg] $msg
+} {1 {unmatched open brace in list}}
+test listobj-3.5 {Tcl_ListObjAppend, force internal rep array to grow} {
+    set x ""
+    list [lappend x 1 1] [lappend x 2 2] [lappend x 3 3] [lappend x 4 4] \
+        [lappend x 5 5] [lappend x 6 6] [lappend x 7 7] [lappend x 8 8] $x
+} {{1 1} {1 1 2 2} {1 1 2 2 3 3} {1 1 2 2 3 3 4 4} {1 1 2 2 3 3 4 4 5 5} {1 1 2 2 3 3 4 4 5 5 6 6} {1 1 2 2 3 3 4 4 5 5 6 6 7 7} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8}}
+
+test listobj-4.1 {Tcl_ListObjAppendElement, list conversion} {
+    catch {unset x}
+    list [lappend x 1] $x
+} {1 1}
+test listobj-4.2 {Tcl_ListObjAppendElement, list conversion} {
+    set x ""
+    list [lappend x first] [lappend x second] $x
+} {first {first second} {first second}}
+test listobj-4.3 {Tcl_ListObjAppendElement, list conversion} {
+    set x "abc def"
+    list [lappend x first] $x
+} {{abc def first} {abc def first}}
+test listobj-4.4 {Tcl_ListObjAppendElement, error in conversion} {
+    set x " \{"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
+test listobj-4.5 {Tcl_ListObjAppendElement, force internal rep array to grow} {
+    set x ""
+    list [lappend x 1] [lappend x 2] [lappend x 3] [lappend x 4] \
+        [lappend x 5] [lappend x 6] [lappend x 7] [lappend x 8] $x
+} {1 {1 2} {1 2 3} {1 2 3 4} {1 2 3 4 5} {1 2 3 4 5 6} {1 2 3 4 5 6 7} {1 2 3 4 5 6 7 8} {1 2 3 4 5 6 7 8}}
+
+test listobj-5.1 {Tcl_ListObjIndex, basic tests} {
+    lindex {a b c} 0
+} a
+test listobj-5.2 {Tcl_ListObjIndex, basic tests} {
+    lindex a 0
+} a
+test listobj-5.3 {Tcl_ListObjIndex, basic tests} {
+    lindex {a {b c d} x} 1
+} {b c d}
+test listobj-5.4 {Tcl_ListObjIndex, basic tests} {
+    lindex {a b c} 3
+} {}
+test listobj-5.5 {Tcl_ListObjIndex, basic tests} {
+    lindex {a b c} 100
+} {}
+test listobj-5.6 {Tcl_ListObjIndex, basic tests} {
+    lindex a 100
+} {}
+test listobj-5.7 {Tcl_ListObjIndex, basic tests} {
+    lindex {} -1
+} {}
+test listobj-5.8 {Tcl_ListObjIndex, error in conversion} {
+    set x " \{"
+    list [catch {lindex $x 0} msg] $msg
+} {1 {unmatched open brace in list}}
+
+test listobj-6.1 {Tcl_ListObjLength} {
+    llength {a b c d}
+} 4
+test listobj-6.2 {Tcl_ListObjLength} {
+    llength {a b c {a b {c d}} d}
+} 5
+test listobj-6.3 {Tcl_ListObjLength} {
+    llength {}
+} 0
+test listobj-6.4 {Tcl_ListObjLength, convert from non-list} {
+    llength 123
+} 1
+test listobj-6.5 {Tcl_ListObjLength, error converting from non-list} {
+    list [catch {llength "a b c \{"} msg] $msg
+} {1 {unmatched open brace in list}}
+test listobj-6.6 {Tcl_ListObjLength, error converting from non-list} {
+    list [catch {llength "a {b}c"} msg] $msg
+} {1 {list element in braces followed by "c" instead of space}}
+
+test listobj-7.1 {Tcl_ListObjReplace, conversion from non-list} {
+    lreplace 123 0 0 x
+} {x}
+test listobj-7.2 {Tcl_ListObjReplace, error converting from non-list} {
+    list [catch {lreplace "a b c \{" 1 1 x} msg] $msg
+} {1 {unmatched open brace in list}}
+test listobj-7.3 {Tcl_ListObjReplace, error converting from non-list} {
+    list [catch {lreplace "a {b}c" 1 2 x} msg] $msg
+} {1 {list element in braces followed by "c" instead of space}}
+test listobj-7.4 {Tcl_ListObjReplace, negative first element index} {
+    lreplace {1 2 3 4 5} -1 1 a
+} {a 3 4 5}
+test listobj-7.5 {Tcl_ListObjReplace, last element index >= num elems} {
+    lreplace {1 2 3 4 5} 3 7 a b c
+} {1 2 3 a b c}
+test listobj-7.6 {Tcl_ListObjReplace, first element index > last index} {
+    lreplace {1 2 3 4 5} 3 1 a b c
+} {1 2 3 a b c 4 5}
+test listobj-7.7 {Tcl_ListObjReplace, no new elements} {
+    lreplace {1 2 3 4 5} 1 1
+} {1 3 4 5}
+test listobj-7.8 {Tcl_ListObjReplace, shrink array in place} {
+    lreplace {1 2 3 4 5 6 7} 4 5
+} {1 2 3 4 7}
+test listobj-7.9 {Tcl_ListObjReplace, grow array in place} {
+    lreplace {1 2 3 4 5 6 7} 1 3 a b c d e
+} {1 a b c d e 5 6 7}
+test listobj-7.10 {Tcl_ListObjReplace, replace tail of array} {
+    lreplace {1 2 3 4 5 6 7} 3 6 a
+} {1 2 3 a}
+test listobj-7.11 {Tcl_ListObjReplace, must grow internal array} {
+    lreplace {1 2 3 4 5} 2 3 a b c d e f g h i j k l
+} {1 2 a b c d e f g h i j k l 5}
+test listobj-7.12 {Tcl_ListObjReplace, grow array, insert at start} {
+    lreplace {1 2 3 4 5} -1 -1 a b c d e f g h i j k l
+} {a b c d e f g h i j k l 1 2 3 4 5}
+test listobj-7.13 {Tcl_ListObjReplace, grow array, insert at end} {
+    lreplace {1 2 3 4 5} 4 1 a b c d e f g h i j k l
+} {1 2 3 4 a b c d e f g h i j k l 5}
+
+test listobj-8.1 {SetListFromAny} {
+    lindex {0 foo\x00help 2} 1
+} "foo\x00help"
+
+test listobj-9.1 {UpdateStringOfList} {
+    string length [list foo\x00help]
+} 8
diff --git a/contrib/tcl/tests/load.test b/contrib/tcl/tests/load.test
index 331e3b7..5c33677 100644
--- a/contrib/tcl/tests/load.test
+++ b/contrib/tcl/tests/load.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: %Z% %M% %I% %E% %U%
+# SCCS: @(#) load.test 1.19 96/11/30 16:05:18
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -27,11 +27,13 @@ if ![file readable [file join $testDir pkga$ext]] {
     return
 }
 
-if [string match *pkga* [info loaded]] {
+if [string match *pkga* [set alreadyLoaded [info loaded {}]]] {
     puts "load tests have already been run once:  skipping (can't rerun)"
     return
 }
 
+set alreadyTotalLoaded [info loaded]
+
 test load-1.1 {basic errors} {
     list [catch {load} msg] $msg
 } {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
@@ -74,8 +76,6 @@ test load-3.1 {error in _Init procedure, same interpreter} {
     while executing
 "open non_existent"
     invoked from within
-"if 44 {open non_existent}"
-    invoked from within
 "load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
 test load-3.2 {error in _Init procedure, slave interpreter} {
     catch {interp delete x}
@@ -90,8 +90,6 @@ test load-3.2 {error in _Init procedure, slave interpreter} {
     while executing
 "open non_existent"
     invoked from within
-"if 44 {open non_existent}"
-    invoked from within
 "load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
 
 test load-4.1 {reloading package into same interpreter} {
@@ -101,47 +99,62 @@ test load-4.2 {reloading package into same interpreter} {
     list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
 } "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"
 
+test load-5.1 {file name not specified and no static package: pick default} {
+    catch {interp delete x}
+    interp create x
+    load [file join $testDir pkga$ext] pkga
+    load {} pkga x
+    set result [info loaded x]
+    interp delete x
+    set result
+} "{[file join $testDir pkga$ext] Pkga}"
+
 # On some platforms, like SunOS 4.1.3, these tests can't be run because
 # they cause the process to exit.
 
-test load-5.1 {errors loading file} {nonPortable} {
+test load-6.1 {errors loading file} {nonPortable} {
     catch {load foo foo}
 } {1}
 
 if {[info command teststaticpkg] != ""} {
-    test load-6.1 {Tcl_StaticPackage procedure, static packages} {
+    test load-7.1 {Tcl_StaticPackage procedure} {
 	set x "not loaded"
 	teststaticpkg Test 1 0
 	load {} Test
 	load {} Test child
 	list [set x] [child eval set x]
     } {loaded loaded}
-    test load-6.2 {Tcl_StaticPackage procedure, static packages} {
+    test load-7.2 {Tcl_StaticPackage procedure} {
 	set x "not loaded"
 	teststaticpkg Another 0 0
 	load {} Another
 	child eval {set x "not loaded"}
 	list [catch {load {} Another child} msg] $msg [child eval set x] [set x]
     } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
-    test load-6.3 {Tcl_StaticPackage procedure, static packages} {
+    test load-7.3 {Tcl_StaticPackage procedure} {
 	set x "not loaded"
 	teststaticpkg More 0 1
 	load {} More
 	set x
     } {not loaded}
-    
-    test load-7.1 {TclGetLoadedPackages procedure} {
+    test load-7.4 {Tcl_StaticPackage procedure, redundant calls} {
+	teststaticpkg Double 0 1
+	teststaticpkg Double 0 1
+	info loaded
+    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+
+    test load-8.1 {TclGetLoadedPackages procedure} {
 	info loaded
-    } "{{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} {{} Tcltest}"
-    test load-7.2 {TclGetLoadedPackages procedure} {
+    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+    test load-8.2 {TclGetLoadedPackages procedure} {
 	list [catch {info loaded gorp} msg] $msg
     } {1 {couldn't find slave interpreter named "gorp"}}
-    test load-7.3 {TclGetLoadedPackages procedure} {
+    test load-8.3 {TclGetLoadedPackages procedure} {
 	list [info loaded {}] [info loaded child]
-    } "{{{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} {{} Tcltest}} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
-    test load-7.4 {TclGetLoadedPackages procedure} {
+    } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
+    test load-8.4 {TclGetLoadedPackages procedure} {
 	load [file join $testDir pkgb$ext] pkgb
 	list [info loaded {}] [lsort [info commands pkgb_*]]
-    } "{{[file join $testDir pkgb$ext] Pkgb} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} {{} Tcltest}} {pkgb_sub pkgb_unsafe}"
+    } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
     interp delete child
 }
diff --git a/contrib/tcl/tests/lrange.test b/contrib/tcl/tests/lrange.test
index 91f4439..32fbbaa 100644
--- a/contrib/tcl/tests/lrange.test
+++ b/contrib/tcl/tests/lrange.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) lrange.test 1.6 96/07/10 17:16:47
+# SCCS: @(#) lrange.test 1.12 97/06/23 18:19:25
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -43,7 +43,7 @@ test lrange-1.9 {range of list elements} {
 } {a b c d e}
 test lrange-1.10 {range of list elements} {
     lrange "a b\{c d" 1 2
-} "b\{c d"
+} "b\\{c d"
 test lrange-1.11 {range of list elements} {
     lrange "a b c d" end end
 } d
@@ -56,9 +56,12 @@ test lrange-1.13 {range of list elements} {
 test lrange-1.14 {range of list elements} {
     lrange "a b c d" end 2
 } {}
-test lrange-1.14 {range of list elements} {
+test lrange-1.15 {range of list elements} {
     concat \"[lrange {a b \{\   	} 0 2]"
 } {"a b \{\ "}
+test lrange-1.16 {list element quoting} {
+    lrange {[append a .b]} 0 end    
+} {{[append} a .b\]}
 
 test lrange-2.1 {error conditions} {
     list [catch {lrange a b} msg] $msg
@@ -68,10 +71,10 @@ test lrange-2.2 {error conditions} {
 } {1 {wrong # args: should be "lrange list first last"}}
 test lrange-2.3 {error conditions} {
     list [catch {lrange a b 6} msg] $msg
-} {1 {expected integer but got "b"}}
+} {1 {bad index "b": must be integer or "end"}}
 test lrange-2.4 {error conditions} {
     list [catch {lrange a 0 enigma} msg] $msg
-} {1 {expected integer or "end" but got "enigma"}}
+} {1 {bad index "enigma": must be integer or "end"}}
 test lrange-2.5 {error conditions} {
     list [catch {lrange "a \{b c" 3 4} msg] $msg
 } {1 {unmatched open brace in list}}
diff --git a/contrib/tcl/tests/lreplace.test b/contrib/tcl/tests/lreplace.test
index 75cddb2..197084e 100644
--- a/contrib/tcl/tests/lreplace.test
+++ b/contrib/tcl/tests/lreplace.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) lreplace.test 1.13 96/07/10 17:16:47
+# SCCS: @(#) lreplace.test 1.15 96/12/16 21:43:57
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -58,7 +58,7 @@ test lreplace-1.14 {lreplace command} {
 } {a b c}
 test lreplace-1.15 {lreplace command} {
     lreplace {a b "c c" d e f} 3 3
-} {a b "c c" e f}
+} {a b {c c} e f}
 test lreplace-1.16 {lreplace command} {
     lreplace { 1 2 3 4 5} 0 0 a
 } {a 2 3 4 5}
@@ -112,3 +112,11 @@ test lreplace-2.6 {lreplace errors} {
 test lreplace-2.7 {lreplace errors} {
     list [catch {lreplace x 1 1} msg] $msg
 } {1 {list doesn't contain element 1}}
+
+test lreplace-3.1 {lreplace won't modify shared argument objects} {
+    proc p {} {
+        lreplace "a b c" 1 1 "x y"
+        return "a b c"
+    }
+    p
+} "a b c"
diff --git a/contrib/tcl/tests/lsearch.test b/contrib/tcl/tests/lsearch.test
index 95df872..4eda84b 100644
--- a/contrib/tcl/tests/lsearch.test
+++ b/contrib/tcl/tests/lsearch.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) lsearch.test 1.5 96/02/16 08:56:15
+# SCCS: @(#) lsearch.test 1.7 97/04/30 13:23:53
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -35,18 +35,27 @@ test lsearch-2.2 {search modes} {
     lsearch -exact {b.x ^bc xy bcx} ^bc
 } 1
 test lsearch-2.3 {search modes} {
+    lsearch -exact {foo bar cat} ba
+} -1
+test lsearch-2.4 {search modes} {
+    lsearch -exact {foo bar cat} bart
+} -1
+test lsearch-2.5 {search modes} {
+    lsearch -exact {foo bar cat} bar
+} 1
+test lsearch-2.6 {search modes} {
     list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] $msg
 } {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
-test lsearch-2.4 {search modes} {
+test lsearch-2.7 {search modes} {
     lsearch -regexp {b.x ^bc xy bcx} ^bc
 } 3
-test lsearch-2.5 {search modes} {
+test lsearch-2.8 {search modes} {
     lsearch -glob {xyz bbcc *bc*} *bc*
 } 1
-test lsearch-2.6 {search modes} {
+test lsearch-2.9 {search modes} {
     lsearch -glob {b.x ^bc xy bcx} ^bc
 } 1
-test lsearch-2.7 {search modes} {
+test lsearch-2.10 {search modes} {
     list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
 } {1 {bad search mode "-glib": must be -exact, -glob, or -regexp}}
 
@@ -65,3 +74,13 @@ test lsearch-3.4 {lsearch errors} {
 test lsearch-3.5 {lsearch errors} {
     list [catch {lsearch "\{" b} msg] $msg
 } {1 {unmatched open brace in list}}
+
+test lsearch-4.1 {binary data} {
+    lsearch -exact [list foo one\000two bar] bar
+} 2
+test lsearch-4.2 {binary data} {
+    set x one
+    append x \x00
+    append x two
+    lsearch -exact [list foo one\000two bar] $x
+} 1
diff --git a/contrib/tcl/tests/macFCmd.test b/contrib/tcl/tests/macFCmd.test
new file mode 100644
index 0000000..a06004c
--- /dev/null
+++ b/contrib/tcl/tests/macFCmd.test
@@ -0,0 +1,168 @@
+# This file tests the tclfCmd.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) macFCmd.test 1.3 97/06/23 18:24:10
+#
+
+if {$tcl_platform(platform) != "macintosh"} {
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {file delete -force foo.dir}
+file mkdir foo.dir
+if {[catch {file attributes foo.dir -readonly 1}]} {
+    set testConfig(fileSharing) 0
+    set testConfig(notFileSharing) 1
+} else {
+    set testConfig(fileSharing) 1
+    set testConfig(notFileSharing) 0
+}
+file delete -force foo.dir
+
+test macFCmd-1.1 {GetFileFinderAttributes - no file} {
+    catch {file delete -force foo.file}
+    list [catch {file attributes foo.file -creator} msg] $msg
+} {1 {couldn't get attributes for file ":foo.file": no such file or directory}}
+test macFCmd-1.2 {GetFileFinderAttributes - creator} {
+    catch {file delete -force foo.file}
+    catch {close [open foo.file w]}
+    list [catch {file attributes foo.file -creator} msg] $msg [file delete -force foo.file]
+} {0 {MPW } {}}
+test macFCmd-1.3 {GetFileFinderAttributes - type} {
+    catch {file delete -force foo.file}
+    catch {close [open foo.file w]}
+    list [catch {file attributes foo.file -type} msg] $msg [file delete -force foo.file]
+} {0 TEXT {}}
+test macFCmd-1.4 {GetFileFinderAttributes - not hidden} {
+    catch {file delete -force foo.file}
+    catch {close [open foo.file w]}
+    list [catch {file attributes foo.file -hidden} msg] $msg [file delete -force foo.file]
+} {0 0 {}}
+test macFCmd-1.5 {GetFileFinderAttributes - hidden} {
+    catch {file delete -force foo.file}
+    catch {close [open foo.file w]}
+    file attributes foo.file -hidden 1
+    list [catch {file attributes foo.file -hidden} msg] $msg [file delete -force foo.file]
+} {0 1 {}}
+test macFCmd-1.6 {GetFileFinderAttributes - folder creator} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -creator} msg] $msg [file delete -force foo.dir]
+} {0 Fldr {}}
+test macFCmd-1.7 {GetFileFinderAttributes - folder type} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -type} msg] $msg [file delete -force foo.dir]
+} {0 Fldr {}}
+test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -hidden} msg] $msg [file delete -force foo.dir]
+} {0 0 {}}
+
+test macFCmd-2.1 {GetFileReadOnly - bad file} {
+    catch {file delete -force foo.file}
+    list [catch {file attributes foo.file -readonly} msg] $msg
+} {1 {couldn't get attributes for file ":foo.file": no such file or directory}}
+test macFCmd-2.2 {GetFileReadOnly - file not read only} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -readonly} msg] $msg [file delete -force foo.file]
+} {0 0 {}}
+test macFCmd-2.3 {GetFileReadOnly - file read only} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    file attributes foo.file -readonly 1
+    list [catch {file attributes foo.file -readonly} msg] $msg [file delete -force foo.file]
+} {0 1 {}}
+test macFCmd-2.4 {GetFileReadOnly - directory not read only} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -readonly} msg] $msg [file delete -force foo.dir]
+} {0 0 {}}
+test macFCmd-2.5 {GetFileReadOnly - directory read only} {fileSharing} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    file attributes foo.dir -readonly 1
+    list [catch {file attributes foo.dir -readonly} msg] $msg [file delete -force foo.dir]
+} {0 1 {}}
+
+test macFCmd-3.1 {SetFileFinderAttributes - bad file} {
+    catch {file delete -force foo.file}
+    list [catch {file attributes foo.file -creator FOOO} msg] $msg
+} {1 {couldn't set attributes for file ":foo.file": no such file or directory}}
+test macFCmd-3.2 {SetFileFinderAttributes - creator} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -creator FOOO} msg] $msg [file attributes foo.file -creator] [file delete -force foo.file]
+} {0 {} FOOO {}}
+test macFCmd-3.3 {SetFileFinderAttributes - bad creator} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -creator 0} msg] $msg [file delete -force foo.file]
+} {1 {expected Macintosh OS type but got "0"} {}}
+test macFCmd-3.4 {SetFileFinderAttributes - hidden} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -hidden 1} msg] $msg [file attributes foo.file -hidden] [file delete -force foo.file]
+} {0 {} 1 {}}
+test macFCmd-3.5 {SetFileFinderAttributes - type} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -type FOOO} msg] $msg [file attributes foo.file -type] [file delete -force foo.file]
+} {0 {} FOOO {}}
+test macFCmd-3.6 {SetFileFinderAttributes - bad type} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -type 0} msg] $msg [file delete -force foo.file]
+} {1 {expected Macintosh OS type but got "0"} {}}
+test macFCmd-3.7 {SetFileFinderAttributes - directory} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -creator FOOO} msg] $msg [file delete -force foo.dir]
+} {1 {cannot set -creator: ":foo.dir" is a directory} {}}
+
+test macFCmd-4.1 {SetFileReadOnly - bad file} {
+    catch {file delete -force foo.file}
+    list [catch {file attributes foo.file -readonly 1} msg] $msg
+} {1 {couldn't set attributes for file ":foo.file": no such file or directory}}
+test macFCmd-4.2 {SetFileReadOnly - file not readonly} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -readonly 0} msg] $msg [file attributes foo.file -readonly] [file delete -force foo.file]
+} {0 {} 0 {}}
+test macFCmd-4.3 {SetFileReadOnly - file readonly} {
+    catch {file delete -force foo.file}
+    close [open foo.file w]
+    list [catch {file attributes foo.file -readonly 1} msg] $msg [file attributes foo.file -readonly] [file delete -force foo.file]
+} {0 {} 1 {}}
+test macFCmd-4.4 {SetFileReadOnly - directory not readonly} {fileSharing} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -readonly 0} msg] $msg [file attributes foo.dir -readonly] [file delete -force foo.dir]
+} {0 {} 0 {}}
+test macFCmd-4.5 {SetFileReadOnly - directory not readonly} {notFileSharing} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -readonly 0} msg] $msg [file delete -force foo.dir]
+} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
+test macFCmd-4.6 {SetFileReadOnly - directory readonly} {fileSharing} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -readonly 1} msg] $msg [file attributes foo.dir -readonly] [file delete -force foo.dir]
+} {0 {} 1 {}}
+test macFCmd-4.7 {SetFileReadOnly - directory readonly} {notFileSharing} {
+    catch {file delete -force foo.dir}
+    file mkdir foo.dir
+    list [catch {file attributes foo.dir -readonly 1} msg] $msg [file delete -force foo.dir]
+} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
diff --git a/contrib/tcl/tests/misc.test b/contrib/tcl/tests/misc.test
index b53759d..5929206 100644
--- a/contrib/tcl/tests/misc.test
+++ b/contrib/tcl/tests/misc.test
@@ -6,12 +6,12 @@
 # releases.
 #
 # Copyright (c) 1992-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# 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.
 #
-# SCCS: @(#) misc.test 1.5 96/02/16 08:56:18
+# SCCS: @(#) misc.test 1.11 97/06/20 16:53:28
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -48,23 +48,10 @@ test misc-1.2 {error in variable ref. in command in array reference} {
     "
     set msg {}
     list [catch tstProc msg] $msg $errorInfo
-} [list 1 {missing close-brace for variable name} \
-[format {missing close-brace for variable name
-    while executing
-"winfo name $%szz)
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus commen ..."
-    (parsing index for array "a")
-    invoked from within
-"set tst $a([winfo name $%szz)
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a  ..."
-    (procedure "tstProc" line 4)
+} [list 1 {missing close-bracket or close-brace} \
+{missing close-bracket or close-brace
+    while compiling
+"set"
+    (compiling body of proc "tstProc", line 4)
     invoked from within
-"tstProc"} \{ \{]]
+"tstProc"}]
diff --git a/contrib/tcl/tests/namespace-old.test b/contrib/tcl/tests/namespace-old.test
new file mode 100644
index 0000000..f743722
--- /dev/null
+++ b/contrib/tcl/tests/namespace-old.test
@@ -0,0 +1,844 @@
+# Functionality covered: this file contains slightly modified versions of
+# the original tests written by Mike McLennan of Lucent Technologies for
+# the procedures in tclNamesp.c that implement Tcl's basic support for
+# namespaces. Other namespace-related tests appear in namespace.test
+# and variable.test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1997 Lucent Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) namespace-old.test 1.5 97/06/20 14:51:17
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Clear out any namespaces called test_ns_*
+catch {eval namespace delete [namespace children :: test_ns_*]}
+
+test namespace-old-1.1 {usage for "namespace" command} {
+    list [catch {namespace} msg] $msg
+} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
+
+test namespace-old-1.2 {global namespace's name is "::" or {}} {
+    list [namespace current] [namespace eval {} {namespace current}]
+} {:: ::}
+
+test namespace-old-1.3 {usage for "namespace eval"} {
+    list [catch {namespace eval} msg] $msg
+} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
+
+test namespace-old-1.4 {create new namespaces} {
+    list [lsort [namespace children :: test_ns_simple*]] \
+	 [namespace eval test_ns_simple {}] \
+	 [namespace eval test_ns_simple2 {}] \
+         [lsort [namespace children :: test_ns_simple*]]
+} {{} {} {} {::test_ns_simple ::test_ns_simple2}}
+
+test namespace-old-1.5 {access a new namespace} {
+    namespace eval test_ns_simple { namespace current }
+} {::test_ns_simple}
+
+test namespace-old-1.6 {usage for "namespace eval"} {
+    list [catch {namespace eval} msg] $msg
+} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
+
+test namespace-old-1.7 {usage for "namespace eval"} {
+    list [catch {namespace eval test_ns_xyzzy} msg] $msg
+} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
+
+test namespace-old-1.8 {command "namespace eval" concatenates args} {
+    namespace eval test_ns_simple namespace current
+} {::test_ns_simple}
+
+test namespace-old-1.9 {add elements to a namespace} {
+    namespace eval test_ns_simple {
+        variable test_ns_x 0
+        proc test {test_ns_x} {
+            return "test: $test_ns_x"
+        }
+    }
+} {}
+
+test namespace-old-1.10 {commands in a namespace} {
+    namespace eval test_ns_simple { info commands [namespace current]::*}
+} {::test_ns_simple::test}
+
+test namespace-old-1.11 {variables in a namespace} {
+    namespace eval test_ns_simple { info vars [namespace current]::* }
+} {::test_ns_simple::test_ns_x}
+
+test namespace-old-1.12 {global vars are separate from locals vars} {
+    list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
+} {{test: 123} 0}
+
+test namespace-old-1.13 {add to an existing namespace} {
+    namespace eval test_ns_simple {
+        variable test_ns_y 123
+        proc _backdoor {cmd} {
+            eval $cmd
+        }
+    }
+} ""
+
+test namespace-old-1.14 {commands in a namespace} {
+    lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
+} {::test_ns_simple::_backdoor ::test_ns_simple::test}
+
+test namespace-old-1.15 {variables in a namespace} {
+    lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
+} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
+test namespace-old-1.16 {variables in a namespace} {
+    lsort [info vars test_ns_simple::*]
+} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
+
+test namespace-old-1.17 {commands in a namespace are hidden} {
+    list [catch "_backdoor {return yes!}" msg] $msg
+} {1 {invalid command name "_backdoor"}}
+test namespace-old-1.18 {using namespace qualifiers} {
+    list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
+} {0 yes!}
+test namespace-old-1.19 {using absolute namespace qualifiers} {
+    list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
+} {0 yes!}
+
+test namespace-old-1.20 {variables in a namespace are hidden} {
+    list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
+} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
+test namespace-old-1.21 {using namespace qualifiers} {
+    list [catch "set test_ns_simple::test_ns_x" msg] $msg \
+         [catch "set test_ns_simple::test_ns_y" msg] $msg
+} {0 0 0 123}
+test namespace-old-1.22 {using absolute namespace qualifiers} {
+    list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
+         [catch "set ::test_ns_simple::test_ns_y" msg] $msg
+} {0 0 0 123}
+test namespace-old-1.23 {variables can be accessed within a namespace} {
+    test_ns_simple::_backdoor {
+        variable test_ns_x
+        variable test_ns_y
+        return "$test_ns_x $test_ns_y"
+    }
+} {0 123}
+
+test namespace-old-1.24 {setting global variables} {
+    test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
+    namespace eval test_ns_simple {set test_ns_x}
+} {new val}
+
+test namespace-old-1.25 {qualified variables don't need a global declaration} {
+    namespace eval test_ns_another { variable test_ns_x 456 }
+    set cmd {set ::test_ns_another::test_ns_x}
+    list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
+         [eval $cmd]
+} {0 some-value some-value}
+
+test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
+    namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
+    set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
+    list [test_ns_simple::_backdoor $cmd] [eval $cmd]
+} {{12 34} {12 34}}
+
+test namespace-old-1.27 {can create commands with null names} {
+    proc test_ns_simple:: {args} {return $args}
+} {}
+
+# -----------------------------------------------------------------------
+# TEST: using "info" in namespace contexts
+# -----------------------------------------------------------------------
+test namespace-old-2.1 {querying:  info commands} {
+    lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
+} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
+
+test namespace-old-2.2 {querying:  info procs} {
+    lsort [test_ns_simple::_backdoor {info procs}]
+} {{} _backdoor test}
+
+test namespace-old-2.3 {querying:  info vars} {
+    lsort [info vars test_ns_simple::*]
+} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
+
+test namespace-old-2.4 {querying:  info vars} {
+    lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
+} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
+
+test namespace-old-2.5 {querying:  info locals} {
+    lsort [test_ns_simple::_backdoor {info locals}]
+} {cmd}
+
+test namespace-old-2.6 {querying:  info exists} {
+    test_ns_simple::_backdoor {info exists test_ns_x}
+} {0}
+
+test namespace-old-2.7 {querying:  info exists} {
+    test_ns_simple::_backdoor {info exists cmd}
+} {1}
+
+test namespace-old-2.8 {querying:  info args} {
+    info args test_ns_simple::_backdoor
+} {cmd}
+
+test namespace-old-2.9 {querying:  info body} {
+    string trim [info body test_ns_simple::test]
+} {return "test: $test_ns_x"}
+
+# -----------------------------------------------------------------------
+# TEST: namespace qualifiers, namespace tail
+# -----------------------------------------------------------------------
+test namespace-old-3.1 {usage for "namespace qualifiers"} {
+    list [catch "namespace qualifiers" msg] $msg
+} {1 {wrong # args: should be "namespace qualifiers string"}}
+
+test namespace-old-3.2 {querying:  namespace qualifiers} {
+    list [namespace qualifiers ""] \
+         [namespace qualifiers ::] \
+         [namespace qualifiers x] \
+         [namespace qualifiers ::x] \
+         [namespace qualifiers foo::x] \
+         [namespace qualifiers ::foo::bar::xyz]
+} {{} {} {} {} foo ::foo::bar}
+
+test namespace-old-3.3 {usage for "namespace tail"} {
+    list [catch "namespace tail" msg] $msg
+} {1 {wrong # args: should be "namespace tail string"}}
+
+test namespace-old-3.4 {querying:  namespace tail} {
+    list [namespace tail ""] \
+         [namespace tail ::] \
+         [namespace tail x] \
+         [namespace tail ::x] \
+         [namespace tail foo::x] \
+         [namespace tail ::foo::bar::xyz]
+} {{} {} x x x xyz}
+
+# -----------------------------------------------------------------------
+# TEST: delete commands and namespaces
+# -----------------------------------------------------------------------
+test namespace-old-4.1 {define test namespaces} {
+    namespace eval test_ns_delete {
+        namespace eval ns1 {
+            variable var1 1
+            proc cmd1 {} {return "cmd1"}
+        }
+        namespace eval ns2 {
+            variable var2 2
+            proc cmd2 {} {return "cmd2"}
+        }
+        namespace eval another {}
+        lsort [namespace children]
+    }
+} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
+
+test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
+    list [catch {namespace delete} msg] $msg
+} {0 {}}
+
+test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
+    set cmd {
+        namespace eval test_ns_delete {namespace delete ns*}
+    }
+    list [catch $cmd msg] $msg
+} {1 {unknown namespace "ns*" in namespace delete command}}
+
+test namespace-old-4.4 {command "namespace delete" handles multiple args} {
+    set cmd {
+        namespace eval test_ns_delete {
+            eval namespace delete \
+                [namespace children [namespace current] ns?]
+        }
+    }
+    list [catch $cmd msg] $msg [namespace children test_ns_delete]
+} {0 {} ::test_ns_delete::another}
+
+# -----------------------------------------------------------------------
+# TEST: namespace hierarchy
+# -----------------------------------------------------------------------
+test namespace-old-5.1 {define nested namespaces} {
+    set test_ns_var_global "var in ::"
+    proc test_ns_cmd_global {} {return "cmd in ::"}
+
+    namespace eval test_ns_hier1 {
+        set test_ns_var_hier1 "particular to hier1"
+        proc test_ns_cmd_hier1 {} {return "particular to hier1"}
+
+        set test_ns_level 1
+        proc test_ns_show {} {return "[namespace current]: 1"}
+
+        namespace eval test_ns_hier2 {
+            set test_ns_var_hier2 "particular to hier2"
+            proc test_ns_cmd_hier2 {} {return "particular to hier2"}
+
+            set test_ns_level 2
+            proc test_ns_show {} {return "[namespace current]: 2"}
+
+            namespace eval test_ns_hier3a {}
+            namespace eval test_ns_hier3b {}
+        }
+
+        namespace eval test_ns_hier2a {}
+        namespace eval test_ns_hier2b {}
+    }
+} {}
+
+test namespace-old-5.2 {namespaces can be nested} {
+    list [namespace eval test_ns_hier1 {namespace current}] \
+         [namespace eval test_ns_hier1 {
+              namespace eval test_ns_hier2 {namespace current}
+          }]
+} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
+
+test namespace-old-5.3 {namespace qualifiers work in namespace command} {
+    list [namespace eval ::test_ns_hier1 {namespace current}] \
+         [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
+         [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
+} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
+
+test namespace-old-5.4 {nested namespaces can access global namespace} {
+    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
+         [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
+         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
+         [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
+} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
+
+test namespace-old-5.5 {variables in different namespaces don't conflict} {
+    list [set test_ns_hier1::test_ns_level] \
+         [set test_ns_hier1::test_ns_hier2::test_ns_level]
+} {1 2}
+
+test namespace-old-5.6 {commands in different namespaces don't conflict} {
+    list [test_ns_hier1::test_ns_show] \
+         [test_ns_hier1::test_ns_hier2::test_ns_show]
+} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
+
+test namespace-old-5.7 {nested namespaces don't see variables in parent} {
+    set cmd {
+        namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
+    }
+    list [catch $cmd msg] $msg
+} {1 {can't read "test_ns_var_hier1": no such variable}}
+
+test namespace-old-5.8 {nested namespaces don't see commands in parent} {
+    set cmd {
+        namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
+    }
+    list [catch $cmd msg] $msg
+} {1 {invalid command name "test_ns_cmd_hier1"}}
+
+test namespace-old-5.9 {usage for "namespace children"} {
+    list [catch {namespace children test_ns_hier1 y z} msg] $msg
+} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
+
+test namespace-old-5.10 {command "namespace children" must get valid namespace} {
+    list [catch {namespace children xyzzy} msg] $msg
+} {1 {unknown namespace "xyzzy" in namespace children command}}
+
+test namespace-old-5.11 {querying namespace children} {
+    lsort [namespace children :: test_ns_hier*]
+} {::test_ns_hier1}
+
+test namespace-old-5.12 {querying namespace children} {
+    lsort [namespace children test_ns_hier1]
+} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
+
+test namespace-old-5.13 {querying namespace children} {
+    lsort [namespace eval test_ns_hier1 {namespace children}]
+} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
+
+test namespace-old-5.14 {querying namespace children} {
+    lsort [namespace children test_ns_hier1::test_ns_hier2]
+} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
+
+test namespace-old-5.15 {querying namespace children} {
+    lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
+} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
+
+test namespace-old-5.16 {querying namespace children with patterns} {
+    lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
+} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
+
+test namespace-old-5.17 {querying namespace children with patterns} {
+    lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
+} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
+
+test namespace-old-5.18 {usage for "namespace parent"} {
+    list [catch {namespace parent x y} msg] $msg
+} {1 {wrong # args: should be "namespace parent ?name?"}}
+
+test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
+    list [catch {namespace parent xyzzy} msg] $msg
+} {1 {unknown namespace "xyzzy" in namespace parent command}}
+
+test namespace-old-5.20 {querying namespace parent} {
+    list [namespace eval :: {namespace parent}] \
+        [namespace eval test_ns_hier1 {namespace parent}] \
+        [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
+        [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
+} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
+
+test namespace-old-5.21 {querying namespace parent for explicit namespace} {
+    list [namespace parent ::] \
+         [namespace parent test_ns_hier1] \
+         [namespace parent test_ns_hier1::test_ns_hier2] \
+         [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
+} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
+
+# -----------------------------------------------------------------------
+# TEST: name resolution and caching
+# -----------------------------------------------------------------------
+test namespace-old-6.1 {relative ns names only looked up in current ns} {
+    namespace eval test_ns_cache1 {}
+    namespace eval test_ns_cache2 {}
+    namespace eval test_ns_cache2::test_ns_cache3 {}
+    set trigger {
+        namespace eval test_ns_cache2 {namespace current}
+    }
+    set trigger2 {
+        namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
+    }
+    list [namespace eval test_ns_cache1 $trigger] \
+         [namespace eval test_ns_cache1 $trigger2]
+} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+
+test namespace-old-6.2 {relative ns names only looked up in current ns} {
+    namespace eval test_ns_cache1::test_ns_cache2 {}
+    list [namespace eval test_ns_cache1 $trigger] \
+         [namespace eval test_ns_cache1 $trigger2]
+} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+
+test namespace-old-6.3 {relative ns names only looked up in current ns} {
+    namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
+    list [namespace eval test_ns_cache1 $trigger] \
+         [namespace eval test_ns_cache1 $trigger2]
+} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+
+test namespace-old-6.4 {relative ns names only looked up in current ns} {
+    namespace delete test_ns_cache1::test_ns_cache2
+    list [namespace eval test_ns_cache1 $trigger] \
+         [namespace eval test_ns_cache1 $trigger2]
+} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+
+test namespace-old-6.5 {define test commands} {
+    proc test_ns_cache_cmd {} {
+        return "global version"
+    }
+    namespace eval test_ns_cache1 {
+        proc trigger {} {
+            test_ns_cache_cmd
+        }
+    }
+    test_ns_cache1::trigger
+} {global version}
+
+test namespace-old-6.6 {one-level check for command shadowing} {
+    proc test_ns_cache1::test_ns_cache_cmd {} {
+        return "cache1 version"
+    }
+    test_ns_cache1::trigger
+} {cache1 version}
+
+test namespace-old-6.7 {renaming commands changes command epoch} {
+    namespace eval test_ns_cache1 {
+        rename test_ns_cache_cmd test_ns_new
+    }
+    test_ns_cache1::trigger
+} {global version}
+
+test namespace-old-6.8 {renaming back handles shadowing} {
+    namespace eval test_ns_cache1 {
+        rename test_ns_new test_ns_cache_cmd
+    }
+    test_ns_cache1::trigger
+} {cache1 version}
+
+test namespace-old-6.9 {deleting commands changes command epoch} {
+    namespace eval test_ns_cache1 {
+        rename test_ns_cache_cmd ""
+    }
+    test_ns_cache1::trigger
+} {global version}
+
+test namespace-old-6.10 {define test namespaces} {
+    namespace eval test_ns_cache2 {
+        proc test_ns_cache_cmd {} {
+            return "global cache2 version"
+        }
+    }
+    namespace eval test_ns_cache1 {
+        proc trigger {} {
+            test_ns_cache2::test_ns_cache_cmd
+        }
+    }
+    namespace eval test_ns_cache1::test_ns_cache2 {
+        proc trigger {} {
+            test_ns_cache_cmd
+        }
+    }
+    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
+} {{global cache2 version} {global version}}
+
+test namespace-old-6.11 {commands affect all parent namespaces} {
+    proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
+        return "cache2 version"
+    }
+    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
+} {{cache2 version} {cache2 version}}
+
+test namespace-old-6.12 {define test variables} {
+    variable test_ns_cache_var "global version"
+    set trigger {set test_ns_cache_var}
+    namespace eval test_ns_cache1 $trigger
+} {global version}
+
+test namespace-old-6.13 {one-level check for variable shadowing} {
+    namespace eval test_ns_cache1 {
+        variable test_ns_cache_var "cache1 version"
+    }
+    namespace eval test_ns_cache1 $trigger
+} {cache1 version}
+
+test namespace-old-6.14 {deleting variables changes variable epoch} {
+    namespace eval test_ns_cache1 {
+        unset test_ns_cache_var
+    }
+    namespace eval test_ns_cache1 $trigger
+} {global version}
+
+test namespace-old-6.15 {define test namespaces} {
+    namespace eval test_ns_cache2 {
+        variable test_ns_cache_var "global cache2 version"
+    }
+    set trigger2 {set test_ns_cache2::test_ns_cache_var}
+    list [namespace eval test_ns_cache1 $trigger2] \
+         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
+} {{global cache2 version} {global version}}
+
+test namespace-old-6.16 {public variables affect all parent namespaces} {
+    variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
+    list [namespace eval test_ns_cache1 $trigger2] \
+         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
+} {{cache2 version} {cache2 version}}
+
+test namespace-old-6.17 {usage for "namespace which"} {
+    list [catch "namespace which -baz" msg] $msg
+} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
+test namespace-old-6.18 {usage for "namespace which"} {
+    list [catch "namespace which -command" msg] $msg
+} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
+
+test namespace-old-6.19 {querying:  namespace which -command} {
+    proc test_ns_cache1::test_ns_cache_cmd {} {
+        return "cache1 version"
+    }
+    list [namespace eval :: {namespace which test_ns_cache_cmd}] \
+         [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
+         [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
+         [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
+} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
+
+test namespace-old-6.20 {command "namespace which" may not find commands} {
+    namespace eval test_ns_cache1 {namespace which -command xyzzy}
+} {}
+
+test namespace-old-6.21 {querying:  namespace which -variable} {
+    namespace eval test_ns_cache1::test_ns_cache2 {
+        namespace which -variable test_ns_cache_var
+    }
+} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
+
+test namespace-old-6.22 {command "namespace which" may not find variables} {
+    namespace eval test_ns_cache1 {namespace which -variable xyzzy}
+} {}
+
+# -----------------------------------------------------------------------
+# TEST: uplevel/upvar across namespace boundaries
+# -----------------------------------------------------------------------
+test namespace-old-7.1 {define test namespace} {
+    namespace eval test_ns_uplevel {
+        variable x 0
+        variable y 1
+
+        proc show_vars {num} {
+            return [uplevel $num {info vars}]
+        }
+        proc test_uplevel {num} {
+            set a 0
+            set b 1
+            namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
+        }
+    }
+} {}
+test namespace-old-7.2 {uplevel can access namespace call frame} {
+    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
+         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
+} {1 1}
+test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
+    lsort [test_ns_uplevel::test_uplevel 2]
+} {a b num}
+test namespace-old-7.4 {uplevel can go up to global context} {
+    expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
+} {1}
+
+test namespace-old-7.5 {absolute call frame references work too} {
+    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
+         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
+} {1 1}
+test namespace-old-7.6 {absolute call frame references work too} {
+    lsort [test_ns_uplevel::test_uplevel #1]
+} {a b num}
+test namespace-old-7.7 {absolute call frame references work too} {
+    expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
+} {1}
+
+test namespace-old-7.8 {namespaces are included in the call stack} {
+    namespace eval test_ns_upvar {
+        variable scope "test_ns_upvar"
+
+        proc show_val {var num} {
+            upvar $num $var x
+            return $x
+        }
+        proc test_upvar {num} {
+            set scope "test_ns_upvar::test_upvar"
+            namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
+        }
+    }
+} {}
+test namespace-old-7.9 {upvar can access namespace call frame} {
+    test_ns_upvar::test_upvar 1
+} {test_ns_upvar}
+test namespace-old-7.10 {upvar can go beyond namespace call frame} {
+    test_ns_upvar::test_upvar 2
+} {test_ns_upvar::test_upvar}
+test namespace-old-7.11 {absolute call frame references work too} {
+    test_ns_upvar::test_upvar #2
+} {test_ns_upvar}
+test namespace-old-7.12 {absolute call frame references work too} {
+    test_ns_upvar::test_upvar #1
+} {test_ns_upvar::test_upvar}
+
+# -----------------------------------------------------------------------
+# TEST: variable traces across namespace boundaries
+# -----------------------------------------------------------------------
+test namespace-old-8.1 {traces work across namespace boundaries} {
+    namespace eval test_ns_trace {
+        namespace eval foo {
+            variable x ""
+        }
+
+        variable status ""
+        proc monitor {name1 name2 op} {
+            variable status
+            lappend status "$op: $name1"
+        }
+        trace variable foo::x rwu [namespace code monitor]
+    }
+    set test_ns_trace::foo::x "yes!"
+    set test_ns_trace::foo::x
+    unset test_ns_trace::foo::x
+
+    namespace eval test_ns_trace { set status }
+} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
+
+# -----------------------------------------------------------------------
+# TEST: imported commands
+# -----------------------------------------------------------------------
+test namespace-old-9.1 {empty "namespace export" list} {
+    list [catch "namespace export" msg] $msg
+} {0 {}}
+test namespace-old-9.2 {usage for "namespace export" command} {
+    list [catch "namespace export test_ns_trace::zzz" msg] $msg
+} {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
+
+test namespace-old-9.3 {define test namespaces for import} {
+    namespace eval test_ns_export {
+        namespace export cmd1 cmd2 cmd3
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+        proc cmd3 {args} {return "cmd3: $args"}
+        proc cmd4 {args} {return "cmd4: $args"}
+        proc cmd5 {args} {return "cmd5: $args"}
+        proc cmd6 {args} {return "cmd6: $args"}
+    }
+    lsort [info commands test_ns_export::*]
+} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
+
+test namespace-old-9.4 {check export status} {
+    set x ""
+    namespace eval test_ns_import {
+        namespace export cmd1 cmd2
+        namespace import ::test_ns_export::*
+    }
+    foreach cmd [lsort [info commands test_ns_import::*]] {
+        lappend x $cmd
+    }
+    set x
+} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
+
+test namespace-old-9.5 {empty import list in "namespace import" command} {
+    namespace import
+} {}
+
+test namespace-old-9.6 {empty import list for "namespace import" command} {
+    namespace import
+} {}
+
+test namespace-old-9.7 {empty forget list for "namespace forget" command} {
+    namespace forget
+} {}
+
+catch {rename cmd1 {}}
+catch {rename cmd2 {}}
+catch {rename ncmd {}}
+catch {rename ncmd1 {}}
+catch {rename ncmd2 {}}
+test namespace-old-9.8 {only exported commands are imported} {
+    namespace import test_ns_import::cmd*
+    set x [lsort [info commands cmd*]]
+} {cmd1 cmd2}
+
+test namespace-old-9.9 {imported commands work just the same as original} {
+    list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
+} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
+
+test namespace-old-9.10 {commands can be imported from many namespaces} {
+    namespace eval test_ns_import2 {
+        namespace export ncmd ncmd1 ncmd2
+        proc ncmd  {args} {return "ncmd: $args"}
+        proc ncmd1 {args} {return "ncmd1: $args"}
+        proc ncmd2 {args} {return "ncmd2: $args"}
+        proc ncmd3 {args} {return "ncmd3: $args"}
+    }
+    namespace import test_ns_import2::*
+    lsort [concat [info commands cmd*] [info commands ncmd*]]
+} {cmd1 cmd2 ncmd ncmd1 ncmd2}
+
+test namespace-old-9.11 {imported commands can be removed by deleting them} {
+    rename cmd1 ""
+    lsort [concat [info commands cmd*] [info commands ncmd*]]
+} {cmd2 ncmd ncmd1 ncmd2}
+
+test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
+    list [catch {namespace forget xyzzy::*} msg] $msg
+} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
+
+test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
+    list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
+         [lsort [info commands cmd?]]
+} {0 {} cmd2}
+
+test namespace-old-9.14 {imported commands can be removed} {
+    namespace forget test_ns_import::cmd?
+    list [lsort [info commands cmd?]] \
+         [catch {cmd1 another test} msg] $msg
+} {{} 1 {invalid command name "cmd1"}}
+
+test namespace-old-9.15 {existing commands can't be overwritten} {
+    proc cmd1 {x y} {
+        return [expr $x+$y]
+    }
+    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
+         [cmd1 3 5]
+} {1 {can't import command "cmd1": already exists} 8}
+
+test namespace-old-9.16 {use "-force" option to override existing commands} {
+    list [cmd1 3 5] \
+         [namespace import -force test_ns_import::cmd?] \
+         [cmd1 3 5]
+} {8 {} {cmd1: 3 5}}
+
+test namespace-old-9.17 {commands can be imported into many namespaces} {
+    namespace eval test_ns_import_use {
+        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
+        lsort [concat [info commands ::test_ns_import_use::cmd*] \
+                      [info commands ::test_ns_import_use::ncmd*]]
+    }
+} {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
+
+test namespace-old-9.18 {when command is deleted, imported commands go away} {
+    namespace eval test_ns_import { rename cmd1 "" }
+    list [info commands cmd1] \
+         [namespace eval test_ns_import_use {info commands cmd1}]
+} {{} {}}
+
+test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
+    namespace delete test_ns_import test_ns_import2
+    list [info commands cmd*] \
+         [info commands ncmd*] \
+         [namespace eval test_ns_import_use {info commands cmd*}] \
+         [namespace eval test_ns_import_use {info commands ncmd*}] \
+} {{} {} {} {}}
+
+# -----------------------------------------------------------------------
+# TEST: scoped values
+# -----------------------------------------------------------------------
+test namespace-old-10.1 {define namespace for scope test} {
+    namespace eval test_ns_inscope {
+        variable x "x-value"
+        proc show {args} {
+            return "show: $args"
+        }
+        proc do {args} {
+            return [eval $args]
+        }
+        list [set x] [show test]
+    }
+} {x-value {show: test}}
+
+test namespace-old-10.2 {command "namespace code" requires one argument} {
+    list [catch {namespace code} msg] $msg
+} {1 {wrong # args: should be "namespace code arg"}}
+
+test namespace-old-10.3 {command "namespace code" requires one argument} {
+    list [catch {namespace code first "second arg" third} msg] $msg
+} {1 {wrong # args: should be "namespace code arg"}}
+
+test namespace-old-10.4 {command "namespace code" gets current namesp context} {
+    namespace eval test_ns_inscope {
+        namespace code {"1 2 3" "4 5" 6}
+    }
+} {namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
+
+test namespace-old-10.5 {with one arg, first "scope" sticks} {
+    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
+    namespace code $sval
+} {namespace inscope ::test_ns_inscope {one two}}
+
+test namespace-old-10.6 {with many args, each "scope" adds new args} {
+    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
+    namespace code "$sval three"
+} {namespace inscope ::test_ns_inscope {one two} three}
+
+test namespace-old-10.7 {scoped commands work with eval} {
+    set cref [namespace eval test_ns_inscope {namespace code show}]
+    list [eval $cref "a" "b c" "d e f"]
+} {{show: a b c d e f}}
+
+test namespace-old-10.8 {scoped commands execute in namespace context} {
+    set cref [namespace eval test_ns_inscope {
+        namespace code {set x "some new value"}
+    }]
+    list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
+} {x-value {some new value} {some new value}}
+
+foreach cmd [info commands test_ns_*] {
+    rename $cmd ""
+}
+catch {rename cmd {}}
+catch {rename cmd1 {}}
+catch {rename cmd2 {}}
+catch {rename ncmd {}}
+catch {rename ncmd1 {}}
+catch {rename ncmd2 {}}
+catch {unset cref}
+catch {unset trigger}
+catch {unset trigger2}
+catch {unset sval}
+catch {unset msg}
+catch {unset x}
+catch {unset test_ns_var_global}
+catch {unset cmd}
+eval namespace delete [namespace children :: test_ns_*]
diff --git a/contrib/tcl/tests/namespace.test b/contrib/tcl/tests/namespace.test
new file mode 100644
index 0000000..c021d21
--- /dev/null
+++ b/contrib/tcl/tests/namespace.test
@@ -0,0 +1,1064 @@
+# Functionality covered: this file contains a collection of tests for the
+# procedures in tclNamesp.c that implement Tcl's basic support for
+# namespaces. Other namespace-related tests appear in variable.test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) namespace.test 1.11 97/06/23 18:24:39
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Clear out any namespaces called test_ns_*
+catch {eval namespace delete [namespace children :: test_ns_*]}
+
+test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
+    namespace children ::
+} {}
+
+catch {unset l}
+test namespace-2.1 {Tcl_GetCurrentNamespace} {
+    list [namespace current] [namespace eval {} {namespace current}] \
+        [namespace eval {} {namespace current}]
+} {:: :: ::}
+test namespace-2.2 {Tcl_GetCurrentNamespace} {
+    set l {}
+    lappend l [namespace current]
+    namespace eval test_ns_1 {
+        lappend l [namespace current]
+        namespace eval foo {
+            lappend l [namespace current]
+        }
+    }
+    lappend l [namespace current]
+    set l
+} {:: ::test_ns_1 ::test_ns_1::foo ::}
+
+test namespace-3.1 {Tcl_GetGlobalNamespace} {
+    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
+    # namespace children uses Tcl_GetGlobalNamespace 
+    namespace eval test_ns_1 {namespace children foo b*}
+} {::test_ns_1::foo::bar}
+
+test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
+    namespace eval test_ns_1 {
+        variable v 123
+        proc p {} {
+            variable v
+            return $v
+        }
+    }
+    test_ns_1::p    ;# does Tcl_PushCallFrame to push p's namespace
+} {123}
+test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
+    namespace eval test_ns_1::baz {}  ;# does Tcl_PushCallFrame to create baz
+    proc test_ns_1::baz::p {} {
+        variable v
+        set v 789
+        set v}
+    test_ns_1::baz::p
+} {789}
+
+test namespace-5.1 {Tcl_PopCallFrame, no vars} {
+    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
+} {}
+test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
+    proc test_ns_1::r {} {
+        set a 123
+    }
+    test_ns_1::r   ;# pushes then pop's r's frame
+} {123}
+
+test namespace-6.1 {Tcl_CreateNamespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [lsort [namespace children :: test_ns_*]] \
+	 [namespace eval test_ns_1 {namespace current}] \
+	 [namespace eval test_ns_2 {namespace current}] \
+	 [namespace eval ::test_ns_3 {namespace current}] \
+	 [namespace eval ::test_ns_4 \
+             {namespace eval foo {namespace current}}] \
+	 [namespace eval ::test_ns_5 \
+             {namespace eval ::test_ns_6 {namespace current}}] \
+         [lsort [namespace children :: test_ns_*]]
+} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
+test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
+    list [namespace eval :::test_ns_1::::foo {namespace current}] \
+         [namespace eval test_ns_2:::::foo {namespace current}]
+} {::test_ns_1::foo ::test_ns_2::foo}
+test namespace-6.3 {Tcl_CreateNamespace, bad namespace names} {
+    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
+} {1 {can't create namespace "": invalid name}}
+test namespace-6.4 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
+    set trigger {
+        namespace eval test_ns_2 {namespace current}
+    }
+    set l {}
+    lappend l [namespace eval test_ns_1 $trigger]
+    namespace eval test_ns_1::test_ns_2 {}
+    lappend l [namespace eval test_ns_1 $trigger]
+} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
+
+test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        proc p {} {
+            namespace delete [namespace current]
+            return [namespace current]
+        }
+    }
+    list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
+} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
+test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
+    namespace eval test_ns_2 {
+        proc p {} {
+            return [namespace current]
+        }
+    }
+    list [test_ns_2::p] [namespace delete test_ns_2]
+} {::test_ns_2 {}}
+
+test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
+    catch {interp delete test_interp}
+    interp create test_interp
+    interp eval test_interp {
+        namespace eval test_ns_1 {
+            namespace export p
+            proc p {} {
+                return [namespace current]
+            }
+        }
+        namespace eval test_ns_2 {
+            namespace import ::test_ns_1::p
+            variable v 27
+            proc q {} {
+                variable v
+                return "[p] $v"
+            }
+        }
+        set x [test_ns_2::q]
+        catch {set xxxx}
+    }
+    list [interp eval test_interp {test_ns_2::q}] \
+         [interp eval test_interp {namespace delete ::}] \
+         [catch {interp eval test_interp {set a 123}} msg] $msg \
+         [interp delete test_interp]
+} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
+test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
+    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
+    list [namespace children test_ns_1] \
+         [namespace delete test_ns_1::test_ns_2] \
+         [namespace children test_ns_1]
+} {::test_ns_1::test_ns_2 {} {}}
+test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
+    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
+    list [namespace children test_ns_1] \
+         [namespace delete test_ns_1::test_ns_2] \
+         [namespace children test_ns_1] \
+         [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
+         [info commands test_ns_1::test_ns_2::test_ns_3a::*]
+} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
+test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1 cmd2
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_import {
+        namespace import ::test_ns_export::*
+        proc p {} {return foo}
+    }
+    list [info commands test_ns_import::*] \
+         [namespace delete test_ns_export] \
+         [info commands test_ns_import::*]
+} {{::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2} {} ::test_ns_import::p}
+
+test namespace-9.1 {Tcl_Import, empty import pattern} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
+} {1 {empty import pattern}}
+test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
+    list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
+} {1 {unknown namespace in import pattern "fred::x"}}
+test namespace-9.3 {Tcl_Import, import ns == export ns} {
+    list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
+} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
+test namespace-9.4 {Tcl_Import, simple import} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_import {
+        namespace import ::test_ns_export::*
+        proc p {} {return [cmd1 123]}
+    }
+    test_ns_import::p
+} {cmd1: 123}
+test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
+    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
+} {1 {can't import command "cmd1": already exists}}
+test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
+    namespace eval test_ns_import {
+        namespace import -force ::test_ns_export::*
+        cmd1 555
+    }
+} {cmd1: 555}
+
+test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace forget xyzzy::*} msg] $msg
+} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
+test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_import {
+        namespace forget ::test_ns_export::wombat
+    }
+} {}
+test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
+    namespace eval test_ns_import {
+        namespace import ::test_ns_export::*
+        proc p {} {return [cmd1 123]}
+        set l {}
+        lappend l [info commands ::test_ns_import::*]
+        namespace forget ::test_ns_export::cmd1
+        lappend l [info commands ::test_ns_import::*]
+        lappend l [catch {cmd1 777} msg] $msg
+    }
+} {{::test_ns_import::p ::test_ns_import::cmd1} ::test_ns_import::p 1 {invalid command name "cmd1"}}
+
+test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+    }
+    list [namespace origin set] [namespace origin test_ns_export::cmd1]
+} {::set ::test_ns_export::cmd1}
+test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
+    namespace eval test_ns_import1 {
+        namespace import ::test_ns_export::*
+        namespace export *
+        proc p {} {namespace origin cmd1}
+    }
+    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
+} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
+test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
+    namespace eval test_ns_import2 {
+        namespace import ::test_ns_import1::*
+        proc q {} {return [cmd1 123]}
+    }
+    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
+} {{cmd1: 123} ::test_ns_export::cmd1}
+
+test namespace-12.1 {InvokeImportedCmd} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {namespace current}
+    }
+    namespace eval test_ns_import {
+        namespace import ::test_ns_export::*
+    }
+    list [test_ns_import::cmd1]
+} {::test_ns_export}
+
+test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
+    namespace eval test_ns_import {
+        set l {}
+        lappend l [info commands ::test_ns_import::*]
+        namespace forget ::test_ns_export::cmd1
+        lappend l [info commands ::test_ns_import::*]
+    }
+} {::test_ns_import::cmd1 {}}
+
+test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    variable v 10
+    namespace eval test_ns_1::test_ns_2 {
+        variable v 20
+    }
+    namespace eval test_ns_2 {
+        variable v 30
+    }
+    namespace eval test_ns_1 {
+        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
+             [namespace children ::]
+    }
+} {10 30 20 {::test_ns_1 ::test_ns_2}}
+test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
+    namespace eval test_ns_1 {
+        list [catch {set ::test_ns_777::v} msg] $msg \
+             [catch {namespace children test_ns_777} msg] $msg
+    }
+} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
+test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
+    namespace eval test_ns_1 {
+        list $v $test_ns_2::v
+    }
+} {10 20}
+test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
+    namespace eval test_ns_1::test_ns_2 {
+        namespace eval foo {}
+    }
+    namespace eval test_ns_1 {
+        list [namespace children test_ns_2] \
+             [catch {namespace children test_ns_1} msg] $msg
+    }
+} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
+    namespace eval ::test_ns_2 {
+        namespace eval bar {}
+    }
+    namespace eval test_ns_1 {
+        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
+    }
+    set l
+} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
+test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
+    namespace eval test_ns_1::test_ns_2 {
+        namespace eval foo {}
+    }
+    namespace eval test_ns_1 {
+        list [namespace children test_ns_2] \
+             [catch {namespace children test_ns_1} msg] $msg
+    }
+} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
+    namespace children test_ns_1:::
+} {::test_ns_1::test_ns_2}
+test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
+    namespace children :::test_ns_1:::::test_ns_2:::
+} {::test_ns_1::test_ns_2::foo}
+test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
+    set l {}
+    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
+    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
+    lappend l [set test_ns_1::test_ns_2::]
+} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
+test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
+    catch {unset test_ns_1::test_ns_2::}
+    set l {}
+    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
+    set test_ns_1::test_ns_2:: 314159
+    lappend l [set test_ns_1::test_ns_2::]
+} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
+test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
+    catch {rename test_ns_1::test_ns_2:: {}}
+    set l {}
+    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
+    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
+    lappend l [test_ns_1::test_ns_2:: hello]
+} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
+test namespace-14.12 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
+} {1 {can't create namespace "": invalid name}}
+
+test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_delete {
+        namespace eval test_ns_delete2 {}
+        proc cmd {args} {namespace current}
+    }
+    list [namespace delete ::test_ns_delete::test_ns_delete2] \
+         [namespace children ::test_ns_delete]
+} {{} {}}
+test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
+    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
+} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
+test namespace-15.3 {Tcl_FindNamespace, relative name found} {
+    namespace eval test_ns_delete {
+        namespace eval test_ns_delete2 {}
+        namespace eval test_ns_delete3 {}
+        list [namespace delete test_ns_delete2] \
+             [namespace children [namespace current]]
+    }
+} {{} ::test_ns_delete::test_ns_delete3}
+test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
+    namespace eval test_ns_delete2 {}
+    namespace eval test_ns_delete {
+        list [catch {namespace delete test_ns_delete2} msg] $msg
+    }
+} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
+
+test namespace-16.1 {Tcl_FindCommand, absolute name found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        proc cmd {args} {return "[namespace current]::cmd: $args"}
+        variable v "::test_ns_1::cmd"
+        eval $v one
+    }
+} {::test_ns_1::cmd: one}
+test namespace-16.2 {Tcl_FindCommand, absolute name found} {
+    eval $test_ns_1::v two
+} {::test_ns_1::cmd: two}
+test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
+    namespace eval test_ns_1 {
+        variable v2 "::test_ns_1::ladidah"
+        list [catch {eval $v2} msg] $msg
+    }
+} {1 {invalid command name "::test_ns_1::ladidah"}}
+
+# save the "unknown" proc, which is redefined by the following two tests
+catch {rename unknown unknown.old}
+proc unknown {args} {
+    return "unknown: $args"
+}
+test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
+    ::test_ns_1::foobar x y z
+} {unknown: ::test_ns_1::foobar x y z}
+test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
+    ::foobar 1 2 3 4 5
+} {unknown: ::foobar 1 2 3 4 5}
+test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
+    test_ns_1::foobar x y z
+} {unknown: test_ns_1::foobar x y z}
+test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
+    foobar 1 2 3 4 5
+} {unknown: foobar 1 2 3 4 5}
+# restore the "unknown" proc saved previously
+catch {rename unknown {}}
+catch {rename unknown.old unknown}
+
+test namespace-16.8 {Tcl_FindCommand, relative name found} {
+    namespace eval test_ns_1 {
+        cmd a b c
+    }
+} {::test_ns_1::cmd: a b c}
+test namespace-16.9 {Tcl_FindCommand, relative name found} {
+    catch {rename cmd2 {}}
+    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
+    namespace eval test_ns_1 {
+       cmd2 a b c
+    }
+} {::::cmd2: a b c}
+test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
+    namespace eval test_ns_1 {
+        proc cmd2 {args} {
+            return "[namespace current]::cmd2 in test_ns_1: $args"
+        }
+        namespace eval test_ns_12 {
+            cmd2 a b c
+        }
+    }
+} {::::cmd2: a b c}
+test namespace-16.11 {Tcl_FindCommand, relative name not found} {
+    namespace eval test_ns_1 {
+       list [catch {cmd3 a b c} msg] $msg
+    }
+} {1 {invalid command name "cmd3"}}
+
+catch {unset x}
+test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    set x 314159
+    namespace eval test_ns_1 {
+        set ::x
+    }
+} {314159}
+test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
+    namespace eval test_ns_1 {
+        variable x 777
+        set ::test_ns_1::x
+    }
+} {777}
+test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
+    namespace eval test_ns_1 {
+        namespace eval test_ns_2 {
+            variable x 1111
+        }
+        set ::test_ns_1::test_ns_2::x
+    }
+} {1111}
+test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
+    namespace eval test_ns_1 {
+        namespace eval test_ns_2 {
+            variable x 1111
+        }
+        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
+    }
+} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
+test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
+    namespace eval test_ns_1 {
+        namespace eval test_ns_3 {
+            variable ::test_ns_1::test_ns_2::x 2222
+        }
+    }
+    set ::test_ns_1::test_ns_2::x
+} {2222}
+test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
+    namespace eval test_ns_1 {
+        set x
+    }
+} {777}
+test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
+    namespace eval test_ns_1 {
+        unset x
+        set x  ;# must be global x now
+    }
+} {314159}
+test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
+    namespace eval test_ns_1 {
+        list [catch {set wuzzat} msg] $msg
+    }
+} {1 {can't read "wuzzat": no such variable}}
+test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
+    namespace eval test_ns_1 {
+        variable a hello
+    }
+    set test_ns_1::a
+} {hello}
+catch {unset x}
+
+catch {unset l}
+catch {rename foo {}}
+test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    proc foo {} {return "global foo"}
+    namespace eval test_ns_1 {
+        proc trigger {} {
+            return [foo]
+        }
+    }
+    set l ""
+    lappend l [test_ns_1::trigger]
+    namespace eval test_ns_1 {
+        # force invalidation of cached ref to "foo" in proc trigger
+        proc foo {} {return "foo in test_ns_1"}
+    }
+    lappend l [test_ns_1::trigger]
+    set l
+} {{global foo} {foo in test_ns_1}}
+test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
+    namespace eval test_ns_2 {
+        proc foo {} {return "foo in ::test_ns_2"}
+    }
+    namespace eval test_ns_1 {
+        namespace eval test_ns_2 {}
+        proc trigger {} {
+            return [test_ns_2::foo]
+        }
+    }
+    set l ""
+    lappend l [test_ns_1::trigger]
+    namespace eval test_ns_1 {
+        namespace eval test_ns_2 {
+            # force invalidation of cached ref to "foo" in proc trigger
+            proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
+        }
+    }
+    lappend l [test_ns_1::trigger]
+    set l
+} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
+catch {unset l}
+catch {rename foo {}}
+
+test namespace-19.1 {GetNamespaceFromObj, global name found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+    namespace children ::test_ns_1
+} {::test_ns_1::test_ns_2}
+test namespace-19.2 {GetNamespaceFromObj, relative name found} {
+    namespace eval test_ns_1 {
+        namespace children test_ns_2
+    }
+} {}
+test namespace-19.3 {GetNamespaceFromObj, name not found} {
+    namespace eval test_ns_1 {
+        list [catch {namespace children test_ns_99} msg] $msg
+    }
+} {1 {unknown namespace "test_ns_99" in namespace children command}}
+test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
+    namespace eval test_ns_1 {
+        proc foo {} {
+            return [namespace children test_ns_2]
+        }
+        list [catch {namespace children test_ns_99} msg] $msg
+    }
+    set l {}
+    lappend l [test_ns_1::foo]
+    namespace delete test_ns_1::test_ns_2
+    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
+    lappend l [test_ns_1::foo]
+    set l
+} {{} ::test_ns_1::test_ns_2::test_ns_3}
+
+test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace} msg] $msg
+} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
+test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
+    list [catch {namespace wombat {}} msg] $msg
+} {1 {bad namespace subcommand "wombat": should be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
+    namespace ch ::
+} {}
+
+test namespace-21.1 {NamespaceChildrenCmd, no args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+    namespace children
+} {::test_ns_1}
+test namespace-21.2 {NamespaceChildrenCmd, no args} {
+    namespace eval test_ns_1 {
+        namespace children
+    }
+} {::test_ns_1::test_ns_2}
+test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
+    namespace children ::test_ns_1
+} {::test_ns_1::test_ns_2}
+test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
+    namespace eval test_ns_1 {
+        namespace children test_ns_2
+    }
+} {}
+test namespace-21.5 {NamespaceChildrenCmd, too many args} {
+    namespace eval test_ns_1 {
+        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
+    }
+} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
+test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
+    namespace eval test_ns_1::test_ns_foo {}
+    namespace children test_ns_1 *f*
+} {::test_ns_1::test_ns_foo}
+test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
+    namespace eval test_ns_1::test_ns_foo {}
+    namespace children test_ns_1 test*
+} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
+
+test namespace-22.1 {NamespaceCodeCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace code} msg] $msg \
+         [catch {namespace code xxx yyy} msg] $msg
+} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
+test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
+    namespace eval test_ns_1 {
+        proc cmd {} {return "test_ns_1::cmd"}
+    }
+    namespace code {namespace inscope ::test_ns_1 cmd}
+} {namespace inscope ::test_ns_1 cmd}
+test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
+    namespace code {namespace     inscope     ::test_ns_1 cmd}
+} {namespace     inscope     ::test_ns_1 cmd}
+test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
+    namespace code unknown
+} {namespace inscope :: unknown}
+test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
+    namespace eval test_ns_1 {
+        namespace code cmd
+    }
+} {namespace inscope ::test_ns_1 cmd}
+
+test namespace-23.1 {NamespaceCurrentCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace current xxx} msg] $msg \
+         [catch {namespace current xxx yyy} msg] $msg
+} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
+test namespace-23.2 {NamespaceCurrentCmd, at global level} {
+    namespace current
+} {::}
+test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
+    namespace eval test_ns_1::test_ns_2 {
+        namespace current
+    }
+} {::test_ns_1::test_ns_2}
+
+test namespace-24.1 {NamespaceDeleteCmd, no args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace delete
+} {}
+test namespace-24.2 {NamespaceDeleteCmd, one arg} {
+    namespace eval test_ns_1::test_ns_2 {}
+    namespace delete ::test_ns_1
+} {}
+test namespace-24.3 {NamespaceDeleteCmd, two args} {
+    namespace eval test_ns_1::test_ns_2 {}
+    list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
+} {{} {}}
+test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
+    list [catch {namespace delete ::test_ns_foo} msg] $msg
+} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
+
+test namespace-25.1 {NamespaceEvalCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace eval} msg] $msg
+} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
+test namespace-25.2 {NamespaceEvalCmd, bad args} {
+    list [catch {namespace test_ns_1} msg] $msg
+} {1 {bad namespace subcommand "test_ns_1": should be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+catch {unset v}
+test namespace-25.3 {NamespaceEvalCmd, new namespace} {
+    set v 123
+    namespace eval test_ns_1 {
+        variable v 314159
+        proc p {} {
+            variable v
+            return $v
+        }
+    }
+    test_ns_1::p
+} {314159}
+test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
+    namespace eval test_ns_1 {
+        proc q {} {return [expr {[p]+1}]}
+    }
+    test_ns_1::q
+} {314160}
+test namespace-25.5 {NamespaceEvalCmd, multiple args} {
+    namespace eval test_ns_1 "set" "v"
+} {314159}
+test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
+    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
+} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
+    while executing
+"xxxx"
+    (in namespace eval "::test_ns_1" script line 1)
+    invoked from within
+"namespace eval test_ns_1 {xxxx}"}}
+catch {unset v}
+
+test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace export
+} {}
+test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
+    namespace export -clear
+} {}
+test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
+    namespace eval test_ns_1 {
+        list [catch {namespace export ::zzz} msg] $msg
+    }
+} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
+test namespace-26.4 {NamespaceExportCmd, one pattern} {
+    namespace eval test_ns_1 {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+        proc cmd3 {args} {return "cmd3: $args"}
+        proc cmd4 {args} {return "cmd4: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace import ::test_ns_1::*
+    }
+    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
+} {::test_ns_2::cmd1 {cmd1: hello}}
+test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
+    namespace eval test_ns_1 {
+        namespace export cmd1 cmd3
+    }
+    namespace eval test_ns_2 {
+        namespace import -force ::test_ns_1::*
+    }
+    list [info commands test_ns_2::*] [test_ns_2::cmd3 hello]
+} {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
+test namespace-26.6 {NamespaceExportCmd, no patterns means return export list} {
+    namespace eval test_ns_1 {
+        namespace export
+    }
+} {cmd1 cmd1 cmd3}
+test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
+    namespace eval test_ns_1 {
+        namespace export -clear cmd4
+    }
+    namespace eval test_ns_2 {
+        namespace import ::test_ns_1::*
+    }
+    list [info commands test_ns_2::*] [test_ns_2::cmd4 hello]
+} {{::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd4: hello}}
+
+test namespace-27.1 {NamespaceForgetCmd, no args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace forget
+} {}
+test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
+    list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
+} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
+test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
+    namespace eval test_ns_1 {
+        namespace export cmd*
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace import ::test_ns_1::*
+        namespace forget ::test_ns_1::cmd1
+    }
+    info commands ::test_ns_2::*
+} {::test_ns_2::cmd2}
+
+test namespace-28.1 {NamespaceImportCmd, no args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace import
+} {}
+test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
+    namespace import -force
+} {}
+test namespace-28.3 {NamespaceImportCmd, arg is imported} {
+    namespace eval test_ns_1 {
+        namespace export cmd2
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace import ::test_ns_1::*
+        namespace forget ::test_ns_1::cmd1
+    }
+    info commands test_ns_2::*
+} {::test_ns_2::cmd2}
+
+test namespace-29.1 {NamespaceInscopeCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace inscope} msg] $msg
+} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
+test namespace-29.2 {NamespaceInscopeCmd, bad args} {
+    list [catch {namespace inscope ::} msg] $msg
+} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
+test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
+    list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
+} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
+test namespace-29.4 {NamespaceInscopeCmd, simple case} {
+    namespace eval test_ns_1 {
+        variable v 747
+        proc cmd {args} {
+            variable v
+            return "[namespace current]::cmd: v=$v, args=$args"
+        }
+    }
+    namespace inscope test_ns_1 cmd
+} {::test_ns_1::cmd: v=747, args=}
+test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
+    list [namespace inscope test_ns_1 cmd x y z] \
+         [namespace eval test_ns_1 [concat cmd [list x y z]]]
+} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
+
+test namespace-30.1 {NamespaceOriginCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace origin} msg] $msg
+} {1 {wrong # args: should be "namespace origin name"}}
+test namespace-30.2 {NamespaceOriginCmd, bad args} {
+    list [catch {namespace origin x y} msg] $msg
+} {1 {wrong # args: should be "namespace origin name"}}
+test namespace-30.3 {NamespaceOriginCmd, command not found} {
+    list [catch {namespace origin fred} msg] $msg
+} {1 {invalid command name "fred"}}
+test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
+    namespace origin set
+} {::set}
+test namespace-30.5 {NamespaceOriginCmd, imported command} {
+    namespace eval test_ns_1 {
+        namespace export cmd*
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace export *
+        namespace import ::test_ns_1::*
+        proc p {} {}
+    }
+    namespace eval test_ns_3 {
+        namespace import ::test_ns_2::*
+        list [namespace origin foreach] \
+             [namespace origin p] \
+             [namespace origin cmd1] \
+             [namespace origin ::test_ns_2::cmd2]
+    }
+} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
+
+test namespace-31.1 {NamespaceParentCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace parent a b} msg] $msg
+} {1 {wrong # args: should be "namespace parent ?name?"}}
+test namespace-31.2 {NamespaceParentCmd, no args} {
+    namespace parent
+} {}
+test namespace-31.3 {NamespaceParentCmd, namespace specified} {
+    namespace eval test_ns_1 {
+        namespace eval test_ns_2 {
+            namespace eval test_ns_3 {}
+        }
+    }
+    list [namespace parent ::] \
+         [namespace parent test_ns_1::test_ns_2] \
+         [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
+} {{} ::test_ns_1 ::test_ns_1}
+test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
+    list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
+} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
+
+test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace qualifiers} msg] $msg
+} {1 {wrong # args: should be "namespace qualifiers string"}}
+test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
+    list [catch {namespace qualifiers x y} msg] $msg
+} {1 {wrong # args: should be "namespace qualifiers string"}}
+test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
+    namespace qualifiers foo
+} {}
+test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
+    namespace qualifiers ::x::y::z
+} {::x::y}
+test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
+    namespace qualifiers a::b
+} {a}
+test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
+    namespace qualifiers ::
+} {}
+test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
+    namespace qualifiers :::::
+} {}
+test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
+    namespace qualifiers foo:::
+} {foo}
+
+test namespace-33.1 {NamespaceTailCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace tail} msg] $msg
+} {1 {wrong # args: should be "namespace tail string"}}
+test namespace-33.2 {NamespaceTailCmd, bad args} {
+    list [catch {namespace tail x y} msg] $msg
+} {1 {wrong # args: should be "namespace tail string"}}
+test namespace-33.3 {NamespaceTailCmd, simple name} {
+    namespace tail foo
+} {foo}
+test namespace-33.4 {NamespaceTailCmd, leading ::} {
+    namespace tail ::x::y::z
+} {z}
+test namespace-33.5 {NamespaceTailCmd, no leading ::} {
+    namespace tail a::b
+} {b}
+test namespace-33.6 {NamespaceTailCmd, :: argument} {
+    namespace tail ::
+} {}
+test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
+    namespace tail :::::
+} {}
+test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
+    namespace tail foo:::
+} {}
+
+test namespace-34.1 {NamespaceWhichCmd, bad args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {namespace which} msg] $msg
+} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
+test namespace-34.2 {NamespaceWhichCmd, bad args} {
+    list [catch {namespace which -fred} msg] $msg
+} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
+test namespace-34.3 {NamespaceWhichCmd, bad args} {
+    list [catch {namespace which -command} msg] $msg
+} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
+test namespace-34.4 {NamespaceWhichCmd, bad args} {
+    list [catch {namespace which a b} msg] $msg
+} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
+test namespace-34.5 {NamespaceWhichCmd, command lookup} {
+    namespace eval test_ns_1 {
+        namespace export cmd*
+        variable v1 111
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace export *
+        namespace import ::test_ns_1::*
+        variable v2 222
+        proc p {} {}
+    }
+    namespace eval test_ns_3 {
+        namespace import ::test_ns_2::*
+        variable v3 333
+        list [namespace which -command foreach] \
+             [namespace which -command p] \
+             [namespace which -command cmd1] \
+             [namespace which -command ::test_ns_2::cmd2] \
+             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
+    }
+} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
+test namespace-34.6 {NamespaceWhichCmd, -command is default} {
+    namespace eval test_ns_3 {
+        list [namespace which foreach] \
+             [namespace which p] \
+             [namespace which cmd1] \
+             [namespace which ::test_ns_2::cmd2]
+    }
+} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
+test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
+    namespace eval test_ns_3 {
+        list [namespace which -variable env] \
+             [namespace which -variable v3] \
+             [namespace which -variable ::test_ns_2::v2] \
+             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
+    }
+} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
+
+test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        proc p {} {
+            namespace delete [namespace current]
+            return [namespace current]
+        }
+    }
+    test_ns_1::p
+} {::test_ns_1}
+test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
+    namespace eval test_ns_1 {
+        proc q {} {
+            return [namespace current]
+        }
+    }
+    list [test_ns_1::q] \
+         [namespace delete test_ns_1] \
+         [catch {test_ns_1::q} msg] $msg
+} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
+
+catch {unset x}
+catch {unset y}
+test namespace-36.1 {DupNsNameInternalRep} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {}
+    set x "::test_ns_1"
+    list [namespace parent $x] [set y $x] [namespace parent $y]
+} {:: ::test_ns_1 ::}
+catch {unset x}
+catch {unset y}
+
+test namespace-37.1 {SetNsNameFromAny, ns name found} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+    namespace eval test_ns_1 {
+        namespace children ::test_ns_1
+    }
+} {::test_ns_1::test_ns_2}
+test namespace-37.2 {SetNsNameFromAny, ns name not found} {
+    namespace eval test_ns_1 {
+        list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
+    }
+} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
+
+test namespace-38.1 {UpdateStringOfNsName} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
+    list [namespace eval {} {namespace current}] \
+         [namespace eval {} {namespace current}]
+} {:: ::}
+
+catch {rename cmd1 {}}
+catch {unset l}
+catch {unset msg}
+catch {unset trigger}
+eval namespace delete [namespace children :: test_ns_*]
diff --git a/contrib/tcl/tests/obj.test b/contrib/tcl/tests/obj.test
new file mode 100644
index 0000000..cc8ea3c
--- /dev/null
+++ b/contrib/tcl/tests/obj.test
@@ -0,0 +1,496 @@
+# Functionality covered: this file contains a collection of tests for the
+# procedures in tclObj.c that implement Tcl's basic type support and the
+# type managers for the types boolean, double, and integer.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1995-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.
+#
+# @(#) obj.test 1.10 97/05/19 14:38:29
+
+if {[info commands testobj] == {}} {
+    puts "This application hasn't been compiled with the \"testobj\""
+    puts "command, so I can't test the Tcl type and object support."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
+    set r 1
+    foreach {t} {list boolean cmdName bytecode string int double} {
+        set first [string first $t [testobj types]]
+        set r [expr {$r && ($first != -1)}]
+    }
+    set result $r
+} {1}
+
+test obj-2.1 {Tcl_GetObjType error} {
+    list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
+} {0 1 {no type foo found}}
+test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 12]
+    lappend result [testobj convert 1 double]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 12 12 double 3}
+
+test obj-3.1 {Tcl_ConvertToType error} {
+    list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
+} {12.34 1 {expected integer but got "12.34"}}
+test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
+    list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
+} {{} 1 {expected integer but got ""}}
+
+test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} {} string 2}
+
+test obj-5.1 {Tcl_FreeObj} {
+    set result ""
+    lappend result [testintobj set 1 12345]
+    lappend result [testobj freeallvars]
+    lappend result [catch {testintobj get 1} msg]
+    lappend result $msg
+} {12345 {} 1 {variable 1 is unset (NULL)}}
+
+test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 47]
+    lappend result [testobj duplicate 1 2]    
+    lappend result [testintobj get 2]
+    lappend result [testobj refcount 1]
+    lappend result [testobj refcount 2]
+} {{} 47 47 47 2 3}
+test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [testobj duplicate 1 2]    
+    lappend result [testintobj get 2]
+    lappend result [testobj refcount 1]
+    lappend result [testobj refcount 2]
+} {{} {} {} {} 2 3}
+
+test obj-7.1 {Tcl_GetStringFromObj, return existing string rep} {
+    set result ""
+    lappend result [testintobj set 1 47]
+    lappend result [testintobj get 1]
+} {47 47}
+test obj-7.2 {Tcl_GetStringFromObj, "empty string" object} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [teststringobj append 1 abc -1]
+    lappend result [teststringobj get 1]
+} {{} abc abc}
+test obj-7.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
+    set result ""
+    lappend result [teststringobj set 1 xyz]
+    lappend result [teststringobj append 1 abc -1]
+    lappend result [teststringobj get 1]
+} {xyz xyzabc xyzabc}
+test obj-7.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
+    set result ""
+    lappend result [testintobj set 1 77]
+    lappend result [testintobj mult10 1]
+    lappend result [teststringobj get 1]
+} {77 770 770}
+
+test obj-8.1 {Tcl_NewBooleanObj} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testbooleanobj set 1 0]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 0 boolean 2}
+
+test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [testbooleanobj set 1 0]  ;# makes existing obj boolean
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} {} 0 boolean 2}
+test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 98765]
+    lappend result [testbooleanobj set 1 1]  ;# makes existing obj boolean
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 98765 1 boolean 2}
+
+test obj-10.1 {Tcl_GetBooleanFromObj, existing boolean object} {
+    set result ""
+    lappend result [testbooleanobj set 1 1]
+    lappend result [testbooleanobj not 1]    ;# gets existing boolean rep
+} {1 0}
+test obj-10.2 {Tcl_GetBooleanFromObj, convert to boolean} {
+    set result ""
+    lappend result [testintobj set 1 47]
+    lappend result [testbooleanobj not 1]    ;# must convert to bool
+    lappend result [testobj type 1]
+} {47 0 boolean}
+test obj-10.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testbooleanobj not 1} msg]
+    lappend result $msg
+} {abc 1 {expected boolean value but got "abc"}}
+test obj-10.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testbooleanobj not 1} msg]
+    lappend result $msg
+} {{} 1 {expected boolean value but got ""}}
+
+test obj-11.1 {DupBooleanInternalRep} {
+    set result ""
+    lappend result [testbooleanobj set 1 1]
+    lappend result [testobj duplicate 1 2]   ;# uses DupBooleanInternalRep
+    lappend result [testbooleanobj get 2]
+} {1 1 1}
+
+test obj-12.1 {SetBooleanFromAny, int to boolean special case} {
+    set result ""
+    lappend result [testintobj set 1 1234]
+    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
+    lappend result [testobj type 1]
+} {1234 0 boolean}
+test obj-12.2 {SetBooleanFromAny, double to boolean special case} {
+    set result ""
+    lappend result [format %.6g [testdoubleobj set 1 3.14159]]
+    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
+    lappend result [testobj type 1]
+} {3.14159 0 boolean}
+test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} {
+    set result ""
+    foreach s {yes no true false on off} {
+        teststringobj set 1 $s
+        lappend result [testbooleanobj not 1]
+    }
+    lappend result [testobj type 1]
+} {0 1 0 1 0 1 boolean}
+test obj-12.4 {SetBooleanFromAny, recompute string rep then parse it} {
+    set result ""
+    lappend result [testintobj set 1 456]
+    lappend result [testintobj div10 1]
+    lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
+    lappend result [testobj type 1]
+} {456 45 0 boolean}
+test obj-12.5 {SetBooleanFromAny, error parsing string} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testbooleanobj not 1} msg]
+    lappend result $msg
+} {abc 1 {expected boolean value but got "abc"}}
+test obj-12.6 {SetBooleanFromAny, error parsing string} {
+    set result ""
+    lappend result [teststringobj set 1 x1.0]
+    lappend result [catch {testbooleanobj not 1} msg]
+    lappend result $msg
+} {x1.0 1 {expected boolean value but got "x1.0"}}
+test obj-12.7 {SetBooleanFromAny, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testbooleanobj not 1} msg]
+    lappend result $msg
+} {{} 1 {expected boolean value but got ""}}
+
+test obj-13.1 {UpdateStringOfBoolean} {
+    set result ""
+    lappend result [testbooleanobj set 1 0]
+    lappend result [testbooleanobj not 1]
+    lappend result [testbooleanobj get 1]    ;# must update string rep
+} {0 1 1}
+
+test obj-14.1 {Tcl_NewDoubleObj} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [format %.6g [testdoubleobj set 1 3.1459]]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 3.1459 double 1}
+
+test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [testdoubleobj set 1 0.123]  ;# makes existing obj boolean
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} {} 0.123 double 2}
+test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 98765]
+    lappend result [format %.6g [testdoubleobj set 1 27.56]]  ;# makes existing obj double
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 98765 27.56 double 1}
+
+test obj-16.1 {Tcl_GetDoubleFromObj, existing double object} {
+    set result ""
+    lappend result [format %.6g [testdoubleobj set 1 16.1]]
+    lappend result [testdoubleobj mult10 1]   ;# gets existing double rep
+} {16.1 161.0}
+test obj-16.2 {Tcl_GetDoubleFromObj, convert to double} {
+    set result ""
+    lappend result [testintobj set 1 477]
+    lappend result [format %.6g [testdoubleobj div10 1]]    ;# must convert to bool
+    lappend result [testobj type 1]
+} {477 47.7 double}
+test obj-16.3 {Tcl_GetDoubleFromObj, error converting to double} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testdoubleobj mult10 1} msg]
+    lappend result $msg
+} {abc 1 {expected floating-point number but got "abc"}}
+test obj-16.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testdoubleobj div10 1} msg]
+    lappend result $msg
+} {{} 1 {expected floating-point number but got ""}}
+
+test obj-17.1 {DupDoubleInternalRep} {
+    set result ""
+    lappend result [format %.6g [testdoubleobj set 1 17.1]]
+    lappend result [format %.6g [testobj duplicate 1 2]]      ;# uses DupDoubleInternalRep
+    lappend result [format %.6g [testdoubleobj get 2]]
+} {17.1 17.1 17.1}
+
+test obj-18.1 {SetDoubleFromAny, int to double special case} {
+    set result ""
+    lappend result [testintobj set 1 1234]
+    lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
+    lappend result [testobj type 1]
+} {1234 12340.0 double}
+test obj-18.2 {SetDoubleFromAny, boolean to double special case} {
+    set result ""
+    lappend result [testbooleanobj set 1 1]
+    lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
+    lappend result [testobj type 1]
+} {1 10.0 double}
+test obj-18.3 {SetDoubleFromAny, recompute string rep then parse it} {
+    set result ""
+    lappend result [testintobj set 1 456]
+    lappend result [testintobj div10 1]
+    lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
+    lappend result [testobj type 1]
+} {456 45 450.0 double}
+test obj-18.4 {SetDoubleFromAny, error parsing string} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testdoubleobj mult10 1} msg]
+    lappend result $msg
+} {abc 1 {expected floating-point number but got "abc"}}
+test obj-18.5 {SetDoubleFromAny, error parsing string} {
+    set result ""
+    lappend result [teststringobj set 1 x1.0]
+    lappend result [catch {testdoubleobj mult10 1} msg]
+    lappend result $msg
+} {x1.0 1 {expected floating-point number but got "x1.0"}}
+test obj-18.6 {SetDoubleFromAny, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testdoubleobj div10 1} msg]
+    lappend result $msg
+} {{} 1 {expected floating-point number but got ""}}
+
+test obj-19.1 {UpdateStringOfDouble} {
+    set result ""
+    lappend result [format %.6g [testdoubleobj set 1 3.14159]]
+    lappend result [format %.6g [testdoubleobj mult10 1]]
+    lappend result [format %.6g [testdoubleobj get 1]]   ;# must update string rep
+} {3.14159 31.4159 31.4159}
+
+test obj-20.1 {Tcl_NewIntObj} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 55]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 55 int 2}
+
+test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [testintobj set 1 77]  ;# makes existing obj int
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} {} 77 int 2}
+test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testdoubleobj set 1 12.34]
+    lappend result [testintobj set 1 77]  ;# makes existing obj int
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 12.34 77 int 2}
+
+test obj-22.1 {Tcl_GetIntFromObj, existing int object} {
+    set result ""
+    lappend result [testintobj set 1 22]
+    lappend result [testintobj mult10 1]   ;# gets existing int rep
+} {22 220}
+test obj-22.2 {Tcl_GetIntFromObj, convert to int} {
+    set result ""
+    lappend result [testintobj set 1 477]
+    lappend result [testintobj div10 1]    ;# must convert to bool
+    lappend result [testobj type 1]
+} {477 47 int}
+test obj-22.3 {Tcl_GetIntFromObj, error converting to int} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testintobj mult10 1} msg]
+    lappend result $msg
+} {abc 1 {expected integer but got "abc"}}
+test obj-22.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testintobj div10 1} msg]
+    lappend result $msg
+} {{} 1 {expected integer but got ""}}
+test obj-22.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [testintobj inttoobigtest 1]
+} {{} 1}
+
+test obj-23.1 {DupIntInternalRep} {
+    set result ""
+    lappend result [testintobj set 1 23]
+    lappend result [testobj duplicate 1 2]    ;# uses DupIntInternalRep
+    lappend result [testintobj get 2]
+} {23 23 23}
+
+test obj-24.1 {SetIntFromAny, int to int special case} {
+    set result ""
+    lappend result [testintobj set 1 1234]
+    lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
+    lappend result [testobj type 1]
+} {1234 12340 int}
+test obj-24.2 {SetIntFromAny, boolean to int special case} {
+    set result ""
+    lappend result [testbooleanobj set 1 1]
+    lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
+    lappend result [testobj type 1]
+} {1 10 int}
+test obj-24.3 {SetIntFromAny, recompute string rep then parse it} {
+    set result ""
+    lappend result [testintobj set 1 456]
+    lappend result [testintobj div10 1]
+    lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
+    lappend result [testobj type 1]
+} {456 45 450 int}
+test obj-24.4 {SetIntFromAny, error parsing string} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testintobj mult10 1} msg]
+    lappend result $msg
+} {abc 1 {expected integer but got "abc"}}
+test obj-24.5 {SetIntFromAny, error parsing string} {
+    set result ""
+    lappend result [teststringobj set 1 x17]
+    lappend result [catch {testintobj mult10 1} msg]
+    lappend result $msg
+} {x17 1 {expected integer but got "x17"}}
+test obj-24.6 {SetIntFromAny, integer too large} {nonPortable} {
+    set result ""
+    lappend result [teststringobj set 1 12345678901234567890]
+    lappend result [catch {testintobj mult10 1} msg]
+    lappend result $msg
+} {12345678901234567890 1 {integer value too large to represent}}
+test obj-24.7 {SetIntFromAny, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testintobj div10 1} msg]
+    lappend result $msg
+} {{} 1 {expected integer but got ""}}
+
+test obj-25.1 {UpdateStringOfInt} {
+    set result ""
+    lappend result [testintobj set 1 512]
+    lappend result [testintobj mult10 1]
+    lappend result [testintobj get 1]       ;# must update string rep
+} {512 5120 5120}
+
+test obj-26.1 {Tcl_NewLongObj} {
+    set result ""
+    lappend result [testobj freeallvars]
+    testintobj setmaxlong 1
+    lappend result [testintobj ismaxlong 1]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 1 int 1}
+
+test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} {} 77 int 2}
+test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testdoubleobj set 1 12.34]
+    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 12.34 77 int 2}
+
+test obj-28.1 {Tcl_GetLongFromObj, existing long integer object} {
+    set result ""
+    lappend result [testintobj setlong 1 22]
+    lappend result [testintobj mult10 1]   ;# gets existing long int rep
+} {22 220}
+test obj-28.2 {Tcl_GetLongFromObj, convert to long} {
+    set result ""
+    lappend result [testintobj setlong 1 477]
+    lappend result [testintobj div10 1]    ;# must convert to bool
+    lappend result [testobj type 1]
+} {477 47 int}
+test obj-28.3 {Tcl_GetLongFromObj, error converting to long integer} {
+    set result ""
+    lappend result [teststringobj set 1 abc]
+    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
+    lappend result $msg
+} {abc 1 {expected integer but got "abc"}}
+test obj-28.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
+    set result ""
+    lappend result [testobj newobj 1]
+    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
+    lappend result $msg
+} {{} 1 {expected integer but got ""}}
+
+test obj-29.1 {Ref counting and object deletion, simple types} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 1024]
+    lappend result [testobj assign 1 2]     ;# vars 1 and 2 share the int obj
+    lappend result [testobj type 2]
+    lappend result [testobj refcount 1]
+    lappend result [testobj refcount 2]
+    lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
+    lappend result [testobj type 2]
+    lappend result [testobj refcount 1]
+    lappend result [testobj refcount 2]
+} {{} 1024 1024 int 4 4 0 boolean 3 2}
+
+testobj freeallvars
diff --git a/contrib/tcl/tests/osa.test b/contrib/tcl/tests/osa.test
new file mode 100644
index 0000000..0e94838
--- /dev/null
+++ b/contrib/tcl/tests/osa.test
@@ -0,0 +1,36 @@
+# Commands covered:  AppleScript
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) osa.test 1.4 97/06/23 18:24:24
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# This command only runs on the Macintosh, only run the test if we
+# can load the command
+if {$tcl_platform(platform) != "macintosh"} {
+    puts "skipping: Mac only tests..."
+    return
+}
+if {[info commands AppleScript] == ""} {
+    puts "couldn't find AppleScript command..."
+    return
+}
+
+test osa-1.1 {Tcl_OSAComponentCmd} {
+    list [catch AppleScript msg] $msg
+} {1 {wrong # args: should be "AppleScript option ?arg ...?"}}
+test osa-1.2 {Tcl_OSAComponentCmd} {
+    list [catch {AppleScript x} msg] $msg
+} {1 {bad option "x": should be compile, decompile, delete, execute, info, load, run or store}}
+
+test osa-1.3 {TclOSACompileCmd} {
+    list [catch {AppleScript compile} msg] $msg
+} {1 {wrong # args: should be "AppleScript compile ?options? code"}}
diff --git a/contrib/tcl/tests/parse.test b/contrib/tcl/tests/parse.test
index fa1c6f5..1241262 100644
--- a/contrib/tcl/tests/parse.test
+++ b/contrib/tcl/tests/parse.test
@@ -6,12 +6,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# 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.
 #
-# SCCS: @(#) parse.test 1.34 96/03/02 14:29:03
+# SCCS: @(#) parse.test 1.40 97/06/23 18:19:53
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -121,6 +121,11 @@ format %s $b
 ]b
     set a
 } a22b
+test parse-4.4 {command substitution} {
+    set a 7.7
+    if [catch {expr int($a)}] {set a foo}
+    set a
+} 7.7
 
 # Variable substitution.
 
@@ -209,7 +214,7 @@ catch {unset a}; catch {unset a1}
 set errNum 1
 proc bsCheck {char num} {
     global errNum
-    test parse-6.$errNum {backslash substitution} {
+;   test parse-6.$errNum {backslash substitution} {
 	scan $char %c value
 	set value
     } $num
@@ -336,22 +341,22 @@ test parse-9.3 {syntax errors} {catch {set a "bcd} msg} 1
 test parse-9.4 {syntax errors} {
 	catch {set a "bcd} msg
 	set msg
-} {missing "}
+} {quoted string doesn't terminate properly}
 test parse-9.5 {syntax errors} {catch {set a "bcd"xy} msg} 1
 test parse-9.6 {syntax errors} {
 	catch {set a "bcd"xy} msg
 	set msg
-} {extra characters after close-quote}
+} {quoted string doesn't terminate properly}
 test parse-9.7 {syntax errors} {catch "set a {bcd}xy" msg} 1
 test parse-9.8 {syntax errors} {
 	catch "set a {bcd}xy" msg
 	set msg
-} {extra characters after close-brace}
+} {argument word in braces doesn't terminate properly}
 test parse-9.9 {syntax errors} {catch {set a [format abc} msg} 1
 test parse-9.10 {syntax errors} {
 	catch {set a [format abc} msg
 	set msg
-} {missing close-bracket}
+} {missing close-bracket or close-brace}
 test parse-9.11 {syntax errors} {catch gorp-a-lot msg} 1
 test parse-9.12 {syntax errors} {
 	catch gorp-a-lot msg
@@ -366,11 +371,27 @@ test parse-9.14 {syntax errors} {
     list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
 } {1 {missing )} {missing )
     (parsing index for array "x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
-    invoked from within
+    while compiling
 "$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ..."
     ("eval" body line 1)
     invoked from within
 "eval \$x[format "%01000d" 0]("}}
+test parse-9.15 {syntax errors, missplaced braces} {
+    catch {
+        proc misplaced_end_brace {} {
+            set what foo
+            set when [expr ${what}size - [set off$what]}]
+    } msg
+    set msg
+} {wrong # args: should be "proc name args body"}
+test parse-9.16 {syntax errors, missplaced braces} {
+    catch {
+        set a {
+            set what foo
+            set when [expr ${what}size - [set off$what]}]
+    } msg
+    set msg
+} {argument word in braces doesn't terminate properly}
 
 # Long values (stressing storage management)
 
@@ -382,30 +403,30 @@ test parse-10.1 {long values} {
 test parse-10.2 {long values} {
     llength $a
 } 43
-test parse-1a1.3 {long values} {
+test parse-10.3 {long values} {
     set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH"
     set b
 } $a
-test parse-10.3 {long values} {
+test parse-10.4 {long values} {
     set b "$a"
     set b
 } $a
-test parse-10.4 {long values} {
+test parse-10.5 {long values} {
     set b [set a]
     set b
 } $a
-test parse-10.5 {long values} {
+test parse-10.6 {long values} {
     set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
     string length $b
 } 214
-test parse-10.6 {long values} {
+test parse-10.7 {long values} {
     set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
     llength $b
 } 43
-test parse-10.7 {long values} {
+test parse-10.8 {long values} {
     set b
 } $a
-test parse-10.8 {long values} {
+test parse-10.9 {long values} {
     set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ]
     llength $a
 } 62
@@ -414,11 +435,11 @@ foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cc
     set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
     set test $test$test$test$test
     set i [expr $i+1]
-    test parse-10.9 {long values} {
+    test parse-10.10 {long values} {
 	set j
     } $test
 }
-test parse-10.10 {test buffer overflow in backslashes in braces} {
+test parse-10.11 {test buffer overflow in backslashes in braces} {
     expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}}
 } 0
 
@@ -499,6 +520,21 @@ if {[info command testwordend] == "testwordend"} {
     test parse-13.16 {TclWordEnd procedure} {
 	testwordend "abc"
     } {c}
+    test parse-13.17 {TclWordEnd procedure} {
+	testwordend "a\000bc"
+    } {c}
+    test parse-13.18 {TclWordEnd procedure} {
+	testwordend \[a\000\]
+    } {]}
+    test parse-13.19 {TclWordEnd procedure} {
+	testwordend \"a\000\"
+    } {"}
+    test parse-13.20 {TclWordEnd procedure} {
+	testwordend a{\000}b
+    } {b}
+    test parse-13.21 {TclWordEnd procedure} {
+	testwordend "   \000b"
+    } {b}
 }
 
 test parse-14.1 {TclScriptEnd procedure} {
diff --git a/contrib/tcl/tests/pkg.test b/contrib/tcl/tests/pkg.test
index 66c1658..37a5b9c 100644
--- a/contrib/tcl/tests/pkg.test
+++ b/contrib/tcl/tests/pkg.test
@@ -4,18 +4,18 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1995-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.
 #
-# SCCS: @(#) pkg.test 1.6 96/03/20 10:50:27
+# SCCS: @(#) pkg.test 1.9 96/11/15 17:56:01
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
 eval package forget [package names]
 package unknown {}
-set oldPath auto_path
+set oldPath $auto_path
 set auto_path ""
 
 test pkg-1.1 {Tcl_PkgProvide procedure} {
@@ -192,7 +192,7 @@ test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
 } {1 {testing package unknown} {testing package unknown
     while executing
 "error "testing package unknown""
-    (procedure "pkgUnknown" line 2)
+    (procedure "pkgUnknown" line 1)
     invoked from within
 "pkgUnknown t {}"
     ("package unknown" script)
@@ -545,5 +545,5 @@ test pkg-6.9 {ComparePkgVersions procedure} {
     package vsatisfies 2 1
 } {0}
 
-set auto_path oldPath
+set auto_path $oldPath
 concat
diff --git a/contrib/tcl/tests/policies/globalPolicy.tcl b/contrib/tcl/tests/policies/globalPolicy.tcl
new file mode 100644
index 0000000..11904d4
--- /dev/null
+++ b/contrib/tcl/tests/policies/globalPolicy.tcl
@@ -0,0 +1,4 @@
+proc globalPolicy_PolicyInit {slave {version {}}} {
+    interp alias $slave tada {} tada $slave
+}
+proc tada {slave} {}
diff --git a/contrib/tcl/tests/policies/packages/pkgA.tcl b/contrib/tcl/tests/policies/packages/pkgA.tcl
new file mode 100644
index 0000000..d54d221
--- /dev/null
+++ b/contrib/tcl/tests/policies/packages/pkgA.tcl
@@ -0,0 +1,3 @@
+package provide packageA 1.0
+
+proc hoohum {} {return bazooka}
diff --git a/contrib/tcl/tests/policies/packages/pkgIndex.tcl b/contrib/tcl/tests/policies/packages/pkgIndex.tcl
new file mode 100644
index 0000000..5d39a66
--- /dev/null
+++ b/contrib/tcl/tests/policies/packages/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.0
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script.  It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands.  When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded packageA 1.0 [list tclPkgSetup $dir packageA 1.0 {{pkgA.tcl source hoohum}}]
diff --git a/contrib/tcl/tests/policies/policyA/policy.tcl b/contrib/tcl/tests/policies/policyA/policy.tcl
new file mode 100644
index 0000000..cfd558f
--- /dev/null
+++ b/contrib/tcl/tests/policies/policyA/policy.tcl
@@ -0,0 +1,5 @@
+proc policyA_PolicyInit {slave {version {}}} {
+    interp alias $slave tada {} tada $slave
+}
+proc tada {slave} {}
+
diff --git a/contrib/tcl/tests/policies/policyA/tclIndex b/contrib/tcl/tests/policies/policyA/tclIndex
new file mode 100644
index 0000000..5a55537
--- /dev/null
+++ b/contrib/tcl/tests/policies/policyA/tclIndex
@@ -0,0 +1,9 @@
+# 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(policyA_PolicyInit) [list source [file join $dir policy.tcl]]
diff --git a/contrib/tcl/tests/policies/policyB/policy.tcl b/contrib/tcl/tests/policies/policyB/policy.tcl
new file mode 100644
index 0000000..51ceff7
--- /dev/null
+++ b/contrib/tcl/tests/policies/policyB/policy.tcl
@@ -0,0 +1,2 @@
+proc policyB_PolicyInit {slave {version 1.0}} {
+}
diff --git a/contrib/tcl/tests/policies/policyB/tclIndex b/contrib/tcl/tests/policies/policyB/tclIndex
new file mode 100644
index 0000000..8abf6d1
--- /dev/null
+++ b/contrib/tcl/tests/policies/policyB/tclIndex
@@ -0,0 +1,9 @@
+# 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(policyB_PolicyInit) [list source [file join $dir policy.tcl]]
diff --git a/contrib/tcl/tests/policies/policyC/policy.tcl b/contrib/tcl/tests/policies/policyC/policy.tcl
new file mode 100644
index 0000000..2615b31
--- /dev/null
+++ b/contrib/tcl/tests/policies/policyC/policy.tcl
@@ -0,0 +1,7 @@
+proc policyC_PolicyInit {slave {version 1.0}} {
+}
+proc policyC_PolicyCleanup {slave} {
+    global l
+
+    lappend l bye
+}
diff --git a/contrib/tcl/tests/policies/policyC/tclIndex b/contrib/tcl/tests/policies/policyC/tclIndex
new file mode 100644
index 0000000..d56e723
--- /dev/null
+++ b/contrib/tcl/tests/policies/policyC/tclIndex
@@ -0,0 +1,10 @@
+# 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(policyC_PolicyInit) [list source [file join $dir policy.tcl]]
+set auto_index(policyC_PolicyCleanup) [list source [file join $dir policy.tcl]]
diff --git a/contrib/tcl/tests/policies/tclIndex b/contrib/tcl/tests/policies/tclIndex
new file mode 100644
index 0000000..ce2fa7f
--- /dev/null
+++ b/contrib/tcl/tests/policies/tclIndex
@@ -0,0 +1,10 @@
+# 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(globalPolicy_PolicyInit) [list source [file join $dir globalPolicy.tcl]]
+set auto_index(tada) [list source [file join $dir globalPolicy.tcl]]
diff --git a/contrib/tcl/tests/proc-old.test b/contrib/tcl/tests/proc-old.test
new file mode 100644
index 0000000..5da6335
--- /dev/null
+++ b/contrib/tcl/tests/proc-old.test
@@ -0,0 +1,505 @@
+# Commands covered:  proc, return, global
+#
+# This file, proc-old.test, includes the original set of tests for Tcl's
+# proc, return, and global commands. There is now a new file proc.test
+# that contains tests for the tclProc.c source file.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) proc-old.test 1.30 97/04/30 14:14:47
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {rename t1 ""}
+catch {rename foo ""}
+
+proc tproc {} {return a; return b}
+test proc-old-1.1 {simple procedure call and return} {tproc} a
+proc tproc x {
+    set x [expr $x+1]
+    return $x
+}
+test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
+test proc-old-1.3 {simple procedure call and return} {
+    proc tproc {} {return foo}
+} {}
+test proc-old-1.4 {simple procedure call and return} {
+    proc tproc {} {return}
+    tproc
+} {}
+proc tproc1 {a}   {incr a; return $a}
+proc tproc2 {a b} {incr a; return $a}
+test proc-old-1.5 {simple procedure call and return (2 procs with same body but different parameters)} {
+    list [tproc1 123] [tproc2 456 789]
+} {124 457}
+test proc-old-1.6 {simple procedure call and return (shared proc body string)} {
+    set x {}
+    proc tproc {} {}   ;# body is shared with x
+    list [tproc] [append x foo]
+} {{} foo}
+
+test proc-old-2.1 {local and global variables} {
+    proc tproc x {
+	set x [expr $x+1]
+	return $x
+    }
+    set x 42
+    list [tproc 6] $x
+} {7 42}
+test proc-old-2.2 {local and global variables} {
+    proc tproc x {
+	set y [expr $x+1]
+	return $y
+    }
+    set y 18
+    list [tproc 6] $y
+} {7 18}
+test proc-old-2.3 {local and global variables} {
+    proc tproc x {
+	global y
+	set y [expr $x+1]
+	return $y
+    }
+    set y 189
+    list [tproc 6] $y
+} {7 7}
+test proc-old-2.4 {local and global variables} {
+    proc tproc x {
+	global y
+	return [expr $x+$y]
+    }
+    set y 189
+    list [tproc 6] $y
+} {195 189}
+catch {unset _undefined_}
+test proc-old-2.5 {local and global variables} {
+    proc tproc x {
+	global _undefined_
+	return $_undefined_
+    }
+    list [catch {tproc xxx} msg] $msg
+} {1 {can't read "_undefined_": no such variable}}
+test proc-old-2.6 {local and global variables} {
+    set a 114
+    set b 115
+    global a b
+    list $a $b
+} {114 115}
+
+proc do {cmd} {eval $cmd}
+test proc-old-3.1 {local and global arrays} {
+    catch {unset a}
+    set a(0) 22
+    list [catch {do {global a; set a(0)}} msg] $msg
+} {0 22}
+test proc-old-3.2 {local and global arrays} {
+    catch {unset a}
+    set a(x) 22
+    list [catch {do {global a; set a(x) newValue}} msg] $msg $a(x)
+} {0 newValue newValue}
+test proc-old-3.3 {local and global arrays} {
+    catch {unset a}
+    set a(x) 22
+    set a(y) 33
+    list [catch {do {global a; unset a(y)}; array names a} msg] $msg
+} {0 x}
+test proc-old-3.4 {local and global arrays} {
+    catch {unset a}
+    set a(x) 22
+    set a(y) 33
+    list [catch {do {global a; unset a; info exists a}} msg] $msg \
+	    [info exists a]
+} {0 0 0}
+test proc-old-3.5 {local and global arrays} {
+    catch {unset a}
+    set a(x) 22
+    set a(y) 33
+    list [catch {do {global a; unset a(y); array names a}} msg] $msg
+} {0 x}
+catch {unset a}
+test proc-old-3.6 {local and global arrays} {
+    catch {unset a}
+    set a(x) 22
+    set a(y) 33
+    do {global a; do {global a; unset a}; set a(z) 22}
+    list [catch {array names a} msg] $msg
+} {0 z}
+test proc-old-3.7 {local and global arrays} {
+    proc t1 {args} {global info; set info 1}
+    catch {unset a}
+    set info {}
+    do {global a; trace var a(1) w t1}
+    set a(1) 44
+    set info
+} 1
+test proc-old-3.8 {local and global arrays} {
+    proc t1 {args} {global info; set info 1}
+    catch {unset a}
+    trace var a(1) w t1
+    set info {}
+    do {global a; trace vdelete a(1) w t1}
+    set a(1) 44
+    set info
+} {}
+test proc-old-3.9 {local and global arrays} {
+    proc t1 {args} {global info; set info 1}
+    catch {unset a}
+    trace var a(1) w t1
+    do {global a; trace vinfo a(1)}
+} {{w t1}}
+catch {unset a}
+
+test proc-old-3.1 {arguments and defaults} {
+    proc tproc {x y z} {
+	return [list $x $y $z]
+    }
+    tproc 11 12 13
+} {11 12 13}
+test proc-old-3.2 {arguments and defaults} {
+    proc tproc {x y z} {
+	return [list $x $y $z]
+    }
+    list [catch {tproc 11 12} msg] $msg
+} {1 {no value given for parameter "z" to "tproc"}}
+test proc-old-3.3 {arguments and defaults} {
+    proc tproc {x y z} {
+	return [list $x $y $z]
+    }
+    list [catch {tproc 11 12 13 14} msg] $msg
+} {1 {called "tproc" with too many arguments}}
+test proc-old-3.4 {arguments and defaults} {
+    proc tproc {x {y y-default} {z z-default}} {
+	return [list $x $y $z]
+    }
+    tproc 11 12 13
+} {11 12 13}
+test proc-old-3.5 {arguments and defaults} {
+    proc tproc {x {y y-default} {z z-default}} {
+	return [list $x $y $z]
+    }
+    tproc 11 12
+} {11 12 z-default}
+test proc-old-3.6 {arguments and defaults} {
+    proc tproc {x {y y-default} {z z-default}} {
+	return [list $x $y $z]
+    }
+    tproc 11
+} {11 y-default z-default}
+test proc-old-3.7 {arguments and defaults} {
+    proc tproc {x {y y-default} {z z-default}} {
+	return [list $x $y $z]
+    }
+    list [catch {tproc} msg] $msg
+} {1 {no value given for parameter "x" to "tproc"}}
+test proc-old-3.8 {arguments and defaults} {
+    list [catch {
+	proc tproc {x {y y-default} z} {
+	    return [list $x $y $z]
+	}
+	tproc 2 3
+    } msg] $msg
+} {1 {no value given for parameter "z" to "tproc"}}
+test proc-old-3.9 {arguments and defaults} {
+    proc tproc {x {y y-default} args} {
+	return [list $x $y $args]
+    }
+    tproc 2 3 4 5
+} {2 3 {4 5}}
+test proc-old-3.10 {arguments and defaults} {
+    proc tproc {x {y y-default} args} {
+	return [list $x $y $args]
+    }
+    tproc 2 3
+} {2 3 {}}
+test proc-old-3.11 {arguments and defaults} {
+    proc tproc {x {y y-default} args} {
+	return [list $x $y $args]
+    }
+    tproc 2
+} {2 y-default {}}
+test proc-old-3.12 {arguments and defaults} {
+    proc tproc {x {y y-default} args} {
+	return [list $x $y $args]
+    }
+    list [catch {tproc} msg] $msg
+} {1 {no value given for parameter "x" to "tproc"}}
+
+test proc-old-4.1 {variable numbers of arguments} {
+    proc tproc args {return $args}
+    tproc
+} {}
+test proc-old-4.2 {variable numbers of arguments} {
+    proc tproc args {return $args}
+    tproc 1 2 3 4 5 6 7 8
+} {1 2 3 4 5 6 7 8}
+test proc-old-4.3 {variable numbers of arguments} {
+    proc tproc args {return $args}
+    tproc 1 {2 3} {4 {5 6} {{{7}}}} 8
+} {1 {2 3} {4 {5 6} {{{7}}}} 8}
+test proc-old-4.4 {variable numbers of arguments} {
+    proc tproc {x y args} {return $args}
+    tproc 1 2 3 4 5 6 7
+} {3 4 5 6 7}
+test proc-old-4.5 {variable numbers of arguments} {
+    proc tproc {x y args} {return $args}
+    tproc 1 2
+} {}
+test proc-old-4.6 {variable numbers of arguments} {
+    proc tproc {x missing args} {return $args}
+    list [catch {tproc 1} msg] $msg
+} {1 {no value given for parameter "missing" to "tproc"}}
+
+test proc-old-5.1 {error conditions} {
+    list [catch {proc} msg] $msg
+} {1 {wrong # args: should be "proc name args body"}}
+test proc-old-5.2 {error conditions} {
+    list [catch {proc tproc b} msg] $msg
+} {1 {wrong # args: should be "proc name args body"}}
+test proc-old-5.3 {error conditions} {
+    list [catch {proc tproc b c d e} msg] $msg
+} {1 {wrong # args: should be "proc name args body"}}
+test proc-old-5.4 {error conditions} {
+    list [catch {proc tproc \{xyz {return foo}} msg] $msg
+} {1 {unmatched open brace in list}}
+test proc-old-5.5 {error conditions} {
+    list [catch {proc tproc {{} y} {return foo}} msg] $msg
+} {1 {procedure "tproc" has argument with no name}}
+test proc-old-5.6 {error conditions} {
+    list [catch {proc tproc {{} y} {return foo}} msg] $msg
+} {1 {procedure "tproc" has argument with no name}}
+test proc-old-5.7 {error conditions} {
+    list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg
+} {1 {too many fields in argument specifier "x 1 2"}}
+test proc-old-5.8 {error conditions} {
+    catch {return}
+} 2
+test proc-old-5.9 {error conditions} {
+    list [catch {global} msg] $msg
+} {1 {wrong # args: should be "global varName ?varName ...?"}}
+proc tproc {} {
+    set a 22
+    global a
+}
+test proc-old-5.10 {error conditions} {
+    list [catch {tproc} msg] $msg
+} {1 {variable "a" already exists}}
+test proc-old-5.11 {error conditions} {
+    catch {rename tproc {}}
+    catch {
+	proc tproc {x {} z} {return foo}
+    }
+    list [catch {tproc 1} msg] $msg
+} {1 {invalid command name "tproc"}}
+test proc-old-5.12 {error conditions} {
+    proc tproc {} {
+	set a 22
+	error "error in procedure"
+	return
+    }
+    list [catch tproc msg] $msg
+} {1 {error in procedure}}
+test proc-old-5.13 {error conditions} {
+    proc tproc {} {
+	set a 22
+	error "error in procedure"
+	return
+    }
+    catch tproc msg
+    set errorInfo
+} {error in procedure
+    while executing
+"error "error in procedure""
+    (procedure "tproc" line 1)
+    invoked from within
+"tproc"}
+test proc-old-5.14 {error conditions} {
+    proc tproc {} {
+	set a 22
+	break
+	return
+    }
+    catch tproc msg
+    set errorInfo
+} {invoked "break" outside of a loop
+    while executing
+"tproc"}
+test proc-old-5.15 {error conditions} {
+    proc tproc {} {
+	set a 22
+	continue
+	return
+    }
+    catch tproc msg
+    set errorInfo
+} {invoked "continue" outside of a loop
+    while executing
+"tproc"}
+test proc-old-5.16 {error conditions} {
+    proc foo args {
+	global fooMsg
+	set fooMsg "foo was called: $args"
+    }
+    proc tproc {} {
+	set x 44
+	trace var x u foo
+	while {$x < 100} {
+	    error "Nested error"
+	}
+    }
+    set fooMsg "foo not called"
+    list [catch tproc msg] $msg $errorInfo $fooMsg
+} {1 {Nested error} {Nested error
+    while executing
+"error "Nested error""
+    (procedure "tproc" line 1)
+    invoked from within
+"tproc"} {foo was called: x {} u}}
+
+# The tests below will really only be useful when run under Purify or
+# some other system that can detect accesses to freed memory...
+
+test proc-old-6.1 {procedure that redefines itself} {
+    proc tproc {} {
+	proc tproc {} {
+	    return 44
+	}
+	return 45
+    }
+    tproc
+} 45
+test proc-old-6.2 {procedure that deletes itself} {
+    proc tproc {} {
+	rename tproc {}
+	return 45
+    }
+    tproc
+} 45
+
+proc tproc code {
+    return -code $code abc
+}
+test proc-old-7.1 {return with special completion code} {
+    list [catch {tproc ok} msg] $msg
+} {0 abc}
+test proc-old-7.2 {return with special completion code} {
+    list [catch {tproc error} msg] $msg $errorInfo $errorCode
+} {1 abc {abc
+    while executing
+"tproc error"} NONE}
+test proc-old-7.3 {return with special completion code} {
+    list [catch {tproc return} msg] $msg
+} {2 abc}
+test proc-old-7.4 {return with special completion code} {
+    list [catch {tproc break} msg] $msg
+} {3 abc}
+test proc-old-7.5 {return with special completion code} {
+    list [catch {tproc continue} msg] $msg
+} {4 abc}
+test proc-old-7.6 {return with special completion code} {
+    list [catch {tproc -14} msg] $msg
+} {-14 abc}
+test proc-old-7.7 {return with special completion code} {
+    list [catch {tproc gorp} msg] $msg
+} {1 {bad completion code "gorp": must be ok, error, return, break, continue, or an integer}}
+test proc-old-7.8 {return with special completion code} {
+    list [catch {tproc 10b} msg] $msg
+} {1 {bad completion code "10b": must be ok, error, return, break, continue, or an integer}}
+test proc-old-7.9 {return with special completion code} {
+    proc tproc2 {} {
+	tproc return
+    }
+    list [catch tproc2 msg] $msg
+} {0 abc}
+test proc-old-7.10 {return with special completion code} {
+    proc tproc2 {} {
+	return -code error
+    }
+    list [catch tproc2 msg] $msg
+} {1 {}}
+test proc-old-7.11 {return with special completion code} {
+    proc tproc2 {} {
+	global errorCode errorInfo
+	catch {open _bad_file_name r} msg
+	return -code error -errorinfo $errorInfo -errorcode $errorCode $msg
+    }
+    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
+    while executing
+"open _bad_file_name r"
+    invoked from within
+"tproc2"} {posix enoent {no such file or directory}}}
+test proc-old-7.12 {return with special completion code} {
+    proc tproc2 {} {
+	global errorCode errorInfo
+	catch {open _bad_file_name r} msg
+	return -code error -errorcode $errorCode $msg
+    }
+    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
+    while executing
+"tproc2"} {posix enoent {no such file or directory}}}
+test proc-old-7.13 {return with special completion code} {
+    proc tproc2 {} {
+	global errorCode errorInfo
+	catch {open _bad_file_name r} msg
+	return -code error -errorinfo $errorInfo $msg
+    }
+    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
+    while executing
+"open _bad_file_name r"
+    invoked from within
+"tproc2"} none}
+test proc-old-7.14 {return with special completion code} {
+    proc tproc2 {} {
+	global errorCode errorInfo
+	catch {open _bad_file_name r} msg
+	return -code error $msg
+    }
+    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
+    while executing
+"tproc2"} none}
+test proc-old-7.14 {return with special completion code} {
+    list [catch {return -badOption foo message} msg] $msg
+} {1 {bad option "-badOption": must be -code, -errorcode, or -errorinfo}}
+
+test proc-old-8.1 {unset and undefined local arrays} {
+    proc t1 {} {
+        foreach v {xxx, yyy} {
+            catch {unset $v}
+        }
+        set yyy(foo) bar
+    }
+    t1
+} bar
+
+test proc-old-9.1 {empty command name} {
+    catch {rename {} ""}
+    proc t1 {args} {
+        return
+    }
+    set v [t1]
+    catch {$v}
+} 1
+
+test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
+    proc t1 x {
+        set y 20
+        rename expr expr.old
+        rename expr.old expr
+        if $x then {t1 0} ;# recursive call after foo's code is invalidated
+        return 20
+    }
+    t1 1
+} 20
+
+catch {rename t1 ""}
+catch {rename foo ""}
diff --git a/contrib/tcl/tests/proc.test b/contrib/tcl/tests/proc.test
index 6eef73c..9647399 100644
--- a/contrib/tcl/tests/proc.test
+++ b/contrib/tcl/tests/proc.test
@@ -1,461 +1,159 @@
-# Commands covered:  proc, return, global
+# This file contains tests for the tclProc.c source file. Tests appear in
+# the same order as the C code that they test. The set of tests is
+# currently incomplete since it currently includes only new tests for
+# code changed for the addition of Tcl namespaces. Other procedure-
+# related tests appear in other test files including proc-old.test.
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) proc.test 1.21 96/02/16 08:56:21
+# SCCS: @(#) proc.test 1.9 97/06/20 18:55:03
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
-proc tproc {} {return a; return b}
-test proc-1.1 {simple procedure call and return} {tproc} a
-proc tproc x {
-    set x [expr $x+1]
-    return $x
-}
-test proc-1.2 {simple procedure call and return} {tproc 2} 3
-test proc-1.3 {simple procedure call and return} {
-    proc tproc {} {return foo}
-} {}
-test proc-1.4 {simple procedure call and return} {
-    proc tproc {} {return}
-    tproc
-} {}
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename p ""}
+catch {rename {} ""}
+catch {unset msg}
 
-test proc-2.1 {local and global variables} {
-    proc tproc x {
-	set x [expr $x+1]
-	return $x
-    }
-    set x 42
-    list [tproc 6] $x
-} {7 42}
-test proc-2.2 {local and global variables} {
-    proc tproc x {
-	set y [expr $x+1]
-	return $y
-    }
-    set y 18
-    list [tproc 6] $y
-} {7 18}
-test proc-2.3 {local and global variables} {
-    proc tproc x {
-	global y
-	set y [expr $x+1]
-	return $y
-    }
-    set y 189
-    list [tproc 6] $y
-} {7 7}
-test proc-2.4 {local and global variables} {
-    proc tproc x {
-	global y
-	return [expr $x+$y]
-    }
-    set y 189
-    list [tproc 6] $y
-} {195 189}
-catch {unset _undefined_}
-test proc-2.5 {local and global variables} {
-    proc tproc x {
-	global _undefined_
-	return $_undefined_
-    }
-    list [catch {tproc xxx} msg] $msg
-} {1 {can't read "_undefined_": no such variable}}
-test proc-2.6 {local and global variables} {
-    set a 114
-    set b 115
-    global a b
-    list $a $b
-} {114 115}
+test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        namespace eval baz {}
+    }
+    proc test_ns_1::baz::p {} {
+        return "p in [namespace current]"
+    }
+    list [test_ns_1::baz::p] \
+         [namespace eval test_ns_1 {baz::p}] \
+         [info commands test_ns_1::baz::*]
+} {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
+test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    list [catch {proc test_ns_1::baz::p {} {}} msg] $msg
+} {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}}
+test proc-1.3 {Tcl_ProcObjCmd, empty proc name} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    proc :: {} {
+        return "empty called"
+    }
+    list [::] \
+         [info body {}]
+} {{empty called} {
+        return "empty called"
+    }}
+test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        namespace eval baz {
+            proc p {} {
+                return "p in [namespace current]"
+            }
+        }
+    }
+    list [test_ns_1::baz::p] \
+         [info commands test_ns_1::baz::*]
+} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
+test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::baz {}
+    namespace eval test_ns_1 {
+        proc baz::p {} {
+            return "p in [namespace current]"
+        }
+    }
+    list [test_ns_1::baz::p] \
+         [info commands test_ns_1::baz::*] \
+         [namespace eval test_ns_1::baz {namespace which p}]
+} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
+test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        proc q: {} {return "q:"}
+        proc value:at: {} {return "value:at:"}
+    }
+    list [namespace eval test_ns_1 {q:}] \
+         [namespace eval test_ns_1 {value:at:}] \
+         [test_ns_1::q:] \
+         [test_ns_1::value:at:] \
+         [lsort [info commands test_ns_1::*]] \
+         [namespace eval test_ns_1 {namespace which q:}] \
+         [namespace eval test_ns_1 {namespace which value:at:}]
+} {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
+test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} {
+    catch {rename p ""}
+    list [catch {proc p {a(1) a(2)} { 
+            set z [expr $a(1)+$a(2)]
+            puts "$z=z, $a(1)=$a(1)"
+        }} msg] $msg
+} {1 {procedure "p" has formal parameter "a(1)" that is an array element}}
 
-proc do {cmd} {eval $cmd}
-test proc-3.1 {local and global arrays} {
-    catch {unset a}
-    set a(0) 22
-    list [catch {do {global a; set a(0)}} msg] $msg
-} {0 22}
-test proc-3.2 {local and global arrays} {
-    catch {unset a}
-    set a(x) 22
-    list [catch {do {global a; set a(x) newValue}} msg] $msg $a(x)
-} {0 newValue newValue}
-test proc-3.3 {local and global arrays} {
-    catch {unset a}
-    set a(x) 22
-    set a(y) 33
-    list [catch {do {global a; unset a(y)}; array names a} msg] $msg
-} {0 x}
-test proc-3.4 {local and global arrays} {
-    catch {unset a}
-    set a(x) 22
-    set a(y) 33
-    list [catch {do {global a; unset a; info exists a}} msg] $msg \
-	    [info exists a]
-} {0 0 0}
-test proc-3.5 {local and global arrays} {
-    catch {unset a}
-    set a(x) 22
-    set a(y) 33
-    list [catch {do {global a; unset a(y); array names a}} msg] $msg
-} {0 x}
-catch {unset a}
-test proc-3.6 {local and global arrays} {
-    catch {unset a}
-    set a(x) 22
-    set a(y) 33
-    do {global a; do {global a; unset a}; set a(z) 22}
-    list [catch {array names a} msg] $msg
-} {0 z}
-test proc-3.7 {local and global arrays} {
-    proc t1 {args} {global info; set info 1}
-    catch {unset a}
-    set info {}
-    do {global a; trace var a(1) w t1}
-    set a(1) 44
-    set info
-} 1
-test proc-3.8 {local and global arrays} {
-    proc t1 {args} {global info; set info 1}
-    catch {unset a}
-    trace var a(1) w t1
-    set info {}
-    do {global a; trace vdelete a(1) w t1}
-    set a(1) 44
-    set info
-} {}
-test proc-3.9 {local and global arrays} {
-    proc t1 {args} {global info; set info 1}
-    catch {unset a}
-    trace var a(1) w t1
-    do {global a; trace vinfo a(1)}
-} {{w t1}}
-catch {unset a}
-
-test proc-3.1 {arguments and defaults} {
-    proc tproc {x y z} {
-	return [list $x $y $z]
-    }
-    tproc 11 12 13
-} {11 12 13}
-test proc-3.2 {arguments and defaults} {
-    proc tproc {x y z} {
-	return [list $x $y $z]
-    }
-    list [catch {tproc 11 12} msg] $msg
-} {1 {no value given for parameter "z" to "tproc"}}
-test proc-3.3 {arguments and defaults} {
-    proc tproc {x y z} {
-	return [list $x $y $z]
-    }
-    list [catch {tproc 11 12 13 14} msg] $msg
-} {1 {called "tproc" with too many arguments}}
-test proc-3.4 {arguments and defaults} {
-    proc tproc {x {y y-default} {z z-default}} {
-	return [list $x $y $z]
-    }
-    tproc 11 12 13
-} {11 12 13}
-test proc-3.5 {arguments and defaults} {
-    proc tproc {x {y y-default} {z z-default}} {
-	return [list $x $y $z]
-    }
-    tproc 11 12
-} {11 12 z-default}
-test proc-3.6 {arguments and defaults} {
-    proc tproc {x {y y-default} {z z-default}} {
-	return [list $x $y $z]
-    }
-    tproc 11
-} {11 y-default z-default}
-test proc-3.7 {arguments and defaults} {
-    proc tproc {x {y y-default} {z z-default}} {
-	return [list $x $y $z]
-    }
-    list [catch {tproc} msg] $msg
-} {1 {no value given for parameter "x" to "tproc"}}
-test proc-3.8 {arguments and defaults} {
-    list [catch {
-	proc tproc {x {y y-default} z} {
-	    return [list $x $y $z]
-	}
-	tproc 2 3
-    } msg] $msg
-} {1 {no value given for parameter "z" to "tproc"}}
-test proc-3.9 {arguments and defaults} {
-    proc tproc {x {y y-default} args} {
-	return [list $x $y $args]
-    }
-    tproc 2 3 4 5
-} {2 3 {4 5}}
-test proc-3.10 {arguments and defaults} {
-    proc tproc {x {y y-default} args} {
-	return [list $x $y $args]
-    }
-    tproc 2 3
-} {2 3 {}}
-test proc-3.11 {arguments and defaults} {
-    proc tproc {x {y y-default} args} {
-	return [list $x $y $args]
-    }
-    tproc 2
-} {2 y-default {}}
-test proc-3.12 {arguments and defaults} {
-    proc tproc {x {y y-default} args} {
-	return [list $x $y $args]
-    }
-    list [catch {tproc} msg] $msg
-} {1 {no value given for parameter "x" to "tproc"}}
+test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    proc p {} {return "p in [namespace current]"}
+    info body p
+} {return "p in [namespace current]"}
+test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        namespace eval baz {
+            proc p {} {return "p in [namespace current]"}
+        }
+    }
+    namespace eval test_ns_1::baz {info body p}
+} {return "p in [namespace current]"}
+test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::baz {}
+    namespace eval test_ns_1 {
+        proc baz::p {} {return "p in [namespace current]"}
+    }
+    namespace eval test_ns_1 {info body baz::p}
+} {return "p in [namespace current]"}
+test proc-2.4 {TclFindProc, global proc and executing in namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    proc p {} {return "global p"}
+    namespace eval test_ns_1::baz {info body p}
+} {return "global p"}
 
-test proc-4.1 {variable numbers of arguments} {
-    proc tproc args {return $args}
-    tproc
-} {}
-test proc-4.2 {variable numbers of arguments} {
-    proc tproc args {return $args}
-    tproc 1 2 3 4 5 6 7 8
-} {1 2 3 4 5 6 7 8}
-test proc-4.3 {variable numbers of arguments} {
-    proc tproc args {return $args}
-    tproc 1 {2 3} {4 {5 6} {{{7}}}} 8
-} {1 {2 3} {4 {5 6} {{{7}}}} 8}
-test proc-4.4 {variable numbers of arguments} {
-    proc tproc {x y args} {return $args}
-    tproc 1 2 3 4 5 6 7
-} {3 4 5 6 7}
-test proc-4.5 {variable numbers of arguments} {
-    proc tproc {x y args} {return $args}
-    tproc 1 2
-} {}
-test proc-4.6 {variable numbers of arguments} {
-    proc tproc {x missing args} {return $args}
-    list [catch {tproc 1} msg] $msg
-} {1 {no value given for parameter "missing" to "tproc"}}
+test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    proc p {} {return "p in [namespace current]"}
+    p
+} {p in ::}
+test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::baz {
+        proc p {} {return "p in [namespace current]"}
+        p
+    }
+} {p in ::test_ns_1::baz}
+test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    proc p {} {return "p in [namespace current]"}
+    namespace eval test_ns_1::baz {
+        p
+    }
+} {p in ::}
+test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename p ""}
+    namespace eval test_ns_1::baz {
+        proc p {} {return "p in [namespace current]"}
+        rename ::test_ns_1::baz::p ::p
+        list [p] [namespace which p]
+    }
+} {{p in ::test_ns_1::baz} ::p}
 
-test proc-5.1 {error conditions} {
-    list [catch {proc} msg] $msg
-} {1 {wrong # args: should be "proc name args body"}}
-test proc-5.2 {error conditions} {
-    list [catch {proc tproc b} msg] $msg
-} {1 {wrong # args: should be "proc name args body"}}
-test proc-5.3 {error conditions} {
-    list [catch {proc tproc b c d e} msg] $msg
-} {1 {wrong # args: should be "proc name args body"}}
-test proc-5.4 {error conditions} {
-    list [catch {proc tproc \{xyz {return foo}} msg] $msg
-} {1 {unmatched open brace in list}}
-test proc-5.5 {error conditions} {
-    list [catch {proc tproc {{} y} {return foo}} msg] $msg
-} {1 {procedure "tproc" has argument with no name}}
-test proc-5.6 {error conditions} {
-    list [catch {proc tproc {{} y} {return foo}} msg] $msg
-} {1 {procedure "tproc" has argument with no name}}
-test proc-5.7 {error conditions} {
-    list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg
-} {1 {too many fields in argument specifier "x 1 2"}}
-test proc-5.8 {error conditions} {
-    catch {return}
-} 2
-test proc-5.9 {error conditions} {
-    list [catch {global} msg] $msg
-} {1 {wrong # args: should be "global varName ?varName ...?"}}
-proc tproc {} {
-    set a 22
-    global a
-}
-test proc-5.10 {error conditions} {
-    list [catch {tproc} msg] $msg
-} {1 {variable "a" already exists}}
-test proc-5.11 {error conditions} {
-    catch {rename tproc {}}
-    catch {
-	proc tproc {x {} z} {return foo}
-    }
-    list [catch {tproc 1} msg] $msg
-} {1 {invalid command name "tproc"}}
-test proc-5.12 {error conditions} {
-    proc tproc {} {
-	set a 22
-	error "error in procedure"
-	return
-    }
-    list [catch tproc msg] $msg
-} {1 {error in procedure}}
-test proc-5.13 {error conditions} {
-    proc tproc {} {
-	set a 22
-	error "error in procedure"
-	return
-    }
-    catch tproc msg
-    set errorInfo
-} {error in procedure
-    while executing
-"error "error in procedure""
-    (procedure "tproc" line 3)
-    invoked from within
-"tproc"}
-test proc-5.14 {error conditions} {
-    proc tproc {} {
-	set a 22
-	break
-	return
-    }
-    catch tproc msg
-    set errorInfo
-} {invoked "break" outside of a loop
-    while executing
-"tproc"}
-test proc-5.15 {error conditions} {
-    proc tproc {} {
-	set a 22
-	continue
-	return
-    }
-    catch tproc msg
-    set errorInfo
-} {invoked "continue" outside of a loop
-    while executing
-"tproc"}
-test proc-5.16 {error conditions} {
-    proc foo args {
-	global fooMsg
-	set fooMsg "foo was called: $args"
-    }
-    proc tproc {} {
-	set x 44
-	trace var x u foo
-	while {$x < 100} {
-	    error "Nested error"
-	}
-    }
-    set fooMsg "foo not called"
-    list [catch tproc msg] $msg $errorInfo $fooMsg
-} {1 {Nested error} {Nested error
-    while executing
-"error "Nested error""
-    ("while" body line 2)
-    invoked from within
-"while {$x < 100} {
-	    error "Nested error"
-	}"
-    (procedure "tproc" line 4)
-    invoked from within
-"tproc"} {foo was called: x {} u}}
-
-# The tests below will really only be useful when run under Purify or
-# some other system that can detect accesses to freed memory...
-
-test proc-6.1 {procedure that redefines itself} {
-    proc tproc {} {
-	proc tproc {} {
-	    return 44
-	}
-	return 45
-    }
-    tproc
-} 45
-test proc-6.2 {procedure that deletes itself} {
-    proc tproc {} {
-	rename tproc {}
-	return 45
-    }
-    tproc
-} 45
-
-proc tproc code {
-    return -code $code abc
-}
-test proc-7.1 {return with special completion code} {
-    list [catch {tproc ok} msg] $msg
-} {0 abc}
-test proc-7.2 {return with special completion code} {
-    list [catch {tproc error} msg] $msg $errorInfo $errorCode
-} {1 abc {abc
-    while executing
-"tproc error"} NONE}
-test proc-7.3 {return with special completion code} {
-    list [catch {tproc return} msg] $msg
-} {2 abc}
-test proc-7.4 {return with special completion code} {
-    list [catch {tproc break} msg] $msg
-} {3 abc}
-test proc-7.5 {return with special completion code} {
-    list [catch {tproc continue} msg] $msg
-} {4 abc}
-test proc-7.6 {return with special completion code} {
-    list [catch {tproc -14} msg] $msg
-} {-14 abc}
-test proc-7.7 {return with special completion code} {
-    list [catch {tproc gorp} msg] $msg
-} {1 {bad completion code "gorp": must be ok, error, return, break, continue, or an integer}}
-test proc-7.8 {return with special completion code} {
-    list [catch {tproc 10b} msg] $msg
-} {1 {bad completion code "10b": must be ok, error, return, break, continue, or an integer}}
-test proc-7.9 {return with special completion code} {
-    proc tproc2 {} {
-	tproc return
-    }
-    list [catch tproc2 msg] $msg
-} {0 abc}
-test proc-7.10 {return with special completion code} {
-    proc tproc2 {} {
-	return -code error
-    }
-    list [catch tproc2 msg] $msg
-} {1 {}}
-test proc-7.11 {return with special completion code} {
-    proc tproc2 {} {
-	global errorCode errorInfo
-	catch {open _bad_file_name r} msg
-	return -code error -errorinfo $errorInfo -errorcode $errorCode $msg
-    }
-    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
-} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
-    while executing
-"open _bad_file_name r"
-    invoked from within
-"tproc2"} {posix enoent {no such file or directory}}}
-test proc-7.12 {return with special completion code} {
-    proc tproc2 {} {
-	global errorCode errorInfo
-	catch {open _bad_file_name r} msg
-	return -code error -errorcode $errorCode $msg
-    }
-    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
-} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
-    while executing
-"tproc2"} {posix enoent {no such file or directory}}}
-test proc-7.13 {return with special completion code} {
-    proc tproc2 {} {
-	global errorCode errorInfo
-	catch {open _bad_file_name r} msg
-	return -code error -errorinfo $errorInfo $msg
-    }
-    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
-} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
-    while executing
-"open _bad_file_name r"
-    invoked from within
-"tproc2"} none}
-test proc-7.14 {return with special completion code} {
-    proc tproc2 {} {
-	global errorCode errorInfo
-	catch {open _bad_file_name r} msg
-	return -code error $msg
-    }
-    normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
-} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
-    while executing
-"tproc2"} none}
-test proc-7.14 {return with special completion code} {
-    list [catch {return -badOption foo message} msg] $msg
-} {1 {bad option "-badOption: must be -code, -errorcode, or -errorinfo}}
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename p ""}
+catch {rename {} ""}
+catch {unset msg}
diff --git a/contrib/tcl/tests/regexp.test b/contrib/tcl/tests/regexp.test
index 1f1aecf..5fb785b 100644
--- a/contrib/tcl/tests/regexp.test
+++ b/contrib/tcl/tests/regexp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) regexp.test 1.20 96/04/02 15:03:53
+# SCCS: @(#) regexp.test 1.21 96/12/23 13:59:48
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -27,6 +27,9 @@ test regexp-1.3 {basic regexp operation} {
 test regexp-1.4 {basic regexp operation} {
     regexp -- -gorp abc-gorpxxx
 } 1
+test regexp-1.5 {basic regexp operation} {
+    regexp {^([^ ]*)[ ]*([^ ]*)} "" a
+} 1
 
 test regexp-2.1 {getting substrings back from regexp} {
     set foo {}
diff --git a/contrib/tcl/tests/registry.test b/contrib/tcl/tests/registry.test
new file mode 100644
index 0000000..6a6b99f
--- /dev/null
+++ b/contrib/tcl/tests/registry.test
@@ -0,0 +1,507 @@
+# registry.test --
+#
+# This file contains a collection of tests for the registry command.
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors.  No output means no errors were found.
+#
+# In order for these tests to run, the registry package must be on the
+# auto_path or the registry package must have been loaded already.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
+#
+# SCCS: @(#) registry.test 1.3 97/02/11 16:58:43
+
+if {$tcl_platform(platform) != "windows"} {
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if [catch {package require registry}] {
+    puts "Unable to find the registry package. Skipping registry tests."
+    return
+}
+
+switch $tcl_platform(os) {
+    "Windows NT" {set testConfig(NT) 1}
+    "Windows 95" {set testConfig(95) 1}
+}
+
+set hostname [info hostname]
+
+test registry-1.1 {argument parsing for registry command} {
+    list [catch {registry} msg] $msg
+} {1 {wrong # args: should be "registry option ?arg arg ...?"}}
+test registry-1.2 {argument parsing for registry command} {
+    list [catch {registry foo} msg] $msg
+} {1 {bad option "foo": must be delete, get, keys, set, type, or values}}
+
+test registry-1.3 {argument parsing for registry command} {
+    list [catch {registry d} msg] $msg
+} {1 {wrong # args: should be "registry d keyName ?valueName?"}}
+test registry-1.4 {argument parsing for registry command} {
+    list [catch {registry delete} msg] $msg
+} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
+test registry-1.5 {argument parsing for registry command} {
+    list [catch {registry delete foo bar baz} msg] $msg
+} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
+
+test registry-1.6 {argument parsing for registry command} {
+    list [catch {registry g} msg] $msg
+} {1 {wrong # args: should be "registry g keyName valueName"}}
+test registry-1.7 {argument parsing for registry command} {
+    list [catch {registry get} msg] $msg
+} {1 {wrong # args: should be "registry get keyName valueName"}}
+test registry-1.8 {argument parsing for registry command} {
+    list [catch {registry get foo} msg] $msg
+} {1 {wrong # args: should be "registry get keyName valueName"}}
+test registry-1.9 {argument parsing for registry command} {
+    list [catch {registry get foo bar baz} msg] $msg
+} {1 {wrong # args: should be "registry get keyName valueName"}}
+
+test registry-1.10 {argument parsing for registry command} {
+    list [catch {registry k} msg] $msg
+} {1 {wrong # args: should be "registry k keyName ?pattern?"}}
+test registry-1.11 {argument parsing for registry command} {
+    list [catch {registry keys} msg] $msg
+} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
+test registry-1.12 {argument parsing for registry command} {
+    list [catch {registry keys foo bar baz} msg] $msg
+} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
+
+test registry-1.13 {argument parsing for registry command} {
+    list [catch {registry s} msg] $msg
+} {1 {wrong # args: should be "registry s keyName ?valueName data ?type??"}}
+test registry-1.14 {argument parsing for registry command} {
+    list [catch {registry set} msg] $msg
+} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
+test registry-1.15 {argument parsing for registry command} {
+    list [catch {registry set foo bar} msg] $msg
+} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
+test registry-1.16 {argument parsing for registry command} {
+    list [catch {registry set foo bar baz blat gorp} msg] $msg
+} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
+
+test registry-1.17 {argument parsing for registry command} {
+    list [catch {registry t} msg] $msg
+} {1 {wrong # args: should be "registry t keyName valueName"}}
+test registry-1.18 {argument parsing for registry command} {
+    list [catch {registry type} msg] $msg
+} {1 {wrong # args: should be "registry type keyName valueName"}}
+test registry-1.19 {argument parsing for registry command} {
+    list [catch {registry type foo} msg] $msg
+} {1 {wrong # args: should be "registry type keyName valueName"}}
+test registry-1.20 {argument parsing for registry command} {
+    list [catch {registry type foo bar baz} msg] $msg
+} {1 {wrong # args: should be "registry type keyName valueName"}}
+
+test registry-1.21 {argument parsing for registry command} {
+    list [catch {registry v} msg] $msg
+} {1 {wrong # args: should be "registry v keyName ?pattern?"}}
+test registry-1.22 {argument parsing for registry command} {
+    list [catch {registry values} msg] $msg
+} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
+test registry-1.23 {argument parsing for registry command} {
+    list [catch {registry values foo bar baz} msg] $msg
+} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
+
+test registry-2.1 {DeleteKey: bad key} {
+    list [catch {registry delete foo} msg] $msg
+} {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
+test registry-2.2 {DeleteKey: bad key} {
+    list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg
+} {1 {bad key: cannot delete root keys}}
+test registry-2.3 {DeleteKey: bad key} {
+    list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
+} {1 {bad key: cannot delete root keys}}
+test registry-2.4 {DeleteKey: subkey at root level} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry keys HKEY_CLASSES_ROOT TclFoobar
+} {}
+test registry-2.5 {DeleteKey: subkey below root level} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test
+    set result [registry keys HKEY_CLASSES_ROOT TclFoobar\\test]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {}
+test registry-2.6 {DeleteKey: recursive delete} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
+    set result
+} {}
+test registry-2.7 {DeleteKey: trailing backslashes} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
+    list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar\\} msg] $msg
+} {1 {unable to delete key: The configuration registry key is invalid.}}
+test registry-2.8 {DeleteKey: failure} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+} {}
+
+
+test registry-3.1 {DeleteValue} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test1 blort
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test2 blat
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar\\baz test1
+    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar\\baz]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} test2
+test registry-3.2 {DeleteValue: bad key} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar test} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-3.3 {DeleteValue: bad value} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test2 blort
+    set result [list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar test1} msg] $msg]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {1 {unable to delete value "test1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+
+
+test registry-4.1 {GetKeyNames: bad key} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-4.2 {GetKeyNames} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
+    set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {baz}
+test registry-4.3 {GetKeyNames: remote key} {nonPortable} {
+    registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar\\baz
+    set result [registry keys \\\\gaspode\\HKEY_CLASSES_ROOT\\TclFoobar]
+    registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {baz}
+test registry-4.4 {GetKeyNames: empty key} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar
+    set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {}
+test registry-4.5 {GetKeyNames: patterns} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
+    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {baz blat}
+test registry-4.6 {GetKeyNames: names with spaces} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\ bar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
+    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {{baz bar} blat}
+
+test registry-5.1 {GetType} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-5.2 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
+} {1 {unable to get type of value "val1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+test registry-5.3 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar none
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} none
+test registry-5.4 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} sz
+test registry-5.5 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar sz
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} sz
+test registry-5.6 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar expand_sz
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} expand_sz
+test registry-5.7 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 binary
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} binary
+test registry-5.8 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 dword
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} dword
+test registry-5.9 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 dword_big_endian
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} dword_big_endian
+test registry-5.10 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 link
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} link
+test registry-5.11 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar multi_sz
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} multi_sz
+test registry-5.12 {GetType} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 resource_list
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} resource_list
+test registry-5.13 {GetType: unknown types} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 24
+    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 24
+
+test registry-6.1 {GetValue} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry get HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-6.2 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry get HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
+} {1 {unable to get value "val1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+test registry-6.3 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar none
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} foobar
+test registry-6.4 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} foobar
+test registry-6.5 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar sz
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} foobar
+test registry-6.6 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar expand_sz
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} foobar
+test registry-6.7 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 binary
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 1
+test registry-6.8 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 0x20 dword
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 32
+test registry-6.9 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 0x20 dword_big_endian
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 32
+test registry-6.10 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 link
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 1
+test registry-6.11 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar multi_sz
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} foobar
+test registry-6.12 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo\ bar baz} multi_sz
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {{foo bar} baz}
+test registry-6.13 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {} multi_sz
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {}
+test registry-6.14 {GetValue: truncation of multivalues with null elements} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {a {} b} multi_sz
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} a
+test registry-6.15 {GetValue} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 resource_list
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 1
+test registry-6.16 {GetValue: unknown types} {
+    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 24
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} 1
+
+test registry-7.1 {GetValueNames: bad key} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry values HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-7.2 {GetValueNames} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar
+    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} baz
+test registry-7.3 {GetValueNames} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar1
+    registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
+    registry set HKEY_CLASSES_ROOT\\TclFoobar {} foobar3
+    set result [lsort [registry values HKEY_CLASSES_ROOT\\TclFoobar]]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {{} baz blat}
+test registry-7.4 {GetValueNames: remote key} {nonPortable} {
+    registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar baz blat
+    set result [registry values \\\\gaspode\\HKEY_CLASSES_ROOT\\TclFoobar]
+    registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} baz
+test registry-7.5 {GetValueNames: empty key} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar
+    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {}
+test registry-7.6 {GetValueNames: patterns} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar1
+    registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
+    registry set HKEY_CLASSES_ROOT\\TclFoobar foo foobar3
+    set result [lsort [registry values HKEY_CLASSES_ROOT\\TclFoobar b*]]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {baz blat}
+test registry-7.7 {GetValueNames: names with spaces} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar baz\ bar foobar1
+    registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
+    registry set HKEY_CLASSES_ROOT\\TclFoobar foo foobar3
+    set result [lsort [registry values HKEY_CLASSES_ROOT\\TclFoobar b*]]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {{baz bar} blat}
+
+test registry-8.1 {OpenSubKey} {nonPortable} {
+    list [catch {registry keys {\\petrouchka\HKEY_LOCAL_MACHINE}} msg] $msg
+} {1 {unable to open key: Access is denied.}}
+test registry-8.2 {OpenSubKey} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar
+    set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} TclFoobar
+test registry-8.3 {OpenSubKey} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+
+test registry-9.1 {ParseKeyName: bad keys} {
+    list [catch {registry values \\} msg] $msg
+} "1 {bad key \"\\\": must start with a valid root}"
+test registry-9.2 {ParseKeyName: bad keys} {
+    list [catch {registry values \\foobar} msg] $msg
+} {1 {bad key "\foobar": must start with a valid root}}
+test registry-9.3 {ParseKeyName: bad keys} {
+    list [catch {registry values \\\\} msg] $msg
+} {1 {ambiguous root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
+test registry-9.4 {ParseKeyName: bad keys} {
+    list [catch {registry values \\\\\\} msg] $msg
+} {1 {ambiguous root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
+test registry-9.5 {ParseKeyName: bad keys} {
+    list [catch {registry values \\\\\\HKEY_CLASSES_ROOT} msg] $msg
+} {1 {unable to open key: The network address is invalid.}}
+test registry-9.6 {ParseKeyName: bad keys} {
+    list [catch {registry values \\\\gaspode} msg] $msg
+} {1 {ambiguous root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
+test registry-9.7 {ParseKeyName: bad keys} {
+    list [catch {registry values foobar} msg] $msg
+} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
+test registry-9.8 {ParseKeyName: null keys} {
+    list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
+} {1 {bad key: cannot delete root keys}}
+test registry-9.9 {ParseKeyName: null keys} {
+    list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} msg] $msg
+} {1 {unable to open key: The system cannot find the file specified.}}
+
+test registry-10.1 {RecursiveDeleteKey} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
+    set result
+} {}
+test registry-10.2 {RecursiveDeleteKey} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
+    set result [registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test4]
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    set result
+} {}
+
+test registry-11.1 {SetValue: recursive creation} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat foobar
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar\\baz blat]
+} foobar
+test registry-11.2 {SetValue: modification} {
+    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat foobar
+    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat frob
+    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar\\baz blat]
+} frob
+test registry-11.3 {SetValue: failure} {nonPortable} {
+    list [catch {registry set {\\petrouchka\HKEY_CLASSES_ROOT\TclFoobar} bar foobar} msg] $msg
+} {1 {unable to open key: Access is denied.}}
+
+
+unset hostname
diff --git a/contrib/tcl/tests/rename.test b/contrib/tcl/tests/rename.test
index 1613445..05f5938 100644
--- a/contrib/tcl/tests/rename.test
+++ b/contrib/tcl/tests/rename.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) rename.test 1.13 96/03/20 10:49:22
+# SCCS: @(#) rename.test 1.20 97/06/24 17:26:23
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -44,7 +44,7 @@ set b [l.new a b c]
 rename l.new list
 set c [catch l.new msg2]
 set d [list 111 222]
-test 2.1 {renaming built-in command} {
+test rename-2.1 {renaming built-in command} {
     list $a $msg1 $b $c $msg2 $d
 } {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}}
 
@@ -129,3 +129,44 @@ if {[info command testdel] == "testdel"} {
 	list [catch {interp delete foo} msg] $msg $env(value)
     } {0 {} deleted}
 }
+
+# Save the unknown procedure which is modified by the following test.
+
+catch {rename unknown unknown.old}
+
+test rename-5.1 {repeated rename deletion and redefinition of same command} {
+    set SAVED_UNKNOWN "proc unknown "
+    append SAVED_UNKNOWN "\{[info args unknown.old]\} "
+    append SAVED_UNKNOWN "\{[info body unknown.old]\}"
+
+    for {set i 0} {$i < 10} {incr i} {
+        eval $SAVED_UNKNOWN
+        tcl_wordBreakBefore "" 0
+        rename tcl_wordBreakBefore {}
+        rename unknown {}
+    }
+} {}
+
+catch {rename unknown {}}
+catch {rename unknown.old unknown}
+
+
+test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
+    proc x {} {
+        set a 123
+        set b [incr a]
+    }
+    x
+    rename incr incr.old
+    proc incr {} {puts "new incr called!"}
+    catch {x} msg
+    set msg
+} {called "incr" with too many arguments}
+
+catch {rename incr {}}
+catch {rename incr.old incr}
+
+# Make the file return an empty string (cleaner.).
+
+set x ""
+
diff --git a/contrib/tcl/tests/resource.test b/contrib/tcl/tests/resource.test
new file mode 100644
index 0000000..dc60535
--- /dev/null
+++ b/contrib/tcl/tests/resource.test
@@ -0,0 +1,78 @@
+# Commands covered:  resource
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) resource.test 1.5 97/05/15 17:51:48
+
+# Only run this test on Macintosh systems
+if {$tcl_platform(platform) != "macintosh"} {
+    return
+}
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test resource-1.1 {resource tests} {
+    list [catch {resource} msg] $msg
+} {1 {wrong # args: should be "resource option ?arg ...?"}}
+test resource-1.2 {resource tests} {
+    list [catch {resource _bad_} msg] $msg
+} {1 {bad option "_bad_": must be close, list, open, read, types, or write}}
+
+# resource open & close tests
+test resource-2.1 {resource open & close tests} {
+    list [catch {resource open} msg] $msg
+} {1 {wrong # args: should be "resource open fileName ?permissions?"}}
+test resource-2.2 {resource open & close tests} {
+    list [catch {resource open resource.test r extraArg} msg] $msg
+} {1 {wrong # args: should be "resource open fileName ?permissions?"}}
+test resource-2.3 {resource open & close tests} {
+    list [catch {resource open resource.test bad_perms} msg] $msg
+} {1 {illegal access mode "bad_perms"}}
+test resource-2.4 {resource open & close tests} {
+    list [catch {resource open _bad_file_} msg] $msg
+} {1 {path doesn't lead to a file}}
+test resource-2.5 {resource open & close tests} {
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
+    set id [resource open rsrc.file]
+    resource close $id
+} {}
+test resource-2.6 {resource open & close tests} {
+    list [catch {resource close _bad_resource_} msg] $msg
+} {1 {invalid resource file reference "_bad_resource_"}}
+
+# Tests for the Mac version of the source command
+catch {file delete rsrc.file}
+testWriteTextResource -rsrc fileRsrcName -rsrcid 128 \
+    -file rsrc.file  {set rsrc_foo 1}
+test resource-3.1 {source command} {
+    catch {unset rsrc_foo}
+    source -rsrc fileRsrcName rsrc.file
+    list [catch {set rsrc_foo} msg] $msg
+} {0 1}
+test resource-3.2 {source command} {
+    catch {unset rsrc_foo}
+    list [catch {source -rsrc no_resource rsrc.file} msg] $msg
+} {1 {The resource "no_resource" could not be loaded from rsrc.file.}}
+test resource-3.3 {source command} {
+    catch {unset rsrc_foo}
+    source -rsrcid 128 rsrc.file
+    list [catch {set rsrc_foo} msg] $msg
+} {0 1}
+test resource-3.4 {source command} {
+    catch {unset rsrc_foo}
+    list [catch {source -rsrcid bad_int rsrc.file} msg] $msg
+} {1 {expected integer but got "bad_int"}}
+test resource-3.5 {source command} {
+    catch {unset rsrc_foo}
+    list [catch {source -rsrcid 100 rsrc.file} msg] $msg
+} {1 {The resource "ID=100" could not be loaded from rsrc.file.}}
+
+# Clean up and return
+catch {file delete rsrc.file}
+return
diff --git a/contrib/tcl/tests/safe.test b/contrib/tcl/tests/safe.test
new file mode 100644
index 0000000..702bf8d
--- /dev/null
+++ b/contrib/tcl/tests/safe.test
@@ -0,0 +1,324 @@
+# safe.test --
+#
+# This file contains a collection of tests for security policies, safe Tcl,
+# and using safe interpreters. Sourcing this file into tcl runs the tests
+# and generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1995-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.
+#
+# SCCS: @(#) safe.test 1.13 97/06/24 17:33:22
+
+# NOTE: The tests in this file only pass if you invoke them from the
+#	"tests" directory.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+foreach i [interp slaves] {
+  interp delete $i
+}
+
+proc equiv {x} {return $x}
+
+test safe-1.1 {creating interpreters, should have no aliases} {
+    interp aliases
+} ""
+test safe-1.2 {creating interpreters, should have no aliases} {
+    catch {tcl_safeDeleteInterp a}
+    interp create a
+    set l [a aliases]
+    interp delete a
+    set l
+} ""
+test safe-1.3 {creating safe interpreters, should have no aliases} {
+    catch {tcl_safeDeleteInterp a}
+    interp create a -safe
+    set l [a aliases]
+    interp delete a
+    set l
+} ""
+
+test safe-2.1 {calling tcl_SafeInit is safe} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    catch {interp eval a exec ls} msg
+    tcl_safeDeleteInterp a
+    set msg
+} {invalid command name "exec"}
+test safe-2.2 {calling tcl_safeCreateInterp on trusted interp} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l [lsort [a aliases]]
+    tcl_safeDeleteInterp a
+    set l
+} {exit file load source tclPkgUnknown}
+test safe-2.3 {calling tcl_safeCreateInterp on trusted interp} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set x [interp eval a {source [file join $tcl_library init.tcl]}]
+    tcl_safeDeleteInterp a
+    set x
+} ""
+test safe-2.4 {calling tcl_safeCreateInterp on trusted interp} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    catch {set x \
+		[interp eval a {source [file join $tcl_library init.tcl]}]} msg
+    tcl_safeDeleteInterp a
+    list $x $msg
+} {{} {}}
+
+test safe-3.1 {tcl_safeDeleteInterp} {
+    catch {tcl_safeDeleteInterp a}
+    interp create a
+    tcl_safeDeleteInterp a
+} ""
+test safe-3.2 {tcl_safeDeleteInterp, indirectly} {
+    catch {tcl_safeDeleteInterp a}
+    interp create a
+    a alias exit tcl_safeDeleteInterp a
+    a eval exit
+} ""
+test safe-3.3 {tcl_safeDeleteInterp, state array} {
+    catch {tcl_safeDeleteInterp a}
+    set tclSafea(foo) 33
+    tcl_safeDeleteInterp a
+    catch {set tclSafea(foo)} msg
+    set msg
+} {can't read "tclSafea(foo)": no such variable}
+test safe-3.4 {tcl_safeDeleteInterp, state array, indirectly} {
+    catch {tcl_safeDeleteInterp a}
+    set tclSafea(foo) 33
+    tcl_safeCreateInterp a
+    a eval exit
+    catch {set tclSafea(foo)} msg
+    set msg
+} {can't read "tclSafea(foo)": no such variable}
+test safe-3.5 {tcl_safeDeleteInterp} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    catch {tcl_safeCreateInterp a} msg
+    set msg
+} {interpreter named "a" already exists, cannot create}
+test safe-3.6 {tcl_safeDeleteInterp, indirectly} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    a eval exit
+} ""
+test safe-3.7 {tcl_safeDeleteInterp, state array} {
+    catch {tcl_safeDeleteInterp a}
+    set tclSafea(foo) 33
+    tcl_safeCreateInterp a
+    tcl_safeDeleteInterp a
+    catch {set tclSafea(foo)} msg
+    set msg
+} {can't read "tclSafea(foo)": no such variable}
+test safe-3.8 {tcl_safeDeleteInterp, state array, indirectly} {
+    catch {tcl_safeDeleteInterp a}
+    set tclSafea(foo) 33
+    tcl_safeCreateInterp a
+    a eval exit
+    catch {set tclSafea(foo)} msg
+    set msg
+} {can't read "tclSafea(foo)": no such variable}
+
+# For the following tests, we need a policyPath; we assume that the
+# test directory has a subdirectory policies, and we will use that.
+
+# Save old value of tcl_PolicyPath so we can restore it once we are
+# done with this test sequence:
+
+set my_old_auto_path $auto_path
+lappend auto_path [pwd]
+
+test safe-4.1 {loading a policy from the main directory} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l [a eval {package require globalPolicy}]
+    tcl_safeDeleteInterp a
+    set l
+} 1.0
+test safe-4.2 {same, loading into safe interpreter} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l [a eval {package require globalPolicy}]
+    tcl_safeDeleteInterp a
+    set l
+} 1.0
+test safe-4.3 {loading a policy from a subdirectory} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l [a eval {package require policyA}]
+    tcl_safeDeleteInterp a
+    set l
+} 1.0
+test safe-4.4 {loading a policy, unloading, reloading -- clean} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    tcl_safeDeleteInterp a
+    tcl_safeCreateInterp a
+    lappend l [a eval {package require policyA}]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1.0}
+test safe-4.5 {loading two policies - prevented} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [catch {a eval {package require policyB}} msg]
+    lappend l $msg
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1 {security policy policyA already loaded}}
+test safe-4.6 {two interpreters can have different policies} {
+    catch {tcl_safeDeleteInterp a}
+    catch {tcl_safeDeleteInterp b}
+    tcl_safeCreateInterp a
+    tcl_safeCreateInterp b
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [b eval {package require policyB}]
+    tcl_safeDeleteInterp a
+    tcl_safeDeleteInterp b
+    set l
+} {1.0 1.0}
+test safe-4.7 {safe, loading policy, unloading, reloading: clean} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    tcl_safeDeleteInterp a
+    tcl_safeCreateInterp a
+    lappend l [a eval {package require policyA}]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1.0}
+test safe-4.8 {safe, loading two policies - prevented} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [catch {a eval {package require policyB}} msg]
+    lappend l $msg
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1 {security policy policyA already loaded}}
+test safe-4.9 {safe, two interpreters have different policies} {
+    catch {tcl_safeDeleteInterp a}
+    catch {tcl_safeDeleteInterp b}
+    tcl_safeCreateInterp a
+    tcl_safeCreateInterp b
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [b eval {package require policyB}]
+    tcl_safeDeleteInterp a
+    tcl_safeDeleteInterp b
+    set l
+} {1.0 1.0}
+
+test safe-5.1 {unloading runs policy cleanup code} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyC}]
+    tcl_safeDeleteInterp a
+    set l  ;# the cleanup side-effects the global variable "l"
+} {1.0 bye}
+
+# For the following tests we need an auto_path that has the policies and
+# packages directories in it.
+
+lappend auto_path [file join [pwd] policies] \
+	[file join [pwd] policies packages]
+
+proc findPackage {i n} {
+    set l [$i eval {package names}]
+    if {[lsearch $l $n] > -1} {
+	return 1
+    }
+    return 0
+}
+
+test safe-6.1 {loading packages still works} {
+    catch {tcl_safeDeleteInterp a}
+    interp create a
+    set l ""
+    a eval [list set auto_path $auto_path]   
+    lappend l [a eval {package require packageA 1.0}]
+    lappend l [a eval hoohum]
+    lappend l [a eval info proc hoohum]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 bazooka hoohum}
+test safe-6.2 {tcl_safeCreateInterp, loading packages} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require packageA 1.0}]
+    lappend l [a eval hoohum]
+    lappend l [a eval info proc hoohum]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 bazooka hoohum}
+test safe-6.3 {policies vs packages} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [a eval {package require packageA}]
+    lappend l [findPackage a policyA]
+    lappend l [findPackage a packageA]
+    lappend l [findPackage a hohum]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1.0 1 1 0}
+test safe-6.4 {policies vs packages} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [a eval {package require packageA}]
+    lappend l [findPackage a Tcl]
+    lappend l [findPackage a policyA]
+    lappend l [findPackage a hohum]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1.0 1 1 0}
+test safe-6.5 {policies vs packages vs policies} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set l ""
+    lappend l [a eval {package require policyA}]
+    lappend l [a eval {package require packageA}]
+    catch {a eval {package require policyB}} msg
+    lappend l $msg
+    lappend l [findPackage a Tcl]
+    lappend l [findPackage a policyA]
+    lappend l [findPackage a policyB]
+    tcl_safeDeleteInterp a
+    set l
+} {1.0 1.0 {security policy policyA already loaded} 1 1 0}
+
+# The following test checks whether the definition of tcl_endOfWord can be
+# obtained from auto_loading.
+
+test safe-7.1 {test auto-loading in safe interpreters} {
+    catch {tcl_safeDeleteInterp a}
+    tcl_safeCreateInterp a
+    set r [catch {interp eval a {tcl_endOfWord "" 0}} msg]
+    tcl_safeDeleteInterp a
+    list $r $msg
+} {0 -1}
+
+# Restore settings to what they were before this file was sourced:
+
+set auto_path $my_old_auto_path
+unset my_old_auto_path
+
+# set auto_path $old_auto_path
+# unset old_auto_path
diff --git a/contrib/tcl/tests/scan.test b/contrib/tcl/tests/scan.test
index 0b2da90..9f73bf1 100644
--- a/contrib/tcl/tests/scan.test
+++ b/contrib/tcl/tests/scan.test
@@ -5,12 +5,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) scan.test 1.23 96/02/16 08:56:24
+# SCCS: @(#) scan.test 1.25 97/01/21 21:16:03
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -55,6 +55,11 @@ test scan-1.10 {integer scanning} {
     set a {}; set b {}; set c {}; set d {}
     list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
 } {2 1 2 {} {}}
+#
+# The behavior for scaning intergers larger than MAX_INT is
+# not defined by the ANSI spec.  Some implementations wrap the
+# input (-16) some return MAX_INT.
+#
 test scan-1.11 {integer scanning} {nonPortable} {
     set a {}; set b {};
     list [scan "4294967280 4294967280" "%u %d" a b] $a $b
@@ -62,35 +67,44 @@ test scan-1.11 {integer scanning} {nonPortable} {
 
 test scan-2.1 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
-    list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
+    list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] \
+	    [format %.6g $a] [format %.6g $b] [format %.6g $c] $d
 } {3 2.1 -3e+08 0.99962 {}}
 test scan-2.2 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
-    list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
-} {4 -1.0 234.0 5.0 8.2}
+    list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] \
+	    [format %.6g $a] [format %.6g $b] [format %.6g $c] [format %.6g $d]
+} {4 -1 234 5 8.2}
 test scan-2.3 {floating-point scanning} {
     set a {}; set b {}; set c {}
     list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c
 } {3 10000.0 30000.0}
+#
+# Some libc implementations consider 3.e- bad input.  The ANSI
+# spec states that digits must follow the - sign.
+#
 test scan-2.4 {floating-point scanning} {nonPortable} {
     set a {}; set b {}; set c {}
     list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
 } {3 1.0 200.0 3.0}
 test scan-2.5 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
-    list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
-} {4 4.6 99999.7 87.643 118.0}
+    list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] \
+	    [format %.6g $a] [format %.6g $b] [format %.6g $c] [format %.6g $d]
+} {4 4.6 99999.7 87.643 118}
 test scan-2.6 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
-    list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
-} {4 1.2345 0.697 124.0 5e-05}
+    list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] \
+	    [format %.6g $a] [format %.6g $b] [format %.6g $c] [format %.6g $d]
+} {4 1.2345 0.697 124 5e-05}
 test scan-2.7 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
-    list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
+    list [scan "4.6abc" "%f %f %f %f" a b c d] [format %.6g $a] $b $c $d
 } {1 4.6 {} {} {}}
 test scan-2.8 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
-    list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
+    list [scan "4.6 5.2" "%f %f %f %f" a b c d] \
+	    [format %.6g $a] [format %.6g $b] $c $d
 } {2 4.6 5.2 {} {}}
 
 test scan-3.1 {string and character scanning} {
@@ -214,26 +228,6 @@ test scan-6.4 {miscellaneous tests} {
     set a {}
     list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a
 } {0 1 14}
-test scan-6.5 {miscellaneous tests} {
-    catch {unset tcl_precision}
-    set a {}
-    scan 1.111122223333 %f a
-    set a
-} {1.11112}
-test scan-6.6 {miscellaneous tests} {
-    set tcl_precision 10
-    set a {}
-    scan 1.111122223333 %lf a
-    unset tcl_precision
-    set a
-} {1.111122223}
-test scan-6.7 {miscellaneous tests} {
-    set tcl_precision 10
-    set a {}
-    scan 1.111122223333 %f a
-    unset tcl_precision
-    set a
-} {1.111122223}
 
 test scan-7.1 {alignment in results array (TCL_ALIGN)} {
     scan "123 13.6" "%s %f" a b
diff --git a/contrib/tcl/tests/set-old.test b/contrib/tcl/tests/set-old.test
new file mode 100644
index 0000000..17e67f7
--- /dev/null
+++ b/contrib/tcl/tests/set-old.test
@@ -0,0 +1,679 @@
+# Commands covered:  set, unset, array
+#
+# This file includes the original set of tests for Tcl's set command.
+# Since the set command is now compiled, a new set of tests covering
+# the new implementation is in the file "set.test". Sourcing this file
+# into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# 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.
+#
+# SCCS: @(#) set-old.test 1.19 96/09/09 18:36:24
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+proc ignore args {}
+
+# Simple variable operations.
+
+catch {unset a}
+test set-old-1.1 {basic variable setting and unsetting} {
+    set a 22
+} 22
+test set-old-1.2 {basic variable setting and unsetting} {
+    set a 123
+    set a
+} 123
+test set-old-1.3 {basic variable setting and unsetting} {
+    set a xxx
+    format %s $a
+} xxx
+test set-old-1.4 {basic variable setting and unsetting} {
+    set a 44
+    unset a
+    list [catch {set a} msg] $msg
+} {1 {can't read "a": no such variable}}
+
+# Basic array operations.
+
+catch {unset a}
+set a(xyz) 2
+set a(44) 3
+set {a(a long name)} test
+test set-old-2.1 {basic array operations} {
+    lsort [array names a]
+} {44 {a long name} xyz}
+test set-old-2.2 {basic array operations} {
+    set a(44)
+} 3
+test set-old-2.3 {basic array operations} {
+    set a(xyz)
+} 2
+test set-old-2.4 {basic array operations} {
+    set "a(a long name)"
+} test
+test set-old-2.5 {basic array operations} {
+    list [catch {set a(other)} msg] $msg
+} {1 {can't read "a(other)": no such element in array}}
+test set-old-2.6 {basic array operations} {
+    list [catch {set a} msg] $msg
+} {1 {can't read "a": variable is array}}
+test set-old-2.7 {basic array operations} {
+    format %s $a(44)
+} 3
+test set-old-2.8 {basic array operations} {
+    format %s $a(a long name)
+} test
+unset a(44)
+test set-old-2.9 {basic array operations} {
+    lsort [array names a]
+} {{a long name} xyz}
+test set-old-2.10 {basic array operations} {
+    catch {unset b}
+    list [catch {set b(123)} msg] $msg
+} {1 {can't read "b(123)": no such variable}}
+test set-old-2.11 {basic array operations} {
+    catch {unset b}
+    set b 44
+    list [catch {set b(123)} msg] $msg
+} {1 {can't read "b(123)": variable isn't array}}
+test set-old-2.12 {basic array operations} {
+    list [catch {set a 14} msg] $msg
+} {1 {can't set "a": variable is array}}
+unset a
+test set-old-2.13 {basic array operations} {
+    list [catch {set a(xyz)} msg] $msg
+} {1 {can't read "a(xyz)": no such variable}}
+
+# Test the set commands, and exercise the corner cases of the code
+# that parses array references into two parts.
+
+test set-old-3.1 {set command} {
+    list [catch {set} msg] $msg
+} {1 {wrong # args: should be "set varName ?newValue?"}}
+test set-old-3.2 {set command} {
+    list [catch {set x y z} msg] $msg
+} {1 {wrong # args: should be "set varName ?newValue?"}}
+test set-old-3.3 {set command} {
+    catch {unset a}
+    list [catch {set a} msg] $msg
+} {1 {can't read "a": no such variable}}
+test set-old-3.4 {set command} {
+    catch {unset a}
+    set a(14) 83
+    list [catch {set a 22} msg] $msg
+} {1 {can't set "a": variable is array}}
+
+# Test the corner-cases of parsing array names, using set and unset.
+
+test set-old-4.1 {parsing array names} {
+    catch {unset a}
+    set a(()) 44
+    list [catch {array names a} msg] $msg
+} {0 ()}
+test set-old-4.2 {parsing array names} {
+    catch {unset a a(abcd}
+    set a(abcd 33
+    info exists a(abcd
+} 1
+test set-old-4.3 {parsing array names} {
+    catch {unset a a(abcd}
+    set a(abcd 33
+    list [catch {array names a} msg] $msg
+} {0 {}}
+test set-old-4.4 {parsing array names} {
+    catch {unset a abcd)}
+    set abcd) 33
+    info exists abcd)
+} 1
+test set-old-4.5 {parsing array names} {
+    set a(bcd yyy
+    catch {unset a}
+    list [catch {set a(bcd} msg] $msg
+} {0 yyy}
+test set-old-4.6 {parsing array names} {
+    catch {unset a}
+    set a 44
+    list [catch {set a(bcd test} msg] $msg
+} {0 test}
+
+# Errors in reading variables
+
+test set-old-5.1 {errors in reading variables} {
+    catch {unset a}
+    list [catch {set a} msg] $msg
+} {1 {can't read "a": no such variable}}
+test set-old-5.2 {errors in reading variables} {
+    catch {unset a}
+    set a 44
+    list [catch {set a(18)} msg] $msg
+} {1 {can't read "a(18)": variable isn't array}}
+test set-old-5.3 {errors in reading variables} {
+    catch {unset a}
+    set a(6) 44
+    list [catch {set a(18)} msg] $msg
+} {1 {can't read "a(18)": no such element in array}}
+test set-old-5.4 {errors in reading variables} {
+    catch {unset a}
+    set a(6) 44
+    list [catch {set a} msg] $msg
+} {1 {can't read "a": variable is array}}
+
+# Errors and other special cases in writing variables
+
+test set-old-6.1 {creating array during write} {
+    catch {unset a}
+    trace var a rwu ignore
+    list [catch {set a(14) 186} msg] $msg [array names a]
+} {0 186 14}
+test set-old-6.2 {errors in writing variables} {
+    catch {unset a}
+    set a xxx
+    list [catch {set a(14) 186} msg] $msg
+} {1 {can't set "a(14)": variable isn't array}}
+test set-old-6.3 {errors in writing variables} {
+    catch {unset a}
+    set a(100) yyy
+    list [catch {set a 2} msg] $msg
+} {1 {can't set "a": variable is array}}
+test set-old-6.4 {expanding variable size} {
+    catch {unset a}
+    list [set a short] [set a "longer name"] [set a "even longer name"] \
+	    [set a "a much much truly longer name"]
+} {short {longer name} {even longer name} {a much much truly longer name}}
+
+# Unset command, Tcl_UnsetVar procedures
+
+test set-old-7.1 {unset command} {
+    catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
+    set a 44
+    set b 55
+    set c 66
+    set d 77
+    unset a b c
+    list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
+	    [catch {set d(0) 0}]
+} {0 0 0 1}
+test set-old-7.2 {unset command} {
+    list [catch {unset} msg] $msg
+} {1 {wrong # args: should be "unset varName ?varName ...?"}}
+test set-old-7.3 {unset command} {
+    catch {unset a}
+    list [catch {unset a} msg] $msg
+} {1 {can't unset "a": no such variable}}
+test set-old-7.4 {unset command} {
+    catch {unset a}
+    set a 44
+    list [catch {unset a(14)} msg] $msg
+} {1 {can't unset "a(14)": variable isn't array}}
+test set-old-7.5 {unset command} {
+    catch {unset a}
+    set a(0) xx
+    list [catch {unset a(14)} msg] $msg
+} {1 {can't unset "a(14)": no such element in array}}
+test set-old-7.6 {unset command} {
+    catch {unset a}; catch {unset b}; catch {unset c}
+    set a foo
+    set c gorp
+    list [catch {unset a a a(14)} msg] $msg [info exists c]
+} {1 {can't unset "a": no such variable} 1}
+test set-old-7.7 {unsetting globals from within procedures} {
+    set y 0
+    proc p1 {} {
+	global y
+	set z [p2]
+	return [list $z [catch {set y} msg] $msg]
+    }
+    proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
+    p1
+} {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
+test set-old-7.8 {unsetting globals from within procedures} {
+    set y 0
+    proc p1 {} {
+	global y
+	p2
+	return [list [catch {set y 44} msg] $msg]
+    }
+    proc p2 {} {global y; unset y}
+    concat [p1] [list [catch {set y} msg] $msg]
+} {0 44 0 44}
+test set-old-7.9 {unsetting globals from within procedures} {
+    set y 0
+    proc p1 {} {
+	global y
+	unset y
+	return [list [catch {set y 55} msg] $msg]
+    }
+    concat [p1] [list [catch {set y} msg] $msg]
+} {0 55 0 55}
+test set-old-7.10 {unset command} {
+    catch {unset a}
+    set a(14) 22
+    unset a(14)
+    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
+} {1 {can't read "a(14)": no such element in array} 0 {}}
+test set-old-7.11 {unset command} {
+    catch {unset a}
+    set a(14) 22
+    unset a
+    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
+} {1 {can't read "a(14)": no such variable} 0 {}}
+
+# Array command.
+
+test set-old-8.1 {array command} {
+    list [catch {array} msg] $msg
+} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+test set-old-8.2 {array command} {
+    list [catch {array a} msg] $msg
+} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+test set-old-8.3 {array command} {
+    catch {unset a}
+    list [catch {array anymore a b} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.4 {array command} {
+    catch {unset a}
+    set a 44
+    list [catch {array anymore a b} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.5 {array command} {
+    proc foo {} {
+	set a 44
+	upvar 0 a x
+	list [catch {array anymore x b} msg] $msg
+    }
+    foo
+} {1 {"x" isn't an array}}
+test set-old-8.6 {array command} {
+    catch {unset a}
+    set a(22) 3
+    list [catch {array gorp a} msg] $msg
+} {1 {bad option "gorp": should be anymore, donesearch, exists, get, names, nextelement, set, size, or startsearch}}
+test set-old-8.7 {array command, anymore option} {
+    catch {unset a}
+    list [catch {array anymore a x} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.8 {array command, donesearch option} {
+    catch {unset a}
+    list [catch {array donesearch a x} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.9 {array command, exists option} {
+    list [catch {array exists a b} msg] $msg
+} {1 {wrong # args: should be "array exists arrayName"}}
+test set-old-8.10 {array command, exists option} {
+    catch {unset a}
+    array exists a
+} {0}
+test set-old-8.11 {array command, exists option} {
+    catch {unset a}
+    set a(0) 1
+    array exists a
+} {1}
+test set-old-8.12 {array command, get option} {
+    list [catch {array get} msg] $msg
+} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+test set-old-8.13 {array command, get option} {
+    list [catch {array get a b c} msg] $msg
+} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
+test set-old-8.14 {array command, get option} {
+    catch {unset a}
+    array get a
+} {}
+test set-old-8.15 {array command, get option} {
+    catch {unset a}
+    set a(22) 3
+    set {a(long name)} {}
+    array get a
+} {22 3 {long name} {}}
+test set-old-8.16 {array command, get option (unset variable)} {
+    catch {unset a}
+    set a(x) 3
+    trace var a(y) w ignore
+    array get a
+} {x 3}
+test set-old-8.17 {array command, get option, with pattern} {
+    catch {unset a}
+    set a(x1) 3
+    set a(x2) 4
+    set a(x3) 5
+    set a(b1) 24
+    set a(b2) 25
+    array get a x*
+} {x1 3 x2 4 x3 5}
+test set-old-8.18 {array command, names option} {
+    catch {unset a}
+    set a(22) 3
+    list [catch {array names a 4 5} msg] $msg
+} {1 {wrong # args: should be "array names arrayName ?pattern?"}}
+test set-old-8.19 {array command, names option} {
+    catch {unset a}
+    array names a
+} {}
+test set-old-8.20 {array command, names option} {
+    catch {unset a}
+    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
+    list [catch {lsort [array names a]} msg] $msg
+} {0 {22 Textual_name {name with spaces}}}
+test set-old-8.21 {array command, names option} {
+    catch {unset a}
+    set a(22) 3; set a(33) 44;
+    trace var a(xxx) w ignore
+    list [catch {lsort [array names a]} msg] $msg
+} {0 {22 33}}
+test set-old-8.22 {array command, names option} {
+    catch {unset a}
+    set a(22) 3; set a(33) 44;
+    trace var a(xxx) w ignore
+    set a(xxx) value
+    list [catch {lsort [array names a]} msg] $msg
+} {0 {22 33 xxx}}
+test set-old-8.23 {array command, names option} {
+    catch {unset a}
+    set a(axy) 3
+    set a(bxy) 44
+    set a(no) yes
+    set a(xxx) value
+    list [lsort [array names a *xy]] [lsort [array names a]]
+} {{axy bxy} {axy bxy no xxx}}
+test set-old-8.24 {array command, nextelement option} {
+    list [catch {array nextelement a} msg] $msg
+} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
+test set-old-8.25 {array command, nextelement option} {
+    catch {unset a}
+    list [catch {array nextelement a b} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.26 {array command, set option} {
+    list [catch {array set a} msg] $msg
+} {1 {wrong # args: should be "array set arrayName list"}}
+test set-old-8.27 {array command, set option} {
+    list [catch {array set a 1 2} msg] $msg
+} {1 {wrong # args: should be "array set arrayName list"}}
+test set-old-8.28 {array command, set option} {
+    list [catch {array set a "a \{ c"} msg] $msg
+} {1 {unmatched open brace in list}}
+test set-old-8.29 {array command, set option} {
+    catch {unset a}
+    set a 44
+    list [catch {array set a {a b c d}} msg] $msg
+} {1 {can't set "a(a)": variable isn't array}}
+test set-old-8.30 {array command, set option} {
+    catch {unset a}
+    set a(xx) yy
+    array set a {b c d e}
+    array get a
+} {d e xx yy b c}
+test set-old-8.31 {array command, size option} {
+    list [catch {array size a 4} msg] $msg
+} {1 {wrong # args: should be "array size arrayName"}}
+test set-old-8.32 {array command, size option} {
+    catch {unset a}
+    array size a
+} {0}
+test set-old-8.33 {array command, size option} {
+    catch {unset a}
+    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
+    list [catch {array size a} msg] $msg
+} {0 3}
+test set-old-8.34 {array command, size option} {
+    catch {unset a}
+    set a(22) 3; set a(xx) 44; set a(y) xxx
+    unset a(22) a(y) a(xx)
+    list [catch {array size a} msg] $msg
+} {0 0}
+test set-old-8.35 {array command, size option} {
+    catch {unset a}
+    set a(22) 3;
+    trace var a(33) rwu ignore
+    list [catch {array size a} msg] $msg
+} {0 1}
+test set-old-8.36 {array command, startsearch option} {
+    list [catch {array startsearch a b} msg] $msg
+} {1 {wrong # args: should be "array startsearch arrayName"}}
+test set-old-8.37 {array command, startsearch option} {
+    catch {unset a}
+    list [catch {array startsearch a} msg] $msg
+} {1 {"a" isn't an array}}
+
+test set-old-9.1 {ids for array enumeration} {
+    catch {unset a}
+    set a(a) 1
+    list [array st a] [array st a] [array done a s-1-a; array st a] \
+	    [array done a s-2-a; array d a s-3-a; array start a]
+} {s-1-a s-2-a s-3-a s-1-a}
+test set-old-9.2 {array enumeration} {
+    catch {unset a}
+    set a(a) 1
+    set a(b) 1
+    set a(c) 1
+    set x [array startsearch a]
+    list [array nextelement a $x] [array ne a $x] [array next a $x] \
+	    [array next a $x] [array next a $x]
+} {a b c {} {}}
+test set-old-9.3 {array enumeration} {
+    catch {unset a}
+    set a(a) 1
+    set a(b) 1
+    set a(c) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    set z [array startsearch a]
+    list [array nextelement a $x] [array ne a $x] \
+	    [array next a $y] [array next a $z] [array next a $y] \
+	    [array next a $z] [array next a $y] [array next a $z] \
+	    [array next a $y] [array next a $z] [array next a $x] \
+	    [array next a $x]
+} {a b a a b b c c {} {} c {}}
+test set-old-9.4 {array enumeration: stopping searches} {
+    catch {unset a}
+    set a(a) 1
+    set a(b) 1
+    set a(c) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    set z [array startsearch a]
+    list [array next a $x] [array next a $x] [array next a $y] \
+	    [array done a $z; array next a $x] \
+	    [array done a $x; array next a $y] [array next a $y]
+} {a b a c b c}
+test set-old-9.5 {array enumeration: stopping searches} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    array done a $x
+    list [catch {array next a $x} msg] $msg
+} {1 {couldn't find search "s-1-a"}}
+test set-old-9.6 {array enumeration: searches automatically stopped} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    set a(b) 1
+    list [catch {array next a $x} msg] $msg \
+	    [catch {array next a $y} msg2] $msg2
+} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
+test set-old-9.7 {array enumeration: searches automatically stopped} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    set a(a) 2
+    list [catch {array next a $x} msg] $msg \
+	    [catch {array next a $y} msg2] $msg2
+} {0 a 0 a}
+test set-old-9.8 {array enumeration: searches automatically stopped} {
+    catch {unset a}
+    set a(a) 1
+    set a(c) 2
+    set x [array startsearch a]
+    set y [array startsearch a]
+    catch {unset a(c)}
+    list [catch {array next a $x} msg] $msg \
+	    [catch {array next a $y} msg2] $msg2
+} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
+test set-old-9.9 {array enumeration: searches automatically stopped} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    catch {unset a(c)}
+    list [catch {array next a $x} msg] $msg \
+	    [catch {array next a $y} msg2] $msg2
+} {0 a 0 a}
+test set-old-9.10 {array enumeration: searches automatically stopped} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    trace var a(b) r {}
+    list [catch {array next a $x} msg] $msg \
+	    [catch {array next a $y} msg2] $msg2
+} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
+test set-old-9.11 {array enumeration: searches automatically stopped} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    set y [array startsearch a]
+    trace var a(a) r {}
+    list [catch {array next a $x} msg] $msg \
+	    [catch {array next a $y} msg2] $msg2
+} {0 a 0 a}
+test set-old-9.12 {array enumeration with traced undefined elements} {
+    catch {unset a}
+    set a(a) 1
+    trace var a(b) r {}
+    set x [array startsearch a]
+    list [array next a $x] [array next a $x]
+} {a {}}
+
+test set-old-10.1 {array enumeration errors} {
+    list [catch {array start} msg] $msg
+} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+test set-old-10.2 {array enumeration errors} {
+    list [catch {array start a b} msg] $msg
+} {1 {wrong # args: should be "array startsearch arrayName"}}
+test set-old-10.3 {array enumeration errors} {
+    catch {unset a}
+    list [catch {array start a} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-10.4 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a} msg] $msg
+} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
+test set-old-10.5 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a b c} msg] $msg
+} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
+test set-old-10.6 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a a-1-a} msg] $msg
+} {1 {illegal search identifier "a-1-a"}}
+test set-old-10.7 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a sx1-a} msg] $msg
+} {1 {illegal search identifier "sx1-a"}}
+test set-old-10.8 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a s--a} msg] $msg
+} {1 {illegal search identifier "s--a"}}
+test set-old-10.9 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a s-1-b} msg] $msg
+} {1 {search identifier "s-1-b" isn't for variable "a"}}
+test set-old-10.10 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a s-1ba} msg] $msg
+} {1 {illegal search identifier "s-1ba"}}
+test set-old-10.11 {array enumeration errors} {
+    catch {unset a}
+    set a(a) 1
+    set x [array startsearch a]
+    list [catch {array next a s-2-a} msg] $msg
+} {1 {couldn't find search "s-2-a"}}
+test set-old-10.12 {array enumeration errors} {
+    list [catch {array done a} msg] $msg
+} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
+test set-old-10.13 {array enumeration errors} {
+    list [catch {array done a b c} msg] $msg
+} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
+test set-old-10.14 {array enumeration errors} {
+    list [catch {array done a b} msg] $msg
+} {1 {illegal search identifier "b"}}
+test set-old-10.15 {array enumeration errors} {
+    list [catch {array anymore a} msg] $msg
+} {1 {wrong # args: should be "array anymore arrayName searchId"}}
+test set-old-10.16 {array enumeration errors} {
+    list [catch {array any a b c} msg] $msg
+} {1 {wrong # args: should be "array anymore arrayName searchId"}}
+test set-old-10.17 {array enumeration errors} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {array any a bogus} msg] $msg
+} {1 {illegal search identifier "bogus"}}
+
+# Array enumeration with "anymore" option
+
+test set-old-11.1 {array anymore option} {
+    catch {unset a}
+    set a(a) 1
+    set a(b) 2
+    set a(c) 3
+    array startsearch a
+    list [array anymore a s-1-a] [array next a s-1-a] \
+	    [array anymore a s-1-a] [array next a s-1-a] \
+	    [array anymore a s-1-a] [array next a s-1-a] \
+	    [array anymore a s-1-a] [array next a s-1-a] 
+} {1 a 1 b 1 c 0 {}}
+test set-old-11.2 {array anymore option} {
+    catch {unset a}
+    set a(a) 1
+    set a(b) 2
+    set a(c) 3
+    array startsearch a
+    list [array next a s-1-a] [array next a s-1-a] \
+	    [array anymore a s-1-a] [array next a s-1-a] \
+	    [array next a s-1-a] [array anymore a s-1-a] 
+} {a b 1 c {} 0}
+
+# Special check to see that the value of a variable is handled correctly
+# if it is returned as the result of a procedure (must not free the variable
+# string while deleting the call frame).  Errors will only be detected if
+# a memory consistency checker such as Purify is being used.
+
+test set-old-12.1 {cleanup on procedure return} {
+    proc foo {} {
+	set x 12345
+    }
+    foo
+} 12345
+test set-old-12.2 {cleanup on procedure return} {
+    proc foo {} {
+	set x(1) 23456
+    }
+    foo
+} 23456
+
+# Must delete variables when done, since these arrays get used as
+# scalars by other tests.
+
+catch {unset a}
+catch {unset b}
+catch {unset c}
+return ""
diff --git a/contrib/tcl/tests/set.test b/contrib/tcl/tests/set.test
index 8a8d887..4d0f352 100644
--- a/contrib/tcl/tests/set.test
+++ b/contrib/tcl/tests/set.test
@@ -1,677 +1,233 @@
-# Commands covered:  set, unset, array
+# Commands covered:  set
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 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.
 #
-# SCCS: @(#) set.test 1.18 96/02/16 08:56:25
+# SCCS: @(#) set.test 1.6 97/06/23 18:18:54
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
-proc ignore args {}
+catch {unset x}
+catch {unset i}
 
-# Simple variable operations.
-
-catch {unset a}
-test set-1.1 {basic variable setting and unsetting} {
-    set a 22
-} 22
-test set-1.2 {basic variable setting and unsetting} {
-    set a 123
-    set a
-} 123
-test set-1.3 {basic variable setting and unsetting} {
-    set a xxx
-    format %s $a
-} xxx
-test set-1.4 {basic variable setting and unsetting} {
-    set a 44
-    unset a
-    list [catch {set a} msg] $msg
-} {1 {can't read "a": no such variable}}
-
-# Basic array operations.
-
-catch {unset a}
-set a(xyz) 2
-set a(44) 3
-set {a(a long name)} test
-test set-2.1 {basic array operations} {
-    lsort [array names a]
-} {44 {a long name} xyz}
-test set-2.2 {basic array operations} {
-    set a(44)
-} 3
-test set-2.3 {basic array operations} {
-    set a(xyz)
-} 2
-test set-2.4 {basic array operations} {
-    set "a(a long name)"
-} test
-test set-2.5 {basic array operations} {
-    list [catch {set a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-2.6 {basic array operations} {
-    list [catch {set a} msg] $msg
-} {1 {can't read "a": variable is array}}
-test set-2.7 {basic array operations} {
-    format %s $a(44)
-} 3
-test set-2.8 {basic array operations} {
-    format %s $a(a long name)
-} test
-unset a(44)
-test set-2.9 {basic array operations} {
-    lsort [array names a]
-} {{a long name} xyz}
-test set-2.10 {basic array operations} {
-    catch {unset b}
-    list [catch {set b(123)} msg] $msg
-} {1 {can't read "b(123)": no such variable}}
-test set-2.11 {basic array operations} {
-    catch {unset b}
-    set b 44
-    list [catch {set b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-2.12 {basic array operations} {
-    list [catch {set a 14} msg] $msg
-} {1 {can't set "a": variable is array}}
-unset a
-test set-2.13 {basic array operations} {
-    list [catch {set a(xyz)} msg] $msg
-} {1 {can't read "a(xyz)": no such variable}}
-
-# Test the set commands, and exercise the corner cases of the code
-# that parses array references into two parts.
-
-test set-3.1 {set command} {
+test set-1.1 {TclCompileSetCmd: missing variable name} {
     list [catch {set} msg] $msg
 } {1 {wrong # args: should be "set varName ?newValue?"}}
-test set-3.2 {set command} {
-    list [catch {set x y z} msg] $msg
-} {1 {wrong # args: should be "set varName ?newValue?"}}
-test set-3.3 {set command} {
-    catch {unset a}
-    list [catch {set a} msg] $msg
-} {1 {can't read "a": no such variable}}
-test set-3.4 {set command} {
+test set-1.2 {TclCompileSetCmd: simple variable name} {
+    set i 10
+    list [set i] $i
+} {10 10}
+test set-1.3 {TclCompileSetCmd: error compiling variable name} {
+    set i 10
+    catch {set "i"xxx} msg
+    set msg
+} {quoted string doesn't terminate properly}
+test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
+    set i 17
+    list [set "i"] $i
+} {17 17}
+test set-1.5 {TclCompileSetCmd: simple variable name in braces} {
+    catch {unset {a simple var}}
+    set {a simple var} 27
+    list [set {a simple var}] ${a simple var}
+} {27 27}
+test set-1.6 {TclCompileSetCmd: simple array variable name} {
+    catch {unset a}
+    set a(foo) 37
+    list [set a(foo)] $a(foo)
+} {37 37}
+test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
+    set x "i"
+    set i 77
+    list [set $x] $i
+} {77 77}
+test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} {
+    set x "i"
+    set i 77
+    list [set [set x] 2] $i
+} {2 2}
+
+test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} {
+    set i "abcdef"
+    list [set i] $i
+} {abcdef abcdef}
+test set-1.10 {TclCompileSetCmd: only two args => just getting value} {
+    set i {one two}
+    set i
+} {one two}
+
+test set-1.11 {TclCompileSetCmd: simple global name} {
+    proc p {} {
+        global i
+        set i 54
+        set i
+    }
+    p
+} {54}
+test set-1.12 {TclCompileSetCmd: simple local name} {
+    proc p {bar} {
+        set foo $bar
+        set foo
+    }
+    p 999
+} {999}
+test set-1.13 {TclCompileSetCmd: simple but new (unknown) local name} {
+    proc p {} {
+        set bar
+    }
+    catch {p} msg
+    set msg
+} {can't read "bar": no such variable}
+test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
+    proc 260locals {} {
+        # create 260 locals (the last ones with index > 255)
+        set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
+        set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
+        set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
+        set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
+        set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
+        set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
+        set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
+        set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
+        set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
+        set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
+        set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
+        set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
+        set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
+        set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
+        set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
+        set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
+        set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
+        set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
+        set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
+        set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
+        set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
+        set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
+        set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
+        set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
+        set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
+        set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
+        set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
+        set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
+        set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
+        set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
+        set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
+        set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
+        set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
+        set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
+        set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
+        set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
+        set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
+        set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
+        set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
+        set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
+        set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
+        set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
+        set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
+        set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
+        set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
+        set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
+        set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
+        set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
+        set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
+        set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
+        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
+        set z5 0; set z6 0; set z7 0; set z8 0; set z9 1234
+    }
+    260locals
+} {1234}
+test set-1.15 {TclCompileSetCmd: variable is array} {
     catch {unset a}
-    set a(14) 83
-    list [catch {set a 22} msg] $msg
-} {1 {can't set "a": variable is array}}
-
-# Test the corner-cases of parsing array names, using set and unset.
-
-test set-4.1 {parsing array names} {
+    set x 27
+    set x [set a(foo) 11]
     catch {unset a}
-    set a(()) 44
-    list [catch {array names a} msg] $msg
-} {0 ()}
-test set-4.2 {parsing array names} {
-    catch {unset a a(abcd}
-    set a(abcd 33
-    info exists a(abcd
-} 1
-test set-4.3 {parsing array names} {
-    catch {unset a a(abcd}
-    set a(abcd 33
-    list [catch {array names a} msg] $msg
-} {0 {}}
-test set-4.4 {parsing array names} {
-    catch {unset a abcd)}
-    set abcd) 33
-    info exists abcd)
-} 1
-test set-4.5 {parsing array names} {
-    set a(bcd yyy
+    set x
+} 11
+test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
     catch {unset a}
-    list [catch {set a(bcd} msg] $msg
-} {0 yyy}
-test set-4.6 {parsing array names} {
+    set i 5
+    set x 789
+    set a(foo5) 27
+    set x [set a(foo$i)]
     catch {unset a}
-    set a 44
-    list [catch {set a(bcd test} msg] $msg
-} {0 test}
-
-# Errors in reading variables
+    set x
+} 27
 
-test set-5.1 {errors in reading variables} {
-    catch {unset a}
-    list [catch {set a} msg] $msg
-} {1 {can't read "a": no such variable}}
-test set-5.2 {errors in reading variables} {
-    catch {unset a}
-    set a 44
-    list [catch {set a(18)} msg] $msg
-} {1 {can't read "a(18)": variable isn't array}}
-test set-5.3 {errors in reading variables} {
+test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
+    set i 5
+    set i 123
+} 123
+test set-1.18 {TclCompileSetCmd: doing assignment, simple int} {
+    set i 5
+    set i -100
+} -100
+test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} {
+    set i 5
+    set i 0x12MNOP
+    set i
+} {0x12MNOP}
+test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} {
+    set i 25
+    set i "-100"
+} -100
+test set-1.21 {TclCompileSetCmd: doing assignment, in braces} {
+    set i 24
+    set i {126}
+} 126
+test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
+    set i 5
+    set i 200000
+} 200000
+test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
+    set i 25
+    set i 000012345     ;# an octal literal == 5349 decimal
+    list $i [incr i]
+} {000012345 5350}
+
+test set-1.24 {TclCompileSetCmd: too many arguments} {
+    set i 10
+    catch {set i 20 30} msg
+    set msg
+} {wrong # args: should be "set varName ?newValue?"}
+
+test set-2.1 {set command: runtime error, bad variable name} {
+    list [catch {set {"foo}} msg] $msg $errorInfo
+} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+    while executing
+"set {"foo}"}}
+test set-2.2 {set command: runtime error, not array variable} {
+    catch {unset b}
+    set b 44
+    list [catch {set b(123)} msg] $msg
+} {1 {can't read "b(123)": variable isn't array}}
+test set-2.3 {set command: runtime error, errors in reading variables} {
     catch {unset a}
     set a(6) 44
     list [catch {set a(18)} msg] $msg
 } {1 {can't read "a(18)": no such element in array}}
-test set-5.4 {errors in reading variables} {
-    catch {unset a}
-    set a(6) 44
+test set-2.4 {set command: runtime error, readonly variable} {
+    proc readonly args {error "variable is read-only"}
+    set x 123
+    trace var x w readonly
+    list [catch {set x 1} msg] $msg $errorInfo
+} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+    while executing
+"set x 1"}}
+test set-2.5 {set command: runtime error, basic array operations} {
+    list [catch {set a(other)} msg] $msg
+} {1 {can't read "a(other)": no such element in array}}
+test set-2.6 {set command: runtime error, basic array operations} {
     list [catch {set a} msg] $msg
 } {1 {can't read "a": variable is array}}
 
-# Errors and other special cases in writing variables
-
-test set-6.1 {creating array during write} {
-    catch {unset a}
-    trace var a rwu ignore
-    list [catch {set a(14) 186} msg] $msg [array names a]
-} {0 186 14}
-test set-6.2 {errors in writing variables} {
-    catch {unset a}
-    set a xxx
-    list [catch {set a(14) 186} msg] $msg
-} {1 {can't set "a(14)": variable isn't array}}
-test set-6.3 {errors in writing variables} {
-    catch {unset a}
-    set a(100) yyy
-    list [catch {set a 2} msg] $msg
-} {1 {can't set "a": variable is array}}
-test set-6.4 {expanding variable size} {
-    catch {unset a}
-    list [set a short] [set a "longer name"] [set a "even longer name"] \
-	    [set a "a much much truly longer name"]
-} {short {longer name} {even longer name} {a much much truly longer name}}
-
-# Unset command, Tcl_UnsetVar procedures
-
-test set-7.1 {unset command} {
-    catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
-    set a 44
-    set b 55
-    set c 66
-    set d 77
-    unset a b c
-    list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
-	    [catch {set d(0) 0}]
-} {0 0 0 1}
-test set-7.2 {unset command} {
-    list [catch {unset} msg] $msg
-} {1 {wrong # args: should be "unset varName ?varName ...?"}}
-test set-7.3 {unset command} {
-    catch {unset a}
-    list [catch {unset a} msg] $msg
-} {1 {can't unset "a": no such variable}}
-test set-7.4 {unset command} {
-    catch {unset a}
-    set a 44
-    list [catch {unset a(14)} msg] $msg
-} {1 {can't unset "a(14)": variable isn't array}}
-test set-7.5 {unset command} {
-    catch {unset a}
-    set a(0) xx
-    list [catch {unset a(14)} msg] $msg
-} {1 {can't unset "a(14)": no such element in array}}
-test set-7.6 {unset command} {
-    catch {unset a}; catch {unset b}; catch {unset c}
-    set a foo
-    set c gorp
-    list [catch {unset a a a(14)} msg] $msg [info exists c]
-} {1 {can't unset "a": no such variable} 1}
-test set-7.7 {unsetting globals from within procedures} {
-    set y 0
-    proc p1 {} {
-	global y
-	set z [p2]
-	return [list $z [catch {set y} msg] $msg]
-    }
-    proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
-    p1
-} {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
-test set-7.8 {unsetting globals from within procedures} {
-    set y 0
-    proc p1 {} {
-	global y
-	p2
-	return [list [catch {set y 44} msg] $msg]
-    }
-    proc p2 {} {global y; unset y}
-    concat [p1] [list [catch {set y} msg] $msg]
-} {0 44 0 44}
-test set-7.9 {unsetting globals from within procedures} {
-    set y 0
-    proc p1 {} {
-	global y
-	unset y
-	return [list [catch {set y 55} msg] $msg]
-    }
-    concat [p1] [list [catch {set y} msg] $msg]
-} {0 55 0 55}
-test set-7.10 {unset command} {
-    catch {unset a}
-    set a(14) 22
-    unset a(14)
-    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
-} {1 {can't read "a(14)": no such element in array} 0 {}}
-test set-7.11 {unset command} {
-    catch {unset a}
-    set a(14) 22
-    unset a
-    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
-} {1 {can't read "a(14)": no such variable} 0 {}}
-
-# Array command.
-
-test set-8.1 {array command} {
-    list [catch {array} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
-test set-8.2 {array command} {
-    list [catch {array a} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
-test set-8.3 {array command} {
-    catch {unset a}
-    list [catch {array anymore a b} msg] $msg
-} {1 {"a" isn't an array}}
-test set-8.4 {array command} {
-    catch {unset a}
-    set a 44
-    list [catch {array anymore a b} msg] $msg
-} {1 {"a" isn't an array}}
-test set-8.5 {array command} {
-    proc foo {} {
-	set a 44
-	upvar 0 a x
-	list [catch {array anymore x b} msg] $msg
-    }
-    foo
-} {1 {"x" isn't an array}}
-test set-8.6 {array command} {
-    catch {unset a}
-    set a(22) 3
-    list [catch {array gorp a} msg] $msg
-} {1 {bad option "gorp": should be anymore, donesearch, exists, get, names, nextelement, set, size, or startsearch}}
-test set-8.7 {array command, anymore option} {
-    catch {unset a}
-    list [catch {array anymore a x} msg] $msg
-} {1 {"a" isn't an array}}
-test set-8.8 {array command, donesearch option} {
-    catch {unset a}
-    list [catch {array donesearch a x} msg] $msg
-} {1 {"a" isn't an array}}
-test set-8.9 {array command, exists option} {
-    list [catch {array exists a b} msg] $msg
-} {1 {wrong # args: should be "array exists arrayName"}}
-test set-8.10 {array command, exists option} {
-    catch {unset a}
-    array exists a
-} {0}
-test set-8.11 {array command, exists option} {
-    catch {unset a}
-    set a(0) 1
-    array exists a
-} {1}
-test set-8.12 {array command, get option} {
-    list [catch {array get} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
-test set-8.13 {array command, get option} {
-    list [catch {array get a b c} msg] $msg
-} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
-test set-8.14 {array command, get option} {
-    catch {unset a}
-    array get a
-} {}
-test set-8.15 {array command, get option} {
-    catch {unset a}
-    set a(22) 3
-    set {a(long name)} {}
-    array get a
-} {22 3 {long name} {}}
-test set-8.16 {array command, get option (unset variable)} {
-    catch {unset a}
-    set a(x) 3
-    trace var a(y) w ignore
-    array get a
-} {x 3}
-test set-8.17 {array command, get option, with pattern} {
-    catch {unset a}
-    set a(x1) 3
-    set a(x2) 4
-    set a(x3) 5
-    set a(b1) 24
-    set a(b2) 25
-    array get a x*
-} {x1 3 x2 4 x3 5}
-test set-8.18 {array command, names option} {
-    catch {unset a}
-    set a(22) 3
-    list [catch {array names a 4 5} msg] $msg
-} {1 {wrong # args: should be "array names arrayName ?pattern?"}}
-test set-8.19 {array command, names option} {
-    catch {unset a}
-    array names a
-} {}
-test set-8.20 {array command, names option} {
-    catch {unset a}
-    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
-    list [catch {lsort [array names a]} msg] $msg
-} {0 {22 Textual_name {name with spaces}}}
-test set-8.21 {array command, names option} {
-    catch {unset a}
-    set a(22) 3; set a(33) 44;
-    trace var a(xxx) w ignore
-    list [catch {lsort [array names a]} msg] $msg
-} {0 {22 33}}
-test set-8.22 {array command, names option} {
-    catch {unset a}
-    set a(22) 3; set a(33) 44;
-    trace var a(xxx) w ignore
-    set a(xxx) value
-    list [catch {lsort [array names a]} msg] $msg
-} {0 {22 33 xxx}}
-test set-8.23 {array command, names option} {
-    catch {unset a}
-    set a(axy) 3
-    set a(bxy) 44
-    set a(no) yes
-    set a(xxx) value
-    list [lsort [array names a *xy]] [lsort [array names a]]
-} {{axy bxy} {axy bxy no xxx}}
-test set-8.24 {array command, nextelement option} {
-    list [catch {array nextelement a} msg] $msg
-} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
-test set-8.25 {array command, nextelement option} {
-    catch {unset a}
-    list [catch {array nextelement a b} msg] $msg
-} {1 {"a" isn't an array}}
-test set-8.26 {array command, set option} {
-    list [catch {array set a} msg] $msg
-} {1 {wrong # args: should be "array set arrayName list"}}
-test set-8.27 {array command, set option} {
-    list [catch {array set a 1 2} msg] $msg
-} {1 {wrong # args: should be "array set arrayName list"}}
-test set-8.28 {array command, set option} {
-    list [catch {array set a "a \{ c"} msg] $msg
-} {1 {unmatched open brace in list}}
-test set-8.29 {array command, set option} {
-    catch {unset a}
-    set a 44
-    list [catch {array set a {a b c d}} msg] $msg
-} {1 {can't set "a(a)": variable isn't array}}
-test set-8.30 {array command, set option} {
-    catch {unset a}
-    set a(xx) yy
-    array set a {b c d e}
-    array get a
-} {d e xx yy b c}
-test set-8.31 {array command, size option} {
-    list [catch {array size a 4} msg] $msg
-} {1 {wrong # args: should be "array size arrayName"}}
-test set-8.32 {array command, size option} {
-    catch {unset a}
-    array size a
-} {0}
-test set-8.33 {array command, size option} {
-    catch {unset a}
-    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
-    list [catch {array size a} msg] $msg
-} {0 3}
-test set-8.34 {array command, size option} {
-    catch {unset a}
-    set a(22) 3; set a(xx) 44; set a(y) xxx
-    unset a(22) a(y) a(xx)
-    list [catch {array size a} msg] $msg
-} {0 0}
-test set-8.35 {array command, size option} {
-    catch {unset a}
-    set a(22) 3;
-    trace var a(33) rwu ignore
-    list [catch {array size a} msg] $msg
-} {0 1}
-test set-8.36 {array command, startsearch option} {
-    list [catch {array startsearch a b} msg] $msg
-} {1 {wrong # args: should be "array startsearch arrayName"}}
-test set-8.37 {array command, startsearch option} {
-    catch {unset a}
-    list [catch {array startsearch a} msg] $msg
-} {1 {"a" isn't an array}}
-
-test set-9.1 {ids for array enumeration} {
-    catch {unset a}
-    set a(a) 1
-    list [array st a] [array st a] [array done a s-1-a; array st a] \
-	    [array done a s-2-a; array d a s-3-a; array start a]
-} {s-1-a s-2-a s-3-a s-1-a}
-test set-9.2 {array enumeration} {
-    catch {unset a}
-    set a(a) 1
-    set a(b) 1
-    set a(c) 1
-    set x [array startsearch a]
-    list [array nextelement a $x] [array ne a $x] [array next a $x] \
-	    [array next a $x] [array next a $x]
-} {a b c {} {}}
-test set-9.3 {array enumeration} {
-    catch {unset a}
-    set a(a) 1
-    set a(b) 1
-    set a(c) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    set z [array startsearch a]
-    list [array nextelement a $x] [array ne a $x] \
-	    [array next a $y] [array next a $z] [array next a $y] \
-	    [array next a $z] [array next a $y] [array next a $z] \
-	    [array next a $y] [array next a $z] [array next a $x] \
-	    [array next a $x]
-} {a b a a b b c c {} {} c {}}
-test set-9.4 {array enumeration: stopping searches} {
-    catch {unset a}
-    set a(a) 1
-    set a(b) 1
-    set a(c) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    set z [array startsearch a]
-    list [array next a $x] [array next a $x] [array next a $y] \
-	    [array done a $z; array next a $x] \
-	    [array done a $x; array next a $y] [array next a $y]
-} {a b a c b c}
-test set-9.5 {array enumeration: stopping searches} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    array done a $x
-    list [catch {array next a $x} msg] $msg
-} {1 {couldn't find search "s-1-a"}}
-test set-9.6 {array enumeration: searches automatically stopped} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    set a(b) 1
-    list [catch {array next a $x} msg] $msg \
-	    [catch {array next a $y} msg2] $msg2
-} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
-test set-9.7 {array enumeration: searches automatically stopped} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    set a(a) 2
-    list [catch {array next a $x} msg] $msg \
-	    [catch {array next a $y} msg2] $msg2
-} {0 a 0 a}
-test set-9.8 {array enumeration: searches automatically stopped} {
-    catch {unset a}
-    set a(a) 1
-    set a(c) 2
-    set x [array startsearch a]
-    set y [array startsearch a]
-    catch {unset a(c)}
-    list [catch {array next a $x} msg] $msg \
-	    [catch {array next a $y} msg2] $msg2
-} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
-test set-9.9 {array enumeration: searches automatically stopped} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    catch {unset a(c)}
-    list [catch {array next a $x} msg] $msg \
-	    [catch {array next a $y} msg2] $msg2
-} {0 a 0 a}
-test set-9.10 {array enumeration: searches automatically stopped} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    trace var a(b) r {}
-    list [catch {array next a $x} msg] $msg \
-	    [catch {array next a $y} msg2] $msg2
-} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
-test set-9.11 {array enumeration: searches automatically stopped} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    set y [array startsearch a]
-    trace var a(a) r {}
-    list [catch {array next a $x} msg] $msg \
-	    [catch {array next a $y} msg2] $msg2
-} {0 a 0 a}
-test set-9.12 {array enumeration with traced undefined elements} {
-    catch {unset a}
-    set a(a) 1
-    trace var a(b) r {}
-    set x [array startsearch a]
-    list [array next a $x] [array next a $x]
-} {a {}}
-
-test set-10.1 {array enumeration errors} {
-    list [catch {array start} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
-test set-10.2 {array enumeration errors} {
-    list [catch {array start a b} msg] $msg
-} {1 {wrong # args: should be "array startsearch arrayName"}}
-test set-10.3 {array enumeration errors} {
-    catch {unset a}
-    list [catch {array start a} msg] $msg
-} {1 {"a" isn't an array}}
-test set-10.4 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a} msg] $msg
-} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
-test set-10.5 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a b c} msg] $msg
-} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
-test set-10.6 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a a-1-a} msg] $msg
-} {1 {illegal search identifier "a-1-a"}}
-test set-10.7 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a sx1-a} msg] $msg
-} {1 {illegal search identifier "sx1-a"}}
-test set-10.8 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a s--a} msg] $msg
-} {1 {illegal search identifier "s--a"}}
-test set-10.9 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a s-1-b} msg] $msg
-} {1 {search identifier "s-1-b" isn't for variable "a"}}
-test set-10.10 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a s-1ba} msg] $msg
-} {1 {illegal search identifier "s-1ba"}}
-test set-10.11 {array enumeration errors} {
-    catch {unset a}
-    set a(a) 1
-    set x [array startsearch a]
-    list [catch {array next a s-2-a} msg] $msg
-} {1 {couldn't find search "s-2-a"}}
-test set-10.12 {array enumeration errors} {
-    list [catch {array done a} msg] $msg
-} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
-test set-10.13 {array enumeration errors} {
-    list [catch {array done a b c} msg] $msg
-} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
-test set-10.14 {array enumeration errors} {
-    list [catch {array done a b} msg] $msg
-} {1 {illegal search identifier "b"}}
-test set-10.15 {array enumeration errors} {
-    list [catch {array anymore a} msg] $msg
-} {1 {wrong # args: should be "array anymore arrayName searchId"}}
-test set-10.16 {array enumeration errors} {
-    list [catch {array any a b c} msg] $msg
-} {1 {wrong # args: should be "array anymore arrayName searchId"}}
-test set-10.17 {array enumeration errors} {
-    catch {unset a}
-    set a(0) 44
-    list [catch {array any a bogus} msg] $msg
-} {1 {illegal search identifier "bogus"}}
-
-# Array enumeration with "anymore" option
-
-test set-11.1 {array anymore option} {
-    catch {unset a}
-    set a(a) 1
-    set a(b) 2
-    set a(c) 3
-    array startsearch a
-    list [array anymore a s-1-a] [array next a s-1-a] \
-	    [array anymore a s-1-a] [array next a s-1-a] \
-	    [array anymore a s-1-a] [array next a s-1-a] \
-	    [array anymore a s-1-a] [array next a s-1-a] 
-} {1 a 1 b 1 c 0 {}}
-test set-11.2 {array anymore option} {
-    catch {unset a}
-    set a(a) 1
-    set a(b) 2
-    set a(c) 3
-    array startsearch a
-    list [array next a s-1-a] [array next a s-1-a] \
-	    [array anymore a s-1-a] [array next a s-1-a] \
-	    [array next a s-1-a] [array anymore a s-1-a] 
-} {a b 1 c {} 0}
-
-# Special check to see that the value of a variable is handled correctly
-# if it is returned as the result of a procedure (must not free the variable
-# string while deleting the call frame).  Errors will only be detected if
-# a memory consistency checker such as Purify is being used.
-
-test set-12.1 {cleanup on procedure return} {
-    proc foo {} {
-	set x 12345
-    }
-    foo
-} 12345
-test set-12.2 {cleanup on procedure return} {
-    proc foo {} {
-	set x(1) 23456
-    }
-    foo
-} 23456
-
-# Must delete variables when done, since these arrays get used as
-# scalars by other tests.
-
 catch {unset a}
 catch {unset b}
-catch {unset c}
+catch {unset i}
+catch {unset x}
 return ""
diff --git a/contrib/tcl/tests/socket.test b/contrib/tcl/tests/socket.test
index 8a356f6..2389016 100644
--- a/contrib/tcl/tests/socket.test
+++ b/contrib/tcl/tests/socket.test
@@ -59,7 +59,7 @@
 # listening at port 2048. If all fails, a message is printed and the tests
 # using the remote server are not performed.
 #
-# SCCS: @(#) socket.test 1.62 96/08/01 15:57:49
+# SCCS: @(#) socket.test 1.75 97/04/30 15:42:58
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -102,7 +102,8 @@ if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
 # platforms that do not support exec, the remote server must be started
 # by the user before running the tests.
 
-set remotePid -1
+set remoteProcChan ""
+set commandSocket ""
 if {$doTestsWithRemoteServer == 1} {
     catch {close $commandSocket}
     if {[catch {set commandSocket [socket $remoteServerIP \
@@ -112,10 +113,12 @@ if {$doTestsWithRemoteServer == 1} {
 	    set doTestsWithRemoteServer 0
 	} else {
 	    set remoteServerIP localhost
-	    if {[catch {set remotePid [exec $tcltest remote.tcl \
-						-serverIsSilent \
-						-port $remoteServerPort \
-						-address $remoteServerIP &]} \
+	    if {[catch {set remoteProcChan \
+				[open "|$tcltest remote.tcl \
+					-serverIsSilent \
+					-port $remoteServerPort \
+					-address $remoteServerIP" \
+					w+]} \
 		   msg] == 0} {
 		after 1000
 		if {[catch {set commandSocket [socket $remoteServerIP \
@@ -233,6 +236,7 @@ test socket-2.1 {tcp connection} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set timer [after 2000 "set x timed_out"]
 	set f [socket -server accept 2828]
 	proc accept {file addr port} {
 	    global x
@@ -241,8 +245,9 @@ test socket-2.1 {tcp connection} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $timer
 	close $f
-	puts done
+	puts $x
     }
     close $f
     set f [open "|$tcltest script" r]
@@ -267,6 +272,7 @@ test socket-2.2 {tcp connection with client port specified} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set timer [after 2000 "set x done"]
         set f [socket -server accept 2828]
 	proc accept {file addr port} {
             global x
@@ -276,6 +282,7 @@ test socket-2.2 {tcp connection with client port specified} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $timer
 	close $f
     }
     close $f
@@ -299,6 +306,7 @@ test socket-2.3 {tcp connection with client interface specified} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set timer [after 2000 "set x done"]
         set f [socket  -server accept 2828]
 	proc accept {file addr port} {
             global x
@@ -308,6 +316,7 @@ test socket-2.3 {tcp connection with client interface specified} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $timer
 	close $f
     }
     close $f
@@ -328,6 +337,7 @@ test socket-2.4 {tcp connection with server interface specified} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set timer [after 2000 "set x done"]
         set f [socket -server accept -myaddr [info hostname] 2828]
 	proc accept {file addr port} {
             global x
@@ -337,6 +347,7 @@ test socket-2.4 {tcp connection with server interface specified} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $timer
 	close $f
     }
     close $f
@@ -357,6 +368,7 @@ test socket-2.5 {tcp connection with redundant server port} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set timer [after 2000 "set x done"]
         set f [socket -server accept 2828]
 	proc accept {file addr port} {
             global x
@@ -366,6 +378,7 @@ test socket-2.5 {tcp connection with redundant server port} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $timer
 	close $f
     }
     close $f
@@ -396,13 +409,14 @@ test socket-2.7 {echo server, one line} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set timer [after 2000 "set x done"]
 	set f [socket -server accept 2828]
 	proc accept {s a p} {
             fileevent $s readable [list echo $s]
 	    fconfigure $s -translation lf -buffering line
         }
 	proc echo {s} {
-             set l [gets $s]
+	     set l [gets $s]
              if {[eof $s]} {
                  global x
                  close $s
@@ -413,6 +427,7 @@ test socket-2.7 {echo server, one line} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $timer
 	close $f
 	puts done
     }
@@ -451,7 +466,9 @@ test socket-2.8 {echo server, loop 50 times, single connection} {unixOrPc} {
 	}
 	set i 0
 	puts ready
+	set timer [after 20000 "set x done"]
 	vwait x
+	after cancel $timer
 	close $f
 	puts "done $i"
     }
@@ -483,13 +500,12 @@ test socket-2.9 {socket conflict} {unixOrPc} {
     set x
 } {1 {couldn't open socket: address already in use
     while executing
-"socket -server accept 2828"
-    invoked from within
-"set f [socket -server accept 2828]..."
+"set f [socket -server accept 2828]"
     (file "script" line 1)}}
 test socket-2.10 {close on accept, accepted socket lives} {
     set done 0
-    set ss [socket -server accept 2828]
+    set timer [after 20000 "set done timed_out"]
+    set ss [socket -server accept 2830]
     proc accept {s a p} {
 	global ss
 	close $ss
@@ -502,10 +518,11 @@ test socket-2.10 {close on accept, accepted socket lives} {
 	close $s
 	set done 1
     }
-    set cs [socket [info hostname] 2828]
+    set cs [socket [info hostname] 2830]
     puts $cs hello
     close $cs
     vwait done
+    after cancel $timer
     set done
 } 1
 
@@ -531,6 +548,9 @@ test socket-3.2 {server with several clients} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
+	set t1 [after 30000 "set x timed_out"]
+	set t2 [after 31000 "set x timed_out"]
+	set t3 [after 32000 "set x timed_out"]
 	set counter 0
 	set s [socket -server accept 2828]
 	proc accept {s a p} {
@@ -549,10 +569,13 @@ test socket-3.2 {server with several clients} {unixOrPc} {
 	}
 	puts ready
 	vwait x
+	after cancel $t1
 	vwait x
+	after cancel $t2
 	vwait x
+	after cancel $t3
 	close $s
-	puts done
+	puts $x
     }
     close $f
     set f [open "|$tcltest script" r+]
@@ -615,6 +638,9 @@ test socket-4.1 {server with several clients} {unixOrPc} {
             puts $s $l
         }
     }
+    set t1 [after 30000 "set x timed_out"]
+    set t2 [after 31000 "set x timed_out"]
+    set t3 [after 32000 "set x timed_out"]
     set s [socket -server accept 2828]
     puts $p1 open
     puts $p2 open
@@ -622,11 +648,14 @@ test socket-4.1 {server with several clients} {unixOrPc} {
     vwait x
     vwait x
     vwait x
+    after cancel $t1
+    after cancel $t2
+    after cancel $t3
     close $s
     set l ""
-    lappend l [list p1 [gets $p1]]
-    lappend l [list p2 [gets $p2]]
-    lappend l [list p3 [gets $p3]]
+    lappend l [list p1 [gets $p1] $x]
+    lappend l [list p2 [gets $p2] $x]
+    lappend l [list p3 [gets $p3] $x]
     puts $p1 bye
     puts $p2 bye
     puts $p3 bye
@@ -634,7 +663,7 @@ test socket-4.1 {server with several clients} {unixOrPc} {
     close $p2
     close $p3
     set l
-} {{p1 bye} {p2 bye} {p3 bye}}
+} {{p1 bye done} {p2 bye done} {p3 bye done}}
 test socket-4.2 {byte order problems, socket numbers, htons} {
     set x ok
     if {[catch {socket -server dodo 0x3000} msg]} {
@@ -693,7 +722,9 @@ test socket-6.1 {accept callback error} {unixOrPc} {
     set s [socket -server accept 2848]
     puts $f hello
     close $f
+    set timer [after 10000 "set x timed_out"]
     vwait x
+    after cancel $timer
     close $s
     rename bgerror {}
     set x
@@ -703,84 +734,93 @@ test socket-7.1 {testing socket specific options} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
-	socket -server accept 2828
+	socket -server accept 2820
 	proc accept args {
 	    global x
 	    set x done
 	}
 	puts ready
+	set timer [after 10000 "set x timed_out"]
 	vwait x
+	after cancel $timer
     }
     close $f
     set f [open "|$tcltest script" r]
     gets $f
-    set s [socket localhost 2828]
+    set s [socket localhost 2820]
     set p [fconfigure $s -peername]
     close $s
     close $f
     set l ""
     lappend l [string compare [lindex $p 0] 127.0.0.1]
-    lappend l [string compare [lindex $p 2] 2828]
+    lappend l [string compare [lindex $p 2] 2820]
     lappend l [llength $p]
 } {0 0 3}
 test socket-7.2 {testing socket specific options} {unixOrPc} {
     removeFile script
     set f [open script w]
     puts $f {
-	socket -server accept 2828
+	socket -server accept 2821
 	proc accept args {
 	    global x
 	    set x done
 	}
 	puts ready
+	set timer [after 10000 "set x timed_out"]
 	vwait x
+	after cancel $timer
     }
     close $f
     set f [open "|$tcltest script" r]
     gets $f
-    set s [socket localhost 2828]
+    set s [socket localhost 2821]
     set p [fconfigure $s -sockname]
     close $s
     close $f
     set l ""
     lappend l [llength $p]
     lappend l [lindex $p 0]
-    lappend l [expr [lindex $p 2] == 2828]
+    lappend l [expr [lindex $p 2] == 2821]
 } {3 127.0.0.1 0}
 test socket-7.3 {testing socket specific options} {
-    set s [socket -server accept 2828]
+    set s [socket -server accept 2822]
     set l [fconfigure $s]
     close $s
+    update
     llength $l
 } 10
 test socket-7.4 {testing socket specific options} {
-    set s [socket -server accept 2828]
+    set s [socket -server accept 2823]
     proc accept {s a p} {
 	global x
 	set x [fconfigure $s -sockname]
 	close $s
     }
-    set s1 [socket [info hostname] 2828]
+    set s1 [socket [info hostname] 2823]
+    set timer [after 10000 "set x timed_out"]
     vwait x
+    after cancel $timer
     close $s
     close $s1
     set l ""
     lappend l [lindex $x 2] [llength $x]
-} {2828 3}
+} {2823 3}
 test socket-7.5 {testing socket specific options} {unixOrPc} {
-    set s [socket -server accept 2828]
+    set s [socket -server accept 2829]
     proc accept {s a p} {
 	global x
 	set x [fconfigure $s -sockname]
 	close $s
     }
-    set s1 [socket localhost 2828]
+    set s1 [socket localhost 2829]
+    set timer [after 10000 "set x timed_out"]
     vwait x
+    after cancel $timer
     close $s
     close $s1
     set l ""
     lappend l [lindex $x 0] [lindex $x 2] [llength $x]
-} {127.0.0.1 2828 3}
+} {127.0.0.1 2829 3}
 
 test socket-8.1 {testing -async flag on sockets} {
     # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
@@ -797,14 +837,14 @@ test socket-8.1 {testing -async flag on sockets} {
     # problem, please email jyl@eng.sun.com. We have not observed this
     # failure on Solaris 2.5, so another option (instead of installing
     # these patches) is to upgrade to Solaris 2.5.
-    set s [socket -server accept 2828]
+    set s [socket -server accept 2830]
     proc accept {s a p} {
 	global x
 	puts $s bye
 	close $s
 	set x done
     }
-    set s1 [socket -async [info hostname] 2828]
+    set s1 [socket -async [info hostname] 2830]
     vwait x
     set z [gets $s1]
     close $s
@@ -834,11 +874,13 @@ test socket-9.1 {testing spurious events} {
 	fconfigure $s -buffering none -blocking off
 	fileevent $s readable [list readlittle $s]
     }
-    set s [socket -server accept 2828]
-    set c [socket [info hostname] 2828]
+    set s [socket -server accept 2831]
+    set c [socket [info hostname] 2831]
     puts -nonewline $c 01234567890123456789012345678901234567890123456789
     close $c
+    set timer [after 10000 "set done timed_out"]
     vwait done
+    after cancel $timer
     close $s
     list $spurious $len
 } {0 50}
@@ -849,7 +891,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {
     for {set i 0} {$i < 16} {incr i} {
 	set secondblock "b$secondblock$secondblock"
     }
-    set l [socket -server accept 8080]
+    set l [socket -server accept 2832]
     proc accept {s a p} {
 	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
 		-buffering line
@@ -870,7 +912,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {
 	puts -nonewline $s $secondblock
 	close $s
     }
-    set s [socket [info hostname] 8080]
+    set s [socket [info hostname] 2832]
     fconfigure $s -blocking 0 -trans lf -buffering line
     set count 0
     puts $s hello
@@ -884,10 +926,51 @@ test socket-9.2 {testing async write, fileevents, flush on close} {
 	}
     }
     fileevent $s readable "readit $s"
+    set timer [after 10000 "set done timed_out"]
     vwait done
+    after cancel $timer
     close $l
     set count
 } 65566
+test socket-9.3 {testing EOF stickyness} {
+    proc count_to_eof {s} {
+	global count done timer
+	set l [gets $s]
+	if {[eof $s]} {
+	    incr count
+	    if {$count > 9} {
+		close $s
+		set done true
+		set count {eof is sticky}
+		after cancel $timer
+	    }
+	}
+    }
+    proc timerproc {} {
+	global done count c
+	set done true
+	set count {timer went off, eof is not sticky}
+	close $c
+    }	
+    set count 0
+    set done false
+    proc write_then_close {s} {
+	puts $s bye
+	close $s
+    }
+    proc accept {s a p} {
+	fconfigure $s -buffering line -translation lf
+	fileevent $s writable "write_then_close $s"
+    }
+    set s [socket -server accept 2833]
+    set c [socket [info hostname] 2833]
+    fconfigure $c -blocking off -buffering line -translation lf
+    fileevent $c readable "count_to_eof $c"
+    set timer [after 1000 timerproc]
+    vwait done
+    close $s
+    set count
+} {eof is sticky}
 
 removeFile script
 
@@ -902,13 +985,13 @@ if {$doTestsWithRemoteServer == 0} {
 
 test socket-10.1 {tcp connection} {
     sendCommand {
-	set socket9_1_test_server [socket -server accept 2828]
+	set socket9_1_test_server [socket -server accept 2834]
 	proc accept {s a p} {
 	    puts $s done
 	    close $s
 	}
     }
-    set s [socket $remoteServerIP 2828]
+    set s [socket $remoteServerIP 2834]
     set r [gets $s]
     close $s
     sendCommand {close $socket9_1_test_server}
@@ -921,13 +1004,13 @@ test socket-10.2 {client specifies its port} {
 	set port [expr 2048 + [pid]%1024]
     }
     sendCommand {
-	set socket9_2_test_server [socket -server accept 2828]
+	set socket9_2_test_server [socket -server accept 2835]
 	proc accept {s a p} {
 	    puts $s $p
 	    close $s
 	}
     }
-    set s [socket -myport $port $remoteServerIP 2828]
+    set s [socket -myport $port $remoteServerIP 2835]
     set r [gets $s]
     close $s
     sendCommand {close $socket9_2_test_server}
@@ -943,7 +1026,7 @@ test socket-10.2 {client specifies its port} {
 #
 test socket-10.5 {trying to connect, no server} {
     set status ok
-    if {![catch {set s [socket $remoteServerIp 2828]}]} {
+    if {![catch {set s [socket $remoteServerIp 2836]}]} {
 	if {![catch {gets $s}]} {
 	    set status broken
 	}
@@ -953,7 +1036,7 @@ test socket-10.5 {trying to connect, no server} {
 } ok
 test socket-10.6 {remote echo, one line} {
     sendCommand {
-	set socket10_6_test_server [socket -server accept 2828]
+	set socket10_6_test_server [socket -server accept 2836]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -967,7 +1050,7 @@ test socket-10.6 {remote echo, one line} {
 	    }
 	}
     }
-    set f [socket $remoteServerIP 2828]
+    set f [socket $remoteServerIP 2836]
     fconfigure $f -translation crlf -buffering line
     puts $f hello
     set r [gets $f]
@@ -977,7 +1060,7 @@ test socket-10.6 {remote echo, one line} {
 } hello
 test socket-10.7 {remote echo, 50 lines} {
     sendCommand {
-	set socket10_7_test_server [socket -server accept 2828]
+	set socket10_7_test_server [socket -server accept 2836]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -991,7 +1074,7 @@ test socket-10.7 {remote echo, 50 lines} {
 	    }
 	}
     }
-    set f [socket $remoteServerIP 2828]
+    set f [socket $remoteServerIP 2836]
     fconfigure $f -translation crlf -buffering line
     for {set cnt 0} {$cnt < 50} {incr cnt} {
 	puts $f "hello, $cnt"
@@ -1005,13 +1088,13 @@ test socket-10.7 {remote echo, 50 lines} {
 } 50
 # Macintosh sockets can have more than one server per port
 if {$tcl_platform(platform) == "macintosh"} {
-    set conflictResult {0 2828}
+    set conflictResult {0 2836}
 } else {
     set conflictResult {1 {couldn't open socket: address already in use}}
 }
 test socket-10.8 {socket conflict} {
-    set s1 [socket -server accept 2828]
-    if {[catch {set s2 [socket -server accept 2828]} msg]} {
+    set s1 [socket -server accept 2836]
+    if {[catch {set s2 [socket -server accept 2836]} msg]} {
 	set result [list 1 $msg]
     } else {
 	set result [list 0 [lindex [fconfigure $s2 -sockname] 2]]
@@ -1022,7 +1105,7 @@ test socket-10.8 {socket conflict} {
 } $conflictResult
 test socket-10.9 {server with several clients} {
     sendCommand {
-	set socket10_9_test_server [socket -server accept 2828]
+	set socket10_9_test_server [socket -server accept 2836]
 	proc accept {s a p} {
 	    fconfigure $s -buffering line
 	    fileevent $s readable [list echo $s]
@@ -1036,11 +1119,11 @@ test socket-10.9 {server with several clients} {
 	    }
 	}
     }
-    set s1 [socket $remoteServerIP 2828]
+    set s1 [socket $remoteServerIP 2836]
     fconfigure $s1 -buffering line
-    set s2 [socket $remoteServerIP 2828]
+    set s2 [socket $remoteServerIP 2836]
     fconfigure $s2 -buffering line
-    set s3 [socket $remoteServerIP 2828]
+    set s3 [socket $remoteServerIP 2836]
     fconfigure $s3 -buffering line
     for {set i 0} {$i < 100} {incr i} {
 	puts $s1 hello,s1
@@ -1058,17 +1141,17 @@ test socket-10.9 {server with several clients} {
 } 100    
 test socket-10.10 {client with several servers} {
     sendCommand {
-	set s1 [socket -server "accept 3000" 3000]
-	set s2 [socket -server "accept 3001" 3001]
-	set s3 [socket -server "accept 3002" 3002]
+	set s1 [socket -server "accept 4003" 4003]
+	set s2 [socket -server "accept 4004" 4004]
+	set s3 [socket -server "accept 4005" 4005]
 	proc accept {mp s a p} {
 	    puts $s $mp
 	    close $s
 	}
     }
-    set s1 [socket $remoteServerIP 3000]
-    set s2 [socket $remoteServerIP 3001]
-    set s3 [socket $remoteServerIP 3002]
+    set s1 [socket $remoteServerIP 4003]
+    set s2 [socket $remoteServerIP 4004]
+    set s3 [socket $remoteServerIP 4005]
     set l ""
     lappend l [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
 	[gets $s3] [gets $s3] [eof $s3]
@@ -1081,9 +1164,9 @@ test socket-10.10 {client with several servers} {
 	close $s3
     }
     set l
-} {3000 {} 1 3001 {} 1 3002 {} 1}
+} {4003 {} 1 4004 {} 1 4005 {} 1}
 test socket-10.11 {accept callback error} {
-    set s [socket -server accept 2828]
+    set s [socket -server accept 2836]
     proc accept {s a p} {expr 10 / 0}
     proc bgerror args {
 	global x
@@ -1091,23 +1174,25 @@ test socket-10.11 {accept callback error} {
     }
     if {[catch {sendCommand {
 	    set peername [fconfigure $callerSocket -peername]
-	    set s [socket [lindex $peername 0] 2828]
+	    set s [socket [lindex $peername 0] 2836]
 	    close $s
     	 }} msg]} {
 	close $s
 	error $msg
     }
+    set timer [after 10000 "set x timed_out"]
     vwait x
+    after cancel $timer
     close $s
     rename bgerror {}
     set x
 } {{divide by zero}}
 test socket-10.12 {testing socket specific options} {
     sendCommand {
-	set socket10_12_test_server [socket -server accept 2828]
+	set socket10_12_test_server [socket -server accept 2836]
 	proc accept {s a p} {close $s}
     }
-    set s [socket $remoteServerIP 2828]
+    set s [socket $remoteServerIP 2836]
     set p [fconfigure $s -peername]
     set n [fconfigure $s -sockname]
     set l ""
@@ -1115,13 +1200,138 @@ test socket-10.12 {testing socket specific options} {
     close $s
     sendCommand {close $socket10_12_test_server}
     set l
-} {2828 3 3}
+} {2836 3 3}
+test socket-10.13 {testing spurious events} {
+    sendCommand {
+	set socket10_13_test_server [socket -server accept 2836]
+	proc accept {s a p} {
+	    fconfigure $s -translation "auto lf"
+	    after 100 writesome $s
+	}
+	proc writesome {s} {
+	    for {set i 0} {$i < 100} {incr i} {
+		puts $s "line $i from remote server"
+	    }
+	    close $s
+	}
+    }
+    set len 0
+    set spurious 0
+    set done 0
+    proc readlittle {s} {
+	global spurious done len
+	set l [read $s 1]
+	if {[string length $l] == 0} {
+	    if {![eof $s]} {
+		incr spurious
+	    } else {
+		close $s
+		set done 1
+	    }
+	} else {
+	    incr len [string length $l]
+	}
+    }
+    set c [socket $remoteServerIP 2836]
+    fileevent $c readable "readlittle $c"
+    set timer [after 10000 "set done timed_out"]
+    vwait done
+    after cancel $timer
+    sendCommand {close $socket10_13_test_server}
+    list $spurious $len
+} {0 2690}
+test socket-10.14 {testing EOF stickyness} {
+    set counter 0
+    set done 0
+    proc count_up {s} {
+	global counter done after_id
+	set l [gets $s]
+	if {[eof $s]} {
+	    incr counter
+	    if {$counter > 9} {
+		set done {EOF is sticky}
+		after cancel $after_id
+		close $s
+	    }
+	}
+    }
+    proc timed_out {} {
+	global c done
+	set done {timed_out, EOF is not sticky}
+	close $c
+    }
+    sendCommand {
+	set socket10_14_test_server [socket -server accept 2836]
+	proc accept {s a p} {
+	    after 100 close $s
+	}
+    }
+    set c [socket $remoteServerIP 2836]
+    fileevent $c readable "count_up $c"
+    set after_id [after 1000 timed_out]
+    vwait done
+    sendCommand {close $socket10_14_test_server}
+    set done
+} {EOF is sticky}
+test socket-10.15 {testing async write, async flush, async close} {
+    proc readit {s} {
+	global count done
+	set l [read $s]
+	incr count [string length $l]
+	if {[eof $s]} {
+	    close $s
+	    set done 1
+	}
+    }
+    sendCommand {
+	set firstblock ""
+	for {set i 0} {$i < 5} {incr i} {
+		set firstblock "a$firstblock$firstblock"
+	}
+	set secondblock ""
+	for {set i 0} {$i < 16} {incr i} {
+	    set secondblock "b$secondblock$secondblock"
+	}
+	set l [socket -server accept 2845]
+	proc accept {s a p} {
+	    fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
+		-buffering line
+	    fileevent $s readable "readable $s"
+	}
+	proc readable {s} {
+	    set l [gets $s]
+	    fileevent $s readable {}
+	    after 1000 respond $s
+	}
+	proc respond {s} {
+	    global firstblock
+	    puts -nonewline $s $firstblock
+	    after 1000 writedata $s
+	}
+	proc writedata {s} {
+	    global secondblock
+	    puts -nonewline $s $secondblock
+	    close $s
+	}
+    }
+    set s [socket $remoteServerIP 2845]
+    fconfigure $s -blocking 0 -trans lf -buffering line
+    set count 0
+    puts $s hello
+    fileevent $s readable "readit $s"
+    set timer [after 10000 "set done timed_out"]
+    vwait done
+    after cancel $timer
+    sendCommand {close $l}
+    set count
+} 65566
 
-if {$remotePid != -1} {
+if {[string match sock* $commandSocket] == 1} {
    puts $commandSocket exit
    flush $commandSocket
 }
 catch {close $commandSocket}
+catch {close $remoteProcChan}
 
 set x ""
 unset x
diff --git a/contrib/tcl/tests/source.test b/contrib/tcl/tests/source.test
index f335c0e..2d62284 100644
--- a/contrib/tcl/tests/source.test
+++ b/contrib/tcl/tests/source.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) source.test 1.22 96/04/05 15:27:13
+# SCCS: @(#) source.test 1.24 96/10/22 11:34:29
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -57,7 +57,7 @@ test source-2.3 {source error conditions} {
 } {1 {error in sourced file} {error in sourced file
     while executing
 "error "error in sourced file""
-    (file "source.file" line 3)
+    (file "source.file" line 1)
     invoked from within
 "source source.file"}}
 test source-2.4 {source error conditions} {
@@ -149,7 +149,7 @@ test source-5.2 {source resource files} {macOnly} {
 test source-5.3 {source resource files} {macOnly} {
     testWriteTextResource -rsrc rsrcName -file rsrc.file {set msg2 ok; return}
     set result [catch {source -rsrc rsrcName rsrc.file} msg]
-    rm rsrc.file
+    removeFile rsrc.file
     list $msg2 $result $msg
 } [list ok 0 {}]
 test source-5.4 {source resource files} {macOnly} {
@@ -157,23 +157,23 @@ test source-5.4 {source resource files} {macOnly} {
     testWriteTextResource -rsrc fileRsrcName -file rsrc.file {set msg2 ok; return}
     source -rsrc fileRsrcName rsrc.file
     set result [catch {source -rsrc fileRsrcName} msg]    
-    rm rsrc.file
+    removeFile rsrc.file
     list $msg2 $result $msg
 } [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}]
 test source-5.5 {source resource files} {macOnly} {
     testWriteTextResource -rsrcid 200 -file rsrc.file {set msg2 hello; set msg3 bye}
     set result [catch {source -rsrcid 200 rsrc.file} msg]
-    rm rsrc.file
+    removeFile rsrc.file
     list $msg2 $result $msg
 } [list hello 0 bye]
 test source-5.6 {source resource files} {macOnly} {
     testWriteTextResource -rsrcid 200 -file rsrc.file {set msg2 hello; error bad; set msg3 bye}
     set result [catch {source -rsrcid 200 rsrc.file} msg]
-    rm rsrc.file
+    removeFile rsrc.file
     list $msg2 $result $msg
 } [list hello 1 bad]
 
-catch {exec rm source.file}
+catch {removeFile source.file}
 
 # Generate null final value
 
diff --git a/contrib/tcl/tests/split.test b/contrib/tcl/tests/split.test
index e87fcd4..2e2af25 100644
--- a/contrib/tcl/tests/split.test
+++ b/contrib/tcl/tests/split.test
@@ -5,12 +5,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# 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.
 #
-# SCCS: @(#) split.test 1.8 96/02/16 08:56:28
+# SCCS: @(#) split.test 1.9 96/12/30 17:10:16
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -35,6 +35,16 @@ test split-1.6 {basic split commands} {
 test split-1.7 {basic split commands} {
     split {   }
 } {{} {} {} {}}
+test split-1.8 {basic split commands} {
+    proc foo {} {
+        set x {}
+        foreach f [split {]\n} {}] {
+            append x $f
+        }
+        return $x
+    }
+    foo
+} {]\n}
 
 test split-2.1 {split errors} {
     list [catch split msg] $msg $errorCode
diff --git a/contrib/tcl/tests/string.test b/contrib/tcl/tests/string.test
index 77e1bc7..08ade64 100644
--- a/contrib/tcl/tests/string.test
+++ b/contrib/tcl/tests/string.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) string.test 1.12 96/02/16 08:56:29
+# SCCS: @(#) string.test 1.14 97/03/09 17:47:19
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -223,10 +223,16 @@ test string-7.11 {string range} {
 } {1 {wrong # args: should be "string range string first last"}}
 test string-7.12 {string range} {
     list [catch {string range abc abc 1} msg] $msg
-} {1 {expected integer but got "abc"}}
+} {1 {bad index "abc": must be integer or "end"}}
 test string-7.13 {string range} {
     list [catch {string range abc 1 eof} msg] $msg
-} {1 {expected integer or "end" but got "eof"}}
+} {1 {bad index "eof": must be integer or "end"}}
+test string-7.14 {string range} {
+    string range abcdefghijklmnop end end
+} {p}
+test string-7.15 {string range} {
+    string range abcdefghijklmnop e 1000
+} {p}
 
 test string-8.1 {string trim} {
     string trim "    XYZ      "
@@ -263,7 +269,7 @@ test string-9.1 {string trimleft} {
     string trimleft "    XYZ      "
 } {XYZ      }
 test string-9.2 {string trimleft} {
-    list [catch {string triml} msg] $msg
+    list [catch {string trimleft} msg] $msg
 } {1 {wrong # args: should be "string trimleft string ?chars?"}}
 
 test string-10.1 {string trimright} {
@@ -276,11 +282,11 @@ test string-10.3 {string trimright} {
     string trimright ""
 } {}
 test string-10.4 {string trimright errors} {
-    list [catch {string trimr} msg] $msg
+    list [catch {string trimright} msg] $msg
 } {1 {wrong # args: should be "string trimright string ?chars?"}}
 test string-10.5 {string trimright errors} {
     list [catch {string trimg a} msg] $msg
-} {1 {bad option "trimg": should be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 
 test string-11.1 {string tolower} {
     string tolower ABCDeF
@@ -341,7 +347,7 @@ test string-13.8 {string wordend} {
 
 test string-14.1 {string wordstart} {
     list [catch {string word a} msg] $msg
-} {1 {bad option "word": should be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 test string-14.2 {string wordstart} {
     list [catch {string wordstart a} msg] $msg
 } {1 {wrong # args: should be "string wordstart string index"}}
@@ -369,7 +375,7 @@ test string-14.9 {string wordend} {
 
 test string-15.1 {error conditions} {
     list [catch {string gorp a b} msg] $msg
-} {1 {bad option "gorp": should be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 test string-15.2 {error conditions} {
     list [catch {string} msg] $msg
 } {1 {wrong # args: should be "string option arg ?arg ...?"}}
diff --git a/contrib/tcl/tests/stringObj.test b/contrib/tcl/tests/stringObj.test
new file mode 100644
index 0000000..3d03bad
--- /dev/null
+++ b/contrib/tcl/tests/stringObj.test
@@ -0,0 +1,189 @@
+# Commands covered: none
+#
+# This file contains tests for the procedures in tclStringObj.c
+# that implement the Tcl type manager for the string type.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) stringObj.test 1.8 97/04/09 11:29:37
+
+if {[info commands testobj] == {}} {
+    puts "This application hasn't been compiled with the \"testobj\""
+    puts "command, so I can't test the Tcl type and object support."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test stringObj-1.1 {string type registration} {
+    set t [testobj types]
+    set first [string first "string" $t]
+    set result [expr {$first != -1}]
+} {1}
+
+test stringObj-2.1 {Tcl_NewStringObj} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [teststringobj set 1 abcd]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} abcd string 2}
+
+test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testobj newobj 1]
+    lappend result [teststringobj set 1 xyz] ;# makes existing obj a string
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} {} xyz string 2}
+test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
+    set result ""
+    lappend result [testobj freeallvars]
+    lappend result [testintobj set 1 512]
+    lappend result [teststringobj set 1 foo]  ;# makes existing obj a string
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 512 foo string 2}
+
+test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {
+    testobj freeallvars
+    teststringobj set 1 test
+    teststringobj setlength 1 3
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {3 4 tes}
+test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {
+    testobj freeallvars
+    teststringobj set 1 abcdef
+    teststringobj setlength 1 10
+    list [teststringobj length 1] [teststringobj length2 1]
+} {10 10}
+test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {
+    testobj freeallvars
+    teststringobj set 1 abcdef
+    teststringobj append 1 xyzq -1
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {10 20 abcdefxyzq}
+test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {
+    testobj freeallvars
+    testobj newobj 1
+    teststringobj setlength 1 0
+    list [teststringobj length2 1] [teststringobj get 1]
+} {0 {}}
+
+test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} {
+    testobj freeallvars
+    testintobj set2 1 43
+    teststringobj append 1 xyz -1
+    teststringobj get 1
+} {43xyz}
+test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} {
+    testobj freeallvars
+    teststringobj set 1 {x y }
+    teststringobj append 1 bbCCddEE 4
+    teststringobj append 1 123 -1
+    teststringobj get 1
+} {x y bbCC123}
+test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
+    testobj freeallvars
+    teststringobj set 1 xyz
+    teststringobj setlength 1 15
+    teststringobj setlength 1 2
+    set result {}
+    teststringobj append 1 1234567890123 -1
+    lappend result [teststringobj length 1] [teststringobj length2 1]
+    teststringobj setlength 1 10
+    teststringobj append 1 abcdef -1
+    lappend result [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {15 15 16 32 xy12345678abcdef}
+
+test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} {
+    testobj freeallvars
+    teststringobj set2 1 [list a b]
+    teststringobj appendstrings 1 xyz { 1234 } foo
+    teststringobj get 1
+} {a bxyz 1234 foo}
+test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} {
+    testobj freeallvars
+    teststringobj set 1 abc
+    teststringobj appendstrings 1
+    list [teststringobj length 1] [teststringobj get 1]
+} {3 abc}
+test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} {
+    testobj freeallvars
+    teststringobj set 1 abc
+    teststringobj appendstrings 1 {} {} {} {}
+    list [teststringobj length 1] [teststringobj get 1]
+} {3 abc}
+test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} {
+    testobj freeallvars
+    teststringobj set 1 abc
+    teststringobj appendstrings 1 { 123 } abcdefg
+    list [teststringobj length 1] [teststringobj get 1]
+} {15 {abc 123 abcdefg}}
+test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {
+    testobj freeallvars
+    testobj newobj 1
+    teststringobj appendstrings 1 123 abcdefg
+    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
+} {10 10 123abcdefg}
+test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
+    testobj freeallvars
+    teststringobj set 1 abc
+    teststringobj setlength 1 10
+    teststringobj setlength 1 2
+    teststringobj appendstrings 1 34567890
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {10 10 ab34567890}
+test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
+    testobj freeallvars
+    teststringobj set 1 abc
+    teststringobj setlength 1 10
+    teststringobj setlength 1 2
+    teststringobj appendstrings 1 34567890x
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {11 22 ab34567890x}
+test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
+    testobj freeallvars
+    testobj newobj 1
+    teststringobj appendstrings 1 {}
+    list [teststringobj length2 1] [teststringobj get 1]
+} {0 {}}
+
+test stringObj-7.1 {ConvertToStringType procedure} {
+    testobj freeallvars
+    teststringobj set2 1 [list a b]
+    teststringobj append 1 x -1
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {4 8 {a bx}}
+test stringObj-7.2 {ConvertToStringType procedure, null object} {
+    testobj freeallvars
+    testobj newobj 1
+    teststringobj appendstrings 1 {}
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj get 1]
+} {0 0 {}}
+
+test stringObj-8.1 {DupStringInternalRep procedure} {
+    testobj freeallvars
+    teststringobj set 1 {}
+    teststringobj append 1 abcde -1
+    testobj duplicate 1 2
+    list [teststringobj length 1] [teststringobj length2 1] \
+	    [teststringobj length 2] [teststringobj length2 2] \
+	    [teststringobj get 2]
+} {5 10 5 5 abcde}
+
+testobj freeallvars
diff --git a/contrib/tcl/tests/subst.test b/contrib/tcl/tests/subst.test
index 5c7f556..356114d 100644
--- a/contrib/tcl/tests/subst.test
+++ b/contrib/tcl/tests/subst.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) subst.test 1.7 96/02/16 08:56:30
+# SCCS: @(#) subst.test 1.8 97/06/23 18:20:15
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -70,7 +70,7 @@ test subst-5.2 {command substitutions} {
 test subst-5.3 {command substitutions} {
     subst {x.[concat foo].y.[concat bar].z}
 } {x.foo.y.bar.z}
-test subst-5.3 {command substitutions} {
+test subst-5.4 {command substitutions} {
     list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
 } {1 {invalid command name "bogus_command"}}
 
diff --git a/contrib/tcl/tests/switch.test b/contrib/tcl/tests/switch.test
index 740ecb1..347e7a5 100644
--- a/contrib/tcl/tests/switch.test
+++ b/contrib/tcl/tests/switch.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) switch.test 1.5 96/02/16 08:56:31
+# SCCS: @(#) switch.test 1.7 97/02/10 17:27:13
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -85,7 +85,7 @@ test switch-3.5 {-exact vs. -glob vs. -regexp} {
 } exact
 test switch-3.6 {-exact vs. -glob vs. -regexp} {
     list [catch {switch -foo a b c} msg] $msg
-} {1 {bad option "-foo": should be -exact, -glob, -regexp, or --}}
+} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}}
 
 test switch-4.1 {error in executed command} {
     list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
@@ -168,3 +168,12 @@ test switch-7.3 {"-" bodies} {
 	}
     } msg] $msg
 } {1 {invalid command name "-foo"}}
+
+test switch-8.1 {empty body} {
+    set msg {}
+    switch {2} {
+    	1 {set msg 1}
+        2 {}
+        default {set msg 2}
+    }
+} {}
diff --git a/contrib/tcl/tests/timer.test b/contrib/tcl/tests/timer.test
new file mode 100644
index 0000000..4671366
--- /dev/null
+++ b/contrib/tcl/tests/timer.test
@@ -0,0 +1,455 @@
+# This file contains a collection of tests for the procedures in the
+# file tclTimer.c, which includes the "after" Tcl command.  Sourcing
+# this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) timer.test 1.2 97/04/29 11:59:59
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test timer-1.1 {Tcl_CreateTimerHandler procedure} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x ""
+    foreach i {100 200 1000 50 150} {
+	after $i lappend x $i
+    }
+    after 200
+    update
+    set x
+} {50 100 150 200}
+
+test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x ""
+    foreach i {100 200 300 50 150} {
+	after $i lappend x $i
+    }
+    after cancel lappend x 150
+    after cancel lappend x 50
+    after 200
+    update
+    set x
+} {100 200}
+
+# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
+# above.
+
+test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
+    set x start
+    after 100 { set x fired }
+    update idletasks
+    set result $x
+    after 200
+    update
+    lappend result $x
+} {start fired}
+test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    foreach i {200 600 1000} {
+	after $i lappend x $i
+    }
+    after 200
+    set result ""
+    set x ""
+    update
+    lappend result $x
+    after 400
+    update
+    lappend result $x
+    after 400
+    update
+    lappend result $x
+} {200 {200 600} {200 600 1000}}
+test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x {}
+    after 100 lappend x 100
+    set i [after 300 lappend x 300]
+    after 200 after cancel $i
+    after 400
+    update
+    set x
+} 100
+test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x {}
+    after 100 lappend x a
+    after 200 lappend x b
+    after 300 lappend x c
+    after 300
+    vwait x
+    set x
+} {a b c}
+test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x {}
+    after 100 {lappend x a; after 0 lappend x b}
+    after 100
+    vwait x
+    set x
+} a
+test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x {}
+    after 100 {lappend x a; after 100 lappend x b; after 100}
+    after 100
+    vwait x
+    set result $x
+    vwait x
+    lappend result $x
+} {a {a b}}
+
+# No tests for Tcl_DoWhenIdle:  it's already tested by other tests
+# below.
+
+test timer-4.1 {Tcl_CancelIdleCall procedure} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x before
+    set y before
+    set z before
+    after idle set x after1
+    after idle set y after2
+    after idle set z after3
+    after cancel set y after2
+    update idletasks
+    concat $x $y $z
+} {after1 before after3}
+test timer-4.2 {Tcl_CancelIdleCall procedure} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x before
+    set y before
+    set z before
+    after idle set x after1
+    after idle set y after2
+    after idle set z after3
+    after cancel set x after1
+    update idletasks
+    concat $x $y $z
+} {before after2 after3}
+
+test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x 1
+    set y 23
+    after idle {incr x; after idle {incr x; after idle {incr x}}}
+    after idle {incr y}
+    vwait x
+    set result "$x $y"
+    update idletasks
+    lappend result $x
+} {2 24 4}
+
+test timer-6.1 {Tcl_AfterCmd procedure, basics} {
+    list [catch {after} msg] $msg
+} {1 {wrong # args: should be "after option ?arg arg ...?"}}
+test timer-6.2 {Tcl_AfterCmd procedure, basics} {
+    list [catch {after 2x} msg] $msg
+} {1 {expected integer but got "2x"}}
+test timer-6.3 {Tcl_AfterCmd procedure, basics} {
+    list [catch {after gorp} msg] $msg
+} {1 {bad argument "gorp": must be cancel, idle, info, or a number}}
+test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
+    set x before
+    after 400 {set x after}
+    after 200
+    update
+    set y $x
+    after 400
+    update
+    list $y $x
+} {before after}
+test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
+    set x before
+    after 300 set x after
+    after 200
+    update
+    set y $x
+    after 200
+    update
+    list $y $x
+} {before after}
+test timer-6.6 {Tcl_AfterCmd procedure, cancel option} {
+    list [catch {after cancel} msg] $msg
+} {1 {wrong # args: should be "after cancel id|command"}}
+test timer-6.7 {Tcl_AfterCmd procedure, cancel option} {
+    after cancel after#1
+} {}
+test timer-6.8 {Tcl_AfterCmd procedure, cancel option} {
+    after cancel {foo bar}
+} {}
+test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x before
+    set y [after 100 set x after]
+    after cancel $y
+    after 200
+    update
+    set x
+} {before}
+test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x before
+    after 100 set x after
+    after cancel {set x after}
+    after 200
+    update
+    set x
+} {before}
+test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x before
+    after 100 set x after
+    set id [after 300 set x after]
+    after cancel $id
+    after 200
+    update
+    set y $x
+    set x cleared
+    after 200
+    update
+    list $y $x
+} {after cleared}
+test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x first
+    after idle lappend x second
+    after idle lappend x third
+    set i [after idle lappend x fourth]
+    after cancel {lappend x second}
+    after cancel $i
+    update idletasks
+    set x
+} {first third}
+test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x first
+    after idle lappend x second
+    after idle lappend x third
+    set i [after idle lappend x fourth]
+    after cancel lappend x second
+    after cancel $i
+    update idletasks
+    set x
+} {first third}
+test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    set id [
+	after 100 {
+	    set x done
+	    after cancel $id
+	}
+    ]
+    vwait x
+} {}
+test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    interp create x
+    x eval {set a before; set b before; after idle {set a a-after};
+	    after idle {set b b-after}}
+    set result [llength [x eval after info]]
+    lappend result [llength [after info]]
+    after cancel {set b b-after}
+    set a aaa
+    set b bbb
+    x eval {after cancel set a a-after}
+    update idletasks
+    lappend result $a $b [x eval {list $a $b}]
+    interp delete x
+    set result
+} {2 0 aaa bbb {before b-after}}
+test timer-6.16 {Tcl_AfterCmd procedure, idle option} {
+    list [catch {after idle} msg] $msg
+} {1 {wrong # args: should be "after idle script script ..."}}
+test timer-6.17 {Tcl_AfterCmd procedure, idle option} {
+    set x before
+    after idle {set x after}
+    set y $x
+    update idletasks
+    list $y $x
+} {before after}
+test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
+    set x before
+    after idle set x after
+    set y $x
+    update idletasks
+    list $y $x
+} {before after}
+set event1 [after idle event 1]
+set event2 [after 1000 event 2]
+interp create x
+set childEvent [x eval {after idle event in child}]
+test timer-6.19 {Tcl_AfterCmd, info option} {
+    lsort [after info]
+} [lsort "$event1 $event2"]
+test timer-6.20 {Tcl_AfterCmd, info option} {
+    list [catch {after info a b} msg] $msg
+} {1 {wrong # args: should be "after info ?id?"}}
+test timer-6.21 {Tcl_AfterCmd, info option} {
+    list [catch {after info $childEvent} msg] $msg
+} "1 {event \"$childEvent\" doesn't exist}"
+test timer-6.22 {Tcl_AfterCmd, info option} {
+    list [after info $event1] [after info $event2]
+} {{{event 1} idle} {{event 2} timer}}
+after cancel $event1
+after cancel $event2
+interp delete x
+
+set event [after idle foo bar]
+scan $event after#%d id
+test timer-7.1 {GetAfterEvent procedure} {
+    list [catch {after info xfter#$id} msg] $msg
+} "1 {event \"xfter#$id\" doesn't exist}"
+test timer-7.2 {GetAfterEvent procedure} {
+    list [catch {after info afterx$id} msg] $msg
+} "1 {event \"afterx$id\" doesn't exist}"
+test timer-7.3 {GetAfterEvent procedure} {
+    list [catch {after info after#ab} msg] $msg
+} {1 {event "after#ab" doesn't exist}}
+test timer-7.4 {GetAfterEvent procedure} {
+    list [catch {after info after#} msg] $msg
+} {1 {event "after#" doesn't exist}}
+test timer-7.5 {GetAfterEvent procedure} {
+    list [catch {after info after#${id}x} msg] $msg
+} "1 {event \"after#${id}x\" doesn't exist}"
+test timer-7.6 {GetAfterEvent procedure} {
+    list [catch {after info afterx[expr $id+1]} msg] $msg
+} "1 {event \"afterx[expr $id+1]\" doesn't exist}"
+after cancel $event
+
+test timer-8.1 {AfterProc procedure} {
+    set x before
+    proc foo {} {
+	set x untouched
+	after 100 {set x after}
+	after 200
+	update
+	return $x
+    }
+    list [foo] $x
+} {untouched after}
+test timer-8.2 {AfterProc procedure} {
+    catch {rename bgerror {}}
+    proc bgerror msg {
+	global x errorInfo
+	set x [list $msg $errorInfo]
+    }
+    set x empty
+    after 100 {error "After error"}
+    after 200
+    set y $x
+    update
+    catch {rename bgerror {}}
+    list $y $x
+} {empty {{After error} {After error
+    while executing
+"error "After error""
+    ("after" script)}}}
+test timer-8.3 {AfterProc procedure, deleting handler from itself} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    proc foo {} {
+	global x
+	set x {}
+	foreach i [after info] {
+	    lappend x [after info $i]
+	}
+	after cancel foo
+    }
+    after idle foo
+    after 1000 {error "I shouldn't ever have executed"}
+    update idletasks
+    set x
+} {{{error "I shouldn't ever have executed"} timer}}
+test timer-8.4 {AfterProc procedure, deleting handler from itself} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    proc foo {} {
+	global x
+	set x {}
+	foreach i [after info] {
+	    lappend x [after info $i]
+	}
+	after cancel foo
+    }
+    after 1000 {error "I shouldn't ever have executed"}
+    after idle foo
+    update idletasks
+    set x
+} {{{error "I shouldn't ever have executed"} timer}}
+
+foreach i [after info] {
+    after cancel $i
+}
+
+# No test for FreeAfterPtr, since it is already tested above.
+
+
+test timer-9.1 {AfterCleanupProc procedure} {
+    catch {interp delete x}
+    interp create x
+    x eval {after 200 {
+	lappend x after
+	puts "part 1: this message should not appear"
+    }}
+    after 200 {lappend x after2}
+    x eval {after 200 {
+	lappend x after3
+	puts "part 2: this message should not appear"
+    }}
+    after 200 {lappend x after4}
+    x eval {after 200 {
+	lappend x after5
+	puts "part 3: this message should not appear"
+    }}
+    interp delete x
+    set x before
+    after 300
+    update
+    set x
+} {before after2 after4}
+
diff --git a/contrib/tcl/tests/trace.test b/contrib/tcl/tests/trace.test
index 9077906..d67c252 100644
--- a/contrib/tcl/tests/trace.test
+++ b/contrib/tcl/tests/trace.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) trace.test 1.24 96/02/16 08:56:32
+# SCCS: @(#) trace.test 1.25 96/08/23 11:44:46
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -142,6 +142,11 @@ test trace-2.5 {trace variable writes} {
     set info
 } {}
 
+# append no longer triggers read traces when fetching the old values of
+# variables before doing the append operation. However, lappend _does_
+# still trigger these read traces. Also lappend triggers only one write
+# trace: after appending all arguments to the list.
+
 test trace-3.1 {trace variable read-modify-writes} {
     catch {unset x}
     set info {}
@@ -150,7 +155,7 @@ test trace-3.1 {trace variable read-modify-writes} {
     append x 456
     lappend x 789
     set info
-} {x {} r 1 {can't read "x": no such variable} x {} r 0 123 x {} r 0 123456}
+} {x {} r 0 123456}
 test trace-3.2 {trace variable read-modify-writes} {
     catch {unset x}
     set info {}
@@ -158,7 +163,7 @@ test trace-3.2 {trace variable read-modify-writes} {
     append x 123
     lappend x 456
     set info
-} {x {} r 1 {can't read "x": no such variable} x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
+} {x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
 
 # Basic unset-tracing on variables
 
@@ -335,10 +340,9 @@ test trace-7.3 {error returns from traces} {
     catch {unset x}
     set x 123
     set info {}
-    trace var x r traceError
-    trace var x w traceScalar
+    trace var x w traceError
     list [catch {append x 44} msg] $msg $info
-} {1 {can't read "x": trace returned error} {}}
+} {1 {can't set "x": trace returned error} {}}
 test trace-7.4 {error returns from traces} {
     catch {unset x}
     set x 123
diff --git a/contrib/tcl/tests/unixFCmd.test b/contrib/tcl/tests/unixFCmd.test
new file mode 100644
index 0000000..8fc1f2e
--- /dev/null
+++ b/contrib/tcl/tests/unixFCmd.test
@@ -0,0 +1,241 @@
+# This file tests the tclUnixFCmd.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 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.
+#
+# SCCS: @(#) unixFCmd.test 1.11 97/06/23 17:30:25
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {$tcl_platform(platform) != "unix"} {
+    return
+}
+
+if {$user == "root"} {
+    puts "Skipping unixFCmd tests.  They depend on not being able to write to"
+    puts "certain directories.  It would be too dangerous to run them as root."
+    return
+}
+
+proc openup {path} {
+    testchmod 777 $path
+    if {[file isdirectory $path]} {
+	catch {
+	    foreach p [glob [file join $path *]] {
+		openup $p
+	    }
+	}
+    }
+}
+
+proc cleanup {args} {
+    foreach p ". $args" {
+	set x ""
+	catch {
+	    set x [glob [file join $p tf*] [file join $p td*]]
+	}
+	foreach file $x {
+	    if {[catch {file delete -force -- $file}]} {
+		openup $file
+		file delete -force -- $file
+	    }
+	}
+    }
+}
+
+test unixFCmd-1.1 {TclpRenameFile: EACCES} {
+    cleanup
+    file mkdir td1/td2/td3
+    exec chmod 000 td1/td2
+    set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
+    exec chmod 755 td1/td2
+    set msg
+} {1 {error renaming "td1/td2/td3": permission denied}}
+test unixFCmd-1.2 {TclpRenameFile: EEXIST} {
+    cleanup
+    file mkdir td1/td2
+    file mkdir td2
+    list [catch {file rename td2 td1} msg] $msg
+} {1 {error renaming "td2" to "td1/td2": file already exists}}
+test unixFCmd-1.3 {TclpRenameFile: EINVAL} {
+    cleanup
+    file mkdir td1
+    list [catch {file rename td1 td1} msg] $msg
+} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
+test unixFCmd-1.4 {TclpRenameFile: EISDIR} {
+    # can't make it happen
+} {}
+test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
+    cleanup
+    file mkdir td1
+    list [catch {file rename td2 td1} msg] $msg
+} {1 {error renaming "td2": no such file or directory}}
+test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {
+    # can't make it happen
+} {}
+test unixFCmd-1.7 {TclpRenameFile: EXDEV} {nonPortable} {
+    cleanup
+    file mkdir td1
+    if [file exists /kernel] {
+	set msg [list [catch {file rename /kernel td1} msg] $msg]
+	set a1 {1 {can't unlink "/kernel": permission denied}}
+	expr {$msg == $a1}
+    } else {
+        list 1
+    }
+} {1}
+
+test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
+    cleanup
+    exec touch tf1
+    exec touch tf2
+    file copy -force tf1 tf2
+} {}
+test unixFCmd-2.2 {TclpCopyFile: src is symlink} {
+    cleanup
+    exec ln -s tf1 tf2
+    file copy tf2 tf3
+    file type tf3
+} {link}
+test unixFCmd-2.3 {TclpCopyFile: src is block} {
+    cleanup
+    set null "/dev/null"
+    while {[file type $null] != "characterSpecial"} {
+	set null [file join [file dirname $null] [file readlink $null]]
+    }
+    # file copy $null tf1
+} {}
+test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
+    cleanup
+    if [catch {exec mknod tf1 p}] {
+	list 1
+    } else {
+	file copy tf1 tf2
+	expr {"[file type tf1]" == "[file type tf2]"}
+    }
+} {1}
+test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
+    cleanup
+    exec touch tf1
+    exec chmod 472 tf1
+    file copy tf1 tf2
+    string range [exec ls -l tf2] 0 9
+} {-r--rwx-w-}
+
+test unixFCmd-3.1 {CopyFile not done} {
+} {}
+
+test unixFCmd-4.1 {TclpDeleteFile not done} {
+} {}
+
+test unixFCmd-5.1 {TclpCreateDirectory not done} {
+} {}
+
+test unixFCmd-6.1 {TclpCopyDirectory not done} {
+} {}
+
+test unixFCmd-7.1 {TclpRemoveDirectory not done} {
+} {}
+
+test unixFCmd-8.1 {TraverseUnixTree not done} {
+} {}
+
+test unixFCmd-9.1 {TraversalCopy not done} {
+} {}
+
+test unixFCmd-10.1 {TraversalDelete not done} {
+} {}
+
+test unixFCmd-11.1 {CopyFileAttrs not done} {
+} {}
+
+set testConfig(tclGroup) 0
+if {[catch {exec {groups}} groupList] == 0} {
+    if {[lsearch $groupList tcl] != -1} {
+	set testConfig(tclGroup) 1
+    }
+}
+
+test unixFCmd-12.1 {GetGroupAttribute - file not found} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -group} msg] $msg
+} {1 {could not stat file "foo.test": no such file or directory}}
+test unixFCmd-12.2 {GetGroupAttribute - file found} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
+} {0 {}}
+
+test unixFCmd-13.1 {GetOwnerAttribute - file not found} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -group} msg] $msg
+} {1 {could not stat file "foo.test": no such file or directory}}
+test unixFCmd-13.2 {GetOwnerAttribute} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -owner} msg] [string compare $msg $user] [file delete -force -- foo.test]
+} {0 0 {}}
+
+test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -permissions} msg] $msg
+} {1 {could not stat file "foo.test": no such file or directory}}
+test unixFCmd-14.2 {GetPermissionsAttribute} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attribute foo.test -permissions}] [file delete -force -- foo.test]
+} {0 {}}
+
+#groups hard to test
+test unixFCmd-15.1 {SetGroupAttribute - invalid group} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -group foozzz} msg] $msg [file delete -force -- foo.test]
+} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
+test unixFCmd-15.2 {SetGroupAttribute - invalid file} {tclGroup} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -group tcl} msg] $msg
+} {1 {could not set group for file "foo.test": no such file or directory}}
+
+#changing owners hard to do
+test unixFCmd-16.1 {SetOwnerAttribute - current owner} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -owner $user} msg] $msg [string compare [file attributes foo.test -owner] $user] [file delete -force -- foo.test]
+} {0 {} 0 {}}
+test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -owner $user} msg] $msg
+} {1 {could not set owner for file "foo.test": no such file or directory}}
+test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -owner foozzz} msg] $msg
+} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
+
+
+test unixFCmd-17.1 {SetPermissionsAttribute} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -permissions 0000} msg] $msg [file attributes foo.test -permissions] [file delete -force -- foo.test]
+} {0 {} 00000 {}}
+test unixFCmd-17.2 {SetPermissionsAttribute} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -permissions 0000} msg] $msg
+} {1 {could not set permissions for file "foo.test": no such file or directory}}
+test unixFCmd-17.3 {SetPermissionsAttribute} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -permissions foo} msg] $msg [file delete -force -- foo.test]
+} {1 {expected integer but got "foo"} {}}
+
+cleanup    
+
+    
+
+    
+    
diff --git a/contrib/tcl/tests/unixNotfy.test b/contrib/tcl/tests/unixNotfy.test
new file mode 100644
index 0000000..ba99db1
--- /dev/null
+++ b/contrib/tcl/tests/unixNotfy.test
@@ -0,0 +1,40 @@
+# This file contains tests for tclUnixNotfy.c.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) unixNotfy.test 1.2 97/06/16 17:26:28
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {$tcl_platform(platform) != "unix"} {
+    return
+}
+test unixNotfy-1.1 {Tcl_DeleteFileHandler} {
+    catch {vwait x}
+    set f [open foo w]
+    fileevent $f writable {set x 1}
+    vwait x
+    close $f
+    list [catch {vwait x} msg] $msg
+} {1 {can't wait for variable "x":  would wait forever}}
+test unixNotfy-1.2 {Tcl_DeleteFileHandler} {
+    catch {vwait x}
+    set f1 [open foo w]
+    set f2 [open foo2 w]
+    fileevent $f1 writable {set x 1}
+    fileevent $f2 writable {set y 1}
+    vwait x
+    close $f1
+    vwait y
+    close $f2
+    list [catch {vwait x} msg] $msg
+} {1 {can't wait for variable "x":  would wait forever}}
+
+file delete foo
diff --git a/contrib/tcl/tests/unknown.test b/contrib/tcl/tests/unknown.test
index fd41109..83ad160 100644
--- a/contrib/tcl/tests/unknown.test
+++ b/contrib/tcl/tests/unknown.test
@@ -10,10 +10,11 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) unknown.test 1.11 96/02/16 08:56:34
+# SCCS: @(#) unknown.test 1.12 96/08/26 11:29:29
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
+catch {unset x}
 catch {rename unknown unknown.old}
 
 test unknown-1.1 {non-existent "unknown" command} {
diff --git a/contrib/tcl/tests/upvar.test b/contrib/tcl/tests/upvar.test
index accc74c..23419de 100644
--- a/contrib/tcl/tests/upvar.test
+++ b/contrib/tcl/tests/upvar.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) upvar.test 1.11 96/02/28 21:45:36
+# SCCS: @(#) upvar.test 1.14 96/10/22 11:34:39
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -310,6 +310,11 @@ test upvar-8.7 {errors in upvar command} {
     proc p1 {} {trace variable a w foo; upvar b a}
     list [catch p1 msg] $msg
 } {1 {variable "a" has traces: can't use for upvar}}
+test upvar-8.8 {create nested array with upvar} {
+    proc p1 {} {upvar x(a) b; set b(2) 44}
+    catch {unset x}
+    list [catch p1 msg] $msg
+} {1 {can't set "b(2)": variable isn't array}}
 
 if {[info commands testupvar] != {}} {
     test upvar-9.1 {Tcl_UpVar2 procedure} {
diff --git a/contrib/tcl/tests/util.test b/contrib/tcl/tests/util.test
new file mode 100644
index 0000000..e7a3f2f
--- /dev/null
+++ b/contrib/tcl/tests/util.test
@@ -0,0 +1,64 @@
+# This file is a Tcl script to test the code in the file tclUtil.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) util.test 1.5 97/06/16 13:21:57
+
+if {[info commands testobj] == {}} {
+    puts "This application hasn't been compiled with the \"testobj\""
+    puts "command, so I can't test the Tcl type and object support."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test util-1.1 {TclFindElement procedure - binary element in middle of list} {
+    lindex {0 foo\x00help 1} 1
+} "foo\x00help"
+test util-1.2 {TclFindElement procedure - binary element at end of list} {
+    lindex {0 foo\x00help} 1
+} "foo\x00help"
+
+test util-2.1 {TclCopyAndCollapse procedure - normal string} {
+    lindex {0 foo} 1
+} {foo}
+test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} {
+    lindex {0 foo\n\x00help 1} 1
+} "foo\n\x00help"
+
+test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} {
+    # This test checks for a very tricky feature.  Any list element
+    # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must
+    # have the property that it can be enclosing in curly braces to make
+    # an embedded sub-list.  If this property doesn't hold, then
+    # Tcl_DStringStartSublist doesn't work.
+
+    set x {}
+    lappend x " \\\{ \\"
+    concat $x [llength "{$x}"]
+} {\ \\\{\ \\ 1}
+
+test util-4.1 {Tcl_SetObjErrorCode - one arg} {
+    catch {testsetobjerrorcode 1}
+    list [set errorCode]
+} {1}
+test util-4.2 {Tcl_SetObjErrorCode - two args} {
+    catch {testsetobjerrorcode 1 2}
+    list [set errorCode]
+} {{1 2}}
+test util-4.3 {Tcl_SetObjErrorCode - three args} {
+    catch {testsetobjerrorcode 1 2 3}
+    list [set errorCode]
+} {{1 2 3}}
+test util-4.4 {Tcl_SetObjErrorCode - four args} {
+    catch {testsetobjerrorcode 1 2 3 4}
+    list [set errorCode]
+} {{1 2 3 4}}
+test util-4.5 {Tcl_SetObjErrorCode - five args} {
+    catch {testsetobjerrorcode 1 2 3 4 5}
+    list [set errorCode]
+} {{1 2 3 4 5}}
diff --git a/contrib/tcl/tests/var.test b/contrib/tcl/tests/var.test
new file mode 100644
index 0000000..a51a47b
--- /dev/null
+++ b/contrib/tcl/tests/var.test
@@ -0,0 +1,436 @@
+# This file contains tests for the tclVar.c source file. Tests appear in
+# the same order as the C code that they test. The set of tests is
+# currently incomplete since it currently includes only new tests for
+# code changed for the addition of Tcl namespaces. Other variable-
+# related tests appear in several other test files including
+# namespace.test, set.test, trace.test, and upvar.test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) var.test 1.8 97/06/25 09:02:03
+#
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {rename p ""}
+catch {namespace delete test_ns_var}
+catch {unset xx}
+catch {unset x}
+catch {unset y}
+catch {unset i}
+catch {unset a}
+catch {unset arr}
+
+test var-1.1 {TclLookupVar, TCL_PARSE_PART1 flag set} {
+    catch {unset a}
+    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd 
+    set i 10
+    set arr(foo) 37
+    list [$x i] $i [$x arr(foo)] $arr(foo)
+} {11 11 38 38}
+test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
+    set x "global value"
+    namespace eval test_ns_var {
+        variable x "namespace value"
+        proc p {} {
+            global x  ;# specifies TCL_GLOBAL_ONLY to get global x
+            return $x
+        }
+    }
+    test_ns_var::p
+} {global value}
+test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} {
+    namespace eval test_ns_var {
+        proc q {} {
+            variable x  ;# specifies TCL_NAMESPACE_ONLY to get namespace x
+            return $x
+        }
+    }
+    test_ns_var::q
+} {namespace value}
+test var-1.4 {TclLookupVar, no active call frame implies global namespace var} {
+    set x
+} {global value}
+test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} {
+    namespace eval test_ns_var {set x}
+} {namespace value}
+test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
+    namespace eval test_ns_var {set ::x}
+} {global value}
+test var-1.7 {TclLookupVar, error finding namespace var} {
+    list [catch {set a:::b} msg] $msg
+} {1 {can't read "a:::b": no such variable}}
+test var-1.8 {TclLookupVar, error finding namespace var} {
+    list [catch {set ::foobarfoo} msg] $msg
+} {1 {can't read "::foobarfoo": no such variable}}
+test var-1.9 {TclLookupVar, create new namespace var} {
+    namespace eval test_ns_var {
+        set v hello
+    }
+} {hello}
+test var-1.10 {TclLookupVar, create new namespace var} {
+    catch {unset y}
+    namespace eval test_ns_var {
+        set ::y 789
+    }
+    set y
+} {789}
+test var-1.11 {TclLookupVar, error creating new namespace var} {
+    namespace eval test_ns_var {
+        list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg
+    }
+} {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}}
+test var-1.12 {TclLookupVar, error creating new namespace var} {
+    namespace eval test_ns_var {
+        list [catch {set ::test_ns_var::foo:: 1997} msg] $msg
+    }
+} {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}}
+test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
+    catch {unset aNeWnAmEiNnS}
+    namespace eval test_ns_var {
+        namespace eval test_ns_var2::test_ns_var3 {
+            set aNeWnAmEiNnS 77777
+        }
+        # namespace which builds a name by traversing nsPtr chain to ::
+        namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS
+    }
+} {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS}
+test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} {
+    namespace eval test_ns_var {
+        set : 123
+        set v: 456
+        set x:y: 789
+        list [set :] [set v:] [set x:y:] \
+             ${:} ${v:} ${x:y:} \
+             [expr {[lsearch [info vars] :] != -1}] \
+             [expr {[lsearch [info vars] v:] != -1}] \
+             [expr {[lsearch [info vars] x:y:] != -1}]
+    }
+} {123 456 789 123 456 789 1 1 1}
+
+test var-2.1 {Tcl_LappendObjCmd, create var if new} {
+    catch {unset x}
+    lappend x 1 2
+} {1 2}
+
+test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} {
+    catch {unset x}
+    set x 1997
+    proc p {} {
+        global x  ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
+        return $x
+    }
+    p
+} {1997}
+test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
+    namespace eval test_ns_var {
+        catch {unset v}
+        variable v 1998
+        proc p {} {
+            variable v  ;# TCL_NAMESPACE_ONLY specified for other var x
+            return $v
+        }
+        p
+    }
+} {1998}
+if {[info commands testupvar] != {}} {
+    test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} {
+        catch {unset a}
+        set a 123321
+        proc p {} {
+            # create global xx linked to global a
+	    testupvar 1 a {} xx global 
+	}
+        list [p] $xx [set xx 789] $a
+    } {{} 123321 789 789}
+    test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} {
+        catch {unset a}
+        set a 456
+        namespace eval test_ns_var {
+            catch {unset ::test_ns_var::vv}
+            proc p {} {
+                # create namespace var vv linked to global a
+	        testupvar 1 a {} vv namespace 
+	    }
+            p
+        }
+        list $test_ns_var::vv [set test_ns_var::vv 123] $a
+    } {456 123 123}
+}
+test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
+    catch {unset aaaaa}
+    catch {unset xxxxx}
+    set aaaaa 77777
+    upvar #0 aaaaa xxxxx
+    list [set xxxxx] [set aaaaa]
+} {77777 77777}
+test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} {
+    catch {unset a}
+    set a 121212
+    namespace eval test_ns_var {
+        upvar ::a vvv
+        set vvv
+    }
+} {121212}
+test var-3.7 {MakeUpvar, my var has ::s} {
+    catch {unset a}
+    set a 789789
+    upvar #0 a test_ns_var::lnk
+    namespace eval test_ns_var {
+        set lnk
+    }
+} {789789}
+test var-3.8 {MakeUpvar, my var already exists in global ns} {
+    catch {unset aaaaa}
+    catch {unset xxxxx}
+    set aaaaa 456654
+    set xxxxx hello
+    upvar #0 aaaaa xxxxx
+    set xxxxx
+} {hello}
+test var-3.9 {MakeUpvar, my var has invalid ns name} {
+    catch {unset aaaaa}
+    set aaaaa 789789
+    list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
+} {1 {bad variable name "test_ns_fred::lnk": unknown namespace}}
+
+if {[info commands testgetvarfullname] != {}} {
+    test var-4.1 {Tcl_GetVariableName, global variable} {
+        catch {unset a}
+        set a 123
+        testgetvarfullname a global
+    } ::a
+    test var-4.2 {Tcl_GetVariableName, namespace variable} {
+        namespace eval test_ns_var {
+            variable george
+            testgetvarfullname george namespace
+        }
+    } ::test_ns_var::george
+    test var-4.3 {Tcl_GetVariableName, variable can't be array element} {
+        catch {unset a}
+        set a(1) foo
+        list [catch {testgetvarfullname a(1) global} msg] $msg
+    } {1 {unknown variable "a(1)"}}
+}
+
+test var-5.1 {Tcl_GetVariableFullName, global variable} {
+    catch {unset a}
+    set a bar
+    namespace which -variable a
+} {::a}
+test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
+    namespace eval test_ns_var {
+        variable martha
+        namespace which -variable martha
+    }
+} {::test_ns_var::martha}
+test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
+    namespace which -variable test_ns_var::martha
+} {::test_ns_var::martha}
+
+test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
+    namespace eval test_ns_var {
+        variable boeing 777
+    }
+    proc p {} {
+        global ::test_ns_var::boeing
+        set boeing
+    }
+    p
+} {777}
+test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
+    namespace eval test_ns_var {
+        namespace eval test_ns_nested {
+            variable java java
+        }
+        proc p {} {
+            global ::test_ns_var::test_ns_nested::java
+            set java
+        }
+    }
+    test_ns_var::p
+} {java}
+test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
+    set ::test_ns_var::test_ns_nested:: 24
+    proc p {} {
+        global ::test_ns_var::test_ns_nested::
+        set {}
+    }
+    p
+} {24}
+
+test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
+    catch {namespace delete test_ns_var}
+    namespace eval test_ns_var {
+        variable one 1
+    }
+    list [info vars test_ns_var::*] [set test_ns_var::one]
+} {::test_ns_var::one 1}
+test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
+    set two 2222222
+    namespace eval test_ns_var {
+        variable two
+    }
+    list [info vars test_ns_var::*] [catch {set test_ns_var::two} msg] $msg
+} {::test_ns_var::one 1 {can't read "test_ns_var::two": no such variable}}
+test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
+    namespace eval test_ns_var {
+        variable two 2
+    }
+    list [info vars test_ns_var::*] \
+         [namespace eval test_ns_var {set two}]
+} {{::test_ns_var::two ::test_ns_var::one} 2}
+test var-7.4 {Tcl_VariableObjCmd, list of vars} {
+    namespace eval test_ns_var {
+        variable three 3 four 4
+    }
+    list [info vars test_ns_var::*] \
+         [namespace eval test_ns_var {expr $three+$four}]
+} {{::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one} 7}
+test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
+    catch {unset a}
+    catch {unset five}
+    catch {unset six}
+    set a ""
+    set five 555
+    set six  666
+    namespace eval test_ns_var {
+        variable five 5 six
+        lappend a $five
+    }
+    lappend a $test_ns_var::five \
+        [set test_ns_var::six 6] [set test_ns_var::six] $six
+    catch {unset five}
+    catch {unset six}
+    set a
+} {5 5 6 6 666}
+catch {unset newvar}
+test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
+    namespace eval test_ns_var {
+        variable ::newvar cheers!
+    }
+    set newvar
+} {cheers!}
+catch {unset newvar}
+test var-7.7 {Tcl_VariableObjCmd, bad var name} {
+    namespace eval test_ns_var {
+        list [catch {variable sev:::en 7} msg] $msg
+    }
+} {1 {can't define "sev:::en": parent namespace doesn't exist}}
+test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
+    set a ""
+    namespace eval test_ns_var {
+        variable eight 8
+        lappend a $eight
+        variable eight
+        lappend a $eight
+    }
+    set a
+} {8 8}
+test var-7.9 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+    namespace eval test_ns_var {
+        proc p {} {
+            variable eight
+            list [set eight] [info vars]
+        }
+        p
+    }
+} {8 eight}
+test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+    proc p {} {   ;# note this proc is at global :: scope
+        variable test_ns_var::eight
+        list [set eight] [info vars]
+    }
+    p
+} {8 eight}
+test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+    namespace eval test_ns_var {
+        variable {} {My name is empty}
+    }
+    proc p {} {   ;# note this proc is at global :: scope
+        variable test_ns_var::
+        list [set {}] [info vars]
+    }
+    p
+} {{My name is empty} {{}}}
+
+test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
+    catch {namespace delete test_ns_var}
+    catch {unset a}
+    namespace eval test_ns_var {
+        variable v 123
+        variable info ""
+
+        proc traceUnset {name1 name2 op} {
+            variable info
+            set info [concat $info [list $name1 $name2 $op]]
+        }
+
+        trace var v u [namespace code traceUnset]
+    }
+    list [unset test_ns_var::v] $test_ns_var::info
+} {{} {test_ns_var::v {} u}}
+
+test var-9.1 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+	testsetnoerr v 1
+} 1
+test var-9.2 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
+	catch {unset v}
+	list [catch {testsetnoerr v} res] $res;
+} {1 {before get}}
+test var-9.3 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
+	catch {unset arr}
+	set arr(1) 1;
+	list [catch {testsetnoerr arr} res] $res;
+} {1 {before get}}
+test var-9.4 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
+	namespace eval ns {variable v nsv}
+	testsetnoerr ns::v;
+} nsv;
+test var-9.5 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
+	catch {namespace delete ns}
+	list [catch {testsetnoerr ns::v} res] $res;
+} {1 {before get}}
+test var-9.6 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+	catch {unset arr}
+	set arr(1) 1;
+	list [catch {testsetnoerr arr 2} res] $res;
+} {1 {before set}}
+test var-9.6 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+	catch {unset arr}
+	set arr(1) 1;
+	list [catch {testsetnoerr arr 2} res] $res;
+} {1 {before set}}
+test var-9.7 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+    # this test currently fails, should not...
+    # (some namespace function resets the interp while it should not)
+    catch {namespace delete ns}
+    list [catch {testsetnoerr ns::v 1} res] $res;
+} {1 {before set}}
+test var-9.8 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+    proc readonly args {error "read-only"}
+    set v 456
+    trace var v w readonly
+    list [catch {testsetnoerr v 2} msg] $msg
+} {1 {before set}}
+
+catch {namespace delete ns}
+catch {unset arr}
+catch {unset v}
+
+catch {rename p ""}
+catch {namespace delete test_ns_var}
+catch {unset xx}
+catch {unset x}
+catch {unset y}
+catch {unset i}
+catch {unset a}
+catch {unset xxxxx}
+catch {unset aaaaa}
+
diff --git a/contrib/tcl/tests/while-old.test b/contrib/tcl/tests/while-old.test
new file mode 100644
index 0000000..f5e5b05
--- /dev/null
+++ b/contrib/tcl/tests/while-old.test
@@ -0,0 +1,113 @@
+# Commands covered:  while
+#
+# This file contains the original set of tests for Tcl's while command.
+# Since the while command is now compiled, a new set of tests covering
+# the new implementation is in the file "while.test". Sourcing this file
+# into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# 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.
+#
+# SCCS: @(#) while-old.test 1.14 97/05/16 10:44:19
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test while-old-1.1 {basic while loops} {
+    set count 0
+    while {$count < 10} {set count [expr $count+1]}
+    set count
+} 10
+test while-old-1.2 {basic while loops} {
+    set value xxx
+    while {2 > 3} {set value yyy}
+    set value
+} xxx
+test while-old-1.3 {basic while loops} {
+    set value 1
+    while {"true"} {
+	incr value;
+	if {$value > 5} {
+	    break;
+	}
+    }
+    set value
+} 6
+test while-old-1.4 {basic while loops, multiline test expr} {
+    set value 1
+    while {($tcl_platform(platform) != "foobar1") && \
+	    ($tcl_platform(platform) != "foobar2")} {
+        incr value
+        break
+    }
+    set value
+} {2}
+test while-old-1.5 {basic while loops, test expr in quotes} {
+    set value 1
+    while "0 < 3" {set value 2; break}
+    set value
+} {2}
+
+test while-old-2.1 {continue in while loop} {
+    set list {1 2 3 4 5}
+    set index 0
+    set result {}
+    while {$index < 5} {
+	if {$index == 2} {set index [expr $index+1]; continue}
+	set result [concat $result [lindex $list $index]]
+	set index [expr $index+1]
+    }
+    set result
+} {1 2 4 5}
+
+test while-old-3.1 {break in while loop} {
+    set list {1 2 3 4 5}
+    set index 0
+    set result {}
+    while {$index < 5} {
+	if {$index == 3} break
+	set result [concat $result [lindex $list $index]]
+	set index [expr $index+1]
+    }
+    set result
+} {1 2 3}
+
+test while-old-4.1 {errors in while loops} {
+    set err [catch {while} msg]
+    list $err $msg
+} {1 {wrong # args: should be "while test command"}}
+test while-old-4.2 {errors in while loops} {
+    set err [catch {while 1} msg]
+    list $err $msg
+} {1 {wrong # args: should be "while test command"}}
+test while-old-4.3 {errors in while loops} {
+    set err [catch {while 1 2 3} msg]
+    list $err $msg
+} {1 {wrong # args: should be "while test command"}}
+test while-old-4.4 {errors in while loops} {
+    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
+    list $err $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test while-old-4.5 {errors in while loops} {
+    catch {unset x}
+    set x 1
+    set err [catch {while {$x} {set x foo}} msg]
+    list $err $msg
+} {1 {expected boolean value but got "foo"}}
+test while-old-4.6 {errors in while loops} {
+    set err [catch {while {1} {error "loop aborted"}} msg]
+    list $err $msg $errorInfo
+} {1 {loop aborted} {loop aborted
+    while executing
+"error "loop aborted""}}
+
+test while-old-5.1 {while return result} {
+    while {0} {set a 400}
+} {}
+test while-old-5.2 {while return result} {
+    set x 1
+    while {$x} {set x 0}
+} {}
diff --git a/contrib/tcl/tests/while.test b/contrib/tcl/tests/while.test
index ad3d328..3cb43d0 100644
--- a/contrib/tcl/tests/while.test
+++ b/contrib/tcl/tests/while.test
@@ -4,27 +4,46 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 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.
 #
-# SCCS: @(#) while.test 1.9 96/02/16 08:56:37
+# SCCS: @(#) @(#) while.test 1.8 97/06/24 10:36:56
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
-test while-1.1 {basic while loops} {
-    set count 0
-    while {$count < 10} {set count [expr $count+1]}
-    set count
-} 10
-test while-1.2 {basic while loops} {
-    set value xxx
-    while {2 > 3} {set value yyy}
+# Basic "while" operation.
+
+catch {unset i}
+catch {unset a}
+
+test while-1.1 {TclCompileWhileCmd: missing test expression} {
+    catch {while } msg
+    set msg
+} {wrong # args: should be "while test command"}
+test while-1.2 {TclCompileWhileCmd: error in test expression} {
+    set i 0
+    catch {while {$i<}} msg
+    set errorInfo
+} {syntax error in expression "$i<"
+    ("while" test expression)
+    while compiling
+"while"}
+test while-1.3 {TclCompileWhileCmd: error in test expression} {
+    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
+    list $err $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test while-1.4 {TclCompileWhileCmd: multiline test expr} {
+    set value 1
+    while {($tcl_platform(platform) != "foobar1") && \
+	    ($tcl_platform(platform) != "foobar2")} {
+        incr value
+        break
+    }
     set value
-} xxx
-test while-1.3 {basic while loops} {
+} {2}
+test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
     set value 1
     while {"true"} {
 	incr value;
@@ -34,66 +53,267 @@ test while-1.3 {basic while loops} {
     }
     set value
 } 6
+test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
+    set i 0
+    while "$i > 5" {}
+} {}
+test while-1.7 {TclCompileWhileCmd: missing command body} {
+    set i 0
+    catch {while {$i < 5} } msg
+    set msg
+} {wrong # args: should be "while test command"}
+test while-1.8 {TclCompileWhileCmd: error compiling command body} {
+    set i 0
+    catch {while {$i < 5} {set}} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    ("while" body line 1)
+    while compiling
+"while"}
+test while-1.9 {TclCompileWhileCmd: simple command body} {
+    set a {}
+    set i 1
+    while {$i<6} {
+	if $i==4 break
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 2 3}
+test while-1.10 {TclCompileWhileCmd: command body in quotes} {
+    set a {}
+    set i 1
+    while {$i<6} "append a x; incr i"
+    set a
+} {xxxxx}
+test while-1.11 {TclCompileWhileCmd: computed command body} {
+    catch {unset x1}
+    catch {unset bb}
+    catch {unset x2}
+    set x1 {append a x1; }
+    set bb {break}
+    set x2 {; append a x2; incr i}
+    set a {}
+    set i 1
+    while {$i<6} $x1$bb$x2
+    set a
+} {x1}
+test while-1.12 {TclCompileWhileCmd: long command body} {
+    set a {}
+    set i 1
+    while {$i<6} {
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 2 3}
+test while-1.13 {TclCompileWhileCmd: while command result} {
+    set i 0
+    set a [while {$i < 5} {incr i}]
+    set a
+} {}
+test while-1.14 {TclCompileWhileCmd: while command result} {
+    set i 0
+    set a [while {$i < 5} {if $i==3 break; incr i}]
+    set a
+} {}
+
+# Check "while" and "continue".
+
+test while-2.1 {continue tests} {
+    set a {}
+    set i 1
+    while {$i <= 4} {
+        incr i
+	if {$i == 3} continue
+	set a [concat $a $i]
+    }
+    set a
+} {2 4 5}
+test while-2.2 {continue tests} {
+    set a {}
+    set i 1
+    while {$i <= 4} {
+        incr i
+	if {$i != 2} continue
+	set a [concat $a $i]
+    }
+    set a
+} {2}
+test while-2.3 {continue tests, nested loops} {
+    set msg {}
+    set i 1
+    while {$i <= 4} {
+        incr i
+        set a 1
+	while {$a <= 2} {
+            incr a
+            if {$i>=3 && $a>=3} continue
+            set msg [concat $msg "$i.$a"]
+        }
+    }
+    set msg
+} {2.2 2.3 3.2 4.2 5.2}
+test while-2.4 {continue tests, long command body} {
+    set a {}
+    set i 1
+    while {$i<6} {
+	if $i==2 {incr i; continue}
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 3}
 
-test while-2.1 {continue in while loop} {
-    set list {1 2 3 4 5}
-    set index 0
-    set result {}
-    while {$index < 5} {
-	if {$index == 2} {set index [expr $index+1]; continue}
-	set result [concat $result [lindex $list $index]]
-	set index [expr $index+1]
+# Check "while" and "break".
+
+test while-3.1 {break tests} {
+    set a {}
+    set i 1
+    while {$i <= 4} {
+	if {$i == 3} break
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 2}
+test while-3.2 {break tests, nested loops} {
+    set msg {}
+    set i 1
+    while {$i <= 4} {
+        set a 1
+	while {$a <= 2} {
+            if {$i>=2 && $a>=2} break
+            set msg [concat $msg "$i.$a"]
+            incr a
+        }
+        incr i
+    }
+    set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test while-3.3 {break tests, long command body} {
+    set a {}
+    set i 1
+    while {$i<6} {
+	if $i==2 {incr i; continue}
+	if $i==5 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if $i==4 break
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+        incr i
     }
-    set result
-} {1 2 4 5}
+    set a
+} {1 3}
+
+# Check "while", "break", "continue" and computed command names.
 
-test while-3.1 {break in while loop} {
-    set list {1 2 3 4 5}
-    set index 0
-    set result {}
-    while {$index < 5} {
-	if {$index == 3} break
-	set result [concat $result [lindex $list $index]]
-	set index [expr $index+1]
+test while-4.1 {while and computed command names} {
+    set i 0
+    set z while
+    $z {$i < 10} {
+        incr i
     }
-    set result
-} {1 2 3}
+    set i
+} 10
 
-test while-4.1 {errors in while loops} {
-    set err [catch {while} msg]
-    list $err $msg
-} {1 {wrong # args: should be "while test command"}}
-test while-4.2 {errors in while loops} {
-    set err [catch {while 1} msg]
-    list $err $msg
-} {1 {wrong # args: should be "while test command"}}
-test while-4.3 {errors in while loops} {
-    set err [catch {while 1 2 3} msg]
-    list $err $msg
-} {1 {wrong # args: should be "while test command"}}
-test while-4.4 {errors in while loops} {
-    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
-    list $err $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test while-4.5 {errors in while loops} {
-    set x 1
-    set err [catch {while {$x} {set x foo}} msg]
-    list $err $msg
-} {1 {expected boolean value but got "foo"}}
-test while-4.6 {errors in while loops} {
-    set err [catch {while {1} {error "loop aborted"}} msg]
-    list $err $msg $errorInfo
-} {1 {loop aborted} {loop aborted
-    while executing
-"error "loop aborted""
-    ("while" body line 1)
-    invoked from within
-"while {1} {error "loop aborted"}"}}
+test while-5.1 {break and computed command names} {
+    set i 0
+    set z break
+    while 1 {
+        if {$i > 10} $z
+        incr i
+    }
+    set i
+} 11
 
-test while-5.1 {while return result} {
-    while {0} {set a 400}
-} {}
-test while-5.2 {while return result} {
-    set x 1
-    while {$x} {set x 0}
-} {}
+test while-6.1 {continue and computed command names} {
+    set i 0
+    set z continue
+    while 1 {
+        incr i
+        if {$i < 10} $z
+        break
+    }
+    set i
+} 10
diff --git a/contrib/tcl/tests/winFCmd.test b/contrib/tcl/tests/winFCmd.test
new file mode 100644
index 0000000..83691b0
--- /dev/null
+++ b/contrib/tcl/tests/winFCmd.test
@@ -0,0 +1,975 @@
+# This file tests the tclWinFCmd.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) winFCmd.test 1.8 97/05/21 14:49:13
+#
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {$tcl_platform(platform) != "windows"} {
+    return
+}
+
+proc createfile {file {string a}} {
+    set f [open $file w]
+    puts -nonewline $f $string
+    close $f
+    return $string
+}
+
+proc contents {file} {
+    set f [open $file r]
+    set r [read $f]
+    close $f
+    set r
+}
+
+proc cleanup {args} {
+    foreach p ". $args" {
+	set x ""
+	catch {
+	    set x [glob [file join $p tf*] [file join $p td*]]
+	}
+	if {$x != ""} {
+	    catch {eval file delete -force -- $x}
+	}
+    }
+}
+
+set testConfig(32s) 0
+set testConfig(95) 0
+set testConfig(NT) 0
+set testConfig(cdrom) 0
+set testConfig(exdev) 0
+set testConfig(UNCPath} 0
+
+# find a CD-ROM so we can test read-only filesystems.
+
+set cdrom {}
+set nodrive x:
+foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
+    set name ${p}:/dummy~~.fil
+    if [catch {set fd [open $name w]}] {
+	set err [lindex $errorCode 1]
+        if {$cdrom == "" && $err == "EACCES"} {
+	    set cdrom ${p}:
+	}
+	if {$err == "ENOENT"} {
+	    set nodrive ${p}:
+	}
+    } else {
+        close $fd
+	file delete $name
+    }
+}
+
+proc findfile {dir} {
+    foreach p [glob $dir/*] {
+        if {[file type $p] == "file"} {
+	    return $p
+	}
+    }
+    foreach p [glob $dir/*] {
+        if {[file type $p] == "directory"} {
+	    set f [findfile $p]
+	    if {$f != ""} {
+	        return $f
+	    }
+	}
+    }
+    return ""
+}
+
+if {$cdrom == ""} {
+    puts "Couldn't find a CD-ROM.  Skipping tests that access CD-ROM."
+    puts "If you have a CD-ROM, insert a data disk and rerun tests."
+} else {
+    set testConfig(cdrom) 1
+    set cdfile [findfile $cdrom]
+}
+
+if {[file exists c:/] && [file exists d:/]} {
+    catch {file delete d:/tf1}
+    if {[catch {close [open d:/tf1 w]}] == 0} {
+	file delete d:/tf1
+	set testConfig(exdev) 1
+    }
+}
+
+switch $tcl_platform(os) {
+    "Windows NT" {set testConfig(NT) 1}
+    "Windows 95" {set testConfig(95) 1}
+    "Win32s" {set testConfig(32s) 1}
+}
+
+if {[file exists //bisque/icepick]} {
+    set testConfig(UNCPath) 1
+}
+
+file delete -force -- td1
+set foo [catch {open td1 w} testfile]
+if {$foo} {
+    set testConfig(longFileNames) 0
+} else {
+    close $testfile
+    set testConfig(longFileNames) 1
+    file delete -force -- td1
+}
+
+# A really long file name
+# length of longname is 1216 chars, which should be greater than any static
+# buffer or allowable filename.
+
+set longname "abcdefghihjllmnopqrstuvwxyz01234567890"
+append longname $longname
+append longname $longname
+append longname $longname
+append longname $longname
+append longname $longname
+
+# Uses the "testfile" command instead of the "file" command.  The "file"
+# command provides several layers of sanity checks on the arguments and
+# it can be difficult to actually forward "insane" arguments to the
+# low-level posix emulation layer.
+
+test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {cdrom} {
+    list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
+} {1 EACCES}
+test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {
+    cleanup
+    file mkdir td1/td2/td3
+    file mkdir td2
+    list [catch {testfile mv td2 td1/td2} msg] $msg
+} {1 EEXIST} 
+test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {
+    cleanup
+    list [catch {testfile mv / td1} msg] $msg
+} {1 EINVAL}
+test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile mv td1 td1/td2} msg] $msg
+} {1 EINVAL}
+test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {
+    cleanup
+    file mkdir td1
+    createfile tf1
+    list [catch {testfile mv tf1 td1} msg] $msg
+} {1 EISDIR}
+test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {
+    cleanup
+    list [catch {testfile mv tf1 tf2} msg] $msg
+} {1 ENOENT}
+test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {
+    cleanup
+    list [catch {testfile mv "" tf2} msg] $msg
+} {1 ENOENT}
+test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {
+    cleanup
+    createfile tf1
+    list [catch {testfile mv tf1 ""} msg] $msg
+} {1 ENOENT}
+test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {
+    cleanup
+    file mkdir td1
+    createfile tf1
+    list [catch {testfile mv td1 tf1} msg] $msg
+} {1 ENOTDIR}
+test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {exdev} {
+    file delete -force d:/tf1
+    file mkdir c:/tf1
+    set msg [list [catch {testfile mv c:/tf1 d:/tf1} msg] $msg]
+    file delete -force c:/tf1
+    set msg
+} {1 EXDEV}
+test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {
+    cleanup
+    set fd [open tf1 w]
+    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}
+test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {
+    cleanup
+    createfile tf1
+    set fd [open tf2 w]
+    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}
+test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {
+    cleanup
+    list [catch {testfile mv nul tf1} msg] $msg
+} {1 EACCES}
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {95} {
+    cleanup
+    createfile tf1
+    list [catch {testfile mv tf1 nul} msg] $msg
+} {1 EACCES}
+test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {NT} {
+    cleanup
+    createfile tf1
+    list [catch {testfile mv tf1 nul} msg] $msg
+} {1 EEXIST}
+test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {
+    cleanup
+    createfile tf1 tf1
+    testfile mv tf1 tf2
+    list [file exists tf1] [contents tf2]
+} {0 tf1}
+test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {
+    cleanup
+    list [catch {testfile mv tf1 tf2} msg] $msg
+} {1 ENOENT} 
+test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {
+    cleanup
+    list [catch {testfile mv tf1 tf2} msg] $msg
+} {1 ENOENT} 
+test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {
+    cleanup
+    list [catch {testfile mv nul g} msg] $msg
+} {1 EACCES}
+# under 95, this would actually move the current dir out from under yourself.
+test winFCmd-1.20 {TclpRenameFile: src is dir} {NT} {
+    cleanup
+    file delete /tf1
+    list [catch {testfile mv [pwd] /tf1} msg] $msg
+} {1 EACCES}
+test winFCmd-1.21 {TclpRenameFile: obscenely long src} {
+    list [catch {testfile mv $longname tf1} msg] $msg
+} {1 ENAMETOOLONG}
+test winFCmd-1.22 {TclpRenameFile: obscenely long dst} {NT} {
+    # return ENOENT if name is too long!
+    cleanup
+    createfile tf1
+    list [catch {testfile mv tf1 $longname} msg] $msg
+} {1 ENOENT}
+test winFCmd-1.23 {TclpRenameFile: obscenely long dst} {95} {
+    cleanup
+    createfile tf1
+    list [catch {testfile mv tf1 $longname} msg] $msg
+} {1 ENAMETOOLONG}
+test winFCmd-1.24 {TclpRenameFile: move dir into self} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile mv [pwd]/td1 td1/td2} msg] $msg
+} {1 EINVAL}
+test winFCmd-1.25 {TclpRenameFile: move a root dir} {
+    cleanup
+    list [catch {testfile mv / c:/} msg] $msg
+} {1 EINVAL}
+test winFCmd-1.26 {TclpRenameFile: cross file systems} {cdrom} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile mv td1 $cdrom/td1} msg] $msg
+} {1 EXDEV} 
+test winFCmd-1.27 {TclpRenameFile: readonly fs} {cdrom} {
+    cleanup
+    list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
+} {1 EACCES}
+test winFCmd-1.28 {TclpRenameFile: open file} {
+    cleanup
+    set fd [open tf1 w]
+    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}    
+test winFCmd-1.29 {TclpRenameFile: errno == EEXIST} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    testfile mv tf1 tf2
+    list [file exist tf1] [file exist tf2]
+} {0 1}
+test winFCmd-1.30 {TclpRenameFile: src is dir} {
+    cleanup
+    file mkdir td1
+    createfile tf1
+    list [catch {testfile mv td1 tf1} msg] $msg
+} {1 ENOTDIR} 
+test winFCmd-1.31 {TclpRenameFile: dst is dir} {
+    cleanup
+    file mkdir td1
+    file mkdir td2/td2
+    list [catch {testfile mv td1 td2} msg] $msg
+} {1 EEXIST}
+test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory fails} {
+    cleanup
+    file mkdir td1
+    file mkdir td2/td2
+    list [catch {testfile mv td1 td2} msg] $msg
+} {1 EEXIST}
+test winFCmd-1.33 {TclpRenameFile: TclpRemoveDirectory succeeds} {
+    cleanup
+    file mkdir td1/td2
+    file mkdir td2
+    testfile mv td1 td2
+    list [file exist td1] [file exist td2] [file exist td2/td2]
+} {0 1 1}
+test winFCmd-1.34 {TclpRenameFile: After removing dst dir, MoveFile fails} {exdev} {
+    file mkdir d:/td1
+    testchmod 000 d:/td1
+    set msg [list [catch {testfile mv c:/windows d:/td1} msg] $msg]
+    set msg "$msg [file writable d:/td1]"
+    file delete d:/td1
+    set msg
+} {1 EXDEV 0}
+test winFCmd-1.35 {TclpRenameFile: src is dir, dst is not} {
+    file mkdir td1
+    createfile tf1
+    list [catch {testfile mv td1 tf1} msg] $msg
+} {1 ENOTDIR}
+test winFCmd-1.36 {TclpRenameFile: src is not dir, dst is} {
+    file mkdir td1
+    createfile tf1
+    list [catch {testfile mv tf1 td1} msg] $msg
+} {1 EISDIR}
+test winFCmd-1.37 {TclpRenameFile: src and dst not dir} {
+    createfile tf1 tf1
+    createfile tf2 tf2
+    testfile mv tf1 tf2
+    contents tf2
+} {tf1}
+test winFCmd-1.38 {TclpRenameFile: need to restore temp file} {
+    # Can't figure out how to cause this. 
+    # Need a file that can't be copied.
+} {}
+
+test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {cdrom} {
+    cleanup
+    list [catch {testfile cp $cdfile $cdrom/dummy~~.fil} msg] $msg
+} {1 EACCES}
+test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile cp td1 tf1} msg] $msg
+} {1 EISDIR}
+test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {
+    cleanup
+    createfile tf1
+    file mkdir td1
+    list [catch {testfile cp tf1 td1} msg] $msg
+} {1 EISDIR}
+test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {
+    cleanup
+    list [catch {testfile cp tf1 tf2} msg] $msg
+} {1 ENOENT}
+test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {
+    cleanup
+    list [catch {testfile cp "" tf2} msg] $msg
+} {1 ENOENT}
+test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {
+    cleanup
+    createfile tf1
+    list [catch {testfile cp tf1 ""} msg] $msg
+} {1 ENOENT}
+test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {95} {
+    cleanup
+    createfile tf1
+    set fd [open tf2 w]
+    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {NT} {
+    cleanup
+    list [catch {testfile cp nul tf1} msg] $msg
+} {1 EACCES}
+test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {95} {
+    cleanup
+    list [catch {testfile cp nul tf1} msg] $msg
+} {1 ENOENT}
+test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {
+    cleanup
+    createfile tf1 tf1
+    testfile cp tf1 tf2
+    list [contents tf1] [contents tf2]
+} {tf1 tf1}
+test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {
+    cleanup
+    createfile tf1 tf1
+    createfile tf2 tf2
+    testfile cp tf1 tf2
+    list [contents tf1] [contents tf2]
+} {tf1 tf1}
+test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {
+    cleanup
+    createfile tf1 tf1
+    testchmod 000 tf1
+    testfile cp tf1 tf2
+    list [contents tf2] [file writable tf2]
+} {tf1 0}
+test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {
+    cleanup
+    createfile tf1
+    file mkdir td1
+    list [catch {testfile cp tf1 td1} msg] $msg
+} {1 EISDIR} 
+test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile cp td1 tf1} msg] $msg
+} {1 EISDIR}
+test winFCmd-2.15 {TclpCopyFile: src is directory} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile cp td1 tf1} msg] $msg
+} {1 EISDIR}
+test winFCmd-2.16 {TclpCopyFile: dst is directory} {
+    cleanup
+    createfile tf1
+    file mkdir td1
+    list [catch {testfile cp tf1 td1} msg] $msg
+} {1 EISDIR}
+test winFCmd-2.17 {TclpCopyFile: dst is readonly} {
+    cleanup
+    createfile tf1 tf1
+    createfile tf2 tf2
+    testchmod 000 tf2
+    testfile cp tf1 tf2
+    list [file writable tf2] [contents tf2]
+} {1 tf1}
+test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {95} {
+    cleanup
+    createfile tf1
+    createfile tf2
+    testchmod 000 tf2
+    set fd [open tf2]
+    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
+    close $fd
+    set msg "$msg [file writable tf2]"
+} {1 EACCES 0}    
+
+test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {cdrom} {
+    list [catch {testfile rm $cdfile $cdrom/dummy~~.fil} msg] $msg
+} {1 EACCES}
+test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile rm td1} msg] $msg
+} {1 EISDIR} 
+test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {
+    cleanup
+    list [catch {testfile rm tf1} msg] $msg
+} {1 ENOENT}
+test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {
+    cleanup
+    list [catch {testfile rm ""} msg] $msg
+} {1 ENOENT}
+test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {
+    cleanup
+    set fd [open tf1 w]
+    set msg [list [catch {testfile rm tf1} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}
+test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {
+    cleanup
+    list [catch {testfile rm nul} msg] $msg
+} {1 EACCES}
+test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {
+    cleanup
+    createfile tf1
+    testfile rm tf1
+    file exist tf1
+} {0}
+test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile rm td1} msg] $msg
+} {1 EISDIR}
+test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {
+    cleanup
+    set fd [open tf1 w]
+    set msg [list [catch {testfile rm tf1} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}
+test winFCmd-3.10 {TclpDeleteFile: path is readonly} {
+    cleanup
+    createfile tf1
+    testchmod 000 tf1
+    testfile rm tf1
+    file exists tf1
+} {0}
+test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {
+    cleanup
+    set fd [open tf1 w]
+    testchmod 000 tf1
+    set msg [list [catch {testfile rm tf1} msg] $msg]
+    close $fd
+    set msg
+} {1 EACCES}
+
+test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {cdrom NT} {
+    list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
+} {1 EACCES}
+test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {cdrom 95} {
+    list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
+} {1 ENOSPC}
+test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile mkdir td1} msg] $msg
+} {1 EEXIST}
+test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {
+    cleanup
+    list [catch {testfile mkdir td1/td2} msg] $msg
+} {1 ENOENT}
+test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {
+    cleanup
+    testfile mkdir td1
+    file type td1
+} {directory}
+
+test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {
+    cleanup
+    file mkdir td1
+    testfile cpdir td1 td2
+    list [file type td1] [file type td2]
+} {directory directory}
+
+test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {
+    cleanup
+    file mkdir td1
+    testchmod 000 td1
+    testfile rmdir td1
+    file exist td1
+} {0}
+test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {
+    cleanup
+    file mkdir td1/td2
+    list [catch {testfile rmdir td1} msg] $msg
+} {1 {td1 EEXIST}}
+test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {
+    # can't test this w/o removing everything on your hard disk first!
+    # testfile rmdir /
+} {}
+test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {
+    cleanup
+    list [catch {testfile rmdir td1} msg] $msg
+} {1 {td1 ENOENT}}
+test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {
+    cleanup
+    list [catch {testfile rmdir ""} msg] $msg
+} {1 ENOENT}
+test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {
+    cleanup
+    createfile tf1
+    list [catch {testfile rmdir tf1} msg] $msg
+} {1 {tf1 ENOTDIR}}
+test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {
+    cleanup
+    file mkdir td1
+    testfile rmdir td1
+    file exists td1
+} {0}
+test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {
+    cleanup
+    createfile tf1
+    list [catch {testfile rmdir tf1} msg] $msg
+} {1 {tf1 ENOTDIR}}
+test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {
+    cleanup
+    file mkdir td1
+    testchmod 000 td1
+    testfile rmdir td1
+    file exists td1
+} {0}
+test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {95} {
+    cleanup
+    list [catch {testfile rmdir nul} msg] $msg
+} {1 {nul EACCES}}
+test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {NT} {
+    cleanup
+    list [catch {testfile rmdir /} msg] $msg
+} {1 {\ EACCES}}
+test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {95} {
+    cleanup
+    createfile tf1
+    list [catch {testfile rmdir tf1} msg] $msg
+} {1 {tf1 ENOTDIR}}
+test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {
+    cleanup
+    file mkdir td1
+    testchmod 000 td1
+    testfile rmdir td1
+    file exists td1
+} {0}
+test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95} {
+    cleanup
+    file mkdir td1/td2
+    list [catch {testfile rmdir td1} msg] $msg
+} {1 {td1 EEXIST}}
+test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {
+    cleanup
+    file mkdir td1/td2
+    list [catch {testfile rmdir td1} msg] $msg
+} {1 {td1 EEXIST}}
+test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {
+    cleanup
+    createfile tf1
+    list [catch {testfile rmdir -force tf1} msg] $msg
+} {1 {tf1 ENOTDIR}}
+test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {
+    cleanup
+    file mkdir td1/td2
+    testfile rmdir -force td1
+    file exists td1
+} {0}
+
+test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {
+    cleanup
+    file mkdir td1/td2/td3
+    testfile rmdir -force td1
+    file exists td1
+} {0}
+test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {
+    cleanup
+    file mkdir td1/td2/td3
+    testfile cpdir td1 td2
+    list [file exists td1] [file exists td2]
+} {1 1}
+test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {
+    cleanup
+    list [catch {testfile cpdir td1 td2} msg] $msg
+} {1 {td1 ENOENT}}
+test winFCmd-7.4 {TraverseWinTree: source isn't directory} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile cpdir td1 td2
+    contents td2/tf1
+} {tf1}
+test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile cpdir td1 td2
+    contents td2/tf1
+} {tf1}
+test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile rmdir -force td1
+    file exists td1
+} {0}
+test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile cpdir td1 td2
+    contents td2/tf1
+} {tf1}    
+test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {95 cdrom} {
+    list [catch {testfile rmdir $cdrom/} msg] $msg
+} "1 {$cdrom\\ EEXIST}"
+test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {NT cdrom} {
+    list [catch {testfile rmdir $cdrom/} msg] $msg
+} "1 {$cdrom\\ EACCES}"
+test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} {
+    # can't make it happen
+} {}
+test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {
+    cleanup
+    file mkdir td1
+    testchmod 000 td1
+    createfile td1/tf1 tf1
+    testfile cpdir td1 td2
+    list [file exists td2] [file writable td2]
+} {1 0}
+test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile rmdir -force td1
+    file exists td1
+} {0}
+test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile cpdir td1 td2
+    contents td2/tf1
+} {tf1}    
+test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {95} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile cpdir td1 /} msg] $msg
+} {1 {\ EEXIST}}
+test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {NT} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile cpdir td1 /} msg] $msg
+} {1 {\ EACCES}}
+test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {
+    cleanup
+    file mkdir td1
+    testfile cpdir td1 td2
+} {}
+test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {
+    cleanup
+    file mkdir td1
+    createfile td1/td2
+    testfile cpdir td1 td2
+    glob td2/*
+} {td2/td2}
+test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1
+    createfile td1/tf2
+    file mkdir td1/td2/td3
+    createfile td1/tf3
+    createfile td1/tf4
+    testfile cpdir td1 td2
+    glob td2/*
+} {td2/tf1 td2/tf2 td2/td2 td2/tf3 td2/tf4}
+test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {
+    cleanup
+    file mkdir td1
+    testchmod 000 td1
+    createfile td1/tf1 tf1
+    testfile cpdir td1 td2
+    list [file exists td2] [file writable td2]
+} {1 0}
+test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1 tf1
+    testfile rmdir -force td1
+    file exists td1
+} {0}
+test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {
+    cleanup
+    list [catch {testfile cpdir td1 td2} msg] $msg
+} {1 {td1 ENOENT}}
+
+test winFCmd-8.1 {TraversalCopy: DOTREE_F} {
+    cleanup
+    file mkdir td1
+    list [catch {testfile cpdir td1 td1} msg] $msg
+} {1 {td1 EEXIST}}
+test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {
+    cleanup
+    file mkdir td1/td2
+    testchmod 000 td1
+    testfile cpdir td1 td2
+    list [file writable td1] [file writable td1/td2]
+} {0 1}
+test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {
+    cleanup
+    file mkdir td1
+    testfile cpdir td1 td2
+} {}
+
+test winFCmd-9.1 {TraversalDelete: DOTREE_F} {
+    cleanup
+    file mkdir td1
+    createfile td1/tf1
+    testfile rmdir -force td1
+} {}
+test winFCmd-9.2 {TraversalDelete: DOTREE_F} {95} {
+    cleanup
+    file mkdir td1
+    set fd [open td1/tf1 w]
+    set msg [list [catch {testfile rmdir -force td1} msg] $msg]
+    close $fd
+    set msg
+} {1 {td1\tf1 EACCES}}
+test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {
+    cleanup
+    file mkdir td1/td2
+    testchmod 000 td1
+    testfile rmdir -force td1
+    file exists td1
+} {0}
+test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {
+    cleanup
+    file mkdir td1/td1/td3/td4/td5
+    testfile rmdir -force td1
+} {}
+
+test winFCmd-10.1 {AttributesPosixError - get} {
+    cleanup
+    list [catch {file attributes td1 -archive} msg] $msg
+} {1 {cannot get attribute "-archive" for file "td1": no such file or directory}}
+test winFCmd-10.2 {AttributesPosixError - set} {
+    cleanup
+    list [catch {file attributes td1 -archive 0} msg] $msg
+} {1 {cannot set attribute "-archive" for file "td1": no such file or directory}}
+
+test winFCmd-11.1 {GetWinFileAttributes} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -archive} msg] $msg [cleanup]
+} {0 1 {}}
+test winFCmd-11.2 {GetWinFileAttributes} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -readonly} msg] $msg [cleanup]
+} {0 0 {}}
+test winFCmd-11.3 {GetWinFileAttributes} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -hidden} msg] $msg [cleanup]
+} {0 0 {}}
+test winFCmd-11.4 {GetWinFileAttributes} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -system} msg] $msg [cleanup]
+} {0 0 {}}
+
+test winFCmd-12.1 {ConvertFileNameFormat} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -longname} msg] $msg [cleanup]
+} {0 td1 {}}
+test winFCmd-12.2 {ConvertFileNameFormat} {
+    cleanup
+    file mkdir td1
+    close [open td1/td1 w]
+    list [catch {file attributes td1/td1 -longname} msg] $msg [cleanup]
+} {0 td1/td1 {}}
+test winFCmd-12.3 {ConvertFileNameFormat} {
+    cleanup
+    file mkdir td1
+    file mkdir td1/td2
+    close [open td1/td3 w]
+    list [catch {file attributes td1/td2/../td3 -longname} msg] $msg [cleanup]
+} {0 td1/td2/../td3 {}}
+test winFCmd-12.4 {ConvertFileNameFormat} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes ./td1 -longname} msg] $msg [cleanup]
+} {0 ./td1 {}}
+test winFCmd-12.5 {ConvertFileNameFormat} {
+    catch {file delete -force -- c:/td1}
+    close [open c:/td1 w]
+    list [catch {file attributes c:/td1 -longname} msg] $msg [file delete -force -- c:/td1]
+} {0 c:/td1 {}}
+test winFCmd-12.6 {ConvertFileNameFormat} {UNCPath} {
+    catch {file delete -force -- //bisque/icepick/test/td1}
+    close [open //bisque/icepick/test/td1 w]
+    list [catch {file attributes //bisque/icepick/test/td1 -longname} msg] $msg [file delete -force -- //bisque/icepick/test/td1]
+} {0 //bisque/icepick/test/td1 {}}
+test winFCmd-12.7 {ConvertFileNameFormat} {longFileNames} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -longname} msg] $msg [cleanup]
+} {0 td1 {}}
+test winFCmd-12.8 {ConvertFileNameFormat} {32s} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -longname} msg] $msg [cleanup]
+} {0 td1 {}}
+test winFCmd-12.9 {ConvertFileNameFormat} {longFileNames} {
+    cleanup
+    close [open td1td1td1 w]
+    list [catch {file attributes td1td1td1 -shortname}] [cleanup]
+} {0 {}}
+test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -shortname} msg] $msg [cleanup]
+} {0 td1 {}}
+
+test winFCmd-13.1 {GetWinFileLongName} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -longname} msg] $msg [cleanup]
+} {0 td1 {}}
+
+test winFCmd-14.1 {GetWinFileShortName} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -shortname} msg] $msg [cleanup]
+} {0 td1 {}}
+
+test winFCmd-15.1 {SetWinFileAttributes} {
+    cleanup
+    list [catch {file attributes td1 -archive 0} msg] $msg
+} {1 {cannot set attribute "-archive" for file "td1": no such file or directory}}
+test winFCmd-15.2 {SetWinFileAttributes - archive} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -archive 1} msg] $msg [file attributes td1 -archive] [cleanup]
+} {0 {} 1 {}}
+test winFCmd-15.3 {SetWinFileAttributes - archive} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -archive 0} msg] $msg [file attributes td1 -archive] [cleanup]
+} {0 {} 0 {}}
+test winFCmd-15.4 {SetWinFileAttributes - hidden} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -hidden 1} msg] $msg [file attributes td1 -hidden] [file attributes td1 -hidden 0] [cleanup]
+} {0 {} 1 {} {}}
+test winFCmd-15.5 {SetWinFileAttributes - hidden} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -hidden 0} msg] $msg [file attributes td1 -hidden] [cleanup]
+} {0 {} 0 {}}
+test winFCmd-15.6 {SetWinFileAttributes - readonly} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -readonly 1} msg] $msg [file attributes td1 -readonly] [cleanup]
+} {0 {} 1 {}}
+test winFCmd-15.7 {SetWinFileAttributes - readonly} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -readonly 0} msg] $msg [file attributes td1 -readonly] [cleanup]
+} {0 {} 0 {}}
+test winFCmd-15.8 {SetWinFileAttributes - system} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -system 1} msg] $msg [file attributes td1 -system] [cleanup]
+} {0 {} 1 {}}
+test winFCmd-15.9 {SetWinFileAttributes - system} {
+    cleanup
+    close [open td1 w]
+    list [catch {file attributes td1 -system 0} msg] $msg [file attributes td1 -system] [cleanup]
+} {0 {} 0 {}}
+test winFCmd-15.10 {SetWinFileAttributes - failing} {cdrom} {
+    cleanup
+    catch {file attributes $cdfile -archive 1}
+} {1}
+
+cleanup
+
+return
+
+foreach source {tef ted tnf tnd "" nul com1} {
+    foreach chmodsrc {000 755} {
+        foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" {
+	    foreach chmoddst {000 755} {
+		puts hi
+		cleanup
+		file delete -force ted tef
+		file mkdir ted
+		createfile tef
+		createfile tfe
+		file mkdir tdempty
+		file mkdir tdfull/td1/td2
+
+		catch {testchmod $chmodsrc $source}
+		catch {testchmod $chmoddst $dest}
+
+		if [catch {file rename $source $dest} msg] {
+		    puts "file rename $source ($chmodsrc) $dest ($chmoddst)"
+		    puts $msg
+		}
+	    }
+	}
+    }
+}
+
diff --git a/contrib/tcl/tests/winNotify.test b/contrib/tcl/tests/winNotify.test
new file mode 100644
index 0000000..2914a41
--- /dev/null
+++ b/contrib/tcl/tests/winNotify.test
@@ -0,0 +1,155 @@
+# This file tests the tclWinNotify.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) winNotify.test 1.2 97/04/14 17:24:56
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {$tcl_platform(platform) != "windows"} {
+    return
+}
+
+# There is no explicit test for InitNotifier or NotifierExitHandler
+
+test winNotify-1.1 {Tcl_SetTimer: positive timeout} {
+    set done 0
+    after 1000 { set done 1 }
+    vwait done
+    set done
+} 1
+test winNotify-1.2 {Tcl_SetTimer: positive timeout, message pending} {
+    set x 0
+    set y 1
+    set a1 [after 0 { incr y }]
+    after cancel $a1
+    after 500 { incr x }
+    vwait x
+    list $x $y
+} {1 1}
+test winNotify-1.3 {Tcl_SetTimer: cancelling positive timeout} {
+    set x 0
+    set y 1
+    set id [after 10000 { incr y }]
+    after 0 { incr x }
+    vwait x
+    after cancel $id
+    list $x $y
+} {1 1}
+test winNotify-1.4 {Tcl_SetTimer: null timeout, message pending} {
+    set x 0
+    set y 1
+    after 0 { incr x }
+    after 0 { incr y }
+    vwait x
+    list $x $y
+} {1 2}
+
+test winNotify-2.1 {Tcl_ResetIdleTimer} {
+    set x 0
+    update
+    after idle { incr x }
+    vwait x
+    set x
+} 1
+test winNotify-2.2 {Tcl_ResetIdleTimer: message pending} {
+    set x 0
+    set y 1
+    update
+    after idle { incr x }
+    after idle { incr y }
+    update
+    list $x $y
+} {1 2}
+
+test winNotify-3.1 {NotifierProc: non-modal normal timer} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    after 500 { incr x; testeventloop done }
+    testeventloop wait
+    set x
+} 1
+test winNotify-3.2 {NotifierProc: non-modal normal timer, rescheduled} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    after 500 { incr x; after 100 {incr x; testeventloop done }}
+    testeventloop wait
+    set x
+} 2
+test winNotify-3.3 {NotifierProc: modal normal timer} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    after 500 { incr x }
+    vwait x
+    set x
+} 1
+test winNotify-3.4 {NotifierProc: modal normal timer, rescheduled} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    set y 0
+    after 500 { incr y; after 100 {incr x}}
+    vwait x
+    list $x $y
+} {1 1}
+test winNotify-3.5 {NotifierProc: non-modal idle timer} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    after idle { incr x; testeventloop done }
+    testeventloop wait
+    set x
+} 1
+test winNotify-3.6 {NotifierProc: non-modal idle timer, rescheduled} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    after idle { incr x; after idle {incr x; testeventloop done }}
+    testeventloop wait
+    set x
+} 2
+test winNotify-3.7 {NotifierProc: modal idle timer} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    after idle { incr x }
+    vwait x
+    set x
+} 1
+test winNotify-3.8 {NotifierProc: modal idle timer, rescheduled} {
+    update
+    set x 0
+    foreach i [after info] {
+	after cancel $i
+    }
+    set y 0
+    after idle { incr y; after idle {incr x}}
+    vwait x
+    list $x $y
+} {1 1}
+
+# Tcl_DoOneEvent is tested by the timer.test, io.test, and event.test files
diff --git a/contrib/tcl/tests/winPipe.test b/contrib/tcl/tests/winPipe.test
new file mode 100644
index 0000000..af26db4
--- /dev/null
+++ b/contrib/tcl/tests/winPipe.test
@@ -0,0 +1,283 @@
+# 
+# winPipe.test --
+#
+# This file contains a collection of tests for tclWinPipe.c
+
+# Sourcing this file into Tcl runs the tests and generates output for 
+# errors.  No output means no errors were found.
+#
+# Copyright (c) 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.
+#
+# SCCS: @(#) winPipe.test 1.7 97/06/23 17:30:41
+
+if {$tcl_platform(platform) != "windows"} {
+    return
+}
+
+set cat16 [file join $tcl_library ../win/cat16.exe]
+set cat32 [file join $tcl_library ../win/cat32.exe]
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if [catch {puts console1 ""}] {
+    set testConfig(AllocConsole) 1
+} else {
+    set testConfig(.console) 1
+}
+
+set big aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n
+append big $big
+append big $big	
+append big $big
+append big $big
+append big $big
+append big $big
+
+set f [open "little" w] 
+puts -nonewline $f "little"
+close $f
+
+set f [open "big" w]
+puts -nonewline $f $big
+close $f
+
+proc contents {file} {
+    set f [open $file r]
+    set r [read $f]
+    close $f
+    set r
+}
+
+if [file exists $cat32] {
+test winpipe-1.1 {32 bit comprehensive tests: from little file} {
+    exec $cat32 < little > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "little stderr32"
+test winpipe-1.2 {32 bit comprehensive tests: from big file} {
+    exec $cat32 < big > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{$big} stderr32"
+test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt} {
+    exec more < little | $cat32 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{little\n} stderr32"
+test winpipe-1.4 {32 bit comprehensive tests: a little from pipe} {95} {
+    exec more < little |& $cat32 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{\nlittle} stderr32"
+test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {nt} {
+    exec more < big | $cat32 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{$big} stderr32"
+test winpipe-1.6 {32 bit comprehensive tests: a lot from pipe} {95} {
+    exec command /c type big |& $cat32 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{$big} stderr32"
+test winpipe-1.7 {32 bit comprehensive tests: from console} {AllocConsole} {
+    # would block waiting for human input
+} {}
+test winpipe-1.8 {32 bit comprehensive tests: from NUL} {
+    exec $cat32 < nul > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{} stderr32"
+test winpipe-1.9 {32 bit comprehensive tests: from socket} {
+    # doesn't work
+} {}
+test winpipe-1.10 {32 bit comprehensive tests: from nowhere} {.console} {
+    exec $cat32 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{} stderr32"
+test winpipe-1.11 {32 bit comprehensive tests: from file handle} {
+    set f [open "little" r]
+    exec $cat32 <@$f > stdout 2> stderr
+    close $f
+    list [contents stdout] [contents stderr]
+} "little stderr32"
+test winpipe-1.12 {32 bit comprehensive tests: read from application} {
+    set f [open "|$cat32 < little" r]
+    gets $f line
+    catch {close $f} msg
+    list $line $msg
+} "little stderr32"
+test winpipe-1.13 {32 bit comprehensive tests: a little to file} {
+    exec $cat32 < little > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "little stderr32"
+test winpipe-1.14 {32 bit comprehensive tests: a lot to file} {
+    exec $cat32 < big > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{$big} stderr32"
+test winpipe-1.15 {32 bit comprehensive tests: a little to pipe} {nt} {
+    exec $cat32 < little | more > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{little\n} stderr32"
+test winpipe-1.16 {32 bit comprehensive tests: a little to pipe} {95} {
+    exec $cat32 < little | more > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{\nlittle} stderr32"
+test winpipe-1.17 {32 bit comprehensive tests: a lot to pipe} {nt} {
+    exec $cat32 < big | more > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{$big\n} stderr32"
+test winpipe-1.18 {32 bit comprehensive tests: a lot to pipe} {95} {
+    exec $cat32 < big | more > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{\n$big} stderr32"
+test winpipe-1.19 {32 bit comprehensive tests: to console} {
+    catch {exec $cat32 << "You should see this\n" >@stdout} msg
+    set msg
+} stderr32
+test winpipe-1.20 {32 bit comprehensive tests: to NUL} {
+    # some apps hang when sending a large amount to NUL.  $cat32 isn't one.
+    catch {exec $cat32 < big > nul} msg
+    set msg
+} stderr32
+test winpipe-1.21 {32 bit comprehensive tests: to nowhere} {.console} {
+    exec $cat32 < big >&@stdout 
+} {}
+test winpipe-1.22 {32 bit comprehensive tests: to file handle} {
+    set f1 [open "stdout" w]
+    set f2 [open "stderr" w]
+    exec $cat32 < little >@$f1 2>@$f2
+    close $f1
+    close $f2
+    list [contents stdout] [contents stderr]
+} "little stderr32"
+test winpipe-1.23 {32 bit comprehensive tests: write to application} {
+    set f [open "|$cat32 > stdout" w]
+    puts -nonewline $f "foo"
+    catch {close $f} msg
+    list [contents stdout] $msg
+} "foo stderr32"
+test winpipe-1.24 {32 bit comprehensive tests: read/write application} {
+    set f [open "|$cat32" r+]
+    puts $f $big
+    puts $f \032
+    flush $f
+    set r [read $f 64]
+    catch {close $f}
+    set r
+} "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+test winpipe-1.25 {32 bit comprehensive tests: to socket} {
+    # doesn't work
+} {}
+}
+
+if [file exists $cat16] {
+test winpipe-2.1 {16 bit comprehensive tests: from little file} {
+    exec $cat16 < little > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "little stderr16"
+test winpipe-2.2 {16 bit comprehensive tests: from big file} {
+    exec $cat16 < big > stdout 2> stderr
+    list [contents stdout] [contents stderr] 
+} "{$big} stderr16"
+test winpipe-2.3 {16 bit comprehensive tests: a little from pipe} {nt} {
+    exec more < little | $cat16 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{little\n} stderr16"
+test winpipe-2.4 {16 bit comprehensive tests: a little from pipe} {95} {
+    exec more < little | $cat16 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{\nlittle} stderr16"
+test winpipe-2.5 {16 bit comprehensive tests: a lot from pipe} {nt} {
+    exec $cat16 < big | $cat16 > stdout 2> stderr
+    list [contents stdout] [contents stderr] 
+} "{$big} stderr16stderr16"
+test winpipe-2.6 {16 bit comprehensive tests: a lot from pipe} {95} {
+    exec more < big | $cat16 > stdout 2> stderr
+    list [contents stdout] [contents stderr] 
+} "{\n$big} stderr16"
+test winpipe-2.7 {16 bit comprehensive tests: from console} {AllocConsole} {
+    # would block waiting for human input
+} {}		     
+test winpipe-2.8 {16 bit comprehensive tests: from NUL} {nt} {
+    exec $cat16 < nul > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{} stderr16"
+test winpipe-2.9 {16 bit comprehensive tests: from socket} {
+    # doesn't work
+} {}
+test winpipe-2.10 {16 bit comprehensive tests: from nowhere} {.console} {
+    exec $cat16 > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{} stderr16"
+test winpipe-2.11 {16 bit comprehensive tests: from file handle} {
+    set f [open "little" r]
+    exec $cat16 <@$f > stdout 2> stderr
+    close $f
+    list [contents stdout] [contents stderr]
+} "little stderr16"
+test winpipe-2.12 {16 bit comprehensive tests: read from application} {
+    set f [open "|$cat16 < little" r]
+    gets $f line
+    catch {close $f} msg
+    list $line $msg
+} {little stderr16}
+test winpipe-2.13 {16 bit comprehensive tests: a little to file} {
+    exec $cat16 < little > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "little stderr16"
+test winpipe-2.14 {16 bit comprehensive tests: a lot to file} {
+    exec $cat16 < big > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{$big} stderr16"
+test winpipe-2.15 {16 bit comprehensive tests: a little to pipe} {nt} {
+    catch {exec $cat16 < little | more > stdout 2> stderr}
+    list [contents stdout] [contents stderr]
+} "{little\n} stderr16"
+test winpipe-2.16 {16 bit comprehensive tests: a little to pipe} {95} {
+    exec $cat16 < little | more > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{\nlittle} stderr16"
+test winpipe-2.17 {16 bit comprehensive tests: a lot to pipe} {nt} {
+    catch {exec $cat16 < big | more > stdout 2> stderr}
+    list [contents stdout] [contents stderr]
+} "{$big\n} stderr16"
+test winpipe-2.18 {16 bit comprehensive tests: a lot to pipe} {95} {
+    exec $cat16 < big | more > stdout 2> stderr
+    list [contents stdout] [contents stderr]
+} "{\n$big} stderr16"
+test winpipe-2.19 {16 bit comprehensive tests: to console} {
+    catch {exec $cat16 << "You should see this\n" >@stdout} msg
+    set msg
+} stderr16
+test winpipe-2.20 {16 bit comprehensive tests: to NUL} {nt} {
+    # some apps hang when sending a large amount to NUL.  cat16 isn't one.
+    catch {exec $cat16 < big > nul} msg
+    set msg
+} stderr16
+test winpipe-2.21 {16 bit comprehensive tests: to nowhere} {.console} {
+    exec $cat16 < big >&@stdout 
+} {}
+test winpipe-2.22 {16 bit comprehensive tests: to file handle} {
+    set f1 [open "stdout" w]
+    set f2 [open "stderr" w]
+    exec $cat16 < little >@$f1 2>@$f2
+    close $f1
+    close $f2
+    list [contents stdout] [contents stderr]
+} "little stderr16"
+test winpipe-2.23 {16 bit comprehensive tests: write to application} {
+    set f [open "|$cat16 > stdout" w]
+    puts -nonewline $f "foo"
+    catch {close $f} msg
+    list [contents stdout] $msg
+} "foo stderr16"
+test winpipe-2.24 {16 bit comprehensive tests: read/write application} {nt} {
+    set f [open "|$cat16" r+]
+    puts $f $big
+    puts $f \032
+    flush $f
+    set r [read $f 64]
+    catch {close $f}
+    set r
+} "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+test winpipe-2.25 {16 bit comprehensive tests: to socket} {
+    # doesn't work
+} {}
+}
+
diff --git a/contrib/tcl/unix/Makefile.in b/contrib/tcl/unix/Makefile.in
index 79f4359..3d992a1 100644
--- a/contrib/tcl/unix/Makefile.in
+++ b/contrib/tcl/unix/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# SCCS: @(#) Makefile.in 1.140 96/08/01 20:06:06
+# SCCS: @(#) Makefile.in 1.174 97/06/26 17:58:32
 
 # Current Tcl version;  used in various names.
 
@@ -39,6 +39,9 @@ INSTALL_ROOT =
 # run-time to override this value):
 TCL_LIBRARY =	$(prefix)/lib/tcl$(VERSION)
 
+# Package search path.
+TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
+
 # Path name to use when installing library scripts:
 SCRIPT_INSTALL_DIR =	$(INSTALL_ROOT)$(TCL_LIBRARY)
 
@@ -101,10 +104,12 @@ ENV_FLAGS =
 # the current one does).
 GENERIC_FLAGS =
 #GENERIC_FLAGS = -DTCL_GENERIC_ONLY
-UNIX_OBJS = tclMtherr.o tclUnixChan.o tclUnixFile.o \
-	tclUnixNotfy.o tclUnixPipe.o tclUnixSock.o tclUnixTime.o \
-	tclUnixInit.o
+UNIX_OBJS = tclMtherr.o tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
+	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
+	tclUnixTime.o tclUnixInit.o
 #UNIX_OBJS =
+NOTIFY_OBJS = tclUnixNotfy.o
+#NOTIFY_OBJS =
 
 # To enable memory debugging reverse the comment characters on the following
 # lines.  Warning:  if you enable memory debugging, you must do it
@@ -113,6 +118,12 @@ UNIX_OBJS = tclMtherr.o tclUnixChan.o tclUnixFile.o \
 MEM_DEBUG_FLAGS =
 #MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
 
+# To enable compilation debugging reverse the comment characters on
+# one of the following lines.
+COMPILE_DEBUG_FLAGS =
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_STATS
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+
 # Some versions of make, like SGI's, use the following variable to
 # determine which shell to use for executing commands:
 SHELL =		/bin/sh
@@ -171,6 +182,7 @@ SRC_DIR =		@srcdir@
 TOP_DIR =		@srcdir@/..
 GENERIC_DIR = 		$(TOP_DIR)/generic
 COMPAT_DIR =		$(TOP_DIR)/compat
+TOOL_DIR =		$(TOP_DIR)/tools
 DLTEST_DIR =		@srcdir@/dltest
 UNIX_DIR = 		@srcdir@
 CC =			@CC@
@@ -184,7 +196,7 @@ CC =			@CC@
 
 CC_SWITCHES =	${CFLAGS} ${TCL_SHLIB_CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
 ${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
+${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
 
 LIBS =		@DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc
 
@@ -195,58 +207,73 @@ ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
 
 TCLSH_OBJS = tclAppInit.o
 
-TCLTEST_OBJS = tclTestInit.o tclTest.o tclUnixTest.o
+TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclUnixTest.o
 
-GENERIC_OBJS = panic.o regexp.o tclAsync.o tclBasic.o tclCkalloc.o \
-	tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclDate.o tclEnv.o \
-	tclEvent.o tclExpr.o tclFHandle.o tclFileName.o tclGet.o tclHash.o \
-	tclHistory.o tclInterp.o tclIO.o tclIOCmd.o \
-	tclIOSock.o tclIOUtil.o tclLink.o tclLoad.o tclMain.o tclNotify.o \
-	tclParse.o tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o \
-	tclUtil.o tclVar.o
+XTTEST_OBJS = tclTest.o tclTestObj.o tclUnixTest.o tclXtNotify.o \
+	tclXtTest.o xtTestInit.o
 
-OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} @DL_OBJS@
+GENERIC_OBJS = panic.o regexp.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
+	tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompExpr.o \
+	tclCompile.o tclDate.o tclEnv.o tclEvent.o tclExecute.o \
+	tclFCmd.o tclFileName.o tclGet.o tclHash.o tclHistory.o \
+	tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o tclIOSock.o \
+	tclIOUtil.o tclLink.o tclListObj.o tclLoad.o tclMain.o tclNamesp.o \
+	tclNotify.o tclObj.o tclParse.o tclPipe.o tclPkg.o tclPosixStr.o \
+	tclPreserve.o tclProc.o tclStringObj.o tclTimer.o tclUtil.o tclVar.o
+
+OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} @DL_OBJS@
 
 GENERIC_HDRS = \
 	$(GENERIC_DIR)/tclRegexp.h \
 	$(GENERIC_DIR)/tcl.h \
 	$(GENERIC_DIR)/tclInt.h \
 	$(GENERIC_DIR)/tclPort.h \
-	$(GENERIC_DIR)/patchlevel.h
+	$(GENERIC_DIR)/tclPatch.h
 
 GENERIC_SRCS = \
 	$(GENERIC_DIR)/regexp.c \
 	$(GENERIC_DIR)/tclAsync.c \
 	$(GENERIC_DIR)/tclBasic.c \
+	$(GENERIC_DIR)/tclBinary.c \
 	$(GENERIC_DIR)/tclCkalloc.c \
 	$(GENERIC_DIR)/tclClock.c \
 	$(GENERIC_DIR)/tclCmdAH.c \
 	$(GENERIC_DIR)/tclCmdIL.c \
 	$(GENERIC_DIR)/tclCmdMZ.c \
+	$(GENERIC_DIR)/tclCompExpr.c \
+	$(GENERIC_DIR)/tclCompile.c \
 	$(GENERIC_DIR)/tclDate.c \
 	$(GENERIC_DIR)/tclEnv.c \
 	$(GENERIC_DIR)/tclEvent.c \
-	$(GENERIC_DIR)/tclExpr.c \
-	$(GENERIC_DIR)/tclFHandle.c \
+	$(GENERIC_DIR)/tclExecute.c \
+	$(GENERIC_DIR)/tclFCmd.c \
 	$(GENERIC_DIR)/tclFileName.c \
 	$(GENERIC_DIR)/tclGet.c \
 	$(GENERIC_DIR)/tclHash.c \
 	$(GENERIC_DIR)/tclHistory.c \
+	$(GENERIC_DIR)/tclIndexObj.c \
 	$(GENERIC_DIR)/tclInterp.c \
 	$(GENERIC_DIR)/tclIO.c \
 	$(GENERIC_DIR)/tclIOCmd.c \
 	$(GENERIC_DIR)/tclIOSock.c \
 	$(GENERIC_DIR)/tclIOUtil.c \
 	$(GENERIC_DIR)/tclLink.c \
+	$(GENERIC_DIR)/tclListObj.c \
 	$(GENERIC_DIR)/tclLoad.c \
 	$(GENERIC_DIR)/tclMain.c \
+	$(GENERIC_DIR)/tclNamesp.c \
 	$(GENERIC_DIR)/tclNotify.c \
-	$(GENERIC_DIR)/tclParse.c \
+	$(GENERIC_DIR)/tclObj.c \
+        $(GENERIC_DIR)/tclParse.c \
+	$(GENERIC_DIR)/tclPipe.c \
 	$(GENERIC_DIR)/tclPkg.c \
 	$(GENERIC_DIR)/tclPosixStr.c \
 	$(GENERIC_DIR)/tclPreserve.c \
 	$(GENERIC_DIR)/tclProc.c \
+	$(GENERIC_DIR)/tclStringObj.c \
 	$(GENERIC_DIR)/tclTest.c \
+	$(GENERIC_DIR)/tclTestObj.c \
+	$(GENERIC_DIR)/tclTimer.c \
 	$(GENERIC_DIR)/tclUtil.c \
 	$(GENERIC_DIR)/tclVar.c
 
@@ -257,6 +284,8 @@ UNIX_SRCS = \
 	$(UNIX_DIR)/tclAppInit.c \
 	$(UNIX_DIR)/tclMtherr.c \
 	$(UNIX_DIR)/tclUnixChan.c \
+	$(UNIX_DIR)/tclUnixEvent.c \
+	$(UNIX_DIR)/tclUnixFCmd.c \
 	$(UNIX_DIR)/tclUnixFile.c \
 	$(UNIX_DIR)/tclUnixNotfy.c \
 	$(UNIX_DIR)/tclUnixPipe.c \
@@ -299,6 +328,13 @@ tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
 	${CC} @LD_FLAGS@ ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
 		@TCL_LD_SEARCH_FLAGS@ -o tcltest
 
+xttest:  ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
+	@DL_OBJS@ ${BUILD_DLTEST}
+	${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
+		@DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+		@TCL_LD_SEARCH_FLAGS@ -lXt -o xttest
+
+
 # Note, in the target below TCL_LIBRARY needs to be set or else
 # "make test" won't work in the case where the compilation directory
 # isn't the same as the source directory.
@@ -311,6 +347,8 @@ test: tcltest
 # The following target outputs the name of the top-level source directory
 # for Tcl (it is used by Tk's configure script, for example).  The
 # .NO_PARALLEL line is needed to avoid problems under Sun's "pmake".
+# Note: this target is now obsolete (use the autoconf variable
+# TCL_SRC_DIR from tclConfig.sh instead).
 
 .NO_PARALLEL: topDirName
 topDirName:
@@ -341,8 +379,8 @@ gendate:
 # command is needed for the same reason (must make sure that it exists).
 
 dltest/pkg5${SHLIB_SUFFIX}: dltest/Makefile
-	if test ! -f tclsh; then make tclsh; else true; fi
-	cd dltest; PATH=..:${PATH} TCL_LIBRARY=../../library make
+	if test ! -f tclsh; then $(MAKE) tclsh; else true; fi
+	cd dltest; PATH=..:${PATH} TCL_LIBRARY=../../library $(MAKE)
 
 dltest/Makefile: $(DLTEST_DIR)/configure $(DLTEST_DIR)/Makefile.in tclConfig.sh
 	if test ! -d dltest; then mkdir dltest; else true; fi
@@ -376,7 +414,7 @@ install-binaries: $(TCL_LIB_FILE) tclsh
 
 install-libraries:
 	@for i in $(INSTALL_ROOT)$(prefix)/lib $(INCLUDE_INSTALL_DIR) \
-		$(SCRIPT_INSTALL_DIR) ; \
+		$(SCRIPT_INSTALL_DIR); \
 	    do \
 	    if [ ! -d $$i ] ; then \
 		echo "Making directory $$i"; \
@@ -385,13 +423,30 @@ install-libraries:
 		else true; \
 		fi; \
 	    done;
+	@for i in http1.0 ; \
+	    do \
+	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
+		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
+		mkdir $(SCRIPT_INSTALL_DIR)/$$i; \
+		chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
+		else true; \
+		fi; \
+	    done;
 	@echo "Installing tcl.h"
 	@$(INSTALL_DATA) $(GENERIC_DIR)/tcl.h $(INCLUDE_INSTALL_DIR)/tcl.h
-	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c; \
+	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
 	    do \
 	    echo "Installing $$i"; \
 	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
 	    done;
+	@for i in http1.0 ; \
+	    do \
+	    for j in $(TOP_DIR)/library/$$i/*.tcl ; \
+		do \
+		echo "Installing $$j"; \
+		$(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
+		done; \
+	    done;
 
 install-man:
 	@for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \
@@ -437,11 +492,12 @@ Makefile: $(UNIX_DIR)/Makefile.in
 clean:
 	rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
 		errors tclsh tcltest lib.exp
-	if test -f dltest/Makefile; then cd dltest; make clean; fi
+	if test -f dltest/Makefile; then cd dltest; $(MAKE) clean; fi
 
 distclean: clean
-	rm -f Makefile config.status config.cache config.log tclConfig.sh
-	if test -f dltest/Makefile; then cd dltest; make distclean; fi
+	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
+		SUNWtcl.* prototype
+	if test -f dltest/Makefile; then cd dltest; $(MAKE) distclean; fi
 
 depend:
 	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
@@ -449,9 +505,10 @@ depend:
 bp: $(UNIX_DIR)/bp.c
 	$(CC) $(CC_SWITCHES) $(UNIX_DIR)/bp.c -o bp
 
-# Test binaries.  The rule for tclTestInit.o is complicated because
-# it is is compiled from tclAppInit.c.  Can't use the "-o" option
-# because this doesn't work on some strange compilers (e.g. UnixWare).
+# Test binaries.  The rules for tclTestInit.o and xtTestInit.o are
+# complicated because they are compiled from tclAppInit.c.  Can't use
+# the "-o" option because this doesn't work on some strange compilers
+# (e.g. UnixWare).
 
 tclTestInit.o: $(UNIX_DIR)/tclAppInit.c
 	@if test -f tclAppInit.o ; then \
@@ -465,6 +522,19 @@ tclTestInit.o: $(UNIX_DIR)/tclAppInit.c
 	    mv tclAppInit.sav tclAppInit.o; \
 	fi;
 
+xtTestInit.o: $(UNIX_DIR)/tclAppInit.c
+	@if test -f tclAppInit.o ; then \
+	    rm -f tclAppInit.sav; \
+	    mv tclAppInit.o tclAppInit.sav; \
+	fi;
+	$(CC) -c $(CC_SWITCHES) -DTCL_TEST -DTCL_XT_TEST \
+		$(UNIX_DIR)/tclAppInit.c
+	rm -f xtTestInit.o
+	mv tclAppInit.o xtTestInit.o
+	@if test -f tclAppInit.sav ; then \
+	    mv tclAppInit.sav tclAppInit.o; \
+	fi;
+
 # Object files used on all Unix systems:
 
 panic.o: $(GENERIC_DIR)/panic.c
@@ -482,6 +552,9 @@ tclAsync.o: $(GENERIC_DIR)/tclAsync.c
 tclBasic.o: $(GENERIC_DIR)/tclBasic.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBasic.c
 
+tclBinary.o: $(GENERIC_DIR)/tclBinary.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBinary.c
+
 tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c
 
@@ -500,17 +573,23 @@ tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c
 tclDate.o: $(GENERIC_DIR)/tclDate.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c
 
+tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompExpr.c
+
+tclCompile.o: $(GENERIC_DIR)/tclCompile.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompile.c
+
 tclEnv.o: $(GENERIC_DIR)/tclEnv.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c
 
 tclEvent.o: $(GENERIC_DIR)/tclEvent.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c
 
-tclExpr.o: $(GENERIC_DIR)/tclExpr.c
-	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExpr.c
+tclExecute.o: $(GENERIC_DIR)/tclExecute.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c
 
-tclFHandle.o: $(GENERIC_DIR)/tclFHandle.c
-	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFHandle.c
+tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFCmd.c
 
 tclFileName.o: $(GENERIC_DIR)/tclFileName.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFileName.c
@@ -524,6 +603,9 @@ tclHash.o: $(GENERIC_DIR)/tclHash.c
 tclHistory.o: $(GENERIC_DIR)/tclHistory.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHistory.c
 
+tclIndexObj.o: $(GENERIC_DIR)/tclIndexObj.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIndexObj.c
+
 tclInterp.o: $(GENERIC_DIR)/tclInterp.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclInterp.c
 
@@ -542,6 +624,12 @@ tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c
 tclLink.o: $(GENERIC_DIR)/tclLink.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c
 
+tclListObj.o: $(GENERIC_DIR)/tclListObj.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c
+
+tclObj.o: $(GENERIC_DIR)/tclObj.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c
+
 tclLoad.o: $(GENERIC_DIR)/tclLoad.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c
 
@@ -575,12 +663,18 @@ tclMain.o: $(GENERIC_DIR)/tclMain.c
 tclMtherr.o: $(UNIX_DIR)/tclMtherr.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclMtherr.c
 
+tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c
+
 tclNotify.o: $(GENERIC_DIR)/tclNotify.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
 
 tclParse.o: $(GENERIC_DIR)/tclParse.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
 
+tclPipe.o: $(GENERIC_DIR)/tclPipe.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPipe.c
+
 tclPkg.o: $(GENERIC_DIR)/tclPkg.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPkg.c
 
@@ -593,6 +687,9 @@ tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
 tclProc.o: $(GENERIC_DIR)/tclProc.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
 
+tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c
+
 tclUtil.o: $(GENERIC_DIR)/tclUtil.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
 
@@ -602,9 +699,21 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c
 tclTest.o: $(GENERIC_DIR)/tclTest.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
 
+tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c
+
+tclTimer.o: $(GENERIC_DIR)/tclTimer.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c
+
 tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixChan.c
 
+tclUnixEvent.o: $(UNIX_DIR)/tclUnixEvent.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixEvent.c
+
+tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c
+
 tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c
 
@@ -625,6 +734,7 @@ tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
 
 tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
 	$(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
+		-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
 		$(UNIX_DIR)/tclUnixInit.c
 
 # compat binaries
@@ -683,74 +793,181 @@ checkexports: $(TCL_LIB_FILE)
 # to put the distribution.
 #
 
-DISTDIR =	/proj/tcl/dist/tcl7.5p1
-configure: configure.in
-	autoconf
-dist: configure
+DISTNAME =	tcl@TCL_VERSION@@TCL_PATCH_LEVEL@
+ZIPNAME =	tcl@TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@@TCL_PATCH_LEVEL@.zip
+DISTDIR =	/proj/tcl/dist/$(DISTNAME)
+$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
+	autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
+dist: $(UNIX_DIR)/configure
 	rm -rf $(DISTDIR)
 	mkdir $(DISTDIR)
 	mkdir $(DISTDIR)/unix
 	cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix
-	rm -f $(DISTDIR)/unix/bp.c
-	cp Makefile.in $(DISTDIR)/unix
+	rm -f $(DISTDIR)/unix/bp.c $(DISTDIR)/unix/tclXtNotify.c
+	cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
 	chmod 664 $(DISTDIR)/unix/Makefile.in
-	cp configure configure.in tclConfig.sh.in install-sh porting.notes \
-		porting.old README ldAix $(DISTDIR)/unix
+	cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
+		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
+		$(UNIX_DIR)/porting.notes $(UNIX_DIR)/porting.old \
+		$(UNIX_DIR)/README $(UNIX_DIR)/ldAix \
+		$(DISTDIR)/unix
 	chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
 	chmod 775 $(DISTDIR)/unix/ldAix
 	chmod +x $(DISTDIR)/unix/install-sh
-	tclsh mkLinks.tcl ../doc/*.[13n] > $(DISTDIR)/unix/mkLinks
+	tclsh $(UNIX_DIR)/mkLinks.tcl \
+		$(UNIX_DIR)/../doc/*.[13n] > $(DISTDIR)/unix/mkLinks
 	chmod +x $(DISTDIR)/unix/mkLinks
 	mkdir $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
-	cp -p ../changes ../README ../license.terms $(DISTDIR)
+	cp -p $(TOP_DIR)/changes $(TOP_DIR)/README $(TOP_DIR)/license.terms \
+		$(DISTDIR)
 	mkdir $(DISTDIR)/library
-	cp -p ../license.terms ../library/*.tcl ../library/tclIndex \
-		 $(DISTDIR)/library
+	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
+		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
+	for i in http1.0; \
+	    do \
+		mkdir $(DISTDIR)/library/$$i ;\
+		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
+	    done;
 	mkdir $(DISTDIR)/doc
-	cp -p ../license.terms ../doc/*.[13n] ../doc/man.macros $(DISTDIR)/doc
+	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
+		$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
 	mkdir $(DISTDIR)/compat
-	cp -p ../license.terms ../compat/*.c ../compat/*.h ../compat/README \
+	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/compat/*.c \
+		$(TOP_DIR)/compat/*.h $(TOP_DIR)/compat/README \
 		$(DISTDIR)/compat
 	mkdir $(DISTDIR)/tests
-	cp -p ../license.terms $(DISTDIR)/tests
-	cp -p ../tests/*.test ../tests/README ../tests/all \
-		../tests/remote.tcl ../tests/defs $(DISTDIR)/tests
+	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
+	cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
+		$(TOP_DIR)/tests/all $(TOP_DIR)/tests/remote.tcl \
+		$(TOP_DIR)/tests/defs $(DISTDIR)/tests
+	cp -r -p $(TOP_DIR)/tests/policies $(DISTDIR)/tests/policies
+	find $(DISTDIR)/tests/policies -name SCCS -exec rm -rf {} \;
 	mkdir $(DISTDIR)/win
-	cp -p ../win/*.c ../win/*.h ../win/*.rc $(DISTDIR)/win
-	cp -p ../win/makefile.* $(DISTDIR)/win
-	cp -p ../win/README $(DISTDIR)/win
-	cp -p ../license.terms $(DISTDIR)/win
+	cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(TOP_DIR)/win/*.rc \
+		$(DISTDIR)/win
+	cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
+	cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
+	cp -p $(TOP_DIR)/win/pkgIndex.tcl $(DISTDIR)/win
+	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
 	mkdir $(DISTDIR)/mac
-	sccs edit -s ../mac/tclMacProjects.sit.hqx
+	sccs edit -s $(TOP_DIR)/mac/tclMacProjects.sit.hqx
 	cp -p tclMacProjects.sit.hqx $(DISTDIR)/mac
-	sccs unedit ../mac/tclMacProjects.sit.hqx
+	sccs unedit $(TOP_DIR)/mac/tclMacProjects.sit.hqx
 	rm -f tclMacProjects.sit.hqx
-	cp -p ../mac/*.c ../mac/*.h ../mac/*.r $(DISTDIR)/mac
-	cp -p ../mac/porting.notes ../mac/README $(DISTDIR)/mac
-	cp -p ../mac/*.doc ../mac/*.pch $(DISTDIR)/mac
-	cp -p ../license.terms $(DISTDIR)/mac
+	cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
+		$(DISTDIR)/mac
+	cp -p $(TOP_DIR)/mac/porting.notes $(TOP_DIR)/mac/README $(DISTDIR)/mac
+	cp -p $(TOP_DIR)/mac/*.exp $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
+	cp -p $(TOP_DIR)/mac/*.doc $(DISTDIR)/mac
+	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac
 	mkdir $(DISTDIR)/unix/dltest
-	cp -p dltest/*.c dltest/Makefile.in $(DISTDIR)/unix/dltest
-	cp -p dltest/configure.in dltest/configure $(DISTDIR)/unix/dltest
-	cp -p dltest/README $(DISTDIR)/unix/dltest
+	cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
+		$(DISTDIR)/unix/dltest
+	cp -p $(UNIX_DIR)/dltest/configure.in $(UNIX_DIR)/dltest/configure \
+		$(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
+
+alldist: dist
+	rm -f /proj/tcl/dist/$(DISTNAME).tar.Z \
+		/proj/tcl/dist/$(DISTNAME).tar.gz \
+		/proj/tcl/dist/$(ZIPNAME)
+	cd /proj/tcl/dist; tar cf $(DISTNAME).tar $(DISTNAME); \
+		gzip -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
+		compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME)
 
 #
 # Target to create a Macintosh version of the distribution.  This will
 # do a normal distribution and then massage the output to prepare it
 # for moving to the Mac platform.  This requires a few scripts and
-# programs found only in the Tcl greoup's tool workspace.
+# programs found only in the Tcl group's tool workspace.
 #
 
-TOOLDIR =	/home/rjohnson/Projects/tools
 macdist: dist
 	rm -f $(DISTDIR)/mac/tclMacProjects.sit.hqx
-	tclsh $(TOOLDIR)/generic/man2html.tcl $(DISTDIR)/tmp ../.. tcl$(VERSION)
+	tclsh $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tcl$(VERSION)
 	mv $(DISTDIR)/tmp/tcl$(VERSION) $(DISTDIR)/html
 	rm -rf $(DISTDIR)/doc
 	rm -rf $(DISTDIR)/tmp
-	tclsh $(TOOLDIR)/mac/cvtEOL.tcl $(DISTDIR)
+	tclsh $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
+
+#
+# Targets to build Solaris package of the distribution for the current
+# architecture.  To build stream packages for both sun4 and i86pc
+# architectures: 
+#
+#   On the sun4 machine, execute the following:
+#     make distclean; ./configure
+#     make DISTDIR=<distdir> package
+#
+#   Once the build is complete, execute the following on the i86pc
+#   machine:
+#     make DISTDIR=<distdir> package-quick
+#
+# <distdir> is the absolute path to a directory where the build should
+# take place.  These steps will generate the SUNWtcl.sun4 and
+# SUNWtcl.i86pc stream packages.  It is important that the packages be
+# built in this fashion in order to ensure that the architecture
+# independent files are exactly the same, including timestamps, in
+# both packages.
+#
+
+package: dist package-config package-common package-binaries package-generate
+package-quick: package-config package-binaries package-generate
+
+#
+# Configure for the current architecture in the dist directory.
+#
+package-config:
+	mkdir -p $(DISTDIR)/unix/`arch`
+	cd $(DISTDIR)/unix/`arch`; \
+        ../configure --prefix=/opt/SUNWtcl/$(VERSION) \
+		--exec_prefix=/opt/SUNWtcl/$(VERSION)/`arch` \
+		--enable-shared
+	mkdir -p $(DISTDIR)/SUNWtcl/$(VERSION)
+	mkdir -p $(DISTDIR)/SUNWtcl/$(VERSION)/`arch`
+
+#
+# Build and install the architecture independent files in the dist directory.
+#
+
+package-common:
+	cd $(DISTDIR)/unix/`arch`;\
+	$(MAKE); \
+	$(MAKE) prefix=$(DISTDIR)/SUNWtcl/$(VERSION) \
+		exec_prefix=$(DISTDIR)/SUNWtcl/$(VERSION)/`arch` \
+		install-libraries install-man
+	mkdir -p $(DISTDIR)/SUNWtcl/$(VERSION)/bin
+	sed -e "s/TCLVERSION/$(VERSION)/g" < $(UNIX_DIR)/tclsh.sh \
+		> $(DISTDIR)/SUNWtcl/$(VERSION)/bin/tclsh$(VERSION)
+	chmod 755 $(DISTDIR)/SUNWtcl/$(VERSION)/bin/tclsh$(VERSION)
+
+#
+# Build and install the architecture specific files in the dist directory.
+#
+
+package-binaries: 
+	cd $(DISTDIR)/unix/`arch`; \
+	$(MAKE); \
+	$(MAKE) install-binaries prefix=$(DISTDIR)/SUNWtcl/$(VERSION) \
+		exec_prefix=$(DISTDIR)/SUNWtcl/$(VERSION)/`arch`
+
+#
+# Generate a package from the installed files in the dist directory for the
+# current architecture.
+#
+
+package-generate:
+	pkgproto $(DISTDIR)/SUNWtcl/$(VERSION)/bin=bin \
+		 $(DISTDIR)/SUNWtcl/$(VERSION)/include=include \
+		 $(DISTDIR)/SUNWtcl/$(VERSION)/lib=lib \
+		 $(DISTDIR)/SUNWtcl/$(VERSION)/man=man \
+		 $(DISTDIR)/SUNWtcl/$(VERSION)/`arch`=`arch` \
+	| tclsh $(UNIX_DIR)/mkProto.tcl \
+		$(VERSION) $(UNIX_DIR) > prototype
+	pkgmk -o -d . -f prototype -a `arch`
+	pkgtrans -s . SUNWtcl.`arch` SUNWtcl
+	rm -rf SUNWtcl
 
 # DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/contrib/tcl/unix/README b/contrib/tcl/unix/README
index 9d950e8..96c79c1 100644
--- a/contrib/tcl/unix/README
+++ b/contrib/tcl/unix/README
@@ -12,7 +12,7 @@ SGI, as well as PCs running Linux, BSDI, and SCO UNIX.  To compile for
 a PC running Windows, see the README file in the directory ../win.  To
 compile for a Macintosh, see the README file in the directory ../mac.
 
-SCCS: @(#) README 1.13 96/07/31 16:28:38
+SCCS: @(#) README 1.15 96/12/19 14:02:23
 
 How To Compile And Install Tcl:
 -------------------------------
@@ -75,15 +75,15 @@ How To Compile And Install Tcl:
     Tcl then you'll first need to set your TCL_LIBRARY variable to
     hold the full path name of the "library" subdirectory.  Note that
     the installed versions of tclsh, libtcl.a, and libtcl.so have a
-    version number in their names, such as "tclsh7.5" or "libtcl7.5.so";
+    version number in their names, such as "tclsh8.0" or "libtcl8.0.so";
     to use the installed versions, either specify the version number
-    or create a symbolic link (e.g. from "tclsh" to "tclsh7.5").
+    or create a symbolic link (e.g. from "tclsh" to "tclsh8.0").
 
 If you have trouble compiling Tcl, read through the file" porting.notes".
 It contains information that people have provided about changes they had
 to make to compile Tcl in various environments.  Or, check out the
 following Web URL:
-    http://www.sunlabs.com/cgi-bin/tcl/info.4.1
+    http://www.sunlabs.com/cgi-bin/tcl/info.8.0
 This is an on-line database of porting information.  We make no guarantees
 that this information is accurate, complete, or up-to-date, but you may
 find it useful.  If you get Tcl running on a new configuration, we would
diff --git a/contrib/tcl/unix/configure.in b/contrib/tcl/unix/configure.in
index 408c4f9..61605dc 100755
--- a/contrib/tcl/unix/configure.in
+++ b/contrib/tcl/unix/configure.in
@@ -2,11 +2,12 @@ dnl	This file is an input file used by the GNU "autoconf" program to
 dnl	generate the file "configure", which is run during Tcl installation
 dnl	to configure the system for the local environment.
 AC_INIT(../generic/tcl.h)
-# SCCS: @(#) configure.in 1.107 96/07/30 08:38:37
+# SCCS: @(#) configure.in 1.135 97/06/10 17:28:19
 
-TCL_VERSION=7.5
-TCL_MAJOR_VERSION=7
-TCL_MINOR_VERSION=5
+TCL_VERSION=8.0
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL=b2
 VERSION=${TCL_VERSION}
 
 if test "${prefix}" = "NONE"; then
@@ -15,6 +16,7 @@ fi
 if test "${exec_prefix}" = "NONE"; then
     exec_prefix=$prefix
 fi
+TCL_SRC_DIR=`cd $srcdir/..; pwd`
 
 AC_PROG_RANLIB
 AC_ARG_ENABLE(gcc, [  --enable-gcc            allow use of gcc if available],
@@ -50,6 +52,21 @@ AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
 AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
 
 #--------------------------------------------------------------------
+#       On AIX systems, libbsd.a has to be linked in to support
+#       non-blocking file IO.  This library has to be linked in after
+#       the MATH_LIBS or it breaks the pow() function.  The way to
+#       insure proper sequencing, is to add it to the tail of MATH_LIBS.
+#        This library also supplies gettimeofday.
+#--------------------------------------------------------------------
+libbsd=no
+if test "`uname -s`" = "AIX" ; then
+    AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+    if test $libbsd = yes; then
+	MATH_LIBS="$MATH_LIBS -lbsd"
+    fi
+fi
+
+#--------------------------------------------------------------------
 #	Supply substitutes for missing POSIX header files.  Special
 #	notes:
 #	    - stdlib.h doesn't define strtol, strtoul, or
@@ -85,6 +102,7 @@ fi
 AC_MSG_RESULT($tcl_ok)
 AC_CHECK_HEADER(errno.h, , AC_DEFINE(NO_ERRNO_H))
 AC_CHECK_HEADER(float.h, , AC_DEFINE(NO_FLOAT_H))
+AC_CHECK_HEADER(values.h, , AC_DEFINE(NO_VALUES_H))
 AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
 AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
 AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
@@ -100,8 +118,67 @@ if test $tcl_ok = 0; then
     AC_DEFINE(NO_STRING_H)
 fi
 AC_CHECK_HEADER(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
+AC_CHECK_HEADER(dlfcn.h, , AC_DEFINE(NO_DLFCN_H))
 AC_HAVE_HEADERS(unistd.h)
 
+#---------------------------------------------------------------------------
+#	Determine which interface to use to talk to the serial port.
+#	Note that #include lines must begin in leftmost column for
+#	some compilers to recognize them as preprocessor directives.
+#---------------------------------------------------------------------------
+
+AC_MSG_CHECKING([termios vs. termio vs. sgtty])
+AC_TRY_RUN([
+#include <termios.h>
+
+main()
+{
+    struct termios t;
+    if (tcgetattr(0, &t) == 0) {
+	cfsetospeed(&t, 0);
+	t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
+	return 0;
+    }
+    return 1;
+}], tk_ok=termios, tk_ok=no, tk_ok=no)
+if test $tk_ok = termios; then
+    AC_DEFINE(USE_TERMIOS)
+else
+AC_TRY_RUN([
+#include <termio.h>
+
+main()
+{
+    struct termio t;
+    if (ioctl(0, TCGETA, &t) == 0) {
+	t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
+	return 0;
+    }
+    return 1;
+}], tk_ok=termio, tk_ok=no, tk_ok=no)
+if test $tk_ok = termio; then
+    AC_DEFINE(USE_TERMIO)
+else
+AC_TRY_RUN([
+#include <sgtty.h>
+
+main()
+{
+    struct sgttyb t;
+    if (ioctl(0, TIOCGETP, &t) == 0) {
+	t.sg_ospeed = 0;
+	t.sg_flags |= ODDP | EVENP | RAW;
+	return 0;
+    }
+    return 1;
+}], tk_ok=sgtty, tk_ok=none, tk_ok=none)
+if test $tk_ok = sgtty; then
+    AC_DEFINE(USE_SGTTY)
+fi
+fi
+fi
+AC_MSG_RESULT($tk_ok)
+
 #--------------------------------------------------------------------
 #	Include sys/select.h if it exists and if it supplies things
 #	that appear to be useful and aren't already in sys/types.h.
@@ -138,26 +215,52 @@ AC_MSG_CHECKING([tm_tzadj in struct tm])
 AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
         [AC_DEFINE(HAVE_TM_TZADJ)
          AC_MSG_RESULT(yes)],
-        AC_MSG_RESULT(no))
+         AC_MSG_RESULT(no))
 
 AC_MSG_CHECKING([tm_gmtoff in struct tm])
 AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
         [AC_DEFINE(HAVE_TM_GMTOFF)
          AC_MSG_RESULT(yes)],
-        AC_MSG_RESULT(no))
+         AC_MSG_RESULT(no))
 
 #
 # Its important to include time.h in this check, as some systems (like convex)
 # have timezone functions, etc.
 #
-AC_MSG_CHECKING([timezone variable])
+have_timezone=no
+AC_MSG_CHECKING([long timezone variable])
 AC_TRY_COMPILE([#include <time.h>],
         [extern long timezone;
          timezone += 1;
          exit (0);],
+        [have_timezone=yes
+	 AC_DEFINE(HAVE_TIMEZONE_VAR)
+         AC_MSG_RESULT(yes)],
+         AC_MSG_RESULT(no))
+
+#
+# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+#
+if test "$have_timezone" = no; then
+   AC_MSG_CHECKING([time_t timezone variable])
+   AC_TRY_COMPILE([#include <time.h>],
+        [extern time_t timezone;
+         timezone += 1;
+         exit (0);],
         [AC_DEFINE(HAVE_TIMEZONE_VAR)
          AC_MSG_RESULT(yes)],
-        AC_MSG_RESULT(no))
+         AC_MSG_RESULT(no))
+fi
+
+#
+# AIX does not have a timezone field in struct tm. When the AIX bsd
+# library is used, the timezone global and the gettimeofday methods are
+# to be avoided for timezone deduction instead, we deduce the timezone
+# by comparing the localtime result on a known GMT value.
+#
+if test $libbsd = yes; then
+    AC_DEFINE(USE_DELTA_FOR_TZ)
+fi
 
 #--------------------------------------------------------------------
 #	On some systems strstr is broken: it returns a pointer even
@@ -239,17 +342,17 @@ AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
 if test "$tcl_strtod" = 1; then
     AC_MSG_CHECKING([for Solaris strtod bug])
     AC_TRY_RUN([
-	extern double strtod();
-	int main()
-	{
-	    char *string = "NaN";
-	    char *term;
-	    strtod(string, &term);
-	    if ((term != string) && (term[-1] == 0)) {
-		exit(1);
-	    }
-	    exit(0);
-	}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+extern double strtod();
+int main()
+{
+    char *string = "NaN";
+    char *term;
+    strtod(string, &term);
+    if ((term != string) && (term[-1] == 0)) {
+	exit(1);
+    }
+    exit(0);
+}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
     if test $tcl_ok = 1; then
 	AC_MSG_RESULT(ok)
     else
@@ -326,30 +429,30 @@ AC_CHECK_FUNC(vfork, tcl_ok=1, tcl_ok=0)
 if test "$tcl_ok" = 1; then
     AC_MSG_CHECKING([vfork/signal bug]);
     AC_TRY_RUN([
-	#include <stdio.h>
-	#include <signal.h>
-	#include <sys/wait.h>
-	int gotSignal = 0;
-	sigProc(sig)
-	    int sig;
-	{
-	    gotSignal = 1;
-	}
-	main()
-	{
-	    int pid, sts;
-	    (void) signal(SIGCHLD, sigProc);
-	    pid = vfork();
-	    if (pid <  0) {
-		exit(1);
-	    } else if (pid == 0) {
-		(void) signal(SIGCHLD, SIG_DFL);
-		_exit(0);
-	    } else {
-		(void) wait(&sts);
-	    }
-	    exit((gotSignal) ? 0 : 1);
-	}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+#include <stdio.h>
+#include <signal.h>
+#include <sys/wait.h>
+int gotSignal = 0;
+sigProc(sig)
+    int sig;
+{
+    gotSignal = 1;
+}
+main()
+{
+    int pid, sts;
+    (void) signal(SIGCHLD, sigProc);
+    pid = vfork();
+    if (pid <  0) {
+	exit(1);
+    } else if (pid == 0) {
+	(void) signal(SIGCHLD, SIG_DFL);
+	_exit(0);
+    } else {
+	(void) wait(&sts);
+    }
+    exit((gotSignal) ? 0 : 1);
+}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
     if test "$tcl_ok" = 1; then
 	AC_MSG_RESULT(ok)
     else
@@ -406,6 +509,23 @@ AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
 AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
 
 #--------------------------------------------------------------------
+#	The following code checks to see whether it is possible to get
+#	signed chars on this platform.  This is needed in order to
+#	properly generate sign-extended ints from character values.
+#--------------------------------------------------------------------
+
+AC_C_CHAR_UNSIGNED
+AC_MSG_CHECKING([signed char declarations])
+AC_TRY_COMPILE(, [
+signed char *p;
+p = 0;
+], tcl_ok=yes, tcl_ok=no)
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = yes; then
+    AC_DEFINE(HAVE_SIGNED_CHAR)
+fi
+
+#--------------------------------------------------------------------
 #	Check for the existence of the -lsocket and -lnsl libraries.
 #	The order here is important, so that they end up in the right
 #	order in the command line generated by make.  Here are some
@@ -473,7 +593,7 @@ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
 #			extensions.  An empty string means we don't know how
 #			to use shared libraries on this platform.
 #	TCL_LIB_FILE -	Name of the file that contains the Tcl library, such
-#			as libtcl7.5.so or libtcl7.5.a.
+#			as libtcl7.8.so or libtcl7.8.a.
 #	TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
 #			in the shared library name, using the $VERSION variable
 #			to put the version in the right place.  This is used
@@ -517,22 +637,25 @@ fi
 
 AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
 
-# Step 3: disable dynamic loading if requested via a command-line switch.
-
-AC_ARG_ENABLE(load, [  --disable-load          disallow dynamic loading and "load" command],
-    [tcl_ok=$enableval], [tcl_ok=yes])
-if test "$tcl_ok" = "no"; then
-    system=unknown
-fi
-
-# Step 4: set configuration options based on system name and version.
+# Step 3: set configuration options based on system name and version.
 
 fullSrcDir=`cd $srcdir; pwd`
-AIX=no
 TCL_SHARED_LIB_SUFFIX=""
 TCL_UNSHARED_LIB_SUFFIX=""
 TCL_LIB_VERSIONS_OK=ok
 case $system in
+    AIX-4.[[2-9]])
+	SHLIB_CFLAGS=""
+	SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	AIX=yes
+	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	;;
     AIX-*)
 	SHLIB_CFLAGS=""
 	SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512"
@@ -542,14 +665,22 @@ case $system in
 	DL_LIBS="-lld"
 	LD_FLAGS=""
 	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
-	AC_DEFINE(NO_DLFCN_H)
-	AIX=yes
 	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
 	;;
-    BSD/OS-2.1*)
+    BSD/OS-2.1*|BSD/OS-3*)
 	SHLIB_CFLAGS=""
-	SHLIB_LD="ld -r"
-	SHLIB_LD_FLAGS=""
+	SHLIB_LD="shlicc -r"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    dgux*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
 	SHLIB_SUFFIX=".so"
 	DL_OBJS="tclLoadDl.o"
 	DL_LIBS="-ldl"
@@ -557,24 +688,28 @@ case $system in
 	LD_SEARCH_FLAGS=""
 	;;
     HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
-	SHLIB_CFLAGS="+z"
-	SHLIB_LD="ld -b"
-	SHLIB_LD_LIBS='${LIBS}'
-	SHLIB_SUFFIX=".sl"
-	DL_OBJS="tclLoadShl.o"
-	DL_LIBS="-ldld"
-	LD_FLAGS="-Wl,-E"
-	LD_SEARCH_FLAGS='-Wl,+b,${LIB_RUNTIME_DIR}:.'
+	AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
+	if test "$tcl_ok" = yes; then
+	    SHLIB_CFLAGS="+z"
+	    SHLIB_LD="ld -b"
+	    SHLIB_LD_LIBS=""
+	    SHLIB_SUFFIX=".sl"
+	    DL_OBJS="tclLoadShl.o"
+	    DL_LIBS="-ldld"
+	    LD_FLAGS="-Wl,-E"
+	    LD_SEARCH_FLAGS='-Wl,+b,${LIB_RUNTIME_DIR}:.'
+	fi
 	;;
     IRIX-4.*)
 	SHLIB_CFLAGS="-G 0"
-	SHLIB_SUFFIX="..o"
+	SHLIB_SUFFIX=".a"
 	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
-	SHLIB_LD_LIBS=""
+	SHLIB_LD_LIBS='${LIBS}'
 	DL_OBJS="tclLoadAout.o"
 	DL_LIBS=""
 	LD_FLAGS="-Wl,-D,08000000"
-	LD_SEARCH_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
 	;;
     IRIX-5.*|IRIX-6.*)
 	SHLIB_CFLAGS=""
@@ -635,32 +770,32 @@ case $system in
 	LD_FLAGS="-Wl,-Bexport"
 	LD_SEARCH_FLAGS=""
 	;;
-    NetBSD-*|FreeBSD-*)
+    NetBSD-*|FreeBSD-*|OpenBSD-*)
 	# Not available on all versions:  check for include file.
 	AC_CHECK_HEADER(dlfcn.h, [
 	    SHLIB_CFLAGS="-fpic"
-	    SHLIB_LD="ld -Bshareable"
+	    SHLIB_LD="ld -Bshareable -x"
 	    SHLIB_LD_LIBS=""
 	    SHLIB_SUFFIX=".so"
-	    DL_OBJS="tclLoadDl2.o"
+	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
 	    LD_FLAGS=""
 	    LD_SEARCH_FLAGS=""
+	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
 	], [
 	    SHLIB_CFLAGS=""
-	    SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
-	    SHLIB_LD_LIBS=""
-	    SHLIB_SUFFIX="..o"
+	    SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+	    SHLIB_LD_LIBS='${LIBS}'
+	    SHLIB_SUFFIX=".a"
 	    DL_OBJS="tclLoadAout.o"
 	    DL_LIBS=""
 	    LD_FLAGS=""
-	    LD_SEARCH_FLAGS=""
+	    LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
 	])
 
-	# FreeBSD doesn't handle version numbers with dots.  Also, have to
-	# append a dummy version number to .so file names.
+	# FreeBSD doesn't handle version numbers with dots.
 
-	TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
 	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
 	TCL_LIB_VERSIONS_OK=nodots
 	;;
@@ -674,7 +809,7 @@ case $system in
 	LD_FLAGS=""
 	LD_SEARCH_FLAGS=""
 	;;
-    OSF1-1.[012])
+    OSF1-1.0|OSF1-1.1|OSF1-1.2)
 	# OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
 	SHLIB_CFLAGS=""
 	# Hack: make package name same as library name
@@ -711,12 +846,12 @@ case $system in
     RISCos-*)
 	SHLIB_CFLAGS="-G 0"
 	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
-	SHLIB_LD_LIBS=""
-	SHLIB_SUFFIX="..o"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".a"
 	DL_OBJS="tclLoadAout.o"
 	DL_LIBS=""
 	LD_FLAGS="-Wl,-D,08000000"
-	LD_SEARCH_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
 	;;
     SCO_SV-3.2*)
         # Note, dlopen is available only on SCO 3.2.5 and greater.  However,
@@ -763,6 +898,10 @@ case $system in
     SunOS-5*)
 	SHLIB_CFLAGS="-KPIC"
 	SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+	# Note: need the LIBS below, otherwise Tk won't find Tcl's
+	# symbols when dynamically loaded into tclsh.
+
 	SHLIB_LD_LIBS='${LIBS}'
 	SHLIB_SUFFIX=".so"
 	DL_OBJS="tclLoadDl.o"
@@ -772,13 +911,13 @@ case $system in
 	;;
     ULTRIX-4.*)
 	SHLIB_CFLAGS="-G 0"
-	SHLIB_SUFFIX="..o"
+	SHLIB_SUFFIX=".a"
 	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
-	SHLIB_LD_LIBS=""
+	SHLIB_LD_LIBS='${LIBS}'
 	DL_OBJS="tclLoadAout.o"
 	DL_LIBS=""
 	LD_FLAGS="-Wl,-D,08000000"
-	LD_SEARCH_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
 	;;
     UNIX_SV*)
 	SHLIB_CFLAGS="-KPIC"
@@ -787,17 +926,30 @@ case $system in
 	SHLIB_SUFFIX=".so"
 	DL_OBJS="tclLoadDl.o"
 	DL_LIBS="-ldl"
-	LD_FLAGS="-Wl,-Bexport"
+	# Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
+	# that don't grok the -Bexport option.  Test that it does.
+	hold_ldflags=$LDFLAGS
+	AC_MSG_CHECKING(for ld accepts -Bexport flag)
+	LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+	AC_TRY_LINK(, [int i;], found=yes, found=no)
+	LDFLAGS=$hold_ldflags
+	AC_MSG_RESULT($found)
+	if test $found = yes; then
+	  LD_FLAGS="-Wl,-Bexport"
+	else
+	  LD_FLAGS=""
+	fi
 	LD_SEARCH_FLAGS=""
 	;;
 esac
 
-# If pseudo-static linking is in use (see K. B. Kenny, "Dynamic Loading for
-# Tcl -- What Became of It?".  Proc. 2nd Tcl/Tk Workshop, New Orleans, LA,
-# Computerized Processes Unlimited, 1994), then we need to determine which
-# of several header files defines the a.out file format (a.out.h, sys/exec.h,
-# or sys/exec_aout.h).  At present, we support only a file format that
-# is more or less version-7-compatible.  In particular,
+# Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
+# Loading for Tcl -- What Became of It?".  Proc. 2nd Tcl/Tk Workshop,
+# New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
+# to determine which of several header files defines the a.out file
+# format (a.out.h, sys/exec.h, or sys/exec_aout.h).  At present, we
+# support only a file format that is more or less version-7-compatible. 
+# In particular,
 #	- a.out files must begin with `struct exec'.
 #	- the N_TXTOFF on the `struct exec' must compute the seek address
 #	  of the text segment
@@ -868,6 +1020,14 @@ if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
     fi
 fi
 
+# Step 5: disable dynamic loading if requested via a command-line switch.
+
+AC_ARG_ENABLE(load, [  --disable-load          disallow dynamic loading and "load" command],
+    [tcl_ok=$enableval], [tcl_ok=yes])
+if test "$tcl_ok" = "no"; then
+    DL_OBJS=""
+fi
+
 if test "x$DL_OBJS" != "x" ; then
     BUILD_DLTEST="\$(DLTEST_TARGETS)"
 else
@@ -889,11 +1049,78 @@ fi
 
 if test "$DL_OBJS" != "tclLoadNone.o" ; then
     if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
-	SHLIB_CFLAGS="-fPIC"
+	case $system in
+	    AIX-*)
+		;;
+	    BSD/OS*)
+		;;
+	    IRIX*)
+		;;
+	    NetBSD-*|FreeBSD-*|OpenBSD-*)
+		;;
+	    RISCos-*)
+		;;
+	    ULTRIX-4.*)
+		;;
+	    *)
+		SHLIB_CFLAGS="-fPIC"
+		;;
+	esac
     fi
 fi
 
 #--------------------------------------------------------------------
+#	The statements below check for systems where POSIX-style
+#	non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. 
+#	On these systems (mostly older ones), use the old BSD-style
+#	FIONBIO approach instead.
+#--------------------------------------------------------------------
+
+AC_CHECK_HEADERS(sys/ioctl.h)
+AC_CHECK_HEADERS(sys/filio.h)
+AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
+if test -f /usr/lib/NextStep/software_version; then
+    system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+else
+    system=`uname -s`-`uname -r`
+    if test "$?" -ne 0 ; then
+	system=unknown
+    else
+	# Special check for weird MP-RAS system (uname returns weird
+	# results, and the version is kept in special file).
+    
+	if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+	    system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+	fi
+	if test "`uname -s`" = "AIX" ; then
+	    system=AIX-`uname -v`.`uname -r`
+	fi
+    fi
+fi
+case $system in
+    # There used to be code here to use FIONBIO under AIX.  However, it
+    # was reported that FIONBIO doesn't work under AIX 3.2.5.  Since
+    # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
+    # code (JO, 5/31/97).
+
+    OSF*)
+	AC_DEFINE(USE_FIONBIO)
+	AC_MSG_RESULT(FIONBIO)
+	;;
+    SunOS-4*)
+	AC_DEFINE(USE_FIONBIO)
+	AC_MSG_RESULT(FIONBIO)
+	;;
+    ULTRIX-4.*)
+	AC_DEFINE(USE_FIONBIO)
+	AC_MSG_RESULT(FIONBIO)
+	;;
+    *)
+	AC_MSG_RESULT(O_NONBLOCK)
+	;;
+esac
+
+#--------------------------------------------------------------------
 #	The statements below define a collection of symbols related to
 #	building libtcl as a shared library instead of a static library.
 #--------------------------------------------------------------------
@@ -908,17 +1135,28 @@ fi
 AC_ARG_ENABLE(shared,
     [  --enable-shared         build libtcl as a shared library],
     [tcl_ok=$enableval], [tcl_ok=no])
-if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" \
-	-a "${DL_OBJS}" != "tclLoadAout.o" ; then
+if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" ; then
     TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
     TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
     eval "TCL_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}"
-    MAKE_LIB="\${SHLIB_LD} -o ${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
-    RANLIB=":"
-else
-    if test "$AIX" = "no" ; then
-	SHLIB_LD_LIBS=""
+    if test "x$DL_OBJS" = "xtclLoadAout.o"; then
+	MAKE_LIB="ar cr ${TCL_LIB_FILE} \${OBJS}"
+    else
+	MAKE_LIB="\${SHLIB_LD} -o ${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+	RANLIB=":"
     fi
+else
+    case $system in
+        BSD/OS*)
+	    ;;
+
+	AIX-*)
+            ;;
+
+        *)
+	    SHLIB_LD_LIBS=""
+	    ;;
+    esac
     TCL_SHLIB_CFLAGS=""
     TCL_LD_SEARCH_FLAGS=""
     eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
@@ -938,6 +1176,19 @@ else
     TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
 fi
 
+#--------------------------------------------------------------------
+#	The statements below define the symbol TCL_PACKAGE_PATH, which
+#	gives a list of directories that may contain packages.  The list
+#	consists of one directory for machine-dependent binaries and
+#	another for platform-independent scripts.
+#--------------------------------------------------------------------
+
+if test "$prefix" != "$exec_prefix"; then
+    TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+else
+    TCL_PACKAGE_PATH="${prefix}/lib"
+fi
+
 AC_SUBST(BUILD_DLTEST)
 AC_SUBST(DL_LIBS)
 AC_SUBST(DL_OBJS)
@@ -955,8 +1206,11 @@ AC_SUBST(TCL_LIB_SPEC)
 AC_SUBST(TCL_LIB_VERSIONS_OK)
 AC_SUBST(TCL_MAJOR_VERSION)
 AC_SUBST(TCL_MINOR_VERSION)
+AC_SUBST(TCL_PACKAGE_PATH)
+AC_SUBST(TCL_PATCH_LEVEL)
 AC_SUBST(TCL_SHARED_LIB_SUFFIX)
 AC_SUBST(TCL_SHLIB_CFLAGS)
+AC_SUBST(TCL_SRC_DIR)
 AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
 AC_SUBST(TCL_VERSION)
 
diff --git a/contrib/tcl/unix/dltest/Makefile.in b/contrib/tcl/unix/dltest/Makefile.in
index 130ea18..2197b4b 100644
--- a/contrib/tcl/unix/dltest/Makefile.in
+++ b/contrib/tcl/unix/dltest/Makefile.in
@@ -1,7 +1,7 @@
 # This Makefile is used to create several test cases for Tcl's load
 # command.  It also illustrates how to take advantage of configuration
 # exported by Tcl to set up Makefiles for shared libraries.
-# SCCS: @(#) Makefile.in 1.11 96/04/15 09:50:19
+# SCCS: @(#) Makefile.in 1.12 97/02/22 14:13:54
 
 CC = @CC@
 LIBS =			@TCL_BUILD_LIB_SPEC@ @TCL_LIBS@ -lc
@@ -20,23 +20,23 @@ all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUF
 
 pkga${SHLIB_SUFFIX}: $(SRC_DIR)/pkga.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c
-	${SHLIB_LD} pkga.o -o pkga${SHLIB_SUFFIX} @SHLIB_LD_LIBS@
+	${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o @SHLIB_LD_LIBS@
 
 pkgb${SHLIB_SUFFIX}: $(SRC_DIR)/pkgb.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c
-	${SHLIB_LD} pkgb.o -o pkgb${SHLIB_SUFFIX} @SHLIB_LD_LIBS@
+	${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o @SHLIB_LD_LIBS@
 
 pkgc${SHLIB_SUFFIX}: $(SRC_DIR)/pkgc.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c
-	${SHLIB_LD} pkgc.o -o pkgc${SHLIB_SUFFIX} @SHLIB_LD_LIBS@
+	${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o @SHLIB_LD_LIBS@
 
 pkgd${SHLIB_SUFFIX}: $(SRC_DIR)/pkgd.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c
-	${SHLIB_LD} pkgd.o -o pkgd${SHLIB_SUFFIX} @SHLIB_LD_LIBS@
+	${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o @SHLIB_LD_LIBS@
 
 pkge${SHLIB_SUFFIX}: $(SRC_DIR)/pkge.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c
-	${SHLIB_LD} pkge.o -o pkge${SHLIB_SUFFIX} @SHLIB_LD_LIBS@
+	${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o @SHLIB_LD_LIBS@
 
 clean:
 	rm -f *.o *${SHLIB_SUFFIX} config.cache config.log config.status lib.exp
diff --git a/contrib/tcl/unix/dltest/configure b/contrib/tcl/unix/dltest/configure
index 219d63d..fa1663c 100755
--- a/contrib/tcl/unix/dltest/configure
+++ b/contrib/tcl/unix/dltest/configure
@@ -398,7 +398,7 @@ else
 fi
 
 
-# SCCS: %Z% %M% %I% %E% %U%
+# SCCS: @(#) configure.in 1.9 96/04/15 09:50:20
 
 # Recover information that Tcl computed with its configure script.
 
diff --git a/contrib/tcl/unix/ldAix b/contrib/tcl/unix/ldAix
index d7f0275..4da2b20 100755
--- a/contrib/tcl/unix/ldAix
+++ b/contrib/tcl/unix/ldAix
@@ -10,7 +10,7 @@
 # symbols exported by those files, and then invokes "ldCmd" to
 # perform the real link.
 #
-# SCCS: @(#) ldAix 1.7 96/03/27 09:45:03
+# SCCS: @(#) ldAix 1.8 97/02/21 14:50:27
 
 # Extract from the arguments the names of all of the object files.
 
@@ -43,7 +43,7 @@ done
 # 8. Eliminate everything after the first field in a line, so that we're
 #    left with just the symbol name.
 
-nmopts="-g"
+nmopts="-g -C"
 osver=`uname -v`
 if test $osver -eq 3; then
   nmopts="-e"
diff --git a/contrib/tcl/unix/mkLinks b/contrib/tcl/unix/mkLinks
index 93b577d..21d9f1c 100755
--- a/contrib/tcl/unix/mkLinks
+++ b/contrib/tcl/unix/mkLinks
@@ -27,10 +27,26 @@ rm xyzzyTe*
 if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
     exit
 fi
+if test -r http.n; then
+    rm -f Http.n
+    ln http.n Http.n
+fi
+if test -r safe.n; then
+    rm -f Safe.n
+    ln safe.n Safe.n
+fi
+if test -r StringObj.3; then
+    rm -f TclConcatObj.3
+    ln StringObj.3 TclConcatObj.3
+fi
 if test -r AddErrInfo.3; then
     rm -f Tcl_AddErrorInfo.3
     ln AddErrInfo.3 Tcl_AddErrorInfo.3
 fi
+if test -r AddErrInfo.3; then
+    rm -f Tcl_AddObjErrorInfo.3
+    ln AddErrInfo.3 Tcl_AddObjErrorInfo.3
+fi
 if test -r Alloc.3; then
     rm -f Tcl_Alloc.3
     ln Alloc.3 Tcl_Alloc.3
@@ -43,6 +59,10 @@ if test -r AppInit.3; then
     rm -f Tcl_AppInit.3
     ln AppInit.3 Tcl_AppInit.3
 fi
+if test -r ObjectType.3; then
+    rm -f Tcl_AppendAllObjTypes.3
+    ln ObjectType.3 Tcl_AppendAllObjTypes.3
+fi
 if test -r SetResult.3; then
     rm -f Tcl_AppendElement.3
     ln SetResult.3 Tcl_AppendElement.3
@@ -51,6 +71,14 @@ if test -r SetResult.3; then
     rm -f Tcl_AppendResult.3
     ln SetResult.3 Tcl_AppendResult.3
 fi
+if test -r StringObj.3; then
+    rm -f Tcl_AppendStringsToObj.3
+    ln StringObj.3 Tcl_AppendStringsToObj.3
+fi
+if test -r StringObj.3; then
+    rm -f Tcl_AppendToObj.3
+    ln StringObj.3 Tcl_AppendToObj.3
+fi
 if test -r Async.3; then
     rm -f Tcl_AsyncCreate.3
     ln Async.3 Tcl_AsyncCreate.3
@@ -75,6 +103,10 @@ if test -r Backslash.3; then
     rm -f Tcl_Backslash.3
     ln Backslash.3 Tcl_Backslash.3
 fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_BadChannelOption.3
+    ln CrtChannel.3 Tcl_BadChannelOption.3
+fi
 if test -r CallDel.3; then
     rm -f Tcl_CallWhenDeleted.3
     ln CallDel.3 Tcl_CallWhenDeleted.3
@@ -99,10 +131,18 @@ if test -r SplitList.3; then
     rm -f Tcl_ConvertElement.3
     ln SplitList.3 Tcl_ConvertElement.3
 fi
+if test -r ObjectType.3; then
+    rm -f Tcl_ConvertToType.3
+    ln ObjectType.3 Tcl_ConvertToType.3
+fi
 if test -r CrtSlave.3; then
     rm -f Tcl_CreateAlias.3
     ln CrtSlave.3 Tcl_CreateAlias.3
 fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_CreateAliasObj.3
+    ln CrtSlave.3 Tcl_CreateAliasObj.3
+fi
 if test -r CrtChannel.3; then
     rm -f Tcl_CreateChannel.3
     ln CrtChannel.3 Tcl_CreateChannel.3
@@ -143,9 +183,9 @@ if test -r CrtMathFnc.3; then
     rm -f Tcl_CreateMathFunc.3
     ln CrtMathFnc.3 Tcl_CreateMathFunc.3
 fi
-if test -r CrtModalTmt.3; then
-    rm -f Tcl_CreateModalTimeout.3
-    ln CrtModalTmt.3 Tcl_CreateModalTimeout.3
+if test -r CrtObjCmd.3; then
+    rm -f Tcl_CreateObjCommand.3
+    ln CrtObjCmd.3 Tcl_CreateObjCommand.3
 fi
 if test -r CrtSlave.3; then
     rm -f Tcl_CreateSlave.3
@@ -203,6 +243,10 @@ if test -r DString.3; then
     rm -f Tcl_DStringValue.3
     ln DString.3 Tcl_DStringValue.3
 fi
+if test -r Object.3; then
+    rm -f Tcl_DecrRefCount.3
+    ln Object.3 Tcl_DecrRefCount.3
+fi
 if test -r AssocData.3; then
     rm -f Tcl_DeleteAssocData.3
     ln AssocData.3 Tcl_DeleteAssocData.3
@@ -215,14 +259,22 @@ if test -r CrtCloseHdlr.3; then
     rm -f Tcl_DeleteCloseHandler.3
     ln CrtCloseHdlr.3 Tcl_DeleteCloseHandler.3
 fi
-if test -r CrtCommand.3; then
+if test -r CrtObjCmd.3; then
     rm -f Tcl_DeleteCommand.3
-    ln CrtCommand.3 Tcl_DeleteCommand.3
+    ln CrtObjCmd.3 Tcl_DeleteCommand.3
+fi
+if test -r CrtObjCmd.3; then
+    rm -f Tcl_DeleteCommandFromToken.3
+    ln CrtObjCmd.3 Tcl_DeleteCommandFromToken.3
 fi
 if test -r Notifier.3; then
     rm -f Tcl_DeleteEventSource.3
     ln Notifier.3 Tcl_DeleteEventSource.3
 fi
+if test -r Notifier.3; then
+    rm -f Tcl_DeleteEvents.3
+    ln Notifier.3 Tcl_DeleteEvents.3
+fi
 if test -r Exit.3; then
     rm -f Tcl_DeleteExitHandler.3
     ln Exit.3 Tcl_DeleteExitHandler.3
@@ -243,10 +295,6 @@ if test -r CrtInterp.3; then
     rm -f Tcl_DeleteInterp.3
     ln CrtInterp.3 Tcl_DeleteInterp.3
 fi
-if test -r CrtModalTmt.3; then
-    rm -f Tcl_DeleteModalTimeout.3
-    ln CrtModalTmt.3 Tcl_DeleteModalTimeout.3
-fi
 if test -r CrtTimerHdlr.3; then
     rm -f Tcl_DeleteTimerHandler.3
     ln CrtTimerHdlr.3 Tcl_DeleteTimerHandler.3
@@ -271,6 +319,10 @@ if test -r CallDel.3; then
     rm -f Tcl_DontCallWhenDeleted.3
     ln CallDel.3 Tcl_DontCallWhenDeleted.3
 fi
+if test -r Object.3; then
+    rm -f Tcl_DuplicateObj.3
+    ln Object.3 Tcl_DuplicateObj.3
+fi
 if test -r OpenFileChnl.3; then
     rm -f Tcl_Eof.3
     ln OpenFileChnl.3 Tcl_Eof.3
@@ -283,6 +335,10 @@ if test -r Eval.3; then
     rm -f Tcl_EvalFile.3
     ln Eval.3 Tcl_EvalFile.3
 fi
+if test -r EvalObj.3; then
+    rm -f Tcl_EvalObj.3
+    ln EvalObj.3 Tcl_EvalObj.3
+fi
 if test -r Preserve.3; then
     rm -f Tcl_EventuallyFree.3
     ln Preserve.3 Tcl_EventuallyFree.3
@@ -291,25 +347,45 @@ if test -r Exit.3; then
     rm -f Tcl_Exit.3
     ln Exit.3 Tcl_Exit.3
 fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_ExposeCommand.3
+    ln CrtSlave.3 Tcl_ExposeCommand.3
+fi
 if test -r ExprLong.3; then
     rm -f Tcl_ExprBoolean.3
     ln ExprLong.3 Tcl_ExprBoolean.3
 fi
+if test -r ExprLongObj.3; then
+    rm -f Tcl_ExprBooleanObj.3
+    ln ExprLongObj.3 Tcl_ExprBooleanObj.3
+fi
 if test -r ExprLong.3; then
     rm -f Tcl_ExprDouble.3
     ln ExprLong.3 Tcl_ExprDouble.3
 fi
+if test -r ExprLongObj.3; then
+    rm -f Tcl_ExprDoubleObj.3
+    ln ExprLongObj.3 Tcl_ExprDoubleObj.3
+fi
 if test -r ExprLong.3; then
     rm -f Tcl_ExprLong.3
     ln ExprLong.3 Tcl_ExprLong.3
 fi
+if test -r ExprLongObj.3; then
+    rm -f Tcl_ExprLongObj.3
+    ln ExprLongObj.3 Tcl_ExprLongObj.3
+fi
+if test -r ExprLongObj.3; then
+    rm -f Tcl_ExprObj.3
+    ln ExprLongObj.3 Tcl_ExprObj.3
+fi
 if test -r ExprLong.3; then
     rm -f Tcl_ExprString.3
     ln ExprLong.3 Tcl_ExprString.3
 fi
-if test -r Notifier.3; then
-    rm -f Tcl_FileReady.3
-    ln Notifier.3 Tcl_FileReady.3
+if test -r Exit.3; then
+    rm -f Tcl_Finalize.3
+    ln Exit.3 Tcl_Finalize.3
 fi
 if test -r FindExec.3; then
     rm -f Tcl_FindExecutable.3
@@ -331,17 +407,13 @@ if test -r Alloc.3; then
     rm -f Tcl_Free.3
     ln Alloc.3 Tcl_Free.3
 fi
-if test -r GetFile.3; then
-    rm -f Tcl_FreeFile.3
-    ln GetFile.3 Tcl_FreeFile.3
-fi
 if test -r CrtSlave.3; then
     rm -f Tcl_GetAlias.3
     ln CrtSlave.3 Tcl_GetAlias.3
 fi
 if test -r CrtSlave.3; then
-    rm -f Tcl_GetAliases.3
-    ln CrtSlave.3 Tcl_GetAliases.3
+    rm -f Tcl_GetAliasObj.3
+    ln CrtSlave.3 Tcl_GetAliasObj.3
 fi
 if test -r AssocData.3; then
     rm -f Tcl_GetAssocData.3
@@ -351,19 +423,31 @@ if test -r GetInt.3; then
     rm -f Tcl_GetBoolean.3
     ln GetInt.3 Tcl_GetBoolean.3
 fi
+if test -r BoolObj.3; then
+    rm -f Tcl_GetBooleanFromObj.3
+    ln BoolObj.3 Tcl_GetBooleanFromObj.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_GetChannel.3
+    ln OpenFileChnl.3 Tcl_GetChannel.3
+fi
 if test -r CrtChannel.3; then
     rm -f Tcl_GetChannelBufferSize.3
     ln CrtChannel.3 Tcl_GetChannelBufferSize.3
 fi
 if test -r CrtChannel.3; then
-    rm -f Tcl_GetChannelFile.3
-    ln CrtChannel.3 Tcl_GetChannelFile.3
+    rm -f Tcl_GetChannelHandle.3
+    ln CrtChannel.3 Tcl_GetChannelHandle.3
 fi
 if test -r CrtChannel.3; then
     rm -f Tcl_GetChannelInstanceData.3
     ln CrtChannel.3 Tcl_GetChannelInstanceData.3
 fi
 if test -r CrtChannel.3; then
+    rm -f Tcl_GetChannelMode.3
+    ln CrtChannel.3 Tcl_GetChannelMode.3
+fi
+if test -r CrtChannel.3; then
     rm -f Tcl_GetChannelName.3
     ln CrtChannel.3 Tcl_GetChannelName.3
 fi
@@ -375,26 +459,26 @@ if test -r CrtChannel.3; then
     rm -f Tcl_GetChannelType.3
     ln CrtChannel.3 Tcl_GetChannelType.3
 fi
-if test -r CrtCommand.3; then
+if test -r CrtObjCmd.3; then
     rm -f Tcl_GetCommandInfo.3
-    ln CrtCommand.3 Tcl_GetCommandInfo.3
+    ln CrtObjCmd.3 Tcl_GetCommandInfo.3
+fi
+if test -r CrtObjCmd.3; then
+    rm -f Tcl_GetCommandName.3
+    ln CrtObjCmd.3 Tcl_GetCommandName.3
 fi
 if test -r GetInt.3; then
     rm -f Tcl_GetDouble.3
     ln GetInt.3 Tcl_GetDouble.3
 fi
+if test -r DoubleObj.3; then
+    rm -f Tcl_GetDoubleFromObj.3
+    ln DoubleObj.3 Tcl_GetDoubleFromObj.3
+fi
 if test -r SetErrno.3; then
     rm -f Tcl_GetErrno.3
     ln SetErrno.3 Tcl_GetErrno.3
 fi
-if test -r GetFile.3; then
-    rm -f Tcl_GetFile.3
-    ln GetFile.3 Tcl_GetFile.3
-fi
-if test -r GetFile.3; then
-    rm -f Tcl_GetFileInfo.3
-    ln GetFile.3 Tcl_GetFileInfo.3
-fi
 if test -r Hash.3; then
     rm -f Tcl_GetHashKey.3
     ln Hash.3 Tcl_GetHashKey.3
@@ -403,14 +487,38 @@ if test -r Hash.3; then
     rm -f Tcl_GetHashValue.3
     ln Hash.3 Tcl_GetHashValue.3
 fi
+if test -r GetIndex.3; then
+    rm -f Tcl_GetIndexFromObj.3
+    ln GetIndex.3 Tcl_GetIndexFromObj.3
+fi
 if test -r GetInt.3; then
     rm -f Tcl_GetInt.3
     ln GetInt.3 Tcl_GetInt.3
 fi
+if test -r IntObj.3; then
+    rm -f Tcl_GetIntFromObj.3
+    ln IntObj.3 Tcl_GetIntFromObj.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_GetInterpPath.3
+    ln CrtSlave.3 Tcl_GetInterpPath.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_GetLongFromObj.3
+    ln IntObj.3 Tcl_GetLongFromObj.3
+fi
 if test -r CrtSlave.3; then
     rm -f Tcl_GetMaster.3
     ln CrtSlave.3 Tcl_GetMaster.3
 fi
+if test -r SetResult.3; then
+    rm -f Tcl_GetObjResult.3
+    ln SetResult.3 Tcl_GetObjResult.3
+fi
+if test -r ObjectType.3; then
+    rm -f Tcl_GetObjType.3
+    ln ObjectType.3 Tcl_GetObjType.3
+fi
 if test -r GetOpnFl.3; then
     rm -f Tcl_GetOpenFile.3
     ln GetOpnFl.3 Tcl_GetOpenFile.3
@@ -419,18 +527,26 @@ if test -r SplitPath.3; then
     rm -f Tcl_GetPathType.3
     ln SplitPath.3 Tcl_GetPathType.3
 fi
+if test -r Notifier.3; then
+    rm -f Tcl_GetServiceMode.3
+    ln Notifier.3 Tcl_GetServiceMode.3
+fi
 if test -r CrtSlave.3; then
     rm -f Tcl_GetSlave.3
     ln CrtSlave.3 Tcl_GetSlave.3
 fi
-if test -r CrtSlave.3; then
-    rm -f Tcl_GetSlaves.3
-    ln CrtSlave.3 Tcl_GetSlaves.3
-fi
 if test -r GetStdChan.3; then
     rm -f Tcl_GetStdChannel.3
     ln GetStdChan.3 Tcl_GetStdChannel.3
 fi
+if test -r StringObj.3; then
+    rm -f Tcl_GetStringFromObj.3
+    ln StringObj.3 Tcl_GetStringFromObj.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_GetStringResult.3
+    ln SetResult.3 Tcl_GetStringResult.3
+fi
 if test -r SetVar.3; then
     rm -f Tcl_GetVar.3
     ln SetVar.3 Tcl_GetVar.3
@@ -447,10 +563,22 @@ if test -r Eval.3; then
     rm -f Tcl_GlobalEval.3
     ln Eval.3 Tcl_GlobalEval.3
 fi
+if test -r EvalObj.3; then
+    rm -f Tcl_GlobalEvalObj.3
+    ln EvalObj.3 Tcl_GlobalEvalObj.3
+fi
 if test -r Hash.3; then
     rm -f Tcl_HashStats.3
     ln Hash.3 Tcl_HashStats.3
 fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_HideCommand.3
+    ln CrtSlave.3 Tcl_HideCommand.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_IncrRefCount.3
+    ln Object.3 Tcl_IncrRefCount.3
+fi
 if test -r Hash.3; then
     rm -f Tcl_InitHashTable.3
     ln Hash.3 Tcl_InitHashTable.3
@@ -459,6 +587,10 @@ if test -r OpenFileChnl.3; then
     rm -f Tcl_InputBlocked.3
     ln OpenFileChnl.3 Tcl_InputBlocked.3
 fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_InputBuffered.3
+    ln OpenFileChnl.3 Tcl_InputBuffered.3
+fi
 if test -r Interp.3; then
     rm -f Tcl_Interp.3
     ln Interp.3 Tcl_Interp.3
@@ -471,6 +603,10 @@ if test -r CrtSlave.3; then
     rm -f Tcl_IsSafe.3
     ln CrtSlave.3 Tcl_IsSafe.3
 fi
+if test -r Object.3; then
+    rm -f Tcl_IsShared.3
+    ln Object.3 Tcl_IsShared.3
+fi
 if test -r SplitPath.3; then
     rm -f Tcl_JoinPath.3
     ln SplitPath.3 Tcl_JoinPath.3
@@ -479,18 +615,90 @@ if test -r LinkVar.3; then
     rm -f Tcl_LinkVar.3
     ln LinkVar.3 Tcl_LinkVar.3
 fi
+if test -r ListObj.3; then
+    rm -f Tcl_ListObjAppendElement.3
+    ln ListObj.3 Tcl_ListObjAppendElement.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_ListObjAppendList.3
+    ln ListObj.3 Tcl_ListObjAppendList.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_ListObjGetElements.3
+    ln ListObj.3 Tcl_ListObjGetElements.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_ListObjIndex.3
+    ln ListObj.3 Tcl_ListObjIndex.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_ListObjLength.3
+    ln ListObj.3 Tcl_ListObjLength.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_ListObjReplace.3
+    ln ListObj.3 Tcl_ListObjReplace.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_MakeFileChannel.3
+    ln OpenFileChnl.3 Tcl_MakeFileChannel.3
+fi
 if test -r CrtSlave.3; then
     rm -f Tcl_MakeSafe.3
     ln CrtSlave.3 Tcl_MakeSafe.3
 fi
+if test -r OpenTcp.3; then
+    rm -f Tcl_MakeTcpClientChannel.3
+    ln OpenTcp.3 Tcl_MakeTcpClientChannel.3
+fi
 if test -r SplitList.3; then
     rm -f Tcl_Merge.3
     ln SplitList.3 Tcl_Merge.3
 fi
+if test -r BoolObj.3; then
+    rm -f Tcl_NewBooleanObj.3
+    ln BoolObj.3 Tcl_NewBooleanObj.3
+fi
+if test -r DoubleObj.3; then
+    rm -f Tcl_NewDoubleObj.3
+    ln DoubleObj.3 Tcl_NewDoubleObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_NewIntObj.3
+    ln IntObj.3 Tcl_NewIntObj.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_NewListObj.3
+    ln ListObj.3 Tcl_NewListObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_NewLongObj.3
+    ln IntObj.3 Tcl_NewLongObj.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_NewObj.3
+    ln Object.3 Tcl_NewObj.3
+fi
+if test -r StringObj.3; then
+    rm -f Tcl_NewStringObj.3
+    ln StringObj.3 Tcl_NewStringObj.3
+fi
 if test -r Hash.3; then
     rm -f Tcl_NextHashEntry.3
     ln Hash.3 Tcl_NextHashEntry.3
 fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_NotifyChannel.3
+    ln CrtChannel.3 Tcl_NotifyChannel.3
+fi
+if test -r ObjSetVar.3; then
+    rm -f Tcl_ObjGetVar2.3
+    ln ObjSetVar.3 Tcl_ObjGetVar2.3
+fi
+if test -r ObjSetVar.3; then
+    rm -f Tcl_ObjSetVar2.3
+    ln ObjSetVar.3 Tcl_ObjSetVar2.3
+fi
 if test -r OpenFileChnl.3; then
     rm -f Tcl_OpenCommandChannel.3
     ln OpenFileChnl.3 Tcl_OpenCommandChannel.3
@@ -563,6 +771,14 @@ if test -r RegExp.3; then
     rm -f Tcl_RegExpRange.3
     ln RegExp.3 Tcl_RegExpRange.3
 fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_RegisterChannel.3
+    ln OpenFileChnl.3 Tcl_RegisterChannel.3
+fi
+if test -r ObjectType.3; then
+    rm -f Tcl_RegisterObjType.3
+    ln ObjectType.3 Tcl_RegisterObjType.3
+fi
 if test -r Preserve.3; then
     rm -f Tcl_Release.3
     ln Preserve.3 Tcl_Release.3
@@ -579,10 +795,22 @@ if test -r OpenFileChnl.3; then
     rm -f Tcl_Seek.3
     ln OpenFileChnl.3 Tcl_Seek.3
 fi
+if test -r Notifier.3; then
+    rm -f Tcl_ServiceAll.3
+    ln Notifier.3 Tcl_ServiceAll.3
+fi
+if test -r Notifier.3; then
+    rm -f Tcl_ServiceEvent.3
+    ln Notifier.3 Tcl_ServiceEvent.3
+fi
 if test -r AssocData.3; then
     rm -f Tcl_SetAssocData.3
     ln AssocData.3 Tcl_SetAssocData.3
 fi
+if test -r BoolObj.3; then
+    rm -f Tcl_SetBooleanObj.3
+    ln BoolObj.3 Tcl_SetBooleanObj.3
+fi
 if test -r CrtChannel.3; then
     rm -f Tcl_SetChannelBufferSize.3
     ln CrtChannel.3 Tcl_SetChannelBufferSize.3
@@ -591,14 +819,18 @@ if test -r OpenFileChnl.3; then
     rm -f Tcl_SetChannelOption.3
     ln OpenFileChnl.3 Tcl_SetChannelOption.3
 fi
-if test -r CrtCommand.3; then
+if test -r CrtObjCmd.3; then
     rm -f Tcl_SetCommandInfo.3
-    ln CrtCommand.3 Tcl_SetCommandInfo.3
+    ln CrtObjCmd.3 Tcl_SetCommandInfo.3
 fi
 if test -r CrtChannel.3; then
     rm -f Tcl_SetDefaultTranslation.3
     ln CrtChannel.3 Tcl_SetDefaultTranslation.3
 fi
+if test -r DoubleObj.3; then
+    rm -f Tcl_SetDoubleObj.3
+    ln DoubleObj.3 Tcl_SetDoubleObj.3
+fi
 if test -r SetErrno.3; then
     rm -f Tcl_SetErrno.3
     ln SetErrno.3 Tcl_SetErrno.3
@@ -611,10 +843,30 @@ if test -r Hash.3; then
     rm -f Tcl_SetHashValue.3
     ln Hash.3 Tcl_SetHashValue.3
 fi
+if test -r IntObj.3; then
+    rm -f Tcl_SetIntObj.3
+    ln IntObj.3 Tcl_SetIntObj.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_SetListObj.3
+    ln ListObj.3 Tcl_SetListObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_SetLongObj.3
+    ln IntObj.3 Tcl_SetLongObj.3
+fi
 if test -r Notifier.3; then
     rm -f Tcl_SetMaxBlockTime.3
     ln Notifier.3 Tcl_SetMaxBlockTime.3
 fi
+if test -r StringObj.3; then
+    rm -f Tcl_SetObjLength.3
+    ln StringObj.3 Tcl_SetObjLength.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_SetObjResult.3
+    ln SetResult.3 Tcl_SetObjResult.3
+fi
 if test -r SetRecLmt.3; then
     rm -f Tcl_SetRecursionLimit.3
     ln SetRecLmt.3 Tcl_SetRecursionLimit.3
@@ -623,10 +875,22 @@ if test -r SetResult.3; then
     rm -f Tcl_SetResult.3
     ln SetResult.3 Tcl_SetResult.3
 fi
+if test -r Notifier.3; then
+    rm -f Tcl_SetServiceMode.3
+    ln Notifier.3 Tcl_SetServiceMode.3
+fi
 if test -r GetStdChan.3; then
     rm -f Tcl_SetStdChannel.3
     ln GetStdChan.3 Tcl_SetStdChannel.3
 fi
+if test -r StringObj.3; then
+    rm -f Tcl_SetStringObj.3
+    ln StringObj.3 Tcl_SetStringObj.3
+fi
+if test -r Notifier.3; then
+    rm -f Tcl_SetTimer.3
+    ln Notifier.3 Tcl_SetTimer.3
+fi
 if test -r SetVar.3; then
     rm -f Tcl_SetVar.3
     ln SetVar.3 Tcl_SetVar.3
@@ -675,6 +939,10 @@ if test -r LinkVar.3; then
     rm -f Tcl_UnlinkVar.3
     ln LinkVar.3 Tcl_UnlinkVar.3
 fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_UnregisterChannel.3
+    ln OpenFileChnl.3 Tcl_UnregisterChannel.3
+fi
 if test -r SetVar.3; then
     rm -f Tcl_UnsetVar.3
     ln SetVar.3 Tcl_UnsetVar.3
@@ -719,14 +987,14 @@ if test -r Notifier.3; then
     rm -f Tcl_WaitForEvent.3
     ln Notifier.3 Tcl_WaitForEvent.3
 fi
-if test -r Notifier.3; then
-    rm -f Tcl_WatchFile.3
-    ln Notifier.3 Tcl_WatchFile.3
-fi
 if test -r OpenFileChnl.3; then
     rm -f Tcl_Write.3
     ln OpenFileChnl.3 Tcl_Write.3
 fi
+if test -r WrongNumArgs.3; then
+    rm -f Tcl_WrongNumArgs.3
+    ln WrongNumArgs.3 Tcl_WrongNumArgs.3
+fi
 if test -r pkgMkIndex.n; then
     rm -f pkg_mkIndex.n
     ln pkgMkIndex.n pkg_mkIndex.n
diff --git a/contrib/tcl/unix/porting.notes b/contrib/tcl/unix/porting.notes
index e018b9d..39b35cb 100644
--- a/contrib/tcl/unix/porting.notes
+++ b/contrib/tcl/unix/porting.notes
@@ -26,7 +26,7 @@ and Tk to compile.  You can also add new entries to that database
 when you install Tcl and Tk on a new platform.  The Web database is
 likely to be more up-to-date than this file.
 
-sccsid = SCCS: @(#) porting.notes 1.17 96/05/18 16:49:24
+sccsid = SCCS: @(#) porting.notes 1.18 96/12/31 14:50:27
 
 --------------------------------------------
 Solaris, various versions
@@ -345,7 +345,7 @@ permission to edit /usr/include/stdarg.h in place, copy it to the tcl unix
 directory and change it there.
  
 Contact me directly if you have problems on SCO systems.
-Mark Diekhans <markd@sco.com>
+Mark Diekhans <markd@grizzly.com>
  
 --------------------------------------------
 SCO Unix 3.2.5 (ODT 5.0)
@@ -354,7 +354,7 @@ SCO Unix 3.2.5 (ODT 5.0)
 Expect failures from socket tests 2.9 and 3.1.
 
 Contact me directly if you have problems on SCO systems.
-Mark Diekhans <markd@sco.com>
+Mark Diekhans <markd@grizzly.com>
  
 --------------------------------------------
 Linux 1.2.13 (gcc 2.7.0, libc.so.5.0.9)
diff --git a/contrib/tcl/unix/tclAppInit.c b/contrib/tcl/unix/tclAppInit.c
index a9479b3..fafa31e 100644
--- a/contrib/tcl/unix/tclAppInit.c
+++ b/contrib/tcl/unix/tclAppInit.c
@@ -5,14 +5,18 @@
  *	procedure for Tcl applications (without Tk).
  *
  * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclAppInit.c 1.17 96/03/26 12:45:29
+ * SCCS: @(#) tclAppInit.c 1.20 97/03/24 14:29:43
  */
 
+#ifdef TCL_XT_TEST
+#include <X11/Intrinsic.h>
+#endif
+
 #include "tcl.h"
 
 /*
@@ -23,9 +27,14 @@
 extern int matherr();
 int *tclDummyMathPtr = (int *) matherr;
 
+
 #ifdef TCL_TEST
+EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
 #endif /* TCL_TEST */
+#ifdef TCL_XT_TEST
+EXTERN int		Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -49,6 +58,9 @@ main(argc, argv)
     int argc;			/* Number of command-line arguments. */
     char **argv;		/* Values of command-line arguments. */
 {
+#ifdef TCL_XT_TEST
+    XtToolkitInitialize();
+#endif
     Tcl_Main(argc, argv, Tcl_AppInit);
     return 0;			/* Needed only to prevent compiler warning. */
 }
@@ -81,11 +93,19 @@ Tcl_AppInit(interp)
     }
 
 #ifdef TCL_TEST
+#ifdef TCL_XT_TEST
+     if (Tclxttest_Init(interp) == TCL_ERROR) {
+	 return TCL_ERROR;
+     }
+#endif
     if (Tcltest_Init(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
             (Tcl_PackageInitProc *) NULL);
+    if (TclObjTest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
 #endif /* TCL_TEST */
 
     /*
diff --git a/contrib/tcl/unix/tclConfig.sh.in b/contrib/tcl/unix/tclConfig.sh.in
index e6d4b04..f75782e 100644
--- a/contrib/tcl/unix/tclConfig.sh.in
+++ b/contrib/tcl/unix/tclConfig.sh.in
@@ -9,12 +9,13 @@
 #
 # The information in this file is specific to a single platform.
 #
-# SCCS: @(#) tclConfig.sh.in 1.15 96/04/17 10:46:27
+# SCCS: @(#) tclConfig.sh.in 1.19 96/12/17 09:08:29
 
 # Tcl's version number.
 TCL_VERSION='@TCL_VERSION@'
 TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@'
 TCL_MINOR_VERSION='@TCL_MINOR_VERSION@'
+TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'
 
 # C compiler to use for compilation.
 TCL_CC='@CC@'
@@ -61,7 +62,7 @@ TCL_LD_FLAGS='@LD_FLAGS@'
 # Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
 # run-time dynamic linker where to look for shared libraries such as
 # libtcl.so.  Used when linking applications.  Only works if there
-# is a variable "LIB_INSTALL_DIR" defined in the Makefile.
+# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
 TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
 
 # Additional object files linked with Tcl to provide compatibility
@@ -97,3 +98,16 @@ TCL_SHARED_LIB_SUFFIX='@TCL_SHARED_LIB_SUFFIX@'
 # extension, and anything else needed).  May depend on the variable
 # VERSION.  On most UNIX systems this is ${VERSION}.a.
 TCL_UNSHARED_LIB_SUFFIX='@TCL_UNSHARED_LIB_SUFFIX@'
+
+# Location of the top-level source directory from which Tcl was built.
+# This is the directory that contains a README file as well as
+# subdirectories such as generic, unix, etc.  If Tcl was compiled in a
+# different place than the directory containing the source files, this
+# points to the location of the sources, not the location where Tcl was
+# compiled.
+TCL_SRC_DIR='@TCL_SRC_DIR@'
+
+# List of standard directories in which to look for packages during
+# "package require" commands.  Contains the "prefix" directory plus also
+# the "exec_prefix" directory, if it is different.
+TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@'
diff --git a/contrib/tcl/unix/tclLoadAix.c b/contrib/tcl/unix/tclLoadAix.c
index a940ca3..edf33d6b 100644
--- a/contrib/tcl/unix/tclLoadAix.c
+++ b/contrib/tcl/unix/tclLoadAix.c
@@ -17,7 +17,7 @@
  *	for any results of using the software, alterations are clearly marked
  *	as such, and this notice is not modified.
  *
- * SCCS: @(#) tclLoadAix.c 1.10 96/03/26 13:18:21
+ * SCCS: @(#) tclLoadAix.c 1.11 96/10/07 10:41:24
  *
  * Note:  this file has been altered from the original in a few
  * ways in order to work properly with Tcl.
@@ -92,7 +92,7 @@ static int readExports(ModulePtr);
 static void terminate(void);
 static void *findMain(void);
 
-void *dlopen(const char *path, int mode)
+VOID *dlopen(const char *path, int mode)
 {
 	register ModulePtr mp;
 	static void *mainModule;
@@ -113,13 +113,13 @@ void *dlopen(const char *path, int mode)
 	for (mp = modList; mp; mp = mp->next)
 		if (strcmp(mp->name, path) == 0) {
 			mp->refCnt++;
-			return mp;
+			return (VOID *) mp;
 		}
 	if ((mp = (ModulePtr)calloc(1, sizeof(*mp))) == NULL) {
 		errvalid++;
 		strcpy(errbuf, "calloc: ");
 		strcat(errbuf, strerror(errno));
-		return NULL;
+		return (VOID *) NULL;
 	}
 	mp->name = malloc((unsigned) (strlen(path) + 1));
 	strcpy(mp->name, path);
@@ -150,7 +150,7 @@ void *dlopen(const char *path, int mode)
 			}
 		} else
 			strcat(errbuf, strerror(errno));
-		return NULL;
+		return (VOID *) NULL;
 	}
 	mp->refCnt = 1;
 	mp->next = modList;
@@ -160,7 +160,7 @@ void *dlopen(const char *path, int mode)
 		errvalid++;
 		strcpy(errbuf, "loadbind: ");
 		strcat(errbuf, strerror(errno));
-		return NULL;
+		return (VOID *) NULL;
 	}
 	/*
 	 * If the user wants global binding, loadbind against all other
@@ -174,12 +174,12 @@ void *dlopen(const char *path, int mode)
 				errvalid++;
 				strcpy(errbuf, "loadbind: ");
 				strcat(errbuf, strerror(errno));
-				return NULL;
+				return (VOID *) NULL;
 			}
 	}
 	if (readExports(mp) == -1) {
 		dlclose(mp);
-		return NULL;
+		return (VOID *) NULL;
 	}
 	/*
 	 * If there is a dl_info structure, call the init function.
@@ -200,7 +200,7 @@ void *dlopen(const char *path, int mode)
 		}
 	} else
 		errvalid = 0;
-	return mp;
+	return (VOID *) mp;
 }
 
 /*
@@ -242,7 +242,7 @@ static void caterr(char *s)
 	}
 }
 
-void *dlsym(void *handle, const char *symbol)
+VOID *dlsym(void *handle, const char *symbol)
 {
 	register ModulePtr mp = (ModulePtr)handle;
 	register ExportPtr ep;
diff --git a/contrib/tcl/unix/tclLoadAout.c b/contrib/tcl/unix/tclLoadAout.c
index 29859a0..ade7161 100644
--- a/contrib/tcl/unix/tclLoadAout.c
+++ b/contrib/tcl/unix/tclLoadAout.c
@@ -14,7 +14,7 @@
  * and Design Engineering (MADE) Initiative through ARPA contract
  * F33615-94-C-4400.
  *
- * SCCS: @(#) tclLoadAout.c 1.7 96/02/15 11:58:53
+ * SCCS: @(#) tclLoadAout.c 1.9 97/02/22 14:05:01
  */
 
 #include "tclInt.h"
@@ -183,6 +183,8 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
 #if defined(__mips) || defined(mips)
   Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
 #endif
+  Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
+  TclGuessPackageName(fileName, &linkCommandBuf);
   Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
   Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
   Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
@@ -429,5 +431,40 @@ TclGuessPackageName(fileName, bufPtr)
     Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
 				 * package name to this if possible. */
 {
-    return 0;
+    char *p, *q, *r;
+
+    if (q = strrchr(fileName,'/')) {
+	q++;
+    } else {
+	q = fileName;
+    }
+    if (!strncmp(q,"lib",3)) {
+	q+=3;
+    }
+    p = q;
+    while ((*p) && (*p != '.') && ((*p<'0') || (*p>'9'))) {
+	p++;
+    }
+    if ((p>q+2) && !strncmp(p-2,"_G0.",4)) {
+	p-=2;
+    }
+    if (p<q) {
+	return 0;
+    }
+
+    Tcl_DStringAppend(bufPtr,q, p-q);
+
+    r = Tcl_DStringValue(bufPtr);
+    r += strlen(r) - (p-q);
+
+    if (islower(UCHAR(*r))) {
+	*r = (char) toupper(UCHAR(*r));
+    }
+    while (*(++r)) {
+	if (isupper(UCHAR(*r))) {
+	    *r = (char) tolower(UCHAR(*r));
+	}
+    }
+
+    return 1;
 }
diff --git a/contrib/tcl/unix/tclLoadDl.c b/contrib/tcl/unix/tclLoadDl.c
index 4f07363..2619bfd 100644
--- a/contrib/tcl/unix/tclLoadDl.c
+++ b/contrib/tcl/unix/tclLoadDl.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclLoadDl.c 1.7 96/03/14 09:03:33
+ * SCCS: @(#) tclLoadDl.c 1.8 96/12/03 16:57:00
  */
 
 #include "tclInt.h"
@@ -68,6 +68,7 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
 				 * to sym1 and sym2. */
 {
     VOID *handle;
+    Tcl_DString newName;
 
     handle = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
     if (handle == NULL) {
@@ -75,8 +76,31 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
 		"\": ", dlerror(), (char *) NULL);
 	return TCL_ERROR;
     }
-    *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, sym1);
-    *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, sym2);
+
+    /* 
+     * Some platforms still add an underscore to the beginning of symbol
+     * names.  If we can't find a name without an underscore, try again
+     * with the underscore.
+     */
+
+    *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym1);
+    if (*proc1Ptr == NULL) {
+	Tcl_DStringInit(&newName);
+	Tcl_DStringAppend(&newName, "_", 1);
+	Tcl_DStringAppend(&newName, sym1, -1);
+	*proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
+		Tcl_DStringValue(&newName));
+	Tcl_DStringFree(&newName);
+    }
+    *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym2);
+    if (*proc2Ptr == NULL) {
+	Tcl_DStringInit(&newName);
+	Tcl_DStringAppend(&newName, "_", 1);
+	Tcl_DStringAppend(&newName, sym2, -1);
+	*proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
+		Tcl_DStringValue(&newName));
+	Tcl_DStringFree(&newName);
+    }
     return TCL_OK;
 }
 
diff --git a/contrib/tcl/unix/tclLoadDld.c b/contrib/tcl/unix/tclLoadDld.c
index f2f949e..0ef994a 100644
--- a/contrib/tcl/unix/tclLoadDld.c
+++ b/contrib/tcl/unix/tclLoadDld.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclLoadDld.c 1.4 96/02/15 11:58:46
+ * SCCS: @(#) tclLoadDld.c 1.5 97/05/14 13:24:22
  */
 
 #include "tclInt.h"
@@ -69,7 +69,9 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
 
     if (firstTime) {
 	if (tclExecutableName == NULL) {
-	    interp->result = "don't know name of application binary file, so can't initialize dynamic loader";
+	    Tcl_SetResult(interp,
+		    "don't know name of application binary file, so can't initialize dynamic loader",
+		    TCL_STATIC);
 	    return TCL_ERROR;
 	}
 	returnCode = dld_init(tclExecutableName);
diff --git a/contrib/tcl/unix/tclMtherr.c b/contrib/tcl/unix/tclMtherr.c
index 2f56e00..24b815d 100644
--- a/contrib/tcl/unix/tclMtherr.c
+++ b/contrib/tcl/unix/tclMtherr.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclMtherr.c 1.11 96/02/15 11:58:36
+ * SCCS: @(#) tclMtherr.c 1.12 96/06/22 16:36:57
  */
 
 #include "tclInt.h"
@@ -23,7 +23,7 @@
 #endif
 
 #ifdef NO_ERRNO_H
-extern int errno;			/* Use errno from tclExpr.c. */
+extern int errno;			/* Use errno from tclExecute.c. */
 #define EDOM 33
 #define ERANGE 34
 #endif
diff --git a/contrib/tcl/unix/tclUnixChan.c b/contrib/tcl/unix/tclUnixChan.c
index a48806f..2e53440 100644
--- a/contrib/tcl/unix/tclUnixChan.c
+++ b/contrib/tcl/unix/tclUnixChan.c
@@ -4,43 +4,98 @@
  *	Common channel driver for Unix channels based on files, command
  *	pipes and TCP sockets.
  *
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixChan.c 1.172 96/06/11 10:14:51
+ * SCCS: @(#) tclUnixChan.c 1.203 97/06/20 13:03:18
  */
 
 #include	"tclInt.h"	/* Internal definitions for Tcl. */
 #include	"tclPort.h"	/* Portability features for Tcl. */
 
 /*
- * This structure describes per-instance state of a pipe based channel.
+ * sys/ioctl.h has already been included by tclPort.h.  Including termios.h
+ * or termio.h causes a bunch of warning messages because some duplicate
+ * (but not contradictory) #defines exist in termios.h and/or termio.h
  */
+#undef NL0
+#undef NL1
+#undef CR0
+#undef CR1
+#undef CR2
+#undef CR3
+#undef TAB0
+#undef TAB1
+#undef TAB2
+#undef XTABS
+#undef BS0
+#undef BS1
+#undef FF0
+#undef FF1
+#undef ECHO
+#undef NOFLSH
+#undef TOSTOP
+#undef FLUSHO
+#undef PENDIN
+
+#ifdef USE_TERMIOS
+#   include <termios.h>
+#else	/* !USE_TERMIOS */
+#ifdef USE_TERMIO
+#   include <termio.h>
+#else	/* !USE_TERMIO */
+#ifdef USE_SGTTY
+#   include <sgtty.h>
+#endif	/* USE_SGTTY */
+#endif	/* !USE_TERMIO */
+#endif	/* !USE_TERMIOS */
 
-typedef struct PipeState {
-    Tcl_File readFile;	/* Output from pipe. */
-    Tcl_File writeFile;	/* Input to pipe. */
-    Tcl_File errorFile;	/* Error output from pipe. */
-    int numPids;	/* How many processes are attached to this pipe? */
-    int *pidPtr;	/* The process IDs themselves. Allocated by
-                         * the creator of the pipe. */
-    int isNonBlocking;	/* Nonzero when the pipe is in nonblocking mode.
-                         * Used to decide whether to wait for the children
-                         * at close time. */
-} PipeState;
+/*
+ * The following structure is used to set or get the serial port
+ * attributes in a platform-independant manner.
+ */
+ 
+typedef struct TtyAttrs {
+    int baud;
+    int parity;
+    int data;
+    int stop;
+} TtyAttrs;
+
+/*
+ * This structure describes per-instance state of a file based channel.
+ */
+
+typedef struct FileState {
+    Tcl_Channel channel;	/* Channel associated with this file. */
+    int fd;			/* File handle. */
+    int validMask;		/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which operations are valid on the file. */
+    struct FileState *nextPtr;	/* Pointer to next file in list of all
+				 * file channels. */
+} FileState;
+
+/*
+ * List of all file channels currently open.
+ */
+
+static FileState *firstFilePtr = NULL;
 
 /*
  * This structure describes per-instance state of a tcp based channel.
  */
 
 typedef struct TcpState {
-    int flags;				/* ORed combination of the
-                                         * bitfields defined below. */
-    Tcl_File sock;			/* The socket itself. */
-    Tcl_TcpAcceptProc *acceptProc;	/* Proc to call on accept. */
-    ClientData acceptProcData;		/* The data for the accept proc. */
+    Tcl_Channel channel;	/* Channel associated with this file. */
+    int fd;			/* The socket itself. */
+    int flags;			/* ORed combination of the bitfields
+				 * defined below. */
+    Tcl_TcpAcceptProc *acceptProc;
+				/* Proc to call on accept. */
+    ClientData acceptProcData;	/* The data for the accept proc. */
 } TcpState;
 
 /*
@@ -58,7 +113,14 @@ typedef struct TcpState {
  * the connection request will fail.
  */
 
-#define TCL_LISTEN_LIMIT	100
+#ifndef	SOMAXCONN
+#define SOMAXCONN	100
+#endif
+
+#if	(SOMAXCONN < 100)
+#undef	SOMAXCONN
+#define	SOMAXCONN	100
+#endif
 
 /*
  * The following defines how much buffer space the kernel should maintain
@@ -78,42 +140,52 @@ static int		CreateSocketAddress _ANSI_ARGS_(
 			    (struct sockaddr_in *sockaddrPtr,
 			    char *host, int port));
 static int		FileBlockModeProc _ANSI_ARGS_((
-    			    ClientData instanceData, Tcl_File inFile,
-                            Tcl_File outFile, int mode));
+    			    ClientData instanceData, int mode));
 static int		FileCloseProc _ANSI_ARGS_((ClientData instanceData,
-			    Tcl_Interp *interp, Tcl_File inFile,
-                            Tcl_File outFile));
-static int		FilePipeInputProc _ANSI_ARGS_((ClientData instanceData,
-		            Tcl_File inFile, char *buf, int toRead,
-		            int *errorCode));
-static int		FilePipeOutputProc _ANSI_ARGS_((
-    			    ClientData instanceData, Tcl_File outFile,
-                            char *buf, int toWrite, int *errorCode));
+			    Tcl_Interp *interp));
+static int		FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static int		FileInputProc _ANSI_ARGS_((ClientData instanceData,
+		            char *buf, int toRead, int *errorCode));
+static int		FileOutputProc _ANSI_ARGS_((
+			    ClientData instanceData, char *buf, int toWrite,
+                            int *errorCode));
 static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
-			    Tcl_File inFile, Tcl_File outFile, long offset,
-			    int mode, int *errorCode));
-static int		PipeBlockModeProc _ANSI_ARGS_((
-    			    ClientData instanceData, Tcl_File inFile,
-                            Tcl_File outFile, int mode));
-static int		PipeCloseProc _ANSI_ARGS_((ClientData instanceData,
-			    Tcl_Interp *interp, Tcl_File inFile,
-                            Tcl_File outFile));
+			    long offset, int mode, int *errorCode));
+static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
 static void		TcpAccept _ANSI_ARGS_((ClientData data, int mask));
 static int		TcpBlockModeProc _ANSI_ARGS_((ClientData data,
-		            Tcl_File inFile, Tcl_File outFile, int mode));
+        		    int mode));
 static int		TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
-			    Tcl_Interp *interp, Tcl_File inFile,
-                            Tcl_File outFile));
+			    Tcl_Interp *interp));
+static int		TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
 static int		TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
-                            char *optionName, Tcl_DString *dsPtr));
+			    Tcl_Interp *interp, char *optionName,
+			    Tcl_DString *dsPtr));
 static int		TcpInputProc _ANSI_ARGS_((ClientData instanceData,
-		            Tcl_File infile, char *buf, int toRead,
-        		    int *errorCode));
+		            char *buf, int toRead,  int *errorCode));
 static int		TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
-		            Tcl_File outFile, char *buf, int toWrite,
-		            int *errorCode));
+		            char *buf, int toWrite, int *errorCode));
+static void		TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+static int		TtyParseMode _ANSI_ARGS_((Tcl_Interp *interp,
+			    CONST char *mode, int *speedPtr, int *parityPtr,
+			    int *dataPtr, int *stopPtr));
+static void		TtyGetAttributes _ANSI_ARGS_((int fd,
+			    TtyAttrs *ttyPtr));
+static int		TtyGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp, char *optionName,
+			    Tcl_DString *dsPtr));
+static void		TtyInit _ANSI_ARGS_((int fd));
+static void		TtySetAttributes _ANSI_ARGS_((int fd,
+			    TtyAttrs *ttyPtr));
+static int		TtySetOptionProc _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp, char *optionName, 
+			    char *value));
 static int		WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
-		            Tcl_File fileToWaitFor, int *errorCodePtr));
+		            int *errorCodePtr));
 
 /*
  * This structure describes the channel type structure for file based IO:
@@ -123,27 +195,31 @@ static Tcl_ChannelType fileChannelType = {
     "file",				/* Type name. */
     FileBlockModeProc,			/* Set blocking/nonblocking mode.*/
     FileCloseProc,			/* Close proc. */
-    FilePipeInputProc,			/* Input proc. */
-    FilePipeOutputProc,			/* Output proc. */
+    FileInputProc,			/* Input proc. */
+    FileOutputProc,			/* Output proc. */
     FileSeekProc,			/* Seek proc. */
     NULL,				/* Set option proc. */
     NULL,				/* Get option proc. */
+    FileWatchProc,			/* Initialize notifier. */
+    FileGetHandleProc,			/* Get OS handles out of channel. */
 };
 
 /*
- * This structure describes the channel type structure for command pipe
- * based IO:
+ * This structure describes the channel type structure for serial IO.
+ * Note that this type is a subclass of the "file" type.
  */
 
-static Tcl_ChannelType pipeChannelType = {
-    "pipe",				/* Type name. */
-    PipeBlockModeProc,			/* Set blocking/nonblocking mode.*/
-    PipeCloseProc,			/* Close proc. */
-    FilePipeInputProc,			/* Input proc. */
-    FilePipeOutputProc,			/* Output proc. */
+static Tcl_ChannelType ttyChannelType = {
+    "tty",				/* Type name. */
+    FileBlockModeProc,			/* Set blocking/nonblocking mode.*/
+    FileCloseProc,			/* Close proc. */
+    FileInputProc,			/* Input proc. */
+    FileOutputProc,			/* Output proc. */
     NULL,				/* Seek proc. */
-    NULL,				/* Set option proc. */
-    NULL,				/* Get option proc. */
+    TtySetOptionProc,			/* Set option proc. */
+    TtyGetOptionProc,			/* Get option proc. */
+    FileWatchProc,			/* Initialize notifier. */
+    FileGetHandleProc,			/* Get OS handles out of channel. */
 };
 
 /*
@@ -160,7 +236,10 @@ static Tcl_ChannelType tcpChannelType = {
     NULL,				/* Seek proc. */
     NULL,				/* Set option proc. */
     TcpGetOptionProc,			/* Get option proc. */
+    TcpWatchProc,			/* Initialize notifier. */
+    TcpGetHandleProc,			/* Get OS handles out of channel. */
 };
+
 
 /*
  *----------------------------------------------------------------------
@@ -168,8 +247,7 @@ static Tcl_ChannelType tcpChannelType = {
  * FileBlockModeProc --
  *
  *	Helper procedure to set blocking and nonblocking modes on a
- *	channel. Invoked either by generic IO level code or by other
- *	channel drivers after doing channel-type-specific inialization.
+ *	file based channel. Invoked by generic IO level code.
  *
  * Results:
  *	0 if successful, errno when failed.
@@ -182,115 +260,46 @@ static Tcl_ChannelType tcpChannelType = {
 
 	/* ARGSUSED */
 static int
-FileBlockModeProc(instanceData, inFile, outFile, mode)
-    ClientData instanceData;		/* Unused. */
-    Tcl_File inFile, outFile;		/* Input, output files for channel. */
+FileBlockModeProc(instanceData, mode)
+    ClientData instanceData;		/* File state. */
     int mode;				/* The mode to set. Can be one of
                                          * TCL_MODE_BLOCKING or
                                          * TCL_MODE_NONBLOCKING. */
 {
+    FileState *fsPtr = (FileState *) instanceData;
     int curStatus;
-    int fd;
 
-    if (inFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(inFile, NULL);
-        curStatus = fcntl(fd, F_GETFL);
-        if (mode == TCL_MODE_BLOCKING) {
-            curStatus &= (~(O_NONBLOCK));
-        } else {
-            curStatus |= O_NONBLOCK;
-        }
-        if (fcntl(fd, F_SETFL, curStatus) < 0) {
-            return errno;
-        }
-        curStatus = fcntl(fd, F_GETFL);
+#ifndef USE_FIONBIO
+    curStatus = fcntl(fsPtr->fd, F_GETFL);
+    if (mode == TCL_MODE_BLOCKING) {
+	curStatus &= (~(O_NONBLOCK));
+    } else {
+	curStatus |= O_NONBLOCK;
     }
-    if (outFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(outFile, NULL);
-        curStatus = fcntl(fd, F_GETFL);
-        if (mode == TCL_MODE_BLOCKING) {
-            curStatus &= (~(O_NONBLOCK));
-        } else {
-            curStatus |= O_NONBLOCK;
-        }
-        if (fcntl(fd, F_SETFL, curStatus) < 0) {
-            return errno;
-        }
+    if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) {
+	return errno;
     }
-
-    return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeBlockModeProc --
- *
- *	Helper procedure to set blocking and nonblocking modes on a
- *	channel. Invoked either by generic IO level code or by other
- *	channel drivers after doing channel-type-specific inialization.
- *
- * Results:
- *	0 if successful, errno when failed.
- *
- * Side effects:
- *	Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-PipeBlockModeProc(instanceData, inFile, outFile, mode)
-    ClientData instanceData;		/* The pipe state. */
-    Tcl_File inFile, outFile;		/* Input, output files for channel. */
-    int mode;				/* The mode to set. Can be one of
-                                         * TCL_MODE_BLOCKING or
-                                         * TCL_MODE_NONBLOCKING. */
-{
-    PipeState *pipePtr;
-    int curStatus;
-    int fd;
-
-    if (inFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(inFile, NULL);
-        curStatus = fcntl(fd, F_GETFL);
-        if (mode == TCL_MODE_BLOCKING) {
-            curStatus &= (~(O_NONBLOCK));
-        } else {
-            curStatus |= O_NONBLOCK;
-        }
-        if (fcntl(fd, F_SETFL, curStatus) < 0) {
-            return errno;
-        }
-        curStatus = fcntl(fd, F_GETFL);
+    curStatus = fcntl(fsPtr->fd, F_GETFL);
+#else
+    if (mode == TCL_MODE_BLOCKING) {
+	curStatus = 0;
+    } else {
+	curStatus = 1;
     }
-    if (outFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(outFile, NULL);
-        curStatus = fcntl(fd, F_GETFL);
-        if (mode == TCL_MODE_BLOCKING) {
-            curStatus &= (~(O_NONBLOCK));
-        } else {
-            curStatus |= O_NONBLOCK;
-        }
-        if (fcntl(fd, F_SETFL, curStatus) < 0) {
-            return errno;
-        }
+    if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
+	return errno;
     }
-
-    pipePtr = (PipeState *) instanceData;
-    pipePtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING) ? 1 : 0;
-    
+#endif
     return 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * FilePipeInputProc --
+ * FileInputProc --
  *
  *	This procedure is invoked from the generic IO level to read
- *	input from a file or command pipeline channel.
+ *	input from a file based channel.
  *
  * Results:
  *	The number of bytes read is returned or -1 on error. An output
@@ -302,22 +311,19 @@ PipeBlockModeProc(instanceData, inFile, outFile, mode)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 static int
-FilePipeInputProc(instanceData, inFile, buf, toRead, errorCodePtr)
-    ClientData instanceData;		/* Unused. */
-    Tcl_File inFile;			/* Input device for channel. */
+FileInputProc(instanceData, buf, toRead, errorCodePtr)
+    ClientData instanceData;		/* File state. */
     char *buf;				/* Where to store data read. */
     int toRead;				/* How much space is available
                                          * in the buffer? */
     int *errorCodePtr;			/* Where to store error code. */
 {
-    int fd;				/* The OS handle for reading. */
+    FileState *fsPtr = (FileState *) instanceData;
     int bytesRead;			/* How many bytes were actually
                                          * read from the input device? */
 
     *errorCodePtr = 0;
-    fd = (int) Tcl_GetFileInfo(inFile, NULL);
     
     /*
      * Assume there is always enough input available. This will block
@@ -326,7 +332,7 @@ FilePipeInputProc(instanceData, inFile, buf, toRead, errorCodePtr)
      * nonblocking, the read will never block.
      */
 
-    bytesRead = read(fd, buf, (size_t) toRead);
+    bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
     if (bytesRead > -1) {
         return bytesRead;
     }
@@ -337,10 +343,10 @@ FilePipeInputProc(instanceData, inFile, buf, toRead, errorCodePtr)
 /*
  *----------------------------------------------------------------------
  *
- * FilePipeOutputProc--
+ * FileOutputProc--
  *
  *	This procedure is invoked from the generic IO level to write
- *	output to a file or command pipeline channel.
+ *	output to a file channel.
  *
  * Results:
  *	The number of bytes written is returned or -1 on error. An
@@ -353,21 +359,18 @@ FilePipeInputProc(instanceData, inFile, buf, toRead, errorCodePtr)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 static int
-FilePipeOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
-    ClientData instanceData;		/* Unused. */
-    Tcl_File outFile;			/* Output device for channel. */
+FileOutputProc(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;		/* File state. */
     char *buf;				/* The data buffer. */
     int toWrite;			/* How many bytes to write? */
     int *errorCodePtr;			/* Where to store error code. */
 {
+    FileState *fsPtr = (FileState *) instanceData;
     int written;
-    int fd;
 
     *errorCodePtr = 0;
-    fd = (int) Tcl_GetFileInfo(outFile, NULL);
-    written = write(fd, buf, (size_t) toWrite);
+    written = write(fsPtr->fd, buf, (size_t) toWrite);
     if (written > -1) {
         return written;
     }
@@ -392,52 +395,30 @@ FilePipeOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 static int
-FileCloseProc(instanceData, interp, inFile, outFile)
-    ClientData instanceData;	/* Unused. */
+FileCloseProc(instanceData, interp)
+    ClientData instanceData;	/* File state. */
     Tcl_Interp *interp;		/* For error reporting - unused. */
-    Tcl_File inFile;		/* Input file to close. */
-    Tcl_File outFile;		/* Output file to close. */
 {
-    int fd, errorCode = 0;
-
-    if (inFile != NULL) {
-
-	/*
-	 * Check for read/write file so we only close it once.
-	 */
+    FileState *fsPtr = (FileState *) instanceData;
+    FileState **nextPtrPtr;
+    int errorCode = 0;
 
-	if (inFile == outFile) {
-	    outFile = NULL;
+    Tcl_DeleteFileHandler(fsPtr->fd);
+    if (!TclInExit()
+	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
+	if (close(fsPtr->fd) < 0) {
+	    errorCode = errno;
 	}
-        fd = (int) Tcl_GetFileInfo(inFile, NULL);
-        Tcl_FreeFile(inFile);
-
-        if (tclInInterpreterDeletion) {
-            if ((fd != 0) && (fd != 1) && (fd != 2)) {
-                if (close(fd) < 0) {
-                    errorCode = errno;
-                }
-            }
-        } else if (close(fd) < 0) {
-            errorCode = errno;
-        }
     }
-
-    if (outFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(outFile, NULL);
-        Tcl_FreeFile(outFile);        
-        if (tclInInterpreterDeletion) {
-            if ((fd != 0) && (fd != 1) && (fd != 2)) {
-                if ((close(fd) < 0) && (errorCode == 0)) {
-                    errorCode = errno;
-                }
-            }
-        } else if ((close(fd) < 0) && (errorCode == 0)) {
-            errorCode = errno;
-        }
+    for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	if ((*nextPtrPtr) == fsPtr) {
+	    (*nextPtrPtr) = fsPtr->nextPtr;
+	    break;
+	}
     }
+    ckfree((char *) fsPtr);
     return errorCode;
 }
 
@@ -461,12 +442,9 @@ FileCloseProc(instanceData, interp, inFile, outFile)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 static int
-FileSeekProc(instanceData, inFile, outFile, offset, mode, errorCodePtr)
-    ClientData instanceData;			/* Unused. */
-    Tcl_File inFile, outFile;			/* Input and output
-                                                 * files for channel. */
+FileSeekProc(instanceData, offset, mode, errorCodePtr)
+    ClientData instanceData;			/* File state. */
     long offset;				/* Offset to seek to. */
     int mode;					/* Relative to where
                                                  * should we seek? Can be
@@ -474,158 +452,699 @@ FileSeekProc(instanceData, inFile, outFile, offset, mode, errorCodePtr)
                                                  * SEEK_SET or SEEK_END. */
     int *errorCodePtr;				/* To store error code. */
 {
+    FileState *fsPtr = (FileState *) instanceData;
     int newLoc;
-    int fd;
 
-    *errorCodePtr = 0;
-    if (inFile != (Tcl_File) NULL) {
-        fd = (int) Tcl_GetFileInfo(inFile, NULL);
-    } else if (outFile != (Tcl_File) NULL) {
-        fd = (int) Tcl_GetFileInfo(outFile, NULL);
-    } else {
-        *errorCodePtr = EFAULT;
-        return -1;
-    }
-    newLoc = lseek(fd, offset, mode);
-    if (newLoc > -1) {
-        return newLoc;
-    }
-    *errorCodePtr = errno;
-    return -1;
+    newLoc = lseek(fsPtr->fd, offset, mode);
+
+    *errorCodePtr = (newLoc == -1) ? errno : 0;
+    return newLoc;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetAndDetachPids --
+ * FileWatchProc --
  *
- *	This procedure is invoked in the generic implementation of a
- *	background "exec" (An exec when invoked with a terminating "&")
- *	to store a list of the PIDs for processes in a command pipeline
- *	in interp->result and to detach the processes.
+ *	Initialize the notifier to watch the fd from this channel.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Modifies interp->result. Detaches processes.
+ *	Sets up the notifier so that a future event on the channel will
+ *	be seen by Tcl.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclGetAndDetachPids(interp, chan)
-    Tcl_Interp *interp;
-    Tcl_Channel chan;
+static void
+FileWatchProc(instanceData, mask)
+    ClientData instanceData;		/* The file state. */
+    int mask;				/* Events of interest; an OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
 {
-    PipeState *pipePtr;
-    Tcl_ChannelType *chanTypePtr;
-    int i;
-    char buf[20];
+    FileState *fsPtr = (FileState *) instanceData;
 
     /*
-     * Punt if the channel is not a command channel.
+     * Make sure we only register for events that are valid on this file.
+     * Note that we are passing Tcl_NotifyChannel directly to
+     * Tcl_CreateFileHandler with the channel pointer as the client data.
      */
 
-    chanTypePtr = Tcl_GetChannelType(chan);
-    if (chanTypePtr != &pipeChannelType) {
-        return;
+    mask &= fsPtr->validMask;
+    if (mask) {
+	Tcl_CreateFileHandler(fsPtr->fd, mask,
+		(Tcl_FileProc *) Tcl_NotifyChannel,
+		(ClientData) fsPtr->channel);
+    } else {
+	Tcl_DeleteFileHandler(fsPtr->fd);
     }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileGetHandleProc --
+ *
+ *	Called from Tcl_GetChannelFile to retrieve OS handles from
+ *	a file based channel.
+ *
+ * Results:
+ *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ *	there is no handle for the specified direction. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileGetHandleProc(instanceData, direction, handlePtr)
+    ClientData instanceData;	/* The file state. */
+    int direction;		/* TCL_READABLE or TCL_WRITABLE */
+    ClientData *handlePtr;	/* Where to store the handle.  */
+{
+    FileState *fsPtr = (FileState *) instanceData;
 
-    pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
-    for (i = 0; i < pipePtr->numPids; i++) {
-        sprintf(buf, "%d", pipePtr->pidPtr[i]);
-        Tcl_AppendElement(interp, buf);
-        Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+    if (direction & fsPtr->validMask) {
+	*handlePtr = (ClientData) fsPtr->fd;
+	return TCL_OK;
+    } else {
+	return TCL_ERROR;
     }
-    if (pipePtr->numPids > 0) {
-        ckfree((char *) pipePtr->pidPtr);
-        pipePtr->numPids = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtySetOptionProc --
+ *
+ *	Sets an option on a channel.
+ *
+ * Results:
+ *	A standard Tcl result. Also sets interp->result on error if
+ *	interp is not NULL.
+ *
+ * Side effects:
+ *	May modify an option on a device.
+ *      Sets Error message if needed (by calling Tcl_BadChannelOption).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int		
+TtySetOptionProc(instanceData, interp, optionName, value)
+    ClientData instanceData;	/* File state. */
+    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
+    char *optionName;		/* Which option to set? */
+    char *value;		/* New value for option. */
+{
+    FileState *fsPtr = (FileState *) instanceData;
+    unsigned int len;
+    TtyAttrs tty;
+
+    len = strlen(optionName);
+    if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
+	if (TtyParseMode(interp, value, &tty.baud, &tty.parity, &tty.data,
+		&tty.stop) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	/*
+	 * system calls results should be checked there. -- dl
+	 */
+
+	TtySetAttributes(fsPtr->fd, &tty);
+	return TCL_OK;
+    } else {
+	return Tcl_BadChannelOption(interp, optionName, "mode");
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * PipeCloseProc --
+ * TtyGetOptionProc --
  *
- *	This procedure is invoked by the generic IO level to perform
- *	channel-type-specific cleanup when a command pipeline channel
- *	is closed.
+ *	Gets a mode associated with an IO channel. If the optionName arg
+ *	is non NULL, retrieves the value of that option. If the optionName
+ *	arg is NULL, retrieves a list of alternating option names and
+ *	values for the given channel.
  *
  * Results:
- *	0 on success, errno otherwise.
+ *	A standard Tcl result. Also sets the supplied DString to the
+ *	string value of the option(s) returned.
  *
  * Side effects:
- *	Closes the command pipeline channel.
+ *	The string returned by this function is in static storage and
+ *	may be reused at any time subsequent to the call.
+ *      Sets Error message if needed (by calling Tcl_BadChannelOption).
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static int
-PipeCloseProc(instanceData, interp, inFile, outFile)
-    ClientData instanceData;	/* The pipe to close. */
-    Tcl_Interp *interp;		/* For error reporting. */
-    Tcl_File inFile, outFile;	/* Unused. */
+static int		
+TtyGetOptionProc(instanceData, interp, optionName, dsPtr)
+    ClientData instanceData;	/* File state. */
+    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
+    char *optionName;		/* Option to get. */
+    Tcl_DString *dsPtr;		/* Where to store value(s). */
 {
-    PipeState *pipePtr;
-    Tcl_Channel errChan;
-    int fd, errorCode, result;
-
-    errorCode = 0;
-    result = 0;
-    pipePtr = (PipeState *) instanceData;
-    if (pipePtr->readFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(pipePtr->readFile, NULL);
-        Tcl_FreeFile(pipePtr->readFile);
-	if (close(fd) < 0) {
-	    errorCode = errno;
+    FileState *fsPtr = (FileState *) instanceData;
+    unsigned int len;
+    char buf[32];
+    TtyAttrs tty;
+
+    if (optionName == NULL) {
+	Tcl_DStringAppendElement(dsPtr, "-mode");
+	len = 0;
+    } else {
+	len = strlen(optionName);
+    }
+    if ((len == 0) || 
+	    ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+	TtyGetAttributes(fsPtr->fd, &tty);
+	sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
+	Tcl_DStringAppendElement(dsPtr, buf);
+	return TCL_OK;
+    } else {
+	return Tcl_BadChannelOption(interp, optionName, "mode");
+    }
+}
+
+#undef DIRECT_BAUD
+#ifdef B4800
+#   if (B4800 == 4800)
+#	define DIRECT_BAUD
+#   endif
+#endif
+
+#ifdef DIRECT_BAUD
+#   define TtyGetSpeed(baud)   ((unsigned) (baud))
+#   define TtyGetBaud(speed)   ((int) (speed))
+#else
+
+static struct {int baud; unsigned long speed;} speeds[] = {
+#ifdef B0
+    {0, B0},
+#endif
+#ifdef B50
+    {50, B50},
+#endif
+#ifdef B75
+    {75, B75},
+#endif
+#ifdef B110
+    {110, B110},
+#endif
+#ifdef B134
+    {134, B134},
+#endif
+#ifdef B150
+    {150, B150},
+#endif
+#ifdef B200
+    {200, B200},
+#endif
+#ifdef B300
+    {300, B300},
+#endif
+#ifdef B600
+    {600, B600},
+#endif
+#ifdef B1200
+    {1200, B1200},
+#endif
+#ifdef B1800
+    {1800, B1800},
+#endif
+#ifdef B2400
+    {2400, B2400},
+#endif
+#ifdef B4800
+    {4800, B4800},
+#endif
+#ifdef B9600
+    {9600, B9600},
+#endif
+#ifdef B14400
+    {14400, B14400},
+#endif
+#ifdef B19200
+    {19200, B19200},
+#endif
+#ifdef EXTA
+    {19200, EXTA},
+#endif
+#ifdef B28800
+    {28800, B28800},
+#endif
+#ifdef B38400
+    {38400, B38400},
+#endif
+#ifdef EXTB
+    {38400, EXTB},
+#endif
+#ifdef B57600
+    {57600, B57600},
+#endif
+#ifdef _B57600
+    {57600, _B57600},
+#endif
+#ifdef B76800
+    {76800, B76800},
+#endif
+#ifdef B115200
+    {115200, B115200},
+#endif
+#ifdef _B115200
+    {115200, _B115200},
+#endif
+#ifdef B153600
+    {153600, B153600},
+#endif
+#ifdef B230400
+    {230400, B230400},
+#endif
+#ifdef B307200
+    {307200, B307200},
+#endif
+#ifdef B460800
+    {460800, B460800},
+#endif
+    {-1, 0}
+};
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetSpeed --
+ *
+ *	Given a baud rate, get the mask value that should be stored in
+ *	the termios, termio, or sgttyb structure in order to select that
+ *	baud rate.
+ *
+ * Results:
+ *	As above.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static unsigned long
+TtyGetSpeed(baud)
+    int baud;			/* The baud rate to look up. */
+{
+    int bestIdx, bestDiff, i, diff;
+    
+    bestIdx = 0;
+    bestDiff = 1000000;
+    
+    /*
+     * If the baud rate does not correspond to one of the known mask values,
+     * choose the mask value whose baud rate is closest to the specified
+     * baud rate.
+     */
+
+    for (i = 0; speeds[i].baud >= 0; i++) {
+	diff = speeds[i].baud - baud;
+	if (diff < 0) {
+	    diff = -diff;
+	}
+	if (diff < bestDiff) {
+	    bestIdx = i;
+	    bestDiff = diff;
 	}
     }
-    if (pipePtr->writeFile != NULL) {
-        fd = (int) Tcl_GetFileInfo(pipePtr->writeFile, NULL);
-        Tcl_FreeFile(pipePtr->writeFile);
-	if ((close(fd) < 0) && (errorCode == 0)) {
-	    errorCode = errno;
+    return speeds[bestIdx].speed;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetBaud --
+ *
+ *	Given a speed mask value from a termios, termio, or sgttyb
+ *	structure, get the baus rate that corresponds to that mask value.
+ *
+ * Results:
+ *	As above.  If the mask value was not recognized, 0 is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TtyGetBaud(speed)
+    unsigned long speed;	/* Speed mask value to look up. */
+{
+    int i;
+    
+    for (i = 0; speeds[i].baud >= 0; i++) {
+	if (speeds[i].speed == speed) {
+	    return speeds[i].baud;
 	}
     }
+    return 0;
+}
+
+#endif	/* !DIRECT_BAUD */
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyInit --
+ *
+ *	Given file descriptor that refers to a serial port, 
+ *	initialize the serial port to a set of sane values so that
+ *	Tcl can talk to a device located on the serial port.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Serial device initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtyInit(fd)
+    int fd;			/* Open file descriptor for serial port to
+				 * be initialized. */
+{
+#ifdef USE_TERMIOS
+    struct termios termios;
+
+    tcgetattr(fd, &termios);
+    termios.c_iflag = IGNBRK;
+    termios.c_oflag = 0;
+    termios.c_lflag = 0;
+    termios.c_cflag |= CREAD;
+    termios.c_cc[VMIN] = 60;
+    termios.c_cc[VTIME] = 2;
+    tcsetattr(fd, TCSANOW, &termios);
+#else	/* !USE_TERMIOS */
+#ifdef USE_TERMIO
+    struct termio termio;
+
+    ioctl(fd, TCGETA, &termio);
+    termio.c_iflag = IGNBRK;
+    termio.c_oflag = 0;
+    termio.c_lflag = 0;
+    termio.c_cflag |= CREAD;
+    termio.c_cc[VMIN] = 60;
+    termio.c_cc[VTIME] = 2;
+    ioctl(fd, TCSETAW, &termio);
+#else	/* !USE_TERMIO */
+#ifdef USE_SGTTY
+    struct sgttyb sgttyb;
+
+    ioctl(fd, TIOCGETP, &sgttyb);
+    sgttyb.sg_flags &= (EVENP | ODDP);
+    sgttyb.sg_flags |= RAW;
+    ioctl(fd, TIOCSETP, &sgttyb);
+#endif	/* USE_SGTTY */
+#endif	/* !USE_TERMIO */
+#endif	/* !USE_TERMIOS */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetAttributes --
+ *
+ *	Get the current attributes of the specified serial device.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+ 
+static void
+TtyGetAttributes(fd, ttyPtr)
+    int fd;			/* Open file descriptor for serial port to
+				 * be queried. */
+    TtyAttrs *ttyPtr;		/* Buffer filled with serial port
+				 * attributes. */
+{
+#ifdef USE_TERMIOS
+    int parity, data;
+    struct termios termios;
 
-    if (pipePtr->isNonBlocking) {
+    tcgetattr(fd, &termios);
+    ttyPtr->baud = TtyGetBaud(cfgetospeed(&termios));
     
-	/*
-         * If the channel is non-blocking, just detach the children PIDs
-         * and discard the errorFile.
-         */
-        
-        Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
-        if (pipePtr->errorFile != NULL) {
-            Tcl_FreeFile(pipePtr->errorFile);
-        }
-    } else {
-        
-	/*
-         * Wrap the error file into a channel and give it to the cleanup
-         * routine.
-         */
+    parity = 'n';
+#ifdef PAREXT
+    switch ((int) (termios.c_cflag & (PARENB | PARODD | PAREXT))) {
+	case PARENB		      : parity = 'e'; break;
+	case PARENB | PARODD	      :	parity = 'o'; break;
+	case PARENB |	       PAREXT : parity = 's'; break;
+	case PARENB | PARODD | PAREXT :	parity = 'm'; break;
+    }
+#else	/* !PAREXT */
+    switch ((int) (termios.c_cflag & (PARENB | PARODD))) {
+	case PARENB		      : parity = 'e'; break;
+	case PARENB | PARODD	      :	parity = 'o'; break;
+    }
+#endif	/* !PAREXT */
+    ttyPtr->parity = parity;
+
+    data = termios.c_cflag & CSIZE;
+    ttyPtr->data = (data == CS5) ? 5 : (data == CS6) ? 6 :
+	    (data == CS7) ? 7 : 8;
+
+    ttyPtr->stop = (termios.c_cflag & CSTOPB) ? 2 : 1;
+#else	/* !USE_TERMIOS */
+#ifdef USE_TERMIO
+    int parity, data;
+    struct termio termio;
+
+    ioctl(fd, TCGETA, &termio);
+    ttyPtr->baud = TtyGetBaud(termio.c_cflag & CBAUD);
+    parity = 'n';
+    switch (termio.c_cflag & (PARENB | PARODD | PAREXT)) {
+	case PARENB		      : parity = 'e'; break;
+	case PARENB | PARODD	      :	parity = 'o'; break;
+	case PARENB |	       PAREXT : parity = 's'; break;
+	case PARENB | PARODD | PAREXT :	parity = 'm'; break;
+    }
+    ttyPtr->parity = parity;
+
+    data = termio.c_cflag & CSIZE;
+    ttyPtr->data = (data == CS5) ? 5 : (data == CS6) ? 6 :
+	    (data == CS7) ? 7 : 8;
+
+    ttyPtr->stop = (termio.c_cflag & CSTOPB) ? 2 : 1;
+#else	/* !USE_TERMIO */
+#ifdef USE_SGTTY
+    int parity;
+    struct sgttyb sgttyb;
+
+    ioctl(fd, TIOCGETP, &sgttyb);
+    ttyPtr->baud = TtyGetBaud(sgttyb.sg_ospeed);
+    parity = 'n';
+    if (sgttyb.sg_flags & EVENP) {
+	parity = 'e';
+    } else if (sgttyb.sg_flags & ODDP) {
+	parity = 'o';
+    }
+    ttyPtr->parity = parity;
+    ttyPtr->data = (sgttyb.sg_flags & (EVENP | ODDP)) ? 7 : 8;
+    ttyPtr->stop = 1;
+#else	/* !USE_SGTTY */
+    ttyPtr->baud = 0;
+    ttyPtr->parity = 'n';
+    ttyPtr->data = 0;
+    ttyPtr->stop = 0;
+#endif	/* !USE_SGTTY */
+#endif	/* !USE_TERMIO */
+#endif	/* !USE_TERMIOS */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtySetAttributes --
+ *
+ *	Set the current attributes of the specified serial device. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+ 
+static void
+TtySetAttributes(fd, ttyPtr)
+    int fd;			/* Open file descriptor for serial port to
+				 * be modified. */
+    TtyAttrs *ttyPtr;		/* Buffer containing new attributes for
+				 * serial port. */
+{
+#ifdef USE_TERMIOS
+    int parity, data, flag;
+    struct termios termios;
+
+    tcgetattr(fd, &termios);
+    cfsetospeed(&termios, TtyGetSpeed(ttyPtr->baud));
+    cfsetispeed(&termios, TtyGetSpeed(ttyPtr->baud));
+
+    flag = 0;
+    parity = ttyPtr->parity;
+    if (parity != 'n') {
+	flag |= PARENB;
+#ifdef PAREXT
+	termios.c_cflag &= ~PAREXT;
+	if ((parity == 'm') || (parity == 's')) {
+	    flag |= PAREXT;
+	}
+#endif
+	if ((parity == 'm') || (parity == 'o')) {
+	    flag |= PARODD;
+	}
+    }
+    data = ttyPtr->data;
+    flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8;
+    if (ttyPtr->stop == 2) {
+	flag |= CSTOPB;
+    }
 
-        if (pipePtr->errorFile != NULL) {
-            errChan = Tcl_CreateChannel(&fileChannelType, "pipeError",
-                    pipePtr->errorFile, NULL, NULL);
-        } else {
-            errChan = NULL;
-        }
-        result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
-                errChan);
+    termios.c_cflag &= ~(PARENB | PARODD | CSIZE | CSTOPB);
+    termios.c_cflag |= flag;
+    tcsetattr(fd, TCSANOW, &termios);
+
+#else	/* !USE_TERMIOS */
+#ifdef USE_TERMIO
+    int parity, data, flag;
+    struct termio termio;
+
+    ioctl(fd, TCGETA, &termio);
+    termio.c_cflag &= ~CBAUD;
+    termio.c_cflag |= TtyGetSpeed(ttyPtr->baud);
+
+    flag = 0;
+    parity = ttyPtr->parity;
+    if (parity != 'n') {
+	flag |= PARENB;
+	if ((parity == 'm') || (parity == 's')) {
+	    flag |= PAREXT;
+	}
+	if ((parity == 'm') || (parity == 'o')) {
+	    flag |= PARODD;
+	}
     }
-    if (pipePtr->numPids != 0) {
-        ckfree((char *) pipePtr->pidPtr);
+    data = ttyPtr->data;
+    flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8;
+    if (ttyPtr->stop == 2) {
+	flag |= CSTOPB;
+    }
+
+    termio.c_cflag &= ~(PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
+    termio.c_cflag |= flag;
+    ioctl(fd, TCSETAW, &termio);
+
+#else	/* !USE_TERMIO */
+#ifdef USE_SGTTY
+    int parity;
+    struct sgttyb sgttyb;
+
+    ioctl(fd, TIOCGETP, &sgttyb);
+    sgttyb.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
+    sgttyb.sg_ispeed = TtyGetSpeed(ttyPtr->baud);
+
+    parity = ttyPtr->parity;
+    if (parity == 'e') {
+	sgttyb.sg_flags &= ~ODDP;
+	sgttyb.sg_flags |= EVENP;
+    } else if (parity == 'o') {
+	sgttyb.sg_flags &= ~EVENP;
+	sgttyb.sg_flags |= ODDP;
+    }
+    ioctl(fd, TIOCSETP, &sgttyb);
+#endif	/* USE_SGTTY */
+#endif	/* !USE_TERMIO */
+#endif	/* !USE_TERMIOS */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyParseMode --
+ *
+ *	Parse the "-mode" argument to the fconfigure command.  The argument
+ *	is of the form baud,parity,data,stop.
+ *
+ * Results:
+ *	The return value is TCL_OK if the argument was successfully
+ *	parsed, TCL_ERROR otherwise.  If TCL_ERROR is returned, an
+ *	error message is left in interp->result (if interp is non-NULL).
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+ 
+static int
+TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
+    Tcl_Interp *interp;		/* If non-NULL, interp for error return. */
+    CONST char *mode;		/* Mode string to be parsed. */
+    int *speedPtr;		/* Filled with baud rate from mode string. */
+    int *parityPtr;		/* Filled with parity from mode string. */
+    int *dataPtr;		/* Filled with data bits from mode string. */
+    int *stopPtr;		/* Filled with stop bits from mode string. */
+{
+    int i, end;
+    char parity;
+    static char *bad = "bad value for -mode";
+
+    i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr,
+	    stopPtr, &end);
+    if ((i != 4) || (mode[end] != '\0')) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
+		    NULL);
+	}
+	return TCL_ERROR;
     }
-    ckfree((char *) pipePtr);
-    if (errorCode == 0) {
-        return result;
+    if (strchr("noems", parity) == NULL) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, bad,
+		    " parity: should be n, o, e, m, or s", NULL);
+	}
+	return TCL_ERROR;
     }
-    return errorCode;
+    *parityPtr = parity;
+    if ((*dataPtr < 5) || (*dataPtr > 8)) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
+		    NULL);
+	}
+	return TCL_ERROR;
+    }
+    if ((*stopPtr < 0) || (*stopPtr > 2)) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
 }
 
 /*
@@ -659,10 +1178,10 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
                                          * it? */
 {
     int fd, seekFlag, mode, channelPermissions;
-    Tcl_File file;
-    Tcl_Channel chan;
+    FileState *fsPtr;
     char *nativeName, channelName[20];
     Tcl_DString buffer;
+    Tcl_ChannelType *channelTypePtr;
 
     mode = TclGetOpenMode(interp, modeString, &seekFlag);
     if (mode == -1) {
@@ -706,43 +1225,68 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
         }
         return NULL;
     }
-    
-    sprintf(channelName, "file%d", fd);
-    file = Tcl_GetFile((ClientData) fd, TCL_UNIX_FD);
-    
-    chan = Tcl_CreateChannel(&fileChannelType, channelName,
-            (channelPermissions & TCL_READABLE) ? file : NULL,
-            (channelPermissions & TCL_WRITABLE) ? file : NULL,
-            (ClientData) NULL);
 
     /*
-     * The channel may not be open now, for example if we tried to
-     * open a file with permissions that cannot be satisfied.
+     * Set close-on-exec flag on the fd so that child processes will not
+     * inherit this fd.
      */
+  
+    fcntl(fd, F_SETFD, FD_CLOEXEC);
     
-    if (chan == (Tcl_Channel) NULL) {
-        if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "couldn't create channel \"",
-                    channelName, "\": ", Tcl_PosixError(interp),
-                    (char *) NULL);
-        }
-        Tcl_FreeFile(file);
-        close(fd);
-        return NULL;
+    sprintf(channelName, "file%d", fd);
+    
+    fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+    fsPtr->nextPtr = firstFilePtr;
+    firstFilePtr = fsPtr;
+    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
+    fsPtr->fd = fd;
+    
+    if (isatty(fd)) {
+	/*
+	 * Initialize the serial port to a set of sane parameters.
+	 * Especially important if the remote device is set to echo and
+	 * the serial port driver was also set to echo -- as soon as a char
+	 * were sent to the serial port, the remote device would echo it,
+	 * then the serial driver would echo it back to the device, etc.
+	 */
+	 
+	TtyInit(fd);
+	channelTypePtr = &ttyChannelType;
+    } else {
+	channelTypePtr = &fileChannelType;
     }
 
+    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+	    (ClientData) fsPtr, channelPermissions);
+
     if (seekFlag) {
-        if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
+        if (Tcl_Seek(fsPtr->channel, 0, SEEK_END) < 0) {
             if (interp != (Tcl_Interp *) NULL) {
                 Tcl_AppendResult(interp, "couldn't seek to end of file on \"",
-                        channelName, "\": ", Tcl_PosixError(interp),
-                        (char *) NULL);
+                        channelName, "\": ", Tcl_PosixError(interp), NULL);
             }
-            Tcl_Close(NULL, chan);
+            Tcl_Close(NULL, fsPtr->channel);
             return NULL;
         }
     }
-    return chan;
+
+    if (channelTypePtr == &ttyChannelType) {
+	/*
+	 * Gotcha.  Most modems need a "\r" at the end of the command
+	 * sequence.  If you just send "at\n", the modem will not respond
+	 * with "OK" because it never got a "\r" to actually invoke the
+	 * command.  So, by default, newlines are translated to "\r\n" on
+	 * output to avoid "bug" reports that the serial port isn't working.
+	 */
+	 
+	if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
+		"auto crlf") != TCL_OK) {
+	    Tcl_Close(NULL, fsPtr->channel);
+	    return NULL;
+	}
+    }
+
+    return fsPtr->channel;
 }
 
 /*
@@ -762,192 +1306,41 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
  */
 
 Tcl_Channel
-Tcl_MakeFileChannel(inFd, outFd, mode)
-    ClientData inFd;		/* OS level handle used for input. */
-    ClientData outFd;		/* OS level handle used for output. */
+Tcl_MakeFileChannel(handle, mode)
+    ClientData handle;		/* OS level handle. */
     int mode;			/* ORed combination of TCL_READABLE and
-                                 * TCL_WRITABLE to indicate whether inFile
-                                 * and/or outFile are valid. */
+                                 * TCL_WRITABLE to indicate file mode. */
 {
-    Tcl_Channel chan;
-    int fileUsed;
-    Tcl_File inFile, outFile;
+    FileState *fsPtr;
     char channelName[20];
+    int fd = (int) handle;
 
     if (mode == 0) {
-        return (Tcl_Channel) NULL;
-    }
-    
-    inFile = (Tcl_File) NULL;
-    outFile = (Tcl_File) NULL;
-    
-    if (mode & TCL_READABLE) {
-	sprintf(channelName, "file%d", (int) inFd);
-        inFile = Tcl_GetFile(inFd, TCL_UNIX_FD);
-    }
-    
-    if (mode & TCL_WRITABLE) {
-	sprintf(channelName, "file%d", (int) outFd);
-        outFile = Tcl_GetFile(outFd, TCL_UNIX_FD);
+        return NULL;
     }
 
-    /*
-     * Look to see if a channel with those two Tcl_Files already exists.
-     * If so, return it.
-     */
-    
-    chan = TclFindFileChannel(inFile, outFile, &fileUsed);
-    if (chan != (Tcl_Channel) NULL) {
-        return chan;
-    }
+    sprintf(channelName, "file%d", fd);
 
     /*
-     * If one of the Tcl_Files is used in another channel, do not
-     * create a new channel containing it; this avoids core dumps
-     * later, when the Tcl_File would be freed twice.
+     * Look to see if a channel with this fd and the same mode already exists.
+     * If the fd is used, but the mode doesn't match, return NULL.
      */
     
-    if (fileUsed) {
-        return (Tcl_Channel) NULL;
-    }
-    return Tcl_CreateChannel(&fileChannelType, channelName, inFile, outFile,
-            (ClientData) NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCreateCommandChannel --
- *
- *	This function is called by the generic IO level to perform
- *	the platform specific channel initialization for a command
- *	channel.
- *
- * Results:
- *	Returns a new channel or NULL on failure.
- *
- * Side effects:
- *	Allocates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
-    Tcl_File readFile;		/* If non-null, gives the file for reading. */
-    Tcl_File writeFile;		/* If non-null, gives the file for writing. */
-    Tcl_File errorFile;		/* If non-null, gives the file where errors
-				 * can be read. */
-    int numPids;		/* The number of pids in the pid array. */
-    int *pidPtr;		/* An array of process identifiers.
-                                 * Allocated by the caller, freed when
-                                 * the channel is closed or the processes
-                                 * are detached (in a background exec). */
-{
-    Tcl_Channel channel;
-    char channelName[20];
-    int channelId;
-    PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
-
-    statePtr->readFile = readFile;
-    statePtr->writeFile = writeFile;
-    statePtr->errorFile = errorFile;
-    statePtr->numPids = numPids;
-    statePtr->pidPtr = pidPtr;
-    statePtr->isNonBlocking = 0;
-
-    /*
-     * Use one of the fds associated with the channel as the
-     * channel id.
-     */
-
-    if (readFile) {
-	channelId = (int) Tcl_GetFileInfo(readFile, NULL);
-    } else if (writeFile) {
-	channelId = (int) Tcl_GetFileInfo(writeFile, NULL);
-    } else if (errorFile) {
-	channelId = (int) Tcl_GetFileInfo(errorFile, NULL);
-    } else {
-	channelId = 0;
-    }
-
-    /*
-     * For backward compatibility with previous versions of Tcl, we
-     * use "file%d" as the base name for pipes even though it would
-     * be more natural to use "pipe%d".
-     */
-
-    sprintf(channelName, "file%d", channelId);
-    channel = Tcl_CreateChannel(&pipeChannelType, channelName, readFile,
-	    writeFile, (ClientData) statePtr);
-
-    if (channel == NULL) {
-
-        /*
-         * pidPtr will be freed by the caller if the return value is NULL.
-         */
-        
-	ckfree((char *)statePtr);
-    }
-    return channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_PidCmd --
- *
- *	This procedure is invoked to process the "pid" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tcl_PidCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
-{
-    Tcl_Channel chan;			/* The channel to get pids for. */
-    Tcl_ChannelType *chanTypePtr;	/* The type of that channel. */
-    PipeState *pipePtr;			/* The pipe state. */
-    int i;				/* Loops over PIDs attached to the
-                                         * pipe. */
-    char string[50];			/* Temp buffer for string rep. of
-                                         * PIDs attached to the pipe. */
-
-    if (argc > 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " ?channelId?\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-    if (argc == 1) {
-	sprintf(interp->result, "%ld", (long) getpid());
-    } else {
-        chan = Tcl_GetChannel(interp, argv[1], NULL);
-        if (chan == (Tcl_Channel) NULL) {
-	    return TCL_ERROR;
-	}
-	chanTypePtr = Tcl_GetChannelType(chan);
-	if (chanTypePtr != &pipeChannelType) {
-	    return TCL_OK;
-	}
-        pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
-        for (i = 0; i < pipePtr->numPids; i++) {
-	    sprintf(string, "%d", pipePtr->pidPtr[i]);
-	    Tcl_AppendElement(interp, string);
+    for (fsPtr = firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
+	if (fsPtr->fd == fd) {
+	    return (mode == fsPtr->validMask) ? fsPtr->channel : NULL;
 	}
     }
-    return TCL_OK;
+
+    fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+    fsPtr->nextPtr = firstFilePtr;
+    firstFilePtr = fsPtr;
+    fsPtr->fd = fd;
+    fsPtr->validMask = mode | TCL_EXCEPTION;
+    fsPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
+            (ClientData) fsPtr, mode);
+    
+    return fsPtr->channel;
 }
 
 /*
@@ -969,22 +1362,46 @@ Tcl_PidCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TcpBlockModeProc(instanceData, inFile, outFile, mode)
+TcpBlockModeProc(instanceData, mode)
     ClientData instanceData;		/* Socket state. */
-    Tcl_File inFile, outFile;		/* Input, output files for channel. */
     int mode;				/* The mode to set. Can be one of
                                          * TCL_MODE_BLOCKING or
                                          * TCL_MODE_NONBLOCKING. */
 {
-    TcpState *statePtr;
+    TcpState *statePtr = (TcpState *) instanceData;
+    int setting;
     
-    statePtr = (TcpState *) instanceData;
+#ifndef	USE_FIONBIO
+    setting = fcntl(statePtr->fd, F_GETFL);
     if (mode == TCL_MODE_BLOCKING) {
         statePtr->flags &= (~(TCP_ASYNC_SOCKET));
+        setting &= (~(O_NONBLOCK));
     } else {
         statePtr->flags |= TCP_ASYNC_SOCKET;
+        setting |= O_NONBLOCK;
     }
-    return FileBlockModeProc(instanceData, inFile, outFile, mode);
+    if (fcntl(statePtr->fd, F_SETFL, setting) < 0) {
+        return errno;
+    }
+#endif
+
+#ifdef	USE_FIONBIO
+    if (mode == TCL_MODE_BLOCKING) {
+        statePtr->flags &= (~(TCP_ASYNC_SOCKET));
+        setting = 0;
+        if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
+            return errno;
+        }
+    } else {
+        statePtr->flags |= TCP_ASYNC_SOCKET;
+        setting = 1;
+        if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
+            return errno;
+        }
+    }
+#endif
+
+    return 0;
 }
 
 /*
@@ -1005,12 +1422,10 @@ TcpBlockModeProc(instanceData, inFile, outFile, mode)
  */
 
 static int
-WaitForConnect(statePtr, fileToWaitFor, errorCodePtr)
+WaitForConnect(statePtr, errorCodePtr)
     TcpState *statePtr;		/* State of the socket. */
-    Tcl_File fileToWaitFor;	/* File to wait on to become connected. */
     int *errorCodePtr;		/* Where to store errors? */
 {
-    int sock;			/* The socket itself. */
     int timeOut;		/* How long to wait. */
     int state;			/* Of calling TclWaitForFile. */
     int flags;			/* fcntl flags for the socket. */
@@ -1027,13 +1442,19 @@ WaitForConnect(statePtr, fileToWaitFor, errorCodePtr)
             timeOut = -1;
         }
         errno = 0;
-        state = TclWaitForFile(fileToWaitFor, TCL_WRITABLE | TCL_EXCEPTION,
-                timeOut);
+        state = TclUnixWaitForFile(statePtr->fd,
+		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
         if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
-            sock = (int) Tcl_GetFileInfo(statePtr->sock, NULL);
-            flags = fcntl(sock, F_GETFL);
+#ifndef	USE_FIONBIO
+            flags = fcntl(statePtr->fd, F_GETFL);
             flags &= (~(O_NONBLOCK));
-            (void) fcntl(sock, F_SETFL, flags);
+            (void) fcntl(statePtr->fd, F_SETFL, flags);
+#endif
+
+#ifdef	USE_FIONBIO
+            flags = 0;
+            (void) ioctl(statePtr->fd, FIONBIO, &flags);
+#endif
         }
         if (state & TCL_EXCEPTION) {
             return -1;
@@ -1072,28 +1493,22 @@ WaitForConnect(statePtr, fileToWaitFor, errorCodePtr)
 
 	/* ARGSUSED */
 static int
-TcpInputProc(instanceData, inFile, buf, bufSize, errorCodePtr)
+TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
     ClientData instanceData;		/* Socket state. */
-    Tcl_File inFile;			/* Input device for channel. */
     char *buf;				/* Where to store data read. */
     int bufSize;			/* How much space is available
                                          * in the buffer? */
     int *errorCodePtr;			/* Where to store error code. */
 {
-    TcpState *statePtr;			/* The state of the socket. */
-    int sock;				/* The OS handle. */
-    int bytesRead;			/* How many bytes were read? */
-    int state;				/* Of waiting for connection. */
+    TcpState *statePtr = (TcpState *) instanceData;
+    int bytesRead, state;
 
     *errorCodePtr = 0;
-    sock = (int) Tcl_GetFileInfo(inFile, NULL);
-    statePtr = (TcpState *) instanceData;
-
-    state = WaitForConnect(statePtr, inFile, errorCodePtr);
+    state = WaitForConnect(statePtr, errorCodePtr);
     if (state != 0) {
         return -1;
     }
-    bytesRead = recv(sock, buf, bufSize, 0);
+    bytesRead = recv(statePtr->fd, buf, bufSize, 0);
     if (bytesRead > -1) {
         return bytesRead;
     }
@@ -1131,26 +1546,22 @@ TcpInputProc(instanceData, inFile, buf, bufSize, errorCodePtr)
  */
 
 static int
-TcpOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
+TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
     ClientData instanceData;		/* Socket state. */
-    Tcl_File outFile;			/* Output device for channel. */
     char *buf;				/* The data buffer. */
     int toWrite;			/* How many bytes to write? */
     int *errorCodePtr;			/* Where to store error code. */
 {
-    TcpState *statePtr;
+    TcpState *statePtr = (TcpState *) instanceData;
     int written;
-    int sock;				/* OS level socket. */
     int state;				/* Of waiting for connection. */
 
     *errorCodePtr = 0;
-    sock = (int) Tcl_GetFileInfo(outFile, NULL);
-    statePtr = (TcpState *) instanceData;
-    state = WaitForConnect(statePtr, outFile, errorCodePtr);
+    state = WaitForConnect(statePtr, errorCodePtr);
     if (state != 0) {
         return -1;
     }
-    written = send(sock, buf, toWrite, 0);
+    written = send(statePtr->fd, buf, toWrite, 0);
     if (written > -1) {
         return written;
     }
@@ -1178,20 +1589,13 @@ TcpOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
 
 	/* ARGSUSED */
 static int
-TcpCloseProc(instanceData, interp, inFile, outFile)
+TcpCloseProc(instanceData, interp)
     ClientData instanceData;	/* The socket to close. */
     Tcl_Interp *interp;		/* For error reporting - unused. */
-    Tcl_File inFile, outFile;	/* Unused. */
 {
-    TcpState *statePtr;
-    Tcl_File sockFile;
-    int sock;
+    TcpState *statePtr = (TcpState *) instanceData;
     int errorCode = 0;
 
-    statePtr = (TcpState *) instanceData;
-    sockFile = statePtr->sock;
-    sock = (int) Tcl_GetFileInfo(sockFile, NULL);
-    
     /*
      * Delete a file handler that may be active for this socket if this
      * is a server socket - the file handler was created automatically
@@ -1201,20 +1605,12 @@ TcpCloseProc(instanceData, interp, inFile, outFile)
      * delete them here.
      */
     
-    Tcl_DeleteFileHandler(sockFile);
-
-    ckfree((char *) statePtr);
-    
-    /*
-     * We assume that inFile==outFile==sockFile and so
-     * we only clean up sockFile.
-     */
-
-    Tcl_FreeFile(sockFile);
+    Tcl_DeleteFileHandler(statePtr->fd);
 
-    if (close(sock) < 0) {
+    if (close(statePtr->fd) < 0) {
 	errorCode = errno;
     }
+    ckfree((char *) statePtr);
 
     return errorCode;
 }
@@ -1232,7 +1628,7 @@ TcpCloseProc(instanceData, interp, inFile, outFile)
  * Results:
  *	A standard Tcl result. The value of the specified option or a
  *	list of all options and	their values is returned in the
- *	supplied DString.
+ *	supplied DString. Sets Error message if needed.
  *
  * Side effects:
  *	None.
@@ -1241,26 +1637,24 @@ TcpCloseProc(instanceData, interp, inFile, outFile)
  */
 
 static int
-TcpGetOptionProc(instanceData, optionName, dsPtr)
-    ClientData instanceData;		/* Socket state. */
-    char *optionName;			/* Name of the option to
-                                         * retrieve the value for, or
-                                         * NULL to get all options and
-                                         * their values. */
-    Tcl_DString *dsPtr;			/* Where to store the computed
-                                         * value; initialized by caller. */
+TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
+    ClientData instanceData;     /* Socket state. */
+    Tcl_Interp *interp;          /* For error reporting - can be NULL. */
+    char *optionName;	         /* Name of the option to
+				  * retrieve the value for, or
+				  * NULL to get all options and
+				  * their values. */
+    Tcl_DString *dsPtr;	         /* Where to store the computed
+				  * value; initialized by caller. */
 {
-    TcpState *statePtr;
+    TcpState *statePtr = (TcpState *) instanceData;
     struct sockaddr_in sockname;
     struct sockaddr_in peername;
     struct hostent *hostEntPtr;
-    int sock;
     int size = sizeof(struct sockaddr_in);
     size_t len = 0;
     char buf[128];
 
-    statePtr = (TcpState *) instanceData;
-    sock = (int) Tcl_GetFileInfo(statePtr->sock, NULL);
     if (optionName != (char *) NULL) {
         len = strlen(optionName);
     }
@@ -1268,7 +1662,8 @@ TcpGetOptionProc(instanceData, optionName, dsPtr)
     if ((len == 0) ||
             ((len > 1) && (optionName[1] == 'p') &&
                     (strncmp(optionName, "-peername", len) == 0))) {
-        if (getpeername(sock, (struct sockaddr *) &peername, &size) >= 0) {
+        if (getpeername(statePtr->fd, (struct sockaddr *) &peername, &size)
+		>= 0) {
             if (len == 0) {
                 Tcl_DStringAppendElement(dsPtr, "-peername");
                 Tcl_DStringStartSublist(dsPtr);
@@ -1288,13 +1683,30 @@ TcpGetOptionProc(instanceData, optionName, dsPtr)
             } else {
                 return TCL_OK;
             }
+        } else {
+            /*
+             * getpeername failed - but if we were asked for all the options
+             * (len==0), don't flag an error at that point because it could
+             * be an fconfigure request on a server socket. (which have
+             * no peer). same must be done on win&mac.
+             */
+
+            if (len) {
+                if (interp) {
+                    Tcl_AppendResult(interp, "can't get peername: ",
+                                     Tcl_PosixError(interp),
+                                     (char *) NULL);
+                }
+                return TCL_ERROR;
+            }
         }
     }
 
     if ((len == 0) ||
             ((len > 1) && (optionName[1] == 's') &&
                     (strncmp(optionName, "-sockname", len) == 0))) {
-        if (getsockname(sock, (struct sockaddr *) &sockname, &size) >= 0) {
+        if (getsockname(statePtr->fd, (struct sockaddr *) &sockname, &size)
+		>= 0) {
             if (len == 0) {
                 Tcl_DStringAppendElement(dsPtr, "-sockname");
                 Tcl_DStringStartSublist(dsPtr);
@@ -1314,12 +1726,18 @@ TcpGetOptionProc(instanceData, optionName, dsPtr)
             } else {
                 return TCL_OK;
             }
-        }
+        } else {
+	    if (interp) {
+		Tcl_AppendResult(interp, "can't get sockname: ",
+				 Tcl_PosixError(interp),
+				 (char *) NULL);
+	    }
+	    return TCL_ERROR;
+	}
     }
 
     if (len > 0) {
-        Tcl_SetErrno(EINVAL);
-        return TCL_ERROR;
+        return Tcl_BadChannelOption(interp, optionName, "peername sockname");
     }
 
     return TCL_OK;
@@ -1328,6 +1746,72 @@ TcpGetOptionProc(instanceData, optionName, dsPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TcpWatchProc --
+ *
+ *	Initialize the notifier to watch the fd from this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets up the notifier so that a future event on the channel will
+ *	be seen by Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TcpWatchProc(instanceData, mask)
+    ClientData instanceData;		/* The socket state. */
+    int mask;				/* Events of interest; an OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+
+    if (mask) {
+	Tcl_CreateFileHandler(statePtr->fd, mask,
+		(Tcl_FileProc *) Tcl_NotifyChannel,
+		(ClientData) statePtr->channel);
+    } else {
+	Tcl_DeleteFileHandler(statePtr->fd);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetHandleProc --
+ *
+ *	Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ *	a TCP socket based channel.
+ *
+ * Results:
+ *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ *	there is no handle for the specified direction. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TcpGetHandleProc(instanceData, direction, handlePtr)
+    ClientData instanceData;	/* The socket state. */
+    int direction;		/* Not used. */
+    ClientData *handlePtr;	/* Where to store the handle.  */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+
+    *handlePtr = (ClientData)statePtr->fd;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * CreateSocket --
  *
  *	This function opens a new socket in client or server mode
@@ -1378,6 +1862,13 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
     }
 
     /*
+     * Set the close-on-exec flag so that the socket will not get
+     * inherited by child processes.
+     */
+
+    fcntl(sock, F_SETFD, FD_CLOEXEC);
+    
+    /*
      * Set kernel space buffering
      */
 
@@ -1398,13 +1889,13 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
 	status = bind(sock, (struct sockaddr *) &sockaddr,
                 sizeof(struct sockaddr));
 	if (status != -1) {
-	    status = listen(sock, TCL_LISTEN_LIMIT);
+	    status = listen(sock, SOMAXCONN);
 	} 
     } else {
 	if (myaddr != NULL || myport != 0) { 
-	    status = 1;
-	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
-		    sizeof(status));
+	    curState = 1;
+	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+                    (char *) &curState, sizeof(curState));
 	    status = bind(sock, (struct sockaddr *) &mysockaddr,
 		    sizeof(struct sockaddr));
 	    if (status < 0) {
@@ -1420,9 +1911,16 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
 	 */
 
         if (async) {
+#ifndef	USE_FIONBIO
             origState = fcntl(sock, F_GETFL);
             curState = origState | O_NONBLOCK;
             status = fcntl(sock, F_SETFL, curState);
+#endif
+
+#ifdef	USE_FIONBIO
+            curState = 1;
+            status = ioctl(sock, FIONBIO, &curState);
+#endif            
         } else {
             status = 0;
         }
@@ -1459,7 +1957,7 @@ bindError:
     if (asyncConnect) {
         statePtr->flags = TCP_ASYNC_CONNECT;
     }
-    statePtr->sock = Tcl_GetFile((ClientData) sock, TCL_UNIX_FD);
+    statePtr->fd = sock;
     
     return statePtr;
 
@@ -1565,7 +2063,6 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
                                          * asynchronous connect. Otherwise
                                          * we do a blocking connect. */
 {
-    Tcl_Channel chan;
     TcpState *statePtr;
     char channelName[20];
 
@@ -1581,17 +2078,16 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
     statePtr->acceptProc = NULL;
     statePtr->acceptProcData = (ClientData) NULL;
 
-    sprintf(channelName, "sock%d",
-	    (int) Tcl_GetFileInfo(statePtr->sock, NULL));
+    sprintf(channelName, "sock%d", statePtr->fd);
 
-    chan = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr->sock,
-	    statePtr->sock, (ClientData) statePtr);
-    if (Tcl_SetChannelOption(interp, chan, "-translation", "auto crlf") ==
-            TCL_ERROR) {
-        Tcl_Close((Tcl_Interp *) NULL, chan);
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
+	    "auto crlf") == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
         return NULL;
     }
-    return chan;
+    return statePtr->channel;
 }
 
 /*
@@ -1615,26 +2111,23 @@ Tcl_MakeTcpClientChannel(sock)
     ClientData sock;		/* The socket to wrap up into a channel. */
 {
     TcpState *statePtr;
-    Tcl_File sockFile;
     char channelName[20];
-    Tcl_Channel chan;
 
-    sockFile = Tcl_GetFile(sock, TCL_UNIX_FD);
     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
-    statePtr->sock = sockFile;
+    statePtr->fd = (int) sock;
     statePtr->acceptProc = NULL;
     statePtr->acceptProcData = (ClientData) NULL;
 
-    sprintf(channelName, "sock%d", (int) sock);
+    sprintf(channelName, "sock%d", statePtr->fd);
     
-    chan = Tcl_CreateChannel(&tcpChannelType, channelName, sockFile, sockFile,
-            (ClientData) statePtr);
-    if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-translation",
-            "auto crlf") == TCL_ERROR) {
-        Tcl_Close((Tcl_Interp *) NULL, chan);
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+    if (Tcl_SetChannelOption((Tcl_Interp *) NULL, statePtr->channel,
+	    "-translation", "auto crlf") == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
         return NULL;
     }
-    return chan;
+    return statePtr->channel;
 }
 
 /*
@@ -1665,7 +2158,6 @@ Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
                                          * from new clients. */
     ClientData acceptProcData;		/* Data for the callback. */
 {
-    Tcl_Channel chan;
     TcpState *statePtr;
     char channelName[20];
 
@@ -1686,13 +2178,12 @@ Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
      * from new clients.
      */
 
-    Tcl_CreateFileHandler(statePtr->sock, TCL_READABLE, TcpAccept,
+    Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
             (ClientData) statePtr);
-    sprintf(channelName, "sock%d",
-	    (int) Tcl_GetFileInfo(statePtr->sock, NULL));
-    chan = Tcl_CreateChannel(&tcpChannelType, channelName, NULL, NULL,
-            (ClientData) statePtr);
-    return chan;
+    sprintf(channelName, "sock%d", statePtr->fd);
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, 0);
+    return statePtr->channel;
 }
 
 /*
@@ -1719,48 +2210,44 @@ TcpAccept(data, mask)
 {
     TcpState *sockState;		/* Client data of server socket. */
     int newsock;			/* The new client socket */
-    Tcl_File newFile;			/* Its file. */
     TcpState *newSockState;		/* State for new socket. */
     struct sockaddr_in addr;		/* The remote address */
     int len;				/* For accept interface */
-    Tcl_Channel chan;			/* Channel instance created. */
     char channelName[20];
 
     sockState = (TcpState *) data;
 
     len = sizeof(struct sockaddr_in);
-    newsock = accept((int) Tcl_GetFileInfo(sockState->sock, NULL),
-	    (struct sockaddr *)&addr, &len);
+    newsock = accept(sockState->fd, (struct sockaddr *)&addr, &len);
     if (newsock < 0) {
         return;
     }
+
+    /*
+     * Set close-on-exec flag to prevent the newly accepted socket from
+     * being inherited by child processes.
+     */
+
+    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
     
-    newFile = Tcl_GetFile((ClientData) newsock, TCL_UNIX_FD);
-    if (newFile) {
-        newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
-
-        newSockState->flags = 0;
-        newSockState->sock = newFile;
-        newSockState->acceptProc = (Tcl_TcpAcceptProc *) NULL;
-        newSockState->acceptProcData = (ClientData) NULL;
+    newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+
+    newSockState->flags = 0;
+    newSockState->fd = newsock;
+    newSockState->acceptProc = (Tcl_TcpAcceptProc *) NULL;
+    newSockState->acceptProcData = (ClientData) NULL;
         
-        sprintf(channelName, "sock%d", (int) newsock);
-        chan = Tcl_CreateChannel(&tcpChannelType, channelName, newFile,
-                newFile, (ClientData) newSockState);
-        if (chan == (Tcl_Channel) NULL) {
-            ckfree((char *) newSockState);
-            close(newsock);
-            Tcl_FreeFile(newFile);
-	} else {
-            if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-translation",
-                    "auto crlf") == TCL_ERROR) {
-                Tcl_Close((Tcl_Interp *) NULL, chan);
-            }
-            if (sockState->acceptProc != (Tcl_TcpAcceptProc *) NULL) {
-                (sockState->acceptProc) (sockState->acceptProcData, chan,
-                        inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
-            }
-	}
+    sprintf(channelName, "sock%d", newsock);
+    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
+
+    Tcl_SetChannelOption((Tcl_Interp *) NULL, newSockState->channel,
+	    "-translation", "auto crlf");
+
+    if (sockState->acceptProc != (Tcl_TcpAcceptProc *) NULL) {
+	(sockState->acceptProc) (sockState->acceptProcData,
+		newSockState->channel, inet_ntoa(addr.sin_addr),
+		ntohs(addr.sin_port));
     }
 }
 
@@ -1824,56 +2311,20 @@ TclGetDefaultStdChannel(type)
 	    break;
     }
 
-    channel = Tcl_MakeFileChannel((ClientData) fd, (ClientData) fd, mode);
+    channel = Tcl_MakeFileChannel((ClientData) fd, mode);
 
     /*
      * Set up the normal channel options for stdio handles.
      */
 
-    if (Tcl_SetChannelOption(NULL, channel, "-translation", "auto") ==
-            TCL_ERROR) {
-        Tcl_Close((Tcl_Interp *) NULL, channel);
-        return NULL;
-    }
-    if (Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode) ==
-            TCL_ERROR) {
-        Tcl_Close((Tcl_Interp *) NULL, channel);
-        return NULL;
-    }
+    Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
+    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
     return channel;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclClosePipeFile --
- *
- *	This function is a simple wrapper for close on a file or
- *	pipe handle. Called in the generic command pipeline cleanup
- *	code to do platform specific closing of the files associated
- *	with the command channel.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Closes the fd and frees the Tcl_File.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclClosePipeFile(file)
-    Tcl_File file;
-{
-    int fd = (int) Tcl_GetFileInfo(file, NULL);
-    close(fd);
-    Tcl_FreeFile(file);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_GetOpenFile --
  *
  *	Given a name of a channel registered in the given interpreter,
@@ -1909,7 +2360,6 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
     Tcl_Channel chan;
     int chanMode;
     Tcl_ChannelType *chanTypePtr;
-    Tcl_File tf;
     int fd;
     FILE *f;
     
@@ -1934,30 +2384,180 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
      */
 
     chanTypePtr = Tcl_GetChannelType(chan);
-    if ((chanTypePtr == &fileChannelType) || (chanTypePtr == &pipeChannelType)
-            || (chanTypePtr == &tcpChannelType)) {
-        tf = Tcl_GetChannelFile(chan,
-                (forWriting ? TCL_WRITABLE : TCL_READABLE));
-        fd = (int) Tcl_GetFileInfo(tf, NULL);
-
-        /*
-         * The call to fdopen below is probably dangerous, since it will
-         * truncate an existing file if the file is being opened
-         * for writing....
-         */
+    if ((chanTypePtr == &fileChannelType) || (chanTypePtr == &tcpChannelType)
+	    || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
+        if (Tcl_GetChannelHandle(chan,
+		(forWriting ? TCL_WRITABLE : TCL_READABLE), (ClientData*) &fd)
+		== TCL_OK) {
+
+	    /*
+	     * The call to fdopen below is probably dangerous, since it will
+	     * truncate an existing file if the file is being opened
+	     * for writing....
+	     */
         
-        f = fdopen(fd, (forWriting ? "w" : "r"));
-        if (f == NULL) {
-            Tcl_AppendResult(interp, "cannot get a FILE * for \"", string,
-                    "\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        *filePtr = (ClientData) f;
-        return TCL_OK;
+	    f = fdopen(fd, (forWriting ? "w" : "r"));
+	    if (f == NULL) {
+		Tcl_AppendResult(interp, "cannot get a FILE * for \"", string,
+			"\"", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    *filePtr = (ClientData) f;
+	    return TCL_OK;
+	}
     }
 
     Tcl_AppendResult(interp, "\"", string,
-            "\" cannot be used to get a FILE * - unsupported type",
-            (char *) NULL);
+            "\" cannot be used to get a FILE *", (char *) NULL);
     return TCL_ERROR;        
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUnixWaitForFile --
+ *
+ *	This procedure waits synchronously for a file to become readable
+ *	or writable, with an optional timeout.
+ *
+ * Results:
+ *	The return value is an OR'ed combination of TCL_READABLE,
+ *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions
+ *	that are present on file at the time of the return.  This
+ *	procedure will not return until either "timeout" milliseconds
+ *	have elapsed or at least one of the conditions given by mask
+ *	has occurred for file (a return value of 0 means that a timeout
+ *	occurred).  No normal events will be serviced during the
+ *	execution of this procedure.
+ *
+ * Side effects:
+ *	Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUnixWaitForFile(fd, mask, timeout)
+    int fd;			/* Handle for file on which to wait. */
+    int mask;			/* What to wait for: OR'ed combination of
+				 * TCL_READABLE, TCL_WRITABLE, and
+				 * TCL_EXCEPTION. */
+    int timeout;		/* Maximum amount of time to wait for one
+				 * of the conditions in mask to occur, in
+				 * milliseconds.  A value of 0 means don't
+				 * wait at all, and a value of -1 means
+				 * wait forever. */
+{
+    Tcl_Time abortTime, now;
+    struct timeval blockTime, *timeoutPtr;
+    int index, bit, numFound, result = 0;
+    static fd_mask readyMasks[3*MASK_SIZE];
+				/* This array reflects the readable/writable
+				 * conditions that were found to exist by the
+				 * last call to select. */
+
+    /*
+     * If there is a non-zero finite timeout, compute the time when
+     * we give up.
+     */
+
+    if (timeout > 0) {
+	TclpGetTime(&now);
+	abortTime.sec = now.sec + timeout/1000;
+	abortTime.usec = now.usec + (timeout%1000)*1000;
+	if (abortTime.usec >= 1000000) {
+	    abortTime.usec -= 1000000;
+	    abortTime.sec += 1;
+	}
+	timeoutPtr = &blockTime;
+    } else if (timeout == 0) {
+	timeoutPtr = &blockTime;
+	blockTime.tv_sec = 0;
+	blockTime.tv_usec = 0;
+    } else {
+	timeoutPtr = NULL;
+    }
+
+    /*
+     * Initialize the ready masks and compute the mask offsets.
+     */
+
+    if (fd >= FD_SETSIZE) {
+	panic("TclWaitForFile can't handle file id %d", fd);
+    }
+    memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+    index = fd/(NBBY*sizeof(fd_mask));
+    bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+    
+    /*
+     * Loop in a mini-event loop of our own, waiting for either the
+     * file to become ready or a timeout to occur.
+     */
+
+    while (1) {
+	if (timeout > 0) {
+	    blockTime.tv_sec = abortTime.sec - now.sec;
+	    blockTime.tv_usec = abortTime.usec - now.usec;
+	    if (blockTime.tv_usec < 0) {
+		blockTime.tv_sec -= 1;
+		blockTime.tv_usec += 1000000;
+	    }
+	    if (blockTime.tv_sec < 0) {
+		blockTime.tv_sec = 0;
+		blockTime.tv_usec = 0;
+	    }
+	}
+	
+	/*
+	 * Set the appropriate bit in the ready masks for the fd.
+	 */
+
+	if (mask & TCL_READABLE) {
+	    readyMasks[index] |= bit;
+	}
+	if (mask & TCL_WRITABLE) {
+	    (readyMasks+MASK_SIZE)[index] |= bit;
+	}
+	if (mask & TCL_EXCEPTION) {
+	    (readyMasks+2*(MASK_SIZE))[index] |= bit;
+	}
+
+	/*
+	 * Wait for the event or a timeout.
+	 */
+
+	numFound = select(fd+1, (SELECT_MASK *) &readyMasks[0],
+		(SELECT_MASK *) &readyMasks[MASK_SIZE],
+		(SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
+	if (numFound == 1) {
+	    if (readyMasks[index] & bit) {
+		result |= TCL_READABLE;
+	    }
+	    if ((readyMasks+MASK_SIZE)[index] & bit) {
+		result |= TCL_WRITABLE;
+	    }
+	    if ((readyMasks+2*(MASK_SIZE))[index] & bit) {
+		result |= TCL_EXCEPTION;
+	    }
+	    result &= mask;
+	    if (result) {
+		break;
+	    }
+	}
+	if (timeout == 0) {
+	    break;
+	}
+
+	/*
+	 * The select returned early, so we need to recompute the timeout.
+	 */
+
+	TclpGetTime(&now);
+	if ((abortTime.sec < now.sec)
+		|| ((abortTime.sec == now.sec)
+		&& (abortTime.usec <= now.usec))) {
+	    break;
+	}
+    }
+    return result;
+}
diff --git a/contrib/tcl/unix/tclUnixEvent.c b/contrib/tcl/unix/tclUnixEvent.c
new file mode 100644
index 0000000..24841ca
--- /dev/null
+++ b/contrib/tcl/unix/tclUnixEvent.c
@@ -0,0 +1,76 @@
+/* 
+ * tclUnixEvent.c --
+ *
+ *	This file implements Unix specific event related routines.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixEvent.c 1.1 97/03/04 14:19:34
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Sleep --
+ *
+ *	Delay execution for the specified number of milliseconds.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Sleep(ms)
+    int ms;			/* Number of milliseconds to sleep. */
+{
+    static struct timeval delay;
+    Tcl_Time before, after;
+
+    /*
+     * The only trick here is that select appears to return early
+     * under some conditions, so we have to check to make sure that
+     * the right amount of time really has elapsed.  If it's too
+     * early, go back to sleep again.
+     */
+
+    TclpGetTime(&before);
+    after = before;
+    after.sec += ms/1000;
+    after.usec += (ms%1000)*1000;
+    if (after.usec > 1000000) {
+	after.usec -= 1000000;
+	after.sec += 1;
+    }
+    while (1) {
+	delay.tv_sec = after.sec - before.sec;
+	delay.tv_usec = after.usec - before.usec;
+	if (delay.tv_usec < 0) {
+	    delay.tv_usec += 1000000;
+	    delay.tv_sec -= 1;
+	}
+
+	/*
+	 * Special note:  must convert delay.tv_sec to int before comparing
+	 * to zero, since delay.tv_usec is unsigned on some platforms.
+	 */
+
+	if ((((int) delay.tv_sec) < 0)
+		|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
+	    break;
+	}
+	(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
+		(SELECT_MASK *) 0, &delay);
+	TclpGetTime(&before);
+    }
+}
diff --git a/contrib/tcl/unix/tclUnixFCmd.c b/contrib/tcl/unix/tclUnixFCmd.c
new file mode 100644
index 0000000..51224e6
--- /dev/null
+++ b/contrib/tcl/unix/tclUnixFCmd.c
@@ -0,0 +1,1229 @@
+/*
+ * tclUnixFCmd.c
+ *
+ *      This file implements the unix specific portion of file manipulation 
+ *      subcommands of the "file" command.  All filename arguments should
+ *	already be translated to native format.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixFCmd.c 1.29 97/06/16 16:28:25
+ *
+ * Portions of this code were derived from NetBSD source code which has
+ * the following copyright notice:
+ *
+ * Copyright (c) 1988, 1993, 1994
+ *      The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *      This product includes software developed by the University of
+ *      California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <utime.h>
+#include <grp.h>
+
+/*
+ * The following constants specify the type of callback when
+ * TraverseUnixTree() calls the traverseProc()
+ */
+
+#define DOTREE_PRED   1     /* pre-order directory  */
+#define DOTREE_POSTD  2     /* post-order directory */
+#define DOTREE_F      3     /* regular file */
+
+/*
+ * Callbacks for file attributes code.
+ */
+
+static int		GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetPermissionsAttribute _ANSI_ARGS_((
+			    Tcl_Interp *interp, int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+static int		SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+static int		SetPermissionsAttribute _ANSI_ARGS_((
+			    Tcl_Interp *interp, int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+			  
+/*
+ * Prototype for the TraverseUnixTree callback function.
+ */
+
+typedef int (TraversalProc) _ANSI_ARGS_((char *src, char *dst, 
+        struct stat *sb, int type, Tcl_DString *errorPtr));
+
+/*
+ * Constants and variables necessary for file attributes subcommand.
+ */
+
+enum {
+    UNIX_GROUP_ATTRIBUTE,
+    UNIX_OWNER_ATTRIBUTE,
+    UNIX_PERMISSIONS_ATTRIBUTE
+};
+
+char *tclpFileAttrStrings[] = {"-group", "-owner", "-permissions",
+	(char *) NULL};
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+	{GetGroupAttribute, SetGroupAttribute},
+	{GetOwnerAttribute, SetOwnerAttribute},
+	{GetPermissionsAttribute, SetPermissionsAttribute}};
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static int		CopyFile _ANSI_ARGS_((char *src, char *dst, 
+			    struct stat *srcStatBufPtr));
+static int		CopyFileAtts _ANSI_ARGS_((char *src, char *dst, 
+			    struct stat *srcStatBufPtr));
+static int		TraversalCopy _ANSI_ARGS_((char *src, char *dst, 
+			    struct stat *sbPtr, int type,
+			    Tcl_DString *errorPtr));
+static int		TraversalDelete _ANSI_ARGS_((char *src, char *dst, 
+			    struct stat *sbPtr, int type,
+			    Tcl_DString *errorPtr));
+static int		TraverseUnixTree _ANSI_ARGS_((
+			    TraversalProc *traversalProc,
+			    Tcl_DString *sourcePath, Tcl_DString *destPath,
+			    Tcl_DString *errorPtr));
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpRenameFile --
+ *
+ *      Changes the name of an existing file or directory, from src to dst.
+ *	If src and dst refer to the same file or directory, does nothing
+ *	and returns success.  Otherwise if dst already exists, it will be
+ *	deleted and replaced by src subject to the following conditions:
+ *	    If src is a directory, dst may be an empty directory.
+ *	    If src is a file, dst may be a file.
+ *	In any other situation where dst already exists, the rename will
+ *	fail.  
+ *
+ * Results:
+ *	If the directory was successfully created, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR and errno is set to
+ *	indicate the error.  Some possible values for errno are:
+ *
+ *	EACCES:     src or dst parent directory can't be read and/or written.
+ *	EEXIST:	    dst is a non-empty directory.
+ *	EINVAL:	    src is a root directory or dst is a subdirectory of src.
+ *	EISDIR:	    dst is a directory, but src is not.
+ *	ENOENT:	    src doesn't exist, or src or dst is "".
+ *	ENOTDIR:    src is a directory, but dst is not.  
+ *	EXDEV:	    src and dst are on different filesystems.
+ *	
+ * Side effects:
+ *	The implementation of rename may allow cross-filesystem renames,
+ *	but the caller should be prepared to emulate it with copy and
+ *	delete if errno is EXDEV.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpRenameFile(src, dst)
+    char *src;			/* Pathname of file or dir to be renamed. */
+    char *dst;			/* New pathname of file or directory. */
+{
+    if (rename(src, dst) == 0) {
+	return TCL_OK;
+    }
+    if (errno == ENOTEMPTY) {
+	errno = EEXIST;
+    }
+
+#ifdef sparc
+    /*
+     * SunOS 4.1.4 reports overwriting a non-empty directory with a
+     * directory as EINVAL instead of EEXIST (first rule out the correct
+     * EINVAL result code for moving a directory into itself).  Must be
+     * conditionally compiled because realpath() is only defined on SunOS.
+     */
+
+    if (errno == EINVAL) {
+	char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
+	DIR *dirPtr;
+	struct dirent *dirEntPtr;
+
+	if ((realpath(src, srcPath) != NULL)
+		&& (realpath(dst, dstPath) != NULL)
+		&& (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
+	    dirPtr = opendir(dst);
+	    if (dirPtr != NULL) {
+		while ((dirEntPtr = readdir(dirPtr)) != NULL) {
+		    if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
+			    (strcmp(dirEntPtr->d_name, "..") != 0)) {
+			errno = EEXIST;
+			closedir(dirPtr);
+			return TCL_ERROR;
+		    }
+		}
+		closedir(dirPtr);
+	    }
+	}
+	errno = EINVAL;
+    }
+#endif	/* sparc */
+
+    if (strcmp(src, "/") == 0) {
+	/*
+	 * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,
+	 * instead of EINVAL.
+	 */
+	 
+	errno = EINVAL;
+    }
+
+    /*
+     * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a
+     * file across filesystems and the parent directory of that file is
+     * not writable.  Most other systems return EXDEV.  Does nothing to
+     * correct this behavior.
+     */
+
+    return TCL_ERROR;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCopyFile --
+ *
+ *      Copy a single file (not a directory).  If dst already exists and
+ *	is not a directory, it is removed.
+ *
+ * Results:
+ *	If the file was successfully copied, returns TCL_OK.  Otherwise
+ *	the return value is TCL_ERROR and errno is set to indicate the
+ *	error.  Some possible values for errno are:
+ *
+ *	EACCES:     src or dst parent directory can't be read and/or written.
+ *	EISDIR:	    src or dst is a directory.
+ *	ENOENT:	    src doesn't exist.  src or dst is "".
+ *
+ * Side effects:
+ *      This procedure will also copy symbolic links, block, and
+ *      character devices, and fifos.  For symbolic links, the links 
+ *      themselves will be copied and not what they point to.  For the
+ *	other special file types, the directory entry will be copied and
+ *	not the contents of the device that it refers to.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int 
+TclpCopyFile(src, dst)
+    char *src;			/* Pathname of file to be copied. */
+    char *dst;			/* Pathname of file to copy to. */
+{
+    struct stat srcStatBuf, dstStatBuf;
+    char link[MAXPATHLEN];
+    int length;
+
+    /*
+     * Have to do a stat() to determine the filetype.
+     */
+    
+    if (lstat(src, &srcStatBuf) != 0) {
+	return TCL_ERROR;
+    }
+    if (S_ISDIR(srcStatBuf.st_mode)) {
+	errno = EISDIR;
+	return TCL_ERROR;
+    }
+
+    /*
+     * symlink, and some of the other calls will fail if the target 
+     * exists, so we remove it first
+     */
+    
+    if (lstat(dst, &dstStatBuf) == 0) {
+	if (S_ISDIR(dstStatBuf.st_mode)) {
+	    errno = EISDIR;
+	    return TCL_ERROR;
+	}
+    }
+    if (unlink(dst) != 0) {
+	if (errno != ENOENT) {
+	    return TCL_ERROR;
+	} 
+    }
+
+    switch ((int) (srcStatBuf.st_mode & S_IFMT)) {
+        case S_IFLNK:
+	    length = readlink(src, link, sizeof(link)); 
+	    if (length == -1) {
+		return TCL_ERROR;
+	    }
+	    link[length] = '\0';
+	    if (symlink(link, dst) < 0) {
+		return TCL_ERROR;
+	    }
+	    break;
+
+        case S_IFBLK:
+        case S_IFCHR:
+	    if (mknod(dst, srcStatBuf.st_mode, srcStatBuf.st_rdev) < 0) {
+		return TCL_ERROR;
+	    }
+	    return CopyFileAtts(src, dst, &srcStatBuf);
+
+        case S_IFIFO:
+	    if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
+		return TCL_ERROR;
+	    }
+	    return CopyFileAtts(src, dst, &srcStatBuf);
+
+        default:
+	    return CopyFile(src, dst, &srcStatBuf);
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyFile - 
+ *
+ *      Helper function for TclpCopyFile.  Copies one regular file,
+ *	using read() and write().
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *      A file is copied.  Dst will be overwritten if it exists.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int 
+CopyFile(src, dst, srcStatBufPtr) 
+    char *src;                   /* Pathname of file to copy. */
+    char *dst;                   /* Pathname of file to create/overwrite. */
+    struct stat *srcStatBufPtr;  /* Used to determine mode and blocksize */
+{
+    int srcFd;
+    int dstFd;
+    u_int blockSize;   /* Optimal I/O blocksize for filesystem */
+    char *buffer;      /* Data buffer for copy */
+    size_t nread;
+
+    if ((srcFd = open(src, O_RDONLY, 0)) < 0) { 
+	return TCL_ERROR;
+    }
+
+    dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, srcStatBufPtr->st_mode);
+    if (dstFd < 0) {
+	close(srcFd); 
+	return TCL_ERROR;
+    }
+
+    blockSize = srcStatBufPtr->st_blksize;
+    buffer = ckalloc(blockSize);
+    while (1) {
+	nread = read(srcFd, buffer, blockSize);
+	if ((nread == -1) || (nread == 0)) {
+	    break;
+	}
+	if (write(dstFd, buffer, nread) != nread) {
+	    nread = (size_t) -1;
+	    break;
+	}
+    }
+	
+    ckfree(buffer);
+    close(srcFd);
+    if ((close(dstFd) != 0) || (nread == -1)) {
+	unlink(dst);
+	return TCL_ERROR;
+    }
+    if (CopyFileAtts(src, dst, srcStatBufPtr) == TCL_ERROR) {
+	/*
+	 * The copy succeeded, but setting the permissions failed, so be in
+	 * a consistent state, we remove the file that was created by the
+	 * copy.
+	 */
+
+	unlink(dst);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpDeleteFile --
+ *
+ *      Removes a single file (not a directory).
+ *
+ * Results:
+ *	If the file was successfully deleted, returns TCL_OK.  Otherwise
+ *	the return value is TCL_ERROR and errno is set to indicate the
+ *	error.  Some possible values for errno are:
+ *
+ *	EACCES:     a parent directory can't be read and/or written.
+ *	EISDIR:	    path is a directory.
+ *	ENOENT:	    path doesn't exist or is "".
+ *
+ * Side effects:
+ *      The file is deleted, even if it is read-only.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpDeleteFile(path) 
+    char *path;			/* Pathname of file to be removed. */
+{
+    if (unlink(path) != 0) {
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCreateDirectory --
+ *
+ *      Creates the specified directory.  All parent directories of the
+ *	specified directory must already exist.  The directory is
+ *	automatically created with permissions so that user can access
+ *	the new directory and create new files or subdirectories in it.
+ *
+ * Results:
+ *	If the directory was successfully created, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR and errno is set to
+ *	indicate the error.  Some possible values for errno are:
+ *
+ *	EACCES:     a parent directory can't be read and/or written.
+ *	EEXIST:	    path already exists.
+ *	ENOENT:	    a parent directory doesn't exist.
+ *
+ * Side effects:
+ *      A directory is created with the current umask, except that
+ *	permission for u+rwx will always be added.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpCreateDirectory(path)
+    char *path;			/* Pathname of directory to create. */
+{
+    mode_t mode;
+
+    mode = umask(0);
+    umask(mode);
+
+    /*
+     * umask return value is actually the inverse of the permissions.
+     */
+    
+    mode = (0777 & ~mode);
+
+    if (mkdir(path, mode | S_IRUSR | S_IWUSR | S_IXUSR) != 0) {
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCopyDirectory --
+ *
+ *      Recursively copies a directory.  The target directory dst must
+ *	not already exist.  Note that this function does not merge two
+ *	directory hierarchies, even if the target directory is an an
+ *	empty directory.
+ *
+ * Results:
+ *	If the directory was successfully copied, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR, errno is set to indicate
+ *	the error, and the pathname of the file that caused the error
+ *	is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
+ *	for a description of possible values for errno.
+ *
+ * Side effects:
+ *      An exact copy of the directory hierarchy src will be created
+ *	with the name dst.  If an error occurs, the error will
+ *      be returned immediately, and remaining files will not be
+ *	processed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpCopyDirectory(src, dst, errorPtr)
+    char *src;			/* Pathname of directory to be copied.  */
+    char *dst;			/* Pathname of target directory. */
+    Tcl_DString *errorPtr;	/* If non-NULL, initialized DString for
+				 * error reporting. */
+{
+    int result;
+    Tcl_DString srcBuffer;
+    Tcl_DString dstBuffer;
+
+    Tcl_DStringInit(&srcBuffer);
+    Tcl_DStringInit(&dstBuffer);
+    Tcl_DStringAppend(&srcBuffer, src, -1);
+    Tcl_DStringAppend(&dstBuffer, dst, -1);
+    result = TraverseUnixTree(TraversalCopy, &srcBuffer, &dstBuffer,
+	    errorPtr);
+    Tcl_DStringFree(&srcBuffer);
+    Tcl_DStringFree(&dstBuffer);
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpRemoveDirectory --
+ *
+ *	Removes directory (and its contents, if the recursive flag is set).
+ *
+ * Results:
+ *	If the directory was successfully removed, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR, errno is set to indicate
+ *	the error, and the pathname of the file that caused the error
+ *	is stored in errorPtr.  Some possible values for errno are:
+ *
+ *	EACCES:     path directory can't be read and/or written.
+ *	EEXIST:	    path is a non-empty directory.
+ *	EINVAL:	    path is a root directory.
+ *	ENOENT:	    path doesn't exist or is "".
+ * 	ENOTDIR:    path is not a directory.
+ *
+ * Side effects:
+ *	Directory removed.  If an error occurs, the error will be returned
+ *	immediately, and remaining files will not be deleted.
+ *
+ *---------------------------------------------------------------------------
+ */
+ 
+int
+TclpRemoveDirectory(path, recursive, errorPtr) 
+    char *path;			/* Pathname of directory to be removed. */
+    int recursive;		/* If non-zero, removes directories that
+				 * are nonempty.  Otherwise, will only remove
+				 * empty directories. */
+    Tcl_DString *errorPtr;	/* If non-NULL, initialized DString for
+				 * error reporting. */
+{
+    int result;
+    Tcl_DString buffer;
+
+    if (rmdir(path) == 0) {
+	return TCL_OK;
+    }
+    if (errno == ENOTEMPTY) {
+	errno = EEXIST;
+    }
+    if ((errno != EEXIST) || (recursive == 0)) {
+	if (errorPtr != NULL) {
+	    Tcl_DStringAppend(errorPtr, path, -1);
+	}
+	return TCL_ERROR;
+    }
+    
+    /*
+     * The directory is nonempty, but the recursive flag has been
+     * specified, so we recursively remove all the files in the directory.
+     */
+
+    Tcl_DStringInit(&buffer);
+    Tcl_DStringAppend(&buffer, path, -1);
+    result = TraverseUnixTree(TraversalDelete, &buffer, NULL, errorPtr);
+    Tcl_DStringFree(&buffer);
+    return result;
+}
+	
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TraverseUnixTree --
+ *
+ *      Traverse directory tree specified by sourcePtr, calling the function 
+ *	traverseProc for each file and directory encountered.  If destPtr 
+ *	is non-null, each of name in the sourcePtr directory is appended to 
+ *	the directory specified by destPtr and passed as the second argument 
+ *	to traverseProc() .
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      None caused by TraverseUnixTree, however the user specified 
+ *	traverseProc() may change state.  If an error occurs, the error will
+ *      be returned immediately, and remaining files will not be processed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int 
+TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
+    TraversalProc *traverseProc;/* Function to call for every file and
+				 * directory in source hierarchy. */
+    Tcl_DString *sourcePtr;	/* Pathname of source directory to be
+				 * traversed. */
+    Tcl_DString *targetPtr;	/* Pathname of directory to traverse in
+				 * parallel with source directory. */
+    Tcl_DString *errorPtr;	/* If non-NULL, an initialized DString for
+				 * error reporting. */
+{
+    struct stat statbuf;
+    char *source, *target, *errfile;
+    int result, sourceLen;
+    int targetLen = 0;		/* Initialization needed only to prevent
+				 * warning in gcc. */
+    struct dirent *dirp;
+    DIR *dp;
+
+    result = TCL_OK;
+    source = Tcl_DStringValue(sourcePtr);
+    if (targetPtr != NULL) {
+	target = Tcl_DStringValue(targetPtr);
+    } else {
+	target = NULL;
+    }
+
+    errfile = NULL;
+    if (lstat(source, &statbuf) != 0) {
+	errfile = source;
+	goto end;
+    }
+    if (!S_ISDIR(statbuf.st_mode)) {
+	/*
+	 * Process the regular file
+	 */
+
+	return (*traverseProc)(source, target, &statbuf, DOTREE_F, errorPtr);
+    }
+
+    dp = opendir(source);
+    if (dp == NULL) {
+	/* 
+	 * Can't read directory
+	 */
+
+	errfile = source;
+	goto end;
+    }
+    result = (*traverseProc)(source, target, &statbuf, DOTREE_PRED, errorPtr);
+    if (result != TCL_OK) {
+	closedir(dp);
+	return result;
+    }
+    
+    Tcl_DStringAppend(sourcePtr, "/", 1);
+    source = Tcl_DStringValue(sourcePtr);
+    sourceLen = Tcl_DStringLength(sourcePtr);	
+
+    if (targetPtr != NULL) {
+	Tcl_DStringAppend(targetPtr, "/", 1);
+	target = Tcl_DStringValue(targetPtr);
+	targetLen = Tcl_DStringLength(targetPtr);
+    }
+				  
+    while ((dirp = readdir(dp)) != NULL) {
+	if ((strcmp(dirp->d_name, ".") == 0)
+	        || (strcmp(dirp->d_name, "..") == 0)) {
+	    continue;
+	}
+
+	/* 
+	 * Append name after slash, and recurse on the file.
+	 */
+
+	Tcl_DStringAppend(sourcePtr, dirp->d_name, -1);
+	if (targetPtr != NULL) {
+	    Tcl_DStringAppend(targetPtr, dirp->d_name, -1);
+	}
+	result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
+		errorPtr);
+	if (result != TCL_OK) {
+	    break;
+	}
+	
+	/*
+	 * Remove name after slash.
+	 */
+
+	Tcl_DStringSetLength(sourcePtr, sourceLen);
+	if (targetPtr != NULL) {
+	    Tcl_DStringSetLength(targetPtr, targetLen);
+	}
+    }
+    closedir(dp);
+    
+    /*
+     * Strip off the trailing slash we added
+     */
+
+    Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
+    source = Tcl_DStringValue(sourcePtr);
+    if (targetPtr != NULL) {
+	Tcl_DStringSetLength(targetPtr, targetLen - 1);
+	target = Tcl_DStringValue(targetPtr);
+    }
+
+    if (result == TCL_OK) {
+	/*
+	 * Call traverseProc() on a directory after visiting all the
+	 * files in that directory.
+	 */
+
+	result = (*traverseProc)(source, target, &statbuf, DOTREE_POSTD,
+		errorPtr);
+    }
+    end:
+    if (errfile != NULL) {
+	if (errorPtr != NULL) {
+	    Tcl_DStringAppend(errorPtr, errfile, -1);
+	}
+	result = TCL_ERROR;
+    }
+	    
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraversalCopy
+ *
+ *      Called from TraverseUnixTree in order to execute a recursive copy of a 
+ *      directory. 
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      The file or directory src may be copied to dst, depending on 
+ *      the value of type.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int 
+TraversalCopy(src, dst, sbPtr, type, errorPtr) 
+    char *src;			/* Source pathname to copy. */
+    char *dst;                  /* Destination pathname of copy. */
+    struct stat *sbPtr;		/* Stat info for file specified by src. */
+    int type;                   /* Reason for call - see TraverseUnixTree(). */
+    Tcl_DString *errorPtr;	/* If non-NULL, initialized DString for
+				 * error return. */
+{
+    switch (type) {
+	case DOTREE_F:
+	    if (TclpCopyFile(src, dst) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+	case DOTREE_PRED:
+	    if (TclpCreateDirectory(dst) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+	case DOTREE_POSTD:
+	    if (CopyFileAtts(src, dst, sbPtr) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+    }
+
+    /*
+     * There shouldn't be a problem with src, because we already
+     * checked it to get here.
+     */
+
+    if (errorPtr != NULL) {
+	Tcl_DStringAppend(errorPtr, dst, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TraversalDelete --
+ *
+ *      Called by procedure TraverseUnixTree for every file and directory
+ *	that it encounters in a directory hierarchy. This procedure unlinks
+ *      files, and removes directories after all the containing files 
+ *      have been processed.
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      Files or directory specified by src will be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraversalDelete(src, ignore, sbPtr, type, errorPtr) 
+    char *src;			/* Source pathname. */
+    char *ignore;		/* Destination pathname (not used). */
+    struct stat *sbPtr;		/* Stat info for file specified by src. */
+    int type;                   /* Reason for call - see TraverseUnixTree(). */
+    Tcl_DString *errorPtr;	/* If non-NULL, initialized DString for
+				 * error return. */
+{
+    switch (type) {
+        case DOTREE_F:
+	    if (unlink(src) == 0) {
+		return TCL_OK;
+	    }
+	    break;
+
+        case DOTREE_PRED:
+	    return TCL_OK;
+
+        case DOTREE_POSTD:
+	    if (rmdir(src) == 0) {
+		return TCL_OK;
+	    }
+	    break;
+	    
+    }
+
+    if (errorPtr != NULL) {
+	Tcl_DStringAppend(errorPtr, src, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyFileAtts
+ *
+ *      Copy the file attributes such as owner, group, permissions, and
+ *      modification date from one file to another.
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      user id, group id, permission bits, last modification time, and 
+ *      last access time are updated in the new file to reflect the old
+ *      file.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyFileAtts(src, dst, statBufPtr) 
+    char *src;                 /* Path name of source file */
+    char *dst;                 /* Path name of target file */
+    struct stat *statBufPtr;   /* ptr to stat info for source file */
+{
+    struct utimbuf tval;
+    mode_t newMode;
+    
+    newMode = statBufPtr->st_mode
+	    & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);
+	
+    /* 
+     * Note that if you copy a setuid file that is owned by someone
+     * else, and you are not root, then the copy will be setuid to you.
+     * The most correct implementation would probably be to have the
+     * copy not setuid to anyone if the original file was owned by 
+     * someone else, but this corner case isn't currently handled.
+     * It would require another lstat(), or getuid().
+     */
+    
+    if (chmod(dst, newMode)) {
+	newMode &= ~(S_ISUID | S_ISGID);
+	if (chmod(dst, newMode)) {
+	    return TCL_ERROR;
+	}
+    }
+
+    tval.actime = statBufPtr->st_atime; 
+    tval.modtime = statBufPtr->st_mtime; 
+
+    if (utime(dst, &tval)) {
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetGroupAttribute
+ *
+ *      Gets the group attribute of a file.
+ *
+ * Results:
+ *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ *	if there is no error.
+ *
+ * Side effects:
+ *      A new object is allocated.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr)
+    Tcl_Interp *interp;		/* The interp we are using for errors. */
+    int objIndex;		/* The index of the attribute. */
+    char *fileName;		/* The name of the file. */
+    Tcl_Obj **attributePtrPtr;	/* A pointer to return the object with. */
+{
+    struct stat statBuf;
+    struct group *groupPtr;
+
+    if (stat(fileName, &statBuf) != 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not stat file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    groupPtr = getgrgid(statBuf.st_gid);
+    if (groupPtr == NULL) {
+	endgrent();
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not get group for file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    *attributePtrPtr = Tcl_NewStringObj(groupPtr->gr_name, -1);
+    endgrent();
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOwnerAttribute
+ *
+ *      Gets the owner attribute of a file.
+ *
+ * Results:
+ *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ *	if there is no error.
+ *
+ * Side effects:
+ *      A new object is allocated.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr)
+    Tcl_Interp *interp;		/* The interp we are using for errors. */
+    int objIndex;		/* The index of the attribute. */
+    char *fileName;		/* The name of the file. */
+    Tcl_Obj **attributePtrPtr;	/* A pointer to return the object with. */
+{
+    struct stat statBuf;
+    struct passwd *pwPtr;
+
+    if (stat(fileName, &statBuf) != 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not stat file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    pwPtr = getpwuid(statBuf.st_uid);
+    if (pwPtr == NULL) {
+	endpwent();
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not get owner for file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    *attributePtrPtr = Tcl_NewStringObj(pwPtr->pw_name, -1);
+    endpwent();
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetPermissionsAttribute
+ *
+ *      Gets the group attribute of a file.
+ *
+ * Results:
+ *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ *	if there is no error. The object will have ref count 0.
+ *
+ * Side effects:
+ *      A new object is allocated.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
+    Tcl_Interp *interp;		    /* The interp we are using for errors. */
+    int objIndex;		    /* The index of the attribute. */
+    char *fileName;		    /* The name of the file. */
+    Tcl_Obj **attributePtrPtr;	    /* A pointer to return the object with. */
+{
+    struct stat statBuf;
+    char returnString[6];
+
+    if (stat(fileName, &statBuf) != 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not stat file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    sprintf(returnString, "%0#5lo", (statBuf.st_mode & 0x00007FFF));
+
+    *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetGroupAttribute
+ *
+ *      Sets the file to the given group.
+ *
+ * Results:
+ *      Standard TCL result.
+ *
+ * Side effects:
+ *      The group of the file is changed.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetGroupAttribute(interp, objIndex, fileName, attributePtr)
+    Tcl_Interp *interp;		    /* The interp we are using for errors. */
+    int objIndex;		    /* The index of the attribute. */
+    char *fileName;		    /* The name of the file. */
+    Tcl_Obj *attributePtr;	    /* The attribute to set. */
+{
+    gid_t groupNumber;
+    long placeHolder;
+
+    if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
+	struct group *groupPtr;
+	char *groupString = Tcl_GetStringFromObj(attributePtr, NULL);
+
+	Tcl_ResetResult(interp);
+	groupPtr = getgrnam(groupString);
+	if (groupPtr == NULL) {
+	    endgrent();
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "could not set group for file \"", fileName,
+		    "\": group \"", groupString, "\" does not exist",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	groupNumber = groupPtr->gr_gid;
+    } else {
+	groupNumber = (gid_t) placeHolder;
+    }
+
+    if (chown(fileName, -1, groupNumber) != 0) {
+	endgrent();
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not set group for file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }    
+    endgrent();
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOwnerAttribute
+ *
+ *      Sets the file to the given owner.
+ *
+ * Results:
+ *      Standard TCL result.
+ *
+ * Side effects:
+ *      The group of the file is changed.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
+    Tcl_Interp *interp;		    /* The interp we are using for errors. */
+    int objIndex;		    /* The index of the attribute. */
+    char *fileName;		    /* The name of the file. */
+    Tcl_Obj *attributePtr;	    /* The attribute to set. */
+{
+    uid_t userNumber;
+    long placeHolder;
+
+    if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
+	struct passwd *pwPtr;
+	char *ownerString = Tcl_GetStringFromObj(attributePtr, NULL);
+
+	Tcl_ResetResult(interp);
+	pwPtr = getpwnam(ownerString);
+	if (pwPtr == NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "could not set owner for file \"", fileName,
+		    "\": user \"", ownerString, "\" does not exist",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	userNumber = pwPtr->pw_uid;
+    } else {
+	userNumber = (uid_t) placeHolder;
+    }
+
+    if (chown(fileName, userNumber, -1) != 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not set owner for file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }    
+	
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetPermissionsAttribute
+ *
+ *      Sets the file to the given group.
+ *
+ * Results:
+ *      Standard TCL result.
+ *
+ * Side effects:
+ *      The group of the file is changed.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
+    Tcl_Interp *interp;		    /* The interp we are using for errors. */
+    int objIndex;		    /* The index of the attribute. */
+    char *fileName;		    /* The name of the file. */
+    Tcl_Obj *attributePtr;	    /* The attribute to set. */
+{
+    long modeInt;
+    mode_t newMode;
+
+    /*
+     * mode_t is a long under SPARC; an int under SunOS. Since we do not
+     * know how big it really is, we get the long and then cast it
+     * down to a mode_t.
+     */
+    
+    if (Tcl_GetLongFromObj(interp, attributePtr, &modeInt)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    newMode = (mode_t) modeInt;
+
+    if (chmod(fileName, newMode) != 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not set permissions for file \"", fileName, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpListVolumes --
+ *
+ *	Lists the currently mounted volumes, which on UNIX is just /.
+ *
+ * Results:
+ *	A standard Tcl result.  Will always be TCL_OK, since there is no way
+ *	that this command can fail.  Also, the interpreter's result is set to 
+ *	the list of volumes.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpListVolumes(interp)
+    Tcl_Interp *interp;			/* Interpreter to which to pass
+					 * the volume list. */
+{
+    Tcl_Obj *resultPtr;
+    
+    resultPtr = Tcl_GetObjResult(interp);
+    Tcl_SetStringObj(resultPtr, "/", 1);
+    return TCL_OK;	
+}
+
diff --git a/contrib/tcl/unix/tclUnixFile.c b/contrib/tcl/unix/tclUnixFile.c
index cebd43b..3819ed5 100644
--- a/contrib/tcl/unix/tclUnixFile.c
+++ b/contrib/tcl/unix/tclUnixFile.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixFile.c 1.38 96/04/18 08:43:51
+ * SCCS: @(#) tclUnixFile.c 1.45 97/05/14 13:24:19
  */
 
 #include "tclInt.h"
@@ -43,40 +43,6 @@ static void	FreeExecutableName _ANSI_ARGS_((ClientData clientData));
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_WaitPid --
- *
- *	Implements the waitpid system call on Unix systems.
- *
- * Results:
- *	Result of calling waitpid.
- *
- * Side effects:
- *	Waits for a process to terminate.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_WaitPid(pid, statPtr, options)
-    int pid;
-    int *statPtr;
-    int options;
-{
-    int result;
-    pid_t real_pid;
-
-    real_pid = (pid_t) pid;
-    while (1) {
-	result = (int) waitpid(real_pid, statPtr, options);
-	if ((result != -1) || (errno != EINTR)) {
-	    return result;
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * FreeCurrentDir --
  *
  *	Frees the string stored in the currentDir variable. This routine
@@ -99,6 +65,7 @@ FreeCurrentDir(clientData)
     if (currentDir != (char *) NULL) {
         ckfree(currentDir);
         currentDir = (char *) NULL;
+        currentDirExitHandlerSet = 0;
     }
 }
 
@@ -205,7 +172,9 @@ TclGetCwd(interp)
 	if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
 	    if (interp != NULL) {
 		if (errno == ERANGE) {
-		    interp->result = "working directory name is too long";
+		    Tcl_SetResult(interp,
+			    "working directory name is too long",
+		            TCL_STATIC);
 		} else {
 		    Tcl_AppendResult(interp,
 			    "error getting working directory name: ",
@@ -223,227 +192,6 @@ TclGetCwd(interp)
 /*
  *----------------------------------------------------------------------
  *
- * TclOpenFile --
- *
- *	Implements a mechanism to open files on Unix systems.
- *
- * Results:
- *	The opened file.
- *
- * Side effects:
- *	May cause a file to be created on the file system.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_File
-TclOpenFile(fname, mode)
-    char *fname;			/* The name of the file to open. */
-    int mode;				/* In what mode to open the file? */
-{
-    int fd;
-
-    fd = open(fname, mode, 0600);
-    if (fd != -1) {
-        fcntl(fd, F_SETFD, FD_CLOEXEC);
-        return Tcl_GetFile((ClientData)fd, TCL_UNIX_FD);
-    }
-    return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCloseFile --
- *
- *	Implements a mechanism to close a UNIX file.
- *
- * Results:
- *	Returns 0 on success, or -1 on error, setting errno.
- *
- * Side effects:
- *	The file is closed.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCloseFile(file)
-    Tcl_File file;	/* The file to close. */
-{
-    int type;
-    int fd;
-    int result;
-
-    fd = (int) Tcl_GetFileInfo(file, &type);
-    if (type != TCL_UNIX_FD) {
-	panic("Tcl_CloseFile: unexpected file type");
-    }
-
-    /*
-     * Refuse to close the fds for stdin, stdout and stderr.
-     */
-    
-    if ((fd == 0) || (fd == 1) || (fd == 2)) {
-        return 0;
-    }
-    
-    result = close(fd);
-    Tcl_DeleteFileHandler(file);
-    Tcl_FreeFile(file);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclReadFile --
- *
- *	Implements a mechanism to read from files on Unix systems. Also
- *	simulates blocking behavior on non-blocking files when asked to.
- *
- * Results:
- *	The number of characters read from the specified file.
- *
- * Side effects:
- *	May consume characters from the file.
- *
- *----------------------------------------------------------------------
- */
-	/* ARGSUSED */
-int
-TclReadFile(file, shouldBlock, buf, toRead)
-    Tcl_File file;	/* The file to read from. */
-    int shouldBlock;		/* Not used. */
-    char *buf;			/* The buffer to store input in. */
-    int toRead;			/* Number of characters to read. */
-{
-    int type, fd;
-
-    fd = (int) Tcl_GetFileInfo(file, &type);
-    if (type != TCL_UNIX_FD) {
-	panic("Tcl_ReadFile: unexpected file type");
-    }
-
-    return read(fd, buf, (size_t) toRead);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWriteFile --
- *
- *	Implements a mechanism to write to files on Unix systems.
- *
- * Results:
- *	The number of characters written to the specified file.
- *
- * Side effects:
- *	May produce characters on the file.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-TclWriteFile(file, shouldBlock, buf, toWrite)
-    Tcl_File file;	/* The file to write to. */
-    int shouldBlock;		/* Not used. */
-    char *buf;			/* Where output is stored. */
-    int toWrite;		/* Number of characters to write. */
-{
-    int type, fd;
-
-    fd = (int) Tcl_GetFileInfo(file, &type);
-    if (type != TCL_UNIX_FD) {
-	panic("Tcl_WriteFile: unexpected file type");
-    }
-    return write(fd, buf, (size_t) toWrite);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSeekFile --
- *
- *	Sets the file pointer on the indicated UNIX file.
- *
- * Results:
- *	The new position at which the file will be accessed, or -1 on
- *	failure.
- *
- * Side effects:
- *	May change the position at which subsequent operations access the
- *	file designated by the file.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclSeekFile(file, offset, whence)
-    Tcl_File file;	/* The file to seek on. */
-    int offset;			/* How far to seek? */
-    int whence;			/* And from where to seek? */
-{
-    int type, fd;
-
-    fd = (int) Tcl_GetFileInfo(file, &type);
-    if (type != TCL_UNIX_FD) {
-	panic("Tcl_SeekFile: unexpected file type");
-    }
-
-    return lseek(fd, offset, whence);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCreateTempFile --
- *
- *	This function creates a temporary file initialized with an
- *	optional string, and returns a file handle with the file pointer
- *	at the beginning of the file.
- *
- * Results:
- *	A handle to a file.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_File
-TclCreateTempFile(contents)
-    char *contents;		/* String to write into temp file, or NULL. */
-{
-    char fileName[L_tmpnam];
-    Tcl_File file;
-    size_t length = (contents == NULL) ? 0 : strlen(contents);
-
-    tmpnam(fileName);
-    file = TclOpenFile(fileName, O_RDWR|O_CREAT|O_TRUNC);
-    unlink(fileName);
-
-    if ((file != NULL) && (length > 0)) {
-	int fd = (int)Tcl_GetFileInfo(file, NULL);
-	while (1) {
-	    if (write(fd, contents, length) != -1) {
-		break;
-	    } else if (errno != EINTR) {
-		close(fd);
-		Tcl_FreeFile(file);
-		return NULL;
-	    }
-	}
-	lseek(fd, 0, SEEK_SET);
-    }
-    return file;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_FindExecutable --
  *
  *	This procedure computes the absolute path name of the current
@@ -467,6 +215,7 @@ Tcl_FindExecutable(argv0)
     char *name, *p, *cwd;
     Tcl_DString buffer;
     int length;
+    struct stat statBuf;
 
     Tcl_DStringInit(&buffer);
     if (tclExecutableName != NULL) {
@@ -518,7 +267,9 @@ Tcl_FindExecutable(argv0)
 	    }
 	}
 	Tcl_DStringAppend(&buffer, argv0, -1);
-	if (access(Tcl_DStringValue(&buffer), X_OK) == 0) {
+	if ((access(Tcl_DStringValue(&buffer), X_OK) == 0)
+		&& (stat(Tcl_DStringValue(&buffer), &statBuf) == 0)
+		&& S_ISREG(statBuf.st_mode)) {
 	    name = Tcl_DStringValue(&buffer);
 	    goto gotName;
 	}
@@ -626,7 +377,8 @@ TclGetUserHome(name, bufferPtr)
  * Side effects:
  *	None.
  *
- *---------------------------------------------------------------------- */
+ *----------------------------------------------------------------------
+ */
 
 int
 TclMatchFiles(interp, separators, dirPtr, pattern, tail)
diff --git a/contrib/tcl/unix/tclUnixInit.c b/contrib/tcl/unix/tclUnixInit.c
index a7206b6..930568b 100644
--- a/contrib/tcl/unix/tclUnixInit.c
+++ b/contrib/tcl/unix/tclUnixInit.c
@@ -8,14 +8,11 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixInit.c 1.14 96/07/10 15:45:24
+ * SCCS: @(#) tclUnixInit.c 1.25 97/06/24 17:28:56
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
-#ifndef NO_UNAME
-#   include <sys/utsname.h>
-#endif
 #if defined(__FreeBSD__)
 #   include <floatingpoint.h>
 #endif
@@ -27,12 +24,27 @@
 #endif
 
 /*
- * Default directory in which to look for libraries:
+ * Default directory in which to look for Tcl library scripts.  The
+ * symbol is defined by Makefile.
  */
 
 static char defaultLibraryDir[200] = TCL_LIBRARY;
 
 /*
+ * Directory in which to look for packages (each package is typically
+ * installed as a subdirectory of this directory).  The symbol is
+ * defined by Makefile.
+ */
+
+static char pkgPath[200] = TCL_PACKAGE_PATH;
+
+/*
+ * Is this module initialized?
+ */
+
+static int initialized = 0;
+
+/*
  * The following string is the startup script executed in new
  * interpreters.  It looks on disk in several different directories
  * for a script "init.tcl" that is compatible with this version
@@ -41,9 +53,11 @@ static char defaultLibraryDir[200] = TCL_LIBRARY;
  */
 
 static char initScript[] =
-"proc init {} {\n\
-    global tcl_library tcl_version tcl_patchLevel env\n\
-    rename init {}\n\
+"proc tclInit {} {\n\
+    global tcl_library tcl_version tcl_patchLevel env errorInfo\n\
+    global tcl_pkgPath\n\
+    rename tclInit {}\n\
+    set errors {}\n\
     set dirs {}\n\
     if [info exists env(TCL_LIBRARY)] {\n\
 	lappend dirs $env(TCL_LIBRARY)\n\
@@ -60,16 +74,54 @@ static char initScript[] =
     lappend dirs $parentDir/library\n\
     foreach i $dirs {\n\
 	set tcl_library $i\n\
-	if ![catch {uplevel #0 source $i/init.tcl}] {\n\
-	    return\n\
+	if {[file exists $i/init.tcl]} {\n\
+            lappend tcl_pkgPath [file dirname $i]\n\
+	    if ![catch {uplevel #0 source $i/init.tcl} msg] {\n\
+		return\n\
+	    } else {\n\
+		append errors \"$i/init.tcl: $msg\n$errorInfo\n\"\n\
+	    }\n\
 	}\n\
     }\n\
     set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
-    append msg \"    $dirs\n\"\n\
+    append msg \"    $dirs\n\n\"\n\
+    append msg \"$errors\n\n\"\n\
     append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
     error $msg\n\
 }\n\
-init";
+tclInit";
+
+/*
+ * Static routines in this file:
+ */
+
+static void	PlatformInitExitHandler _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformInitExitHandler --
+ *
+ *	Uninitializes all values on unload, so that this module can
+ *	be later reinitialized.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Returns the module to uninitialized state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PlatformInitExitHandler(clientData)
+    ClientData clientData;		/* Unused. */
+{
+    strcpy(defaultLibraryDir, TCL_LIBRARY);
+    strcpy(pkgPath, TCL_PACKAGE_PATH);
+    initialized = 0;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -97,10 +149,10 @@ TclPlatformInit(interp)
     struct utsname name;
 #endif
     int unameOK;
-    static int initialized = 0;
 
     tclPlatform = TCL_PLATFORM_UNIX;
     Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
     Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
     unameOK = 0;
 #ifndef NO_UNAME
@@ -108,8 +160,25 @@ TclPlatformInit(interp)
 	unameOK = 1;
 	Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
 		TCL_GLOBAL_ONLY);
-	Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
-		TCL_GLOBAL_ONLY);
+	/*
+	 * The following code is a special hack to handle differences in
+	 * the way version information is returned by uname.  On most
+	 * systems the full version number is available in name.release.
+	 * However, under AIX the major version number is in
+	 * name.version and the minor version number is in name.release.
+	 */
+
+	if ((strchr(name.release, '.') != NULL) || !isdigit(name.version[0])) {
+	    Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
+		    TCL_GLOBAL_ONLY);
+	} else {
+	    Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
+		    TCL_GLOBAL_ONLY);
+	    Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
+		    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
+	    Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
+		    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
+	}
 	Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
 		TCL_GLOBAL_ONLY);
     }
@@ -121,6 +190,14 @@ TclPlatformInit(interp)
     }
 
     if (!initialized) {
+
+        /*
+         * Create an exit handler so that uninitialization will be done
+         * on unload.
+         */
+        
+        Tcl_CreateExitHandler(PlatformInitExitHandler, NULL);
+        
 	/*
 	 * The code below causes SIGPIPE (broken pipe) errors to
 	 * be ignored.  This is needed so that Tcl processes don't
@@ -175,3 +252,65 @@ Tcl_Init(interp)
 {
     return Tcl_Eval(interp, initScript);
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SourceRCFile --
+ *
+ *	This procedure is typically invoked by Tcl_Main of Tk_Main
+ *	procedure to source an application specific rc file into the
+ *	interpreter at startup time.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on what's in the rc script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SourceRCFile(interp)
+    Tcl_Interp *interp;		/* Interpreter to source rc file into. */
+{
+    Tcl_DString temp;
+    char *fileName;
+    Tcl_Channel errChannel;
+
+    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
+
+    if (fileName != NULL) {
+        Tcl_Channel c;
+	char *fullName;
+
+        Tcl_DStringInit(&temp);
+	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
+	if (fullName == NULL) {
+	    /*
+	     * Couldn't translate the file name (e.g. it referred to a
+	     * bogus user or there was no HOME environment variable).
+	     * Just do nothing.
+	     */
+	} else {
+
+	    /*
+	     * Test for the existence of the rc file before trying to read it.
+	     */
+
+            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
+            if (c != (Tcl_Channel) NULL) {
+                Tcl_Close(NULL, c);
+		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
+		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+		    if (errChannel) {
+			Tcl_Write(errChannel, interp->result, -1);
+			Tcl_Write(errChannel, "\n", 1);
+		    }
+		}
+	    }
+	}
+        Tcl_DStringFree(&temp);
+    }
+}
diff --git a/contrib/tcl/unix/tclUnixNotfy.c b/contrib/tcl/unix/tclUnixNotfy.c
index 7dce634..74c0ffc 100644
--- a/contrib/tcl/unix/tclUnixNotfy.c
+++ b/contrib/tcl/unix/tclUnixNotfy.c
@@ -1,16 +1,17 @@
-/* 
+/*
  * tclUnixNotify.c --
  *
- *	This file contains Unix-specific procedures for the notifier,
- *	which is the lowest-level part of the Tcl event loop.  This file
- *	works together with ../generic/tclNotify.c.
+ *	This file contains the implementation of the select-based
+ *	Unix-specific notifier, which is the lowest-level part of the
+ *	Tcl event loop.  This file works together with
+ *	../generic/tclNotify.c.
  *
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixNotfy.c 1.31 96/07/23 16:17:29
+ * SCCS: @(#) tclUnixNotfy.c 1.41 97/06/02 16:45:24
  */
 
 #include "tclInt.h"
@@ -18,176 +19,393 @@
 #include <signal.h> 
 
 /*
- * The information below is used to provide read, write, and
- * exception masks to select during calls to Tcl_DoOneEvent.
+ * This structure is used to keep track of the notifier info for a 
+ * a registered file.
+ */
+
+typedef struct FileHandler {
+    int fd;
+    int mask;			/* Mask of desired events: TCL_READABLE,
+				 * etc. */
+    int readyMask;		/* Mask of events that have been seen since the
+				 * last time file handlers were invoked for
+				 * this file. */
+    Tcl_FileProc *proc;		/* Procedure to call, in the style of
+				 * Tcl_CreateFileHandler. */
+    ClientData clientData;	/* Argument to pass to proc. */
+    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+} FileHandler;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file handlers are ready to fire.
  */
 
-static fd_mask checkMasks[3*MASK_SIZE];
+typedef struct FileHandlerEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    int fd;			/* File descriptor that is ready.  Used
+				 * to find the FileHandler structure for
+				 * the file (can't point directly to the
+				 * FileHandler structure because it could
+				 * go away while the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * select based implementation of the Tcl notifier.
+ */
+
+static struct {
+    FileHandler *firstFileHandlerPtr;
+				/* Pointer to head of file handler list. */
+    fd_mask checkMasks[3*MASK_SIZE];
 				/* This array is used to build up the masks
 				 * to be used in the next call to select.
 				 * Bits are set in response to calls to
-				 * Tcl_WatchFile. */
-static fd_mask readyMasks[3*MASK_SIZE];
+				 * Tcl_CreateFileHandler. */
+    fd_mask readyMasks[3*MASK_SIZE];
 				/* This array reflects the readable/writable
 				 * conditions that were found to exist by the
 				 * last call to select. */
-static int numFdBits;		/* Number of valid bits in checkMasks
+    int numFdBits;		/* Number of valid bits in checkMasks
 				 * (one more than highest fd for which
 				 * Tcl_WatchFile has been called). */
+} notifier;
+
+/*
+ * The following static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * Static routines defined in this file.
+ */
+
+static void		InitNotifier _ANSI_ARGS_((void));
+static void		NotifierExitHandler _ANSI_ARGS_((
+			    ClientData clientData));
+static int		FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+			    int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ *	Initializes the notifier state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new exit handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitNotifier()
+{
+    initialized = 1;
+    memset(&notifier, 0, sizeof(notifier));
+    Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierExitHandler --
+ *
+ *	This function is called to cleanup the notifier state before
+ *	Tcl is unloaded.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Destroys the notifier window.
+ *
+ *----------------------------------------------------------------------
+ */
 
+static void
+NotifierExitHandler(clientData)
+    ClientData clientData;		/* Not used. */
+{
+    initialized = 0;
+}
+
 /*
- * Static routines in this file:
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ *	This procedure sets the current notifier timer value.  This
+ *	interface is not implemented in this notifier because we are
+ *	always running inside of Tcl_DoOneEvent.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
  */
 
-static int	MaskEmpty _ANSI_ARGS_((long *maskPtr));
+void
+Tcl_SetTimer(timePtr)
+    Tcl_Time *timePtr;		/* Timeout value, may be NULL. */
+{
+    /*
+     * The interval timer doesn't do anything in this implementation,
+     * because the only event loop is via Tcl_DoOneEvent, which passes
+     * timeout values to Tcl_WaitForEvent.
+     */
+}
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_WatchFile --
+ * Tcl_CreateFileHandler --
  *
- *	Arrange for Tcl_DoOneEvent to include this file in the masks
- *	for the next call to select.  This procedure is invoked by
- *	event sources, which are in turn invoked by Tcl_DoOneEvent
- *	before it invokes select.
+ *	This procedure registers a file handler with the Xt notifier.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	
- *	The notifier will generate a file event when the I/O channel
- *	given by fd next becomes ready in the way indicated by mask.
- *	If fd is already registered then the old mask will be replaced
- *	with the new one.  Once the event is sent, the notifier will
- *	not send any more events about the fd until the next call to
- *	Tcl_NotifyFile. 
+ *	Creates a new file handler structure and registers one or more
+ *	input procedures with Xt.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_WatchFile(file, mask)
-    Tcl_File file;	/* Generic file handle for a stream. */
+Tcl_CreateFileHandler(fd, mask, proc, clientData)
+    int fd;			/* Handle of stream to watch. */
     int mask;			/* OR'ed combination of TCL_READABLE,
 				 * TCL_WRITABLE, and TCL_EXCEPTION:
-				 * indicates conditions to wait for
-				 * in select. */
+				 * indicates conditions under which
+				 * proc should be called. */
+    Tcl_FileProc *proc;		/* Procedure to call for each
+				 * selected event. */
+    ClientData clientData;	/* Arbitrary data to pass to proc. */
 {
-    int fd, type, index;
-    fd_mask bit;
-
-    fd = (int) Tcl_GetFileInfo(file, &type);
-
-    if (type != TCL_UNIX_FD) {
-	panic("Tcl_WatchFile: unexpected file type");
+    FileHandler *filePtr;
+    int index, bit;
+    
+    if (!initialized) {
+	InitNotifier();
     }
 
-    if (fd >= FD_SETSIZE) {
-	panic("Tcl_WatchFile can't handle file id %d", fd);
+    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+	    filePtr = filePtr->nextPtr) {
+	if (filePtr->fd == fd) {
+	    break;
+	}
+    }
+    if (filePtr == NULL) {
+	filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+	filePtr->fd = fd;
+	filePtr->readyMask = 0;
+	filePtr->nextPtr = notifier.firstFileHandlerPtr;
+	notifier.firstFileHandlerPtr = filePtr;
     }
+    filePtr->proc = proc;
+    filePtr->clientData = clientData;
+    filePtr->mask = mask;
+
+    /*
+     * Update the check masks for this file.
+     */
 
     index = fd/(NBBY*sizeof(fd_mask));
     bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
     if (mask & TCL_READABLE) {
-	checkMasks[index] |= bit;
-    }
+	notifier.checkMasks[index] |= bit;
+    } else {
+	notifier.checkMasks[index] &= ~bit;
+    } 
     if (mask & TCL_WRITABLE) {
-	(checkMasks+MASK_SIZE)[index] |= bit;
+	(notifier.checkMasks+MASK_SIZE)[index] |= bit;
+    } else {
+	(notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
     }
     if (mask & TCL_EXCEPTION) {
-	(checkMasks+2*(MASK_SIZE))[index] |= bit;
+	(notifier.checkMasks+2*(MASK_SIZE))[index] |= bit;
+    } else {
+	(notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
     }
-    if (numFdBits <= fd) {
-	numFdBits = fd+1;
+    if (notifier.numFdBits <= fd) {
+	notifier.numFdBits = fd+1;
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FileReady --
+ * Tcl_DeleteFileHandler --
  *
- *	Indicates what conditions (readable, writable, etc.) were
- *	present on a file the last time the notifier invoked select.
- *	This procedure is typically invoked by event sources to see
- *	if they should queue events.
+ *	Cancel a previously-arranged callback arrangement for
+ *	a file.
  *
  * Results:
- *	The return value is 0 if none of the conditions specified by mask
- *	was true for fd the last time the system checked.  If any of the
- *	conditions were true, then the return value is a mask of those
- *	that were true.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	If a callback was previously registered on file, remove it.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_FileReady(file, mask)
-    Tcl_File file;	/* Generic file handle for a stream. */
-    int mask;			/* OR'ed combination of TCL_READABLE,
-				 * TCL_WRITABLE, and TCL_EXCEPTION:
-				 * indicates conditions caller cares about. */
+void
+Tcl_DeleteFileHandler(fd)
+    int fd;		/* Stream id for which to remove callback procedure. */
 {
-    int index, result, type, fd;
-    fd_mask bit;
+    FileHandler *filePtr, *prevPtr;
+    int index, bit, mask, i;
+
+    if (!initialized) {
+	InitNotifier();
+    }
 
-    fd = (int) Tcl_GetFileInfo(file, &type);
-    if (type != TCL_UNIX_FD) {
-	panic("Tcl_FileReady: unexpected file type");
+    /*
+     * Find the entry for the given file (and return if there
+     * isn't one).
+     */
+
+    for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
+	    prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+	if (filePtr == NULL) {
+	    return;
+	}
+	if (filePtr->fd == fd) {
+	    break;
+	}
     }
 
+    /*
+     * Update the check masks for this file.
+     */
+
     index = fd/(NBBY*sizeof(fd_mask));
     bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
-    result = 0;
-    if ((mask & TCL_READABLE) && (readyMasks[index] & bit)) {
-	result |= TCL_READABLE;
+
+    if (filePtr->mask & TCL_READABLE) {
+	notifier.checkMasks[index] &= ~bit;
     }
-    if ((mask & TCL_WRITABLE) && ((readyMasks+MASK_SIZE)[index] & bit)) {
-	result |= TCL_WRITABLE;
+    if (filePtr->mask & TCL_WRITABLE) {
+	(notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
+    }
+    if (filePtr->mask & TCL_EXCEPTION) {
+	(notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+    }
+
+    /*
+     * Find current max fd.
+     */
+
+    if (fd+1 == notifier.numFdBits) {
+	for (notifier.numFdBits = 0; index >= 0; index--) {
+	    mask = notifier.checkMasks[index]
+		| (notifier.checkMasks+MASK_SIZE)[index]
+		| (notifier.checkMasks+2*(MASK_SIZE))[index];
+	    if (mask) {
+		for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) {
+		    if (mask & (1 << (i-1))) {
+			break;
+		    }
+		}
+		notifier.numFdBits = index * (NBBY*sizeof(fd_mask)) + i;
+		break;
+	    }
+	}
     }
-    if ((mask & TCL_EXCEPTION) && ((readyMasks+(2*MASK_SIZE))[index] & bit)) {
-	result |= TCL_EXCEPTION;
+
+    /*
+     * Clean up information in the callback record.
+     */
+
+    if (prevPtr == NULL) {
+	notifier.firstFileHandlerPtr = filePtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = filePtr->nextPtr;
     }
-    return result;
+    ckfree((char *) filePtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * MaskEmpty --
+ * FileHandlerEventProc --
  *
- *	Returns nonzero if mask is empty (has no bits set).
+ *	This procedure is called by Tcl_ServiceEvent when a file event
+ *	reaches the front of the event queue.  This procedure is
+ *	responsible for actually handling the event by invoking the
+ *	callback for the file handler.
  *
  * Results:
- *	Nonzero if the mask is empty, zero otherwise.
+ *	Returns 1 if the event was handled, meaning it should be removed
+ *	from the queue.  Returns 0 if the event was not handled, meaning
+ *	it should stay on the queue.  The only time the event isn't
+ *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
  *
  * Side effects:
- *	None
+ *	Whatever the file handler's callback procedure does.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-MaskEmpty(maskPtr)
-    long *maskPtr;
+FileHandlerEventProc(evPtr, flags)
+    Tcl_Event *evPtr;		/* Event to service. */
+    int flags;			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
 {
-    long *runPtr, *tailPtr;
-    int found, sz;
-
-    sz = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask);
-    for (runPtr = maskPtr, tailPtr = maskPtr + sz, found = 0;
-             runPtr < tailPtr;
-             runPtr++) {
-        if (*runPtr != 0) {
-            found = 1;
-            break;
-        }
+    FileHandler *filePtr;
+    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
+    int mask;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Search through the file handlers to find the one whose handle matches
+     * the event.  We do this rather than keeping a pointer to the file
+     * handler directly in the event, so that the handler can be deleted
+     * while the event is queued without leaving a dangling pointer.
+     */
+
+    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+	    filePtr = filePtr->nextPtr) {
+	if (filePtr->fd != fileEvPtr->fd) {
+	    continue;
+	}
+
+	/*
+	 * The code is tricky for two reasons:
+	 * 1. The file handler's desired events could have changed
+	 *    since the time when the event was queued, so AND the
+	 *    ready mask with the desired mask.
+	 * 2. The file could have been closed and re-opened since
+	 *    the time when the event was queued.  This is why the
+	 *    ready mask is stored in the file handler rather than
+	 *    the queued event:  it will be zeroed when a new
+	 *    file handler is created for the newly opened file.
+	 */
+
+	mask = filePtr->readyMask & filePtr->mask;
+	filePtr->readyMask = 0;
+	if (mask != 0) {
+	    (*filePtr->proc)(filePtr->clientData, mask);
+	}
+	break;
     }
-    return !found;    
+    return 1;
 }
 
 /*
@@ -195,50 +413,55 @@ MaskEmpty(maskPtr)
  *
  * Tcl_WaitForEvent --
  *
- *	This procedure does the lowest level wait for events in a
- *	platform-specific manner.  It uses information provided by
- *	previous calls to Tcl_WatchFile, plus the timePtr argument,
- *	to determine what to wait for and how long to wait.
+ *	This function is called by Tcl_DoOneEvent to wait for new
+ *	events on the message queue.  If the block time is 0, then
+ *	Tcl_WaitForEvent just polls without blocking.
  *
  * Results:
- *	The return value is normally TCL_OK.  However, if there are
- *	no events to wait for (e.g. no files and no timers) so that
- *	the procedure would block forever, then it returns TCL_ERROR.
+ *	Returns -1 if the select would block forever, otherwise
+ *	returns 0.
  *
  * Side effects:
- *	May put the process to sleep for a while, depending on timePtr.
- *	When this procedure returns, an event of interest to the application
- *	has probably, but not necessarily, occurred.
+ *	Queues file events that are detected by the select.
  *
  *----------------------------------------------------------------------
  */
 
 int
 Tcl_WaitForEvent(timePtr)
-    Tcl_Time *timePtr;		/* Specifies the maximum amount of time
-				 * that this procedure should block before
-				 * returning.  The time is given as an
-				 * interval, not an absolute wakeup time.
-				 * NULL means block forever. */
+    Tcl_Time *timePtr;		/* Maximum block time, or NULL. */
 {
+    FileHandler *filePtr;
+    FileHandlerEvent *fileEvPtr;
     struct timeval timeout, *timeoutPtr;
-    int numFound;
+    int bit, index, mask, numFound;
 
-    memcpy((VOID *) readyMasks, (VOID *) checkMasks,
-	    3*MASK_SIZE*sizeof(fd_mask));
-    if (timePtr == NULL) {
-	if ((numFdBits == 0) || (MaskEmpty((long *) readyMasks))) {
-	    return TCL_ERROR;
-	}
-	timeoutPtr = NULL;
-    } else {
-	timeoutPtr = &timeout;
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    /*
+     * Set up the timeout structure.  Note that if there are no events to
+     * check for, we return with a negative result rather than blocking
+     * forever.
+     */
+
+    if (timePtr) {
 	timeout.tv_sec = timePtr->sec;
 	timeout.tv_usec = timePtr->usec;
+	timeoutPtr = &timeout;
+    } else if (notifier.numFdBits == 0) {
+	return -1;
+    } else {
+	timeoutPtr = NULL;
     }
-    numFound = select(numFdBits, (SELECT_MASK *) &readyMasks[0],
-	    (SELECT_MASK *) &readyMasks[MASK_SIZE],
-	    (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
+
+    memcpy((VOID *) notifier.readyMasks, (VOID *) notifier.checkMasks,
+	    3*MASK_SIZE*sizeof(fd_mask));
+    numFound = select(notifier.numFdBits,
+	    (SELECT_MASK *) &notifier.readyMasks[0],
+	    (SELECT_MASK *) &notifier.readyMasks[MASK_SIZE],
+	    (SELECT_MASK *) &notifier.readyMasks[2*MASK_SIZE], timeoutPtr);
 
     /*
      * Some systems don't clear the masks after an error, so
@@ -246,77 +469,49 @@ Tcl_WaitForEvent(timePtr)
      */
 
     if (numFound == -1) {
-	memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+	memset((VOID *) notifier.readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
     }
 
     /*
-     * Reset the check masks in preparation for the next call to
-     * select.
+     * Queue all detected file events before returning.
      */
 
-    numFdBits = 0;
-    memset((VOID *) checkMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Sleep --
- *
- *	Delay execution for the specified number of milliseconds.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Time passes.
- *
- *----------------------------------------------------------------------
- */
+    for (filePtr = notifier.firstFileHandlerPtr;
+	    (filePtr != NULL) && (numFound > 0);
+	    filePtr = filePtr->nextPtr) {
+	index = filePtr->fd / (NBBY*sizeof(fd_mask));
+	bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask)));
+	mask = 0;
 
-void
-Tcl_Sleep(ms)
-    int ms;			/* Number of milliseconds to sleep. */
-{
-    static struct timeval delay;
-    Tcl_Time before, after;
-
-    /*
-     * The only trick here is that select appears to return early
-     * under some conditions, so we have to check to make sure that
-     * the right amount of time really has elapsed.  If it's too
-     * early, go back to sleep again.
-     */
+	if (notifier.readyMasks[index] & bit) {
+	    mask |= TCL_READABLE;
+	}
+	if ((notifier.readyMasks+MASK_SIZE)[index] & bit) {
+	    mask |= TCL_WRITABLE;
+	}
+	if ((notifier.readyMasks+2*(MASK_SIZE))[index] & bit) {
+	    mask |= TCL_EXCEPTION;
+	}
 
-    TclpGetTime(&before);
-    after = before;
-    after.sec += ms/1000;
-    after.usec += (ms%1000)*1000;
-    if (after.usec > 1000000) {
-	after.usec -= 1000000;
-	after.sec += 1;
-    }
-    while (1) {
-	delay.tv_sec = after.sec - before.sec;
-	delay.tv_usec = after.usec - before.usec;
-	if (delay.tv_usec < 0) {
-	    delay.tv_usec += 1000000;
-	    delay.tv_sec -= 1;
+	if (!mask) {
+	    continue;
+	} else {
+	    numFound--;
 	}
 
 	/*
-	 * Special note:  must convert delay.tv_sec to int before comparing
-	 * to zero, since delay.tv_usec is unsigned on some platforms.
+	 * Don't bother to queue an event if the mask was previously
+	 * non-zero since an event must still be on the queue.
 	 */
 
-	if ((((int) delay.tv_sec) < 0)
-		|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
-	    break;
+	if (filePtr->readyMask == 0) {
+	    fileEvPtr = (FileHandlerEvent *) ckalloc(
+		sizeof(FileHandlerEvent));
+	    fileEvPtr->header.proc = FileHandlerEventProc;
+	    fileEvPtr->fd = filePtr->fd;
+	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
 	}
-	(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
-		(SELECT_MASK *) 0, &delay);
-	TclpGetTime(&before);
+	filePtr->readyMask = mask;
     }
+    return 0;
 }
-
diff --git a/contrib/tcl/unix/tclUnixPipe.c b/contrib/tcl/unix/tclUnixPipe.c
index a7ff1b3..f6d90d7 100644
--- a/contrib/tcl/unix/tclUnixPipe.c
+++ b/contrib/tcl/unix/tclUnixPipe.c
@@ -1,25 +1,440 @@
 /* 
- * tclUnixPipe.c -- This file implements the UNIX-specific exec pipeline 
- *                  functions.
+ * tclUnixPipe.c --
+ *
+ *	This file implements the UNIX-specific exec pipeline functions,
+ *	the "pipe" channel driver, and the "pid" Tcl command.
  *
  * Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixPipe.c 1.29 96/04/18 15:56:26
+ * SCCS: @(#) tclUnixPipe.c 1.36 97/05/14 13:24:24
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
 /*
+ * The following macros convert between TclFile's and fd's.  The conversion
+ * simple involves shifting fd's up by one to ensure that no valid fd is ever
+ * the same as NULL.
+ */
+
+#define MakeFile(fd) ((TclFile)((fd)+1))
+#define GetFd(file) (((int)file)-1)
+
+/*
+ * This structure describes per-instance state of a pipe based channel.
+ */
+
+typedef struct PipeState {
+    Tcl_Channel channel;/* Channel associated with this file. */
+    TclFile inFile;	/* Output from pipe. */
+    TclFile outFile;	/* Input to pipe. */
+    TclFile errorFile;	/* Error output from pipe. */
+    int numPids;	/* How many processes are attached to this pipe? */
+    Tcl_Pid *pidPtr;	/* The process IDs themselves. Allocated by
+                         * the creator of the pipe. */
+    int isNonBlocking;	/* Nonzero when the pipe is in nonblocking mode.
+                         * Used to decide whether to wait for the children
+                         * at close time. */
+} PipeState;
+
+/*
  * Declarations for local procedures defined in this file:
  */
 
-static void             RestoreSignals _ANSI_ARGS_((void));
-static int		SetupStdFile _ANSI_ARGS_((Tcl_File file, int type));
+static int	PipeBlockModeProc _ANSI_ARGS_((ClientData instanceData,
+		    int mode));
+static int	PipeCloseProc _ANSI_ARGS_((ClientData instanceData,
+		    Tcl_Interp *interp));
+static int	PipeGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+		    int direction, ClientData *handlePtr));
+static int	PipeInputProc _ANSI_ARGS_((ClientData instanceData,
+		    char *buf, int toRead, int *errorCode));
+static int	PipeOutputProc _ANSI_ARGS_((
+		    ClientData instanceData, char *buf, int toWrite,
+		    int *errorCode));
+static void	PipeWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
+static void	RestoreSignals _ANSI_ARGS_((void));
+static int	SetupStdFile _ANSI_ARGS_((TclFile file, int type));
+
+/*
+ * This structure describes the channel type structure for command pipe
+ * based IO:
+ */
+
+static Tcl_ChannelType pipeChannelType = {
+    "pipe",				/* Type name. */
+    PipeBlockModeProc,			/* Set blocking/nonblocking mode.*/
+    PipeCloseProc,			/* Close proc. */
+    PipeInputProc,			/* Input proc. */
+    PipeOutputProc,			/* Output proc. */
+    NULL,				/* Seek proc. */
+    NULL,				/* Set option proc. */
+    NULL,				/* Get option proc. */
+    PipeWatchProc,			/* Initialize notifier. */
+    PipeGetHandleProc,			/* Get OS handles out of channel. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMakeFile --
+ *
+ *	Make a TclFile from a channel.
+ *
+ * Results:
+ *	Returns a new TclFile or NULL on failure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpMakeFile(channel, direction)
+    Tcl_Channel channel;	/* Channel to get file from. */
+    int direction;		/* Either TCL_READABLE or TCL_WRITABLE. */
+{
+    int fd;
+
+    if (Tcl_GetChannelHandle(channel, direction, (ClientData *) &fd)
+	    == TCL_OK) {
+	return MakeFile(fd);
+    } else {
+	return (TclFile) NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFile --
+ *
+ *	Open a file for use in a pipeline.  
+ *
+ * Results:
+ *	Returns a new TclFile handle or NULL on failure.
+ *
+ * Side effects:
+ *	May cause a file to be created on the file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpOpenFile(fname, mode)
+    char *fname;			/* The name of the file to open. */
+    int mode;				/* In what mode to open the file? */
+{
+    int fd;
+
+    fd = open(fname, mode, 0666);
+    if (fd != -1) {
+        fcntl(fd, F_SETFD, FD_CLOEXEC);
+
+	/*
+	 * If the file is being opened for writing, seek to the end
+	 * so we can append to any data already in the file.
+	 */
+
+	if (mode & O_WRONLY) {
+	    lseek(fd, 0, SEEK_END);
+	}
+
+	/*
+	 * Increment the fd so it can't be 0, which would conflict with
+	 * the NULL return for errors.
+	 */
+
+	return MakeFile(fd);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateTempFile --
+ *
+ *	This function creates a temporary file initialized with an
+ *	optional string, and returns a file handle with the file pointer
+ *	at the beginning of the file.
+ *
+ * Results:
+ *	A handle to a file.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpCreateTempFile(contents, namePtr)
+    char *contents;		/* String to write into temp file, or NULL. */
+    Tcl_DString *namePtr;	/* If non-NULL, pointer to initialized 
+				 * DString that is filled with the name of 
+				 * the temp file that was created. */
+{
+    char fileName[L_tmpnam];
+    TclFile file;
+    size_t length = (contents == NULL) ? 0 : strlen(contents);
+
+    tmpnam(fileName);
+    file = TclpOpenFile(fileName, O_RDWR|O_CREAT|O_TRUNC);
+    unlink(fileName);
+
+    if ((file != NULL) && (length > 0)) {
+	int fd = GetFd(file);
+	while (1) {
+	    if (write(fd, contents, length) != -1) {
+		break;
+	    } else if (errno != EINTR) {
+		close(fd);
+		return NULL;
+	    }
+	}
+	lseek(fd, 0, SEEK_SET);
+    }
+    if (namePtr != NULL) {
+	Tcl_DStringAppend(namePtr, fileName, -1);
+    }
+    return file;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreatePipe --
+ *
+ *      Creates a pipe - simply calls the pipe() function.
+ *
+ * Results:
+ *      Returns 1 on success, 0 on failure. 
+ *
+ * Side effects:
+ *      Creates a pipe.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCreatePipe(readPipe, writePipe)
+    TclFile *readPipe;		/* Location to store file handle for
+				 * read side of pipe. */
+    TclFile *writePipe;		/* Location to store file handle for
+				 * write side of pipe. */
+{
+    int pipeIds[2];
+
+    if (pipe(pipeIds) != 0) {
+	return 0;
+    }
+
+    fcntl(pipeIds[0], F_SETFD, FD_CLOEXEC);
+    fcntl(pipeIds[1], F_SETFD, FD_CLOEXEC);
+
+    *readPipe = MakeFile(pipeIds[0]);
+    *writePipe = MakeFile(pipeIds[1]);
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCloseFile --
+ *
+ *	Implements a mechanism to close a UNIX file.
+ *
+ * Results:
+ *	Returns 0 on success, or -1 on error, setting errno.
+ *
+ * Side effects:
+ *	The file is closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCloseFile(file)
+    TclFile file;	/* The file to close. */
+{
+    int fd = GetFd(file);
+
+    /*
+     * Refuse to close the fds for stdin, stdout and stderr.
+     */
+    
+    if ((fd == 0) || (fd == 1) || (fd == 2)) {
+        return 0;
+    }
+    
+    Tcl_DeleteFileHandler(fd);
+    return close(fd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateProcess --
+ *
+ *	Create a child process that has the specified files as its 
+ *	standard input, output, and error.  The child process runs
+ *	asynchronously and runs with the same environment variables
+ *	as the creating process.
+ *
+ *	The path is searched to find the specified executable.  
+ *
+ * Results:
+ *	The return value is TCL_ERROR and an error message is left in
+ *	interp->result if there was a problem creating the child 
+ *	process.  Otherwise, the return value is TCL_OK and *pidPtr is
+ *	filled with the process id of the child process.
+ * 
+ * Side effects:
+ *	A process is created.
+ *	
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+int
+TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, 
+	pidPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to leave errors that
+				 * occurred when creating the child process.
+				 * Error messages from the child process
+				 * itself are sent to errorFile. */
+    int argc;			/* Number of arguments in following array. */
+    char **argv;		/* Array of argument strings.  argv[0]
+				 * contains the name of the executable
+				 * converted to native format (using the
+				 * Tcl_TranslateFileName call).  Additional
+				 * arguments have not been converted. */
+    TclFile inputFile;		/* If non-NULL, gives the file to use as
+				 * input for the child process.  If inputFile
+				 * file is not readable or is NULL, the child
+				 * will receive no standard input. */
+    TclFile outputFile;		/* If non-NULL, gives the file that
+				 * receives output from the child process.  If
+				 * outputFile file is not writeable or is
+				 * NULL, output from the child will be
+				 * discarded. */
+    TclFile errorFile;		/* If non-NULL, gives the file that
+				 * receives errors from the child process.  If
+				 * errorFile file is not writeable or is NULL,
+				 * errors from the child will be discarded.
+				 * errorFile may be the same as outputFile. */
+    Tcl_Pid *pidPtr;		/* If this procedure is successful, pidPtr
+				 * is filled with the process id of the child
+				 * process. */
+{
+    TclFile errPipeIn, errPipeOut;
+    int joinThisError, count, status, fd;
+    char errSpace[200];
+    int pid;
+    
+    errPipeIn = NULL;
+    errPipeOut = NULL;
+    pid = -1;
+
+    /*
+     * Create a pipe that the child can use to return error
+     * information if anything goes wrong.
+     */
+
+    if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) {
+	Tcl_AppendResult(interp, "couldn't create pipe: ",
+		Tcl_PosixError(interp), (char *) NULL);
+	goto error;
+    }
+
+    joinThisError = (errorFile == outputFile);
+    pid = vfork();
+    if (pid == 0) {
+	fd = GetFd(errPipeOut);
+
+	/*
+	 * Set up stdio file handles for the child process.
+	 */
+
+	if (!SetupStdFile(inputFile, TCL_STDIN)
+		|| !SetupStdFile(outputFile, TCL_STDOUT)
+		|| (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
+		|| (joinThisError &&
+			((dup2(1,2) == -1) ||
+			 (fcntl(2, F_SETFD, 0) != 0)))) {
+	    sprintf(errSpace,
+		    "%dforked process couldn't set up input/output: ",
+		    errno);
+	    write(fd, errSpace, (size_t) strlen(errSpace));
+	    _exit(1);
+	}
+
+	/*
+	 * Close the input side of the error pipe.
+	 */
+
+	RestoreSignals();
+	execvp(argv[0], &argv[0]);
+	sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
+		argv[0]);
+	write(fd, errSpace, (size_t) strlen(errSpace));
+	_exit(1);
+    }
+    if (pid == -1) {
+	Tcl_AppendResult(interp, "couldn't fork child process: ",
+		Tcl_PosixError(interp), (char *) NULL);
+	goto error;
+    }
+
+    /*
+     * Read back from the error pipe to see if the child started
+     * up OK.  The info in the pipe (if any) consists of a decimal
+     * errno value followed by an error message.
+     */
+
+    TclpCloseFile(errPipeOut);
+    errPipeOut = NULL;
+
+    fd = GetFd(errPipeIn);
+    count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
+    if (count > 0) {
+	char *end;
+	errSpace[count] = 0;
+	errno = strtol(errSpace, &end, 10);
+	Tcl_AppendResult(interp, end, Tcl_PosixError(interp),
+		(char *) NULL);
+	goto error;
+    }
+    
+    TclpCloseFile(errPipeIn);
+    *pidPtr = (Tcl_Pid) pid;
+    return TCL_OK;
+
+    error:
+    if (pid != -1) {
+	/*
+	 * Reap the child process now if an error occurred during its
+	 * startup.
+	 */
+
+	Tcl_WaitPid((Tcl_Pid) pid, &status, WNOHANG);
+    }
+    
+    if (errPipeIn) {
+	TclpCloseFile(errPipeIn);
+    }
+    if (errPipeOut) {
+	TclpCloseFile(errPipeOut);
+    }
+    return TCL_ERROR;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -116,7 +531,7 @@ RestoreSignals()
 
 static int
 SetupStdFile(file, type)
-    Tcl_File file;		/* File to dup, or NULL. */
+    TclFile file;		/* File to dup, or NULL. */
     int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR */
 {
     Tcl_Channel channel;
@@ -143,11 +558,11 @@ SetupStdFile(file, type)
     if (!file) {
 	channel = Tcl_GetStdChannel(type);
 	if (channel) {
-	    file = Tcl_GetChannelFile(channel, direction);
+	    file = TclpMakeFile(channel, direction);
 	}
     }
     if (file) {
-	fd = (int)Tcl_GetFileInfo(file, NULL);
+	fd = GetFd(file);
 	if (fd != targetFd) {
 	    if (dup2(fd, targetFd) == -1) {
 		return 0;
@@ -179,318 +594,556 @@ SetupStdFile(file, type)
 /*
  *----------------------------------------------------------------------
  *
- * TclSpawnPipeline --
+ * TclpCreateCommandChannel --
  *
- *      Given an argc/argv array, instantiate a pipeline of processes
- *      as described by the argv.
+ *	This function is called by the generic IO level to perform
+ *	the platform specific channel initialization for a command
+ *	channel.
  *
  * Results:
- *      The return value is 1 on success, 0 on error
+ *	Returns a new channel or NULL on failure.
  *
  * Side effects:
- *      Processes and pipes are created.
+ *	Allocates a new channel.
  *
  *----------------------------------------------------------------------
  */
-int
-TclSpawnPipeline(interp, pidPtr, numPids, argc, argv, inputFile,
-	outputFile, errorFile, intIn, finalOut)
-    Tcl_Interp *interp;		/* Interpreter in which to process pipeline. */
-    int *pidPtr;		/* Array of pids which are created. */
-    int *numPids;		/* Number of pids created. */
-    int argc;			/* Number of entries in argv. */
-    char **argv;		/* Array of strings describing commands in
-				 * pipeline plus I/O redirection with <,
-				 * <<, >, etc. argv[argc] must be NULL. */
-    Tcl_File inputFile;	/* If >=0, gives file id to use as input for
-				 * first process in pipeline (specified via <
-				 * or <@). */
-    Tcl_File outputFile;	/* Writable file id for output from last
-				 * command in pipeline (could be file or
-				 * pipe). NULL means use stdout. */
-    Tcl_File errorFile;	/* Writable file id for error output from all
-				 * commands in the pipeline. NULL means use
-				 * stderr */
-    char *intIn;		/* File name for initial input (for Win32s). */
-    char *finalOut;		/* File name for final output (for Win32s). */
-{
-    int firstArg, lastArg;
-    int pid, count;
-    Tcl_DString buffer;
-    char *execName;
-    char errSpace[200];
-    Tcl_File pipeIn, errPipeIn, errPipeOut;
-    int joinThisError;
-    Tcl_File curOutFile = NULL, curInFile;
-    
-    Tcl_DStringInit(&buffer);
-    pipeIn = errPipeIn = errPipeOut = NULL;
 
-    curInFile = inputFile;
+Tcl_Channel
+TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
+    TclFile readFile;		/* If non-null, gives the file for reading. */
+    TclFile writeFile;		/* If non-null, gives the file for writing. */
+    TclFile errorFile;		/* If non-null, gives the file where errors
+				 * can be read. */
+    int numPids;		/* The number of pids in the pid array. */
+    Tcl_Pid *pidPtr;		/* An array of process identifiers.
+                                 * Allocated by the caller, freed when
+                                 * the channel is closed or the processes
+                                 * are detached (in a background exec). */
+{
+    char channelName[20];
+    int channelId;
+    PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
+    int mode;
 
-    for (firstArg = 0; firstArg < argc; firstArg = lastArg+1) {
+    statePtr->inFile = readFile;
+    statePtr->outFile = writeFile;
+    statePtr->errorFile = errorFile;
+    statePtr->numPids = numPids;
+    statePtr->pidPtr = pidPtr;
+    statePtr->isNonBlocking = 0;
 
-	/*
-	 * Convert the program name into native form.
-	 */
+    mode = 0;
+    if (readFile) {
+        mode |= TCL_READABLE;
+    }
+    if (writeFile) {
+        mode |= TCL_WRITABLE;
+    }
+    
+    /*
+     * Use one of the fds associated with the channel as the
+     * channel id.
+     */
 
-	Tcl_DStringFree(&buffer);
-	execName = Tcl_TranslateFileName(interp, argv[firstArg], &buffer);
-	if (execName == NULL) {
-	    goto error;
-	}
+    if (readFile) {
+	channelId = GetFd(readFile);
+    } else if (writeFile) {
+	channelId = GetFd(writeFile);
+    } else if (errorFile) {
+	channelId = GetFd(errorFile);
+    } else {
+	channelId = 0;
+    }
 
-	/*
-	 * Find the end of the current segment of the pipeline.
-	 */
+    /*
+     * For backward compatibility with previous versions of Tcl, we
+     * use "file%d" as the base name for pipes even though it would
+     * be more natural to use "pipe%d".
+     */
 
-	joinThisError = 0;
-	for (lastArg = firstArg; lastArg < argc; lastArg++) {
-	    if (argv[lastArg][0] == '|') {
-		if (argv[lastArg][1] == 0) {
-		    break;
-		}
-		if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == 0)) {
-		    joinThisError = 1;
-		    break;
-		}
-	    }
-	}
-	argv[lastArg] = NULL;
+    sprintf(channelName, "file%d", channelId);
+    statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
+            (ClientData) statePtr, mode);
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetAndDetachPids --
+ *
+ *	This procedure is invoked in the generic implementation of a
+ *	background "exec" (An exec when invoked with a terminating "&")
+ *	to store a list of the PIDs for processes in a command pipeline
+ *	in interp->result and to detach the processes.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Modifies interp->result. Detaches processes.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	/*
-	 * If this is the last segment, use the specified outputFile.
-	 * Otherwise create an intermediate pipe.
-	 */
+void
+TclGetAndDetachPids(interp, chan)
+    Tcl_Interp *interp;
+    Tcl_Channel chan;
+{
+    PipeState *pipePtr;
+    Tcl_ChannelType *chanTypePtr;
+    int i;
+    char buf[20];
 
-	if (lastArg == argc) {
-	    curOutFile = outputFile;
-	} else {
-	    if (TclCreatePipe(&pipeIn, &curOutFile) == 0) {
-		Tcl_AppendResult(interp, "couldn't create pipe: ",
-			Tcl_PosixError(interp), (char *) NULL);
-		goto error;
-	    }
-	}
+    /*
+     * Punt if the channel is not a command channel.
+     */
 
-	/*
-	 * Create a pipe that the child can use to return error
-	 * information if anything goes wrong.
-	 */
+    chanTypePtr = Tcl_GetChannelType(chan);
+    if (chanTypePtr != &pipeChannelType) {
+        return;
+    }
 
-	if (TclCreatePipe(&errPipeIn, &errPipeOut) == 0) {
-	    Tcl_AppendResult(interp, "couldn't create pipe: ",
-		    Tcl_PosixError(interp), (char *) NULL);
-	    goto error;
-	}
+    pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
+    for (i = 0; i < pipePtr->numPids; i++) {
+        sprintf(buf, "%ld", TclpGetPid(pipePtr->pidPtr[i]));
+        Tcl_AppendElement(interp, buf);
+        Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+    }
+    if (pipePtr->numPids > 0) {
+        ckfree((char *) pipePtr->pidPtr);
+        pipePtr->numPids = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeBlockModeProc --
+ *
+ *	Helper procedure to set blocking and nonblocking modes on a
+ *	pipe based channel. Invoked by generic IO level code.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	pid = vfork();
-	if (pid == 0) {
+	/* ARGSUSED */
+static int
+PipeBlockModeProc(instanceData, mode)
+    ClientData instanceData;		/* Pipe state. */
+    int mode;				/* The mode to set. Can be one of
+                                         * TCL_MODE_BLOCKING or
+                                         * TCL_MODE_NONBLOCKING. */
+{
+    PipeState *psPtr = (PipeState *) instanceData;
+    int curStatus;
+    int fd;
 
-	    /*
-	     * Set up stdio file handles for the child process.
-	     */
+#ifndef	USE_FIONBIO    
+    if (psPtr->inFile) {
+        fd = GetFd(psPtr->inFile);
+        curStatus = fcntl(fd, F_GETFL);
+        if (mode == TCL_MODE_BLOCKING) {
+            curStatus &= (~(O_NONBLOCK));
+        } else {
+            curStatus |= O_NONBLOCK;
+        }
+        if (fcntl(fd, F_SETFL, curStatus) < 0) {
+            return errno;
+        }
+        curStatus = fcntl(fd, F_GETFL);
+    }
+    if (psPtr->outFile) {
+        fd = GetFd(psPtr->outFile);
+        curStatus = fcntl(fd, F_GETFL);
+        if (mode == TCL_MODE_BLOCKING) {
+            curStatus &= (~(O_NONBLOCK));
+        } else {
+            curStatus |= O_NONBLOCK;
+        }
+        if (fcntl(fd, F_SETFL, curStatus) < 0) {
+            return errno;
+        }
+    }
+#endif	/* !FIONBIO */
 
-	    if (!SetupStdFile(curInFile, TCL_STDIN)
-		    || !SetupStdFile(curOutFile, TCL_STDOUT)
-		    || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
-		    || (joinThisError &&
-                            ((dup2(1,2) == -1) ||
-                             (fcntl(2, F_SETFD, 0) != 0)))) {
-		sprintf(errSpace,
-			"%dforked process couldn't set up input/output: ",
-			errno);
-		TclWriteFile(errPipeOut, 1, errSpace, (int) strlen(errSpace));
-		_exit(1);
-	    }
+#ifdef	USE_FIONBIO
+    if (psPtr->inFile) {
+        fd = GetFd(psPtr->inFile);
+        if (mode == TCL_MODE_BLOCKING) {
+            curStatus = 0;
+        } else {
+            curStatus = 1;
+        }
+        if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) {
+            return errno;
+        }
+    }
+    if (psPtr->outFile != NULL) {
+        fd = GetFd(psPtr->outFile);
+        if (mode == TCL_MODE_BLOCKING) {
+            curStatus = 0;
+        } else {
+            curStatus = 1;
+        }
+        if (ioctl(fd, (int) FIONBIO,  &curStatus) < 0) {
+            return errno;
+        }
+    }
+#endif	/* USE_FIONBIO */
+    
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeCloseProc --
+ *
+ *	This procedure is invoked by the generic IO level to perform
+ *	channel-type-specific cleanup when a command pipeline channel
+ *	is closed.
+ *
+ * Results:
+ *	0 on success, errno otherwise.
+ *
+ * Side effects:
+ *	Closes the command pipeline channel.
+ *
+ *----------------------------------------------------------------------
+ */
 
-            /*
-             * Close the input side of the error pipe.
-             */
+	/* ARGSUSED */
+static int
+PipeCloseProc(instanceData, interp)
+    ClientData instanceData;	/* The pipe to close. */
+    Tcl_Interp *interp;		/* For error reporting. */
+{
+    PipeState *pipePtr;
+    Tcl_Channel errChan;
+    int errorCode, result;
 
-	    RestoreSignals();
-	    execvp(execName, &argv[firstArg]);
-	    sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
-		    argv[firstArg]);
-	    TclWriteFile(errPipeOut, 1, errSpace, (int) strlen(errSpace));
-	    _exit(1);
+    errorCode = 0;
+    result = 0;
+    pipePtr = (PipeState *) instanceData;
+    if (pipePtr->inFile) {
+	if (TclpCloseFile(pipePtr->inFile) < 0) {
+	    errorCode = errno;
 	}
-	Tcl_DStringFree(&buffer);
-	if (pid == -1) {
-	    Tcl_AppendResult(interp, "couldn't fork child process: ",
-		    Tcl_PosixError(interp), (char *) NULL);
-	    goto error;
+    }
+    if (pipePtr->outFile) {
+	if ((TclpCloseFile(pipePtr->outFile) < 0) && (errorCode == 0)) {
+	    errorCode = errno;
 	}
+    }
 
+    if (pipePtr->isNonBlocking || TclInExit()) {
+    
 	/*
-	 * Add the child process to the list of those to be reaped.
-	 * Note: must do it now, so that the process will be reaped even if
-	 * an error occurs during its startup.
-	 */
-	
-	pidPtr[*numPids] = pid;
-	(*numPids)++;
-	
-	/*
-	 * Read back from the error pipe to see if the child startup
-	 * up OK.  The info in the pipe (if any) consists of a decimal
-	 * errno value followed by an error message.
-	 */
-
-	TclCloseFile(errPipeOut);
-	errPipeOut = NULL;
-
-	count = TclReadFile(errPipeIn, 1, errSpace,
-		(size_t) (sizeof(errSpace) - 1));
-	if (count > 0) {
-	    char *end;
-	    errSpace[count] = 0;
-	    errno = strtol(errSpace, &end, 10);
-	    Tcl_AppendResult(interp, end, Tcl_PosixError(interp),
-		    (char *) NULL);
-	    goto error;
-	}
-	TclCloseFile(errPipeIn);
-	errPipeIn = NULL;
+         * If the channel is non-blocking or Tcl is being cleaned up, just
+         * detach the children PIDs, reap them (important if we are in a
+         * dynamic load module), and discard the errorFile.
+         */
+        
+        Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
+        Tcl_ReapDetachedProcs();
 
+        if (pipePtr->errorFile) {
+	    TclpCloseFile(pipePtr->errorFile);
+        }
+    } else {
+        
 	/*
-	 * Close off our copies of file descriptors that were set up for
-	 * this child, then set up the input for the next child.
-	 */
+         * Wrap the error file into a channel and give it to the cleanup
+         * routine.
+         */
 
-	if (curInFile && (curInFile != inputFile)) {
-	    TclCloseFile(curInFile);
-	}
-	curInFile = pipeIn;
-	pipeIn = NULL;
+        if (pipePtr->errorFile) {
+	    errChan = Tcl_MakeFileChannel(
+		(ClientData) GetFd(pipePtr->errorFile), TCL_READABLE);
+        } else {
+            errChan = NULL;
+        }
+        result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
+                errChan);
+    }
 
-	if (curOutFile && (curOutFile != outputFile)) {
-	    TclCloseFile(curOutFile);
-	}
-	curOutFile = NULL;
+    if (pipePtr->numPids != 0) {
+        ckfree((char *) pipePtr->pidPtr);
     }
-    return 1;
+    ckfree((char *) pipePtr);
+    if (errorCode == 0) {
+        return result;
+    }
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeInputProc --
+ *
+ *	This procedure is invoked from the generic IO level to read
+ *	input from a command pipeline based channel.
+ *
+ * Results:
+ *	The number of bytes read is returned or -1 on error. An output
+ *	argument contains a POSIX error code if an error occurs, or zero.
+ *
+ * Side effects:
+ *	Reads input from the input device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeInputProc(instanceData, buf, toRead, errorCodePtr)
+    ClientData instanceData;		/* Pipe state. */
+    char *buf;				/* Where to store data read. */
+    int toRead;				/* How much space is available
+                                         * in the buffer? */
+    int *errorCodePtr;			/* Where to store error code. */
+{
+    PipeState *psPtr = (PipeState *) instanceData;
+    int bytesRead;			/* How many bytes were actually
+                                         * read from the input device? */
 
+    *errorCodePtr = 0;
+    
     /*
-     * An error occured, so we need to clean up any open pipes.
+     * Assume there is always enough input available. This will block
+     * appropriately, and read will unblock as soon as a short read is
+     * possible, if the channel is in blocking mode. If the channel is
+     * nonblocking, the read will never block.
      */
 
-error:
-    Tcl_DStringFree(&buffer);
-    if (errPipeIn) {
-	TclCloseFile(errPipeIn);
-    }
-    if (errPipeOut) {
-	TclCloseFile(errPipeOut);
+    bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead);
+    if (bytesRead > -1) {
+        return bytesRead;
     }
-    if (pipeIn) {
-	TclCloseFile(pipeIn);
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeOutputProc--
+ *
+ *	This procedure is invoked from the generic IO level to write
+ *	output to a command pipeline based channel.
+ *
+ * Results:
+ *	The number of bytes written is returned or -1 on error. An
+ *	output argument	contains a POSIX error code if an error occurred,
+ *	or zero.
+ *
+ * Side effects:
+ *	Writes output on the output device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeOutputProc(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;		/* Pipe state. */
+    char *buf;				/* The data buffer. */
+    int toWrite;			/* How many bytes to write? */
+    int *errorCodePtr;			/* Where to store error code. */
+{
+    PipeState *psPtr = (PipeState *) instanceData;
+    int written;
+
+    *errorCodePtr = 0;
+    written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
+    if (written > -1) {
+        return written;
     }
-    if (curOutFile && (curOutFile != outputFile)) {
-	TclCloseFile(curOutFile);
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeWatchProc --
+ *
+ *	Initialize the notifier to watch the fds from this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets up the notifier so that a future event on the channel will
+ *	be seen by Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeWatchProc(instanceData, mask)
+    ClientData instanceData;		/* The pipe state. */
+    int mask;				/* Events of interest; an OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABEL and TCL_EXCEPTION. */
+{
+    PipeState *psPtr = (PipeState *) instanceData;
+    int newmask;
+
+    if (psPtr->inFile) {
+	newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
+	if (newmask) {
+	    Tcl_CreateFileHandler(GetFd(psPtr->inFile), mask,
+		    (Tcl_FileProc *) Tcl_NotifyChannel,
+		    (ClientData) psPtr->channel);
+	} else {
+	    Tcl_DeleteFileHandler(GetFd(psPtr->inFile));
+	}
     }
-    if (curInFile && (curInFile != inputFile)) {
-	TclCloseFile(curInFile);
+    if (psPtr->outFile) {
+	newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION);
+	if (newmask) {
+	    Tcl_CreateFileHandler(GetFd(psPtr->outFile), mask,
+		    (Tcl_FileProc *) Tcl_NotifyChannel,
+		    (ClientData) psPtr->channel);
+	} else {
+	    Tcl_DeleteFileHandler(GetFd(psPtr->outFile));
+	}
     }
-    return 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCreatePipe --
+ * PipeGetHandleProc --
  *
- *      Creates a pipe - simply calls the pipe() function.
+ *	Called from Tcl_GetChannelHandle to retrieve OS handles from
+ *	inside a command pipeline based channel.
  *
  * Results:
- *      Returns 1 on success, 0 on failure. 
+ *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ *	there is no handle for the specified direction. 
  *
  * Side effects:
- *      Creates a pipe.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
-int
-TclCreatePipe(readPipe, writePipe)
-    Tcl_File *readPipe;	/* Location to store file handle for
-				 * read side of pipe. */
-    Tcl_File *writePipe;	/* Location to store file handle for
-				 * write side of pipe. */
+
+static int
+PipeGetHandleProc(instanceData, direction, handlePtr)
+    ClientData instanceData;	/* The pipe state. */
+    int direction;		/* TCL_READABLE or TCL_WRITABLE */
+    ClientData *handlePtr;	/* Where to store the handle.  */
 {
-    int pipeIds[2];
+    PipeState *psPtr = (PipeState *) instanceData;
 
-    if (pipe(pipeIds) != 0) {
-	return 0;
+    if (direction == TCL_READABLE && psPtr->inFile) {
+	*handlePtr = (ClientData) GetFd(psPtr->inFile);
+	return TCL_OK;
+    }
+    if (direction == TCL_WRITABLE && psPtr->outFile) {
+	*handlePtr = (ClientData) GetFd(psPtr->outFile);
+	return TCL_OK;
     }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ *	Implements the waitpid system call on Unix systems.
+ *
+ * Results:
+ *	Result of calling waitpid.
+ *
+ * Side effects:
+ *	Waits for a process to terminate.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    fcntl(pipeIds[0], F_SETFD, FD_CLOEXEC);
-    fcntl(pipeIds[1], F_SETFD, FD_CLOEXEC);
+Tcl_Pid
+Tcl_WaitPid(pid, statPtr, options)
+    Tcl_Pid pid;
+    int *statPtr;
+    int options;
+{
+    int result;
+    pid_t real_pid;
 
-    *readPipe = Tcl_GetFile((ClientData)pipeIds[0], TCL_UNIX_FD);
-    *writePipe = Tcl_GetFile((ClientData)pipeIds[1], TCL_UNIX_FD);
-    return 1;
+    real_pid = (pid_t) pid;
+    while (1) {
+	result = (int) waitpid(real_pid, statPtr, options);
+	if ((result != -1) || (errno != EINTR)) {
+	    return (Tcl_Pid) result;
+	}
+    }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CreatePipeline --
+ * Tcl_PidObjCmd --
  *
- *	This function is a compatibility wrapper for TclCreatePipeline.
- *	It is only available under Unix, and may be removed from later
- *	versions.
+ *	This procedure is invoked to process the "pid" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
- *	Same as TclCreatePipeline.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Same as TclCreatePipeline.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
-	outPipePtr, errFilePtr)
-    Tcl_Interp *interp;
-    int argc;
-    char **argv;
-    int **pidArrayPtr;
-    int *inPipePtr;
-    int *outPipePtr;
-    int *errFilePtr;
+Tcl_PidObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST *objv;	/* Argument strings. */
 {
-    Tcl_File inFile, outFile, errFile;
-    int result;
-
-    result = TclCreatePipeline(interp, argc, argv, pidArrayPtr,
-	    (inPipePtr ? &inFile : NULL),
-	    (outPipePtr ? &outFile : NULL),
-	    (errFilePtr ? &errFile : NULL));
+    Tcl_Channel chan;
+    Tcl_ChannelType *chanTypePtr;
+    PipeState *pipePtr;
+    int i;
+    Tcl_Obj *resultPtr, *longObjPtr;
 
-    if (inPipePtr) {
-	if (inFile) {
-	    *inPipePtr = (int) Tcl_GetFileInfo(inFile, NULL);
-	    Tcl_FreeFile(inFile);
-	} else {
-	    *inPipePtr = -1;
-	}
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
+	return TCL_ERROR;
     }
-    if (outPipePtr) {
-	if (outFile) {
-	    *outPipePtr = (int) Tcl_GetFileInfo(outFile, NULL);
-	    Tcl_FreeFile(outFile);
-	} else {
-	    *outPipePtr = -1;
+    if (objc == 1) {
+	Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) getpid());
+    } else {
+        chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+		NULL);
+        if (chan == (Tcl_Channel) NULL) {
+	    return TCL_ERROR;
 	}
-    }
-    if (errFilePtr) {
-	if (errFile) {
-	    *errFilePtr = (int) Tcl_GetFileInfo(errFile, NULL);
-	    Tcl_FreeFile(errFile);
-	} else {
-	    *errFilePtr = -1;
+	chanTypePtr = Tcl_GetChannelType(chan);
+	if (chanTypePtr != &pipeChannelType) {
+	    return TCL_OK;
+	}
+        pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
+	resultPtr = Tcl_GetObjResult(interp);
+        for (i = 0; i < pipePtr->numPids; i++) {
+	    longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
+	    Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
 	}
     }
-    return result;
+    return TCL_OK;
 }
diff --git a/contrib/tcl/unix/tclUnixPort.h b/contrib/tcl/unix/tclUnixPort.h
index bbf1432..c0d590a 100644
--- a/contrib/tcl/unix/tclUnixPort.h
+++ b/contrib/tcl/unix/tclUnixPort.h
@@ -19,7 +19,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixPort.h 1.34 96/07/23 16:17:47
+ * SCCS: @(#) tclUnixPort.h 1.47 97/05/22 10:57:36
  */
 
 #ifndef _TCLUNIXPORT
@@ -69,6 +69,21 @@
 #else
 #   include "../compat/unistd.h"
 #endif
+#ifdef	USE_FIONBIO
+
+    /*
+     * Not using the Posix fcntl(...,O_NONBLOCK,...) interface, instead
+     * we are using ioctl(..,FIONBIO,..).
+     */
+
+#   ifdef HAVE_SYS_FILIO_H
+#	include	<sys/filio.h>	/* For FIONBIO. */
+#   endif
+
+#   ifdef HAVE_SYS_IOCTL_H
+#	include	<sys/ioctl.h>	/* For FIONBIO. */
+#   endif
+#endif	/* USE_FIONBIO */
 
 /*
  * Socket support stuff: This likely needs more work to parameterize for
@@ -76,12 +91,43 @@
  */
 
 #include <sys/socket.h>		/* struct sockaddr, SOCK_STREAM, ... */
-#include <sys/utsname.h>	/* uname system call. */
+#ifndef NO_UNAME
+#   include <sys/utsname.h>	/* uname system call. */
+#endif
 #include <netinet/in.h>		/* struct in_addr, struct sockaddr_in */
 #include <arpa/inet.h>		/* inet_ntoa() */
 #include <netdb.h>		/* gethostbyname() */
 
 /*
+ * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we
+ * look for an alternative definition.  If no other alternative is available
+ * we use a reasonable guess.
+ */
+
+#ifndef NO_FLOAT_H
+#include <float.h>
+#else
+#   ifndef NO_VALUES_H
+#	include <values.h>
+#   endif
+#endif
+
+#ifndef FLT_MAX
+#   ifdef MAXFLOAT
+#	define FLT_MAX MAXFLOAT
+#   else
+#	define FLT_MAX 3.402823466E+38F
+#   endif
+#endif
+#ifndef FLT_MIN
+#   ifdef MINFLOAT
+#	define FLT_MIN MINFLOAT
+#   else
+#	define FLT_MIN 1.175494351E-38F
+#   endif
+#endif
+
+/*
  * NeXT doesn't define O_NONBLOCK, so #define it here if necessary.
  */
 
@@ -102,6 +148,16 @@
 #endif
 
 /*
+ * The following defines denote malloc and free as the system calls
+ * used to allocate new memory.  These defines are only used in the
+ * file tclCkalloc.c.
+ */
+
+#define TclpAlloc(size)		malloc(size)
+#define TclpFree(ptr)		free(ptr)
+#define TclpRealloc(ptr, size)	realloc(ptr, size)
+
+/*
  * The default platform eol translation on Unix is TCL_TRANSLATE_LF:
  */
 
@@ -417,5 +473,15 @@ extern double strtod();
 
 #define TclpGetDate(t,u) ((u) ? gmtime((t)) : localtime((t)))
 #define TclStrftime(s,m,f,t) (strftime((s),(m),(f),(t)))
+#define TclpGetPid(pid)	    ((unsigned long) (pid))
+
+#define TclpReleaseFile(file)	
+
+/*
+ * The following routine is only exported for testing purposes.
+ */
+
+EXTERN int	TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
+		    int timeout));
 
 #endif /* _TCLUNIXPORT */
diff --git a/contrib/tcl/unix/tclUnixSock.c b/contrib/tcl/unix/tclUnixSock.c
index e5d293b..4301889 100644
--- a/contrib/tcl/unix/tclUnixSock.c
+++ b/contrib/tcl/unix/tclUnixSock.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixSock.c 1.5 96/04/04 15:28:39
+ * SCCS: @(#) tclUnixSock.c 1.6 96/08/08 08:48:51
  */
 
 #include "tcl.h"
@@ -33,7 +33,8 @@ static int  hostnameInited = 0;
  *	Get the network name for this machine, in a system dependent way.
  *
  * Results:
- *	A string containing the network name for this machine.
+ *	A string containing the network name for this machine, or
+ *	an empty string if we can't figure out the name.
  *
  * Side effects:
  *	None.
@@ -44,13 +45,16 @@ static int  hostnameInited = 0;
 char *
 Tcl_GetHostName()
 {
+#ifndef NO_UNAME
     struct utsname u;
     struct hostent *hp;
+#endif
 
     if (hostnameInited) {
         return hostname;
     }
-    
+
+#ifndef NO_UNAME
     if (uname(&u) > -1) {
         hp = gethostbyname(u.nodename);
         if (hp != NULL) {
@@ -61,5 +65,17 @@ Tcl_GetHostName()
         hostnameInited = 1;
         return hostname;
     }
-    return (char *) NULL;
+#else
+    /*
+     * Uname doesn't exist; try gethostname instead.
+     */
+
+    if (gethostname(hostname, sizeof(hostname)) > -1) {
+	hostnameInited = 1;
+        return hostname;
+    }
+#endif
+
+    hostname[0] = 0;
+    return hostname;
 }
diff --git a/contrib/tcl/unix/tclUnixTest.c b/contrib/tcl/unix/tclUnixTest.c
index 1fc95e6..67717d0 100644
--- a/contrib/tcl/unix/tclUnixTest.c
+++ b/contrib/tcl/unix/tclUnixTest.c
@@ -8,21 +8,30 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) tclUnixTest.c 1.1 96/03/26 12:44:30
+ * SCCS: @(#) tclUnixTest.c 1.4 97/05/14 13:24:29
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
 /*
+ * The following macros convert between TclFile's and fd's.  The conversion
+ * simple involves shifting fd's up by one to ensure that no valid fd is ever
+ * the same as NULL.  Note that this code is duplicated from tclUnixPipe.c
+ */
+
+#define MakeFile(fd) ((TclFile)((fd)+1))
+#define GetFd(file) (((int)file)-1)
+
+/*
  * The stuff below is used to keep track of file handlers created and
  * exercised by the "testfilehandler" command.
  */
 
 typedef struct Pipe {
-    Tcl_File readFile;		/* File handle for reading from the
+    TclFile readFile;		/* File handle for reading from the
 				 * pipe.  NULL means pipe doesn't exist yet. */
-    Tcl_File writeFile;		/* File handle for writing from the
+    TclFile writeFile;		/* File handle for writing from the
 				 * pipe. */
     int readCount;		/* Number of times the file handler for
 				 * this file has triggered and the file
@@ -43,6 +52,8 @@ static void		TestFileHandlerProc _ANSI_ARGS_((ClientData clientData,
 			    int mask));
 static int		TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 int			TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
@@ -70,6 +81,8 @@ TclplatformtestInit(interp)
 {
     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
@@ -104,15 +117,13 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
     int i, mask, timeout;
     static int initialized = 0;
     char buffer[4000];
-    Tcl_File file;
+    TclFile file;
 
     /*
      * NOTE: When we make this code work on Windows also, the following
      * variable needs to be made Unix-only.
      */
     
-    int fd;
-    
     if (!initialized) {
 	for (i = 0; i < MAX_PIPES; i++) {
 	    testPipes[i].readFile = NULL;
@@ -140,26 +151,10 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
     if (strcmp(argv[1], "close") == 0) {
 	for (i = 0; i < MAX_PIPES; i++) {
 	    if (testPipes[i].readFile != NULL) {
-		Tcl_DeleteFileHandler(testPipes[i].readFile);
-
-                /*
-                 * NOTE: Unix specific code below.
-                 */
-                
-                fd = (int) Tcl_GetFileInfo(testPipes[i].readFile, NULL);
-                close(fd);
-		Tcl_FreeFile(testPipes[i].readFile);
-
+		TclpCloseFile(testPipes[i].readFile);
 		testPipes[i].readFile = NULL;
-		Tcl_DeleteFileHandler(testPipes[i].writeFile);
-
-                /*
-                 * NOTE: Unix specific code below.
-                 */
-                
-                fd = (int) Tcl_GetFileInfo(testPipes[i].writeFile, NULL);
-		Tcl_FreeFile(testPipes[i].writeFile);
-                close(fd);
+		TclpCloseFile(testPipes[i].writeFile);
+		testPipes[i].writeFile = NULL;
 	    }
 	}
     } else if (strcmp(argv[1], "clear") == 0) {
@@ -170,13 +165,15 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	}
 	pipePtr->readCount = pipePtr->writeCount = 0;
     } else if (strcmp(argv[1], "counts") == 0) {
+	char buf[30];
+	
 	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                     argv[0], " counts index\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
-	sprintf(interp->result, "%d %d", pipePtr->readCount,
-		pipePtr->writeCount);
+	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "create") == 0) {
 	if (argc != 5) {
 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -185,18 +182,17 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 	if (pipePtr->readFile == NULL) {
-	    if (!TclCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
+	    if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
 		Tcl_AppendResult(interp, "couldn't open pipe: ",
 			Tcl_PosixError(interp), (char *) NULL);
 		return TCL_ERROR;
 	    }
 #ifdef O_NONBLOCK
-	    fcntl((int)Tcl_GetFileInfo(pipePtr->readFile, NULL),
-		    F_SETFL, O_NONBLOCK);
-	    fcntl((int)Tcl_GetFileInfo(pipePtr->writeFile, NULL),
-		    F_SETFL, O_NONBLOCK);
+	    fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
+	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
 #else
-	    interp->result = "can't make pipes non-blocking";
+	    Tcl_SetResult(interp, "can't make pipes non-blocking",
+		    TCL_STATIC);
 	    return TCL_ERROR;
 #endif
 	}
@@ -204,12 +200,12 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	pipePtr->writeCount = 0;
 
 	if (strcmp(argv[3], "readable") == 0) {
-	    Tcl_CreateFileHandler(pipePtr->readFile, TCL_READABLE,
+	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
 		    TestFileHandlerProc, (ClientData) pipePtr);
 	} else if (strcmp(argv[3], "off") == 0) {
-	    Tcl_DeleteFileHandler(pipePtr->readFile);
+	    Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
 	} else if (strcmp(argv[3], "disabled") == 0) {
-	    Tcl_CreateFileHandler(pipePtr->readFile, 0,
+	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
 		    TestFileHandlerProc, (ClientData) pipePtr);
 	} else {
 	    Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"",
@@ -217,12 +213,12 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 	if (strcmp(argv[4], "writable") == 0) {
-	    Tcl_CreateFileHandler(pipePtr->writeFile, TCL_WRITABLE,
+	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
 		    TestFileHandlerProc, (ClientData) pipePtr);
 	} else if (strcmp(argv[4], "off") == 0) {
-	    Tcl_DeleteFileHandler(pipePtr->writeFile);
+	    Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
 	} else if (strcmp(argv[4], "disabled") == 0) {
-	    Tcl_CreateFileHandler(pipePtr->writeFile, 0,
+	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
 		    TestFileHandlerProc, (ClientData) pipePtr);
 	} else {
 	    Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"",
@@ -236,12 +232,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 
-        /*
-         * NOTE: Unix specific code below.
-         */
-
-        fd = (int) Tcl_GetFileInfo(pipePtr->readFile, NULL);
-        while (read(fd, buffer, 4000) > 0) {
+        while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
             /* Empty loop body. */
         }
     } else if (strcmp(argv[1], "fill") == 0) {
@@ -251,29 +242,22 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	    return TCL_ERROR;
 	}
 
-        /*
-         * NOTE: Unix specific code below.
-         */
-
-        fd = (int) Tcl_GetFileInfo(pipePtr->writeFile, NULL);
 	memset((VOID *) buffer, 'a', 4000);
-        while (write(fd, buffer, 4000) > 0) {
+        while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
             /* Empty loop body. */
         }
     } else if (strcmp(argv[1], "fillpartial") == 0) {
+	char buf[30];
+	
 	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                     argv[0], " empty index\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 
-        /*
-         * NOTE: Unix specific code below.
-         */
-
-        fd = (int) Tcl_GetFileInfo(pipePtr->writeFile, NULL);
 	memset((VOID *) buffer, 'b', 10);
-	sprintf(interp->result, "%d", write(fd, buffer, 10));
+	sprintf(buf, "%d", write(GetFd(pipePtr->writeFile), buffer, 10));
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "oneevent") == 0) {
 	Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
     } else if (strcmp(argv[1], "wait") == 0) {
@@ -298,7 +282,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
 	if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	i = TclWaitForFile(file, mask, timeout);
+	i = TclUnixWaitForFile(GetFd(file), mask, timeout);
 	if (i & TCL_READABLE) {
 	    Tcl_AppendElement(interp, "readable");
 	}
@@ -335,6 +319,73 @@ static void TestFileHandlerProc(clientData, mask)
 /*
  *----------------------------------------------------------------------
  *
+ * TestfilewaitCmd --
+ *
+ *	This procedure implements the "testfilewait" command. It is
+ *	used to test TclUnixWaitForFile.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfilewaitCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int mask, result, timeout;
+    Tcl_Channel channel;
+    int fd;
+
+    if (argc != 4) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" file readable|writable|both timeout\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    channel = Tcl_GetChannel(interp, argv[1], NULL);
+    if (channel == NULL) {
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[2], "readable") == 0) {
+	mask = TCL_READABLE;
+    } else if (strcmp(argv[2], "writable") == 0){
+	mask = TCL_WRITABLE;
+    } else if (strcmp(argv[2], "both") == 0){
+	mask = TCL_WRITABLE|TCL_READABLE;
+    } else {
+	Tcl_AppendResult(interp, "bad argument \"", argv[2],
+		"\": must be readable, writable, or both", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetChannelHandle(channel, 
+	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
+	    (ClientData*) &fd) != TCL_OK) {
+	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    result = TclUnixWaitForFile(fd, mask, timeout);
+    if (result & TCL_READABLE) {
+	Tcl_AppendElement(interp, "readable");
+    }
+    if (result & TCL_WRITABLE) {
+	Tcl_AppendElement(interp, "writable");
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestgetopenfileCmd --
  *
  *	This procedure implements the "testgetopenfile" command. It is
diff --git a/contrib/tcl/unix/tclXtTest.c b/contrib/tcl/unix/tclXtTest.c
new file mode 100644
index 0000000..bb23256
--- /dev/null
+++ b/contrib/tcl/unix/tclXtTest.c
@@ -0,0 +1,113 @@
+/* 
+ * tclXtTest.c --
+ *
+ *	Contains commands for Xt notifier specific tests on Unix.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclXtTest.c 1.1 97/03/24 14:30:42
+ */
+
+#include <X11/Intrinsic.h>
+#include "tcl.h"
+
+static int	TesteventloopCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tclxttest_Init --
+ *
+ *	This procedure performs application-specific initialization.
+ *	Most applications, especially those that incorporate additional
+ *	packages, will have their own version of this procedure.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code, and leaves an error
+ *	message in interp->result if an error occurs.
+ *
+ * Side effects:
+ *	Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tclxttest_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter for application. */
+{
+    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TesteventloopCmd --
+ *
+ *	This procedure implements the "testeventloop" command. It is
+ *	used to test the Tcl notifier from an "external" event loop
+ *	(i.e. not Tcl_DoOneEvent()).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TesteventloopCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    static int *framePtr = NULL; /* Pointer to integer on stack frame of
+				  * innermost invocation of the "wait"
+				  * subcommand. */
+
+   if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " option ... \"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "done") == 0) {
+	*framePtr = 1;
+    } else if (strcmp(argv[1], "wait") == 0) {
+	int *oldFramePtr;
+	int done;
+	int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+
+	/*
+	 * Save the old stack frame pointer and set up the current frame.
+	 */
+
+	oldFramePtr = framePtr;
+	framePtr = &done;
+
+	/*
+	 * Enter an Xt event loop until the flag changes.
+	 * Note that we do not explicitly call Tcl_ServiceEvent().
+	 */
+
+	done = 0;
+	while (!done) {
+	    XtProcessEvent(XtIMAll);
+	}
+	(void) Tcl_SetServiceMode(oldMode);
+	framePtr = oldFramePtr;
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be done or wait", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}