import dejagnu-1999-11-08 snapshotdejagnu-1999-11-08

495 files changed, 218086 insertions, 0 deletions

diff --git a/tcl/ChangeLog b/tcl/ChangeLog
new file mode 100644
index 00000000000..9522130234b
--- /dev/null
+++ b/tcl/ChangeLog
@@ -0,0 +1,854 @@
+1999-10-26  DJ Delorie  <dj@cygnus.com>
+
+	* cygwin/*: new; replicate unix/* setup (other modules look
+	in unix/* for "local" builds; we don't want them to find the
+	cygwin version)
+	* unix/Makefile.in: undo
+	* configure.in: For cygwin, build win and cygwin
+	* Makefile.in: re-enable multi-dir support
+
+Tue Oct 26 13:16:09 1999  Christopher Faylor <cgf@cygnus.com>
+
+	* win/configure.in: Add better detection of cross-compilation
+	environment.
+	* win/configure: Regenerate.
+
+1999-10-20  DJ Delorie  <dj@cygnus.com>
+
+	* Makefile.in: temporarily disable second subdirectory
+
+1999-10-19  DJ Delorie  <dj@cygnus.com>
+
+	* Makefile.in: support two subdirectories
+	* configure[.in]: for Cygwin, build both win and unix variants
+	* generic/tclEnv.c: include windows.h for cygwin
+	* generic/tclPort.h: If building the unix variant for cygwin,
+	pretend we're a unix machine instead of a windows machine.
+	* unix/Makefile.in: don't list -lc; it breaks on cygwin.
+	* unix/tclUnixFCmd.c: don't support fifos on cygwin
+
+1999-08-05  DJ Delorie  <dj@cygnus.com>
+
+	* win/tclWinInit.c (TclPlatformInit): add tcl_pkgPath hack
+
+1999-05-18  Fred Fish  <fnf@cygnus.com>
+
+	* generic/tclPosixStr.c	(Tcl_ErrnoId): Avoid duplicate case when
+	ENOTSUP and EOPNOTSUPP are defined to the same thing.
+	(Tcl_ErrnoMsg): Ditto.
+
+Fri Feb 26 17:40:55 1999  Geoffrey Noer  <noer@cygnus.com>
+
+        * win/configure.in: change "cygwin32*" to "cygwin*"
+        * win/configure: Regenerated.
+        * configure.in: Change "cygwin32*" to "cygwin*"
+        * configure: Regenerate.
+
+1999-02-11  Syd Polk  <spolk@cygnus.com>
+
+	* unix/configure.in: Forgot to AC_SUBST TCL_LIB_FULL_PATH
+	* unix/configure: Regenerated.
+
+1999-02-10  Syd Polk  <spolk@cygnus.com>
+
+	* unix/configure.in unix/tclConfig.sh.in: Export TCL_LIB_FULL_PATH 
+	for dependencies.
+	* unix/configure: Regenerated.
+
+1999-01-27  James Ingham  <jingham@cygnus.com>
+
+	* generic/tclInitScript.h: Added two missing \n\'s to initScript
+	*generic/tclCmdIL.c: Fixed #ifdef that was giving gcc warning.
+
+1999-01-20  James Ingham  <jingham@cygnus.com>
+
+	* library/init.tcl (auto_mkindex_parser::mkindex): Clean out the parser
+	interpreter completely between each file, rather than
+	trying to remove imports by hand.  The latter method loses with
+	IncrTcl, since that imports the class command by hand, and if you
+	ever do "namespace import itcl::*" in your code, this will get
+	undone. 
+
+Tue Nov 24 18:27:40 1998  Jim Ingham    jingham@cygnus.com
+
+        * Import of Tcl8.0.4 from Scriptics.
+
+Thu Sep 17 17:03:18 1998  Martin M. Hunt  <hunt@cygnus.com>
+
+	* configure: Rebuilt
+	* unix/configure: Rebuilt
+
+Tue Aug 25 18:13:30 1998  Jim Ingham    <jingham@cygnus.com>
+
+        * init.tcl (tcl_findLibrary): Added an argument determining
+        whether to source a packages init file into the TclPro
+        debugger or not.
+
+Thu Aug 20 14:32:59 1998  Jim Ingham    jingham@cygnus.com
+
+	* Import of Tcl 8.0.3 from Scriptics, with our modifications.
+	I also changed the Sciptics startup code so it can find our
+        libraries whether in the build tree or the install tree.
+
+1998-07-03  Ben Elliston  <bje@cygnus.com>
+
+	Patches from Ian Roxborough <irox@cygnus.com>.
+	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Additional test when
+	compiling with Microsoft Visual C++.
+
+	* win/configure.in: Add AC_OBJEXT macro invocation.
+
+	* win/configure: Regenerate.
+
+	* win/Makefile.in: Don't assume object files end in `.o'.
+
+	* win/tclWinPort.h (PASCAL): Define when compiling with Microsoft
+	Visual C++.
+
+	* win/tclWinSock.c (PASCAL): Likewise.
+	
+Tue Jun 30 18:56:27 1998 Jim Ingham <jingham@cygnus.com>
+
+	* generic/tclListObj.c (Tcl_SetListObj, SetListFromAny) Import a 
+	change to the list code from tcl8.1 which prevents a crash 
+	when you do Tcl_SetListObj(obj, 0, NULL) on an object which 
+	has been created with Tcl_NewObj, but never written into.
+
+Thu Jun 18 10:25:00 1998  Syd Polk  <spolk@cygnus.com>
+	
+	* The import from Tcl 8.1a2 created all of the files that wer
+	in the Tcl 8.1a2 distribution but not in devo. Since they
+	are on their own branch, I removed them from devo.
+
+Fri Jun 12 11:42:30 1998  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/install-sh: Remove.
+
+Fri Jun 12 11:42:10 1998  Mumit Khan  <khan@xraylith.wisc.edu>
+
+	* configure.in (*-*-mingw32*): Support.
+	* win/Makefile.in (TCL_ALLOC_OBJ, DLL_LDLIBS, DLL_LDFLAGS): New 
+	variables.
+	(TCLOBJS): Use TCL_ALLOC_OBJ.
+	($(TMPDIR)/tclcyg.def): Ignore errors.
+	($(TMPDIR)/tclplugin.def): Likewise.
+	($(TCLDLL),$(TCLPLUGINDLL,$(TCLREGDLL)): Cleanup DLL build flags 
+	and use TCL_ALLOC_OBJ, DLL_LDLIBS and DLL_LDFLAGS.
+	* win/configure.in: Call AC_CANONICAL_HOST.
+	(TCL_ALLOC_OBJ, DLL_LDLIBS, DLL_LDFLAGS): Define and substitute.
+	(TCL_PATCH_LEVEL): Bump to p2.
+	* win/tclWinPort.h (environ, hypot, exception): Define for Mingw32.
+	(EDEADLOCK): Undefine for Mingw32.
+	* win/configure: Rebuild.
+
+Fri May 29 17:11:01 1998  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in (install-minimal): Don't create
+	INCLUDE_INSTALL_DIR.
+
+Sun May 24 11:18:28 1998  Khamis Abuelkomboz  <khamis@mxbig.multix.de>
+
+	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): using strnicmp for MSVC,
+	strncasecmp otherwise.
+
+Fri May 22 16:56:53 1998  Khamis Abuelkomboz  <khamis@mxbig.multix.de>
+
+	* generic/tclCmdIL.c (NOCASE): let lsearch accept "-nocase"
+	(DICTIONARY): likewise, a synonym for "nocase".
+	So you can call lsearch with a "-nocase" or "-dictionary" flag to
+	use strcasecmp to find an item.
+
+Thu Apr 30 18:10:15 1998  Geoffrey Noer  <noer@cygnus.com>
+
+	* win/Makefile.in: invoke gcc instead of ld when producing
+        dlls.  Pass the linker options down via args to -Wl options.
+
+Mon Apr 20 11:40:23 MEST 1998 Khamis Abuelkomboz <khamis@cygnus.com>
+	*tcl/win tclWinPipe.c
+	(PipeWatchProc): Mask PipeThread using (LPTHREAD_START_ROUTINE) to 
+		remind bogus messages.
+
+Tue Apr  7 16:36:49 1998  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinFile.c: If __CYGWIN32__, call chdir rather than
+	SetCurrentDirectory, so that the cygwin32 DLL knows the current
+	directory when doing path munging.
+
+Sat Mar 21 21:18:06 1998  Elena Zannoni  <ezannoni@kwikemart.cygnus.com>
+	
+	Merged changes from Foundry (list follows in reverse chronological 
+        order)
+
+        - Tom Tromey  <tromey@cygnus.com>
+	* library/init.tcl (auto_execok): If ide_cygwin_path command is
+	defined, the convert PATH environment variable to Win32 path list
+	before use.
+	* win/stub16.c: Include <string.h>.
+	* win/tclWinInit.c (TclPlatformInit): Don't look in registry to
+	find default tcl_library setting.
+
+        - Ian Lance Taylor  <ian@cygnus.com>
+	* win/Makefile.in ($(TCLDLL)): Don't generate relocs for debugging
+	information.
+	($(TCLPLUGINDLL), $(TCLREGDLL)): Likewise.
+	* generic/tclIOUtil.c (Tcl_EvalFile): Put the newly allocated
+	buffer into an object and use Tcl_EvalObj, rather than having
+	Tcl_Eval copy the buffer.
+	* generic/tclEnv.c (TclSetEnv): Don't set the env array if the
+	value is the same as the one we are trying to set.
+  
+Sat Feb 21 08:59:00 1998  Chris Provenzano  <proven@cygnus.com>
+
+	* Makefile.in, unix/Makefile.in
+	Don't set shell to /bin/sh. Set it to @SHELL@
+
+	* configure: Regenerated with support for @SHELL@ substitution
+
+Mon Feb  9 16:02:47 1998  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/configure.in: Call AC_PROG_RANLIB so that TCL_RANLIB gets
+	set correctly in tclConfig.sh.
+	* win/configure: Rebuild.
+
+Tue Jan 20 19:24:22 1998  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinChan.c (TclGetDefaultStdChannel): Check for error
+	return from Tcl_MakeFileChannel.
+
+Tue Dec 23 16:25:02 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in ($(TCLDLL)): Don't generate relocs for debugging
+	information.
+	($(TCLPLUGINDLL), $(TCLREGDLL)): Likewise.
+
+Wed Nov  5 00:50:32 1997  Martin M. Hunt  <hunt@cygnus.com>
+
+	* library/word.tcl: Always use Motif-style selections.
+
+Tue Oct 28 17:44:15 1997  Martin M. Hunt  <hunt@cygnus.com>
+
+	* win/tclWinChan.c (Tcl_OpenFileChannel): Patch "winchan.txt"
+	from net. Fixes problems with PC-NFS access.
+
+	* win/tclWinSock.c (Tcl_GetHostName): Fix problem where
+	[info hostname] crashes on NT 4.0 machines that do not have 
+	networking installed. Patch from Darrel Schneider 
+	<darrel@gemstone.com>
+
+Tue Oct 28 16:31:46 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* Makefile.in (install-minimal): New target.
+	* win/Makefile.in (install-minimal): New target.
+
+Wed Oct 15 18:58:32 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinPort.h: If __CYGWIN32__, define TclpAlloc, TclpFree,
+	and TclpRealloc rather than TclpSysAlloc, TclpSysFree, and
+	TclpSysRealloc.
+	* win/Makefile.in (TCLOBJS): Remove tclAlloc.o.
+
+Thu Sep 25 02:57:00 1997  Martin M. Hunt  <hunt@cygnus.com>
+
+	* generic/tclCmdAH.c (Tcl_FormatObjCmd): This fixes an 
+	off-by-one error in the format command that can lead to memory 
+	corruption on some systems, most notable little endian systems, 
+	such as Intel. Patch "format.txt" from patches archive.
+
+	* unix/tclUnixChan.c (TcpGetOptionProc): Applied patch
+	"unixchan.txt" from patches archive.
+
+Tue Sep 23 14:31:01 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* generic/tclStringObj.c (Tcl_DbNewStringObj): Don't die if
+	bytes==NULL.  From schoenw@gaertner.de (Juergen Schoenwaelder).
+
+	* generic/tclIO.c (Tcl_SetChannelOption): Allow output translation
+	mode to be "auto".  From Dave Dykstra <dwd@bell-labs.com>.
+
+Thu Sep  4 11:29:14 1997  Martin M. Hunt  <hunt@cygnus.com>
+
+	* generic/tclIO.c: Applied patch "io.txt" from the
+	patches archive.
+
+Tue Sep  2 16:49:16 PDT 1997 Khamis Abuelkomboz <khamis@cygnus.com>
+	* library/menu.tcl
+	In this file I have found two bugs:
+	One in focus policy (wrong function call)
+	and the main error was by the tkMenuUnpost procedure (toplevel problem).
+	Generaly this script doesn't work correctly at all and I don't
+	know if we have the latest version of this file.
+
+Thu Aug 28 17:20:57 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in (install-libraries): Install http2.0 and
+	opt0.1.
+
+	* generic/tclEnv.c (TclCygwin32Putenv): Call unsetenv rather than
+	putenv to remove the variable.
+
+	* generic/tclAlloc.c: Don't define caddr_t if __CYGWIN32__.
+
+Thu Aug 28 15:31:05 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
+	* generic/tclCompile.c generic/tclEnv.c generic/tclTestObj.c
+	  unix/tclUnixFCmd.c
+
+	* Memory bug fixes.
+Sun Aug 24 21:35:19 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in ($(TCLDLL)): Set base address to 0x66000000.
+	($(TCLREGDLL)): Set base address to 0x66200000.
+
+Thu Aug 21 12:49:47 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinPipe.c (Tcl_WaitPid): If __CYGWIN32__, handle a
+	cygwin32 signal exit status correctly.
+
+	* win/tclWinPipe.c (PipeThread): Only set PIPE_READAHEAD if we
+	really did read a byte.  Set PIPE_READABLE if ReadFile completes.
+	(PipeProc): Don't bother to set PIPE_READABLE either.
+	(PipeSetupProc): Handle a read from a pipe without a thread.
+	(PipeCheckProc): Likewise.
+
+Wed Aug 20 23:17:23 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinPipe.c (PIPE_READABLE, PIPE_CLOSED): Define.
+	(PIPE_HAS_THREAD, PIPE_READAHEAD): Define.
+	(PipeInfo): Add fields: flagsMutex, mutex, tryReadEvent,
+	readAhead.
+	(pipeHwnd): New static variable.
+	(PipeGetFlags, PipeSetFlag, PipeResetFlag): New static functions.
+	Use them for all access to the flags field of a pipe.
+	(PipeThread): New static function.
+	(PipeProc): New static function.
+	(PipeInit): Set up pipe window class and window.
+	(PipeExitHandler): Unregister the class and destroy the window.
+	(PipeSetupProc): Only set the block time to 0 for a readable pipe
+	if we know that it is readable.  If we want read events, tell the
+	thread to try a read.
+	(PipeCheckProc): Only post an event for a readable pipe if we know
+	that it is readable.
+	(TclpCreateCommandChannel): Create the flags mutex.
+	(PipeCloseProc): If the pipe has a thread, tell the thread the
+	pipe is closed, and let it free everything.  Otherwise, close the
+	flags mutex.
+	(PipeInputProc): Lock the pipe during the function.  Use the
+	readahead byte if it is available.  Reset PIPE_READABLE.
+	(PipeEventProc): Check PIPE_READABLE if we have a thread.
+	(PipeWatchProc): Create a thread if we want read events.
+
+Tue Aug 19 16:34:54 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
+	* generic/tclEnv.c
+	  Removed patch from EnvExitProc()
+
+Mon Aug 18 20:15:23 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinPipe.c (TclpCreateProcess): Make sure the pipe stuff
+	is initialized.
+
+	* win/tclWin32Dll.c (TclSetSystemEnv): If we set Path, clear
+	PATH.  If we set PATH, clear Path.
+
+Fri Aug 15 19:20:44 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinInit.c (initScript): Look up one more level, to allow
+	for exec-prefix being a subdirectory of prefix.
+
+Wed Aug 13 13:22:15 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* generic/tclPipe.c (TclCreatePipeline): Check explicitly for
+	redirecting stderr to stdout, and handle it by making the stderr
+	file a copy of the stdout file.
+
+	* generic/tclEnv.c (TclSetEnv): Call TclSetSystemEnv before
+	calling Tcl_SetVar2.
+
+Mon Aug 11 19:39:45 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* configure.in: Call AC_CANONICAL_HOST.  Check host, not target,
+	for cygwin32.
+	* configure: Rebuild.
+
+Sat Aug  9 20:27:48 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinSock.c (SocketEventProc): Handle an FD_CONNECT event
+	for a client channel.  On FD_CLOSE for a client channel, set
+	TCL_WRITABLE.
+	(Tcl_MakeTcpClientChannel): Select for FD_CONNECT.
+	(TcpWatchProc): Watch for FD_CLOSE on a client channel when
+	looking for writable.  Watch for FD_CONNECT on a client channel in
+	all cases.
+
+Thu Aug  7 12:44:49 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinSock.c: Add clientChannel field.
+	(SocketEventProc): Handle FD_ACCEPT on a client channel by setting
+	TCL_READABLE.
+	(NewSocketInfo): Initialize clientChannel field to 0.
+	(Tcl_MakeTcpClientChannel): Set clientChannel field to 1.  Select
+	for FD_ACCEPT.
+
+	* win/tclWinInit.c (initScript): Use share rather than lib.
+
+Wed Aug  6 20:49:13 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in: Update for Tcl 8.0.
+	* win/configure.in: Likewise.
+	* win/configure: Rebuild.
+	* win/tclWin32Dll.c (TclSetSystemEnv): Handle a NULL value.
+	* win/tclWinChan.c (Tcl_OpenFileChannel): Move conv_to_win32_path
+	call after Tcl_TranslateFileName call.
+	* win/tclWinFile.c: Don't include <shlobj.h> if __CYGWIN32__.
+	(TclWinStat): Don't adjust stat times if __CYGWIN32__.
+
+Tue Aug  5 13:25:43 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* win/tclWinPipe.c: Preserved local changes.
+	* win/tclWinSock.c: Preserved local changes.
+	* win/tclWinChan.c: Preserved local changes.
+
+Mon Aug  4 16:23:53 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* tests/fCmd.test: fCmd-8.1 test marked nonportable; removed local
+	changes.
+
+	* tests/defs: Preserved local changes.
+
+Fri Aug  1 16:51:03 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinChan.c (Tcl_OpenFileChannel): If __CYGWIN32__, convert
+	the path name to a win32 path name.
+
+Wed Jul 23 20:03:07 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinSock.c (TclWinWatchSocket): Only set the maximum block
+	time to zero if we have an event that matches something in the
+	desired mask.
+
+Mon Jun 30 13:38:43 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/tclWinPipe.c (TclpCreateProcess): Our DLL is named
+	cygtclpip, not tclpip.
+
+	* generic/tclEnv.c: If __CYGWIN32__, define environ as a static
+	variable.
+	(EnvInit): If __CYGWIN32__, initialize environ from
+	__imp___cygwin_environ.
+	* win/tclWinPort.h (__imp___cygwin_environ): Don't declare.
+	(environ): Don't define.
+	(TclSetSystemEnv): If __CYGWIN32__, declare as function, don't
+	define as macro.
+	* win/tclWin32Dll.c (TclSetSystemEnv): New function.
+
+Thu Jun 26 13:56:01 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in (WINDRES): New variable.
+	(install-binaries): Don't install DLLs here...
+	(install-libraries): ...install them here instead.
+	($(TCLDLL)): Depend upon and link with tclres.o.
+	($(TCLSH)): Depend upon and link with tclshres.o.
+	($(TCLTEST)): Likewise.
+	(tclres.o, tclshres.o): New targets.
+	* win/configure.in: Define and substitute WINDRES.
+	* win/configure: Rebuild.
+
+Mon Jun 23 10:15:10 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* Makefile.in (install-binaries, install-libraries): New targets.
+
+Wed Jun 18 12:12:36 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in: Copy install, install-binaries, and
+	install-libraries rules, and associated variables from
+	unix/Makefile.in, with appropriate adjustments.
+
+Thu Jun 12 19:12:20 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* win/Makefile.in ($(TMPDIR)/tclcyg.def): Don't export
+	impure_ptr.
+
+Fri Jun  6 15:52:50 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	Add support for building with cygwin32:
+	* win/Makefile.in: Rewrite completely based on makefile.vc.
+	* win/configure.in: Rewrite completely.
+	* win/configure: Rebuild.
+	* win/tclWinPort.h (__imp___cygwin_environ): Declare if
+	__CYGWIN32__.
+	(environ): Define if __CYGWIN32__.
+	* win/tclWin32Dll.c (_impure_ptr): Define if __CYGWIN32__.
+	(__imp_reent_data): Declare if __CYGWIN32__.
+	(DllMain): Initialize _impure_ptr if __CYGWIN32__.
+	* win/tclWinFCmd.c (TclpRenameFile): Don't use try and except if
+	__GNUC__.
+ 	(TclpCopyFile): Likewise.
+	* win/tclWinPipe.c: Don't include dos.h if __CYGWIN32__.
+	* win/tclWinSock.c (InitSockets): Don't cast to PASCAL FAR if
+	__GNUC__.
+
+Thu Jun  5 18:17:53 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* generic/tcl.h (USE_TCLALLOC): Don't define USE_TCLALLOC if it is
+	already defined (this modifies a CYGNUS LOCAL patch).
+
+Fri May  9 09:36:00 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* patchlevel.h: Removed.
+
+Wed Apr  9 17:31:41 1997  Bob Manson  <manson@charmed.cygnus.com>
+
+	* generic/regexp.c (regmatch): Speed up .* matching
+ 	significantly. Treat a single bracketed character the same as a
+ 	string.
+
+Thu Mar 20 14:27:45 1997  Geoffrey Noer  <noer@cygnus.com>
+
+        * compat/strncasecmp.c: fix args in prototype for strcasecmp
+
+Fri Mar 14 10:36:30 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* tests/fCmd.test: Commented out fcmd-8.1 test.
+
+Fri Mar  7 10:46:04 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* Updated to Tcl 7.6p2 and preserved Cygnus changes.
+
+Wed Mar  5 12:00:44 1997  Martin  <hunt@cyber>
+
+	* Makefile.in, configure.in: Added support for building
+	the windows directory.
+	* configure: Rebuilt.
+
+Fri Dec 13 15:47:07 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* compat/strtod.c: Include ../compat/stdlib.h, not
+	compat/stdlib.h.  From Donald Koch <koch@cognex.com>.
+
+Wed Nov 20 14:07:06 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* generic/tclAlloc.c: Removed; functionality has been integrated
+	into Tcl core.
+
+Tue Nov 19 09:30:41 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* generic/tcl.h: Remove redundant decls of Tcl_Alloc and friends.
+
+Mon Nov 18 14:59:47 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* generic/tclAlloc.c (Tcl_Alloc): Renamed.
+	* generic/tcl.h: Always define USE_TCLALLOC.
+
+	* Imported Tcl 7.6 and preserved local changes.
+
+Mon Aug  5 10:41:11 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (configure): Don't depend on configure.in.
+	(config.status): Depend on configure.
+
+Wed Jul 31 14:41:34 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tests/socket.test: Commented out test socket-8.1; it can fail on
+	Solaris 2.4.
+
+Tue Jul 30 14:53:59 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tests/socket.test: Find remote.tcl in srcdir.
+	* tests/io.test: Find io.test in srcdir.
+	* tests/defs: Find "defs" in directory $srcdir.
+
+Wed Jun 26 12:36:57 1996  Jason Molenda  (crash@godzilla.cygnus.co.jp)
+
+	* configure.in (AC_PREREQ): autoconf 2.5 or higher.
+	* configure: Rebuilt.
+
+Thu Jun  6 15:04:44 1996  Gordon Irlam  <gordoni@snuffle.cygnus.com>
+
+	* doc/usenix.ps, doc/usenix.text: Removed because copyright status
+	unclear.
+
+Mon May 20 16:11:55 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tcltk-man-html.tcl: Moved to devo/inet.
+
+Mon May  6 15:21:14 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* tcltk-man-html.tcl: Search Tk section 3 man pages if possible.
+
+Wed May  1 15:17:14 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* tcltk-man-html.tcl: New file.
+
+Thu Mar  7 10:01:05 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (config.status): Don't depend on configure.
+
+Wed Mar  6 10:48:56 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (Makefile): Removed redundant rule.
+
+Thu Feb 29 21:27:38 1996  Fred Fish  <fnf@ninemoons.com>
+
+	* Makefile.in (configure): Run autoconf in source dir,
+	not build dir.
+
+Thu Feb 29 09:08:52 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (Makefile): New rule.
+	(config.status): New rule.
+
+	* tests/all: Use $srcdir to find tests.
+	Source `defs' here.
+	Only print filename, not entire path.
+
+Tue Feb 27 20:40:56 1996  Rob Savoye  <rob@chinadoll.cygnus.com>
+
+	* unix/configure.in: Use -fpic for dltests, as gcc now support
+	shared libraries on HPUX.
+	* configure: Rebuild.
+
+Mon Feb 12 14:55:34 1996  Rob Savoye  <rob@chinadoll.cygnus.com>
+
+	* unix/configure.in: Set the shared lib flags so the dynamic
+	loading tests work for SunOS and Solaris when using GCC.
+
+Wed Jan 24 09:41:00 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in: Replaced realclean with maintainer-clean.
+
+Mon Jan 22 14:42:47 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tests/all: Print message when tests finished.
+
+	* Makefile.in (check): Use absolute directory when finding
+	TCL_LIBRARY.
+
+Fri Jan 19 10:35:16 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (check installcheck): Moved from unix/Makefile.in.
+
+Thu Jan 11 14:41:35 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (test): New target.
+
+Wed Jan 10 11:21:38 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (mostlyclean-recursive clean-recursive
+	distclean-recursive realclean-recursive): Separated out recursive
+	rules.
+
+Tue Jan  9 17:34:56 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in: New file.
+	* configure.in: New file.
+
+	* Updated to the tcl7.5a2 release, plus preserved our patches.
+	Entries past this point mostly likely refer to files in various
+	subdirectories.
+
+Fri Dec  1 10:18:01 1995  Rob Savoye  <rob@chinadoll.cygnus.com>
+
+	* Makefile.in, changes, configure, patchlevel.h, tcl.h,
+	tclBasic.c, tclCkalloc.c, tclCmdAH.c, tclCmdMZ.c, tclInt.h,
+	tclMain.c, tclPort.h, tclRegexp.h, tclUnixAZ.c, tclUnixStr.c,
+	tclUnixUtil.c, tclVar.c, README, compat/fixstrtod.c,
+	tests/lsort.test, testsuite/config/default.exp,
+	testsuite/tcl.tests/tcl-test.exp: Upgrade to Tcl7.4p3 to fix a few
+	bugs.
+
+Thu Nov 16 10:01:20 1995  Rob Savoye  <rob@chinadoll.cygnus.com>
+
+	* configure.in: Use AC_PROG_CC again since Cygnus configure now
+	does the sames thing.
+
+Sat Oct  7 20:51:29 1995  Michael Meissner  <meissner@cygnus.com>
+
+	* tcl.h (ckrealloc): Cast pointer argument to char * to silence
+	warnings.
+
+Sun Aug 20 00:43:51 1995  Jason Molenda  (crash@phydeaux.cygnus.com)
+
+	* configure.in: If the system has a functional strtod(), *don't*
+	provide one.
+
+Thu Aug 17 16:04:39 1995  Rob Savoye  <rob@darkstar.cygnus.com>
+
+	* tcl: Updated to the official tcl7.4 release, plus preserved
+	  our patches.
+
+Sun Aug  6 11:45:19 1995  Fred Fish  <fnf@cygnus.com>
+
+	* Makefile.in (distclean):  Remove config.cache & config.log
+
+Mon Jun 12 15:46:48 1995  J.T. Conklin  <jtc@rtl.cygnus.com>
+
+	* tclAlloc.c: New file.
+	* tcl.h (Tcl_Malloc, Tcl_Realloc, Tcl_Free): New functions.
+	  (ckalloc, ckrealloc, ckfree): Defined to Tcl_Malloc, Tcl_Free
+	  respectively when compiling without TCL_MEM_DEBUG.
+	* Makefile.in (GENERIC_OBJS): Added tclAlloc.o
+	  (SRCS): Added tclAlloc.c.
+
+Thu Apr  6 19:32:43 1995  Doug Evans  <dje@chestnut.cygnus.com>
+
+	* tclPort.h (gettimeofday): Comment out prototype.
+
+Thu Mar 23 17:58:38 1995  Rob Savoye  <rob@thepub.cygnus.com>
+
+	* tcl: Upgrade to 7.4.b2. Update configure.in to autoconf 2.2,
+	merge in our LynxOS patches.
+
+Wed Dec 21 15:12:14 1994  J.T. Conklin  (jtc@phishhead.cygnus.com)
+
+	* tclUnixUtil.c: Use __Lynx__ in the conditional which selects
+	  LynxOS-specific waitpid() prototype.
+
+Mon Dec 19 04:38:49 1994  Angela Marie Thomas  <angela@cygnus.com>
+
+	* Makefile.in (all): use ${AR_FLAGS}, not ${ARFLAGS} because the
+	"make" default for ${ARFLAGS} includes an option, f, which I can't
+	find in any man page and breaks builds.
+
+Tue Jun  7 07:44:31 1994  D. V. Henkel-Wallace  (gumby@cygnus.com)
+
+	* compat/tmpnam.c: handle losing LynxOS mktemp.
+
+Thu May 26 20:15:55 1994  David J. Mackenzie  (djm@poseidon.cygnus.com)
+
+	* aclocal.m4 (TCL_LYNX_POSIX): Renamed from AC_LYNX_POSIX.
+	Check __GNUC__ value to get POSIX flag right.
+	* configure.in: Use new name.
+	* configure: Regenerate.
+
+Wed May  4 20:17:46 1994  D. V. Henkel-Wallace  (gumby@cygnus.com)
+
+	* compat/tmpnam.c: if you're going to redefine P_tmpdir,
+	undefine it first.
+
+	* compat/strerror.c: undefine various error codes which are
+	defined in terms of others, where that causes duplicated case
+	labels on r/s6000 lynxos 2.2.2.
+
+Sat Apr 23 17:10:13 1994  Bill Cox  (bill@rtl.cygnus.com)
+
+	* compat/getcwd.c: The contents of this file was the UCB
+	  float.h file.  Restored the correct contents from devo.
+
+Fri Apr 22 11:28:35 1994  Bill Cox  (bill@cygnus.com)
+
+	* tclUnixUtil.c: Make a new prototype for waitpid if
+	  we're compiling under the Lynx version of gcc.
+
+Thu Mar 31 19:36:44 1994  Ken Raeburn  (raeburn@cujo.cygnus.com)
+
+	* install.sh: Since "set -e" is in effect, don't use a test that
+	can fail in a while condition; it confuses some shells.  Use break
+	instead.  Use "case" rather than "if [" for efficiency with some
+	shells.
+
+Tue Jan  4 17:03:31 1994  Rob Savoye  (rob@rtl.cygnus.com)
+
+	* All files: Upgraded to Tcl7.3. This version has incompatablities
+	with the old versions before 7.0.
+
+Tue Nov 23 13:01:22 1993  Rob Savoye  (rob@darkstar.cygnus.com)
+
+	* configure.in: Use AC_HEADER_CHECK for unistd.h.
+
+Tue Nov  9 19:07:39 1993  Rob Savoye  (rob@cygnus.com)
+
+	* tclUnixStr.c (Tcl_ErrnoId): Added cpp tests for duplicate
+	defines that choked LynxOS.
+
+Fri Oct  1 17:30:06 1993  Doug Evans  (dje@canuck.cygnus.com)
+
+	* Makefile.in (tclTest.o): Sun VPATH lossage.
+
+Tue Aug 17 11:23:27 1993  david d `zoo' zuhn  (zoo@rtl.cygnus.com)
+
+	* Makefile.in (install): don't install *.tcl all at once
+
+Thu Jul  8 09:24:47 1993  Doug Evans  (dje@canuck.cygnus.com)
+
+	* Makefile.in: Add stuff needed to make Sun VPATH work.
+
+Thu May  6 12:04:52 1993  Rob Savoye  (rob at darkstar.cygnus.com)
+
+	* Makefile.in: Install the manpages too.
+
+Tue May  4 22:01:24 1993  Rob Savoye  (rob at darkstar.cygnus.com)
+
+	* tclUnix.h: Don't set TCL_PID_T anymore. FInd the right dirent.h.
+	* configure.in: Handle no pid_t in sys/types.h. Also also check
+	for dirent.h.
+	* Makefile.in: Let INSTALL_PROGRAM and INSTALL_DATA come from
+	configure.
+
+Fri Apr 16 07:25:07 1993  Fred Fish  (fnf@lisa.cygnus.com)
+
+	* configure (DEFS):  When defining "-Dconst=" define "-DCONST="
+	as well, for the sake of things in compat/* that use it.
+
+	* Makefile.in (opendir.c):  Add missing ../compat/..
+
+Mon Apr  5 10:56:28 1993  Rob Savoye  (rob@cygnus.com)
+
+	* testsuite/config/unix-tcl.exp: Use tcl/tclTest for test code
+	driver. 
+	* Makefile.in, testsuite/*.in, testsuite/tcl.tests/*.in: Don't use
+	Cygnus configure anymore.
+
+Wed Mar 24 02:09:33 1993  david d `zoo' zuhn  (zoo at poseidon.cygnus.com)
+
+	* Makefile.in: add installcheck & dvi targets
+
+Fri Mar 19 21:07:25 1993  david d `zoo' zuhn  (zoo at cirdan.cygnus.com)
+
+	* tclEnv.c: disable putenv.  no one uses it.
+
+Mon Feb 22 07:54:03 1993  Mike Werner  (mtw@poseidon.cygnus.com)
+
+        * tcl/testsuite: made modifications to testcases, etc., to allow
+        them to work properly  given the reorganization of deja-gnu and the
+        relocation of the testcases from deja-gnu to a "tool" subdirectory.
+
+Sun Feb 21 10:55:55 1993  Mike Werner  (mtw@poseidon.cygnus.com)
+
+	* tcl/testsuite: Initial creation of tcl/testsuite.
+	Migrated dejagnu testcases and support files for testing nm to
+	tcl/testsuite from deja-gnu.  These files were moved "as is"
+	with no modifications.	This migration is part of a major overhaul
+	of dejagnu.  The modifications to these testcases, etc., which
+	will allow them to work with the new version of dejagnu will be
+	made in a future update.
+
+Thu Feb 18 11:31:05 1993  Fred Fish  (fnf@cygnus.com)
+
+	* tclEnv.c (putenv):  On at least the Sun and SVR4, and possibly
+	most other systems, the argument is just "char *", not
+	"const char *".
+
+Sat Dec 26 11:13:40 1992  Fred Fish  (fnf@cygnus.com)
+
+	* tclUnix.h (fseek):  Returns int, not long.  True for both
+	ANSI-C and traditional C unix environments.
+
+Wed Dec 16 11:02:29 1992  Ian Lance Taylor  (ian@cygnus.com)
+
+	* configure.in: check for gettimeofday, and define TCL_GETTOD
+	accordingly.
+	* configure: regenerated.
+
+Fri Nov 27 19:09:03 1992  david d `zoo' zuhn  (zoo at cirdan.cygnus.com)
+
+	* Makefile.in: don't make TCL_INCLUDE a subdir of $(includedir)
+
+Fri Nov 20 10:15:55 1992  Ian Lance Taylor  (ian@cygnus.com)
+
+	* Makefile.in (INSTALL): Default to @INSTALL@, not install -c.
+	(test): get tests from $(srcdir).
+
+Sun Nov  8 21:56:26 1992  david d `zoo' zuhn  (zoo at cirdan.cygnus.com)
+
+	* Makefile.in: install .tcl files from $(srcdir)/library
+
+	* New file for GNU/Cygnus distribution of TCL.
+
diff --git a/tcl/Makefile.in b/tcl/Makefile.in
new file mode 100644
index 00000000000..bbe52909b5b
--- /dev/null
+++ b/tcl/Makefile.in
@@ -0,0 +1,72 @@
+# Minimal top-level Makefile.  Just pass everything to the $(CONFIGDIR)
+# subdir.
+# Tom Tromey <tromey@cygnus.com>
+
+CONFIGDIR=@CONFIGDIR@
+CONFIGDIR2=@CONFIGDIR2@
+
+VPATH = @srcdir@
+SHELL = @SHELL@
+SRC_DIR = @srcdir@
+
+@SET_MAKE@
+
+all:
+	@cd $(CONFIGDIR) && $(MAKE) $@
+	@test x"$(CONFIGDIR2)" = x"" || (cd "$(CONFIGDIR2)" && $(MAKE) $@)
+
+install test install-binaries install-libraries install-minimal:
+	@cd $(CONFIGDIR) && $(MAKE) $@
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+	@cd $(CONFIGDIR) && $(MAKE) `echo $@ | sed 's/-recursive//'`
+	@test x"$(CONFIGDIR2)" = x"" || (cd "$(CONFIGDIR2)" && $(MAKE) `echo $@ | sed 's/-recursive//'`)
+
+configure:
+	cd $(SRC_DIR) && autoconf
+
+mostlyclean: mostlyclean-recursive
+
+clean: clean-recursive
+
+distclean-local:
+	rm -f Makefile config.status config.cache config.log
+
+distclean: distclean-recursive distclean-local
+
+maintainer-clean: distclean-local maintainer-clean-recursive
+
+
+#----------------------------------------------------------------
+# These let the DejaGnu test suite run when DejaGnu isn't 
+# installed yet, so run it from the srcdir and objdir.
+#----------------------------------------------------------------
+EXPECT = ` \
+  if [ -f $${rootme}/../expect/expect ] ; then \
+    echo $${rootme}/../expect/expect ; \
+  else echo expect ; fi`
+
+RUNTESTFLAGS =
+RUNTEST = ` \
+  if [ -f $(SRC_DIR)/../dejagnu/runtest ] ; then \
+    echo $(SRC_DIR)/../dejagnu/runtest ; \
+  else echo runtest ;  fi`
+
+check:
+	cd $(CONFIGDIR) && $(MAKE) tcltest
+	rootme=`pwd`; export rootme; \
+	srcdir=${SRC_DIR}; export srcdir ; \
+	EXPECT=${EXPECT} ; export EXPECT ; \
+	if [ -f $${rootme}/../expect/expect ] ; then  \
+	   TCL_LIBRARY=`cd $${srcdir}/library && pwd` ; \
+	   export TCL_LIBRARY ; fi ; \
+	$(RUNTEST) $(RUNTESTFLAGS) --tool tcl --srcdir $(SRC_DIR)/testsuite
+
+install-info info installcheck:
+
+Makefile: Makefile.in config.status
+	CONFIG_FILES=Makefile CONFIG_HEADERS= $(SHELL) ./config.status
+
+config.status: configure
+	$(SHELL) config.status --recheck
diff --git a/tcl/README b/tcl/README
new file mode 100644
index 00000000000..c2ba9689946
--- /dev/null
+++ b/tcl/README
@@ -0,0 +1,400 @@
+Tcl
+
+RCS: @(#) $Id$
+
+1. Introduction
+---------------
+
+This directory and its descendants contain the sources and documentation
+for Tcl, an embeddable scripting language.  The information here
+corresponds to release 8.0.4, which is the fourth patch update for Tcl
+8.0. This patch provides compatibility with [incr Tcl] 3.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.  This patch release fixes various bugs in
+Tcl 8.0, plus it adds a few minor features to support the TclPro 1.0
+tool set and [incr Tcl] 3.0.  Please check the changes file for details.
+
+2. Documentation
+----------------
+
+The best way to get started with Tcl is to read one of the introductory
+books on Tcl:
+
+    Practical Programming in Tcl and Tk, 2nd Edition, by Brent Welch,
+    Prentice-Hall, 1997, ISBN 0-13-616830-2
+
+    Tcl and the Tk Toolkit, by John Ousterhout,
+    Addison-Wesley, 1994, ISBN 0-201-63337-X
+
+    Exploring Expect, by Don Libes,
+    O'Reilly and Associates, 1995, ISBN 1-56592-090-2
+
+Other books are listed at
+http://www.scriptics.com/resource/doc/books/
+http://www.tclconsortium.org/resources/books.html
+
+The "doc" subdirectory in this release contains a complete set of reference
+manual entries for Tcl.  Files with extension ".1" are for programs (for
+example, tclsh.1); files with extension ".3" are for C library procedures;
+and files with extension ".n" describe Tcl commands.  The file "doc/Tcl.n"
+gives a quick summary of the Tcl language syntax.  To print any of the man
+pages, cd to the "doc" directory and invoke your favorite variant of
+troff using the normal -man macros, for example
+
+		ditroff -man Tcl.n
+
+to print Tcl.n.  If Tcl has been installed correctly and your "man"
+program supports it, you should be able to access the Tcl manual entries
+using the normal "man" mechanisms, such as
+
+		man Tcl
+
+There is also an official home for Tcl and Tk on the Web:
+	http://www.scriptics.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
+-------------------------------
+
+This release contains everything you should need to compile and run
+Tcl under UNIX, Macintoshes, and PCs (either Windows NT, Windows 95,
+or Win 3.1 with Win32s).
+
+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 Scriptics Tcl Resource Center
+        (http://www.scriptics.com/resource).  Also, check in
+        the FTP directory from which you retrieved the base
+        distribution.
+
+    (b) Make sure you have the most recent patch release.  Look in the
+	FTP directory from which you retrieved this distribution to see
+	if it has been updated with patches.  Patch releases fix bugs
+	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
+	tcl8.0.4.tar.Z is a complete release for patch level 4 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 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:
+	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 (some versions of patch require "-p0"):
+	    patch -p < tcl8.0p1.patch
+	If the patch file has a .gz extension, invoke a command like the
+	following:
+	    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 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
+	directory to a pristine state.
+
+Once you've done this, change to the "unix" subdirectory if you're
+compiling under UNIX, "win" if you're compiling under Windows, or
+"mac" if you're compiling on a Macintosh.  Then follow the instructions
+in the README file in that directory for compiling Tcl, installing it,
+and running the test suite.
+
+4. Summary of changes in Tcl 8.0
+--------------------------------
+
+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
+    safe packages and extension loading, including new library
+    procedures such as safe::interpCreate (see the manual entry safe.n
+    for details).
+
+    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. The variable tcl_precision is now shared between interpreters
+    and defaults to 12 digits instead of 6; safe interpreters cannot
+    modify tcl_precision.  The new object system in Tcl 8.0 causes
+    floating-to-string conversions (and the associated rounding) to
+    occur much less often than in Tcl 7.6, which can sometimes cause
+    behavioral changes.
+
+    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
+-----------------
+
+There is a network news group "comp.lang.tcl" intended for the exchange
+of information about Tcl, Tk, and related applications.  Feel free to use
+the newsgroup both for general information questions and for bug reports.
+We read the newsgroup and will attempt to fix bugs and problems reported
+to it.
+
+When using comp.lang.tcl, please be sure that your e-mail return address
+is correctly set in your postings.  This allows people to respond directly
+to you, rather than the entire newsgroup, for answers that are not of
+general interest.  A bad e-mail return address may prevent you from
+getting answers to your questions.  You may have to reconfigure your news
+reading software to ensure that it is supplying valid e-mail addresses.
+
+6. Tcl contributed archive
+--------------------------
+
+Many people have created exciting packages and applications based on Tcl
+and/or Tk and made them freely available to the Tcl community.  An archive
+of these contributions is kept on the machine ftp.neosoft.com.  You
+can access the archive using anonymous FTP;  the Tcl contributed archive is
+in the directory "/pub/tcl".  The archive also contains several FAQ
+("frequently asked questions") documents that provide solutions to problems
+that are commonly encountered by TCL newcomers.
+
+7. Tcl Resource Center
+----------------------
+Visit http://www.scritics.com/resource/ to see an annotated index of
+many Tcl resources available on the World Wide Web.  This includes
+papers, books, and FAQs, as well as extensions, applications, binary
+releases, and patches.  You can contribute patches by sending them
+to <patches@scriptics.com>.  You can also recommend more URLs for the
+resource center using the forms labeled "Add a Resource".
+
+8. Mailing lists
+----------------
+
+A couple of  Mailing List have been set up to discuss Macintosh or
+Windows related Tcl issues.  In order to use these Mailing Lists you
+must have access to the internet.  To subscribe send a message to:
+	
+	wintcl-request@tclconsortium.org
+	mactcl-request@tclconsortium.org
+	
+In the body of the message (the subject will be ignored) put:
+	
+	subscribe mactcl Joe Blow
+	
+Replacing Joe Blow with your real name, of course.  (Use wintcl
+instead of mactcl if your interested in the Windows list.)  If you
+would just like to receive more information about the list without
+subscribing put the line:
+
+	information mactcl
+	
+in the body instead (or wintcl).
+
+9. Support and bug fixes
+------------------------
+
+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 Scriptics.  We'll see
+anything on comp.lang.tcl, and in addition someone else who reads 
+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
+to the size of the installed base.
+
+When reporting bugs, please provide a short tclsh script that we can
+use to reproduce the bug.  Make sure that the script runs with a
+bare-bones tclsh and doesn't depend on any extensions or other
+programs, particularly those that exist only at your site.  Also,
+please include three additional pieces of information with the
+script:
+    (a) how do we use the script to make the problem happen (e.g.
+	what things do we click on, in what order)?
+    (b) what happens when you do these things (presumably this is
+        undesirable)?
+    (c) what did you expect to happen instead?
+
+The Tcl community is too large for us to provide much individual
+support for users.  If you need help we suggest that you post questions
+to comp.lang.tcl.  We read the newsgroup and will attempt to answer
+esoteric questions for which no-one else is likely to know the answer.
+In addition, Tcl support and training are available commercially from
+Scriptics (info@scriptics.com), NeoSoft (info@neosoft.com),
+Computerized Processes Unlimited (gwl@cpu.com),
+and Data Kinetics (education@dkl.com).
+
+10. Tcl version numbers
+----------------------
+
+You can test the current version of Tcl by examining the
+tcl_version and tcl_patchLevel variables.  The tcl_patchLevel
+variable follows the naming rules outlined below (e.g., 8.0.4).
+The tcl_version just has the major.minor numbers in it (e.g., 8.0)
+
+Each Tcl release is identified by two numbers separated by a dot, e.g.
+6.7 or 7.0.  If a new release contains changes that are likely to break
+existing C code or Tcl scripts then the major release number increments
+and the minor number resets to zero: 6.0, 7.0, etc.  If a new release
+contains only bug fixes and compatible changes, then the minor number
+increments without changing the major number, e.g. 7.1, 7.2, etc.  If
+you have C code or Tcl scripts that work with release X.Y, then they
+should also work with any release X.Z as long as Z > Y.
+
+Alpha and beta releases have an additional suffix of the form a2 or b1.
+For example, Tcl 7.0b1 is the first beta release of Tcl version 7.0,
+Tcl 7.0b2 is the second beta release, and so on.  A beta release is an
+initial version of a new release, used to fix bugs and bad features before
+declaring the release stable.  An alpha release is like a beta release,
+except it's likely to need even more work before it's "ready for prime
+time".  New releases are normally preceded by one or more alpha and beta
+releases.  We hope that lots of people will try out the alpha and beta
+releases and report problems.  We'll make new alpha/beta releases to fix
+the problems, until eventually there is a beta release that appears to
+be stable.  Once this occurs we'll make the final release.
+
+We can't promise to maintain compatibility among alpha and beta releases.
+For example, release 7.1b2 may not be backward compatible with 7.1b1, even
+though the final 7.1 release will be backward compatible with 7.0.  This
+allows us to change new features as we find problems during beta testing.
+We'll try to minimize incompatibilities between beta releases, but if
+a major problem turns up then we'll fix it even if it introduces an
+incompatibility.  Once the official release is made then there won't
+be any more incompatibilities until the next release with a new major
+version number.
+
+(Note: This compatibility is true for Tcl scripts, but historically the Tcl
+C APIs have changed enough between releases that you may need to work a bit to
+upgrade extensions.)
+
+Patch releases have a suffix such as p1 or p2.  These releases contain
+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.6), and you should normally use the highest available patch release.
+
+As of 8.0.3, the patch releases use a second . instead of 'p'.  So, the
+8.0 release went to 8.0p1, 8.0p2, 8.0.3, and 8.0.4.  The alphas and betas
+will still use the 'a' and 'b' letters in their tcl_patchLevel.
diff --git a/tcl/changes b/tcl/changes
new file mode 100644
index 00000000000..0c52f738e43
--- /dev/null
+++ b/tcl/changes
@@ -0,0 +1,3607 @@
+Recent user-visible changes to Tcl:
+
+SCCS: @(#) changes 1.338 97/11/25 08:30:52
+
+1. No more [command1] [command2] construct for grouping multiple
+commands on a single command line.
+
+2. Semi-colon now available for grouping commands on a line.
+
+3. For a command to span multiple lines, must now use backslash-return
+at the end of each line but the last.
+
+4. "Var" command has been changed to "set".
+
+5. Double-quotes now available as an argument grouping character.
+
+6. "Return" may be used at top-level.
+
+7. More backslash sequences available now.  In particular, backslash-newline
+may be used to join lines in command files.
+
+8. New or modified built-in commands:  case, return, for, glob, info,
+print, return, set, source, string, uplevel.
+
+9. After an error, the variable "errorInfo" is filled with a stack
+trace showing what was being executed when the error occurred.
+
+10. Command abbreviations are accepted when parsing commands, but
+are not recommended except for purely-interactive commands.
+
+11. $, set, and expr all complain now if a non-existent variable is
+referenced.
+
+12. History facilities exist now.  See Tcl.man and Tcl_RecordAndEval.man.
+
+13. Changed to distinguish between empty variables and those that don't
+exist at all.  Interfaces to Tcl_GetVar and Tcl_ParseVar have changed
+(NULL return value is now possible).  *** POTENTIAL INCOMPATIBILITY ***
+
+14. Changed meaning of "level" argument to "uplevel" command (1 now means
+"go up one level", not "go to level 1"; "#1" means "go to level 1").
+*** POTENTIAL INCOMPATIBILITY ***
+
+15. 3/19/90 Added "info exists" option to see if variable exists.
+
+16. 3/19/90 Added "noAbbrev" variable to prohibit command abbreviations.
+
+17. 3/19/90 Added extra errorInfo option to "error" command.
+
+18. 3/21/90 Double-quotes now only affect space:  command, variable,
+and backslash substitutions still occur inside double-quotes.
+*** POTENTIAL INCOMPATIBILITY ***
+
+19. 3/21/90 Added support for \r.
+
+20. 3/21/90 List, concat, eval, and glob commands all expect at least
+one argument now.  *** POTENTIAL INCOMPATIBILITY ***
+
+21. 3/22/90 Added "?:" operators to expressions.
+
+22. 3/25/90 Fixed bug in Tcl_Result that caused memory to get trashed.
+
+------------------- Released version 3.1 ---------------------
+
+23. 3/29/90 Fixed bug that caused "file a.b/c ext" to return ".b/c".
+
+24. 3/29/90 Semi-colon is not treated specially when enclosed in
+double-quotes.
+
+------------------- Released version 3.2 ---------------------
+
+25. 4/16/90 Rewrote "exec" not to use select or signals anymore.
+Should be more Sys-V compatible, and no slower in the normal case.
+
+26. 4/18/90 Rewrote "glob" to eliminate GNU code (there's no GNU code
+left in Tcl, now), and added Tcl_TildeSubst procedure.  Added automatic
+tilde-substitution in many commands, including "glob".
+
+------------------- Released version 3.3 ---------------------
+
+27. 7/11/90 Added "Tcl_AppendResult" procedure.
+
+28. 7/20/90 "History" with no options now defaults to "history info"
+rather than to "history redo".  Although this is a backward incompatibility,
+it should only be used interactively and thus shouldn't present any
+compatibility problems with scripts.
+
+29. 7/20/90 Added "Tcl_GetInteger", "Tcl_GetDouble", and "Tcl_GetBoolean"
+procedures.
+
+30. 7/22/90 Removed "Tcl_WatchInterp" procedure:  doesn't seem to be
+necessary, since the same effect can be achieved with the deletion
+callbacks on individual commands.  *** POTENTIAL INCOMPATIBILITY ***
+
+31. 7/23/90 Added variable tracing:  Tcl_TraceVar, Tcl_UnTraceVar,
+and Tcl_VarTraceInfo procedures, "trace" command.
+
+32. 8/9/90 Mailed out list of all bug fixes since 3.3 release.
+
+33. 8/29/90 Fixed bugs in Tcl_Merge relating to backslashes and
+semi-colons.  Mailed out patch.
+
+34. 9/3/90 Fixed bug in tclBasic.c: quotes weren't quoting ]'s.
+Mailed out patch.
+
+35. 9/19/90 Rewrote exec to always use files both for input and
+output to the process.  The old pipe-based version didn't work if
+the exec'ed process forked a child and then exited:  Tcl waited
+around for stdout to get closed, which didn't happen until the
+grandchild exited.
+
+36. 11/5/90 ERR_IN_PROGRESS flag wasn't being cleared soon enough
+in Tcl_Eval, allowing error messages from different commands to
+pile up in $errorInfo.  Fixed by re-arranging code in Tcl_Eval that
+re-initializes result and ERR_IN_PROGRESS flag.  Didn't mail out
+patch:  changes too complicated to describe.
+
+37. 12/19/90 Added Tcl_VarEval procedure as a convenience for
+assembling and executing Tcl commands.
+
+38. 1/29/91 Fixed core leak in Tcl_AddErrorInfo.  Also changed procedure
+and Tcl_Eval so that first call to Tcl_AddErrorInfo need not come from
+Tcl_Eval.
+
+----------------- Released version 5.0 with Tk ------------------
+
+39. 4/3/91 Removed change bars from manual entries, leaving only those
+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
+(this makes newline treatment consistent throughout Tcl).
+*** POTENTIAL INCOMPATIBILITY ***
+
+42. 5/23/91 Massive rewrite of expression code to support floating-point
+values and simple string comparisons.  The C interfaces to expression
+routines have changed (Tcl_Expr is replaced by Tcl_ExprLong, Tcl_ExprDouble,
+etc.), but all old Tcl expression strings should be accepted by the new
+expression code.
+*** POTENTIAL INCOMPATIBILITY ***
+
+43. 5/23/91 Modified tclHistory.c to check for negative "keep" value.
+
+44. 5/23/91 Modified Tcl_Backslash to handle backslash-newline.  It now
+returns 0 to indicate that a backslash sequence should be replaced by
+no character at all.
+*** POTENTIAL INCOMPATIBILITY ***
+
+45. 5/29/91 Modified to use ANSI C function prototypes.  Must set
+"USE_ANSI" switch when compiling to get prototypes.
+
+46. 5/29/91 Completed test suite by providing tests for all of the
+built-in Tcl commands.
+
+47. 5/29/91 Changed Tcl_Concat to eliminate leading and trailing
+white-space in each of the things it concatenates and to ignore
+elements that are empty or have only white space in them.  This
+produces cleaner output from the "concat" command.
+*** POTENTIAL INCOMPATIBILITY ***
+
+48. 5/31/91 Changed "set" command and Tcl_SetVar procedure to return
+new value of variable.
+
+49. 6/1/91 Added "while" and "cd" commands.
+
+50. 6/1/91 Changed "exec" to delete the last character of program
+output if it is a newline.  In most cases this makes it easier to
+process program-generated output.
+*** POTENTIAL INCOMPATIBILITY ***
+
+51. 6/1/91 Made sure that pointers are never used after freeing them.
+
+52. 6/1/91 Fixed bug in TclWordEnd where it wasn't dealing with
+[] inside quotes correctly.
+
+53. 6/8/91 Fixed exec.test to accept return values of either 1 or
+255 from "false" command.
+
+54. 7/6/91 Massive overhaul of variable management.  Associative
+arrays now available, along with "unset" command (and Tcl_UnsetVar
+procedure).  Variable traces have been completely reworked:
+interfaces different both from Tcl and C, and multiple traces may
+exist on same variable.  Can no longer redefine existing local
+variable to be global.  Calling sequences have changed slightly
+for Tcl_GetVar and Tcl_SetVar ("global" is now "flags"). Tcl_SetVar
+can fail and return a NULL result.  New forms of variable-manipulation
+procedures:  Tcl_GetVar2, Tcl_SetVar2, etc.  Syntax of variable
+$-notation changed to support array indexing.
+*** POTENTIAL INCOMPATIBILITY ***
+
+55. 7/6/91 Added new list-manipulation procedures:  Tcl_ScanElement,
+Tcl_ConvertElement, Tcl_AppendElement.
+
+56. 7/12/91 Created new procedure Tcl_EvalFile, which does most of the
+work of the "source" command.
+
+57. 7/20/91 Major reworking of "exec" command to allow pipelines,
+more redirection, background.  Added new procedures Tcl_Fork,
+Tcl_WaitPids, Tcl_DetachPids, and Tcl_CreatePipeline.  The old
+"< input" notation has been replaced by "<< input" ("<" is for
+redirection from a file).  Also handles error returns and abnormal
+terminations (e.g. signals) differently.
+*** POTENTIAL INCOMPATIBILITY ***
+
+58. 7/21/91 Added "append" and "lappend" commands.
+
+59. 7/22/91 Reworked error messages and manual entries to use
+?x? as the notation for an optional argument x, instead of [x].  The
+bracket notation was often confused with the use of brackets for
+command substitution.  Also modified error messages to be more
+consistent.
+
+60. 7/23/91 Tcl_DeleteCommand now returns an indication of whether
+or not the command actually existed, and the "rename" command uses
+this information to return an error if an attempt is made to delete
+a non-existent command.
+*** POTENTIAL INCOMPATIBILITY ***
+
+61. 7/25/91 Added new "errorCode" mechanism, along with procedures
+Tcl_SetErrorCode, Tcl_UnixError, and Tcl_ResetResult.  Renamed
+Tcl_Return to Tcl_SetResult, but left a #define for Tcl_Return to
+avoid compatibility problems.
+
+62. 7/26/91 Extended "case" command with alternate syntax where all
+patterns and commands are together in a single list argument:  makes
+it easier to write multi-line case statements.
+
+63. 7/27/91 Changed "print" command to perform tilde-substitution on
+the file name.
+
+64. 7/27/91 Added "tolower", "toupper", "trim", "trimleft", and "trimright"
+options to "string" command.
+
+65. 7/29/91 Added "atime", "mtime", "size", and "stat" options to "file"
+command.
+
+66. 8/1/91 Added "split" and "join" commands.
+
+67. 8/11/91 Added commands for file I/O, including "open", "close",
+"read", "gets", "puts", "flush", "eof", "seek", and "tell".
+
+68. 8/14/91 Switched to use a hash table for command lookups.  Command
+abbreviations no longer have direct support in the Tcl interpreter, but
+it should be possible to simulate them with the auto-load features
+described below.  The "noAbbrev" variable is no longer used by Tcl.
+*** POTENTIAL INCOMPATIBILITY ***
+
+68.5 8/15/91 Added support for "unknown" command, which can be used to
+complete abbreviations, auto-load library files, auto-exec shell
+commands, etc.
+
+69. 8/15/91 Added -nocomplain switch to "glob" command.
+
+70. 8/20/91 Added "info library" option and TCL_LIBRARY #define.  Also
+added "info script" option.
+
+71. 8/20/91 Changed "file" command to take "option" argument as first
+argument (before file name), for consistency with other Tcl commands.
+*** POTENTIAL INCOMPATIBILITY ***
+
+72. 8/20/91 Changed format of information in $errorInfo variable:
+comments such as 
+    ("while" body line 1)
+are now on separate lines from commands being executed.
+*** POTENTIAL INCOMPATIBILITY ***
+
+73. 8/20/91 Changed Tcl_AppendResult so that it (eventually) frees
+large buffers that it allocates.
+
+74. 8/21/91 Added "linsert", "lreplace", "lsearch", and "lsort"
+commands.
+
+75. 8/28/91 Added "incr" and "exit" commands.
+
+76. 8/30/91 Added "regexp" and "regsub" commands.
+
+77. 9/4/91 Changed "dynamic" field in interpreters to "freeProc" (procedure
+address).  This allows for alternative storage managers.
+*** POTENTIAL INCOMPATIBILITY ***
+
+78. 9/6/91 Added "index", "length", and "range" options to "string"
+command.  Added "lindex", "llength", and "lrange" commands.
+
+79. 9/8/91 Removed "index", "length", "print" and "range" commands.
+"Print" is redundant with "puts", but less general, and the other
+commands are replaced with the new commands described in change 78
+above.
+*** POTENTIAL INCOMPATIBILITY ***
+
+80. 9/8/91 Changed history revision to occur even when history command
+is nested;  needed in order to allow "history" to be invoked from
+"unknown" procedure.
+
+81. 9/13/91 Changed "panic" not to use vfprintf (it's uglier and less
+general now, but makes it easier to run Tcl on systems that don't
+have vfprintf).  Also changed "strerror" not to redeclare sys_errlist.
+
+82. 9/19/91 Lots of changes to improve portability to different UNIX
+systems, including addition of "config" script to adapt Tcl to the
+configuration of the system it's being compiled on.
+
+83. 9/22/91 Added "pwd" command.
+
+84. 9/22/91 Renamed manual pages so that their filenames are no more
+than 14 characters in length, moved to "doc" subdirectory.
+
+85. 9/24/91 Redid manual entries so they contain the supplemental
+macros that they need;  can just print with "troff -man" or "man"
+now.
+
+86. 9/26/91 Created initial version of script library, including
+a version of "unknown" that does auto-loading, auto-execution, and
+abbreviation expansion.  This library is used by tclTest
+automatically.  See the "library" manual entry for details.
+
+----------------- Released version 6.0, 9/26/91 ------------------
+
+87. 9/30/91 Made "string tolower" and "string toupper" check case
+before converting:  on some systems, "tolower" and "toupper" assume
+that character already has particular case.
+
+88. 9/30/91 Fixed bug in Tcl_SetResult:  wasn't always setting freeProc
+correctly when called with NULL value.  This tended to cause memory
+allocation errors later.
+
+89. 10/3/91 Added "upvar" command.
+
+90. 10/4/91 Changed "format" so that internally it converts %D to %ld,
+%U to %lu, %O to %lo, and %F to %f.  This eliminates some compatibility
+problems on some machines without affecting behavior.
+
+91. 10/10/91 Fixed bug in "regsub" that caused core dumps with the -all
+option when the last match wasn't at the end of the string.
+
+92. 10/17/91 Fixed problems with backslash sequences:  \r support was
+incomplete and \f and \v weren't supported at all.
+
+93. 10/24/91 Added Tcl_InitHistory procedure.
+
+94. 10/24/91 Changed "regexp" to store "-1 -1" in subMatchVars that
+don't match, rather than returning an error.
+
+95. 10/27/91 Modified "regexp" to return actual strings in matchVar
+and subMatchVars instead of indices.  Added "-indices" switch to cause
+indices to be returned.
+*** POTENTIAL INCOMPATIBILITY ***
+
+96. 10/27/91 Fixed bug in "scan" where it used hardwired constants for
+sizes of floats and doubles instead of using "sizeof".
+
+97. 10/31/91 Fixed bug in tclParse.c where parse-related error messages
+weren't being storage-managed correctly, causing spurious free's.
+
+98. 10/31/91 Form feed and vertical tab characters are now considered
+to be space characters by the parser.
+
+99. 10/31/91 Added TCL_LEAVE_ERR_MSG flag to procedures like Tcl_SetVar.
+
+100. 11/7/91 Fixed bug in "case" where "in" argument couldn't be omitted
+if all case branches were embedded in a single list.
+
+101. 11/7/91 Switched to use "pid_t" and "uid_t" and other official
+POSIC types and function prototypes.
+
+----------------- Released version 6.1, 11/7/91 ------------------
+
+102. 12/2/91 Modified Tcl_ScanElement and Tcl_ConvertElement in several
+ways.  First, allowed caller to request that only backslashes be used
+(no braces).  Second, made Tcl_ConvertElement more aggressive in using
+backslashes for braces and quotes.
+
+103. 12/5/91 Added "type", "lstat", and "readlink" options to "file"
+command, plus added new "type" element to output of "stat" and "lstat"
+options.
+
+104. 12/10/91 Manual entries had first lines that caused "man" program
+to try weird preprocessor.  Added blank comment lines to fix problem.
+
+105. 12/16/91 Fixed a few bugs in auto_mkindex proc:  wasn't handling
+errors properly, and hadn't been upgraded for new "regexp" syntax.
+
+106. 1/2/92 Fixed bug in "file" command where it didn't properly handle
+a file names containing tildes where the indicated user doesn't exist.
+
+107. 1/2/92 Fixed lots of cases in tclUnixStr.c where two different
+errno symbols (e.g. EWOULDBLOCK and EAGAIN) have the same number;  Tcl
+will only use one of them.
+
+108. 1/2/92 Lots of changes to configuration script to handle many more
+systems more gracefully.  E.g. should now detect the bogus strtoul that
+comes with AIX and substitute Tcl's own version instead.
+
+----------------- Released version 6.2, 1/10/92 ------------------
+
+109. 1/20/92 Config didn't have code to actually use "uid_t" variable
+to set TCL_UIT_T #define.
+
+110. 2/10/92 Tcl_Eval didn't properly reset "numLevels" variable when
+too-deep recursion occurred.
+
+111. 2/29/92 Added "on" and "off" to keywords accepted by Tcl_GetBoolean.
+
+112. 3/19/92 Config wasn't installing default version of strtod.c for
+systems that don't have one in libc.a.
+
+113. 3/23/92 Fixed bug in tclExpr.c where numbers with leading "."s,
+like 0.75, couldn't be properly substituted into expressions with
+variable or command substitution.
+
+114. 3/25/92 Fixed bug in tclUnixAZ.c where "gets" command wasn't
+checking to make sure that it was able to write the variable OK.
+
+115. 4/16/92 Fixed bug in tclUnixAZ.c where "read" command didn't
+compute file size right for device files.
+
+116. 4/23/92 Fixed but in tclCmdMZ.c where "trace vinfo" was overwriting
+the trace command.
+
+----------------- Released version 6.3, 5/1/92 ------------------
+
+117. 5/1/92 Added Tcl_GlobalEval.
+
+118. 6/1/92 Changed auto-load facility to source files at global level.
+
+119. 6/8/92 Tcl_ParseVar wasn't always setting termPtr after errors, which
+sometimes caused core dumps.
+
+120. 6/21/92 Fixed bug in initialization of regexp pattern cache.  This
+bug caused segmentation violations in regexp commands under some conditions.
+
+121. 6/22/92 Changed implementation of "glob" command to eliminate
+trailing slashes on directory names:  they confuse some systems.  There
+shouldn't be any user-visible changes in functionality except for names
+in error messages not having trailing slashes.
+
+122. 7/2/92 Fixed bug that caused 'string match ** ""' to return 0.
+
+123. 7/2/92 Fixed bug in Tcl_CreateCmdBuf where it wasn't initializing
+the buffer to an empty string.
+
+124. 7/6/92 Fixed bug in "case" command where it used NULL pattern string
+after errors in the "default" clause.
+
+125. 7/25/92 Speeded up auto_load procedure:  don't reread all the index
+files unless the path has changed.
+
+126. 8/3/92 Changed tclUnix.h to define MAXPATHLEN from PATH_MAX, not
+_POSIX_PATH_MAX.
+
+----------------- Released version 6.4, 8/7/92 ------------------
+
+127. 8/10/92 Changed tclBasic.c so that comment lines can be continued by
+putting a backslash before the newline.
+
+128. 8/21/92 Modified "unknown" to allow the source-ing of a file for
+an auto-load to trigger other nested auto-loads, as long as there isn't
+any recursion on the same command name.
+
+129. 8/25/92 Modified "format" command to allow " " and "+" flags, and
+allow flags in any order.
+
+130. 9/14/92 Modified Tcl_ParseVar so that it doesn't actually attempt
+to look up the variable if "noEval" mode is in effect in the interpreter
+(it just parses the name).  This avoids the errors that used to occur
+in statements like "expr {[info exists foo] && $foo}".
+
+131. 9/14/92 Fixed bug in "uplevel" command where it didn't output the
+correct error message if a level was specified but no command.
+
+132. 9/14/92 Renamed manual entries to have extensions like .3 and .n,
+and added "install" target to Makefile.
+
+133. 9/18/92 Modified "unknown" command to emulate !!, !<num>, and
+^<old>^<new> csh history substitutions.
+
+134. 9/21/92 Made the config script cleverer about figuring out which
+switches to pass to "nm".
+
+135. 9/23/92 Fixed tclVar.c to be sure to copy flags when growing variables.
+Used to forget about traces in progress and make extra recursive calls
+on trace procs.
+
+136. 9/28/92 Fixed bug in auto_reset where it was unsetting variables
+that might not exist.
+
+137. 10/7/92 Changed "parray" library procedure to print any array
+accessible to caller, local or global.
+
+138. 10/15/92 Fixed bug where propagation of new environment variable
+values among interpreters took N! time if there exist N interpreters.
+
+139. 10/16/92 Changed auto_reset procedure so that it also deletes any
+existing procedures that are in the auto_load index (the assumption is
+that they should be re-loaded to get the latest versions).
+
+140. 10/21/92 Fixed bug that caused lists to be incorrectly generated
+for elements that contained backslash-newline sequences.
+
+141. 12/9/92 Added support for TCL_LIBRARY environment variable:  use
+it as library location if it's present.
+
+142. 12/9/92 Added "info complete" command, Tcl_CommandComplete procedure.
+
+143. 12/16/92 Changed the Makefile to check to make sure "config" has been
+run (can't run config directly from the Makefile because it modifies the
+Makefile;  thus make has to be run again after running config).
+
+----------------- Released version 6.5, 12/17/92 ------------------
+
+144. 12/21/92 Changed config to look in several places for libc file.
+
+145. 12/23/92 Added "elseif" support to if.  Also, "then", "else", and
+"elseif" may no longer be abbreviated.
+*** POTENTIAL INCOMPATIBILITY ***
+
+146. 12/28/92 Changed "puts" and "read" to support initial "-nonewline"
+switch instead of additional "nonewline" argument.  The old form is
+still supported, but it is discouraged and is no longer documented.
+Also changed "puts" to make the file argument default to stdout: e.g.
+"puts foo" will print foo on standard output.
+
+147. 1/6/93 Fixed bug whereby backslash-newline wasn't working when
+typed interactively, or in "info complete".
+
+148. 1/22/93 Fixed bugs in "lreplace" and "linsert" where close
+quotes were being lost from last element before replacement or
+insertion.
+
+149. 1/29/93 Fixed bug in Tcl_AssembleCmd where it wasn't requiring
+a newline at the end of a line before considering a command to be
+complete.  The bug caused some very long lines in script files to
+be processed as multiple separate commands.
+
+150. 1/29/93 Various changes in Makefile to add more configuration
+options, simplify installation, fix bugs (e.g. don't use -f switch
+for cp), etc.
+
+151. 1/29/93 Changed "name1" and "name2" identifiers to "part1" and
+"part2" to avoid name conflicts with stupid C++ implementations that
+use "name1" and "name2" in a reserved way.
+
+152. 2/1/93 Added "putenv" procedure to replace the standard system
+version so that it will work correctly with Tcl's environment handling.
+
+----------------- Released version 6.6, 2/5/93 ------------------
+
+153. 2/10/93 Fixed bugs in config script:  missing "endif" in libc loop,
+and tried to use strncasecmp.c instead of strcasecmp.c.
+
+154. 2/10/93 Makefile improvements:  added RANLIB variable for easier
+Sys-V configuration, added SHELL variable for SGI systems.
+
+----------------- Released version 6.7, 2/11/93 ------------------
+
+153. 2/6/93 Changes in backslash processing:
+    - \Cx, \Mx, \CMx, \e sequences no longer special
+    - \<newline> also eats up any space after the newline, replacing
+      the whole sequence with a single space character
+    - Hex sequences like \x24 are now supported, along with ANSI C's \a.
+    - "format" no longer does backslash processing on its format string
+    - there is no longer any special meaning to a 0 return value from
+      Tcl_Backslash
+    - unknown backslash sequences, like (e.g. \*), are replaced with
+      the following character (e.g. *), instead of just treating the
+      backslash as an ordinary character.
+*** POTENTIAL INCOMPATIBILITY ***
+
+154. 2/6/93 Updated all copyright notices.  The meaning hasn't changed
+at all but the wording does a better job of protecting U.C. from
+liability (according to U.C. lawyers, anyway).
+
+155. 2/6/93 Changed "regsub" so that it overwrites the result variable
+in all cases, even if there is no match.
+*** POTENTIAL INCOMPATIBILITY ***
+
+156. 2/8/93 Added support for XPG3 %n$ conversion specifiers to "format"
+command.
+
+157. 2/17/93 Fixed bug in Tcl_Eval where errors due to infinite
+recursion could result in core dumps.
+
+158. 2/17/93 Improved the auto-load mechanism to deal gracefully (i.e.
+return an error) with a situation where a library file that supposedly
+defines a procedure doesn't actually define it.
+
+159. 2/17/93 Renamed Tcl_UnixError procedure to Tcl_PosixError, and
+changed errorCode variable usage to use POSIX as keyword instead of
+UNIX.
+*** POTENTIAL INCOMPATIBILITY ***
+
+160. 2/19/93 Changes to exec and process control:
+    - Added support for >>, >&, >>&, |&, <@, >@, and >&@ forms of redirection.
+    - When exec puts processes into background, it returns a list of
+      their pids as result.
+    - Added support for <file, >file, etc. (i.e. no space between
+      ">" and file name.
+    - Added -keepnewline option.
+    - Deleted Tcl_Fork and Tcl_WaitPids procedures (just use fork and
+      waitpid instead).
+    - Added waitpid compatibility procedure for systems that don't have
+      it.
+    - Added Tcl_ReapDetachedProcs procedure.
+    - Changed "exec" to return an error if there is stderr output, even
+      if the command returns a 0 exit status (it's always been documented
+      this way, but the implementation wasn't correct).
+    - If a process returns a non-zero exit status but doesn't generate
+      any diagnostic output, then Tcl generates an error message for it.
+*** POTENTIAL INCOMPATIBILITY ***
+
+161. 2/25/93 Fixed two memory-management problems having to do with
+managing the old result during variable trace callbacks.
+
+162. 3/1/93 Added dynamic string library:  Tcl_DStringInit, Tcl_DStringAppend,
+Tcl_DStringFree, Tcl_DStringResult, etc.
+
+163. 3/1/93 Modified glob command to only return the names of files that
+exist, and to only return names ending in "/" if the file is a directory.
+*** POTENTIAL INCOMPATIBILITY ***
+
+164. 3/19/93 Modified not to use system calls like "read" directly,
+but instead to use special Tcl procedures that retry automatically
+if interrupted by signals.
+
+165. 4/3/93 Eliminated "noSep" argument to Tcl_AppendElement, plus
+TCL_NO_SPACE flag for Tcl_SetVar and Tcl_SetVar2.
+*** POTENTIAL INCOMPATIBILITY ***
+
+166. 4/3/93 Eliminated "flags" and "termPtr" arguments to Tcl_Eval.
+*** POTENTIAL INCOMPATIBILITY ***
+
+167. 4/3/93 Changes to expressions:
+    - The "expr" command now accepts multiple arguments, which are
+      concatenated together with space separators.
+    - Integers aren't automatically promoted to floating-point if they
+      overflow the word size:  errors are generated instead.
+    - Tcl can now handle "NaN" and other special values if the underlying
+      library procedures handle them.
+    - When printing floating-point numbers, Tcl ensures that there is a "."
+      or "e" in the number, so it can't be treated as an integer accidentally.
+      The procedure Tcl_PrintDouble is available to provide this function
+      in other contexts.  Also, the variable "tcl_precision" can be used
+      to set the precision for printing (must be a decimal number giving
+      digits of precision).
+    - Expressions now support transcendental and other functions, e.g. sin,
+      acos, hypot, ceil, and round.  Can add new math functions with
+      Tcl_CreateMathFunc().
+    - Boolean expressions can now have any of the string values accepted
+      by Tcl_GetBoolean, such as "yes" or "no".
+*** POTENTIAL INCOMPATIBILITY ***
+
+168. 4/5/93 Changed Tcl_UnsetVar and Tcl_UnsetVar2 to return TCL_OK
+or TCL_ERROR instead of 0 or -1.
+*** POTENTIAL INCOMPATIBILITY ***
+
+169. 4/5/93 Eliminated Tcl_CmdBuf structure and associated procedures;
+can use Tcl_DStrings instead.
+*** POTENTIAL INCOMPATIBILITY ***
+
+170. 4/8/93 Changed interface to Tcl_TildeSubst to use a dynamic
+string for buffer space.  This makes the procedure re-entrant and
+thread-safe, whereas it wasn't before.
+*** POTENTIAL INCOMPATIBILITY ***
+
+171. 4/14/93 Eliminated tclHash.h, and moved everything from it to
+tcl.h
+*** POTENTIAL INCOMPATIBILITY ***
+
+172. 4/15/93 Eliminated Tcl_InitHistory, made "history" command always
+be part of interpreter.
+*** POTENTIAL INCOMPATIBILITY ***
+
+173. 4/16/93 Modified "file" command so that "readable" option always
+exists, even on machines that don't support symbolic links (always returns
+same error as if the file wasn't a symbolic link).
+
+174. 4/26/93 Fixed bugs in "regsub" where ^ patterns didn't get handled
+right (pretended not to match when it really did, and looped infinitely
+if -all was specified).
+
+175. 4/29/93 Various improvements in the handling of variables:
+    - Can create variables and array elements during a read trace.
+    - Can delete variables during traces (note: unset traces will be
+      invoked when this happens).
+    - Can upvar to array elements.
+    - Can retarget an upvar to another variable by re-issuing the
+      upvar command with a different "other" variable.
+
+176. 5/3/93 Added Tcl_GetCommandInfo, which returns info about a Tcl
+command such as whether it exists and its ClientData.  Also added
+Tcl_SetCommandInfo, which allows any of this information to be modified
+and also allows a command's delete procedure to have a different
+ClientData value than its command procedure.
+
+177. 5/5/93 Added Tcl_RegExpMatch procedure.
+
+178. 5/6/93 Fixed bug in "scan" where it didn't properly handle
+%% conversion specifiers.  Also changed "scan" to use Tcl_PrintDouble
+for printing real values.
+
+179. 5/7/93 Added "-exact", "-glob", and "-regexp" options to "lsearch"
+command to allow different kinds of pattern matching.
+
+180. 5/7/93 Added many new switches to "lsort" to control the sorting
+process: "-ascii", "-integer", "-real", "-command", "-increasing",
+and "-decreasing".
+
+181. 5/10/93 Changes to file I/O:
+    - Modified "open" command to support a list of POSIX access flags
+      like {WRONLY CREAT TRUNC} in addition to current fopen-style
+      access modes.  Also added "permissions" argument to set permissions
+      of newly-created files.
+    - Fixed Scott Bolte's bug (can close stdin etc. in application and
+      then re-open them with Tcl commands).
+    - Exported access to Tcl's file table with new procedures Tcl_EnterFile
+      and Tcl_GetOpenFile.
+
+182. 5/15/93 Added new "pid" command, which can be used to retrieve
+either the current process id or a list of the process ids in a
+pipeline opened with "open |..."
+
+183. 6/3/93 Changed to use GNU autoconfig for configuration instead of
+the home-brew "config" script.  Also made many other configuration-related
+changes, such as using <unistd.h> instead of explicitly declaring system
+calls in tclUnix.h.
+
+184. 6/4/93 Fixed bug where core-dumps could occur if a procedure
+redefined itself (the memory for the procedure's body could get
+reallocated in the middle of evaluating the body);  implemented
+simple reference count mechanism.
+
+185. 6/5/93 Changed tclIndex file format in two ways:  (a) it's now
+eval-ed instead of parsed, which makes it 3-4x faster; (b) the entries
+in auto_index are now commands to evaluate, which allows commands to
+be loaded in different ways such as dynamic-loading of C code.  The
+old tclIndex file format is still supported.
+
+186. 6/7/93 Eliminated tclTest program, added new "tclsh" program
+that is more like wish (allows script files to be invoked automatically
+using "#!/usr/local/bin/tclsh", makes arguments available to script,
+etc.).  Added support for Tcl_AppInit plus default version;  this
+allows new Tcl applications to be created without modifying the
+main program for tclsh.
+
+187. 6/7/93 Fixed bug in TclWordEnd that kept backslash-newline from
+working correctly in some cases during interactive input.
+
+188. 6/9/93 Added Tcl_LinkVar and related procedures, which automatically
+keep a Tcl variable in sync with a C variable.
+
+189. 6/16/93 Increased maximum nesting depth from 100 to 1000.
+
+190. 6/16/93 Modified "trace var" command so that error messages from
+within traces are returned properly as the result of the variable
+access, instead of the generic "access disallowed by trace command"
+message.
+
+191. 6/16/93 Added Tcl_CallWhenDeleted to provide callbacks when an
+interpreter is deleted (same functionality as Tcl_WatchInterp, which
+used to exist in versions before 6.0).
+
+193. 6/16/93 Added "-code" argument to "return" command;  it's there
+primarily for completeness, so that procedures implementing control
+constructs can reflect exceptional conditions back to their callers.
+
+194. 6/16/93 Split up Tcl.n to make separate manual entries for each
+Tcl command.  Tcl.n now contains a summary of the language syntax.
+
+195. 6/17/93 Added new "switch" command to replace "case": allows
+alternate forms of pattern matching (exact, glob, regexp), replaces
+pattern lists with single patterns (but you can use "-" bodies to
+share one body among several patterns), eliminates "in" noise word.
+"Case" command is now obsolete.
+
+196. 6/17/93 Changed the "exec", "glob", "regexp", and "regsub" commands
+to include a "--" switch.  All initial arguments starting with "-" are now
+treated as switches unless a "--" switch is present to end the list.
+*** POTENTIAL INCOMPATIBILITY ***
+
+197. 6/17/93 Changed auto-exec so that the subprocess gets stdin, stdout,
+and stderr from the parent.  This allows truly interactive sub-processes
+(e.g. vi) to be auto-exec'ed from a tcl shell command line.
+
+198. 6/18/93 Added patchlevel.h, for use in coordinating future patch
+releases, and also added "info patchlevel" command to make the patch
+level available to Tcl scripts.
+
+199. 6/19/93 Modified "glob" command so that a leading "//" in a name
+gets left as is (this is needed for systems like Apollos where "//" is
+the super-root;  Tcl used to collapse the two slashes into a single
+slash).
+
+200. 7/7/93 Added Tcl_SetRecursionLimit procedure so that the maximum
+allowable nesting depth can be controlled for an interpreter from C.
+
+----------------- Released version 7.0 Beta 1, 7/9/93 ------------------
+
+201. 7/12/93 Modified Tcl_GetInt and tclExpr.c so that full-precision
+unsigned integers can be specified without overflow errors.
+
+202. 7/12/93 Configuration changes:  eliminate leading blank line in
+configure script;  provide separate targets in Makefile for installing
+binary and non-binary information; check for size_t and a few other
+potentially missing typedefs; don't put tclAppInit.o into libtcl.a;
+better checks for matherr support.
+
+203. 7/14/93 Changed tclExpr.c to check the termination pointer before
+errno after strtod calls, to avoid problems with some versions of
+strtod that set errno in unexpected ways.
+
+204. 7/16/93 Changed "scan" command to be more ANSI-conformant:
+eliminated %F, %D, etc., added code to ignore "l", "h", and "L"
+modifiers but always convert %e, %f, and %g with implicit "l";
+also added support for %u and %i.  Also changed "format" command
+to eliminate %D, %U, %O, and add %i.
+*** POTENTIAL INCOMPATIBILITY ***
+
+205. 7/17/93 Changed "uplevel" and "upvar" so that they can be used
+from global level to global level:  this used to generate an error.
+
+206. 7/19/93 Renamed "setenv", "putenv", and "unsetenv" procedures
+to avoid conflicts with system procedures with the same names.  If
+you want Tcl's procedures to override the system procedures, do it
+in the Makefile (instructions are in the Makefile).
+*** POTENTIAL INCOMPATIBILITY ***
+
+----------------- Released version 7.0 Beta 2, 7/21/93 ------------------
+
+207. 7/21/93 Fixed bug in tclVar.c where freed memory was accidentally
+used if a procedure returned an element of a local array.
+
+208. 7/22/93 Fixed bug in "unknown" where it didn't properly handle
+errors occurring in the "auto_load" procedure, leaving its state
+inconsistent.
+
+209. 7/23/93 Changed exec's ">2" redirection operator to "2>" for
+consistency with sh.  This is incompatible with earlier beta releases
+of 7.0 but not with pre-7.0 releases, which didn't support either
+operator.
+
+210. 7/28/93 Changed backslash-newline handling so that the resulting
+space character *is* treated as a word separator unless the backslash
+sequence is in quotes or braces.  This is incompatible with 7.0b1
+and 7.0b2 but is more compatible with pre-7.0 versions that the b1
+and b2 releases were.
+
+211. 7/28/93 Eliminated Tcl_LinkedVarWritable, added TCL_LINK_READ_ONLY to
+Tcl_LinkVar to accomplish same purpose.  This change is incompatible
+with earlier beta releases, but not with releases before Tcl 7.0.
+
+212. 7/29/93 Renamed regexp C functions so they won't clash with POSIX
+regexp functions that use the same name.
+
+213. 8/3/93 Added "-errorinfo" and "-errorcode" options to "return"
+command: these allow for much better handling of the errorInfo
+and errorCode variables in some cases.
+
+214. 8/12/93 Changed "expr" so that % always returns a remainder with
+the same sign as the divisor and absolute value smaller than the
+divisor.
+
+215. 8/14/93 Turned off auto-exec in "unknown" unless the command
+was typed interactively.  This means you must use "exec" when
+invoking subprocesses, unless it's a command that's typed interactively.
+*** POTENTIAL INCOMPATIBILITY ***
+
+216. 8/14/93 Added support for tcl_prompt1 and tcl_prompt2 variables
+to tclMain.c:  makes prompts user-settable.
+
+217. 8/14/93 Added asynchronous handlers (Tcl_AsyncCreate etc.) so
+that signals can be taken cleanly by Tcl applications.
+
+218. 8/16/93 Moved information about open files from the interpreter
+structure to global variables so that a file can be opened in one
+interpreter and read or written in another.
+
+219. 8/16/93 Removed ENV_FLAGS from Makefile, so that there's no
+official support for overriding setenv, unsetenv, and putenv.
+
+220. 8/20/93 Various configuration improvements:  coerce chars
+to unsigned chars before using macros like isspace;  source ~/.tclshrc
+file during initialization if it exists and program is running
+interactively;  allow there to be directories in auto_path that don't
+exist or don't have tclIndex files (ignore them); added Tcl_Init
+procedure and changed Tcl_AppInit to call it.
+
+221. 8/21/93 Fixed bug in expr where "+", "-", and " " were all
+getting treated as integers with value 0.
+
+222. 8/26/93 Added "tcl_interactive" variable to tclsh.
+
+223. 8/27/93 Added procedure Tcl_FilePermissions to return whether a
+given file can be read or written or both.  Modified Tcl_EnterFile
+to take a permissions mask rather than separate read and write arguments.
+
+224. 8/28/93 Fixed performance bug in "glob" command (unnecessary call
+to "access" for each file caused a 5-10x slow-down for big directories).
+
+----------------- Released version 7.0 Beta 3, 8/28/93 ------------------
+
+225. 9/9/93 Renamed regexp.h to tclRegexp.h to avoid conflicts with system
+include file by same name.
+
+226. 9/9/93 Added Tcl_DontCallWhenDeleted.
+
+227. 9/16/93 Changed not to call exit C procedure directly;  instead
+always invoke "exit" Tcl command so that application can redefine the
+command to do additional cleanup.
+
+228. 9/17/93 Changed auto-exec to handle names that contain slashes
+(i.e. don't use PATH for them).
+
+229. 9/23/93 Fixed bug in "read" and "gets" commands where they didn't
+clear EOF conditions.
+
+----------------- Released version 7.0, 9/29/93 ------------------
+
+230. 10/7/93 "Scan" command wasn't properly aligning things in memory,
+so segmentation faults could arise under some circumstances.
+
+231. 10/7/93 Fixed bug in Tcl_ConvertElement where it forgot to
+backslash leading curly brace when creating lists.
+
+232. 10/7/93 Eliminated dependency of tclMain.c on tclInt.h and
+tclUnix.h, so that people can copy the file out of the Tcl source
+directory to make modified private versions.
+
+233. 10/8/93 Fixed bug in auto-loader that reversed the priority order
+of entries in auto_path for new-style index files.  Now things are
+back to the way they were before 3.0:  first in auto_path is always
+highest priority.
+
+234. 10/13/93 Fixed bug where Tcl_CommandComplete didn't recognize
+comments and treat them as such.  Thus if you typed the line
+    # {
+interactively, Tcl would think that the command wasn't complete and
+wait for more input before evaluating the script.
+
+235. 10/14/93 Fixed bug where "regsub" didn't set the output variable
+if the input string was empty.
+
+236. 10/23/93 Fixed bug where Tcl_CreatePipeline didn't close off enough
+file descriptors in child processes, causing children not to exit
+properly in some cases.
+
+237. 10/28/93 Changed "list" and "concat" commands not to generate
+errors if given zero arguments, but instead to just return an empty
+string.
+
+----------------- Released version 7.1, 11/4/93 ------------------
+
+Note: there is no 7.2 release.  It was flawed and was thus withdrawn
+shortly after it was released.
+
+238. 11/10/93 TclMain.c didn't compile on some systems because of
+R_OK in call to "access".  Changed to eliminate call to "access".
+
+----------------- Released version 7.3, 11/26/93 ------------------
+
+239. 11/6/93 Modified "lindex", "linsert", "lrange", and "lreplace"
+so that "end" can be specified as an index.
+
+240. 11/6/93 Modified "append" and "lappend" to allow only two
+words total (i.e., nothing to append) without generating an error.
+
+241. 12/2/93 Changed to use EAGAIN as the errno for non-blocking
+I/O instead of EWOULDBLOCK:  this should fix problem where non-blocking
+I/O didn't work correctly on System-V systems.
+
+242. 12/22/93 Fixed bug in expressions where cancelled evaluation
+wasn't always working correctly (e.g. "set one 1; eval {1 || 1/$one}"
+failed with a divide by zero error).
+
+243. 1/6/94 Changed TCL_VOLATILE definition from -1 to the address of
+a dummy procedure Tcl_Volatile, since -1 causes portability problems on
+some machines (e.g., Crays).
+
+244. 2/4/94 Added support for unary plus.
+
+245. 2/17/94 Changed Tcl_RecordAndEval and "history" command to
+call Tcl_GlobalEval instead of Tcl_Eval.  Otherwise, invocation of
+these facilities in nested procedures can cause unwanted results.
+
+246. 2/17/94 Fixed bug in tclExpr.c where an expression such as
+"expr {"12398712938788234-1298379" != ""}" triggers an integer
+overflow error for the number in quotes, even though it isn't really
+a proper integer anyway.
+
+247. 2/19/94 Added new procedure Tcl_DStringGetResult to move result
+from interpreter to a dynamic string.
+
+248. 2/19/94 Fixed bug in Tcl_DStringResult that caused it to overwrite
+the contents of a static result in some situations.  This can cause
+bizarre errors such as variables suddenly having empty values.
+
+249. 2/21/94 Fixed bug in Tcl_AppendElement, Tcl_DStringAppendElement,
+and the "lappend" command that caused improper omission of a separator
+space in some cases.  For example, the script
+    set x "abc{"; lappend x "def"
+used to return the result "abc{def" instead of "abc{ def".
+
+250. 3/3/94 Tcl_ConvertElement was outputting empty elements as \0 if
+TCL_DONT_USE_BRACES was set.  This depends on old pre-7.0 meaning of
+\0, which is no longer in effect, so it didn't really work.  Changed
+to output empty elements as {} always.
+
+251. 3/3/94 Renamed Tcl_DStringTrunc to Tcl_DStringSetLength and extended
+it so that it can be used to lengthen a string as well as shorten it.
+Tcl_DStringTrunc is defined as a macro for backward compatibility, but
+it is deprecated.
+
+252. 3/3/94 Added Tcl_AllowExceptions procedure.
+
+253. 3/13/94 Fixed bug in Tcl_FormatCmd that could cause "format"
+to mis-behave on 64-bit Big-Endian machines.
+
+254. 3/13/94 Changed to use vfork instead of fork on systems where
+vfork exists.
+
+255. 3/23/94 Fixed bug in expressions where ?: didn't associate
+right-to-left as they should.
+
+256. 4/3/94 Fixed "exec" to flush any files used in >@ or >&@
+redirection in exec, so that data buffered for them is written
+before any new data added by the subprocess.
+
+257. 4/3/94 Added "subst" command.
+
+258. 5/20/94 The tclsh main program is now called Tcl_Main;  tclAppInit.c
+has a "main" procedure that calls Tcl_Main.  This makes it easier to use
+Tcl with C++ programs, which need their own main programs, and it also
+allows an application to prefilter the argument list before calling
+Tcl_Main.
+*** POTENTIAL INCOMPATIBILITY ***
+
+259. 6/6/94 Fixed bug in procedure returns where the errorInfo variable
+could get truncated if an unset trace was invoked as part of returning
+from the procedure.
+
+260. 6/13/94 Added "wordstart" and "wordend" options to "string" command.
+
+261. 6/27/94 Fixed bug in expressions where they didn't properly cancel
+the evaluation of math functions in &&, ||, and ?:.
+
+262. 7/11/94 Incorrect boolean values, like "ogle", weren't being
+handled properly.
+
+263. 7/15/94 Added Tcl_RegExpCompile, Tcl_RegExpExec, and Tcl_RegExpRange,
+which provide lower-level access to regular expression pattern matching.
+
+264. 7/22/94 Fixed bug in "glob" command where "glob -nocomplain ~bad_user"
+would complain about a missing user.  Now it doesn't complain anymore.
+
+265. 8/4/94 Fixed bug with linked variables where they didn't behave
+correctly when accessed via upvars.
+
+266. 8/17/94 Fixed bug in Tcl_EvalFile where it didn't clear interp->result.
+
+267. 8/31/94 Modified "open" command so that errors in exec-ing
+subprocesses are returned by the open immediately, rather than
+being delayed until the "close" is executed.
+
+268. 9/9/94 Modified "expr" command to generate errors for integer
+overflow (includes addition, subtraction, negation, multiplication,
+division).
+
+269. 9/23/94 Modified "regsub" to return a count of the number of
+matches and replacements, rather than 0/1.
+
+279. 10/4/94 Added new features to "array" command:
+    - added "get" and "set" commands for easy conversion between arrays
+      and lists.
+    - added "exists" command to see if a variable is an array, changed
+      "names" and "size" commands to treat a non-existent array (or scalar
+      variable) just like an empty one.
+    - added pattern option to "names" command.
+
+280. 10/6/94 Modified Tcl_SetVar2 so that read traces on variables get
+called during append operations.
+
+281. 10/20/94 Fixed bug in "read" command where reading from stdin
+required two control-D's to stop the reading.
+
+282. 11/3/94 Changed "expr" command to use longs for division just like
+all other expr operators;  it previously used ints for division.
+
+283. 11/4/94 Fixed bugs in "unknown" procedure:  it wasn't properly
+handling exception returns from commands that were executed after
+being auto-loaded.
+
+----------------- Released version 7.4b1, 12/23/94 ------------------
+
+284. 12/26/94 Fixed "install" target in Makefile (couldn't always
+find install program).
+
+285. 12/26/94 Added strcncasecmp procedure to compat directory.
+
+286. 1/3/95 Fixed all procedure calls to explicitly cast arguments:
+implicit conversions from prototypes (especially integer->double)
+don't work when compiling under non-ANSI compilers.  Tcl is now clean
+under gcc -Wconversion.
+
+287. 1/4/95 Fixed problem in Tcl_ArrayCmd where same name was used for
+both a label and a variable;  caused problems on several older compilers,
+making array command misbehave and causing many errors in Tcl test suite.
+
+----------------- Released version 7.4b2, 1/12/95 ------------------
+
+288. 2/9/95 Modified Tcl_CreateCommand to return a token, and added
+Tcl_GetCommandName procedure.  Together, these procedures make it possible
+to track renames of a command.
+
+289. 2/13/95 Fixed bug in expr where "089" was interpreted as a
+floating-point number rather than a bogus octal number.
+*** POTENTIAL INCOMPATIBILITY ***
+
+290. 2/14/95 Added code to Tcl_GetInt and Tcl_GetDouble to check for
+overflows when reading in numbers.
+
+291. 2/18/95 Changed "array set" to stop after first error, rather than
+continuing after error.
+
+292. 2/20/95 Upgraded to use autoconf version 2.2.
+
+293. 2/20/95 Fixed core dump that could occur in "scan" command if a
+close bracket was omitted.
+
+294. 2/27/95 Changed Makefile to always use install-sh for installations:
+there's just too much variation among "install" system programs, which
+makes installation flakey.
+
+----------------- Released version 7.4b3, 3/24/95 ------------------
+
+3/25/95 (bug fix) Changed "install" to "./install" in Makefile so that
+"make install" will work even when "." isn't in the search path.
+
+3/29/95 (bug fix) Fixed bug where the auto-loading mechanism wasn't
+protecting the values of the errorCode and errorInfo variables.
+
+3/29/95 (new feature) Added optional pattern argument to "parray" procedure.
+
+3/29/95 (bug fix) Made the full functionality of
+    "return -code ... -errorcode ..."
+work not just inside procedures, but also in sourced files and at
+top level.
+
+4/6/95 (new feature) Added "pattern" option to "array names" command.
+
+4/18/95 (bug fix) Fixed bug in parser where it didn't allow backslash-newline
+immediately after an argument in braces or quotes.
+
+4/19/95 (new feature) Added tcl_library variable, which application can
+set to override default library directory.
+
+4/30/95 (bug fix) During trace callbacks for array elements, the variable
+name used in the original reference would be temporarily modified to
+separate the array name and element name;  if the trace callback used
+the same name string, it would get the wrong name (the array name without
+element).  Fixed to restore the variable name before making trace
+callbacks.
+
+4/30/95 (new feature) Added -nobackslashes, -nocommands, and -novariables
+switches to "subst" command.
+
+5/4/95 (new feature) Added TCL_EVAL_GLOBAL flag to Tcl_RecordAndEval.
+
+5/5/95 (bug fix)  Format command would overrun memory when printing
+integers with very large precision, as in "format %.1000d 0".
+
+5/5/95 (portability improvement) Changed to use BSDgettimeofday on
+IRIX machines, to avoid compilation problems with the gettimeofday
+declaration.
+
+5/6/95 (bug fix) Changed manual entries to use the standard .TH
+macro instead of a custom .HS macro;  the .HS macro confuses index
+generators like makewhatis.
+
+5/9/95 (bug fix) Modified configure script to check for Solaris bug
+that makes vfork unreliable (core dumps result if vforked child
+changes a signal handler);  will use fork instead of vfork if the
+bug is present.
+
+6/5/95 (bug fix) Modified "lsort" command to disallow recursive calls
+to lsort from a comparison function.  This is needed because qsort
+is not reentrant.
+
+6/5/95 (bug fix) Undid change 243 above:  changed TCL_VOLATILE and
+TCL_DYNAMIC back to integer constants rather than procedure addresses.
+This was needed because procedure addresses can have multiple values
+under some dynamic loading systems (e.g. SunOS 4.1 and Windows).
+
+6/8/95 (feature change) Modified interface to Tcl_Main to pass in the
+address of the application-specific initialization procedure.
+Tcl_AppInit is no longer hardwired into Tcl_Main.  This is needed
+in order to make Tcl a shared library. 
+
+6/8/95 (feature change) Modified Makefile so that the installed versions
+of tclsh and libtcl.a have version number in them (e.g. tclsh7.4 and
+libtcl7.4.a) and the library directory name also has an embedded version
+number (e.g., /usr/local/lib/tcl7.4).  This should make it easier for
+Tcl 7.4 to coexist with earlier versions.
+
+----------------- Released version 7.4b4, 6/16/95 ------------------
+
+6/19/95 (bug fix) Fixed bugs in tclCkalloc.c that caused core dumps
+if TCL_MEM_DEBUG was enabled on word-addressed machines such as Crays.
+
+6/21/95 (feature removal) Removed overflow checks for integer arithmetic:
+they just cause too much trouble (e.g. for random  number generators).
+
+6/28/95 (new features) Added tcl_patchLevel and tcl_version variables,
+for consistency with Tk.
+
+6/29/95 (bug fix) Fixed problem in Tcl_Eval where it didn't record
+the right termination character if a script ended with a comment.  This
+caused erroneous output for the following command, among others:
+puts "[
+expr 1+1
+# duh!
+]"
+
+6/29/95 (message change) Changed the error message for ECHILD slightly
+to provide a hint about why the problem is occurring.
+
+----------------- Released version 7.4, 7/1/95 ------------------
+
+7/18/95 (bug fix) Changed "lreplace" so that nothing is deleted if
+the last index is less than the first index or if the last index
+is < 0.
+
+7/18/95 (bug fix) Fixed bugs with backslashes in comments:
+Tcl_CommandComplete (and "info complete") didn't properly handle
+strings ending in backslash-newline, and neither Tcl_CommandComplete
+nor the Tcl parser handled other backslash sequences right, such
+as two backslashes before a newline.
+
+7/19/95 (bug fix) Modified Tcl_DeleteCommand to delete the hash table
+entry for the command before invoking its callback.  This is needed in
+order to deal with reentrancy.
+
+7/22/95 (bug fix) "exec" wasn't reaping processes correctly after
+certain errors (e.g. if the name of the executable was bogus, as
+in "exec foobar").
+
+7/27/95 (bug fix) Makefile.in wasn't using the LIBS variable provided
+by the "configure" script.  This caused problems on some SCO systems.
+
+7/27/95 (bug fix) The version of strtod in fixstrtod.c didn't properly
+handle the case where endPtr == NULL.
+
+----------------- Released patch 7.4p1, 7/29/95 -----------------------
+
+8/4/95 (bug fix) C-level trace callbacks for variables were sometimes
+receiving the PART1_NOT_PARSED flag, which could cause errors in
+subsequent Tcl library calls using the flags. (JO)
+
+8/4/95 (bug fix) Calls to toupper and tolower weren't using the
+UCHAR macros, which caused trouble in non-U.S. locales. (JO)
+
+8/10/95 (new feature) Added the "load" command for dynamic loading of
+binary packages, and the Tcl_PackageInitProc prototype for package
+initialization procedures. (JO)
+
+8/23/95 (new features) Added "info sharedlibextension" and
+"info nameofexecutable" commands, plus Tcl_FindExtension procedure. (JO)
+
+8/25/95 (bug fix) If the target of an "upvar" was non-existent but
+had traces set, the traces were silently lost.  Change to generate
+an error instead. (JO)
+
+8/25/95 (bug fix) Undid change from 7/19, so that commands can stay
+around while their deletion callbacks execute.  Added lots of code to
+handle all of the reentrancy problems that this opens up. (JO)
+
+8/25/95 (bug fix) Fixed core dump that could occur in TclDeleteVars
+if there was an upvar from one entry in the table to the next entry
+in the same table. (JO)
+
+8/28/95 (bug fix) Exec wasn't handling bad user names properly, as
+in "exec ~bogus_user/foo". (JO)
+
+8/29/95 (bug fixes) Changed backslash-newline handling to correct two
+problems:
+    - Only spaces and tabs following the backslash-newline are now
+      absorbed as part of the backslash-newline.  Newlinew are no
+      longer absorbed (add another backslash if you want to absorb
+      another newline).
+    - TclWordEnd returns the character just before the backslash in
+      the sequence as the end of the sequence;  it used to not consider
+      the backslash-newline as a word separator. (JO)
+
+8/31/95 (new feature) Changed man page installation (with "mkLinks"
+script) to create additional links for manual pages corresponding to
+each of the procedure and command names described in the pages. (JO)
+
+9/10/95 Reorganized Tcl sources for Windows and Mac ports.  All sources
+are now in subdirectories:  "generic" contains sources that work on all
+platforms, "windows", "mac", and "unix" directories contain platform-
+specific sources.  Some UNIX sources are also used on other platforms. (SS)
+
+9/10/95 (feature change) Eliminated exported global variables (they
+don't work with Windows DLLs).  Replaced tcl_AsyncReady and
+tcl_FileCloseProc with procedures Tcl_AsyncReady() and
+Tcl_SetFileCloseProc().  Replaced C variable tcl_RcFileName with
+a Tcl variable tcl_rcFileName. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+9/11/95 (new feature) Added procedure Tcl_SetPanicProc to override
+the default implementation of "panic". (SS)
+
+9/11/95 (new feature) Added "interp" command to allow creation of
+new interpreters and execution of untrusted scripts.  Added many new
+procedures, such as Tcl_CreateSlave, Tcl_CreateAlias,and Tcl_MakeSafe,
+to provide C-level access to the interpreter facility. This mechanism
+now provides almost all of the generic functions of Borenstein's and
+Rose's Safe-Tcl (but not any Tk or email-related stuff).  (JL)
+
+9/11/95 (feature change) Changed file management so that files are
+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. (JL)
+*** POTENTIAL INCOMPATIBILITY ***
+
+9/11/95 (new feature) Added "AssocData" mechanism, whereby extensions
+can associate their own data with 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.  (JL)
+
+9/11/95 (new feature) Added Tcl_ErrnoMsg to translate an errno value
+into a human-readable string.  This is now used instead of calling
+strerror because strerror mesages vary dramatically from platform
+to platform, which messes up Tcl tests.  Tcl_ErrnoMsg uses the standard
+POSIX messages for all the common signals, and calls strerror for
+signals it doesn't understand.
+
+----------------- Released patch 7.5p2, 9/15/95 -----------------------
+
+----------------- Released 7.5a1, 9/15/95 -----------------------
+
+9/22/95 (bug fix) Changed auto_mkindex to create tclIndex files that
+handle directories whose paths might contain spaces. (RJ)
+
+9/27/95 (bug fix) The "format" command didn't check for huge or negative
+width specifiers, which could cause core dumps. (JO)
+
+9/27/95 (bug fix) Core dumps could occur if an interactive command typed
+to tclsh returned a very long result for tclsh to print out.  The bug is
+actually in printf (in Solaris 2.3 and 2.4, at least);  switched to use
+puts instead.  (JO)
+
+9/28/95 (bug fix) Changed makefile.bc to eliminate a false dependency
+for tcl1675.dll on the Borland run time library. (SS)
+
+9/28/95 (bug fix) Fixed tcl75.dll so it looks for tcl1675.dll instead
+of tcl16.dll. (SS)
+
+9/28/95 (bug fix) Tcl was not correctly detecting the difference
+between Win32s and Windows '95. (SS)
+
+9/28/95 (bug fix) "exec" was not passing environment changes to child
+processes under Windows. (SS)
+
+9/28/95 (bug fix) Changed Tcl to ensure that open files are not passed
+to child processes under Windows. (SS)
+
+9/28/95 (bug fix) Fixed Windows '95 and NT versions of exec so it can
+handle both console and windows apps.   (SS)
+
+9/28/95 (bug fix) Fixed Windows version of exec so it no longer leaves
+temp files lying around.  Also changed it so the temp files are
+created in the appropriate system dependent temp directory. (SS)
+
+9/28/95 (bug fix) Eliminated source dependency on the Win32s Universal
+Thunk header file, since it is not bundled with VC++. (SS)
+
+9/28/95 (bug fix) Under Windows, Tcl now constructs the HOME
+environment variable from HOMEPATH and HOMEDRIVE when HOME is not
+already set. (SS)
+
+9/28/95 (bug fix) Added support for "info nameofexecutable" and "info
+sharedlibextension" to the Windows version. (SS)
+
+9/28/95 (bug fix) Changed tclsh to correctly parse command line
+arguments so that backslashes are preserved under Windows. (SS)
+
+9/29/95 (bug fix) Tcl 7.5a1 treated either return or newline as end
+of line in "gets", which caused lines ending in CRLF to be treated as
+two separate lines.  Changed to allow only character as end-of-line:
+carriage return on Macs, newline elsewhere. (JO)
+
+9/29/95 (new feature) Changed to install "configInfo" file in same
+directory as library scripts.  It didn't used to get installed. (JO)
+
+9/29/95 (bug fix) Tcl was not converting Win32 errors into POSIX
+errors under some circumstances. (SS)
+
+10/2/95 (bug fix) Safe interpreters no longer get initialized with
+a call to Tcl_Init(). (JL)
+
+10/1/95 (new feature) Added "tcl_platform" global variable to provide
+environment information such as the instruction set and operating
+system. (JO)
+
+10/1/95 (bug fix) "exec" command wasn't always generating the
+"child process exited abnormally" message when it should have.  (JO)
+
+10/2/95 (bug fix) Changed "mkLinks.tcl" so that the scripts it generates
+won't create links that overwrite original manual entries (there was
+a problem where pack-old.n was overwriting pack.n).  (JO)
+
+10/2/95 (feature change) Changed to use -ldl for dynamic loading under
+Linux if it is available, but fall back to -ldld if it isn't.  (JO)
+
+10/2/95 (bug fix) File sharing was causing refcounts to reach 0
+prematurely for stdin, stdout and stderr, under some circumstances. (JL)
+
+10/2/95 (platform support) Added support for Visual C++ compiler on
+Windows, Windows '95 and Windows NT, code donated by Gordon Chaffee. (JL)
+
+10/3/95 (bug fix) Tcl now frees any libraries that it loads before it
+exits. (SS)
+
+10/03/95 (bug fix) Fixed bug in Macintosh ls command where the -l
+and -C options would fail in anything but the HOME directory. (RJ)
+
+----------------- Released 7.5a2, 10/6/95 -----------------------
+
+10/10/95 (bug fix) "file dirnam /." was returning ":" on UNIX instead
+of "/". (JO)
+
+10/13/95 (bug fix) Eliminated dependency on MKS toolkit for generating
+the tcl.def file from Borland object files. (SS)
+
+10/17/95 (new features) Moved the event loop from Tcl to Tk, made major
+revisions along the way:
+    - New Tcl commands:  after, update, vwait (replaces "tkwait variable").
+    - "tkerror" is now replaced with "bgerror".
+    - The following procedures are similar to their old Tk counterparts:
+      Tcl_DoOneEvent, Tcl_Sleep, Tcl_DoWhenIdle, Tcl_CancelIdleCall,
+      Tcl_CreateFileHandler, Tcl_DeleteFileHandler, Tcl_CreateTimerHandler,
+      Tcl_DeleteTimerHandler, Tcl_BackgroundError.
+    - Revised notifier, add new concept of "event source" with the following
+      procedures:  Tcl_CreateEventSource, Tcl_DeleteEventSource,
+      Tcl_WatchFile, Tcl_SetMaxBlockTime, Tcl_FileReady, Tcl_QueueEvent,
+      Tcl_WaitForEvent. (JO)
+
+10/31/95 (new features) Implemented cross platform file name support to make
+it easier to write cross platform scripts.  Tcl now understands 4 file naming
+conventions: Windows (both DOS and UNC), Mac, Unix, and Network.  The network
+convention is a new naming mechanism that can be used to paths in a platform
+independent fashion.  See the "file" command manual page for more details.
+The primary interfaces changes are:
+    - All Tcl commands that expect a file name now accept both network and
+      native form.
+    - Two new "file" subcommands, "nativename" and "networkname", provide a
+      way to convert between network and native form.
+    - Renamed Tcl_TildeSubst to Tcl_TranslateFileName, and changed it so that
+      it always returns a filename in native form.  Tcl_TildeSubst is defined
+      as a macro for backward compatibility, but it is deprecated. (SS)
+
+11/5/95 (new feature) Made "tkerror" and "bgerror" synonyms, so that
+either name can be used to manipulate the command (provides temporary
+backward compatibility for existing scripts that use tkerror). (JO)
+
+11/5/95 (new feature) Added exit handlers and new C procedures
+Tcl_CreateExitHandler, Tcl_DeleteExitHandler, and Tcl_Exit. (JO)
+
+11/6/95 (new feature) Added pid command for Macintosh version of
+Tcl (it didn't previously exist on the Mac). (RJ)
+
+11/7/95 (new feature) New generic IO facility and support for IO to
+files, pipes and sockets based on a common buffering scheme. Support
+for asynchronous (non-blocking) IO and for event driver IO. Support
+for automatic (background) asynchronous flushing and asynchronous
+closing of channels. (JL)
+
+11/7/95 (new feature)  Added new commands "fconfigure" and "fblocked"
+to support new I/O features such as nonblocking I/O.  Added "socket"
+command for creating TCP client and server sockets. (JL).
+
+11/7/95 (new feature) Complete set of C APIs to the new generic IO
+facility:
+    - Opening channels: Tcl_OpenFileChannel, Tcl_OpenCommandChannel,
+      Tcl_OpenTcpClient, Tcl_OpenTcpServer.
+    - I/O procedures on channels, which roughly mirror the ANSI C stdio
+      library:  Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek,
+      Tcl_Tell, Tcl_Close, Tcl_Eof, Tcl_InputBlocked, Tcl_GetChannelOption,
+      Tcl_SetChannelOption.
+    - Extension mechanism for creating new kinds of channels:
+      Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType,
+      Tcl_GetChannelName, Tcl_GetChannelFile, Tcl_RegisterChannel,
+      Tcl_UnregisterChannel, Tcl_GetChannel.
+    - Event-driven I/O on channels: Tcl_CreateChannelHandler,
+      Tcl_DeleteChannelHandler. (JL)
+
+11/7/95 (new feature) Channel driver interface specification to allow
+new types of channels to be added easily to Tcl. Currently being used
+in three drivers - for files, pipes and TCP-based sockets. (JL).
+
+11/7/95 (new feature) interp delete now takes any number of path
+names of interpreters to delete, including zero. (JL).
+
+11/8/95 (new feature) implemented 'info hostname' and Tcl_GetHostName
+command to get host name of machine on which the Tcl process is running. (JL)
+
+11/9/95 (new feature) Implemented file APIs for access to low level files
+on each system. The APIs are: Tcl_CloseFile, Tcl_OpenFile, Tcl_ReadFile,
+Tcl_WriteFile and Tcl_SeekFile. Also implemented Tcl_WaitPid which waits
+in a system dependent manner for a child process. (JL)
+
+11/9/95 (new feature) Added Tcl_UpdateLinkedVar procedure to force a
+Tcl variable to be updated after its C variable changes. (JO)
+
+11/9/95 (bug fix) The glob command has been totally reimplemented so
+that it can support different file name conventions.  It now handles
+Windows file names (both UNC and drive-relative) properly.  It also
+supports nested braces correctly now. (SS)
+
+11/13/95 (bug fix) Fixed Makefile.in so that configure can be run
+from a clean directory separate from the Tcl source tree, and compilations
+can be performed there. (JO)
+
+11/14/95 (bug fix) Fixed file sharing between interpreters and file
+transferring between interpreters to correctly manage the refcount so that
+files are closed when the last reference to them is discarded. (JL)
+
+11/14/95 (bug fix) Fixed gettimeofday implementation for the
+Macintosh.  This fixes several timing related bugs. (RJ)
+
+11/17/95 (new feature) Added missing support for info nameofexecutable
+on the Macintosh. (RJ)
+
+11/17/95 (bug fix) The Tcl variables argc argv and argv0 now return
+something reasonable on the Mac.  (RJ)
+
+11/22/95 (new feature) Implemented "auto-detect" mode for end of line
+translations. On input, standalone "\r" mean MAC mode, standalone "\n"
+mean Unix mode and "\r\n" means Windows mode. On output, the mode is
+modified to whatever the platform specific mode for that platform is. (JL)
+
+11/24/95 (feature change) Replaced "configInfo" file with tclConfig.sh,
+which is more complete and uses slightly different names.  Also
+arranged for tclConfig.sh to be installed in the platform-specific
+library directory instead of Tcl's script library directory. (JO)
+*** POTENTIAL INCOMPATIBILITY with Tcl 7.5a2, but not with Tcl 7.4 ***
+
+----------------- Released patch 7.4p3, 11/28/95 -----------------------
+
+12/5/95 (new feature) Added Tcl_File facility to support platform-
+independent file handles.  Changed all interfaces that used Unix-
+style integer fd's to use Tcl_File's instead. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/5/95 (new feature) Added a new "clock" command to Tcl.  The command
+allows you to get the current "clicks" or seconds & allows you to
+format or scan human readable time/date strings. (RJ)
+
+12/18/95 (new feature) Moved Tk_Preserve, Tk_Release, and Tk_EventuallyFree
+to Tcl, renamed to Tcl_Preserve, Tcl_Release, and Tcl_EventuallyFree. (JO)
+
+12/18/95 (new feature) Added new "package" command and associated
+procedures Tcl_PkgRequire and Tcl_PkgProvide.   Also wrote
+pkg_mkIndex library procedure to create index files from binaries
+and scripts. (JO)
+
+12/20/95 (new feature) Added Tcl_WaitForFile procedure. (JO)
+
+12/21/95 (new features) Made package name argument to "load" optional
+(Tcl will now attempt to guess the package name if necessary).  Also
+added Tcl_StaticPackage and support in "load" for statically linked
+packages.  (JO)
+
+12/22/95 (new feature) Upgraded the foreach command to accept multiple
+loop variables and multiple value lists.  This lets you iterate over
+multiple lists in parallel, and/or assign multiple loop variables from
+one value list during each iteration. The only potential compatibility
+problem is with scripts that used loop variables with a name that could be
+construed to be a list of variable names (i.e. contained spaces).  (BW)
+
+1/5/96 (new feature) Changed tclsh so it builds as a console mode
+application under Windows.  Now tclsh can be used from the command
+line with pipes or interactively.  Note that this only works under
+Windows 95 or NT. (SS)
+
+1/17/96 (new feature) Modified Makefile and configure script to allow
+Tcl to be compiled as a shared library:  use the --enable-shared option
+when configuing.  (JO)
+
+1/17/96 (removed obsolete features)  Removed the procedures Tcl_EnterFile
+and Tcl_GetOpenFile:  these no longer make sense with the new I/O system. (JL)
+*** POTENTIAL INCOMPATIBILITY ***
+
+1/19/96 (bug fixes) Prevented formation of circular aliases, through the
+Tcl 'interp alias' command and through the 'rename' command, as well as
+through the C API Tcl_CreateAlias. (JL)
+
+1/19/96 (bug fixes) Fixed several bugs in direct deletion of interpreters
+with Tcl_DeleteInterp when the interpreter is a slave; fixes based on a
+patch received from Viktor Dukhovni of ESM. (JL)
+
+1/19/96 (new feature) Implemented on-close handlers for channels; added
+the C APIs Tcl_CreateCloseHandler and Tcl_DeleteCloseHandler. (JL)
+
+1/19/96 (new feature) Implemented portable error reporting mechanism; added
+the C APIs Tcl_SetErrno and Tcl_GetErrno. (JL)
+
+1/24/96 (bug fix) Unknown command processing properly invokes external
+commands under Windows NT and Windows '95 now. (SS)
+
+1/23/96 (bug fix) Eliminated extremely long startup times under Windows '95.
+The problem was a result of the option database initialization code that
+concatenated $HOME with /.Xdefaults, resulting in a // in the middle of the
+file name.  Under Windows '95, this is incorrectly interpreted as a UNC
+path.  They delays came from the network timeouts needed to determine that
+the file name was invalid.  Tcl_TranslateFileName now suppresses duplicate
+slashes that aren't at the beginning of the file name. (SS)
+				     
+1/25/96 (bug fix) Changed exec and open to create children so they are
+attached to the application's console if it exists. (SS)
+
+1/31/96 (bug fix) Fixed command line parsing to handle embedded
+spaces under Windows. (SS)
+
+----------------- Released 7.5b1, 2/1/96 -----------------------
+
+2/7/96 (bug fix) Fixed off by one error in argument parsing code under
+Windows. (SS)
+
+2/7/96 (bug fix) Fixed bugs in VC++ makefile that improperly
+initialized the tcl75.dll.  Fixed bugs in Borland makefile that caused
+build failures under Windows NT. (SS)
+
+2/9/96 (bug fix) Fixed deadlock problem in AUTO end of line translation
+mode which would cause a socket server with several concurrent clients
+writing in CRLF mode to hang. (JL)
+
+2/9/96 (API change) Replaced -linemode option to fconfigure with a
+new -buffering option, added "none" setting to enable immediate write. (JL)
+*** INCOMPATIBILITY with b1 ***
+
+2/9/96 (new feature) Added C API Tcl_InputBuffered which returns the count
+of bytes currently buffered in the input buffer of a channel, and o for
+output only channels. (JL)
+
+2/9/96 (new feature) Implemented asynchronous connect for sockets. (JL)
+
+2/9/96 (new feature) Added C API Tcl_SetDefaultTranslation to set (per
+channel) the default end of line translation mode. This is the mode that
+will be installed if an output operation is done on the channel while it is
+still in AUTO mode. (JL)
+
+2/9/96 (bug fix) Changed Tcl_OpenCommandChannel interface to properly
+handle all of the combinations of stdio inheritance in background
+pipelines.  See the Tcl_OpenFileChannel(3) man page for more
+info.  This change fixes the bug where exec of a background pipeline
+was not getting passed the stdio handles properly. (SS)
+
+2/9/96 (bug fix) Removed the new Tcl_CreatePipeline interface, and
+restored the old version for Unix platforms only.  All new code should
+use Tcl_CreateCommandChannel instead. (SS)
+
+2/9/96 (bug fix) Changed Makefile.in to use -L and -ltcl7.5 for Tcl
+library so that shared libraries are more likely to be found correctly
+on more platforms. (JO)
+
+2/13/96 (new feature) Added C API Tcl_SetNotifierData and
+Tcl_GetNotifierData to allow notifier and channel driver writers to
+associate data with a Tcl_File.  The result of this change is that
+Tcl_GetFileInfo now always returns an OS file handle, and Tcl_GetFile
+can be used to construct a Tcl_File for an externally constructed OS
+handle. (SS)
+
+2/13/96 (bug fix) Changed Windows socket implementation so it doesn't
+set SO_REUSEADDR on server sockets.  Now attempts to create a server
+socket on a port that is already in use will be properly identified
+and an error will be generated. (SS)
+
+2/13/96 (bug fix) Fixed problems with DLL initialization under Visual
+C++ that left the C run time library uninitialized. (SS)
+
+2/13/96 (bug fix) Fixed Windows socket initialization so it loads
+winsock the first time it is used, rather than at the time tcl75.dll
+is loaded.  This should fix the bug where the modem immediately starts
+trying to connect to a service provider when wish or tclsh are
+started. (SS)
+
+2/13/96 (new feature) Added C APIs Tcl_MakeFileChannel and
+Tcl_MakeTcpClientChannel to wrap up existing fds and sockets into
+channels. Provided implementations on Unix and Windows. (JL)
+
+2/13/96 (bug fix) Fixed bug with seek leaving EOF and BLOCKING set. (JL)
+
+2/14/96 (bug fix) Fixed reentrancy problem in fileevent handling
+and made it more robust in the face of errors. (JL)
+
+2/14/96 (feature change) Made generic IO level emulate blocking mode if the
+channel driver is unable to provide it, e.g. if the low level device is
+always nonblocking. Thus, now blocking behavior is an advisory setting for
+channel drivers and can be ignored safely if the channel driver is unable
+to provide it. (JL)
+
+2/15/96 (new feature) Added "binary" end of line translation mode, which is
+a synonym of "lf" mode. (JL)
+
+2/15/96 (bug fix) Fixed reentrancy problem in fileevent handling vs
+deletion of channel event handlers. (JL)
+
+2/15/96 (bug fix) Fixed bug in event handling which would cause a
+nonblocking channel to not see further readable events after the first
+readable event that had insufficient input. (JL)
+
+2/17/96 (bug fix) "info complete" didn't properly handle comments
+in nested commands. (JO)
+
+2/21/96 (bug fix) "exec" under Windows NT/95 did not properly handle
+very long command lines (>200 chars). (SS)
+
+2/21/96 (bug fix) Sockets could get into an infinite loop if a read
+event arrived after all of the available data had been read. (SS)
+
+2/22/96 (bug fix) Added cast of st_size elements to (long) before
+sprintf-ing in "file size" command.  This is needed to handle systems
+like NetBSD with 64-bit file offsets.  (JO)
+
+----------------- Released 7.5b2, 2/23/96 -----------------------
+
+2/23/96 (bug fix) TCL_VARARGS macro in tcl.h wasn't defined properly
+when compiling with C++.  (JO)
+
+2/24/96 (bug fix) Removed dependencies on Makefile in the UNIX Makefile:
+this caused problems on some platforms (like Linux?). (JO)
+
+2/24/96 (bug fix) Fixed configuration bug that made Tcl not compile
+correctly on Linux machines with neither -ldl or -ldld. (JO)
+
+2/24/96 (new feature) Added a block of comments and definitions to
+Makefile.in to make it easier to have Tcl's TclSetEnv etc. replace
+the library procedures setenv etc, so that calls to setenv etc. in
+the application automatically update the Tcl "env" variable. (JO)
+
+2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL)
+to C API Tcl_Close and simplified closing of command channels. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+
+2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL)
+to C type definition Tcl_DriverCloseProc; modified all channel drivers to
+implement close procedures that accept the additional argument. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+
+2/28/96 (bug fix) Fixed memory leak that could occur if an upvar
+referred to an element of an array in the same stack frame as the
+upvar. (JO)
+
+2/29/96 (feature change) Modified both Tcl_DoOneEvent and Tcl_WaitForEvent
+so that they return immediately in cases where they would otherwise
+block forever (e.g. if there are no event handlers of any sort). (JO)
+
+2/29/96 (new feature) Added C APIs Tcl_GetChannelBufferSize and
+Tcl_SetChannelBufferSize to set and retrieve the size, in bytes, for
+buffers allocated to store input or output in a channel. (JL)
+
+2/29/96 (new feature) Added option -buffersize to Tcl fconfigure command
+to allow Tcl scripts to query and set the size of channel buffers. (JL)
+
+2/29/96 (feature removed) Removed channel driver function to specify
+the buffer size to use when allocating a buffer. Removed the C typedef
+for Tcl_DriverBufferSizeProc. Channels are now created with a default
+buffer size of 4K. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+
+2/29/96 (feature change) The channel driver function for setting blocking
+mode on the device may now be NULL. If the generic code detects that the
+function is NULL, operations that set the blocking mode on the channel
+simply succeed. (JL)
+
+3/2/96 (bug fix) Fixed core dump that could occur if a syntax error
+(such as missing close paren) occurred in an array reference with a
+very long array name. (JO)
+
+3/4/96 (bug fix) Removed code in the "auto_load" procedure that deletes
+all existing auto-load information whenever the "auto_path" variable
+is changed.  Instead, new information adds to what was already there.
+Otherwise, changing the "auto_path" variable causes all package-
+related information to be lost.  If you really want to get rid of
+existing auto-load information, use auto_reset before setting auto_path. (JO)
+
+3/5/96 (new feature) Added version suffix to shared library names so that
+Tcl will compile under NetBSD and FreeBSD (I hope).  (JO)
+
+3/6/96 (bug fix) Cleaned up error messages in new I/O system to correspond
+more closely to old I/O system. (JO)
+
+3/6/96 (new feature) Added -myaddr and -myport options to the socket
+command, removed -tcp and -- options.  This lets clients and servers
+choose a particular interface.  Also changed the default server address
+from the hostname to INADDR_ANY.  The server accept callback now gets
+passed the client's port as well as IP address.  The C interfaces for
+Tcl_OpenTcpClient and Tcl_OpenTcpServer have changed to support the
+above changes. (BW)
+*** POTENTIAL INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+
+3/6/96 (changed feature) The library function auto_mkindex will now
+default to using the pattern "*.tcl" if no pattern is given. (RJ)
+
+3/6/96 (bug fix) The socket channel code for the Macintosh has been
+rewritten to use native MacTcp.  (RJ)
+
+3/7/96 (new feature) Added Tcl_SetStdChannel and Tcl_GetStdChannel
+interfaces to allow applications to explicitly set and get the global
+standard channels. (SS)
+
+3/7/96 (bug fix) Tcl did close not the file descriptors associated
+with "stdout", etc. when the corresponding channels were closed.  (SS)
+
+3/7/96 (bug fix) Reworked shared library and dynamic loading stuff to
+try to get it working under AIX.  Added new @SHLIB_LD_LIBS@ autoconf
+symbol as part of this.  AIX probably doesn't work yet, but it should
+be a lot closer. (JO)
+
+3/7/96 (feature change) Added Tcl_ChannelProc typedef and changed the
+signature of Tcl_CreateChannelHandler and Tcl_DeleteChannelHandler to take
+Tcl_ChannelProc arguments instead of Tcl_FileProc arguments. This change
+should not affect any code outside Tcl because the signatures of
+Tcl_ChannelProc and Tcl_FileProc are compatible. (JL)
+
+3/7/96 (API change) Modified signature of Tcl_GetChannelOption to return
+an int instead of char *, and to take a Tcl_DString * argument. Modified
+the implementation so that the option name can be NULL, to mean that the
+call should retrieve a list of alternating option names and values. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+
+3/7/96 (API change) Added Tcl_DriverSetOptionProc, Tcl_DriverGetOptionProc
+typedefs, added two slots setOptionProc and getOptionProc to the channel
+type structure. These may be NULL to indicate that the channel type does
+not support any options. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 ***
+
+3/7/96 (feature change) stdin, stdout and stderr can now be put into
+nonblocking mode. (JL)
+
+3/8/96 (feature change) Eliminated dependence on the registry for
+finding the Tcl library files. (SS)
+
+----------------- Released 7.5b3, 3/8/96 -----------------------
+
+3/12/96 (feature improvement) Modified startup script to look in several
+different places for the Tcl library directory.  This should allow Tcl
+to find the libraries under all but the weirdest conditions, even without
+the TCL_LIBRARY environment variable being set. (JO)
+
+3/13/96 (bug fix) Eliminated use of the "linger" option from the Windows
+socket implementation. (JL)
+
+3/13/96 (new feature) Added -peername and -sockname options for fconfigure
+for socket channels. Code contributed by John Haxby of HP. (JL)
+
+3/13/96 (bug fix) Fixed panic and core dump that would occur if the accept
+callback script on a server socket encountered an error. (JL)
+
+3/13/96 (feature change) Added -async option to the Tcl socket command.
+If the command is creating a client socket and the flag is present, the
+client is connected asynchronously. If the option is absent (the default),
+the client socket is connected synchronously, and the command returns only
+when the connection has been completed or failed. This change was suggested
+by Mark Diekhans. (JL)
+
+3/13/96 (feature change) Modified the signature of Tcl_OpenTcpClient to
+take an additional int argument, async. If nonzero, the client is connected
+to the server asynchronously. If the value is zero, the connection is made
+synchronously, and the call to Tcl_OpenTcpClient returns only when the
+connection fails or succeeds. This change was suggested by Mark Diekhans. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
+
+3/14/96 (bug fix) "tclsh bogus_file_name" didn't print an error message. (JO)
+
+3/14/96 (bug fix) Added new procedures to tclCkalloc.c so that libraries
+and applications can be compiled with TCL_MEM_DEBUG even if Tcl isn't
+(however, the converse is still not true).  Patches provided by Jan
+Nijtmans. (JO)
+
+3/15/96 (bug fix) Marked standard IO handles of a process as close-on-exec
+to fix bug in Ultrix where exec was not sharing standard IO handles with
+subprocesses. Fix suggested by Mark Diekhans. (JL)
+
+3/15/96 (bug fix) Fixed asynchronous close mechanism so that it closes the
+channel instead of leaking system resources. The manifestation was that Tcl
+would eventually run out of file descriptors if it was handling a large
+number of nonblocking sockets or pipes with high congestion. (JL)
+
+3/15/96 (bug fix) Fixed tests so that they no longer leak file descriptors.
+The manifestation was that Tcl would eventually run out of file descriptors
+if the tests were rerun many times (> a hundred times on Solaris). (JL)
+
+3/15/96 (bug fix) Fixed channel creation code so that it never creates
+unnamed channels. This would cause a panic and core dump when the channel
+was closed. (JL)
+
+3/16/96 (bug fixes) Made lots of changes in configuration stuff to get
+Tcl working under AIX (finally).  Tcl should now support the "load"
+command under AIX and should work either with or without shared
+libraries for Tcl and Tk. (JO)
+
+3/21/96 (configuration improvement) Changed configure script so it
+doesn't use version numbers (as in -ltcl7.5 and libtcl7.5.so) under
+SunOS 4.1, where they don't work anyway.  (JO)
+
+3/22/96 (new feature) Added C API Tcl_InterpDeleted that allows extension
+writers to discover when an interpreter is being deleted. (JL)
+
+3/22/96 (bug fix) The standard IO channels are now added to each
+trusted interpreter as soon as the interpreter is created. This ensures
+against the bug where a child would do IO before the master had done any,
+and then the child is destroyed - the standard IO channels would be then
+closed and the master would be unable to do any IO. (JL)
+
+3/22/96 (bug fix) Made Tcl more robust against interpreter deletion, by
+using Tcl_Preserve, Tcl_Release and Tcl_EventuallyFree to split the process
+of interpreter deletion into two distinct phases. Also went through all of
+Tcl and added calls to Tcl_Preserve and Tcl_Delete where needed. (JL)
+
+3/22/96 (bug fix) Fixed several places where C code was reading and writing
+into freed memory, especially during interpreter deletion. (JL)
+
+3/22/96 (bug fix) Fixed very deep bug in Tcl_Release that caused memory to
+be freed twice if the release callback did Tcl_Preserve and Tcl_Release on
+the same memory as the chunk currently being freed. (JL)
+
+3/22/96 (bug fix) Removed several memory leaks that would cause memory
+buildup on half-K chunks in the generic IO level. (JL)
+
+3/22/96 (bug fix) Fixed several core dumps which occurred when new
+AssocData was being created during the cleanups in interpreter deletion.
+The solution implemented now is to loop repeatedly over the AssocData until
+none is left to clean up. (JL)
+
+3/22/96 (bug fix) Fixed a bug in event handling which caused an infinite
+loop if there were no files being watched and no timer. Fix suggested by
+Jan Nijtmans. (JL)
+
+3/22/96 (bug fix) Fixed Tcl_CreateCommand, Tcl_DeleteCommand to be more
+robust if the interpreter is being deleted. Also fixed several order
+dependency bugs in Tcl_DeleteCommand which kicked in when an interpreter
+was being deleted. (JL)
+
+3/26/96 (bug fix) Upon a "short read", the generic code no longer calls
+the driver for more input. Doing this caused blocking on some platforms
+even on nonblocking channels. Bug and fix courtesy Mark Roseman. (JL)
+
+3/26/96 (new feature) Added 'package Tcltest' which is present only in
+test versions of Tcl; this allows the testing commands to be loaded into
+new interpreters besides the main one. (JL)
+
+3/26/96 (restored feature) Recreated the Tcl_GetOpenFile C API. You can
+now get a FILE * from a registered channel; Unix only. (JL)
+
+3/27/96 (bug fix) The regular expression code did not support more
+than 9 subexpressions.  It now supports up to 20. (SS)
+
+4/1/96 (bug fixes) The CHANNEL_BLOCKED bit was being left on on a short
+read, so that fileevents wouldn't fire correctly. Bug reported by Mark
+Roseman.(JL, RJ)
+
+4/1/96 (bug fix) Moved Tcl_Release to match Tcl_Preserve exactly, in
+tclInterp.c; previously interpreters were being freed only conditionally
+and sometimes not at all. (JL)
+
+4/1/96 (bug fix) Fixed error reporting in slave interpreters when the
+error message was being generated directly by C code. Fix suggested by
+Viktor Dukhovni of ESM. (JL)
+
+4/2/96 (bug fixes) Fixed a series of bugs in Windows sockets that caused
+events to variously get lost, to get sent multiple times, or to be ignored
+by the driver. The manifestation was blocking if the channel is blocking,
+and either getting EAGAIN or infinite loops if the channel is nonblocking.
+This series of bugs was found by Ian Wallis of Cisco. Now all tests (also
+those that were previously commented out) in socket.test pass.  (JL, SS)
+
+4/2/96 (feature change/bug fix) Eliminated network name support in
+favor of better native name support.  Added "file split", "file join",
+and "file pathtype" commands.  See the "file" man page for more
+details. (SS)
+*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
+
+4/2/96 (bug fix) Changed implementation of auto_mkindex so tclIndex
+files will properly handle path names in a cross platform context. (SS)
+
+4/5/96 (bug fix) Fixed Tcl_ReadCmd to use the channel buffer size as the
+chunk size it reads, instead of a fixed 4K size. Thus, on large reads, the
+user can set the channel buffer size to a large size and the read will
+occur orders of magnitude faster. For example, on a 2MB file, reading in 4K
+chunks took 34 seconds, while reading in 1MB chunks took 1.5 seconds (on a
+SS-20). Problem identified and fix suggested by John Haxby of HP. (JL)
+
+4/5/96 (bug fix) Fixed socket creation code to invoke gethostbyname only if
+inet_addr failed (very unlikely). Before this change the order was reversed
+and this made things much slower than they needed to be (gethostbyname
+generally requires an RPC, which is slow). Problem identified and fix
+suggested by John Loverso of OSF. (JL)
+
+4/9/96 (feature change) Modified "auto" translation mode so that it
+recognizes any of "\n", "\r" and "\r\n" in input as end of line, so
+that a file can have mixed end-of-line sequences. It now outputs
+the platform specific end of line sequence on each platform for files and
+pipes, and for sockets it produces crlf in output on all platforms. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
+
+4/11/96 (new feature) Added -eofchar option to Tcl_SetChannelOption to allow
+setting of an end of file character for input and output. If an input eof
+char is set, it is recognized as EOF and further input from the channel is
+not presented to the caller. If an output eof char is set, on output, that
+byte is appended to the channel when it is closed. On Unix and Macintosh,
+all channels start with no eof char set for input or output. On Windows,
+files and pipes start with input and output eof chars set to Crlt-Z (ascii
+26), and sockets start with no input or output eof char. (JL)
+*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 ***
+
+4/17/96 (bug fix) Fixed series of bugs with handling of crlf sequence split
+across buffer boundaries in input, in AUTO mode. (JL, BW)
+
+4/17/96 (test suite improvement) Fixed test suite so that tests that
+depend on the availability of Unix commands such as echo, cat and others
+are not run if these commands are not present. (JL)
+
+4/17/96 (test suite improvement) The socket test now automatically starts,
+on platformst that support exec, a separate process for remote testsing. (JL)
+
+----------------- Released 7.5, 4/21/96 -----------------------
+
+5/1/96 (bug fix) "file tail ~" did not correctly return the tail
+portion of the user's home directory. (SS)
+
+5/1/96 (bug fix) Fixed bug in TclGetEnv where it didn't lookup environment
+variables correctly:  could confuse "H" and "HOME", for example.  (JO)
+
+5/1/96 (bug fix) Changed to install tclConfig.sh under "make install-binaries",
+not "make install-libraries".  (JO)
+
+5/2/96 (bug fix) Changed pkg_mkIndex not to attempt to "load" a file unless
+it has the standard shared library extension.  On SunOS, attempts to load
+Tcl scripts cause the whole application to be aborted (there's no way to
+get the error back into Tcl).  (JO)
+
+5/7/96 (bug fix) Moved initScript in tclUnixInit.c to writable memory to
+avoid potential core dumps. (JO)
+
+5/7/96 (bug fix) Auto_reset procedure was removing procedure from init.tcl,
+such as pkg_mkIndex.  (JO)
+
+5/7/96 (bug fix) Fixed cast on socket address resolution code that
+would cause a failure to connect on Dec Alphas. (JL)
+
+5/7/96 (bug fix) Added "time", "subst" and "fileevent" commands to set of
+commands available in a safe interpreter. (JL)
+
+5/13/96 (bug fix) Preventing OS level handles for stdin, stdout and stderr
+from being implicitly closed when the last reference to the standard
+channel containing that handle is discarded when an interpreter is deleted.
+Explicitly closing standard channels by using "close" still works. (JL)
+
+5/21/96 (bug fix) Do not create channels for stdin, stdout and stderr on
+Unix if the devices are closed. This prevents a duplicate channel name
+panic later on when the fd is used to open a channel and the channel is
+registered in an interpreter. (JL)
+
+5/23/96 (bug fix) Fixed bug that prevented the use of standard channels in
+interpreters created after the last interpreter was destroyed. In the sequence
+
+	interp = Tcl_CreateInterp();
+	Tcl_DeleteInterp(interp);
+	interp = Tcl_CreateInterp();
+
+channels for stdio would not be available in the second interpreter. (JL)
+
+5/23/96 (bug fix) Fixed bug that allowed Tcl_MakeFileChannel to create new
+channels with Tcl_Files in them that are already used by another channel.
+This would cause core dumps when the Tcl_Files were being freed twice. (JL)
+
+5/23/96 (bug fix) Fixed a logical timing bug that caused a standard channel
+to be removed from the standard channel table too early when the channel
+was being closed. If the channel was being flushed asynchronously, it could
+get recreated before being actually destroyed, and the recreated channel
+would contain the same Tcl_File as the one being closed, leading to
+dangling pointers and core dumps. (JL)
+
+5/27/96 (bug fix) Fixed a bug in Tcl_GetChannelOption which caused it to
+always return a list of one element, a list of the settings, for
+-translation and -eofchar options. Now correctly returns the value
+described by the documentation (Mark Diekhans found this, thanks!). (JL)
+
+5/30/96 (bug fix) Fixed a couple of syntax errors in io.test. (JL)
+
+5/30/96 (bug fix) If a fileevent scripts gets an error, delete it before
+causing a background error. This is to allow the error handler to reinstall
+the fileevent and to prevent infinite loops if the event loop is reentered
+in the error handler. (JL)
+
+5/31/96 (bug fix) Channels now will get properly flushed on exit. (JL)
+
+6/5/96 (bug fix) Changed Tcl_Ckalloc, Tcl_Ckfree, and Tcl_Ckrealloc to
+Tcl_Alloc, Tcl_Free, and Tcl_Realloc.  Added documentation for these
+routines now that they are officially supported.  Extension writers
+should use these routines instead of free() and malloc(). (SS)
+
+6/10/96 (bug fix) Changes the Tcl close command so that it no longer
+waits on nonblocking pipes for the piped processes to exit; instead it
+reaps them in the background. (JL)
+
+6/11/96 (bug fix) Increased the length of the listen queue for server
+sockets on Unix from 5 to 100. Some OSes will disregard this and reset it
+to 5, but we should try to get as long a queue as we can, for performance
+reasons. (JL)
+
+6/11/96 (bug fix) Fixed windows sockets bug that caused a cascade of events
+if the fileevent script read less than was available. Now reading less than
+is available does not cause a flood of Tcl events. (JL, SS)
+
+6/11/96 (bug fix) Fixed bug in background flushing on closed channels that
+would prevent the last buffer from getting flushed. (JL)
+
+6/13/96 (bug fix) Fixed bug in Windows sockets that caused a core dump if
+a DLL linked with tcl.dll and referred to e.g. ntohs() without opening a
+Tcl socket. The problem was that the indirection table was not being
+initialized. (JL)
+
+6/13/96 (bug fix) Fixed OS level resource leak that would occur when a
+Tcl channel was still registered in some interpreter when the process
+exits. Previously the channel was not being closed and the OS level handles
+were not being released; the output was being flushed but the device was
+not being closed. Now the device is properly closed. This was only a
+problem on Win3.1 and MacOS. (JL, SS)
+
+6/28/96 (bug fix) Fixed bug where transient errors were leaving an error
+code around, so that it would erroneously get reported later. This bug was
+exercised intermittently by closing a channel to a file on a very loaded
+NFS server, or to a socket whose other end blocked. (JL, BW)
+
+7/3/96 (bug fix) Fileevents declared in an interpreter are now deleted
+when the channel is closed in that interpreter. Before this fix, the
+fileevent would hang around until the channel is completely closed, and
+would cause errors if events happened before the channel was closed. This
+could happen in two cases: first if the channel is shared between several
+interpreters, and second if an async flush is in progress that prevents the
+channel from being closed until the flush finishes. (JL)
+
+7/10/96 (bug fix) Fixed bugs in both "lrange" and "lreplace" commands
+where too much white space was being removed. For example, the command
+		lreplace {\}\     hello} end end
+was returning "\}\", losing the significant space in the first list
+element and corrupting the list. (JO)
+
+7/20/96 (bug fix) The procedure pkg_mkIndex didn't work properly for
+extensions that depend on Tk, because it didn't load Tk into the child
+interpreter before loading the extension.  Now it loads Tk if Tk is
+present in the parent. (JO)
+
+7/23/96 (bug fix) Added compat version of strftime to fix crashes
+resulting from bad implementations under Windows. (SS)
+
+7/23/96 (bug fix) Standard implementations of gmtime() and localtime()
+under Windows did not handle dates before 1970, so they were replaced
+with a revised implementation. (SS)
+
+7/23/96 (bug fix) Tcl would crash on exit under Borland 5.0 because
+the global environ pointer was left pointing to freed memory. (SS)
+
+7/29/96 (bug fix) Fixed memory leak in Tcl_LoadCmd that could occur if
+a package's AppInit procedure called Tcl_StaticPackage to register
+static packages. (JO)
+
+8/1/96 (bug fix) Fixed a series of bugs in Windows sockets so that async
+writebehind in the presence of read event handlers now works, and so that
+async writebehind also works on sockets for which a read event handler was
+declared and whose channels were then closed before the async write
+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.
+Added a new file to the library, safeinit.tcl, to hold implementation. (JL)
+On 7/9/97, removed the policy loading mechanism from the Safe Base. Left
+only the Safe Base aliases dealing with auto-loading and source. (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 reads or writes 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 -----------------------
+
+7/1/97 (new feature) TCL_BUILD_SHARED flag set in tclConfig.sh
+when Tcl has been built with --enable-shared. A new tclLibObjs
+make target, echoing the list of the .o's needed to build a tcl
+library, is now provided. (DL)
+
+7/1/97 (feature change) compat/getcwd.c removed and changed the
+only place where getcwd is used so a new USEGETWD flag selects
+the use of the replacement "getwd". Adding this flag is recommended
+for SunOS 4 (because getcwd on SunOS 4 uses a pipe to pwd(1)!). (DL)
+
+7/7/97 (feature change) The split command now supports binary data (i.e.,
+null characters in strings). (BL)
+
+7/7/97 (bug fix) string first returned the wrong result if the first
+argument string was empty. (BL)
+
+7/8/97 (bug fix) Fixed core dump in fcopy that could occur when a command
+callback was supplied and an error or eof condition caused no background
+activity.  A refcount bug triggered a panic in Tcl_ListObjAppendElement. (BW)
+
+7/8/97 (bug fix) Relaxed the pattern matching on http_get so you do not
+need a trailing path component.  You can now get away with just
+http_get sunscript.sun.com					(BW)
+
+7/9/97 (bug fix) Creating anonymous interpreters no longer smashes existing
+commands with names similar to the generated name. Previously creating an
+anonymous interpreter could smash an existing command, now it skips until
+it finds a command name that isn't being used. (JL)
+
+7/9/97 (feature change) Removed the policy management mechanism from the
+Safe Base; left the aliases to source and load modules, and to do a limited
+form of the "file" command. See entry of 11/15/96. (JL)
+
+7/9/97 (bug fixes) Fixed various compilation-related bugs:
+    - Line numbers in errorInfo now are the same as those in Tcl7.6 unless
+there are compilation errors. Compilation error messages now include the
+entire command in error.
+    - Trailing ::s after namespace names weren't being ignored.
+    - Could not refer to an namespace variable with an empty name using a
+name of the form "n::". (BL)
+
+7/9/97 (bug fix) Fixed bug in Tcl_Export that prevented you from exporting
+from other than the current namespace. (BL)
+
+7/9/97 (bug fix) env.test was removing env var needed for proper finding
+of libraries in child process. (DL)
+
+7/10/97 (bug fixes/new feature) Cleanup in Tcl_MakeSafe. Less information
+is leaked to safe interps. Error message fixes for interp sub commands.
+Likewise changes in safealias.tcl; tcl_safeCreateInterp can now be called
+without argument to generate the slave name (like in interp create). (DL)
+
+7/10/97 (bug fixes) Bytecode compiler now generates more detailed 
+command location information: subcommands as well as commands now have
+location information. This means command trace procedures now get the
+correct source string for each command in their command parameter. (BL)
+
+7/22/97 (bug fixes) Performance improvement in Safe interpreters
+handling. Added new mask value to (tclInt.h) Interp.flags record. (DL)
+
+7/22/97 (bug fix) Fixed panic in 'interp target {} foo'. This bug
+was present since Tcl 7.6. (JL)
+
+7/22/97 (bug fix) Fixed bug in compilation of procedures in namespaces: the
+procedure's namespace must be used to look up compile procedures, not the
+current namespace. (BL)
+
+7/22/97 (bug fix) Use of the -channel option of http_get was not setting
+the end of line translations mode on the channel, so copying binary data
+with the -channel option was corrupting the result on non-unix platforms. (BW)
+
+7/22/97 (bug fixes) file commands and ~user (seg fault and other
+improper returns). (DL)
+
+7/23/97 (feature change) Reenabled "vwait" in Safe Base. (JL)
+
+7/23/97 (bug fixes) Fixed two bugs involving read traces on array variables
+in procedures: trace procedures were sometimes not called, and reading
+nonexistant array elements didn't create undefined element variables that
+could later be defined by trace procedures. (BL)
+
+7/24/97 (bug fix) Windows memory allocation performance was
+superlinear in some cases.  Made the Mac allocator generic and changed
+both the Mac and Windows platforms to use the new allocator instead of
+malloc and free. (SS)
+
+7/24/97 - 8/12/97 (bug fixes/change of features) Completely revamped safe
+sourcing/loading (see safe.n) to hide pathnames, use virtual
+paths tokens instead, improved security in several respects and made it
+more tunable. Multi level interp loading can work too now. Package auto
+loading now works in safe interps as long as the package directory is in 
+the auto_path (no deep crawling allowed in safe interps). (DL)
+*** POTENTIAL INCOMPATIBILITY with previous alpha and beta releases ***
+
+7/24/97 (bug fixes) Made Tcl_SetVar* and Tcl_NewString* treat a NULL value
+as an empty string. (This fixes hairy crash case where you would crash
+because load command for other interps assumed presence of
+errorInfo...). (DL)
+
+7/28/97 (bug fix) Fixed pkg_mkIndex to understand namespaces.  It will
+use the export list of a namespace and create auto_index entries for
+all export commands.  Those names are in their fully qualified form in the
+auto_index.  Therefore, I tweaked unknown to try both $cmd and ::$cmd.
+Also fixed pkg_mkIndex so you can have "package require" commands inside
+your packages.  These commands are ignored, which is mostly ok except
+when you must load another package before loading yours because of
+linking dependencies. (BW)
+
+7/28/97 (bug fix) A variable created by the variable command now persists
+until the namespace is destroyed or the variable is unset. This is true even
+if the variable has not been initialized; these variables used to be
+destroyed if an error occurred when accessing them. In addition, the "info
+vars" command lists uninitialized namespace variables, while the "info
+exists" command returns 0 for them. (BL)
+
+7/29/97 (feature change)  Changed the http package to use the ::http
+namespace. http_get renamed to http::geturl, http_config renamed to
+http::config, http_formatQuery renamed to http::formatQuery.
+It now provides the 2.0 version of the package.  
+The 1.0 version is still available with the old names.
+*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b2 but not with Tcl 7.6 ***
+
+7/29/97 (bug fix, new feature) Tcl_Main now uses Tcl objects internally to
+preserve NULLs in commands and command output. Added new API procedure
+Tcl_RecordAndEvalObj that resembles Tcl_RecordAndEval but takes an object
+containing a command. (BL)
+
+7/30/97 (bug fix) Tcl freed strings in the environ array even if it
+did not allocate them. (SS)
+
+7/30/97 (bug fix) If a procedure is renamed into a different namespace, it
+now executes in the context of that namespace. (BL)
+
+7/30/97 (bug fix) Prevent renaming of commands into and from namespaces as
+part of hiding them. (JL)
+
+7/31/97 (feature change) Moved the history command from C to tcl.
+This uses the ::history namespace.  The "words" and "substitute" options
+are no longer supported.  In addition, the "keep" option without a value
+returns the current keep limit.  There is a new "clear" option.
+The unknown command now supports !! again. (BW)
+*** POTENTIAL INCOMPATIBILTY  ***
+
+7/30/97 (bug fix) Made sure that a slave can not fool the master into
+hiding the wrong command. Made sure we don't crash in hiding + namespaces
+issues. (DL)
+
+8/4/97 (bug fix) Concat, eval, uplevel, and similar commands were
+incorrectly trimming trailing space characters from their arguments
+even when the space characters were preceded by a backslash. (JO)
+
+8/4/97 (bug fix) Removed the hard link between bgerror and tkerror.
+Only bgerror is supported in tcl core. Tk will still look for a
+tkerror but using regular tcl code for that feature. (DL)
+*** POTENTIAL INCOMPATIBILTY with code relying on the hard link ***
+
+8/6/97 (bug fix) Reduced size required for compiled bytecodes by using a
+more compact encoding for the command pc-to-source map. (BL)
+
+8/6/97 (new feature) Added support for additional compilation and execution
+statistics when Tcl is compiled with the TCL_COMPILE_STATS flag. (BL)
+
+8/7/97 (bug fix) Expressions not in {}s that have a comparison operator as
+the topmost operator must be compiled out-of-line (call the expr cmd at
+runtime) to properly support expr's two-level substitution semantics. An
+example is "set a 2; set b {$a}; puts [expr $b == 2]". (BL)
+
+8/11/97 (bug fix) The catch command would sometimes crash if a variable name
+was given and the bytecode evaluation stack was grown when executing the
+argument script. (BL)
+
+8/12/97 (feature change) Reinstated the variable tcl_precision to control
+the number of digits used when floating-point values are converted to
+strings, with default of 12 digits.  However, had to make tcl_precision
+shared among all interpreters (except that safe interpreters can't
+modify it).  This makes the Tcl 8.0 behavior almost identical to 7.6
+except that the default precision is 12 instead of 6. (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+----------------- Released 8.0, 8/18/97 -----------------------
+
+8/19/97 (bug fix) Minimal fix for glob -nocomplain bugs:
+"glob -nocomplain unreadableDir/*" was generating an anonymous 
+error. More in depth fixes will come with 8.1. (DL).
+
+8/20/97 (bug fix) Removed check for FLT_MIN in binary command so
+underflow conditions are handled by the compiler automatic
+conversions. (SS)
+
+8/20/97 (bug fixes) Fixed several compilation-related bugs:
+    - Array cmd wasn't detecting arrays that, while compiled, do not yet
+      exist (e.g., are marked undefined since they haven't been assigned
+      to yet).
+    - The GetToken procedure in tclCompExpr.c wasn't recognizing properly
+      whether an integer token was invalid. For example, "0x$" is not
+      a valid integer.
+    - Performance bug in TclExecuteByteCode: the size of its stack frame
+      was reduced by over 20% by moving errorInfo code elsewhere.
+    - Uninitialized memory read error in tclCompile.c. (BL)
+
+8/21/97 (bug fix) safe::interpConfigure now behave like Tk widget's
+configure : it changes only the options you provide and you can get
+the current value of any single option. New ?-nested boolean? and
+?-statics boolean? for all safe::interp* commands but we still
+accept (upward compatibility) the previously defined non valued
+flags ?-noStatics? and ?-nestedLoadOk?. Improved the documentation. (DL).
+
+8/22/97 (bug fix) Updated PrintDbl.3 to reflect the fact that the
+tcl_precision variable is still used and that it is now shared by all
+interpreters. (BL)
+
+8/25/97 (bug fix) Fixed array access bug in IllegalExprOperandType
+procedure in tclExecute.c: it was not properly supporting the || and &&
+operators. (BL)
+
+8/27/97 (bug fix) In cases where a channel handler was created with an
+empty event mask while data was still buffered in the channel, the
+channel code would get stuck spinning on a timer that would starve
+idle handlers.  This mostly happened in Tk when reading from stdin. (SS)
+
+9/4/97 (bug fix) Slave interps now inherit the maximum recursion limit
+of their parent instead of starting back at the default. {nb: this still
+does not prevent stack overflow by multi-interps recursion or aliasing} (DL)
+
+9/11/97 (bug fix) An uninitialized variable in Tcl_WaitPid caused
+pipes to fail to report eof properly under Windows. (SS)
+
+9/12/97 (bug fix) "exec" was misidentifying some DOS executables as not 
+executable. (CCS)
+
+9/14/97 (bug fix) Was using the wrong structure in sizeof operation in
+tclUnixChan.c. (JL)
+
+9/15/97 (bug fix) Fixed notifier to break out of do-one-event loop if
+Tcl_WaitForEvent returns 1, so that callers of Tcl_DoOneEvent will get
+a chance to check whether the event just handled is significant. This
+affected mainly recursive calls to Tcl_VWaitCmd; these did not get a
+chance to notice that the variable they were waiting for has been set
+and thus they didn't terminate the vwait. (JL, DL, SS)
+
+9/15/97 (bug fix) Alignment problems in "binary format" would cause a
+crash on some platforms when formatting floating point numbers. (SS)
+
+9/15/97 (bug fix) Fixed bug in Macintosh socket code.  Now passes all
+tests in socket.test that are not platform specific. (Thanks to Mark
+Roseman for the pointer on the fix.)  (RJ)
+
+9/18/97 (bug fix) Fixed bug -dictionary option of lsort that could
+cause the compare function to run off the end of an array if the
+number only contained 0's. (Thanks to Greg Couch for the report.) (RJ)
+
+9/18/97 (bug fix) TclFinalizeEnvironment was not cleaning up 
+properly. (DL, JI)
+
+9/18/97 (bug fix) Fixed long-standing bug where an "array get" command
+did not trigger traces on the array or its elements. (BL)
+
+9/18/97 (bug fixes) Fixed compilation-related bugs:
+    - Fixed errorInfo traceback information for toplevel coomands that
+      contain nested commands.
+    - In the expr command, && and || now accept boolean operands as well
+      as numeric ones. (BL)
+
+9/22/97 (bug fix) Fixed bug that prevented translation modes from being
+set independently for input and output on sockets if input was "auto". (JL)
+
+9/24/97 (bug fix) Tcl_EvalFile(3) and thus source(n) now works fine on
+files containing NUL chars. (DL)
+
+9/26/97 (bug fix) Fixed use of uninitialized memory in the environ array
+that later could cause random core dumps. Applies to all platforms. (JL)
+
+9/26/97 (bug fix) Fixed use of uninitialized memory in socket address data
+structure under some circumstances. This could cause random core dumps.
+This applies only to Unix. (JL)
+
+9/26/97 (bug fix) Opening files on PC-NFS volumes would cause a hang
+until the system timed after the file was closed. (SS)
+
+10/6/97 (bug fix) The join(n) command, though objectified, was loosing
+NULs in the joinString and in list elements after the 2nd one.
+Now you can "join $list \0" for instance. (DL)
+
+10/9/97 (bug fix) Under windows, if env(TMP) or env(TEMP) referred to a
+non-existent directory, exec would fail when trying to create its temporary
+files. (CCS)
+
+10/9/97 (bug fix) Under mac and windows, "info hostname" would crash if 
+sockets were installed but the hostname could not be determined anyhow.
+Tcl_GetHostName() was returning NULL when it should have been returning 
+an empty string. (CCS)
+
+10/10/97 (bug fix) "file attribute /" returned error on windows. (CCS)
+
+10/10/97 (bug fix) Fixed the auto_load procedure to handle procedures
+defined in namespaces better.  Also fixed pgk_mkIndex so it sees procedures
+defined in nested namespaces.  Index entries are still only made for
+exported procedures. (BW)
+
+10/13/97 (bug fix) On unix, for files with unknown group or owner
+attributes, querying the "file attributes" would return an error rather than
+returning the group's or owner's id number, although tha command accepts
+numbers when setting the file's group or owner.  (CCS)
+
+10/22/97 (bug fix) "fcopy" did not eval the callback script at the
+global scope. (SS)
+
+10/22/97 (bug fix) Fixed the signature of the CopyDone callback used in
+the http package(s) so they can handle error cases properly. (BW)
+
+10/28/97 (bug fixes) Fixed a problem where lappend would free the Tcl object
+in a variable if a Tcl_ObjSetVar2 failed because of an error calling a trace
+on the variable. (BL)
+
+10/28/97 (bug fix) Changed binary scan to properly handle sign
+extension of integers on 64-bit or larger machines. (SS)
+
+11/3/97 (bug fixes) Fixed several bugs:
+    - expressions such as "expr ($x)" must be compiled out-of-line
+      (call the expr command procedure at runtime) to ensure the correct
+      behavior when "$x" is an expression such as "5+10".
+    - "array set a {}" now creates a new array var with an empty array
+      value if the var didn't already exist.
+    - "lreplace $foo end end" no longer returns an error (just an empty
+      list) if foo is empty.
+    - upvar will no longer create a variable in a namespace that refers
+      to a variable in a procedure.
+    - deleting a command trace within a command trace callback would
+      make the code that calls traces to reference freed memory.
+    - significantly sped up "string first" and "string last" (fix from
+      darrel@gemstone.com).
+    - seg fault in Tcl_NewStringObj() when a NULL is passed as the byte
+      pointer argument and Tcl is compiled with -DTCL_MEM_DEBUG.
+    - documentation and error msg fixes. (BL)
+
+11/3/97 (bug fix) Fixed a number of I/O bugs related to word sizes on
+64-bit machines. (SS)
+
+11/6/97 (bug fix) The exit code of the first process created by Tcl
+on Windows was not properly reported due to an initialization
+problem. (SS)
+
+----------------- Released 8.0p1, 11/7/97 -----------------------
+
+11/19/97 (bug fix) Fixed bug in linsert where it sometimes accidently
+cleared out a shared argument list object. (BL).
+
+11/19/97 (bug fix) Autoloading in namespaces was not working properly.
+auto_mkindex is still not really namespace aware but most common
+cases should now be handled properly (see init.test). (BW, DL)
+
+11/20/97 (enhancement) Made the changes required by the new Apple
+Universal Headers V.3.0, so that Tcl will compile with CW Pro 2.
+
+11/24/97 (bug fix) Fixed tests in clock test suite that needed the
+-gmt flag set.  Thanks to Jan Nijtmans for reporting the problem. (RJ)
+
+----------------- Released 8.0p2, 11/25/97 -----------------------
+ 
+12/3/97 (bug fix/optimization) Removed uneeded and potentially dangerous
+instances of double evaluations if "if" and "expr" statements from
+the library files. It is recommended that unless you need a double
+evaluation you always use "expr {...}" instead of "expr ..." and
+"if {...} ..." instead of "if ... ...". It will also be faster
+thanks to the byte compiler. (DL)
+
+---- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ----
+
+12/8/97 (bug fix) Need to protect the newly accepted channel in an
+accept callback on a socket, otherwise the callback may close it and
+cause an error, which would cause the C code to attempt to close the
+now deleted channel. Bumping the refcount assures that the channel sticks
+around to be really closed in this case. (JL)
+
+12/8/97 (bug fix) Need to protect the channel in a fileevent so that it
+is not deleted before the fileevent handler returns. (CS, JL)
+
+12/18/97 (bug fix) In the opt argument parsing package: if the description 
+had only flags, the "too many arguments" case was not detected. The default
+value was not used for the special "args" ending argument. (DL)
+
+1/15/98 (improvement) Moved common part of initScript in common file.
+Moved windows specific initialization to init.tcl so you can initialize
+Tcl in windows without having to call Tcl_Init which is now only
+searching for init.tcl {back ported from 8.1}. (DL)
+
+---- Shipped as part of the plugin as 8.0p2Plugin2, Jan 15th 98 ----
+
+5/27/98 (bug fix) Windows socket driver did not notice new data arriving
+on nonblocking sockets until the event loop was entered. (SS)
+
+5/27/98 (bug fix) Windows socket driver used FIONREAD, which is not
+supported correctly by WinSock. (SS)
+
+6/9/98 (bug fix) Generic channel code failed to report readable file
+events on buffered data that was left behind by a gets or read that
+did not consume all available data. (SS)
+
+6/18/98 (bug fix) Compilation of loop expressions was too aggressive
+and incorrectly inlined non-literal expressions. (SS)
+
+6/18/98 (bug fix) "info var" and "info locals" incorrectly reported
+the existence of compiler temporary variables. (SS)
+
+6/18/98 (bug fix) Dictionary sorting used signed character
+comparisons. (SS)
+
+6/18/98 (bug fix) Compile procs corrupted the exception stack in some
+cases. (SS)
+
+6/18/98 (bug fix) Array set had erratic behavior when initializing a
+variable from an empty value list. (SS)
+
+6/18/98 (bug fix) The Windows registry package had a bad bounds check
+that could lead to a crash. (SS)
+
+6/18/98 (bug fix) The foreach compile proc did not correctly handle
+non-local variable references. (SS)
+
+6/25/98 (new features) Added name resolution hooks to support [incr Tcl].
+There are new internal Tcl_*Resolver* APIs to add, query and remove the hooks. 
+With this changes it should be possible to dynamically load [incr Tcl]
+as an extension. (MM)
+
+7/1/97 (bug fix) The commands "info args, body, default, procs" did
+not correctly handle imported procedures. (RJ)
+
+7/6/98 (improvement) pkg_mkIndex now implements the "package require"
+command.  This makes it possible to create index files for packages
+that require another package and then execute code from that package in
+their file. Previously, this would throw an error because the required
+package had not been loaded.  The -nopkgrequied flag is provided to
+revert back to the old functionality. (EMS)
+
+7/6/98 (improvement) back-ported the -direct flag from 8.1 into
+pkg_mkIndex.  This results in pkgIndex.tcl files that contain direct
+source or load commands instead of tclPkgSetup commands. (EMS)
+
+7/6/98 (improvement) made changes to the AuxData items structures to support
+storage of compiled scripts on disk. Also some related minor changes in
+the compilation and execution engine. (EMS)
+
+6/4/98 (enhancement) Added new internal routines to support inserting
+and deleting from the stat, access, and open-file-channel mechanisms.
+TclAccessInsertProc, TclStatInsertProc, & TclOpenFileChannelInsertProc
+insert pointers to such routines; TclAccessDeleteProc, TclStatDeleteProc,
+& TclOpenFileChannelDeleteProc delete pointers to such routines.  See
+the file generic/tclIOUtils.c for more details. (SKS)
+ 
+7/1/98 (enhancement) Added a new internal C variable
+tclPreInitScript.  This is a pointer to a string that may hold an
+initialization script; If this pointer is non-NULL it is evaluated in
+Tcl_Init() prior to the built-in initialization script defined in the
+file generic/tclInitScript.h.  (SKS)
+
+7/6/98 (bug fix) Removed dead code in PlatformInitExitHandler so that
+the TCL_LIBRARY value can be safely patched in binaries. (BW)
+
+7/24/98 (enhancement) Incorporated a new version of auto_mkindex that
+can support the [incr Tcl] class structures.  This version will index
+all procedures in a source file, not just those where "proc" starts
+at the beginning of the line.  If you want the old behavior, use the
+auto_mkindex_old procedure. (MM)
+
+7/24/98 (feature change) Changed the Windows registry key to be
+HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, and to store the path
+in the default value instead of "Root".  Also, this key can be
+specified at compile time in case Tcl is being used in a different
+context where it needs an alternate library path from the standard Tcl
+installation. (SS)
+
+7/24/98 (feature change) Changed the search order for init.tcl.  The
+tcl_library variable can now be set before calling Tcl_Init to avoid
+doing any searches.  If it isn't set, then Tcl checks
+env(TCL_LIBRARY), the static value set at compile time, an install
+directory relative to the executable, a source directory relative to
+the executable, and a tcl directory relative to the source heirarchy
+containing the executable.  See the comment at the top of
+generic/tclInitScript.h for more details. (SS)
+
+7/27/98 (config change) Changed the use of the DBGX flag in configure.in
+and the makefile to be TCL_DBGX.  Users of tclConfig.sh may need to pass
+this through their configure files with AC_SUBST. (BW)
+
+729/98 (bug fix) Changed [info body] to return a copy of the body of a
+compiled procedure instead of the body itself, to avoid invalidation
+of the internal rep and loss of the byte-codes. (EMS)
+
+8/5/98 (bug fix) The platform init code could walk off the end of a
+buffer when reading the PkgPath registry value on Windows. (SS)
+
+8/5/98 (Windows makefile change) Introduced a set of macros to deal with
+exporting symbols when compiling DLLS on Windows. See win/README for
+details. (EMS)
+
+8/5/98 (addendum) Added a second Windows registry key under
+HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, named "pkgPath".
+This is a multi-string value used to initialize the tcl_pkgPath
+variable. This is required if extension DLLs are in architecture specific
+subdirectories. (SS)
+
+8/6/98 (new feature) Added tcl_findLibrary to init.tcl for use by
+extensions, including Tk.  This searches in a canonical way for
+an extensions library directory and initialization file. (BW)
+
+8/10/98 (bug fix) Imported commands used to get lost if the target
+of the import was redefined.  Tcl_CreateCommand and Tcl_CreateObjCommand
+were updated to restore import links. (Note that if you rename a command,
+the import links move to the new name, and if you delete a command then
+the import links get lost. These semantics have not changed.) (MC)
+
+-------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/10/98 ------
diff --git a/tcl/compat/README b/tcl/compat/README
new file mode 100644
index 00000000000..5bbf04179aa
--- /dev/null
+++ b/tcl/compat/README
@@ -0,0 +1,8 @@
+This directory contains various header and code files that are
+used make Tcl compatible with various releases of UNIX and UNIX-like
+systems.  Typically, files from this directory are used to compile
+Tcl when a system doesn't contain the corresponding files or when
+they are known to be incorrect.  When the whole world becomes POSIX-
+compliant this directory should be unnecessary.
+
+RCS: @(#) $Id$
diff --git a/tcl/compat/dirent.h b/tcl/compat/dirent.h
new file mode 100644
index 00000000000..9022f280560
--- /dev/null
+++ b/tcl/compat/dirent.h
@@ -0,0 +1,23 @@
+/*
+ * dirent.h --
+ *
+ *	This file is a replacement for <dirent.h> in systems that
+ *	support the old BSD-style <sys/dir.h> with a "struct direct".
+ *
+ * Copyright (c) 1991 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _DIRENT
+#define _DIRENT
+
+#include <sys/dir.h>
+
+#define dirent direct
+
+#endif /* _DIRENT */
diff --git a/tcl/compat/dirent2.h b/tcl/compat/dirent2.h
new file mode 100644
index 00000000000..cf77f127549
--- /dev/null
+++ b/tcl/compat/dirent2.h
@@ -0,0 +1,59 @@
+/*
+ * dirent.h --
+ *
+ *	Declarations of a library of directory-reading procedures
+ *	in the POSIX style ("struct dirent").
+ *
+ * Copyright (c) 1991 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _DIRENT
+#define _DIRENT
+
+#ifndef _TCL
+#include <tcl.h>
+#endif
+
+/*
+ * Dirent structure, which holds information about a single
+ * directory entry.
+ */
+
+#define MAXNAMLEN 255
+#define DIRBLKSIZ 512
+
+struct dirent {
+    long d_ino;			/* Inode number of entry */
+    short d_reclen;		/* Length of this record */
+    short d_namlen;		/* Length of string in d_name */
+    char d_name[MAXNAMLEN + 1];	/* Name must be no longer than this */
+};
+
+/*
+ * State that keeps track of the reading of a directory (clients
+ * should never look inside this structure;  the fields should
+ * only be accessed by the library procedures).
+ */
+
+typedef struct _dirdesc {
+    int dd_fd;
+    long dd_loc;
+    long dd_size;
+    char dd_buf[DIRBLKSIZ];
+} DIR;
+
+/*
+ * Procedures defined for reading directories:
+ */
+
+extern void		closedir _ANSI_ARGS_((DIR *dirp));
+extern DIR *		opendir _ANSI_ARGS_((char *name));
+extern struct dirent *	readdir _ANSI_ARGS_((DIR *dirp));
+
+#endif /* _DIRENT */
diff --git a/tcl/compat/dlfcn.h b/tcl/compat/dlfcn.h
new file mode 100644
index 00000000000..080d20616bc
--- /dev/null
+++ b/tcl/compat/dlfcn.h
@@ -0,0 +1,65 @@
+/* 
+ * dlfcn.h --
+ *
+ *	This file provides a replacement for the header file "dlfcn.h"
+ *	on systems where dlfcn.h is missing.  It's primary use is for
+ *	AIX, where Tcl emulates the dl library.
+ *
+ *	This file is subject to the following copyright notice, which is
+ *	different from the notice used elsewhere in Tcl but rougly
+ *	equivalent in meaning.
+ *
+ *	Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH
+ *	Not derived from licensed software.
+ *
+ *	Permission is granted to freely use, copy, modify, and redistribute
+ *	this software, provided that the author is not construed to be liable
+ *	for any results of using the software, alterations are clearly marked
+ *	as such, and this notice is not modified.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * @(#)dlfcn.h	1.4 revision of 95/04/25  09:36:52
+ * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
+ * 30159 Hannover, Germany
+ */
+
+#ifndef __dlfcn_h__
+#define __dlfcn_h__
+
+#ifndef _TCL
+#include <tcl.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Mode flags for the dlopen routine.
+ */
+#define RTLD_LAZY	1	/* lazy function call binding */
+#define RTLD_NOW	2	/* immediate function call binding */
+#define RTLD_GLOBAL	0x100	/* allow symbols to be global */
+
+/*
+ * To be able to intialize, a library may provide a dl_info structure
+ * that contains functions to be called to initialize and terminate.
+ */
+struct dl_info {
+	void (*init) _ANSI_ARGS_((void));
+	void (*fini) _ANSI_ARGS_((void));
+};
+
+VOID *dlopen _ANSI_ARGS_((const char *path, int mode));
+VOID *dlsym _ANSI_ARGS_((void *handle, const char *symbol));
+char *dlerror _ANSI_ARGS_((void));
+int dlclose _ANSI_ARGS_((void *handle));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __dlfcn_h__ */
diff --git a/tcl/compat/fixstrtod.c b/tcl/compat/fixstrtod.c
new file mode 100644
index 00000000000..5890bd1b241
--- /dev/null
+++ b/tcl/compat/fixstrtod.c
@@ -0,0 +1,38 @@
+/* 
+ * fixstrtod.c --
+ *
+ *	Source code for the "fixstrtod" procedure.  This procedure is
+ *	used in place of strtod under Solaris 2.4, in order to fix
+ *	a bug where the "end" pointer gets set incorrectly.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+
+#undef strtod
+
+/*
+ * Declare strtod explicitly rather than including stdlib.h, since in
+ * somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
+ */
+
+extern double strtod();
+
+double
+fixstrtod(string, endPtr)
+    char *string;
+    char **endPtr;
+{
+    double d;
+    d = strtod(string, endPtr);
+    if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
+	*endPtr -= 1;
+    }
+    return d;
+}
diff --git a/tcl/compat/float.h b/tcl/compat/float.h
new file mode 100644
index 00000000000..fa3c197bea4
--- /dev/null
+++ b/tcl/compat/float.h
@@ -0,0 +1,16 @@
+/*
+ * float.h --
+ *
+ *	This is a dummy header file to #include in Tcl when there
+ *	is no float.h in /usr/include.  Right now this file is empty:
+ *	Tcl contains #ifdefs to deal with the lack of definitions;
+ *	all it needs is for the #include statement to work.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
diff --git a/tcl/compat/gettod.c b/tcl/compat/gettod.c
new file mode 100644
index 00000000000..d95907bca73
--- /dev/null
+++ b/tcl/compat/gettod.c
@@ -0,0 +1,32 @@
+/* 
+ * gettod.c --
+ *
+ *	This file provides the gettimeofday function on systems
+ *	that only have the System V ftime function.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclPort.h"
+#include <sys/timeb.h>
+
+#undef timezone
+
+int
+gettimeofday(tp, tz)
+struct timeval *tp;
+struct timezone *tz;
+{
+    struct timeb t;
+    ftime(&t);
+    tp->tv_sec = t.time;
+    tp->tv_usec = t. millitm * 1000;
+    return 0;
+}
+
diff --git a/tcl/compat/license.terms b/tcl/compat/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/compat/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/compat/limits.h b/tcl/compat/limits.h
new file mode 100644
index 00000000000..9487dac2200
--- /dev/null
+++ b/tcl/compat/limits.h
@@ -0,0 +1,24 @@
+/*
+ * limits.h --
+ *
+ *	This is a dummy header file to #include in Tcl when there
+ *	is no limits.h in /usr/include.  There are only a few
+ *	definitions here;  also see tclPort.h, which already
+ *	#defines some of the things here if they're not arleady
+ *	defined.
+ *
+ * Copyright (c) 1991 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define LONG_MIN		0x80000000
+#define LONG_MAX		0x7fffffff
+#define INT_MIN			0x80000000
+#define INT_MAX			0x7fffffff
+#define SHRT_MIN		0x8000
+#define SHRT_MAX		0x7fff
diff --git a/tcl/compat/memcmp.c b/tcl/compat/memcmp.c
new file mode 100644
index 00000000000..09a57242436
--- /dev/null
+++ b/tcl/compat/memcmp.c
@@ -0,0 +1,61 @@
+/* 
+ * memcmp.c --
+ *
+ *	Source code for the "memcmp" library routine.
+ *
+ * Copyright (c) 1998 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: @(#) memcmp.c 1.2 98/01/19 10:48:58
+ */
+
+#include "tcl.h"
+#include "tclPort.h"
+
+/*
+ * Here is the prototype just in case it is not included
+ * in tclPort.h.
+ */
+
+int		memcmp _ANSI_ARGS_((CONST VOID *s1,
+			    CONST VOID *s2, size_t n));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * memcmp --
+ *
+ *	Compares two bytes sequences.
+ *
+ * Results:
+ *     compares  its  arguments, looking at the first n
+ *     bytes (each interpreted as an unsigned char), and  returns
+ *     an integer less than, equal to, or greater than 0, accord-
+ *     ing as s1 is less  than,  equal  to,  or
+ *     greater than s2 when taken to be unsigned 8 bit numbers.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+memcmp(s1, s2, n)
+    CONST VOID *s1;			/* First string. */
+    CONST VOID *s2;			/* Second string. */
+    size_t      n;                      /* Length to compare. */
+{
+    unsigned char u1, u2;
+
+    for ( ; n-- ; s1++, s2++) {
+	u1 = * (unsigned char *) s1;
+	u2 = * (unsigned char *) s2;
+	if ( u1 != u2) {
+	    return (u1-u2);
+	}
+    }
+    return 0;
+}
diff --git a/tcl/compat/opendir.c b/tcl/compat/opendir.c
new file mode 100644
index 00000000000..e1a0b444703
--- /dev/null
+++ b/tcl/compat/opendir.c
@@ -0,0 +1,108 @@
+/* 
+ * opendir.c --
+ *
+ *	This file provides dirent-style directory-reading procedures
+ *	for V7 Unix systems that don't have such procedures.  The
+ *	origin of this code is unclear, but it seems to have come
+ *	originally from Larry Wall.
+ *
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#undef DIRSIZ
+#define DIRSIZ(dp) \
+    ((sizeof (struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
+
+/*
+ * open a directory.
+ */
+DIR *
+opendir(name)
+char *name;
+{
+	register DIR *dirp;
+	register int fd;
+	char *myname;
+
+	myname = ((*name == '\0') ? "." : name);
+	if ((fd = open(myname, 0, 0)) == -1)
+		return NULL;
+	if ((dirp = (DIR *)ckalloc(sizeof(DIR))) == NULL) {
+		close (fd);
+		return NULL;
+	}
+	dirp->dd_fd = fd;
+	dirp->dd_loc = 0;
+	return dirp;
+}
+
+/*
+ * read an old style directory entry and present it as a new one
+ */
+#ifndef pyr
+#define	ODIRSIZ	14
+
+struct	olddirect {
+	ino_t	od_ino;
+	char	od_name[ODIRSIZ];
+};
+#else	/* a Pyramid in the ATT universe */
+#define	ODIRSIZ	248
+
+struct	olddirect {
+	long	od_ino;
+	short	od_fill1, od_fill2;
+	char	od_name[ODIRSIZ];
+};
+#endif
+
+/*
+ * get next entry in a directory.
+ */
+struct dirent *
+readdir(dirp)
+register DIR *dirp;
+{
+	register struct olddirect *dp;
+	static struct dirent dir;
+
+	for (;;) {
+		if (dirp->dd_loc == 0) {
+			dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf,
+			    DIRBLKSIZ);
+			if (dirp->dd_size <= 0)
+				return NULL;
+		}
+		if (dirp->dd_loc >= dirp->dd_size) {
+			dirp->dd_loc = 0;
+			continue;
+		}
+		dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
+		dirp->dd_loc += sizeof(struct olddirect);
+		if (dp->od_ino == 0)
+			continue;
+		dir.d_ino = dp->od_ino;
+		strncpy(dir.d_name, dp->od_name, ODIRSIZ);
+		dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
+		dir.d_namlen = strlen(dir.d_name);
+		dir.d_reclen = DIRSIZ(&dir);
+		return (&dir);
+	}
+}
+
+/*
+ * close a directory.
+ */
+void
+closedir(dirp)
+register DIR *dirp;
+{
+	close(dirp->dd_fd);
+	dirp->dd_fd = -1;
+	dirp->dd_loc = 0;
+	ckfree((char *) dirp);
+}
diff --git a/tcl/compat/stdlib.h b/tcl/compat/stdlib.h
new file mode 100644
index 00000000000..0dabdaf8392
--- /dev/null
+++ b/tcl/compat/stdlib.h
@@ -0,0 +1,45 @@
+/*
+ * stdlib.h --
+ *
+ *	Declares facilities exported by the "stdlib" portion of
+ *	the C library.  This file isn't complete in the ANSI-C
+ *	sense;  it only declares things that are needed by Tcl.
+ *	This file is needed even on many systems with their own
+ *	stdlib.h (e.g. SunOS) because not all stdlib.h files
+ *	declare all the procedures needed here (such as strtod).
+ *
+ * Copyright (c) 1991 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _STDLIB
+#define _STDLIB
+
+#include <tcl.h>
+
+extern void		abort _ANSI_ARGS_((void));
+extern double		atof _ANSI_ARGS_((CONST char *string));
+extern int		atoi _ANSI_ARGS_((CONST char *string));
+extern long		atol _ANSI_ARGS_((CONST char *string));
+extern char *		calloc _ANSI_ARGS_((unsigned int numElements,
+			    unsigned int size));
+extern void		exit _ANSI_ARGS_((int status));
+extern int		free _ANSI_ARGS_((char *blockPtr));
+extern char *		getenv _ANSI_ARGS_((CONST char *name));
+extern char *		malloc _ANSI_ARGS_((unsigned int numBytes));
+extern void		qsort _ANSI_ARGS_((VOID *base, int n, int size,
+			    int (*compar)(CONST VOID *element1, CONST VOID
+			    *element2)));
+extern char *		realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
+extern double		strtod _ANSI_ARGS_((CONST char *string, char **endPtr));
+extern long		strtol _ANSI_ARGS_((CONST char *string, char **endPtr,
+			    int base));
+extern unsigned long	strtoul _ANSI_ARGS_((CONST char *string,
+			    char **endPtr, int base));
+
+#endif /* _STDLIB */
diff --git a/tcl/compat/strftime.c b/tcl/compat/strftime.c
new file mode 100644
index 00000000000..65b687b23c8
--- /dev/null
+++ b/tcl/compat/strftime.c
@@ -0,0 +1,384 @@
+/* 
+ * strftime.c --
+ *
+ *	This file contains a modified version of the BSD 4.4 strftime
+ *	function.
+ *
+ * This file is a modified version of the strftime.c file from the BSD 4.4
+ * source.  See the copyright notice below for details on redistribution
+ * restrictions.  The "license.terms" file does not apply to this file.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Copyright (c) 1989 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.
+ */
+
+#if defined(LIBC_SCCS)
+static char *rcsid = "$Id$";
+#endif /* LIBC_SCCS */
+
+#include <time.h>
+#include <string.h>
+#include <locale.h>
+#include "tclInt.h"
+#include "tclPort.h"
+
+#define TM_YEAR_BASE   1900
+
+typedef struct {
+    const char *abday[7];
+    const char *day[7];
+    const char *abmon[12];
+    const char *mon[12];
+    const char *am_pm[2];
+    const char *d_t_fmt;
+    const char *d_fmt;
+    const char *t_fmt;
+    const char *t_fmt_ampm;
+} _TimeLocale;
+ 
+static const _TimeLocale _DefaultTimeLocale = 
+{
+    {
+	"Sun","Mon","Tue","Wed","Thu","Fri","Sat",
+    },
+    {
+	"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+	"Friday", "Saturday"
+    },
+    {
+	"Jan", "Feb", "Mar", "Apr", "May", "Jun",
+	"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
+    },
+    {
+	"January", "February", "March", "April", "May", "June", "July",
+	"August", "September", "October", "November", "December"
+    },
+    {
+	"AM", "PM"
+    },
+    "%a %b %d %H:%M:%S %Y",
+    "%m/%d/%y",
+    "%H:%M:%S",
+    "%I:%M:%S %p"
+};
+
+static const _TimeLocale *_CurrentTimeLocale = &_DefaultTimeLocale;
+
+static size_t gsize;
+static char *pt;
+static int		 _add _ANSI_ARGS_((const char* str));
+static int		_conv _ANSI_ARGS_((int n, int digits, int pad));
+static int		_secs _ANSI_ARGS_((const struct tm *t));
+static size_t		_fmt _ANSI_ARGS_((const char *format,
+			    const struct tm *t));
+
+size_t
+TclStrftime(s, maxsize, format, t)
+    char *s;
+    size_t maxsize;
+    const char *format;
+    const struct tm *t;
+{
+    tzset();
+
+    pt = s;
+    if ((gsize = maxsize) < 1)
+	return(0);
+    if (_fmt(format, t)) {
+	*pt = '\0';
+	return(maxsize - gsize);
+    }
+    return(0);
+}
+
+#define SUN_WEEK(t)	(((t)->tm_yday + 7 - \
+				((t)->tm_wday)) / 7)
+#define MON_WEEK(t)	(((t)->tm_yday + 7 - \
+				((t)->tm_wday ? (t)->tm_wday - 1 : 6)) / 7)
+
+static size_t
+_fmt(format, t)
+    const char *format;
+    const struct tm *t;
+{
+    for (; *format; ++format) {
+	if (*format == '%') {
+	    ++format;
+	    if (*format == 'E') {
+				/* Alternate Era */
+		++format;
+	    } else if (*format == 'O') {
+				/* Alternate numeric symbols */
+		++format;
+	    }
+	    switch(*format) {
+		case '\0':
+		    --format;
+		    break;
+		case 'A':
+		    if (t->tm_wday < 0 || t->tm_wday > 6)
+			return(0);
+		    if (!_add(_CurrentTimeLocale->day[t->tm_wday]))
+			return(0);
+		    continue;
+		case 'a':
+		    if (t->tm_wday < 0 || t->tm_wday > 6)
+			return(0);
+		    if (!_add(_CurrentTimeLocale->abday[t->tm_wday]))
+			return(0);
+		    continue;
+		case 'B':
+		    if (t->tm_mon < 0 || t->tm_mon > 11)
+			return(0);
+		    if (!_add(_CurrentTimeLocale->mon[t->tm_mon]))
+			return(0);
+		    continue;
+		case 'b':
+		case 'h':
+		    if (t->tm_mon < 0 || t->tm_mon > 11)
+			return(0);
+		    if (!_add(_CurrentTimeLocale->abmon[t->tm_mon]))
+			return(0);
+		    continue;
+		case 'C':
+		    if (!_conv((t->tm_year + TM_YEAR_BASE) / 100,
+			    2, '0'))
+			return(0);
+		    continue;
+		case 'c':
+		    if (!_fmt(_CurrentTimeLocale->d_t_fmt, t))
+			return(0);
+		    continue;
+		case 'D':
+		    if (!_fmt("%m/%d/%y", t))
+			return(0);
+		    continue;
+		case 'd':
+		    if (!_conv(t->tm_mday, 2, '0'))
+			return(0);
+		    continue;
+		case 'e':
+		    if (!_conv(t->tm_mday, 2, ' '))
+			return(0);
+		    continue;
+		case 'H':
+		    if (!_conv(t->tm_hour, 2, '0'))
+			return(0);
+		    continue;
+		case 'I':
+		    if (!_conv(t->tm_hour % 12 ?
+			    t->tm_hour % 12 : 12, 2, '0'))
+			return(0);
+		    continue;
+		case 'j':
+		    if (!_conv(t->tm_yday + 1, 3, '0'))
+			return(0);
+		    continue;
+		case 'k':
+		    if (!_conv(t->tm_hour, 2, ' '))
+			return(0);
+		    continue;
+		case 'l':
+		    if (!_conv(t->tm_hour % 12 ?
+			    t->tm_hour % 12: 12, 2, ' '))
+			return(0);
+		    continue;
+		case 'M':
+		    if (!_conv(t->tm_min, 2, '0'))
+			return(0);
+		    continue;
+		case 'm':
+		    if (!_conv(t->tm_mon + 1, 2, '0'))
+			return(0);
+		    continue;
+		case 'n':
+		    if (!_add("\n"))
+			return(0);
+		    continue;
+		case 'p':
+		    if (!_add(_CurrentTimeLocale->am_pm[t->tm_hour >= 12]))
+			return(0);
+		    continue;
+		case 'R':
+		    if (!_fmt("%H:%M", t))
+			return(0);
+		    continue;
+		case 'r':
+		    if (!_fmt(_CurrentTimeLocale->t_fmt_ampm, t))
+			return(0);
+		    continue;
+		case 'S':
+		    if (!_conv(t->tm_sec, 2, '0'))
+			return(0);
+		    continue;
+		case 's':
+		    if (!_secs(t))
+			return(0);
+		    continue;
+		case 'T':
+		    if (!_fmt("%H:%M:%S", t))
+			return(0);
+		    continue;
+		case 't':
+		    if (!_add("\t"))
+			return(0);
+		    continue;
+		case 'U':
+		    if (!_conv(SUN_WEEK(t), 2, '0'))
+			return(0);
+		    continue;
+		case 'u':
+		    if (!_conv(t->tm_wday ? t->tm_wday : 7, 1, '0'))
+			return(0);
+		    continue;
+		case 'V':
+		{
+				/* ISO 8601 Week Of Year:
+				   If the week (Monday - Sunday) containing
+				   January 1 has four or more days in the new 
+				   year, then it is week 1; otherwise it is 
+				   week 53 of the previous year and the next
+				   week is week one. */
+				 
+		    int week = MON_WEEK(t);
+
+		    int days = (((t)->tm_yday + 7 - \
+			    ((t)->tm_wday ? (t)->tm_wday - 1 : 6)) % 7);
+
+
+		    if (days >= 4) {
+			week++;
+		    } else if (week == 0) {
+			week = 53;
+		    }
+
+		    if (!_conv(week, 2, '0'))
+			return(0);
+		    continue;
+		}
+		case 'W':
+		    if (!_conv(MON_WEEK(t), 2, '0'))
+			return(0);
+		    continue;
+		case 'w':
+		    if (!_conv(t->tm_wday, 1, '0'))
+			return(0);
+		    continue;
+		case 'x':
+		    if (!_fmt(_CurrentTimeLocale->d_fmt, t))
+			return(0);
+		    continue;
+		case 'X':
+		    if (!_fmt(_CurrentTimeLocale->t_fmt, t))
+			return(0);
+		    continue;
+		case 'y':
+		    if (!_conv((t->tm_year + TM_YEAR_BASE) % 100,
+			    2, '0'))
+			return(0);
+		    continue;
+		case 'Y':
+		    if (!_conv((t->tm_year + TM_YEAR_BASE), 4, '0'))
+			return(0);
+		    continue;
+#ifndef MAC_TCL
+		case 'Z': {
+		    char *name = TclpGetTZName();
+		    if (name && !_add(name)) {
+			return 0;
+		    }
+		    continue;
+		}
+#endif
+		case '%':
+		    /*
+		     * X311J/88-090 (4.12.3.5): if conversion char is
+		     * undefined, behavior is undefined.  Print out the
+		     * character itself as printf(3) does.
+		     */
+		default:
+		    break;
+	    }
+	}
+	if (!gsize--)
+	    return(0);
+	*pt++ = *format;
+    }
+    return(gsize);
+}
+
+static int
+_secs(t)
+    const struct tm *t;
+{
+    static char buf[15];
+    register time_t s;
+    register char *p;
+    struct tm tmp;
+
+    /* Make a copy, mktime(3) modifies the tm struct. */
+    tmp = *t;
+    s = mktime(&tmp);
+    for (p = buf + sizeof(buf) - 2; s > 0 && p > buf; s /= 10)
+	*p-- = (char)(s % 10 + '0');
+    return(_add(++p));
+}
+
+static int
+_conv(n, digits, pad)
+    int n, digits;
+    int pad;
+{
+    static char buf[10];
+    register char *p;
+
+    for (p = buf + sizeof(buf) - 2; n > 0 && p > buf; n /= 10, --digits)
+	*p-- = (char)(n % 10 + '0');
+    while (p > buf && digits-- > 0)
+	*p-- = (char) pad;
+    return(_add(++p));
+}
+
+static int
+_add(str)
+    const char *str;
+{
+    for (;; ++pt, --gsize) {
+	if (!gsize)
+	    return(0);
+	if (!(*pt = *str++))
+	    return(1);
+    }
+}
diff --git a/tcl/compat/string.h b/tcl/compat/string.h
new file mode 100644
index 00000000000..c9894783b8d
--- /dev/null
+++ b/tcl/compat/string.h
@@ -0,0 +1,66 @@
+/*
+ * string.h --
+ *
+ *	Declarations of ANSI C library procedures for string handling.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _STRING
+#define _STRING
+
+#include <tcl.h>
+
+/*
+ * The following #include is needed to define size_t. (This used to
+ * include sys/stdtypes.h but that doesn't exist on older versions
+ * of SunOS, e.g. 4.0.2, so I'm trying sys/types.h now.... hopefully
+ * it exists everywhere)
+ */
+
+#ifndef MAC_TCL
+#include <sys/types.h>
+#endif
+
+extern char *		memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n));
+extern int		memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2,
+			    size_t n));
+extern char *		memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n));
+extern char *		memmove _ANSI_ARGS_((VOID *t, CONST VOID *f,
+			    size_t n));
+extern char *		memset _ANSI_ARGS_((VOID *s, int c, size_t n));
+
+extern int		strcasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2));
+extern char *		strcat _ANSI_ARGS_((char *dst, CONST char *src));
+extern char *		strchr _ANSI_ARGS_((CONST char *string, int c));
+extern int		strcmp _ANSI_ARGS_((CONST char *s1, CONST char *s2));
+extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
+extern size_t		strcspn _ANSI_ARGS_((CONST char *string,
+			    CONST char *chars));
+extern char *		strdup _ANSI_ARGS_((CONST char *string));
+extern char *		strerror _ANSI_ARGS_((int error));
+extern size_t		strlen _ANSI_ARGS_((CONST char *string));
+extern int		strncasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2, size_t n));
+extern char *		strncat _ANSI_ARGS_((char *dst, CONST char *src,
+			    size_t numChars));
+extern int		strncmp _ANSI_ARGS_((CONST char *s1, CONST char *s2,
+			    size_t nChars));
+extern char *		strncpy _ANSI_ARGS_((char *dst, CONST char *src,
+			    size_t numChars));
+extern char *		strpbrk _ANSI_ARGS_((CONST char *string, char *chars));
+extern char *		strrchr _ANSI_ARGS_((CONST char *string, int c));
+extern size_t		strspn _ANSI_ARGS_((CONST char *string,
+			    CONST char *chars));
+extern char *		strstr _ANSI_ARGS_((CONST char *string,
+			    CONST char *substring));
+extern char *		strtok _ANSI_ARGS_((CONST char *s, CONST char *delim));
+
+#endif /* _STRING */
diff --git a/tcl/compat/strncasecmp.c b/tcl/compat/strncasecmp.c
new file mode 100644
index 00000000000..7f97d219438
--- /dev/null
+++ b/tcl/compat/strncasecmp.c
@@ -0,0 +1,142 @@
+/* 
+ * strncasecmp.c --
+ *
+ *	Source code for the "strncasecmp" library routine.
+ *
+ * Copyright (c) 1988-1993 The Regents of the University of California.
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclPort.h"
+
+/*
+ * This array is designed for mapping upper and lower case letter
+ * together for a case independent comparison.  The mappings are
+ * based upon ASCII character sequences.
+ */
+
+static unsigned char charmap[] = {
+    0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
+    0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
+    0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
+    0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
+    0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
+    0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f,
+    0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,
+    0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f,
+    0x40, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
+    0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
+    0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
+    0x78, 0x79, 0x7a, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f,
+    0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
+    0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
+    0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
+    0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f,
+    0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
+    0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f,
+    0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
+    0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f,
+    0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7,
+    0xa8, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf,
+    0xb0, 0xb1, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7,
+    0xb8, 0xb9, 0xba, 0xbb, 0xbc, 0xbd, 0xbe, 0xbf,
+    0xc0, 0xe1, 0xe2, 0xe3, 0xe4, 0xc5, 0xe6, 0xe7,
+    0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef,
+    0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7,
+    0xf8, 0xf9, 0xfa, 0xdb, 0xdc, 0xdd, 0xde, 0xdf,
+    0xe0, 0xe1, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7,
+    0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef,
+    0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7,
+    0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff,
+};
+
+/*
+ * Here are the prototypes just in case they are not included
+ * in tclPort.h.
+ */
+int		strncasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2, size_t n));
+
+int		strcasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * strcasecmp --
+ *
+ *	Compares two strings, ignoring case differences.
+ *
+ * Results:
+ *	Compares two null-terminated strings s1 and s2, returning -1, 0,
+ *	or 1 if s1 is lexicographically less than, equal to, or greater
+ *	than s2.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+strcasecmp(s1, s2)
+    CONST char *s1;			/* First string. */
+    CONST char *s2;			/* Second string. */
+{
+    unsigned char u1, u2;
+
+    for ( ; ; s1++, s2++) {
+	u1 = (unsigned char) *s1;
+	u2 = (unsigned char) *s2;
+	if ((u1 == '\0') || (charmap[u1] != charmap[u2])) {
+	    break;
+	}
+    }
+    return charmap[u1] - charmap[u2];
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * strncasecmp --
+ *
+ *	Compares two strings, ignoring case differences.
+ *
+ * Results:
+ *	Compares up to length chars of s1 and s2, returning -1, 0, or 1
+ *	if s1 is lexicographically less than, equal to, or greater
+ *	than s2 over those characters.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+strncasecmp(s1, s2, length)
+    CONST char *s1;		/* First string. */
+    CONST char *s2;		/* Second string. */
+    size_t length;		/* Maximum number of characters to compare
+				 * (stop earlier if the end of either string
+				 * is reached). */
+{
+    unsigned char u1, u2;
+
+    for (; length != 0; length--, s1++, s2++) {
+	u1 = (unsigned char) *s1;
+	u2 = (unsigned char) *s2;
+	if (charmap[u1] != charmap[u2]) {
+	    return charmap[u1] - charmap[u2];
+	}
+	if (u1 == '\0') {
+	    return 0;
+	}
+    }
+    return 0;
+}
diff --git a/tcl/compat/strstr.c b/tcl/compat/strstr.c
new file mode 100644
index 00000000000..c648b9f67f3
--- /dev/null
+++ b/tcl/compat/strstr.c
@@ -0,0 +1,68 @@
+/* 
+ * strstr.c --
+ *
+ *	Source code for the "strstr" library routine.
+ *
+ * Copyright (c) 1988-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * strstr --
+ *
+ *	Locate the first instance of a substring in a string.
+ *
+ * Results:
+ *	If string contains substring, the return value is the
+ *	location of the first matching instance of substring
+ *	in string.  If string doesn't contain substring, the
+ *	return value is 0.  Matching is done on an exact
+ *	character-for-character basis with no wildcards or special
+ *	characters.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+strstr(string, substring)
+    register char *string;	/* String to search. */
+    char *substring;		/* Substring to try to find in string. */
+{
+    register char *a, *b;
+
+    /* First scan quickly through the two strings looking for a
+     * single-character match.  When it's found, then compare the
+     * rest of the substring.
+     */
+
+    b = substring;
+    if (*b == 0) {
+	return string;
+    }
+    for ( ; *string != 0; string += 1) {
+	if (*string != *b) {
+	    continue;
+	}
+	a = string;
+	while (1) {
+	    if (*b == 0) {
+		return string;
+	    }
+	    if (*a++ != *b++) {
+		break;
+	    }
+	}
+	b = substring;
+    }
+    return (char *) 0;
+}
diff --git a/tcl/compat/strtod.c b/tcl/compat/strtod.c
new file mode 100644
index 00000000000..19d24a1f7f7
--- /dev/null
+++ b/tcl/compat/strtod.c
@@ -0,0 +1,257 @@
+/* 
+ * strtod.c --
+ *
+ *	Source code for the "strtod" library procedure.
+ *
+ * Copyright (c) 1988-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#ifdef NO_STDLIB_H
+#   include "../compat/stdlib.h"
+#else
+#   include <stdlib.h>
+#endif
+#include <ctype.h>
+
+#ifndef TRUE
+#define TRUE 1
+#define FALSE 0
+#endif
+#ifndef NULL
+#define NULL 0
+#endif
+
+static int maxExponent = 511;	/* Largest possible base 10 exponent.  Any
+				 * exponent larger than this will already
+				 * produce underflow or overflow, so there's
+				 * no need to worry about additional digits.
+				 */
+static double powersOf10[] = {	/* Table giving binary powers of 10.  Entry */
+    10.,			/* is 10^2^i.  Used to convert decimal */
+    100.,			/* exponents into floating-point numbers. */
+    1.0e4,
+    1.0e8,
+    1.0e16,
+    1.0e32,
+    1.0e64,
+    1.0e128,
+    1.0e256
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * strtod --
+ *
+ *	This procedure converts a floating-point number from an ASCII
+ *	decimal representation to internal double-precision format.
+ *
+ * Results:
+ *	The return value is the double-precision floating-point
+ *	representation of the characters in string.  If endPtr isn't
+ *	NULL, then *endPtr is filled in with the address of the
+ *	next character after the last one that was part of the
+ *	floating-point number.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+strtod(string, endPtr)
+    CONST char *string;		/* A decimal ASCII floating-point number,
+				 * optionally preceded by white space.
+				 * Must have form "-I.FE-X", where I is the
+				 * integer part of the mantissa, F is the
+				 * fractional part of the mantissa, and X
+				 * is the exponent.  Either of the signs
+				 * may be "+", "-", or omitted.  Either I
+				 * or F may be omitted, or both.  The decimal
+				 * point isn't necessary unless F is present.
+				 * The "E" may actually be an "e".  E and X
+				 * may both be omitted (but not just one).
+				 */
+    char **endPtr;		/* If non-NULL, store terminating character's
+				 * address here. */
+{
+    int sign, expSign = FALSE;
+    double fraction, dblExp, *d;
+    register CONST char *p;
+    register int c;
+    int exp = 0;		/* Exponent read from "EX" field. */
+    int fracExp = 0;		/* Exponent that derives from the fractional
+				 * part.  Under normal circumstatnces, it is
+				 * the negative of the number of digits in F.
+				 * However, if I is very long, the last digits
+				 * of I get dropped (otherwise a long I with a
+				 * large negative exponent could cause an
+				 * unnecessary overflow on I alone).  In this
+				 * case, fracExp is incremented one for each
+				 * dropped digit. */
+    int mantSize;		/* Number of digits in mantissa. */
+    int decPt;			/* Number of mantissa digits BEFORE decimal
+				 * point. */
+    CONST char *pExp;		/* Temporarily holds location of exponent
+				 * in string. */
+
+    /*
+     * Strip off leading blanks and check for a sign.
+     */
+
+    p = string;
+    while (isspace(*p)) {
+	p += 1;
+    }
+    if (*p == '-') {
+	sign = TRUE;
+	p += 1;
+    } else {
+	if (*p == '+') {
+	    p += 1;
+	}
+	sign = FALSE;
+    }
+
+    /*
+     * Count the number of digits in the mantissa (including the decimal
+     * point), and also locate the decimal point.
+     */
+
+    decPt = -1;
+    for (mantSize = 0; ; mantSize += 1)
+    {
+	c = *p;
+	if (!isdigit(c)) {
+	    if ((c != '.') || (decPt >= 0)) {
+		break;
+	    }
+	    decPt = mantSize;
+	}
+	p += 1;
+    }
+
+    /*
+     * Now suck up the digits in the mantissa.  Use two integers to
+     * collect 9 digits each (this is faster than using floating-point).
+     * If the mantissa has more than 18 digits, ignore the extras, since
+     * they can't affect the value anyway.
+     */
+    
+    pExp  = p;
+    p -= mantSize;
+    if (decPt < 0) {
+	decPt = mantSize;
+    } else {
+	mantSize -= 1;			/* One of the digits was the point. */
+    }
+    if (mantSize > 18) {
+	fracExp = decPt - 18;
+	mantSize = 18;
+    } else {
+	fracExp = decPt - mantSize;
+    }
+    if (mantSize == 0) {
+	fraction = 0.0;
+	p = string;
+	goto done;
+    } else {
+	int frac1, frac2;
+	frac1 = 0;
+	for ( ; mantSize > 9; mantSize -= 1)
+	{
+	    c = *p;
+	    p += 1;
+	    if (c == '.') {
+		c = *p;
+		p += 1;
+	    }
+	    frac1 = 10*frac1 + (c - '0');
+	}
+	frac2 = 0;
+	for (; mantSize > 0; mantSize -= 1)
+	{
+	    c = *p;
+	    p += 1;
+	    if (c == '.') {
+		c = *p;
+		p += 1;
+	    }
+	    frac2 = 10*frac2 + (c - '0');
+	}
+	fraction = (1.0e9 * frac1) + frac2;
+    }
+
+    /*
+     * Skim off the exponent.
+     */
+
+    p = pExp;
+    if ((*p == 'E') || (*p == 'e')) {
+	p += 1;
+	if (*p == '-') {
+	    expSign = TRUE;
+	    p += 1;
+	} else {
+	    if (*p == '+') {
+		p += 1;
+	    }
+	    expSign = FALSE;
+	}
+	while (isdigit(*p)) {
+	    exp = exp * 10 + (*p - '0');
+	    p += 1;
+	}
+    }
+    if (expSign) {
+	exp = fracExp - exp;
+    } else {
+	exp = fracExp + exp;
+    }
+
+    /*
+     * Generate a floating-point number that represents the exponent.
+     * Do this by processing the exponent one bit at a time to combine
+     * many powers of 2 of 10. Then combine the exponent with the
+     * fraction.
+     */
+    
+    if (exp < 0) {
+	expSign = TRUE;
+	exp = -exp;
+    } else {
+	expSign = FALSE;
+    }
+    if (exp > maxExponent) {
+	exp = maxExponent;
+    }
+    dblExp = 1.0;
+    for (d = powersOf10; exp != 0; exp >>= 1, d += 1) {
+	if (exp & 01) {
+	    dblExp *= *d;
+	}
+    }
+    if (expSign) {
+	fraction /= dblExp;
+    } else {
+	fraction *= dblExp;
+    }
+
+done:
+    if (endPtr != NULL) {
+	*endPtr = (char *) p;
+    }
+
+    if (sign) {
+	return -fraction;
+    }
+    return fraction;
+}
diff --git a/tcl/compat/strtol.c b/tcl/compat/strtol.c
new file mode 100644
index 00000000000..e1d7de599fb
--- /dev/null
+++ b/tcl/compat/strtol.c
@@ -0,0 +1,83 @@
+/* 
+ * strtol.c --
+ *
+ *	Source code for the "strtol" library procedure.
+ *
+ * Copyright (c) 1988 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <ctype.h>
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * strtol --
+ *
+ *	Convert an ASCII string into an integer.
+ *
+ * Results:
+ *	The return value is the integer equivalent of string.  If endPtr
+ *	is non-NULL, then *endPtr is filled in with the character
+ *	after the last one that was part of the integer.  If string
+ *	doesn't contain a valid integer value, then zero is returned
+ *	and *endPtr is set to string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+long int
+strtol(string, endPtr, base)
+    char *string;		/* String of ASCII digits, possibly
+				 * preceded by white space.  For bases
+				 * greater than 10, either lower- or
+				 * upper-case digits may be used.
+				 */
+    char **endPtr;		/* Where to store address of terminating
+				 * character, or NULL. */
+    int base;			/* Base for conversion.  Must be less
+				 * than 37.  If 0, then the base is chosen
+				 * from the leading characters of string:
+				 * "0x" means hex, "0" means octal, anything
+				 * else means decimal.
+				 */
+{
+    register char *p;
+    int result;
+
+    /*
+     * Skip any leading blanks.
+     */
+
+    p = string;
+    while (isspace(*p)) {
+	p += 1;
+    }
+
+    /*
+     * Check for a sign.
+     */
+
+    if (*p == '-') {
+	p += 1;
+	result = -(strtoul(p, endPtr, base));
+    } else {
+	if (*p == '+') {
+	    p += 1;
+	}
+	result = strtoul(p, endPtr, base);
+    }
+    if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
+	*endPtr = string;
+    }
+    return result;
+}
diff --git a/tcl/compat/strtoul.c b/tcl/compat/strtoul.c
new file mode 100644
index 00000000000..9f5d66882fd
--- /dev/null
+++ b/tcl/compat/strtoul.c
@@ -0,0 +1,183 @@
+/* 
+ * strtoul.c --
+ *
+ *	Source code for the "strtoul" library procedure.
+ *
+ * Copyright (c) 1988 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <ctype.h>
+
+/*
+ * The table below is used to convert from ASCII digits to a
+ * numerical equivalent.  It maps from '0' through 'z' to integers
+ * (100 for non-digit characters).
+ */
+
+static char cvtIn[] = {
+    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,		/* '0' - '9' */
+    100, 100, 100, 100, 100, 100, 100,		/* punctuation */
+    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'A' - 'Z' */
+    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
+    30, 31, 32, 33, 34, 35,
+    100, 100, 100, 100, 100, 100,		/* punctuation */
+    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'a' - 'z' */
+    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
+    30, 31, 32, 33, 34, 35};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * strtoul --
+ *
+ *	Convert an ASCII string into an integer.
+ *
+ * Results:
+ *	The return value is the integer equivalent of string.  If endPtr
+ *	is non-NULL, then *endPtr is filled in with the character
+ *	after the last one that was part of the integer.  If string
+ *	doesn't contain a valid integer value, then zero is returned
+ *	and *endPtr is set to string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long int
+strtoul(string, endPtr, base)
+    char *string;		/* String of ASCII digits, possibly
+				 * preceded by white space.  For bases
+				 * greater than 10, either lower- or
+				 * upper-case digits may be used.
+				 */
+    char **endPtr;		/* Where to store address of terminating
+				 * character, or NULL. */
+    int base;			/* Base for conversion.  Must be less
+				 * than 37.  If 0, then the base is chosen
+				 * from the leading characters of string:
+				 * "0x" means hex, "0" means octal, anything
+				 * else means decimal.
+				 */
+{
+    register char *p;
+    register unsigned long int result = 0;
+    register unsigned digit;
+    int anyDigits = 0;
+
+    /*
+     * Skip any leading blanks.
+     */
+
+    p = string;
+    while (isspace(*p)) {
+	p += 1;
+    }
+
+    /*
+     * If no base was provided, pick one from the leading characters
+     * of the string.
+     */
+    
+    if (base == 0)
+    {
+	if (*p == '0') {
+	    p += 1;
+	    if (*p == 'x') {
+		p += 1;
+		base = 16;
+	    } else {
+
+		/*
+		 * Must set anyDigits here, otherwise "0" produces a
+		 * "no digits" error.
+		 */
+
+		anyDigits = 1;
+		base = 8;
+	    }
+	}
+	else base = 10;
+    } else if (base == 16) {
+
+	/*
+	 * Skip a leading "0x" from hex numbers.
+	 */
+
+	if ((p[0] == '0') && (p[1] == 'x')) {
+	    p += 2;
+	}
+    }
+
+    /*
+     * Sorry this code is so messy, but speed seems important.  Do
+     * different things for base 8, 10, 16, and other.
+     */
+
+    if (base == 8) {
+	for ( ; ; p += 1) {
+	    digit = *p - '0';
+	    if (digit > 7) {
+		break;
+	    }
+	    result = (result << 3) + digit;
+	    anyDigits = 1;
+	}
+    } else if (base == 10) {
+	for ( ; ; p += 1) {
+	    digit = *p - '0';
+	    if (digit > 9) {
+		break;
+	    }
+	    result = (10*result) + digit;
+	    anyDigits = 1;
+	}
+    } else if (base == 16) {
+	for ( ; ; p += 1) {
+	    digit = *p - '0';
+	    if (digit > ('z' - '0')) {
+		break;
+	    }
+	    digit = cvtIn[digit];
+	    if (digit > 15) {
+		break;
+	    }
+	    result = (result << 4) + digit;
+	    anyDigits = 1;
+	}
+    } else {
+	for ( ; ; p += 1) {
+	    digit = *p - '0';
+	    if (digit > ('z' - '0')) {
+		break;
+	    }
+	    digit = cvtIn[digit];
+	    if (digit >= base) {
+		break;
+	    }
+	    result = result*base + digit;
+	    anyDigits = 1;
+	}
+    }
+
+    /*
+     * See if there were any digits at all.
+     */
+
+    if (!anyDigits) {
+	p = string;
+    }
+
+    if (endPtr != 0) {
+	*endPtr = p;
+    }
+
+    return result;
+}
diff --git a/tcl/compat/tclErrno.h b/tcl/compat/tclErrno.h
new file mode 100644
index 00000000000..068ef356744
--- /dev/null
+++ b/tcl/compat/tclErrno.h
@@ -0,0 +1,100 @@
+/*
+ * tclErrno.h --
+ *
+ *	This header file contains the various POSIX errno definitions that
+ *	are used by Tcl.  This file is derived from the spec POSIX 2.4 and
+ *	previous implementations for Berkeley UNIX.
+ *
+ * Copyright (c) 1982, 1986, 1989 Regents of the University of California.
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+extern int errno;			/* global error number */
+
+#define	EPERM		1		/* Operation not permitted */
+#define	ENOENT		2		/* No such file or directory */
+#define	ESRCH		3		/* No such process */
+#define	EINTR		4		/* Interrupted system call */
+#define	EIO		5		/* Input/output error */
+#define	ENXIO		6		/* Device not configured */
+#define	E2BIG		7		/* Argument list too long */
+#define	ENOEXEC		8		/* Exec format error */
+#define	EBADF		9		/* Bad file descriptor */
+#define	ECHILD		10		/* No child processes */
+#define	EDEADLK		11		/* Resource deadlock avoided */
+					/* 11 was EAGAIN */
+#define	ENOMEM		12		/* Cannot allocate memory */
+#define	EACCES		13		/* Permission denied */
+#define	EFAULT		14		/* Bad address */
+#define	ENOTBLK		15		/* Block device required */
+#define	EBUSY		16		/* Device busy */
+#define	EEXIST		17		/* File exists */
+#define	EXDEV		18		/* Cross-device link */
+#define	ENODEV		19		/* Operation not supported by device */
+#define	ENOTDIR		20		/* Not a directory */
+#define	EISDIR		21		/* Is a directory */
+#define	EINVAL		22		/* Invalid argument */
+#define	ENFILE		23		/* Too many open files in system */
+#define	EMFILE		24		/* Too many open files */
+#define	ENOTTY		25		/* Inappropriate ioctl for device */
+#define	ETXTBSY		26		/* Text file busy */
+#define	EFBIG		27		/* File too large */
+#define	ENOSPC		28		/* No space left on device */
+#define	ESPIPE		29		/* Illegal seek */
+#define	EROFS		30		/* Read-only file system */
+#define	EMLINK		31		/* Too many links */
+#define	EPIPE		32		/* Broken pipe */
+#define	EDOM		33		/* Numerical argument out of domain */
+#define	ERANGE		34		/* Result too large */
+#define	EAGAIN		35		/* Resource temporarily unavailable */
+#define	EWOULDBLOCK	EAGAIN		/* Operation would block */
+#define	EINPROGRESS	36		/* Operation now in progress */
+#define	EALREADY	37		/* Operation already in progress */
+#define	ENOTSOCK	38		/* Socket operation on non-socket */
+#define	EDESTADDRREQ	39		/* Destination address required */
+#define	EMSGSIZE	40		/* Message too long */
+#define	EPROTOTYPE	41		/* Protocol wrong type for socket */
+#define	ENOPROTOOPT	42		/* Protocol not available */
+#define	EPROTONOSUPPORT	43		/* Protocol not supported */
+#define	ESOCKTNOSUPPORT	44		/* Socket type not supported */
+#define	EOPNOTSUPP	45		/* Operation not supported on socket */
+#define	EPFNOSUPPORT	46		/* Protocol family not supported */
+#define	EAFNOSUPPORT	47		/* Address family not supported by protocol family */
+#define	EADDRINUSE	48		/* Address already in use */
+#define	EADDRNOTAVAIL	49		/* Can't assign requested address */
+#define	ENETDOWN	50		/* Network is down */
+#define	ENETUNREACH	51		/* Network is unreachable */
+#define	ENETRESET	52		/* Network dropped connection on reset */
+#define	ECONNABORTED	53		/* Software caused connection abort */
+#define	ECONNRESET	54		/* Connection reset by peer */
+#define	ENOBUFS		55		/* No buffer space available */
+#define	EISCONN		56		/* Socket is already connected */
+#define	ENOTCONN	57		/* Socket is not connected */
+#define	ESHUTDOWN	58		/* Can't send after socket shutdown */
+#define	ETOOMANYREFS	59		/* Too many references: can't splice */
+#define	ETIMEDOUT	60		/* Connection timed out */
+#define	ECONNREFUSED	61		/* Connection refused */
+#define	ELOOP		62		/* Too many levels of symbolic links */
+#define	ENAMETOOLONG	63		/* File name too long */
+#define	EHOSTDOWN	64		/* Host is down */
+#define	EHOSTUNREACH	65		/* No route to host */
+#define	ENOTEMPTY	66		/* Directory not empty */
+#define	EPROCLIM	67		/* Too many processes */
+#define	EUSERS		68		/* Too many users */
+#define	EDQUOT		69		/* Disc quota exceeded */
+#define	ESTALE		70		/* Stale NFS file handle */
+#define	EREMOTE		71		/* Too many levels of remote in path */
+#define	EBADRPC		72		/* RPC struct is bad */
+#define	ERPCMISMATCH	73		/* RPC version wrong */
+#define	EPROGUNAVAIL	74		/* RPC prog. not avail */
+#define	EPROGMISMATCH	75		/* Program version wrong */
+#define	EPROCUNAVAIL	76		/* Bad procedure for program */
+#define	ENOLCK		77		/* No locks available */
+#define	ENOSYS		78		/* Function not implemented */
+#define	EFTYPE		79		/* Inappropriate file type or format */
+
diff --git a/tcl/compat/tmpnam.c b/tcl/compat/tmpnam.c
new file mode 100644
index 00000000000..ffec5ae6511
--- /dev/null
+++ b/tcl/compat/tmpnam.c
@@ -0,0 +1,42 @@
+/*
+ * Copyright (c) 1988 Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that this notice is preserved and that due credit is given
+ * to the University of California at Berkeley. The name of the University
+ * may not be used to endorse or promote products derived from this
+ * software without specific written prior permission. This software
+ * is provided ``as is'' without express or implied warranty.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <sys/param.h>
+#include <sys/stat.h>
+#include <sys/file.h>
+#include <stdio.h>
+
+/*
+ * Use /tmp instead of /usr/tmp, because L_tmpname is only 14 chars
+ * on some machines (like NeXT machines) and /usr/tmp will cause
+ * buffer overflows.
+ */
+
+#ifdef P_tmpdir
+#   undef P_tmpdir
+#endif
+#define	P_tmpdir	"/tmp"
+
+char *
+tmpnam(s)
+	char *s;
+{
+	static char name[50];
+	char *mktemp();
+
+	if (!s)
+		s = name;
+	(void)sprintf(s, "%s/XXXXXX", P_tmpdir);
+	return(mktemp(s));
+}
diff --git a/tcl/compat/unistd.h b/tcl/compat/unistd.h
new file mode 100644
index 00000000000..1a13f585e63
--- /dev/null
+++ b/tcl/compat/unistd.h
@@ -0,0 +1,84 @@
+/*
+ * unistd.h --
+ *
+ *      Macros, CONSTants and prototypes for Posix conformance.
+ *
+ * Copyright 1989 Regents of the University of California
+ * Permission to use, copy, modify, and distribute this
+ * software and its documentation for any purpose and without
+ * fee is hereby granted, provided that the above copyright
+ * notice appear in all copies.  The University of California
+ * makes no representations about the suitability of this
+ * software for any purpose.  It is provided "as is" without
+ * express or implied warranty.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _UNISTD
+#define _UNISTD
+
+#include <sys/types.h>
+#ifndef _TCL
+#   include "tcl.h"
+#endif
+
+#ifndef NULL
+#define NULL    0
+#endif
+
+/* 
+ * Strict POSIX stuff goes here.  Extensions go down below, in the 
+ * ifndef _POSIX_SOURCE section.
+ */
+
+extern void _exit _ANSI_ARGS_((int status));
+extern int access _ANSI_ARGS_((CONST char *path, int mode));
+extern int chdir _ANSI_ARGS_((CONST char *path));
+extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group));
+extern int close _ANSI_ARGS_((int fd));
+extern int dup _ANSI_ARGS_((int oldfd));
+extern int dup2 _ANSI_ARGS_((int oldfd, int newfd));
+extern int execl _ANSI_ARGS_((CONST char *path, ...));
+extern int execle _ANSI_ARGS_((CONST char *path, ...));
+extern int execlp _ANSI_ARGS_((CONST char *file, ...));
+extern int execv _ANSI_ARGS_((CONST char *path, char **argv));
+extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp));
+extern int execvp _ANSI_ARGS_((CONST char *file, char **argv));
+extern pid_t fork _ANSI_ARGS_((void));
+extern char *getcwd _ANSI_ARGS_((char *buf, size_t size));
+extern gid_t getegid _ANSI_ARGS_((void));
+extern uid_t geteuid _ANSI_ARGS_((void));
+extern gid_t getgid _ANSI_ARGS_((void));
+extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer));
+extern pid_t getpid _ANSI_ARGS_((void));
+extern uid_t getuid _ANSI_ARGS_((void));
+extern int isatty _ANSI_ARGS_((int fd));
+extern long lseek _ANSI_ARGS_((int fd, long offset, int whence));
+extern int pipe _ANSI_ARGS_((int *fildes));
+extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
+extern int setgid _ANSI_ARGS_((gid_t group));
+extern int setuid _ANSI_ARGS_((uid_t user));
+extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds));
+extern char *ttyname _ANSI_ARGS_((int fd));
+extern int unlink _ANSI_ARGS_((CONST char *path));
+extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size));
+
+#ifndef	_POSIX_SOURCE
+extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *));
+extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group));
+extern int flock _ANSI_ARGS_((int fd, int operation));
+extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length));
+extern int ioctl _ANSI_ARGS_((int fd, int request, ...));
+extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize));
+extern int setegid _ANSI_ARGS_((gid_t group));
+extern int seteuid _ANSI_ARGS_((uid_t user));
+extern int setreuid _ANSI_ARGS_((int ruid, int euid));
+extern int symlink _ANSI_ARGS_((CONST char *, CONST char *));
+extern int ttyslot _ANSI_ARGS_((void));
+extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length));
+extern int vfork _ANSI_ARGS_((void));
+#endif /* _POSIX_SOURCE */
+
+#endif /* _UNISTD */
+
diff --git a/tcl/compat/waitpid.c b/tcl/compat/waitpid.c
new file mode 100644
index 00000000000..e9adb632b06
--- /dev/null
+++ b/tcl/compat/waitpid.c
@@ -0,0 +1,170 @@
+/* 
+ * waitpid.c --
+ *
+ *	This procedure emulates the POSIX waitpid kernel call on
+ *	BSD systems that don't have waitpid but do have wait3.
+ *	This code is based on a prototype version written by
+ *	Mark Diekhans and Karl Lehenbauer.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * A linked list of the following structures is used to keep track
+ * of processes for which we received notification from the kernel,
+ * but the application hasn't waited for them yet (this can happen
+ * because wait may not return the process we really want).  We
+ * save the information here until the application finally does
+ * wait for the process.
+ */
+
+typedef struct WaitInfo {
+    int pid;				/* Pid of process that exited. */
+    WAIT_STATUS_TYPE status;		/* Status returned when child exited
+					 * or suspended. */
+    struct WaitInfo *nextPtr;		/* Next in list of exited processes. */
+} WaitInfo;
+
+static WaitInfo *deadList = NULL;	/* First in list of all dead
+					 * processes. */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * waitpid --
+ *
+ *	This procedure emulates the functionality of the POSIX
+ *	waitpid kernel call, using the BSD wait3 kernel call.
+ *	Note:  it doesn't emulate absolutely all of the waitpid
+ *	functionality, in that it doesn't support pid's of 0
+ *	or < -1.
+ *
+ * Results:
+ *	-1 is returned if there is an error in the wait kernel call.
+ *	Otherwise the pid of an exited or suspended process is
+ *	returned and *statusPtr is set to the status value of the
+ *	process.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef waitpid
+#   undef waitpid
+#endif
+
+int
+waitpid(pid, statusPtr, options)
+    int pid;			/* The pid to wait on.  Must be -1 or
+				 * greater than zero. */
+    int *statusPtr;		/* Where to store wait status for the
+				 * process. */
+    int options;		/* OR'ed combination of WNOHANG and
+				 * WUNTRACED. */
+{
+    register WaitInfo *waitPtr, *prevPtr;
+    int result;
+    WAIT_STATUS_TYPE status;
+
+    if ((pid < -1) || (pid == 0)) {
+	errno = EINVAL;
+	return -1;
+    }
+
+    /*
+     * See if there's a suitable process that has already stopped or
+     * exited. If so, remove it from the list of exited processes and
+     * return its information.
+     */
+
+    for (waitPtr = deadList, prevPtr = NULL; waitPtr != NULL;
+	    prevPtr = waitPtr, waitPtr = waitPtr->nextPtr) {
+	if ((pid != waitPtr->pid) && (pid != -1)) {
+	    continue;
+	}
+	if (!(options & WUNTRACED) && (WIFSTOPPED(waitPtr->status))) {
+	    continue;
+	}
+	result = waitPtr->pid;
+	*statusPtr = *((int *) &waitPtr->status);
+	if (prevPtr == NULL) {
+	    deadList = waitPtr->nextPtr;
+	} else {
+	    prevPtr->nextPtr = waitPtr->nextPtr;
+	}
+	ckfree((char *) waitPtr);
+	return result;
+    }
+
+    /*
+     * Wait for any process to stop or exit.  If it's an acceptable one
+     * then return it to the caller;  otherwise store information about it
+     * in the list of exited processes and try again.  On systems that
+     * have only wait but not wait3, there are several situations we can't
+     * handle, but we do the best we can (e.g. can still handle some
+     * combinations of options by invoking wait instead of wait3).
+     */
+
+    while (1) {
+#if NO_WAIT3
+	if (options & WNOHANG) {
+	    return 0;
+	}
+	if (options != 0) {
+	    errno = EINVAL;
+	    return -1;
+	}
+	result = wait(&status);
+#else
+	result = wait3(&status, options, 0);
+#endif
+	if ((result == -1) && (errno == EINTR)) {
+	    continue;
+	}
+	if (result <= 0) {
+	    return result;
+	}
+
+	if ((pid != result) && (pid != -1)) {
+	    goto saveInfo;
+	}
+	if (!(options & WUNTRACED) && (WIFSTOPPED(status))) {
+	    goto saveInfo;
+	}
+	*statusPtr = *((int *) &status);
+	return result;
+
+	/*
+	 * Can't return this info to caller.  Save it in the list of
+	 * stopped or exited processes.  Tricky point: first check for
+	 * an existing entry for the process and overwrite it if it
+	 * exists (e.g. a previously stopped process might now be dead).
+	 */
+
+	saveInfo:
+	for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
+	    if (waitPtr->pid == result) {
+		waitPtr->status = status;
+		goto waitAgain;
+	    }
+	}
+	waitPtr = (WaitInfo *) ckalloc(sizeof(WaitInfo));
+	waitPtr->pid = result;
+	waitPtr->status = status;
+	waitPtr->nextPtr = deadList;
+	deadList = waitPtr;
+
+	waitAgain: continue;
+    }
+}
diff --git a/tcl/configure b/tcl/configure
new file mode 100755
index 00000000000..c7b3e661c15
--- /dev/null
+++ b/tcl/configure
@@ -0,0 +1,989 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.13"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set.  These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=generic/tcl.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+  if test "x$prefix" != xNONE; then
+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+  else
+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+  fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+  if test -f $ac_dir/install-sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f $ac_dir/install.sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:552: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+  case $nonopt in
+  NONE)
+    if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+    else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+    fi ;;
+  *) host_alias=$nonopt ;;
+  esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+case "${host}" in
+*-*-cygwin*)
+	CONFIGDIR="win"
+	
+	CONFIGDIR2="cygwin"
+	
+	;;
+*-*-mingw32*)
+	CONFIGDIR="win"
+	
+	;;
+*)
+	CONFIGDIR="unix"
+	
+	ac_aux_dir=
+for ac_dir in $CONFIGDIR $srcdir/$CONFIGDIR; do
+  if test -f $ac_dir/install-sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f $ac_dir/install.sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  { echo "configure: error: can not find install-sh or install.sh in $CONFIGDIR $srcdir/$CONFIGDIR" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+	
+	;;
+esac
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:610: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftestmake <<\EOF
+all:
+	@echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+  eval ac_cv_prog_make_${ac_make}_set=yes
+else
+  eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  SET_MAKE=
+else
+  echo "$ac_t""no" 1>&6
+  SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+subdirs="$CONFIGDIR $CONFIGDIR2"
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  case `(ac_space=' '; set | grep ac_space) 2>&1` in
+  *ac_space=\ *)
+    # `set' does not quote correctly, so add quotes (double-quote substitution
+    # turns \\\\ into \\, and sed turns \\ into \).
+    sed -n \
+      -e "s/'/'\\\\''/g" \
+      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+    ;;
+  *)
+    # `set' quotes correctly as required by POSIX, so do not add quotes.
+    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+    ;;
+  esac >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ 	`~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.13"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@CONFIGDIR@%$CONFIGDIR%g
+s%@CONFIGDIR2@%$CONFIGDIR2%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@subdirs@%$subdirs%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+  if test $ac_beg -gt 1; then
+    sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+  else
+    sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+  fi
+  if test ! -s conftest.s$ac_file; then
+    ac_more_lines=false
+    rm -f conftest.s$ac_file
+  else
+    if test -z "$ac_sed_cmds"; then
+      ac_sed_cmds="sed -f conftest.s$ac_file"
+    else
+      ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+    fi
+    ac_file=`expr $ac_file + 1`
+    ac_beg=$ac_end
+    ac_end=`expr $ac_end + $ac_max_sed_cmds`
+  fi
+done
+if test -z "$ac_sed_cmds"; then
+  ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+if test "$no_recursion" != yes; then
+
+  # Remove --cache-file and --srcdir arguments so they do not pile up.
+  ac_sub_configure_args=
+  ac_prev=
+  for ac_arg in $ac_configure_args; do
+    if test -n "$ac_prev"; then
+      ac_prev=
+      continue
+    fi
+    case "$ac_arg" in
+    -cache-file | --cache-file | --cache-fil | --cache-fi \
+    | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+      ac_prev=cache_file ;;
+    -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+    | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+      ;;
+    -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+      ac_prev=srcdir ;;
+    -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+      ;;
+    *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+    esac
+  done
+
+  for ac_config_dir in $CONFIGDIR $CONFIGDIR2; do
+
+    # Do not complain, so a configure script can configure whichever
+    # parts of a large source tree are present.
+    if test ! -d $srcdir/$ac_config_dir; then
+      continue
+    fi
+
+    echo configuring in $ac_config_dir
+
+    case "$srcdir" in
+    .) ;;
+    *)
+      if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+      else
+        { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+      fi
+      ;;
+    esac
+
+    ac_popdir=`pwd`
+    cd $ac_config_dir
+
+      # A "../" for each directory in /$ac_config_dir.
+      ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+    case "$srcdir" in
+    .) # No --srcdir option.  We are building in place.
+      ac_sub_srcdir=$srcdir ;;
+    /*) # Absolute path.
+      ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+    *) # Relative path.
+      ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+    esac
+
+    # Check for guested configure; otherwise get Cygnus style configure.
+    if test -f $ac_sub_srcdir/configure; then
+      ac_sub_configure=$ac_sub_srcdir/configure
+    elif test -f $ac_sub_srcdir/configure.in; then
+      ac_sub_configure=$ac_configure
+    else
+      echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+      ac_sub_configure=
+    fi
+
+    # The recursion is here.
+    if test -n "$ac_sub_configure"; then
+
+      # Make the cache file name correct relative to the subdirectory.
+      case "$cache_file" in
+      /*) ac_sub_cache_file=$cache_file ;;
+      *) # Relative path.
+        ac_sub_cache_file="$ac_dots$cache_file" ;;
+      esac
+
+      echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+      # The eval makes quoting arguments work.
+      if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+      then :
+      else
+        { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+      fi
+    fi
+
+    cd $ac_popdir
+  done
+fi
+
diff --git a/tcl/configure.in b/tcl/configure.in
new file mode 100644
index 00000000000..4286ff547fd
--- /dev/null
+++ b/tcl/configure.in
@@ -0,0 +1,33 @@
+dnl This file is used as input to autoconf to generate configure.
+dnl The only reason we need this is that the Tcl directory structure
+dnl changed in 7.5, and this change lets us avoid changing the
+dnl configuration superstructure.
+dnl Tom Tromey <tromey@cygnus.com>
+
+AC_PREREQ(2.5)
+
+AC_INIT(generic/tcl.h)
+
+AC_CANONICAL_HOST
+
+case "${host}" in
+*-*-cygwin*)
+	CONFIGDIR="win"
+	AC_SUBST(CONFIGDIR)
+	CONFIGDIR2="cygwin"
+	AC_SUBST(CONFIGDIR2)
+	;;
+*-*-mingw32*)
+	CONFIGDIR="win"
+	AC_SUBST(CONFIGDIR)
+	;;
+*)
+	CONFIGDIR="unix"
+	AC_SUBST(CONFIGDIR)
+	AC_CONFIG_AUX_DIR($CONFIGDIR)	
+	;;
+esac
+
+AC_PROG_MAKE_SET
+AC_CONFIG_SUBDIRS($CONFIGDIR $CONFIGDIR2)
+AC_OUTPUT(Makefile)
diff --git a/tcl/doc/AddErrInfo.3 b/tcl/doc/AddErrInfo.3
new file mode 100644
index 00000000000..993b5dc62a9
--- /dev/null
+++ b/tcl/doc/AddErrInfo.3
@@ -0,0 +1,166 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_AddErrorInfo 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+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_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR)
+.sp
+\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR)
+.sp
+char *
+\fBTcl_PosixError\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *message
+.AP Tcl_Interp *interp in
+Interpreter in which to record information.
+.AP char *message in
+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.
+.BE
+
+.SH DESCRIPTION
+.PP
+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.
+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
+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_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
+to the application, it will contain a complete trace
+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_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_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_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
+\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
+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.
+The caller must previously have called \fBTcl_SetErrno\fR to set
+\fBerrno\fR; this is necessary on some platforms (e.g. Windows) where Tcl
+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 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
+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_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_AddObjErrorInfo\fR is called
+for an error, it clears the existing value of \fBerrorInfo\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\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
+(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_DecrRefCount, Tcl_IncrRefCount, Tcl_Interp, Tcl_ResetResult, Tcl_SetErrno
+
+.SH KEYWORDS
+error, object, object result, stack, trace, variable
diff --git a/tcl/doc/Alloc.3 b/tcl/doc/Alloc.3
new file mode 100644
index 00000000000..ce114516091
--- /dev/null
+++ b/tcl/doc/Alloc.3
@@ -0,0 +1,52 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Alloc, Tcl_Free, Tcl_Realloc \- allocate or free heap memory
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_Alloc\fR(\fIsize\fR)
+.sp
+\fBTcl_Free\fR(\fIptr\fR)
+.sp
+char *
+\fBTcl_Realloc\fR(\fIptr, size\fR)
+.SH ARGUMENTS
+.AS char *size
+.AP int size in
+Size in bytes of the memory block to allocate.
+.AP char *ptr in
+Pointer to memory block to free or realloc.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures provide a platform and compiler independent interface
+for memory allocation.  Programs that need to transfer ownership of
+memory blocks between Tcl and other modules should use these routines
+rather than the native \fBmalloc()\fR and \fBfree()\fR routines
+provided by the C run-time library.
+.PP
+\fBTcl_Alloc\fR returns a pointer to a block of at least \fIsize\fR
+bytes suitably aligned for any use.
+.PP
+\fBTcl_Free\fR makes the space referred to by \fIptr\fR available for
+further allocation.
+.PP
+\fBTcl_Realloc\fR changes the size of the block pointed to by
+\fIptr\fR to \fIsize\fR bytes and returns a pointer to the new block.
+The contents will be unchanged up to the lesser of the new and old
+sizes.  The returned location may be different from \fIptr\fR.
+.SH KEYWORDS
+alloc, allocation, free, malloc, memory, realloc
diff --git a/tcl/doc/AllowExc.3 b/tcl/doc/AllowExc.3
new file mode 100644
index 00000000000..d035d0e50d8
--- /dev/null
+++ b/tcl/doc/AllowExc.3
@@ -0,0 +1,42 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_AllowExceptions 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_AllowExceptions \- allow all exceptions in next script evaluation
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_AllowExceptions\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *doublePtr
+.AP Tcl_Interp *interp in
+Interpreter in which script will be evaluated.
+.BE
+
+.SH DESCRIPTION
+.PP
+If a script is evaluated at top-level (i.e. no other scripts are
+pending evaluation when the script is invoked), and if the script
+terminates with a completion code other than TCL_OK, TCL_CONTINUE
+or TCL_RETURN, then Tcl normally converts this into a TCL_ERROR
+return with an appropriate message.
+.PP
+However, if \fBTcl_AllowExceptions\fR is invoked immediately before
+calling a procedure such as \fBTcl_Eval\fR, then arbitrary completion
+codes are permitted from the script, and they are returned without
+modification.
+This is useful in cases where the caller can deal with exceptions
+such as TCL_BREAK or TCL_CONTINUE in a meaningful way.
+
+.SH KEYWORDS
+continue, break, exception, interpreter
diff --git a/tcl/doc/AppInit.3 b/tcl/doc/AppInit.3
new file mode 100644
index 00000000000..66295a760fb
--- /dev/null
+++ b/tcl/doc/AppInit.3
@@ -0,0 +1,73 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_AppInit \- perform application-specific initialization
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_AppInit\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Interpreter for the application.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_AppInit\fR is a ``hook'' procedure that is invoked by
+the main programs for Tcl applications such as \fBtclsh\fR and \fBwish\fR.
+Its purpose is to allow new Tcl applications to be created without
+modifying the main programs provided as part of Tcl and Tk.
+To create a new application you write a new version of
+\fBTcl_AppInit\fR to replace the default version provided by Tcl,
+then link your new \fBTcl_AppInit\fR with the Tcl library.
+.PP
+\fBTcl_AppInit\fR is invoked after by \fBTcl_Main\fR and \fBTk_Main\fR
+after their own initialization and before entering the main loop
+to process commands.
+Here are some examples of things that \fBTcl_AppInit\fR might do:
+.IP [1]
+Call initialization procedures for various packages used by
+the application.
+Each initialization procedure adds new commands to \fIinterp\fR
+for its package and performs other package-specific initialization.
+.IP [2]
+Process command-line arguments, which can be accessed from the
+Tcl variables \fBargv\fR and \fBargv0\fR in \fIinterp\fR.
+.IP [3]
+Invoke a startup script to initialize the application.
+.LP
+\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.
+.PP
+In addition to \fBTcl_AppInit\fR, your application should also contain
+a procedure \fBmain\fR that calls \fBTcl_Main\fR as follows:
+.CS
+Tcl_Main(argc, argv, Tcl_AppInit);
+.CE
+The third argument to \fBTcl_Main\fR gives the address of the
+application-specific initialization procedure to invoke.
+This means that you don't have to use the name \fBTcl_AppInit\fR
+for the procedure, but in practice the name is nearly always
+\fBTcl_AppInit\fR (in versions before Tcl 7.4 the name \fBTcl_AppInit\fR
+was implicit;  there was no way to specify the procedure explicitly).
+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.
+
+.SH KEYWORDS
+application, argument, command, initialization, interpreter
diff --git a/tcl/doc/AssocData.3 b/tcl/doc/AssocData.3
new file mode 100644
index 00000000000..8636597f04e
--- /dev/null
+++ b/tcl/doc/AssocData.3
@@ -0,0 +1,89 @@
+'\"
+'\" 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.
+'\" 
+'\" 
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage
+associations of string keys and user specified data with Tcl
+interpreters.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+ClientData
+\fBTcl_GetAssocData\fR(\fIinterp, key, delProcPtr\fR)
+.sp
+\fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR)
+.sp
+\fBTcl_DeleteAssocData\fR(\fIinterp, key\fR)
+.SH ARGUMENTS
+.AS Tcl_InterpDeleteProc *delProcPtr
+.AP Tcl_Interp *interp in
+Interpreter in which to execute the specified command.
+.AP char *key in
+Key for association with which to store data or from which to delete or
+retrieve data.  Typically the module prefix for a package.
+.AP Tcl_InterpDeleteProc *delProc in
+Procedure to call when \fIinterp\fR is deleted.
+.AP Tcl_InterpDeleteProc **delProcPtr in
+Pointer to location in which to store address of current deletion procedure
+for association.  Ignored if NULL.
+.AP ClientData clientData in
+Arbitrary one-word value associated with the given key in this
+interpreter.  This data is owned by the caller.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures allow extensions to associate their own data with
+a Tcl interpreter.
+An association consists of a string key, typically the name of
+the extension, and a one-word value, which is typically a pointer
+to a data structure holding data specific to the extension.
+Tcl makes no interpretation of either the key or the value for
+an association.
+.PP
+Storage management is facilitated by storing with each association a
+procedure to call when the interpreter is deleted. This
+procedure can dispose of the storage occupied by the client's data in any
+way it sees fit.
+.PP
+\fBTcl_SetAssocData\fR creates an association between a string
+key and a user specified datum in the given interpreter.
+If there is already an association with the given \fIkey\fR,
+\fBTcl_SetAssocData\fR overwrites it with the new information.
+It is up to callers to organize their use of names to avoid conflicts,
+for example, by using package names as the keys.
+If the \fIdeleteProc\fR argument is non-NULL it specifies the address of a
+procedure to invoke if the interpreter is deleted before the association
+is deleted.  \fIDeleteProc\fR should have arguments and result that match
+the type \fBTcl_InterpDeleteProc\fR:
+.CS
+typedef void Tcl_InterpDeleteProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR);
+.CE
+When \fIdeleteProc\fR is invoked the \fIclientData\fR and \fIinterp\fR
+arguments will be the same as the corresponding arguments passed to
+\fBTcl_SetAssocData\fR.
+The deletion procedure will \fInot\fR be invoked if the association
+is deleted before the interpreter is deleted.
+.PP
+\fBTcl_GetAssocData\fR returns the datum stored in the association with the
+specified key in the given interpreter, and if the \fIdelProcPtr\fR field
+is non-\fBNULL\fR, the address indicated by it gets the address of the
+delete procedure stored with this association. If no association with the
+specified key exists in the given interpreter \fBTcl_GetAssocData\fR
+returns \fBNULL\fR.
+.PP
+\fBTcl_DeleteAssocData\fR deletes an association with a specified key in
+the given interpreter.  It does not call the deletion procedure.
+.SH KEYWORDS
+association, data, deletion procedure, interpreter, key
diff --git a/tcl/doc/Async.3 b/tcl/doc/Async.3
new file mode 100644
index 00000000000..0d6658677fe
--- /dev/null
+++ b/tcl/doc/Async.3
@@ -0,0 +1,156 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete \- handle asynchronous events
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_AsyncHandler
+\fBTcl_AsyncCreate\fR(\fIproc, clientData\fR)
+.sp
+\fBTcl_AsyncMark\fR(\fIasync\fR)
+.sp
+int
+\fBTcl_AsyncInvoke\fR(\fIinterp, code\fR)
+.sp
+\fBTcl_AsyncDelete\fR(\fIasync\fR)
+.sp
+int
+\fBTcl_AsyncReady\fR()
+.SH ARGUMENTS
+.AS Tcl_AsyncHandler clientData
+.AP Tcl_AsyncProc *proc in
+Procedure to invoke to handle an asynchronous event.
+.AP ClientData clientData in
+One-word value to pass to \fIproc\fR.
+.AP Tcl_AsyncHandler async in
+Token for asynchronous event handler.
+.AP Tcl_Interp *interp in
+Tcl interpreter in which command was being evaluated when handler was
+invoked, or NULL if handler was invoked when there was no interpreter
+active.
+.AP int code in
+Completion code from command that just completed in \fIinterp\fR,
+or 0 if \fIinterp\fR is NULL.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures provide a safe mechanism for dealing with
+asynchronous events such as signals.
+If an event such as a signal occurs while a Tcl script is being
+evaluated then it isn't safe to take any substantive action to
+process the event.
+For example, it isn't safe to evaluate a Tcl script since the
+interpreter may already be in the middle of evaluating a script;
+it may not even be safe to allocate memory, since a memory
+allocation could have been in progress when the event occurred.
+The only safe approach is to set a flag indicating that the event
+occurred, then handle the event later when the world has returned
+to a clean state, such as after the current Tcl command completes.
+.PP
+\fBTcl_AsyncCreate\fR creates an asynchronous handler and returns
+a token for it.
+The asynchronous handler must be created before
+any occurrences of the asynchronous event that it is intended
+to handle (it is not safe to create a handler at the time of
+an event).
+When an asynchronous event occurs the code that detects the event
+(such as a signal handler) should call \fBTcl_AsyncMark\fR with the
+token for the handler.
+\fBTcl_AsyncMark\fR will mark the handler as ready to execute, but it
+will not invoke the handler immediately.
+Tcl will call the \fIproc\fR associated with the handler later, when
+the world is in a safe state, and \fIproc\fR can then carry out
+the actions associated with the asynchronous event.
+\fIProc\fR should have arguments and result that match the
+type \fBTcl_AsyncProc\fR:
+.CS
+typedef int Tcl_AsyncProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	int \fIcode\fR);
+.CE
+The \fIclientData\fR will be the same as the \fIclientData\fR
+argument passed to \fBTcl_AsyncCreate\fR when the handler was
+created.
+If \fIproc\fR is invoked just after a command has completed
+execution in an interpreter, then \fIinterp\fR will identify
+the interpreter in which the command was evaluated and
+\fIcode\fR will be the completion code returned by that
+command.
+The command's result will be present in \fIinterp->result\fR.
+When \fIproc\fR returns, whatever it leaves in \fIinterp->result\fR
+will be returned as the result of the command and the integer
+value returned by \fIproc\fR will be used as the new completion
+code for the command.
+.PP
+It is also possible for \fIproc\fR to be invoked when no interpreter
+is active.
+This can happen, for example, if an asynchronous event occurs while
+the application is waiting for interactive input or an X event.
+In this case \fIinterp\fR will be NULL and \fIcode\fR will be
+0, and the return value from \fIproc\fR will be ignored.
+.PP
+The procedure \fBTcl_AsyncInvoke\fR is called to invoke all of the
+handlers that are ready.
+The procedure \fBTcl_AsyncReady\fR will return non-zero whenever any
+asynchronous handlers are ready;  it can be checked to avoid calls
+to \fBTcl_AsyncInvoke\fR when there are no ready handlers.
+Tcl calls \fBTcl_AsyncReady\fR after each command is evaluated
+and calls \fBTcl_AsyncInvoke\fR if needed.
+Applications may also call \fBTcl_AsyncInvoke\fR at interesting
+times for that application.
+For example, Tcl's event handler calls \fBTcl_AsyncReady\fR
+after each event and calls \fBTcl_AsyncInvoke\fR if needed.
+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
+that just completed.
+.PP
+\fBTcl_AsyncDelete\fR removes an asynchronous handler so that
+its \fIproc\fR will never be invoked again.
+A handler can be deleted even when ready, and it will still
+not be invoked.
+.PP
+If multiple handlers become active at the same time, the
+handlers are invoked in the order they were created (oldest
+handler first).
+The \fIcode\fR and \fIinterp->result\fR for later handlers
+reflect the values returned by earlier handlers, so that
+the most recently created handler has last say about
+the interpreter's result and completion code.
+If new handlers become ready while handlers are executing,
+\fBTcl_AsyncInvoke\fR will invoke them all;  at each point it
+invokes the highest-priority (oldest) ready handler, repeating
+this over and over until there are no longer any ready handlers.
+
+.SH WARNING
+.PP
+It is almost always a bad idea for an asynchronous event
+handler to modify \fIinterp->result\fR or return a code different
+from its \fIcode\fR argument.
+This sort of behavior can disrupt the execution of scripts in
+subtle ways and result in bugs that are extremely difficult
+to track down.
+If an asynchronous event handler needs to evaluate Tcl scripts
+then it should first save \fIinterp->result\fR plus the values
+of the variables \fBerrorInfo\fR and \fBerrorCode\fR (this can
+be done, for example, by storing them in dynamic strings).
+When the asynchronous handler is finished it should restore
+\fIinterp->result\fR, \fBerrorInfo\fR, and \fBerrorCode\fR,
+and return the \fIcode\fR argument.
+
+.SH KEYWORDS
+asynchronous event, handler, signal
diff --git a/tcl/doc/BackgdErr.3 b/tcl/doc/BackgdErr.3
new file mode 100644
index 00000000000..3fa59f8ef61
--- /dev/null
+++ b/tcl/doc/BackgdErr.3
@@ -0,0 +1,58 @@
+'\"
+'\" Copyright (c) 1992-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_BackgroundError \- report Tcl error that occurred in background processing
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_BackgroundError\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Interpreter in which the error occurred.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is typically invoked when a Tcl error occurs during
+``background processing'' such as executing an event handler.
+When such an error occurs, the error condition is reported to Tcl
+or to a widget or some other C code, and there is not usually any
+obvious way for that code to report the error to the user.
+In these cases the code calls \fBTcl_BackgroundError\fR with an
+\fIinterp\fR argument identifying the interpreter in which the
+error occurred.  At the time \fBTcl_BackgroundError\fR is invoked,
+\fIinterp->result\fR is expected to contain an error message.
+\fBTcl_BackgroundError\fR will invoke the \fBbgerror\fR
+Tcl command to report the error in an application-specific fashion.
+If no \fBbgerror\fR command exists, or if it returns with an error condition,
+then \fBTcl_BackgroundError\fR reports the error itself by printing
+a message on the standard error file.
+.PP
+\fBTcl_BackgroundError\fR does not invoke \fBbgerror\fR immediately
+because this could potentially interfere with scripts that are in process
+at the time the error occurred.
+Instead, it invokes \fBbgerror\fR later as an idle callback.
+\fBTcl_BackgroundError\fR saves the values of the \fBerrorInfo\fR and
+\fBerrorCode\fR variables and restores these values just before
+invoking \fBbgerror\fR.
+.PP
+It is possible for many background errors to accumulate before
+\fBbgerror\fR is invoked.  When this happens, each of the errors
+is processed in order.  However, if \fBbgerror\fR returns a
+break exception, then all remaining error reports for the
+interpreter are skipped.
+
+.SH KEYWORDS
+background, bgerror, error
diff --git a/tcl/doc/Backslash.3 b/tcl/doc/Backslash.3
new file mode 100644
index 00000000000..ceeddea3323
--- /dev/null
+++ b/tcl/doc/Backslash.3
@@ -0,0 +1,45 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Backslash 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Backslash \- parse a backslash sequence
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char
+\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
+.SH ARGUMENTS
+.AS char *countPtr
+.AP char *src in
+Pointer to a string starting with a backslash.
+.AP int *countPtr out
+If \fIcountPtr\fR isn't NULL, \fI*countPtr\fR gets filled
+in with number of characters in the backslash sequence, including
+the backslash character.
+.BE
+
+.SH DESCRIPTION
+.PP
+This is a utility procedure used by several of the Tcl
+commands.  It parses a backslash sequence and returns
+the single character corresponding to the sequence.
+\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number
+of characters in the backslash sequence.
+.PP
+See the Tcl manual entry for information on the valid
+backslash sequences.
+All of the sequences described in the Tcl
+manual entry are supported by \fBTcl_Backslash\fR.
+
+.SH KEYWORDS
+backslash, parse
diff --git a/tcl/doc/BoolObj.3 b/tcl/doc/BoolObj.3
new file mode 100644
index 00000000000..43a308a39ba
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/CallDel.3 b/tcl/doc/CallDel.3
new file mode 100644
index 00000000000..c5e4804e88c
--- /dev/null
+++ b/tcl/doc/CallDel.3
@@ -0,0 +1,63 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interpreter is deleted
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_CallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR)
+.sp
+\fBTcl_DontCallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR)
+.SH ARGUMENTS
+.AS Tcl_InterpDeleteProc clientData
+.AP Tcl_Interp *interp in
+Interpreter with which to associated callback.
+.AP Tcl_InterpDeleteProc *proc in
+Procedure to call when \fIinterp\fR is deleted.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CallWhenDeleted\fR arranges for \fIproc\fR to be called by
+\fBTcl_DeleteInterp\fR if/when \fIinterp\fR is deleted at some future
+time.  \fIProc\fR will be invoked just before the interpreter
+is deleted, but the interpreter will still be valid at the
+time of the call.
+\fIProc\fR should have arguments and result that match the
+type \fBTcl_InterpDeleteProc\fR:
+.CS
+typedef void Tcl_InterpDeleteProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR);
+.CE
+The \fIclientData\fR and \fIinterp\fR parameters are
+copies of the \fIclientData\fR and \fIinterp\fR arguments given
+to \fBTcl_CallWhenDeleted\fR.
+Typically, \fIclientData\fR points to an application-specific
+data structure that \fIproc\fR uses to perform cleanup when an
+interpreter is about to go away.
+\fIProc\fR does not return a value.
+.PP
+\fBTcl_DontCallWhenDeleted\fR cancels a previous call to
+\fBTcl_CallWhenDeleted\fR with the same arguments, so that
+\fIproc\fR won't be called after all when \fIinterp\fR is
+deleted.
+If there is no deletion callback that matches \fIinterp\fR,
+\fIproc\fR, and \fIclientData\fR then the call to
+\fBTcl_DontCallWhenDeleted\fR has no effect.
+
+.SH KEYWORDS
+callback, delete, interpreter
diff --git a/tcl/doc/CmdCmplt.3 b/tcl/doc/CmdCmplt.3
new file mode 100644
index 00000000000..3147926a10d
--- /dev/null
+++ b/tcl/doc/CmdCmplt.3
@@ -0,0 +1,36 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CommandComplete \- Check for unmatched braces in a Tcl command
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_CommandComplete\fR(\fIcmd\fR)
+.SH ARGUMENTS
+.AS char *cmd
+.AP char *cmd in
+Command string to test for completeness.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CommandComplete\fR takes a Tcl command string
+as argument and determines whether it contains one or more
+complete commands (i.e. there are no unclosed quotes, braces,
+brackets, or variable references).
+If the command string is complete then it returns 1; otherwise it returns 0.
+
+.SH KEYWORDS
+complete command, partial command
diff --git a/tcl/doc/Concat.3 b/tcl/doc/Concat.3
new file mode 100644
index 00000000000..8c81cf02bf7
--- /dev/null
+++ b/tcl/doc/Concat.3
@@ -0,0 +1,55 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Concat \- concatenate a collection of strings
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_Concat\fR(\fIargc, argv\fR)
+.SH ARGUMENTS
+.AP int argc in
+Number of strings.
+.AP char *argv[] in
+Array of strings to concatenate.  Must have \fIargc\fR entries.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_Concat\fR is a utility procedure used by several of the
+Tcl commands.  Given a collection of strings, it concatenates
+them together into a single string, with the original strings
+separated by spaces.  This procedure behaves differently than
+\fBTcl_Merge\fR, in that the arguments are simply concatenated:
+no effort is made to ensure proper list structure.
+However, in most common usage the arguments will all be proper
+lists themselves;  if this is true, then the result will also have
+proper list structure.
+.PP
+\fBTcl_Concat\fR eliminates leading and trailing white space as it
+copies strings from \fBargv\fR to the result.  If an element of
+\fBargv\fR consists of nothing but white space, then that string
+is ignored entirely.  This white-space removal was added to make
+the output of the \fBconcat\fR command cleaner-looking.
+.PP
+.VS
+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/tcl/doc/CrtChannel.3 b/tcl/doc/CrtChannel.3
new file mode 100644
index 00000000000..17e9079bb64
--- /dev/null
+++ b/tcl/doc/CrtChannel.3
@@ -0,0 +1,571 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.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_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, instanceData, mask\fR)
+.sp
+ClientData
+\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
+.sp
+Tcl_ChannelType *
+\fBTcl_GetChannelType\fR(\fIchannel\fR)
+.sp
+char *
+\fBTcl_GetChannelName\fR(\fIchannel\fR)
+.VS
+.sp
+int
+\fBTcl_GetChannelHandle\fR(\fIchannel, direction, handlePtr\fR)
+.VE
+.sp
+int
+\fBTcl_GetChannelFlags\fR(\fIchannel\fR)
+.sp
+\fBTcl_SetDefaultTranslation\fR(\fIchannel, transMode\fR)
+.sp
+int
+\fBTcl_GetChannelBufferSize\fR(\fIchannel\fR)
+.sp
+\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_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.
+.AP char *channelName in
+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 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 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
+.PP
+Tcl uses a two-layered channel architecture. It provides a generic upper
+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 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
+functions implementing the various operations used by the generic layer to
+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 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
+that opens a channel by invoking \fBTcl_CreateChannel\fR.
+When your driver calls \fBTcl_CreateChannel\fR it passes in
+a \fBTcl_ChannelType\fR structure describing the driver's I/O
+procedures.
+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 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
+\fBTcl_GetChannelInstanceData\fR returns the instance data associated with
+the channel in \fIchannel\fR. This is the same as the \fIinstanceData\fR
+argument in the call to \fBTcl_CreateChannel\fR that created this channel.
+.PP
+\fBTcl_GetChannelType\fR returns a pointer to the \fBTcl_ChannelType\fR
+structure used by the channel in the \fIchannel\fR argument. This is
+the same as the \fItypePtr\fR argument in the call to
+\fBTcl_CreateChannel\fR that created this channel.
+.PP
+\fBTcl_GetChannelName\fR returns a string containing the name associated
+with the channel, or NULL if the \fIchannelName\fR argument to
+\fBTcl_CreateChannel\fR was NULL.
+.PP
+.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
+if an attempt is made to output on the channel while it is still in
+\fBTCL_TRANSLATE_AUTO\fR mode. For a description of end of line translation
+modes, see the manual entry for \fBfconfigure\fR.
+.PP
+\fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers
+allocated to store input or output in \fIchan\fR. If the value was not set
+by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then
+the default value of 4096 is returned.
+.PP
+\fBTcl_SetChannelBufferSize\fR sets the size, in bytes, of buffers that
+will be allocated in subsequent operations on the channel to store input or
+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
+A channel driver provides a \fBTcl_ChannelType\fR structure that contains
+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;
+	Tcl_DriverBlockModeProc *\fIblockModeProc\fR;	
+	Tcl_DriverCloseProc *\fIcloseProc\fR;
+	Tcl_DriverInputProc *\fIinputProc\fR;
+	Tcl_DriverOutputProc *\fIoutputProc\fR;
+	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
+\fIgetOptionProc\fR, which may be specified as NULL to indicate that the
+channel does not support seeking.  Other functions that can not be
+implemented for this type of device should return \fBEINVAL\fR when invoked
+to indicate that they are not implemented.
+
+.SH TYPENAME
+.PP
+The \fItypeName\fR field contains a null-terminated string that
+identifies the type of the device implemented by this driver, e.g.
+\fBfile\fR or \fBsocket\fR.
+
+.SH BLOCKMODEPROC
+.PP
+The \fIblockModeProc\fR field contains the address of a function called by
+the generic layer to set blocking and nonblocking mode on the device.
+\fIBlockModeProc\fR should match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverBlockModeProc(
+	ClientData \fIinstanceData\fR,
+	int \fImode\fR);
+.CE
+.PP
+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 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.
+
+.SH CLOSEPROC
+.PP
+The \fIcloseProc\fR field contains the address of a function called by the
+generic layer to clean up driver-related information when the channel is
+closed. \fICloseProc\fR must match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverCloseProc(
+	ClientData \fIinstanceData\fR,
+	Tcl_Interp *\fIinterp\fR);
+.CE
+.PP
+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
+The \fIinputProc\fR field contains the address of a function called by the
+generic layer to read data from the file or device and store it in an
+internal buffer. \fIInputProc\fR must match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverInputProc(
+	ClientData \fIinstanceData\fR,
+	char *\fIbuf\fR,
+	int \fIbufSize\fR,
+	int *\fIerrorCodePtr\fR);
+.CE
+.PP
+\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
+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 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
+function should only attempt to read as much data as is available and
+return without blocking. If the input device has no data available
+whatsoever and the channel is in nonblocking mode, the function should
+return an \fBEAGAIN\fR error. If the input device has no data available
+whatsoever and the channel is in blocking mode, the function should block
+for the shortest possible time until at least one byte of data can be read
+from the device; then, it should return as much data as it can read without
+blocking.
+
+.SH OUTPUTPROC
+.PP
+The \fIoutputProc\fR field contains the address of a function called by the
+generic layer to transfer data from an internal buffer to the output device.
+\fIOutputProc\fR must match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverOutputProc(
+	ClientData \fIinstanceData\fR,
+	char *\fIbuf\fR,
+	int \fItoWrite\fR,
+	int *\fIerrorCodePtr\fR);
+.CE
+.PP
+\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
+\fIbuf\fR argument.
+.PP
+The \fIerrorCodePtr\fR argument points to an integer variable provided by
+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
+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
+without writing any data.
+
+.SH SEEKPROC
+.PP
+The \fIseekProc\fR field contains the address of a function called by the
+generic layer to move the access point at which subsequent input or output
+operations will be applied. \fISeekProc\fR must match the following
+prototype:
+.PP
+.CS
+typedef int Tcl_DriverSeekProc(
+	ClientData \fIinstanceData\fR,
+	long \fIoffset\fR,
+	int \fIseekMode\fR,
+	int *\fIerrorCodePtr\fR);
+.CE
+.PP
+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.
+.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.
+
+.SH SETOPTIONPROC
+.PP
+The \fIsetOptionProc\fR field contains the address of a function called by
+the generic layer to set a channel type specific option on a channel.
+\fIsetOptionProc\fR must match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverSetOptionProc(
+	ClientData \fIinstanceData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	char *\fIoptionName\fR,
+	char *\fIoptionValue\fR);
+.CE
+.PP
+\fIoptionName\fR is the name of an option to set, and \fIoptionValue\fR is
+the new value for that option, as a string. The \fIinstanceData\fR is the
+same as the value given to \fBTcl_CreateChannel\fR when this channel was
+created. The function should do whatever channel type specific action is
+required to implement the new value of the option.
+.PP
+Some options are handled by the generic code and this function is never
+called to set them, e.g. \fB-blockmode\fR. Other options are specific to
+each channel type and the \fIsetOptionProc\fR procedure of the channel
+driver will get called to implement them. The \fIsetOptionProc\fR field can
+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.
+.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.
+
+.SH GETOPTIONPROC
+.PP
+The \fIgetOptionProc\fR field contains the address of a function called by
+the generic layer to get the value of a channel type specific option on a
+channel. \fIgetOptionProc\fR must match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverGetOptionProc(
+	ClientData \fIinstanceData\fR,
+.VS
+	Tcl_Interp *\fIinterp\fR,
+.VE
+	char *\fIoptionName\fR,
+	Tcl_DString *\fIdsPtr\fR);
+.CE
+.PP
+\fIOptionName\fR is the name of an option supported by this type of
+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. 
+.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
+specific to each channel type and the \fIgetOptionProc\fR procedure of the
+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_QueueEvent(3)
+
+.SH KEYWORDS
+blocking, channel driver, channel registration, channel type, nonblocking
diff --git a/tcl/doc/CrtChnlHdlr.3 b/tcl/doc/CrtChnlHdlr.3
new file mode 100644
index 00000000000..f3b1d96d4df
--- /dev/null
+++ b/tcl/doc/CrtChnlHdlr.3
@@ -0,0 +1,92 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH Tcl_CreateChannelHandler 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_CreateChannelHandler, Tcl_DeleteChannelHandler \- call a procedure when a channel becomes readable or writable
+.SH SYNOPSIS
+.nf
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_CreateChannelHandler\fR(\fIchannel, mask, proc, clientData\fR)
+.sp
+void
+\fBTcl_DeleteChannelHandler\fR(\fIchannel, proc, clientData\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_ChannelProc clientData
+.AP Tcl_Channel channel in
+Tcl channel such as returned by \fBTcl_CreateChannel\fR.
+.AP int mask in
+Conditions under which \fIproc\fR should be called: OR-ed combination of
+\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. Specify
+a zero value to temporarily disable an existing handler.
+.AP Tcl_FileProc *proc in
+Procedure to invoke whenever the channel indicated by \fIchannel\fR meets
+the conditions specified by \fImask\fR.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CreateChannelHandler\fR arranges for \fIproc\fR to be called in the
+future whenever input or output becomes possible on the channel identified
+by \fIchannel\fR, or whenever an exceptional condition exists for
+\fIchannel\fR. The conditions of interest under which \fIproc\fR will be
+invoked are specified by the \fImask\fR argument.
+See the manual entry for \fBfileevent\fR for a precise description of
+what it means for a channel to be readable or writable.
+\fIProc\fR must conform to the following prototype:
+.CS
+typedef void Tcl_ChannelProc(
+	ClientData \fIclientData\fR,
+	int \fImask\fR);
+.CE
+.PP
+The \fIclientData\fR argument is the same as the value passed to
+\fBTcl_CreateChannelHandler\fR when the handler was created. Typically,
+\fIclientData\fR points to a data structure containing application-specific
+information about the channel. \fIMask\fR is an integer mask indicating
+which of the requested conditions actually exists for the channel; it will
+contain a subset of the bits from the \fImask\fR argument to
+\fBTcl_CreateChannelHandler\fR when the handler was created.
+.PP
+Each channel handler is identified by a unique combination of \fIchannel\fR,
+\fIproc\fR and \fIclientData\fR.
+There may be many handlers for a given channel as long as they don't
+have the same \fIchannel\fR, \fIproc\fR, and \fIclientData\fR.
+If \fBTcl_CreateChannelHandler\fR is invoked when there is already a handler
+for \fIchannel\fR, \fIproc\fR, and \fIclientData\fR, then no new
+handler is created;  instead, the \fImask\fR is changed for the
+existing handler.
+.PP
+\fBTcl_DeleteChannelHandler\fR deletes a channel handler identified by
+\fIchannel\fR, \fIproc\fR and \fIclientData\fR; if no such handler exists,
+the call has no effect.
+.PP
+Channel handlers are invoked via the Tcl event mechanism, so they
+are only useful in applications that are event-driven.
+Note also that the conditions specified in the \fImask\fR argument
+to \fIproc\fR may no longer exist when \fIproc\fR is invoked:  for
+example, if there are two handlers for \fBTCL_READABLE\fR on the same
+channel, the first handler could consume all of the available input
+so that the channel is no longer readable when the second handler
+is invoked.
+For this reason it may be useful to use nonblocking I/O on channels
+for which there are event handlers.
+
+.SH "SEE ALSO"
+Notifier(3), Tcl_CreateChannel(3), Tcl_OpenFileChannel(3), vwait(n).
+
+.SH KEYWORDS
+blocking, callback, channel, events, handler, nonblocking.
diff --git a/tcl/doc/CrtCloseHdlr.3 b/tcl/doc/CrtCloseHdlr.3
new file mode 100644
index 00000000000..ebe003869b1
--- /dev/null
+++ b/tcl/doc/CrtCloseHdlr.3
@@ -0,0 +1,59 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH Tcl_CreateCloseHandler 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_CreateCloseHandler, Tcl_DeleteCloseHandler \- arrange for callbacks when channels are closed
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_CreateCloseHandler\fR(\fIchannel, proc, clientData\fR)
+.sp
+void
+\fBTcl_DeleteCloseHandler\fR(\fIchannel, proc, clientData\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_CloseProc callbackData in
+.AP Tcl_Channel channel in
+The channel for which to create or delete a close callback.
+.AP Tcl_CloseProc *proc in
+The procedure to call as the callback.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CreateCloseHandler\fR arranges for \fIproc\fR to be called when
+\fIchannel\fR is closed with \fBTcl_Close\fR or
+\fBTcl_UnregisterChannel\fR, or using the Tcl \fBclose\fR command.
+\fIProc\fR should match the following prototype:
+.PP
+.CS
+typedef void Tcl_CloseProc(
+	ClientData \fIclientData\fR);
+.CE
+.PP
+The \fIclientData\fR is the same as the value provided in the call to
+\fBTcl_CreateCloseHandler\fR.
+.PP
+\fBTcl_DeleteCloseHandler\fR removes a close callback for \fIchannel\fR.
+The \fIproc\fR and \fIclientData\fR identify which close callback to
+remove; \fBTcl_DeleteCloseHandler\fR does nothing if its \fIproc\fR and
+\fIclientData\fR arguments do not match the \fIproc\fR and \fIclientData\fR
+for a  close handler for \fIchannel\fR.
+
+.SH "SEE ALSO"
+close(n), Tcl_Close(3), Tcl_UnregisterChannel(3)
+
+.SH KEYWORDS
+callback, channel closing
diff --git a/tcl/doc/CrtCommand.3 b/tcl/doc/CrtCommand.3
new file mode 100644
index 00000000000..a2946854ac3
--- /dev/null
+++ b/tcl/doc/CrtCommand.3
@@ -0,0 +1,143 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CreateCommand \- implement new commands in C
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Command
+\fBTcl_CreateCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
+.SH ARGUMENTS
+.AS Tcl_CmdDeleteProc **deleteProcPtr
+.AP Tcl_Interp *interp in
+Interpreter in which to create new command.
+.AP char *cmdName in
+Name of command.
+.AP Tcl_CmdProc *proc in
+Implementation of 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.
+.BE
+
+.SH DESCRIPTION
+.PP
+\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.
+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.
+\fIProc\fR should have arguments and result that match the type
+\fBTcl_CmdProc\fR:
+.CS
+typedef int Tcl_CmdProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	int \fIargc\fR,
+	char *\fIargv\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_CreateCommand\fR.
+Typically, \fIclientData\fR points to an application-specific
+data structure that describes what to do when the command procedure
+is invoked.  \fIArgc\fR and \fIargv\fR describe the arguments to
+the command, \fIargc\fR giving the number of arguments (including
+the command name) and \fIargv\fR giving the values of the arguments
+as strings.  The \fIargv\fR array will contain \fIargc\fR+1 values;
+the first \fIargc\fR values point to the argument strings, and the
+last value is NULL.  
+.VS
+Note that the argument strings should not be modified as they may
+point to constant strings or may be shared with other parts of the
+interpreter.
+.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, \fIproc\fR must set
+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 the interpreter result
+field is managed, see the \fBTcl_Interp\fR man page.
+Before invoking a command procedure,
+\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
+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 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.
+.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,
+or by replacing \fIcmdName\fR in another call to \fBTcl_CreateCommand\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_CreateCommand\fR.
+.PP
+
+.SH "SEE ALSO"
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
+
+.SH KEYWORDS
+bind, command, create, delete, interpreter, namespace
diff --git a/tcl/doc/CrtFileHdlr.3 b/tcl/doc/CrtFileHdlr.3
new file mode 100644
index 00000000000..5744397a6d2
--- /dev/null
+++ b/tcl/doc/CrtFileHdlr.3
@@ -0,0 +1,100 @@
+'\"
+'\" Copyright (c) 1990-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+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(\fIfd, mask, proc, clientData\fR)
+.sp
+\fBTcl_DeleteFileHandler\fR(\fIfd\fR)
+.VE
+.SH ARGUMENTS
+.AS Tcl_FileProc clientData
+.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,
+and \fBTCL_EXCEPTION\fR.  May be set to 0 to temporarily disable
+a handler.
+.AP Tcl_FileProc *proc in
+Procedure to invoke whenever the file or device indicated
+by \fIfile\fR meets the conditions specified by \fImask\fR.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.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 \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.
+The callback to \fIproc\fR is made by \fBTcl_DoOneEvent\fR, so
+\fBTcl_CreateFileHandler\fR is only useful in programs that dispatch
+events through \fBTcl_DoOneEvent\fR or through Tcl commands such
+as \fBvwait\fR.
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTcl_FileProc\fR:
+.CS
+typedef void Tcl_FileProc(
+	ClientData \fIclientData\fR,
+	int \fImask\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy
+of the \fIclientData\fR
+argument given to \fBTcl_CreateFileHandler\fR when the callback
+was created.  Typically, \fIclientData\fR points to a data
+structure containing application-specific information about
+the file.  \fIMask\fR is an integer mask indicating which
+of the requested conditions actually exists for the file;  it
+will contain a subset of the bits in the \fImask\fR argument
+to \fBTcl_CreateFileHandler\fR.
+.PP
+.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 \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 \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
+correctly, the application may need to use non-blocking I/O operations on
+the files for which handlers are declared.  Otherwise the application may
+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/tcl/doc/CrtInterp.3 b/tcl/doc/CrtInterp.3
new file mode 100644
index 00000000000..bc7e9cca53a
--- /dev/null
+++ b/tcl/doc/CrtInterp.3
@@ -0,0 +1,131 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpDeleted \- create and delete Tcl command interpreters
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Interp *
+\fBTcl_CreateInterp\fR()
+.sp
+\fBTcl_DeleteInterp\fR(\fIinterp\fR)
+.sp
+int
+\fBTcl_InterpDeleted\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Token for interpreter to be destroyed.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CreateInterp\fR creates a new interpreter structure and returns
+a token for it.  The token is required in calls to most other Tcl
+procedures, such as \fBTcl_CreateCommand\fR, \fBTcl_Eval\fR, and
+\fBTcl_DeleteInterp\fR.
+Clients are only allowed to access a few of the fields of
+Tcl_Interp structures;  see the Tcl_Interp
+and \fBTcl_CreateCommand\fR man pages for details.
+The new interpreter is initialized with no defined variables and only
+the built-in Tcl commands.  To bind in additional commands, call
+\fBTcl_CreateCommand\fR.
+.PP
+\fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter
+will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have
+been matched by calls to \fBTcl_Release\fR. At that time, all of the
+resources associated with it, including variables, procedures, and
+application-specific command bindings, will be deleted.  After
+\fBTcl_DeleteInterp\fR returns any attempt to use \fBTcl_Eval\fR on the
+interpreter will fail and return \fBTCL_ERROR\fR. After the call to
+\fBTcl_DeleteInterp\fR it is safe to examine \fIinterp->result\fR, query or
+set the values of variables, define, undefine or retrieve procedures, and
+examine the runtime evaluation stack. See below, in the section
+\fBINTERPRETERS AND MEMORY MANAGEMENT\fR for details.
+.PP
+\fBTcl_InterpDeleted\fR returns nonzero if \fBTcl_DeleteInterp\fR was
+called with \fIinterp\fR as its argument; this indicates that the
+interpreter will eventually be deleted, when the last call to
+\fBTcl_Preserve\fR for it is matched by a call to \fBTcl_Release\fR. If
+nonzero is returned, further calls to \fBTcl_Eval\fR in this interpreter
+will return \fBTCL_ERROR\fR.
+.PP
+\fBTcl_InterpDeleted\fR is useful in deletion callbacks to distinguish
+between when only the memory the callback is responsible for is being
+deleted and when the whole interpreter is being deleted. In the former case
+the callback may recreate the data being deleted, but this would lead to an
+infinite loop if the interpreter were being deleted.
+
+.SH "INTERPRETERS AND MEMORY MANAGEMENT"
+.PP
+\fBTcl_DeleteInterp\fR can be called at any time on an interpreter that may
+be used by nested evaluations and C code in various extensions. Tcl
+implements a simple mechanism that allows callers to use interpreters
+without worrying about the interpreter being deleted in a nested call, and
+without requiring special code to protect the interpreter, in most cases.
+This mechanism ensures that nested uses of an interpreter can safely
+continue using it even after \fBTcl_DeleteInterp\fR is called.
+.PP
+The mechanism relies on matching up calls to \fBTcl_Preserve\fR with calls
+to \fBTcl_Release\fR. If \fBTcl_DeleteInterp\fR has been called, only when
+the last call to \fBTcl_Preserve\fR is matched by a call to
+\fBTcl_Release\fR, will the interpreter be freed. See the manual entry for
+\fBTcl_Preserve\fR for a description of these functions.
+.PP
+The rules for when the user of an interpreter must call \fBTcl_Preserve\fR
+and \fBTcl_Release\fR are simple:
+.TP
+Interpreters Passed As Arguments
+Functions that are passed an interpreter as an argument can safely use the
+interpreter without any special protection. Thus, when you write an
+extension consisting of new Tcl commands, no special code is needed to
+protect interpreters received as arguments. This covers the majority of all
+uses.
+.TP
+Interpreter Creation And Deletion
+When a new interpreter is created and used in a call to \fBTcl_Eval\fR,
+\fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or
+\fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and
+\fBTcl_Release\fR should be wrapped around all uses of the interpreter.
+Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR
+has been called. To ensure that the interpreter is properly deleted when
+it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other
+code already called \fBTcl_DeleteInterp\fR; if not, call
+\fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code.
+Do not call \fBTcl_DeleteInterp\fR on an interpreter for which
+\fBTcl_InterpDeleted\fR returns nonzero.
+.TP
+Retrieving An Interpreter From A Data Structure
+When an interpreter is retrieved from a data structure (e.g. the client
+data of a callback) for use in \fBTcl_Eval\fR, \fBTcl_VarEval\fR,
+\fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of
+calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around
+all uses of the interpreter; it is unsafe to reuse the interpreter once
+\fBTcl_Release\fR has been called.  If an interpreter is stored inside a
+callback data structure, an appropriate deletion cleanup mechanism should
+be set up by the code that creates the data structure so that the
+interpreter is removed from the data structure (e.g. by setting the field
+to NULL) when the interpreter is deleted. Otherwise, you may be using an
+interpreter that has been freed and whose memory may already have been
+reused.
+.PP
+All uses of interpreters in Tcl and Tk have already been protected.
+Extension writers should ensure that their code also properly protects any
+additional interpreters used, as described above.
+
+.SH KEYWORDS
+command, create, delete, interpreter
+
+.SH "SEE ALSO"
+Tcl_Preserve(3), Tcl_Release(3)
diff --git a/tcl/doc/CrtMathFnc.3 b/tcl/doc/CrtMathFnc.3
new file mode 100644
index 00000000000..b35b883cf58
--- /dev/null
+++ b/tcl/doc/CrtMathFnc.3
@@ -0,0 +1,93 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateMathFunc 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CreateMathFunc \- Define a new math function for expressions
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
+.SH ARGUMENTS
+.AS Tcl_ValueType clientData
+.AP Tcl_Interp *interp in
+Interpreter in which new function will be defined.
+.AP char *name in
+Name for new function.
+.AP int numArgs in
+Number of arguments to new function;  also gives size of \fIargTypes\fR array.
+.AP Tcl_ValueType *argTypes in
+Points to an array giving the permissible types for each argument to
+function.
+.AP Tcl_MathProc *proc in
+Procedure that implements the function.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
+.BE
+
+.SH DESCRIPTION
+.PP
+Tcl allows a number of mathematical functions to be used in
+expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
+\fBTcl_CreateMathFunc\fR allows applications to add additional functions
+to those already provided by Tcl or to replace existing functions.
+\fIName\fR is the name of the function as it will appear in expressions.
+If \fIname\fR doesn't already exist as a function then a new function
+is created.  If it does exist, then the existing function is replaced.
+\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
+Each entry in the \fIargTypes\fR array must be either TCL_INT, TCL_DOUBLE,
+or TCL_EITHER to indicate whether the corresponding argument must be an
+integer, a double-precision floating value, or either, respectively.
+.PP
+Whenever the function is invoked in an expression Tcl will invoke
+\fIproc\fR.  \fIProc\fR should have arguments and result that match
+the type \fBTcl_MathProc\fR:
+.CS
+typedef int Tcl_MathProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	Tcl_Value *\fIargs\fR,
+	Tcl_Value *\fIresultPtr\fR);
+.CE
+.PP
+When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
+arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
+\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
+which describe the actual arguments to the function:
+.CS
+typedef struct Tcl_Value {
+	Tcl_ValueType \fItype\fR;
+	long \fIintValue\fR;
+	double \fIdoubleValue\fR;
+} Tcl_Value;
+.CE
+.PP
+The \fItype\fR field indicates the type of the argument and is
+either TCL_INT or TCL_DOUBLE.
+It will match the \fIargTypes\fR value specified for the function unless
+the \fIargTypes\fR value was TCL_EITHER. Tcl converts
+the argument supplied in the expression to the type requested in
+\fIargTypes\fR, if that is necessary.
+Depending on the value of the \fItype\fR field, the \fIintValue\fR
+or \fIdoubleValue\fR field will contain the actual value of the argument.
+.PP
+\fIProc\fR should compute its result and store it either as an integer
+in \fIresultPtr->intValue\fR or as a floating value in
+\fIresultPtr->doubleValue\fR.
+It should set also \fIresultPtr->type\fR to either TCL_INT or TCL_DOUBLE
+to indicate which value was set.
+Under normal circumstances \fIproc\fR should return TCL_OK.
+If an error occurs while executing the function, \fIproc\fR should
+return TCL_ERROR and leave an error message in \fIinterp->result\fR.
+
+.SH KEYWORDS
+expression, mathematical function
diff --git a/tcl/doc/CrtObjCmd.3 b/tcl/doc/CrtObjCmd.3
new file mode 100644
index 00000000000..74ec90bf6c0
--- /dev/null
+++ b/tcl/doc/CrtObjCmd.3
@@ -0,0 +1,248 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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,
+\fBTcl_DeleteCommandFromToken\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,
+\fBTcl_DeleteCommandFromToken\fR deletes the command
+from a command interpreter.
+It will delete a command even if that command has been renamed.
+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/tcl/doc/CrtSlave.3 b/tcl/doc/CrtSlave.3
new file mode 100644
index 00000000000..3c99cff1cf3
--- /dev/null
+++ b/tcl/doc/CrtSlave.3
@@ -0,0 +1,230 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+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
+.sp
+int
+\fBTcl_IsSafe\fR(\fIinterp\fR)
+.sp
+int
+\fBTcl_MakeSafe\fR(\fIinterp\fR)
+.sp
+Tcl_Interp *
+\fBTcl_CreateSlave\fR(\fIinterp, slaveName, isSafe\fR)
+.sp
+Tcl_Interp *
+\fBTcl_GetSlave\fR(\fIinterp, slaveName\fR)
+.sp
+Tcl_Interp *
+\fBTcl_GetMaster\fR(\fIinterp\fR)
+.sp
+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 **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
+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).
+.AP char *srcCmd in
+Name of source command for alias.
+.AP Tcl_Interp *targetInterp in
+Interpreter that contains the target command for an alias.
+.AP char *targetCmd in
+Name of target command for alias in \fItargetInterp\fR.
+.AP int argc in
+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.
+.AP char **targetCmdPtr out
+Pointer to location to store the address of the name of the target command
+for an alias.
+.AP int *argcPtr out
+Pointer to location to store count of additional arguments to be passed to
+the alias. The location is in storage owned by the caller.
+.AP char ***argvPtr out
+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 under which a hidden command is stored and with which it can be
+exposed or invoked.
+.VE
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are intended for access to the multiple interpreter
+facility from inside C programs. They enable managing multiple interpreters
+in a hierarchical relationship, and the management of aliases, commands
+that when invoked in one interpreter execute a command in another
+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 \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 \fIinterp\fR is ``safe'' (was created
+with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
+\fB0\fR otherwise.
+.PP
+\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.
+.PP
+\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
+\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
+to the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
+\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
+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
+.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, putting
+it under the name
+\fIcmdName\fR. 
+\fIHiddenCmdName\fR must be the name of an existing hidden
+command, or the operation will return \fBTCL_ERROR\fR and leave 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, under the name
+\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.
+Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
+namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
+leave an error message in the object result of \fIinterp\fR.
+The \fICmdName\fR will be looked up in the global namespace, and not
+relative to the current namespace, even if the current namespace is not the
+global one.
+If a hidden command whose name is \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
+.SH "SEE ALSO"
+For a description of the Tcl interface to multiple interpreters, see
+\fIinterp(n)\fR.
+
+.SH KEYWORDS
+alias, command, exposed commands, hidden commands, interpreter, invoke,
+master, slave, 
+
diff --git a/tcl/doc/CrtTimerHdlr.3 b/tcl/doc/CrtTimerHdlr.3
new file mode 100644
index 00000000000..bd03ea5eec3
--- /dev/null
+++ b/tcl/doc/CrtTimerHdlr.3
@@ -0,0 +1,76 @@
+'\"
+'\" Copyright (c) 1990 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CreateTimerHandler, Tcl_DeleteTimerHandler \- call a procedure at a
+given time
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_TimerToken
+\fBTcl_CreateTimerHandler\fR(\fImilliseconds, proc, clientData\fR)
+.sp
+\fBTcl_DeleteTimerHandler\fR(\fItoken\fR)
+.SH ARGUMENTS
+.AS Tcl_TimerToken milliseconds
+.AP int milliseconds  in
+How many milliseconds to wait before invoking \fIproc\fR.
+.AP Tcl_TimerProc *proc in
+Procedure to invoke after \fImilliseconds\fR have elapsed.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.AP Tcl_TimerToken token in
+Token for previously-created timer handler (the return value
+from some previous call to \fBTcl_CreateTimerHandler\fR).
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CreateTimerHandler\fR arranges for \fIproc\fR to be
+invoked at a time \fImilliseconds\fR milliseconds in the
+future.
+The callback to \fIproc\fR will be made by \fBTcl_DoOneEvent\fR,
+so \fBTcl_CreateTimerHandler\fR is only useful in programs that
+dispatch events through \fBTcl_DoOneEvent\fR or through Tcl commands
+such as \fBvwait\fR.
+The call to \fIproc\fR may not be made at the exact time given by
+\fImilliseconds\fR:  it will be made at the next opportunity
+after that time.  For example, if \fBTcl_DoOneEvent\fR isn't
+called until long after the time has elapsed, or if there
+are other pending events to process before the call to
+\fIproc\fR, then the call to \fIproc\fR will be delayed.
+.PP
+\fIProc\fR should have arguments and return value that match
+the type \fBTcl_TimerProc\fR:
+.CS
+typedef void Tcl_TimerProc(ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a
+copy of the \fIclientData\fR argument given to
+\fBTcl_CreateTimerHandler\fR when the callback
+was created.  Typically, \fIclientData\fR points to a data
+structure containing application-specific information about
+what to do in \fIproc\fR.
+.PP
+\fBTcl_DeleteTimerHandler\fR may be called to delete a
+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.
+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/tcl/doc/CrtTrace.3 b/tcl/doc/CrtTrace.3
new file mode 100644
index 00000000000..8c95ed22895
--- /dev/null
+++ b/tcl/doc/CrtTrace.3
@@ -0,0 +1,106 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CreateTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Trace
+\fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR)
+.sp
+\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
+.SH ARGUMENTS
+.AS Tcl_CmdTraceProc (clientData)()
+.AP Tcl_Interp *interp in
+Interpreter containing command to be traced or untraced.
+.AP int level in
+Only commands at or below this nesting level will be traced.  1 means
+top-level commands only, 2 means top-level commands or those that are
+invoked as immediate consequences of executing top-level commands
+(procedure bodies, bracketed commands, etc.) and so on.
+.AP Tcl_CmdTraceProc *proc in
+Procedure to call for each command that's executed.  See below for
+details on the calling sequence.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.AP Tcl_Trace trace in
+Token for trace to be removed (return value from previous call
+to \fBTcl_CreateTrace\fR).
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_CreateTrace\fR arranges for command tracing.  From now on, \fIproc\fR
+will be invoked before Tcl calls command procedures to process
+commands in \fIinterp\fR.  The return value from
+\fBTcl_CreateTrace\fR is a token for the trace,
+which may be passed to \fBTcl_DeleteTrace\fR to remove the trace.  There may
+be many traces in effect simultaneously for the same command interpreter.
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTcl_CmdTraceProc\fR:
+.CS
+typedef void Tcl_CmdTraceProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	int \fIlevel\fR,
+	char *\fIcommand\fR,
+	Tcl_CmdProc *\fIcmdProc\fR,
+	ClientData \fIcmdClientData\fR,
+	int \fIargc\fR,
+	char *\fIargv\fR[]);
+.CE
+The \fIclientData\fR and \fIinterp\fR parameters are
+copies of the corresponding arguments given to \fBTcl_CreateTrace\fR.
+\fIClientData\fR typically points to an application-specific
+data structure that describes what to do when \fIproc\fR
+is invoked.  \fILevel\fR gives the nesting level of the command
+(1 for top-level commands passed to \fBTcl_Eval\fR by the application,
+2 for the next-level commands passed to \fBTcl_Eval\fR as part of parsing
+or interpreting level-1 commands, and so on).  \fICommand\fR
+points to a string containing the text of the
+command, before any argument substitution.
+\fICmdProc\fR contains the address of the command procedure that
+will be called to process the command (i.e. the \fIproc\fR argument
+of some previous call to \fBTcl_CreateCommand\fR) and \fIcmdClientData\fR
+contains the associated client data for \fIcmdProc\fR (the \fIclientData\fR
+value passed to \fBTcl_CreateCommand\fR).  \fIArgc\fR and \fIargv\fR give
+the final argument information that will be passed to \fIcmdProc\fR, after
+command, variable, and backslash substitution.
+\fIProc\fR must not modify the \fIcommand\fR or \fIargv\fR strings.
+.PP
+Tracing will only occur for commands at nesting level less than
+or equal to the \fIlevel\fR parameter (i.e. the \fIlevel\fR
+parameter to \fIproc\fR will always be less than or equal to the
+\fIlevel\fR parameter to \fBTcl_CreateTrace\fR).
+.PP
+Calls to \fIproc\fR will be made by the Tcl parser immediately before
+it calls the command procedure for the command (\fIcmdProc\fR).  This
+occurs after argument parsing and substitution, so tracing for
+substituted commands occurs before tracing of the commands
+containing the substitutions.  If there is a syntax error in a
+command, or if there is no command procedure associated with a
+command name, then no tracing will occur for that command.  If a
+string passed to Tcl_Eval contains multiple commands (bracketed, or
+on different lines) then multiple calls to \fIproc\fR will occur,
+one for each command.  The \fIcommand\fR string for each of these
+trace calls will reflect only a single command, not the entire string
+passed to Tcl_Eval.
+.PP
+\fBTcl_DeleteTrace\fR removes a trace, so that no future calls will be
+made to the procedure associated with the trace.  After \fBTcl_DeleteTrace\fR
+returns, the caller should never again use the \fItrace\fR token.
+
+.SH KEYWORDS
+command, create, delete, interpreter, trace
diff --git a/tcl/doc/DString.3 b/tcl/doc/DString.3
new file mode 100644
index 00000000000..00b76bde315
--- /dev/null
+++ b/tcl/doc/DString.3
@@ -0,0 +1,145 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_DStringInit\fR(\fIdsPtr\fR)
+.sp
+char *
+\fBTcl_DStringAppend\fR(\fIdsPtr, string, length\fR)
+.sp
+char *
+\fBTcl_DStringAppendElement\fR(\fIdsPtr, string\fR)
+.sp
+\fBTcl_DStringStartSublist\fR(\fIdsPtr\fR)
+.sp
+\fBTcl_DStringEndSublist\fR(\fIdsPtr\fR)
+.sp
+int
+\fBTcl_DStringLength\fR(\fIdsPtr\fR)
+.sp
+char *
+\fBTcl_DStringValue\fR(\fIdsPtr\fR)
+.sp
+\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
+.sp
+\fBTcl_DStringFree\fR(\fIdsPtr\fR)
+.sp
+\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
+.sp
+\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_DString newLength
+.AP Tcl_DString *dsPtr in/out
+Pointer to structure that is used to manage a dynamic string.
+.AP char *string in
+Pointer to characters to add to dynamic string.
+.AP int length in
+Number of characters from string to add to dynamic string.  If -1,
+add all characters up to null terminating character.
+.AP int newLength in
+New length for dynamic string, not including null terminating
+character.
+.AP Tcl_Interp *interp in/out
+Interpreter whose result is to be set from or moved to the
+dynamic string.
+.BE
+
+.SH DESCRIPTION
+.PP
+Dynamic strings provide a mechanism for building up arbitrarily long
+strings by gradually appending information.  If the dynamic string is
+short then there will be no memory allocation overhead;  as the string
+gets larger, additional space will be allocated as needed.
+.PP
+\fBTcl_DStringInit\fR initializes a dynamic string to zero length.
+The Tcl_DString structure must have been allocated by the caller.
+No assumptions are made about the current state of the structure;
+anything already in it is discarded.
+If the structure has been used previously, \fBTcl_DStringFree\fR should
+be called first to free up any memory allocated for the old
+string.
+.PP
+\fBTcl_DStringAppend\fR adds new information to a dynamic string,
+allocating more memory for the string if needed.
+If \fIlength\fR is less than zero then everything in \fIstring\fR
+is appended to the dynamic string;  otherwise \fIlength\fR
+specifies the number of bytes to append.
+\fBTcl_DStringAppend\fR returns a pointer to the characters of
+the new string.  The string can also be retrieved from the
+\fIstring\fR field of the Tcl_DString structure.
+.PP
+\fBTcl_DStringAppendElement\fR is similar to \fBTcl_DStringAppend\fR
+except that it doesn't take a \fIlength\fR argument (it appends
+all of \fIstring\fR) and it converts the string to a proper list element
+before appending.
+\fBTcl_DStringAppendElement\fR adds a separator space before the
+new list element unless the new list element is the first in a
+list or sub-list (i.e. either the current string is empty, or it
+contains the single character ``{'', or the last two characters of
+the current string are `` {'').
+\fBTcl_DStringAppendElement\fR returns a pointer to the
+characters of the new string.
+.PP
+\fBTcl_DStringStartSublist\fR and \fBTcl_DStringEndSublist\fR can be
+used to create nested lists.
+To append a list element that is itself a sublist, first
+call \fBTcl_DStringStartSublist\fR, then call \fBTcl_DStringAppendElement\fR
+for each of the elements in the sublist, then call
+\fBTcl_DStringEndSublist\fR to end the sublist.
+\fBTcl_DStringStartSublist\fR appends a space character if needed,
+followed by an open brace;  \fBTcl_DStringEndSublist\fR appends
+a close brace.
+Lists can be nested to any depth.
+.PP
+\fBTcl_DStringLength\fR is a macro that returns the current length
+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
+.PP
+\fBTcl_DStringSetLength\fR changes the length of a dynamic string.
+If \fInewLength\fR is less than the string's current length, then
+the string is truncated.
+If \fInewLength\fR is greater than the string's current length,
+then the string will become longer and new space will be allocated
+for the string if needed.
+However, \fBTcl_DStringSetLength\fR will not initialize the new
+space except to provide a terminating null character;  it is up to the
+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.
+.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
+and reinitializes the string's value to an empty string.
+.PP
+\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
+the dynamic string given by \fIdsPtr\fR.  It does this by moving
+a pointer from \fIdsPtr\fR to \fIinterp->result\fR.
+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
+\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.
+
+.SH KEYWORDS
+append, dynamic string, free, result
diff --git a/tcl/doc/DetachPids.3 b/tcl/doc/DetachPids.3
new file mode 100644
index 00000000000..2aa97a616e5
--- /dev/null
+++ b/tcl/doc/DetachPids.3
@@ -0,0 +1,62 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DetachPids, Tcl_ReapDetachedProcs \- manage child processes in background
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_DetachPids\fR(\fInumPids, pidPtr\fR)
+.sp
+\fBTcl_ReapDetachedProcs\fR()
+.SH ARGUMENTS
+.AS int *statusPtr
+.AP int numPids in
+Number of process ids contained in the array pointed to by \fIpidPtr\fR.
+.AP int *pidPtr in
+Address of array containing \fInumPids\fR process ids.
+.BE
+
+.SH DESCRIPTION
+.PP
+\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
+eventually invoke the \fBwaitpid\fR kernel call (or one of a few other
+similar kernel calls) to wait for the child to exit.  Until the
+parent waits for the child, the child's state cannot be completely
+reclaimed by the system.  If a parent continually creates children
+and doesn't wait on them, the system's process table will eventually
+overflow, even if all the children have exited.
+.PP
+\fBTcl_DetachPids\fR may be called to ask Tcl to take responsibility
+for one or more processes whose process ids are contained in the
+\fIpidPtr\fR array passed as argument.  The caller presumably
+has started these processes running in background and doesn't
+want to have to deal with them again.
+.PP
+\fBTcl_ReapDetachedProcs\fR invokes the \fBwaitpid\fR kernel call
+on each of the background processes so that its state can be cleaned
+up if it has exited.  If the process hasn't exited yet,
+\fBTcl_ReapDetachedProcs\fR doesn't wait for it to exit;  it will check again
+the next time it is invoked.
+Tcl automatically calls \fBTcl_ReapDetachedProcs\fR each time the
+\fBexec\fR command is executed, so in most cases it isn't necessary
+for any code outside of Tcl to invoke \fBTcl_ReapDetachedProcs\fR.
+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.
+
+.SH KEYWORDS
+background, child, detach, process, wait
diff --git a/tcl/doc/DoOneEvent.3 b/tcl/doc/DoOneEvent.3
new file mode 100644
index 00000000000..868126af7ce
--- /dev/null
+++ b/tcl/doc/DoOneEvent.3
@@ -0,0 +1,108 @@
+'\"
+'\" Copyright (c) 1990-1992 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DoOneEvent \- wait for events and invoke event handlers
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_DoOneEvent\fR(\fIflags\fR)
+.SH ARGUMENTS
+.AS int flags
+.AP int flags in
+This parameter is normally zero.  It may be an OR-ed combination
+of any of the following flag bits:  
+TCL_WINDOW_EVENTS,
+TCL_FILE_EVENTS, TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, TCL_ALL_EVENTS, or
+TCL_DONT_WAIT.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is the entry point to Tcl's event loop; it is responsible for
+waiting for events and dispatching event handlers created with
+procedures such as \fBTk_CreateEventHandler\fR, \fBTcl_CreateFileHandler\fR,
+\fBTcl_CreateTimerHandler\fR, and \fBTcl_DoWhenIdle\fR.
+\fBTcl_DoOneEvent\fR checks to see if
+events are already present on the Tcl event queue; if so,
+it calls the handler(s) for the first (oldest) event, removes it from
+the queue, and returns.
+If there are no events ready to be handled, then \fBTcl_DoOneEvent\fR
+checks for new events from all possible sources.
+If any are found, it puts all of them on Tcl's event queue, calls
+handlers for the first event on the queue, and returns.
+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 
+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).
+.PP
+If the \fIflags\fR argument to \fBTcl_DoOneEvent\fR is non-zero,
+it restricts the kinds of events that will be processed by
+\fBTcl_DoOneEvent\fR.
+\fIFlags\fR may be an OR-ed combination of any of the following bits:
+.TP 27
+\fBTCL_WINDOW_EVENTS\fR \-
+Process window system events.
+.TP 27
+\fBTCL_FILE_EVENTS\fR \-
+Process file events.
+.TP 27
+\fBTCL_TIMER_EVENTS\fR \-
+Process timer events.
+.TP 27
+\fBTCL_IDLE_EVENTS\fR \-
+Process idle callbacks.
+.TP 27
+\fBTCL_ALL_EVENTS\fR \-
+Process all kinds of events:  equivalent to OR-ing together all of the
+above flags or specifying none of them.
+.TP 27
+\fBTCL_DONT_WAIT\fR \-
+Don't sleep:  process only events that are ready at the time of the
+call.
+.LP
+If any of the flags \fBTCL_WINDOW_EVENTS\fR, \fBTCL_FILE_EVENTS\fR,
+\fBTCL_TIMER_EVENTS\fR, or \fBTCL_IDLE_EVENTS\fR is set, then the only
+events that will be considered are those for which flags are set.
+Setting none of these flags is equivalent to the value
+\fBTCL_ALL_EVENTS\fR, which causes all event types to be processed.
+If an application has defined additional event sources with
+\fBTcl_CreateEventSource\fR, then additional \fIflag\fR values
+may also be valid, depending on those event sources.
+.PP
+The \fBTCL_DONT_WAIT\fR flag causes \fBTcl_DoOneEvent\fR not to put
+the process to sleep:  it will check for events but if none are found
+then it returns immediately with a return value of 0 to indicate
+that no work was done.
+\fBTcl_DoOneEvent\fR will also return 0 without doing anything if
+the only alternative is to block forever (this can happen, for example,
+if \fIflags\fR is \fBTCL_IDLE_EVENTS\fR and there are no
+\fBTcl_DoWhenIdle\fR callbacks pending, or if no event handlers or
+timer handlers exist).
+.PP
+\fBTcl_DoOneEvent\fR may be invoked recursively.  For example,
+it is possible to invoke \fBTcl_DoOneEvent\fR recursively
+from a handler called by \fBTcl_DoOneEvent\fR.  This sort
+of operation is useful in some modal situations, such
+as when a
+notification dialog has been popped up and an application wishes to
+wait for the user to click a button in the dialog before
+doing anything else.
+
+.SH KEYWORDS
+callback, event, handler, idle, timer
diff --git a/tcl/doc/DoWhenIdle.3 b/tcl/doc/DoWhenIdle.3
new file mode 100644
index 00000000000..bf58fec8f3c
--- /dev/null
+++ b/tcl/doc/DoWhenIdle.3
@@ -0,0 +1,86 @@
+'\"
+'\" Copyright (c) 1990 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR)
+.sp
+\fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR)
+.SH ARGUMENTS
+.AS Tcl_IdleProc clientData
+.AP Tcl_IdleProc *proc in
+Procedure to invoke.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
+when the application becomes idle.  The application is
+considered to be idle when \fBTcl_DoOneEvent\fR has been
+called, couldn't find any events to handle, and is about
+to go to sleep waiting for an event to occur.  At this
+point all pending \fBTcl_DoWhenIdle\fR handlers are
+invoked.  For each call to \fBTcl_DoWhenIdle\fR there will
+be a single call to \fIproc\fR;  after \fIproc\fR is
+invoked the handler is automatically removed.
+\fBTcl_DoWhenIdle\fR is only usable in programs that
+use \fBTcl_DoOneEvent\fR to dispatch events.
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTcl_IdleProc\fR:
+.CS
+typedef void Tcl_IdleProc(ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
+argument given to \fBTcl_DoWhenIdle\fR.  Typically, \fIclientData\fR
+points to a data structure containing application-specific information about
+what \fIproc\fR should do.
+.PP
+\fBTcl_CancelIdleCall\fR
+may be used to cancel one or more previous
+calls to \fBTcl_DoWhenIdle\fR:  if there is a \fBTcl_DoWhenIdle\fR
+handler registered for \fIproc\fR and \fIclientData\fR, then it
+is removed without invoking it.  If there is more than one
+handler on the idle list that refers to \fIproc\fR and \fIclientData\fR,
+all of the handlers are removed.  If no existing handlers match
+\fIproc\fR and \fIclientData\fR then nothing happens.
+.PP
+\fBTcl_DoWhenIdle\fR is most useful in situations where
+(a) a piece of work will have to be done but (b) it's
+possible that something will happen in the near future
+that will change what has to be done or require something
+different to be done.  \fBTcl_DoWhenIdle\fR allows the
+actual work to be deferred until all pending events have
+been processed.  At this point the exact work to be done
+will presumably be known and it can be done exactly once.
+.PP
+For example, \fBTcl_DoWhenIdle\fR might be used by an editor
+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
+continuously.  This will interact badly with certain features of Tk
+that attempt to wait for all idle callbacks to complete.  If you would
+like for an idle callback to reschedule itself continuously, it is
+better to use a timer handler with a zero timeout period.
+
+.SH KEYWORDS
+callback, defer, idle callback
diff --git a/tcl/doc/DoubleObj.3 b/tcl/doc/DoubleObj.3
new file mode 100644
index 00000000000..339bd302f8b
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/Eval.3 b/tcl/doc/Eval.3
new file mode 100644
index 00000000000..6a374bb9fdc
--- /dev/null
+++ b/tcl/doc/Eval.3
@@ -0,0 +1,114 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Eval 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Eval, Tcl_VarEval, Tcl_EvalFile, Tcl_GlobalEval \- execute Tcl commands
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_Eval\fR(\fIinterp, cmd\fR)
+.sp
+int
+\fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR)
+.sp
+int
+\fBTcl_EvalFile\fR(\fIinterp, fileName\fR)
+.sp
+int
+\fBTcl_GlobalEval\fR(\fIinterp, cmd\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp **termPtr;
+.AP Tcl_Interp *interp in
+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).
+.AP char *string in
+String forming part of Tcl command.
+.AP char *fileName in
+Name of file containing Tcl command string.
+.BE
+
+.SH DESCRIPTION
+.PP
+All four of these procedures execute Tcl commands.
+\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 (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.
+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
+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.
+If the file couldn't be read then a Tcl error is returned to describe
+why the file couldn't be read.
+.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_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 \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,
+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.
+
+.SH "SEE ALSO"
+Tcl_EvalObj, Tcl_GlobalEvalObj
+
+.SH KEYWORDS
+command, execute, file, global, object, object result, variable
diff --git a/tcl/doc/Exit.3 b/tcl/doc/Exit.3
new file mode 100644
index 00000000000..34cf336347b
--- /dev/null
+++ b/tcl/doc/Exit.3
@@ -0,0 +1,103 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Exit 3 7.7 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+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)
+.SH ARGUMENTS
+.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, any nonzero value
+usually means that an error occurred.
+.AP Tcl_ExitProc *proc in
+Procedure to invoke before exiting application.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+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_Finalize\fR and \fBTcl_Exit\fR.
+This provides a hook for cleanup operations such as flushing buffers
+and freeing global memory.
+\fIProc\fR should match the type \fBTcl_ExitProc\fR:
+.CS
+typedef void Tcl_ExitProc(ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a
+copy of the \fIclientData\fR argument given to
+\fBTcl_CreateExitHandler\fR when the callback
+was created.  Typically, \fIclientData\fR points to a data
+structure containing application-specific information about
+what to do in \fIproc\fR.
+.PP
+\fBTcl_DeleteExitHandler\fR may be called to delete a
+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, cleanup, dynamic loading, end application, exit, unloading
diff --git a/tcl/doc/ExprLong.3 b/tcl/doc/ExprLong.3
new file mode 100644
index 00000000000..903017488c2
--- /dev/null
+++ b/tcl/doc/ExprLong.3
@@ -0,0 +1,114 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an expression
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ExprLong\fR(\fIinterp, string, longPtr\fR)
+.sp
+int
+\fBTcl_ExprDouble\fR(\fIinterp, string, doublePtr\fR)
+.sp
+int
+\fBTcl_ExprBoolean\fR(\fIinterp, string, booleanPtr\fR)
+.sp
+int
+\fBTcl_ExprString\fR(\fIinterp, string\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *booleanPtr
+.AP Tcl_Interp *interp in
+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
+it undoes before returning).
+.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.
+.BE
+
+.SH DESCRIPTION
+.PP
+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 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
+evaluated, and \fBTCL_ERROR\fR means that an error occurred while
+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.
+.PP
+If the expression is successfully evaluated, then its value is
+returned in one of four forms, depending on which procedure
+is invoked.
+\fBTcl_ExprLong\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_ExprDouble\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_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 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
+\fBTcl_ExprString\fR returns the value of the expression as a
+string stored in \fIinterp->result\fR.
+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.
+
+.SH "SEE ALSO"
+Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj
+
+.SH KEYWORDS
+boolean, double, evaluate, expression, integer, object, string
diff --git a/tcl/doc/ExprLongObj.3 b/tcl/doc/ExprLongObj.3
new file mode 100644
index 00000000000..0769f223749
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/FindExec.3 b/tcl/doc/FindExec.3
new file mode 100644
index 00000000000..a79c6f33b72
--- /dev/null
+++ b/tcl/doc/FindExec.3
@@ -0,0 +1,56 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_FindExecutable 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_FindExecutable\fR(\fIargv0\fR)
+.sp
+CONST char *
+\fBTcl_GetNameOfExecutable\fR()
+.SH ARGUMENTS
+.AS char *argv0 in
+.AP char *argv0 in
+The first command-line argument to the program, which gives the
+application's name.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBTcl_FindExecutable\fR procedure computes the full path name of
+the executable file from which the application was invoked and saves
+it for Tcl's internal use.
+The executable's path name is needed for several purposes in
+Tcl.  For example, it is needed on some platforms in the
+implementation of the \fBload\fR command.
+It is also returned by the \fBinfo nameofexecutable\fR command.
+.PP
+On UNIX platforms this procedure is typically invoked as the very
+first thing in the application's main program;  it must be passed
+\fIargv[0]\fR as its argument.  \fBTcl_FindExecutable\fR uses \fIargv0\fR
+along with the \fBPATH\fR environment variable to find the
+application's executable, if possible.  If it fails to find
+the binary, then future calls to \fBinfo nameofexecutable\fR
+will return an empty string.
+.PP
+\fBTcl_GetNameOfExecutable\fR simply returns a pointer to the
+internal full path name of the executable file as computed by
+\fBTcl_FindExecutable\fR.  This procedure call is the C API
+equivalent to the \fBinfo nameofexecutable\fR command.  NULL
+is returned if the internal full path name has not been
+computed or unknown.
+
+.SH KEYWORDS
+binary, executable file
diff --git a/tcl/doc/GetIndex.3 b/tcl/doc/GetIndex.3
new file mode 100644
index 00000000000..53ac14baf47
--- /dev/null
+++ b/tcl/doc/GetIndex.3
@@ -0,0 +1,77 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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 "SEE ALSO"
+Tcl_WrongNumArgs
+
+.SH KEYWORDS
+index, object, table lookup
diff --git a/tcl/doc/GetInt.3 b/tcl/doc/GetInt.3
new file mode 100644
index 00000000000..cceca7c080d
--- /dev/null
+++ b/tcl/doc/GetInt.3
@@ -0,0 +1,81 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, double, or boolean
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_GetInt\fR(\fIinterp, string, intPtr\fR)
+.sp
+int
+\fBTcl_GetDouble\fR(\fIinterp, string, doublePtr\fR)
+.sp
+int
+\fBTcl_GetBoolean\fR(\fIinterp, string, boolPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *doublePtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP char *string in
+Textual value to be converted.
+.AP int *intPtr out
+Points to place to store integer value converted from \fIstring\fR.
+.AP double *doublePtr out
+Points to place to store double-precision floating-point
+value converted from \fIstring\fR.
+.AP int *boolPtr out
+Points to place to store boolean value (0 or 1) converted from \fIstring\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures convert from strings to integers or double-precision
+floating-point values or booleans (represented as 0- or 1-valued
+integers).  Each of the procedures takes a \fIstring\fR argument,
+converts it to an internal form of a particular type, and stores
+the converted value at the location indicated by the procedure's
+third argument.  If all goes well, each of the procedures returns
+TCL_OK.  If \fIstring\fR doesn't have the proper syntax for the
+desired type then TCL_ERROR is returned, an error message is left
+in \fIinterp->result\fR, and nothing is stored at *\fIintPtr\fR
+or *\fIdoublePtr\fR or *\fIboolPtr\fR.
+.PP
+\fBTcl_GetInt\fR expects \fIstring\fR to consist of a collection
+of integer digits, optionally signed and optionally preceded by
+white space.  If the first two characters of \fIstring\fR are ``0x''
+then \fIstring\fR is expected to be in hexadecimal form;  otherwise,
+if the first character of \fIstring\fR is ``0'' then \fIstring\fR
+is expected to be in octal form;  otherwise, \fIstring\fR is
+expected to be in decimal form.
+.PP
+\fBTcl_GetDouble\fR expects \fIstring\fR to consist of a floating-point
+number, which is:  white space;  a sign; a sequence of digits;  a
+decimal point;  a sequence of digits;  the letter ``e'';  and a
+signed decimal exponent.  Any of the fields may be omitted, except that
+the digits either before or after the decimal point must be present
+and if the ``e'' is present then it must be followed by the
+exponent number.
+.PP
+\fBTcl_GetBoolean\fR expects \fIstring\fR to specify a boolean
+value.  If \fIstring\fR is any of \fB0\fR, \fBfalse\fR,
+\fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero
+value at \fI*boolPtr\fR.
+If \fIstring\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
+then 1 is stored at \fI*boolPtr\fR.
+Any of these values may be abbreviated, and upper-case spellings
+are also acceptable.
+
+.SH KEYWORDS
+boolean, conversion, double, floating-point, integer
diff --git a/tcl/doc/GetOpnFl.3 b/tcl/doc/GetOpnFl.3
new file mode 100644
index 00000000000..d8366d06aa0
--- /dev/null
+++ b/tcl/doc/GetOpnFl.3
@@ -0,0 +1,61 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetOpenFile \- Get a standard IO File * handle from a channel. (Unix only)
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_GetOpenFile\fR(\fIinterp, string, write, checkUsage, filePtr\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_Interp checkUsage
+.AP Tcl_Interp *interp in
+Tcl interpreter from which file handle is to be obtained.
+.AP char *string in
+String identifying channel, such as \fBstdin\fR or \fBfile4\fR.
+.AP int write in
+Non-zero means the file will be used for writing, zero means it will
+be used for reading.
+.AP int checkUsage in
+If non-zero, then an error will be generated if the file wasn't opened
+for the access indicated by \fIwrite\fR.
+.AP ClientData *filePtr out
+Points to word in which to store pointer to FILE structure for
+the file given by \fIstring\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_GetOpenFile\fR takes as argument a file identifier of the form
+returned by the \fBopen\fR command and
+returns at \fI*filePtr\fR a pointer to the FILE structure for
+the file.
+The \fIwrite\fR argument indicates whether the FILE pointer will
+be used for reading or writing.
+In some cases, such as a channel that connects to a pipeline of
+subprocesses, different FILE pointers will be returned for reading
+and writing.
+\fBTcl_GetOpenFile\fR normally returns TCL_OK.
+If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIstring\fR didn't
+make any sense or \fIcheckUsage\fR was set and the file wasn't opened
+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/tcl/doc/GetStdChan.3 b/tcl/doc/GetStdChan.3
new file mode 100644
index 00000000000..7192e4243ed
--- /dev/null
+++ b/tcl/doc/GetStdChan.3
@@ -0,0 +1,73 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_GetStdChannel, Tcl_SetStdChannel \- procedures for retrieving and replacing the standard channels
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Channel
+\fBTcl_GetStdChannel\fR(\fItype\fR)
+.sp
+\fBTcl_SetStdChannel\fR(\fIchannel, type\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_Channel channel in
+.AP int type in
+The identifier for the standard channel to retrieve or modify.  Must be one of
+\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, or \fBTCL_STDERR\fR.
+.AP Tcl_Channel channel in
+The channel to use as the new value for the specified standard channel.
+.BE
+
+.SH DESCRIPTION
+.PP
+Tcl defines three special channels that are used by various I/O related
+commands if no other channels are specified.  The standard input channel
+has a channel name of \fBstdin\fR and is used by \fBread\fR and \fBgets\fR.
+The standard output channel is named \fBstdout\fR and is used by
+\fBputs\fR.  The standard error channel is named \fBstderr\fR and is used for 
+reporting errors.  In addition, the standard channels are inherited by any
+child processes created using \fBexec\fR or \fBopen\fR in the absence of any
+other redirections.
+.PP
+The standard channels are actually aliases for other normal channels.  The
+current channel associated with a standard channel can be retrieved by calling
+\fBTcl_GetStdChannel\fR with one of 
+\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, or \fBTCL_STDERR\fR as the \fItype\fR.  The
+return value will be a valid channel, or NULL.
+.PP
+A new channel can be set for the standard channel specified by \fItype\fR 
+by calling \fBTcl_SetStdChannel\fR with a new channel or NULL in the
+\fIchannel\fR argument.  If the specified channel is closed by a later call to
+\fBTcl_Close\fR, then the corresponding standard channel will automatically be
+set to NULL.
+.PP
+If \fBTcl_GetStdChannel\fR is called before \fBTcl_SetStdChannel\fR, Tcl will
+construct a new channel to wrap the appropriate platform-specific standard 
+file handle.  If \fBTcl_SetStdChannel\fR is called before
+\fBTcl_GetStdChannel\fR, then the default channel will not be created.
+.PP
+If one of the standard channels is set to NULL, either by calling
+\fBTcl_SetStdChannel\fR with a null \fIchannel\fR argument, or by calling
+\fBTcl_Close\fR on the channel, then the next call to \fBTcl_CreateChannel\fR
+will automatically set the standard channel with the newly created channel.  If
+more than one standard channel is NULL, then the standard channels will be
+assigned starting with standard input, followed by standard output, with
+standard error being last.
+
+.SH "SEE ALSO"
+Tcl_Close(3), Tcl_CreateChannel(3)
+
+.SH KEYWORDS
+standard channel, standard input, standard output, standard error
diff --git a/tcl/doc/Hash.3 b/tcl/doc/Hash.3
new file mode 100644
index 00000000000..13de0b9fcc2
--- /dev/null
+++ b/tcl/doc/Hash.3
@@ -0,0 +1,208 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_InitHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_InitHashTable\fR(\fItablePtr, keyType\fR)
+.sp
+\fBTcl_DeleteHashTable\fR(\fItablePtr\fR)
+.sp
+Tcl_HashEntry *
+\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
+.sp
+\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
+.sp
+Tcl_HashEntry *
+\fBTcl_FindHashEntry\fR(\fItablePtr, key\fR)
+.sp
+ClientData
+\fBTcl_GetHashValue\fR(\fIentryPtr\fR)
+.sp
+\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
+.sp
+char *
+\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
+.sp
+Tcl_HashEntry *
+\fBTcl_FirstHashEntry\fR(\fItablePtr, searchPtr\fR)
+.sp
+Tcl_HashEntry *
+\fBTcl_NextHashEntry\fR(\fIsearchPtr\fR)
+.sp
+char *
+\fBTcl_HashStats\fR(\fItablePtr\fR)
+.SH ARGUMENTS
+.AS Tcl_HashSearch *searchPtr
+.AP Tcl_HashTable *tablePtr in
+Address of hash table structure (for all procedures but
+\fBTcl_InitHashTable\fR, this must have been initialized by
+previous call to \fBTcl_InitHashTable\fR).
+.AP int keyType in
+Kind of keys to use for new hash table.  Must be either
+TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an integer value
+greater than 1.
+.AP char *key in
+Key to use for probe into table.  Exact form depends on
+\fIkeyType\fR used to create table.
+.AP int *newPtr out
+The word at \fI*newPtr\fR is set to 1 if a new entry was created
+and 0 if there was already an entry for \fIkey\fR.
+.AP Tcl_HashEntry *entryPtr in
+Pointer to hash table entry.
+.AP ClientData value in
+New value to assign to hash table entry.  Need not have type
+ClientData, but must fit in same space as ClientData.
+.AP Tcl_HashSearch *searchPtr in
+Pointer to record to use to keep track of progress in enumerating
+all the entries in a hash table.
+.BE
+
+.SH DESCRIPTION
+.PP
+A hash table consists of zero or more entries, each consisting of
+a key and a value.
+Given the key for an entry, the hashing routines can very quickly
+locate the entry, and hence its value.
+There may be at most one entry in a hash table with a
+particular key, but many entries may have the same value.
+Keys can take one of three forms:  strings,
+one-word values, or integer arrays.
+All of the keys in a given table have the same form, which is
+specified when the table is initialized.
+.PP
+The value of a hash table entry can be anything that fits in
+the same space as a ``char *'' pointer.
+Values for hash table entries are managed entirely by clients,
+not by the hash module itself.
+Typically each entry's value is a pointer to a data structure
+managed by client code.
+.PP
+Hash tables grow gracefully as the number of entries increases,
+so that there are always less than three entries per hash bucket,
+on average.
+This allows for fast lookups regardless of the number of entries
+in a table.
+.PP
+\fBTcl_InitHashTable\fR initializes a structure that describes
+a new hash table.
+The space for the structure is provided by the caller, not by
+the hash module.
+The value of \fIkeyType\fR indicates what kinds of keys will
+be used for all entries in the table.  \fIKeyType\fR must have
+one of the following values:
+.IP \fBTCL_STRING_KEYS\fR 25
+Keys are null-terminated ASCII strings.
+They are passed to hashing routines using the address of the
+first character of the string.
+.IP \fBTCL_ONE_WORD_KEYS\fR 25
+Keys are single-word values;  they are passed to hashing routines
+and stored in hash table entries as ``char *'' values.
+The pointer value is the key;  it need not (and usually doesn't)
+actually point to a string.
+.IP \fIother\fR 25
+If \fIkeyType\fR is not TCL_STRING_KEYS or TCL_ONE_WORD_KEYS,
+then it must be an integer value greater than 1.
+In this case the keys will be arrays of ``int'' values, where
+\fIkeyType\fR gives the number of ints in each key.
+This allows structures to be used as keys.
+All keys must have the same size.
+Array keys are passed into hashing functions using the address
+of the first int in the array.
+.PP
+\fBTcl_DeleteHashTable\fR deletes all of the entries in a hash
+table and frees up the memory associated with the table's
+bucket array and entries.
+It does not free the actual table structure (pointed to
+by \fItablePtr\fR), since that memory is assumed to be managed
+by the client.
+\fBTcl_DeleteHashTable\fR also does not free or otherwise
+manipulate the values of the hash table entries.
+If the entry values point to dynamically-allocated memory, then
+it is the client's responsibility to free these structures
+before deleting the table.
+.PP
+\fBTcl_CreateHashEntry\fR locates the entry corresponding to a
+particular key, creating a new entry in the table if there
+wasn't already one with the given key.
+If an entry already existed with the given key then \fI*newPtr\fR
+is set to zero.
+If a new entry was created, then \fI*newPtr\fR is set to a non-zero
+value and the value of the new entry will be set to zero.
+The return value from \fBTcl_CreateHashEntry\fR is a pointer to
+the entry, which may be used to retrieve and modify the entry's
+value or to delete the entry from the table.
+.PP
+\fBTcl_DeleteHashEntry\fR will remove an existing entry from a
+table.
+The memory associated with the entry itself will be freed, but
+the client is responsible for any cleanup associated with the
+entry's value, such as freeing a structure that it points to.
+.PP
+\fBTcl_FindHashEntry\fR is similar to \fBTcl_CreateHashEntry\fR
+except that it doesn't create a new entry if the key doesn't exist;
+instead, it returns NULL as result.
+.PP
+\fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to
+read and write an entry's value, respectively.
+Values are stored and retrieved as type ``ClientData'', which is
+large enough to hold a pointer value.  On almost all machines this is
+large enough to hold an integer value too.
+.PP
+\fBTcl_GetHashKey\fR returns the key for a given hash table entry,
+either as a pointer to a string, a one-word (``char *'') key, or
+as a pointer to the first word of an array of integers, depending
+on the \fIkeyType\fR used to create a hash table.
+In all cases \fBTcl_GetHashKey\fR returns a result with type
+``char *''.
+When the key is a string or array, the result of \fBTcl_GetHashKey\fR
+points to information in the table entry;  this information will
+remain valid until the entry is deleted or its table is deleted.
+.PP
+\fBTcl_FirstHashEntry\fR and \fBTcl_NextHashEntry\fR may be used
+to scan all of the entries in a hash table.
+A structure of type ``Tcl_HashSearch'', provided by the client,
+is used to keep track of progress through the table.
+\fBTcl_FirstHashEntry\fR initializes the search record and
+returns the first entry in the table (or NULL if the table is
+empty).
+Each subsequent call to \fBTcl_NextHashEntry\fR returns the
+next entry in the table or
+NULL if the end of the table has been reached.
+A call to \fBTcl_FirstHashEntry\fR followed by calls to
+\fBTcl_NextHashEntry\fR will return each of the entries in
+the table exactly once, in an arbitrary order.
+It is unadvisable to modify the structure of the table, e.g.
+by creating or deleting entries, while the search is in
+progress.
+.PP
+\fBTcl_HashStats\fR returns a dynamically-allocated string with
+overall information about a hash table, such as the number of
+entries it contains, the number of buckets in its hash array,
+and the utilization of the buckets.
+It is the caller's responsibility to free the result string
+by passing it to \fBfree\fR.
+.PP
+The header file \fBtcl.h\fR defines the actual data structures
+used to implement hash tables.
+This is necessary so that clients can allocate Tcl_HashTable
+structures and so that macros can be used to read and write
+the values of entries.
+However, users of the hashing routines should never refer directly
+to any of the fields of any of the hash-related data structures;
+use the procedures and macros defined here.
+
+.SH KEYWORDS
+hash table, key, lookup, search, value
diff --git a/tcl/doc/IntObj.3 b/tcl/doc/IntObj.3
new file mode 100644
index 00000000000..e94fd235b69
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/Interp.3 b/tcl/doc/Interp.3
new file mode 100644
index 00000000000..d608f7f5943
--- /dev/null
+++ b/tcl/doc/Interp.3
@@ -0,0 +1,125 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Interp \- client-visible fields of interpreter structures
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+typedef struct {
+	char *\fIresult\fR;
+	Tcl_FreeProc *\fIfreeProc\fR;
+	int \fIerrorLine\fR;
+} Tcl_Interp;
+
+typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBTcl_CreateInterp\fR procedure returns a pointer to a Tcl_Interp
+structure.  This pointer is then passed into other Tcl procedures
+to process commands in the interpreter and perform other operations
+on the interpreter.  Interpreter structures contain many many fields
+that are used by Tcl, but only three that may be accessed by
+clients:  \fIresult\fR, \fIfreeProc\fR, and \fIerrorLine\fR.
+.PP
+The \fIresult\fR and \fIfreeProc\fR fields are used to return
+results or error messages from commands.
+This information is returned by command procedures back to \fBTcl_Eval\fR,
+and by \fBTcl_Eval\fR back to its callers.
+The \fIresult\fR field points to the string that represents the
+result or error message, and the \fIfreeProc\fR field tells how
+to dispose of the storage for the string when it isn't needed anymore.
+The easiest way for command procedures to manipulate these
+fields is to call procedures like \fBTcl_SetResult\fR
+or \fBTcl_AppendResult\fR;  they
+will hide all the details of managing the fields.
+The description below is for those procedures that manipulate the
+fields directly.
+.PP
+Whenever a command procedure returns, it must ensure
+that the \fIresult\fR field of its interpreter points to the string
+being returned by the command.
+The \fIresult\fR field must always point to a valid string.
+If a command wishes to return no result then \fIinterp->result\fR
+should point to an empty string.
+Normally, results are assumed to be statically allocated,
+which means that the contents will not change before the next time
+\fBTcl_Eval\fR is called or some other command procedure is invoked.
+.VS
+In this case, the \fIfreeProc\fR field must be zero.
+Alternatively, a command procedure may dynamically
+allocate its return value (e.g. using \fBTcl_Alloc\fR)
+and store a pointer to it in \fIinterp->result\fR.
+In this case, the command procedure must also set \fIinterp->freeProc\fR
+to the address of a procedure that can free the value, or \fBTCL_DYNAMIC\fR
+if the storage was allocated directly by Tcl or by a call to
+\fBTcl_Alloc\fR. 
+.VE
+If \fIinterp->freeProc\fR is non-zero, then Tcl will call \fIfreeProc\fR
+to free the space pointed to by \fIinterp->result\fR before it
+invokes the next command.
+If a client procedure overwrites \fIinterp->result\fR when
+\fIinterp->freeProc\fR is non-zero, then it is responsible for calling
+\fIfreeProc\fR to free the old \fIinterp->result\fR (the \fBTcl_FreeResult\fR
+macro should be used for this purpose).
+.PP
+\fIFreeProc\fR should have arguments and result that match the
+\fBTcl_FreeProc\fR declaration above:  it receives a single
+argument which is a pointer to the result value to free.
+.VS
+In most applications \fBTCL_DYNAMIC\fR is the only non-zero value ever
+used for \fIfreeProc\fR.
+.VE
+However, an application may store a different procedure address
+in \fIfreeProc\fR in order to use an alternate memory allocator
+or in order to do other cleanup when the result memory is freed.
+.PP
+As part of processing each command, \fBTcl_Eval\fR initializes
+\fIinterp->result\fR
+and \fIinterp->freeProc\fR just before calling the command procedure for
+the command.  The \fIfreeProc\fR field will be initialized to zero,
+and \fIinterp->result\fR will point to an empty string.  Commands that
+do not return any value can simply leave the fields alone.
+Furthermore, the empty string pointed to by \fIresult\fR is actually
+part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
+If a command wishes to return a short string, it can simply copy
+it to the area pointed to by \fIinterp->result\fR.  Or, it can use
+the sprintf procedure to generate a short result string at the location
+pointed to by \fIinterp->result\fR.
+.PP
+It is a general convention in Tcl-based applications that the result
+of an interpreter is normally in the initialized state described
+in the previous paragraph.
+Procedures that manipulate an interpreter's result (e.g. by
+returning an error) will generally assume that the result
+has been initialized when the procedure is called.
+If such a procedure is to be called after the result has been
+changed, then \fBTcl_ResetResult\fR should be called first to
+reset the result to its initialized state.
+.PP
+The \fIerrorLine\fR
+field is valid only after \fBTcl_Eval\fR returns
+a \fBTCL_ERROR\fR return code.  In this situation the \fIerrorLine\fR
+field identifies the line number of the command being executed when
+the error occurred.  The line numbers are relative to the command
+being executed:  1 means the first line of the command passed to
+\fBTcl_Eval\fR, 2 means the second line, and so on.
+The \fIerrorLine\fR field is typically used in conjunction with
+\fBTcl_AddErrorInfo\fR to report information about where an error
+occurred.
+\fIErrorLine\fR should not normally be modified except by \fBTcl_Eval\fR.
+
+.SH KEYWORDS
+free, initialized, interpreter, malloc, result
diff --git a/tcl/doc/LinkVar.3 b/tcl/doc/LinkVar.3
new file mode 100644
index 00000000000..b5c25dc5c53
--- /dev/null
+++ b/tcl/doc/LinkVar.3
@@ -0,0 +1,115 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_LinkVar\fR(\fIinterp, varName, addr, type\fR)
+.sp
+\fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
+.sp
+\fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
+.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.  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
+Type of C variable.  Must be one of TCL_LINK_INT, TCL_LINK_DOUBLE,
+TCL_LINK_BOOLEAN, or TCL_LINK_STRING, optionally OR'ed with
+TCL_LINK_READ_ONLY to make Tcl variable read-only.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
+named by \fIvarName\fR in sync with the C variable at the address
+given by \fIaddr\fR.
+Whenever the Tcl variable is read the value of the C variable will
+be returned, and whenever the Tcl variable is written the C
+variable will be updated to have the same value.
+\fBTcl_LinkVar\fR normally returns TCL_OK;  if an error occurs
+while setting up the link (e.g. because \fIvarName\fR is the
+name of array) then TCL_ERROR is returned and \fIinterp->result\fR
+contains an error message.
+.PP
+The \fItype\fR argument specifies the type of the C variable,
+and must have one of the following values, optionally OR'ed with
+TCL_LINK_READ_ONLY:
+.TP
+\fBTCL_LINK_INT\fR
+The C variable is of type \fBint\fR.
+Any value written into the Tcl variable must have a proper integer
+form acceptable to \fBTcl_GetInt\fR;  attempts to write
+non-integer values into \fIvarName\fR will be rejected with
+Tcl errors.
+.TP
+\fBTCL_LINK_DOUBLE\fR
+The C variable is of type \fBdouble\fR.
+Any value written into the Tcl variable must have a proper real
+form acceptable to \fBTcl_GetDouble\fR;  attempts to write
+non-real values into \fIvarName\fR will be rejected with
+Tcl errors.
+.TP
+\fBTCL_LINK_BOOLEAN\fR
+The C variable is of type \fBint\fR.
+If its value is zero then it will read from Tcl as ``0'';
+otherwise it will read from Tcl as ``1''.
+Whenever \fIvarName\fR is
+modified, the C variable will be set to a 0 or 1 value.
+Any value written into the Tcl variable must have a proper boolean
+form acceptable to \fBTcl_GetBoolean\fR;  attempts to write
+non-boolean values into \fIvarName\fR will be rejected with
+Tcl errors.
+.TP
+\fBTCL_LINK_STRING\fR
+The C variable is of type \fBchar *\fR.
+.VS
+If its value is not null then it must be a pointer to a string
+allocated with \fBTcl_Alloc\fR.
+.VE
+Whenever the Tcl variable is modified the current C string will be
+freed and new memory will be allocated to hold a copy of the variable's
+new value.
+If the C variable contains a null pointer then the Tcl variable
+will read as ``NULL''.
+.PP
+If the TCL_LINK_READ_ONLY flag is present in \fItype\fR then the
+variable will be read-only from Tcl, so that its value can only be
+changed by modifying the C variable.
+Attempts to write the variable from Tcl will be rejected with errors.
+.PP
+\fBTcl_UnlinkVar\fR removes the link previously set up for the
+variable given by \fIvarName\fR.  If there does not exist a link
+for \fIvarName\fR then the procedure has no effect.
+.PP
+\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
+read the Tcl variable will return the latest value of the C variable.
+However, if a trace has been set on the Tcl variable (such as a
+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.
+
+.SH KEYWORDS
+boolean, integer, link, read-only, real, string, traces, variable
diff --git a/tcl/doc/ListObj.3 b/tcl/doc/ListObj.3
new file mode 100644
index 00000000000..7ae02ae82a5
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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 count in
+The number of elements 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/tcl/doc/Notifier.3 b/tcl/doc/Notifier.3
new file mode 100644
index 00000000000..29b94e03a93
--- /dev/null
+++ b/tcl/doc/Notifier.3
@@ -0,0 +1,537 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Notifier 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.VS
+.SH NAME
+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\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+.sp
+\fBTcl_DeleteEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+.sp
+\fBTcl_SetMaxBlockTime\fR(\fItimePtr\fB)\fR
+.sp
+\fBTcl_QueueEvent\fR(\fIevPtr, position\fR)
+.VS
+.sp
+\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
+.sp
+int
+\fBTcl_WaitForEvent\fR(\fItimePtr\fR)
+.sp
+\fBTcl_SetTimer\fR(\fItimePtr\fR)
+.sp
+int
+\fBTcl_ServiceAll\fR()
+.sp
+int
+\fBTcl_ServiceEvent\fR(\fIflags\fR)
+.sp
+int
+\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_DoOneEvent\fR.
+.AP Tcl_EventCheckProc *checkProc in
+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, \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
+time (when to wakeup).  If the pointer passed to \fBTcl_WaitForEvent\fR
+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
+have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
+.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
+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
+.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
+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 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.  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 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:
+.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
+.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 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
+information provided by the event sources.
+It may cause the application to block if \fItimePtr\fR specifies
+an interval other than 0.
+\fBTcl_WaitForEvent\fR returns when something has happened,
+such as a file becoming readable or the interval given by \fItimePtr\fR
+expiring.  If there are no events for \fBTcl_WaitForEvent\fR to
+wait for, so that it would block forever, then it returns immediately
+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.  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.
+.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.
+
+.SH "CREATING A NEW EVENT SOURCE"
+.PP
+An event source consists of three procedures invoked by the notifier,
+plus additional C procedures that are invoked by higher-level code
+to arrange for event-driven callbacks.  The three procedures called
+by the notifier consist of the setup and check procedures described
+above, plus an additional procedure that is invoked when an event
+is removed from the event queue for servicing.
+.PP
+The procedure \fBTcl_CreateEventSource\fR creates a new event source.
+Its arguments specify the setup procedure and check procedure for
+the event source.
+\fISetupProc\fR should match the following prototype:
+.CS
+typedef void Tcl_EventSetupProc(
+	ClientData \fIclientData\fR,
+	int \fIflags\fR);
+.CE
+The \fIclientData\fR argument will be the same as the \fIclientData\fR
+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
+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 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.  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:
+.CS
+typedef struct Tcl_Time {
+	long \fIsec\fR;
+	long \fIusec\fR;
+} Tcl_Time;
+.CE
+The \fIusec\fR field should be less than 1000000.
+.PP
+.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
+.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
+\fBTcl_CreateEventSource\fR.  \fICheckProc\fR must match the
+following prototype:
+.CS
+typedef void Tcl_EventCheckProc(
+	ClientData \fIclientData\fR,
+	int \fIflags\fR);
+.CE
+The arguments to this procedure are the same as those for \fIsetupProc\fR.
+\fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited
+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.
+.PP
+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;
+    struct Tcl_Event *\fInextPtr\fR;
+};
+.CE
+The event source must fill in the \fIproc\fR field of
+the event before calling \fBTcl_QueueEvent\fR.
+The \fInextPtr\fR is used to link together the events in the queue
+and should not be modified by the event source.
+.PP
+An event may be added to the queue at any of three positions, depending
+on the \fIposition\fR argument to \fBTcl_QueueEvent\fR:
+.IP \fBTCL_QUEUE_TAIL\fR 24
+Add the event at the back of the queue, so that all other pending
+events will be serviced first.  This is almost always the right
+place for new events.
+.IP \fBTCL_QUEUE_HEAD\fR 24
+Add the event at the front of the queue, so that it will be serviced
+before all other queued events.
+.IP \fBTCL_QUEUE_MARK\fR 24
+Add the event at the front of the queue, unless there are other
+events at the front whose position is \fBTCL_QUEUE_MARK\fR;  if so,
+add the new event just after all other \fBTCL_QUEUE_MARK\fR events.
+This value of \fIposition\fR is used to insert an ordered sequence of
+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
+.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
+typedef int Tcl_EventProc(
+	Tcl_Event *\fIevPtr\fR,
+	int \fIflags\fR);
+.CE
+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
+.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
+one or more Tcl commands or C-level callbacks.
+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
+.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
+\fIflags\fR argument.
+For example, the file event source will always return 0 if the
+\fBTCL_FILE_EVENTS\fR bit isn't set in \fIflags\fR.
+Another example of deferring events happens in Tk if
+\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
+of window events.
+.PP
+.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
+the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR)
+before calling \fBTcl_QueueEvent\fR, but it
+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, 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.
+.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 \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 \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
+event, notifier, event queue, event sources, file events, timer, idle, service mode
diff --git a/tcl/doc/Object.3 b/tcl/doc/Object.3
new file mode 100644
index 00000000000..ca828188e03
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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 0.
+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/tcl/doc/ObjectType.3 b/tcl/doc/ObjectType.3
new file mode 100644
index 00000000000..c95606f1798
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/OpenFileChnl.3 b/tcl/doc/OpenFileChnl.3
new file mode 100644
index 00000000000..3a73c173586
--- /dev/null
+++ b/tcl/doc/OpenFileChnl.3
@@ -0,0 +1,499 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.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_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
+.sp
+typedef ... Tcl_Channel;
+.sp
+Tcl_Channel
+\fBTcl_OpenFileChannel\fR(\fIinterp, fileName, mode, permissions\fR)
+.sp
+Tcl_Channel
+\fBTcl_OpenCommandChannel\fR(\fIinterp, argc, argv, flags\fR)
+.VS
+.sp
+Tcl_Channel
+\fBTcl_MakeFileChannel\fR(\fIhandle, readOrWrite\fR)
+.VE
+.sp
+Tcl_Channel
+\fBTcl_GetChannel\fR(\fIinterp, channelName, modePtr\fR)
+.sp
+void
+\fBTcl_RegisterChannel\fR(\fIinterp, channel\fR)
+.sp
+int
+\fBTcl_UnregisterChannel\fR(\fIinterp, channel\fR)
+.sp
+int
+\fBTcl_Close\fR(\fIinterp, channel\fR)
+.sp
+int
+\fBTcl_Read\fR(\fIchannel, buf, toRead\fR)
+.sp
+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
+\fBTcl_Flush\fR(\fIchannel\fR)
+.sp
+int
+\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
+.sp
+int
+\fBTcl_Tell\fR(\fIchannel\fR)
+.sp
+int
+\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)
+.sp
+int
+\fBTcl_SetChannelOption\fR(\fIinterp, channel, optionName, newValue\fR)
+.sp
+int
+\fBTcl_Eof\fR(\fIchannel\fR)
+.sp
+int
+\fBTcl_InputBlocked\fR(\fIchannel\fR)
+.sp
+int
+\fBTcl_InputBuffered\fR(\fIchannel\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_ChannelType newClientProcPtr in
+.AP Tcl_Interp *interp in
+Used for error reporting and to look up a channel registered in it.
+.AP char *fileName in
+The name of a local or network file.
+.AP char *mode in
+Specifies how the file is to be accessed.  May have any of the
+values allowed for the \fImode\fR argument to the Tcl
+\fBopen\fR command.
+For \fBTcl_OpenCommandChannel\fR, may be NULL.
+.AP int permissions in
+POSIX-style permission flags such as 0644.
+If a new file is created, these permissions will be set on the
+created file.
+.AP int argc in
+The number of elements in \fIargv\fR.
+.AP char **argv in
+Arguments for constructing a command pipeline.
+These values have the same meaning as the non-switch arguments
+to the Tcl \fBexec\fR command.
+.AP int flags in
+Specifies the disposition of the stdio handles in pipeline: OR-ed
+combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR,
+and \fBTCL_ENFORCE_MODE\fR. If \fBTCL_STDIN\fR is set, stdin for
+the first child in the pipe is the pipe channel, otherwise it is the same
+as the standard input of the invoking process; likewise for
+\fBTCL_STDOUT\fR and \fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set,
+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.
+.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
+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
+open for reading and writing.
+.AP Tcl_Channel channel in
+A Tcl channel for input or output.  Must have been the return value
+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.  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
+How far to move the access point in the channel at which the next input or
+output operation will be applied, measured in bytes from the position
+given by \fIseekMode\fR.  May be either positive or negative.
+.AP int seekMode in
+Relative to which point to seek; used with \fIoffset\fR to calculate the new
+access point for the channel. Legal values are \fBSEEK_SET\fR,
+\fBSEEK_CUR\fR, and \fBSEEK_END\fR.
+.AP char *optionName in
+The name of an option applicable to this channel, such as \fB\-blocking\fR.
+May have any of the values accepted by the \fBfconfigure\fR command.
+.AP Tcl_DString *optionValue in
+Where to store the value of an option or a list of all options and their
+values. Must have been initialized by the caller.
+.AP char *newValue in
+New value for the option given by \fIoptionName\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+The Tcl channel mechanism provides a device-independent and
+platform-independent mechanism for performing buffered input
+and output operations on a variety of file, socket, and device
+types.
+The channel mechanism is extensible to new channel types, by
+providing a low level channel driver for the new type; the channel driver
+interface is described in the manual entry for \fBTcl_CreateChannel\fR. The
+channel mechanism provides a buffering scheme modelled after
+Unix's standard I/O, and it also allows for nonblocking I/O on
+channels.
+.PP
+The procedures described in this manual entry comprise the C APIs of the
+generic layer of the channel architecture. For a description of the channel
+driver architecture and how to implement channel drivers for new types of
+channels, see the manual entry for \fBTcl_CreateChannel\fR.
+
+.SH TCL_OPENFILECHANNEL
+.PP
+\fBTcl_OpenFileChannel\fR opens a file specified by \fIfileName\fR and
+returns a channel handle that can be used to perform input and output on
+the file. This API is modelled after the \fBfopen\fR procedure of
+the Unix standard I/O library.
+The syntax and meaning of all arguments is similar to those
+given in the Tcl \fBopen\fR command when opening a file.
+If an error occurs while opening the channel, \fBTcl_OpenFileChannel\fR
+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
+\fBTcl_OpenCommandChannel\fR provides a C-level interface to the
+functions of the \fBexec\fR and \fBopen\fR commands.
+It creates a sequence of subprocesses specified
+by the \fIargv\fR and \fIargc\fR arguments and returns a channel that can
+be used to communicate with these subprocesses.
+The \fIflags\fR argument indicates what sort of communication will
+exist with the command pipeline.
+.PP
+If the \fBTCL_STDIN\fR 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 \fBTCL_STDIN\fR is not set,
+then standard input for the first subprocess will be the same as this
+application's standard input.  If \fBTCL_STDOUT\fR 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
+\fBTCL_STDERR\fR 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
+\fBTCL_ENFORCE_MODE\fR is not set, then \fIargc\fR and \fIargv\fR can
+redirect the stdio handles to override \fBTCL_STDIN\fR,
+\fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR; if it is set, then it is an
+error for argc and argv to override stdio channels for which
+\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR have been set.
+.PP
+If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR
+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
+\fBTcl_GetChannel\fR returns a channel given the \fIchannelName\fR used to
+create it with \fBTcl_CreateChannel\fR and a pointer to a Tcl interpreter in
+\fIinterp\fR. If a channel by that name is not registered in that interpreter,
+the procedure returns NULL. If the \fImode\fR argument is not NULL, it
+points at an integer variable that will receive an OR-ed combination of
+\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR describing whether the channel is
+open for reading and writing.
+
+.SH TCL_REGISTERCHANNEL
+.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, 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.
+.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. 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
+POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
+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 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
+\fBTcl_Read\fR consumes up to \fItoRead\fR bytes of data from
+\fIchannel\fR and stores it at \fIbuf\fR.
+The return value of \fBTcl_Read\fR is the number of characters written
+at \fIbuf\fR.
+The buffer produced by \fBTcl_Read\fR is not NULL terminated. Its contents
+are valid from the zeroth position up to and excluding the position
+indicated by the return value.
+If an error occurs, the return value is -1 and \fBTcl_Read\fR records
+a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
+.PP
+The return value may be smaller than the value of \fItoRead\fR, indicating
+that less data than requested was available, also called a \fIshort
+read\fR.
+In blocking mode, this can only happen on an end-of-file.
+In nonblocking mode, a short read can also occur if there is not
+enough input currently available:  \fBTcl_Read\fR returns a short
+count rather than waiting for more data.
+.PP
+If the channel is in blocking mode, a return value of zero indicates an end
+of file condition. If the channel is in nonblocking mode, a return value of
+zero indicates either that no input is currently available or an end of
+file condition. Use \fBTcl_Eof\fR and \fBTcl_InputBlocked\fR
+to tell which of these conditions actually occurred.
+.PP
+\fBTcl_Read\fR translates platform-specific end-of-line representations
+into the canonical \fB\en\fR internal representation according to the
+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 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)
+to the dynamic string given by \fIdsPtr\fR.
+The end-of-line character(s) are read and discarded.
+.PP
+If a line was successfully read, the return value is greater than or
+equal to zero, and it indicates the number of characters stored
+in the dynamic string.
+If an error occurs, \fBTcl_Gets\fR returns -1 and records a POSIX error
+code that can be retrieved with \fBTcl_GetErrno\fR.
+\fBTcl_Gets\fR also returns -1 if the end of the file is reached;
+the \fBTcl_Eof\fR procedure can be used to distinguish an error
+from an end-of-file condition.
+.PP
+If the channel is in nonblocking mode, the return value can also
+be -1 if no data was available or the data that was available
+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
+on \fIchannel\fR. This data may not appear on the output device
+immediately. If the data should appear immediately, call \fBTcl_Flush\fR
+after the call to \fBTcl_Write\fR, or set the \fB-buffering\fR option on
+the channel to \fBnone\fR. If you wish the data to appear as soon as an end
+of line is accepted for output, set the \fB\-buffering\fR option on the
+channel to \fBline\fR mode.
+.PP
+The \fItoWrite\fR argument specifies how many bytes of data are provided in
+the \fIbuf\fR argument. If it is negative, \fBTcl_Write\fR expects the data
+to be NULL terminated and it outputs everything up to the NULL.
+.PP
+The return value of \fBTcl_Write\fR is a count of how many
+characters were accepted for output to the channel. This is either equal to
+\fItoWrite\fR or -1 to indicate that an error occurred.
+If an error occurs, \fBTcl_Write\fR also records a POSIX error code
+that may be retrieved with \fBTcl_GetErrno\fR.
+.PP
+Newline characters in the output data are translated to platform-specific
+end-of-line sequences according to the \fB\-translation\fR option for
+the channel.
+
+.SH TCL_FLUSH
+.PP
+\fBTcl_Flush\fR causes all of the buffered output data for \fIchannel\fR
+to be written to its underlying file or device as soon as possible.
+If the channel is in blocking mode, the call does not return until
+all the buffered data has been sent to the channel or some error occurred.
+The call returns immediately if the channel is nonblocking; it starts
+a background flush that will write the buffered data to the channel
+eventually, as fast as the channel is able to absorb it.
+.PP
+The return value is normally \fBTCL_OK\fR.
+If an error occurs, \fBTcl_Flush\fR returns \fBTCL_ERROR\fR and
+records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
+
+.SH TCL_SEEK
+.PP
+\fBTcl_Seek\fR moves the access point in \fIchannel\fR where subsequent
+data will be read or written. Buffered output is flushed to the channel and
+buffered input is discarded, prior to the seek operation.
+.PP
+\fBTcl_Seek\fR normally returns the new access point.
+If an error occurs, \fBTcl_Seek\fR returns -1 and records a POSIX error
+code that can be retrieved with \fBTcl_GetErrno\fR.
+After an error, the access point may or may not have been moved.
+
+.SH TCL_TELL
+.PP
+\fBTcl_Tell\fR returns the current access point for a channel. The returned
+value is -1 if the channel does not support seeking.
+
+.SH TCL_GETCHANNELOPTION
+.PP
+\fBTcl_GetChannelOption\fR retrieves, in \fIdsPtr\fR, the value of one of
+the options currently in effect for a channel, or a list of all options and
+their values.  The \fIchannel\fR argument identifies the channel for which
+to query an option or retrieve all options and their values.
+If \fIoptionName\fR is not NULL, it is the name of the
+option to query; the option's value is copied to the Tcl dynamic string
+denoted by \fIoptionValue\fR. If
+\fIoptionName\fR is NULL, the function stores an alternating list of option
+names and their values in \fIoptionValue\fR, using a series of calls to
+\fBTcl_DStringAppendElement\fR. The various preexisting options and
+their possible values are described in the manual entry for the Tcl
+\fBfconfigure\fR command. Other options can be added by each channel type.
+These channel type specific options are described in the manual entry for
+the Tcl command that creates a channel of that type; for example, the
+additional options for TCP based channels are described in the manual entry
+for the Tcl \fBsocket\fR command.
+The procedure normally returns \fBTCL_OK\fR. If an error occurs, it returns
+\fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an appropriate POSIX
+error code.
+
+.SH TCL_SETCHANNELOPTION
+.PP
+\fBTcl_SetChannelOption\fR sets a new value for an option on \fIchannel\fR.
+\fIOptionName\fR is the option to set and \fInewValue\fR is the value to
+set.
+The procedure normally returns \fBTCL_OK\fR.  If an error occurs,
+it returns \fBTCL_ERROR\fR;  in addition, if \fIinterp\fR is non-NULL,
+\fBTcl_SetChannelOption\fR leaves an error message in \fIinterp->result\fR.
+
+.SH TCL_EOF
+.PP
+\fBTcl_Eof\fR returns a nonzero value if \fIchannel\fR encountered
+an end of file during the last input operation.
+
+.SH TCL_INPUTBLOCKED
+.PP
+\fBTcl_InputBlocked\fR returns a nonzero value if \fIchannel\fR is in
+nonblocking mode and the last input operation returned less data than
+requested because there was insufficient data available.
+The call always returns zero if the channel is in blocking mode.
+
+.SH TCL_INPUTBUFFERED
+.PP
+\fBTcl_InputBuffered\fR returns the number of bytes of input currently
+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)
+
+.SH KEYWORDS
+access point, blocking, buffered I/O, channel, channel driver, end of file,
+flush, input, nonblocking, output, read, seek, write
diff --git a/tcl/doc/OpenTcp.3 b/tcl/doc/OpenTcp.3
new file mode 100644
index 00000000000..7d3c997f27f
--- /dev/null
+++ b/tcl/doc/OpenTcp.3
@@ -0,0 +1,179 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.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_MakeTcpClientChannel, Tcl_OpenTcpServer \- procedures to open channels using TCP sockets
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h> \fR
+.sp
+Tcl_Channel
+\fBTcl_OpenTcpClient\fR(\fIinterp, port, host, myaddr, myport, async\fR)
+.sp
+Tcl_Channel
+\fBTcl_MakeTcpClientChannel\fR(\fIsock\fR)
+.sp
+Tcl_Channel
+\fBTcl_OpenTcpServer\fR(\fIinterp, port, myaddr, proc, clientData\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_ChannelType newClientProcPtr in
+.AP Tcl_Interp *interp in
+Tcl interpreter to use for error reporting.  If non-NULL and an
+error occurs, an error message is left in \fIinterp->result\fR.
+.AP int port in
+A port number to connect to as a client or to listen on as a server.
+.AP char *host in
+A string specifying a host name or address for the remote end of the connection.
+.AP int myport in
+A port number for the client's end of the socket.  If 0, a port number
+is allocated at random.
+.AP char *myaddr in
+A string specifying the host name or address for network interface to use
+for the local end of the connection.  If NULL, a default interface is
+chosen.
+.AP int async in
+If nonzero, the client socket is connected asynchronously to the server.
+.AP ClientData sock in
+Platform-specific handle for client TCP socket.
+.AP Tcl_TcpAcceptProc *proc in
+Pointer to a procedure to invoke each time a new connection is
+accepted via the socket.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These functions are convenience procedures for creating
+channels that communicate over TCP sockets.
+The operations on a channel
+are described in the manual entry for \fBTcl_OpenFileChannel\fR.
+
+.SH TCL_OPENTCPCLIENT
+.PP
+\fBTcl_OpenTcpClient\fR opens a client TCP socket connected to a \fIport\fR
+on a specific \fIhost\fR, and returns a channel that can be used to
+communicate with the server. The host to connect to can be specified either
+as a domain name style name (e.g. \fBwww.sunlabs.com\fR), or as a string
+containing the alphanumeric representation of its four-byte address (e.g.
+\fB127.0.0.1\fR). Use the string \fBlocalhost\fR to connect to a TCP socket on
+the host on which the function is invoked.
+.PP
+The \fImyaddr\fR and \fImyport\fR arguments allow a client to specify an
+address for the local end of the connection.  If \fImyaddr\fR is NULL, then
+an interface is chosen automatically by the operating system.
+If \fImyport\fR is 0, then a port number is chosen at random by
+the operating system.
+.PP
+If \fIasync\fR is zero, the call to \fBTcl_OpenTcpClient\fR returns only
+after the client socket has either successfully connected to the server, or
+the attempted connection has failed.
+If \fIasync\fR is nonzero the socket is connected asynchronously and the
+returned channel may not yet be connected to the server when the call to
+\fBTcl_OpenTcpClient\fR returns. If the channel is in blocking mode and an
+input or output operation is done on the channel before the connection is
+completed or fails, that operation will wait until the connection either
+completes successfully or fails. If the channel is in nonblocking mode, the
+input or output operation will return immediately and a subsequent call to
+\fBTcl_InputBlocked\fR on the channel will return nonzero.
+.PP
+The returned channel is opened for reading and writing.
+If an error occurs in opening the socket, \fBTcl_OpenTcpClient\fR returns
+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
+\fBTcl_OpenTcpServer\fR opens a TCP socket on the local host on a specified
+\fIport\fR and uses the Tcl event mechanism to accept requests from clients
+to connect to it.  The \fImyaddr\fP argument specifies the network interface.
+If \fImyaddr\fP is NULL the special address INADDR_ANY should be used to
+allow connections from any network interface.
+Each time a client connects to this socket, Tcl creates a channel
+for the new connection and invokes \fIproc\fR with information about
+the channel.  \fIProc\fR must match the following prototype:
+.CS
+typedef void Tcl_TcpAcceptProc(
+	ClientData \fIclientData\fR,
+	Tcl_Channel \fIchannel\fR,
+	char *\fIhostName\fR,
+	int \fIport\fP);
+.CE
+.PP
+The \fIclientData\fR argument will be the same as the \fIclientData\fR
+argument to \fBTcl_OpenTcpServer\fR, \fIchannel\fR will be the handle
+for the new channel, \fIhostName\fR points to a string containing
+the name of the client host making the connection, and \fIport\fP
+will contain the client's port number.
+The new channel
+is opened for both input and output. 
+If \fIproc\fR raises an error, the connection is closed automatically.
+\fIProc\fR has no return value, but if it wishes to reject the
+connection it can close \fIchannel\fR.
+.PP
+\fBTcl_OpenTcpServer\fR normally returns a pointer to a channel
+representing the server socket.
+If an error occurs, \fBTcl_OpenTcpServer\fR returns NULL and
+records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
+In addition, if \fIinterp->result\fR is non-NULL, an error message
+is left in \fIinterp->result\fR.
+.PP
+The channel returned by \fBTcl_OpenTcpServer\fR cannot be used for
+either input or output.
+It is simply a handle for the socket used to accept connections.
+The caller can close the channel to shut down the server and disallow
+further connections from new clients.
+.PP
+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), Tcl_RegisterChannel(3), vwait(n)
+
+.SH KEYWORDS
+client, server, TCP
diff --git a/tcl/doc/PkgRequire.3 b/tcl/doc/PkgRequire.3
new file mode 100644
index 00000000000..30ef5bea84e
--- /dev/null
+++ b/tcl/doc/PkgRequire.3
@@ -0,0 +1,59 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_PkgRequire, Tcl_PkgProvide \- package version control
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_PkgRequire\fR(\fIinterp, name, version, exact\fR)
+.sp
+int
+\fBTcl_PkgProvide\fR(\fIinterp, name, version\fR)
+.SH ARGUMENTS
+.AS Tcl_FreeProc clientData
+.AP Tcl_Interp *interp in
+Interpreter where package is needed or available.
+.AP char *name in
+Name of package.
+.AP char *version in
+A version string consisting of one or more decimal numbers
+separated by dots.
+.AP int exact in
+Non-zero means that only the particular version specified by
+\fIversion\fR is acceptable.
+Zero means that newer versions than \fIversion\fR are also
+acceptable as long as they have the same major version number
+as \fIversion\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures provide C-level interfaces to Tcl's package and
+version management facilities.
+\fBTcl_PkgRequire\fR is equivalent to the \fBpackage require\fR
+command, and \fBTcl_PkgProvide\fR is equivalent to the
+\fBpackage provide\fR command.
+See the documentation for the Tcl commands for details on what these
+procedures do.
+If \fBTcl_PkgRequire\fR completes successfully it returns a pointer
+to the version string for the version of the package that is provided
+in the interpreter (which may be different than \fIversion\fR); if
+an error occurs it returns NULL and leaves an error message in
+\fIinterp->result\fR.
+\fBTcl_PkgProvide\fR returns TCL_OK if it completes successfully;
+if an error occurs it returns TCL_ERROR and leaves an error message
+in \fIinterp->result\fR.
+
+.SH KEYWORDS
+package, provide, require, version
diff --git a/tcl/doc/Preserve.3 b/tcl/doc/Preserve.3
new file mode 100644
index 00000000000..277735cb98d
--- /dev/null
+++ b/tcl/doc/Preserve.3
@@ -0,0 +1,103 @@
+'\"
+'\" Copyright (c) 1990 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it's being used
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_Preserve\fR(\fIclientData\fR)
+.sp
+\fBTcl_Release\fR(\fIclientData\fR)
+.sp
+\fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR)
+.SH ARGUMENTS
+.AS Tcl_FreeProc clientData
+.AP ClientData clientData in
+Token describing structure to be freed or reallocated.  Usually a pointer
+to memory for structure.
+.AP Tcl_FreeProc *freeProc in
+Procedure to invoke to free \fIclientData\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These three procedures help implement a simple reference count mechanism
+for managing storage.  They are designed to solve a problem
+having to do with widget deletion, but are also useful in many other
+situations.  When a widget is deleted, its
+widget record (the structure holding information specific to the
+widget) must be returned to the storage allocator.
+However, it's possible that the widget record is in active use
+by one of the procedures on the stack at the time of the deletion.
+This can happen, for example, if the command associated with a button
+widget causes the button to be destroyed:  an X event causes an
+event-handling C procedure in the button to be invoked, which in
+turn causes the button's associated Tcl command to be executed,
+which in turn causes the button to be deleted, which in turn causes
+the button's widget record to be de-allocated.
+Unfortunately, when the Tcl command returns, the button's
+event-handling procedure will need to reference the
+button's widget record.
+Because of this, the widget record must not be freed as part of the
+deletion, but must be retained until the event-handling procedure has
+finished with it.
+In other situations where the widget is deleted, it may be possible
+to free the widget record immediately.
+.PP
+\fBTcl_Preserve\fR and \fBTcl_Release\fR
+implement short-term reference counts for their \fIclientData\fR
+argument.
+The \fIclientData\fR argument identifies an object and usually
+consists of the address of a structure.
+The reference counts guarantee that an object will not be freed
+until each call to \fBTcl_Preserve\fR for the object has been
+matched by calls to \fBTcl_Release\fR.
+There may be any number of unmatched \fBTcl_Preserve\fR calls
+in effect at once.
+.PP
+\fBTcl_EventuallyFree\fR is invoked to free up its \fIclientData\fR
+argument.
+It checks to see if there are unmatched \fBTcl_Preserve\fR calls
+for the object.
+If not, then \fBTcl_EventuallyFree\fR calls \fIfreeProc\fR immediately.
+Otherwise \fBTcl_EventuallyFree\fR records the fact that \fIclientData\fR
+needs eventually to be freed.
+When all calls to \fBTcl_Preserve\fR have been matched with
+calls to \fBTcl_Release\fR then \fIfreeProc\fR will be called by
+\fBTcl_Release\fR to do the cleanup.
+.PP
+All the work of freeing the object is carried out by \fIfreeProc\fR.
+\fIFreeProc\fR must have arguments and result that match the
+type \fBTcl_FreeProc\fR:
+.CS
+typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+.CE
+The \fIblockPtr\fR argument to \fIfreeProc\fR will be the
+same as the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR.
+The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
+\fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical
+reasons, but the value is the same.
+.PP
+This mechanism can be used to solve the problem described above
+by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around
+actions that may cause undesired storage re-allocation.  The
+mechanism is intended only for short-term use (i.e. while procedures
+are pending on the stack);  it will not work efficiently as a
+mechanism for long-term reference counts.
+The implementation does not depend in any way on the internal
+structure of the objects being freed;  it keeps the reference
+counts in a separate structure.
+
+.SH KEYWORDS
+free, reference count, storage
diff --git a/tcl/doc/PrintDbl.3 b/tcl/doc/PrintDbl.3
new file mode 100644
index 00000000000..1f6d3f4319f
--- /dev/null
+++ b/tcl/doc/PrintDbl.3
@@ -0,0 +1,47 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_PrintDouble \- Convert floating value to string
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_PrintDouble\fR(\fIinterp, value, dst\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+.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
+the conversion is controlled by the \fBtcl_precision\fR variable
+that is now shared by all interpreters.
+.VE
+.AP double value in
+Floating-point value to be converted.
+.AP char *dst out
+Where to store string representing \fIvalue\fR.  Must have at
+least TCL_DOUBLE_SPACE characters of storage.
+.BE
+
+.SH DESCRIPTION
+.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 \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/tcl/doc/RecEvalObj.3 b/tcl/doc/RecEvalObj.3
new file mode 100644
index 00000000000..4697a886817
--- /dev/null
+++ b/tcl/doc/RecEvalObj.3
@@ -0,0 +1,55 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_RecordAndEvalObj \- save command on history list before evaluating
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_RecordAndEvalObj\fR(\fIinterp, cmdPtr, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp;
+.AP Tcl_Interp *interp in
+Tcl interpreter in which to evaluate command.
+.AP Tcl_Obj *cmdPtr in
+Points to a Tcl object containing a command (or sequence of commands)
+to execute.
+.AP int flags in
+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.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
+on the history list and then execute it using \fBTcl_EvalObj\fR
+(or \fBTcl_GlobalEvalObj\fR if the TCL_EVAL_GLOBAL bit is set
+in \fIflags\fR).
+It returns a completion code such as TCL_OK just like \fBTcl_EvalObj\fR,
+as well as a result object containing additional information
+(a result value or error message)
+that can be retrieved using \fBTcl_GetObjResult\fR.
+If you don't want the command recorded on the history list then
+you should invoke \fBTcl_EvalObj\fR instead of \fBTcl_RecordAndEvalObj\fR.
+Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level
+commands typed by the user, since the purpose of history is to
+allow the user to re-issue recently-invoked commands.
+If the \fIflags\fR argument contains the TCL_NO_EVAL bit then
+the command is recorded without being evaluated.
+
+.SH "SEE ALSO"
+Tcl_EvalObj, Tcl_GetObjResult
+
+.SH KEYWORDS
+command, event, execute, history, interpreter, object, record
diff --git a/tcl/doc/RecordEval.3 b/tcl/doc/RecordEval.3
new file mode 100644
index 00000000000..9cbba275f7c
--- /dev/null
+++ b/tcl/doc/RecordEval.3
@@ -0,0 +1,57 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_RecordAndEval \- save command on history list before evaluating
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_RecordAndEval\fR(\fIinterp, cmd, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp;
+.AP Tcl_Interp *interp in
+Tcl interpreter in which to evaluate command.
+.AP char *cmd in
+Command (or sequence of commands) to execute.
+.AP int flags in
+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.
+.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
+(or \fBTcl_GlobalEval\fR if the TCL_EVAL_GLOBAL bit is set in \fIflags\fR).
+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
+you should invoke \fBTcl_Eval\fR instead of \fBTcl_RecordAndEval\fR.
+Normally \fBTcl_RecordAndEval\fR is only called with top-level
+commands typed by the user, since the purpose of history is to
+allow the user to re-issue recently-invoked commands.
+If the \fIflags\fR argument contains the TCL_NO_EVAL bit then
+the command is recorded without being evaluated.
+.PP
+Note that \fBTcl_RecordAndEval\fR has been largely replaced by the
+object-based procedure \fBTcl_RecordAndEvalObj\fR.
+That object-based procedure records and optionally executes
+a command held in a Tcl object instead of a string.
+
+.SH "SEE ALSO"
+Tcl_RecordAndEvalObj
+
+.SH KEYWORDS
+command, event, execute, history, interpreter, record
diff --git a/tcl/doc/RegExp.3 b/tcl/doc/RegExp.3
new file mode 100644
index 00000000000..4aabc933a55
--- /dev/null
+++ b/tcl/doc/RegExp.3
@@ -0,0 +1,116 @@
+'\"
+'\" Copyright (c) 1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_RegExpMatch 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern matching with regular expressions
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR)
+.sp
+Tcl_RegExp
+\fBTcl_RegExpCompile\fR(\fIinterp\fR, \fIpattern\fR)
+.sp
+int
+\fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fIstring\fR, \fIstart\fR)
+.sp
+\fBTcl_RegExpRange\fR(\fIregexp\fR, \fIindex\fR, \fIstartPtr\fR, \fIendPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Tcl interpreter to use for error reporting.
+.AP char *string in
+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
+Compiled regular expression.  Must have been returned previously
+by \fBTcl_RegExpCompile\fR.
+.AP char *start in
+If \fIstring\fR is just a portion of some other string, this argument
+identifies the beginning of the larger string.
+If it isn't the same as \fIstring\fR, then no \fB^\fR matches
+will be allowed.
+.AP int index in
+Specifies which range is desired:  0 means the range of the entire
+match, 1 or greater means the range that matched a parenthesized
+sub-expression.
+.AP char **startPtr out
+The address of the first character in the range is stored here, or
+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.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_RegExpMatch\fR determines whether its \fIpattern\fR argument
+matches \fIregexp\fR, where \fIregexp\fR is interpreted
+as a regular expression using the same rules as for the
+\fBregexp\fR Tcl command.
+If there is a match then \fBTcl_RegExpMatch\fR returns 1.
+If there is no match then \fBTcl_RegExpMatch\fR returns 0.
+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
+\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
+the internal form used for efficient pattern matching.
+The return value is a token for this compiled form, which can be
+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.
+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.
+.PP
+\fBTcl_RegExpExec\fR executes the regular expression pattern matcher.
+It returns 1 if \fIstring\fR contains a range of characters that
+match \fIregexp\fR, 0 if no match is found, and
+\-1 if an error occurs.
+In the case of an error, \fBTcl_RegExpExec\fR leaves an error
+message in \fIinterp->result\fR.
+When searching a string for multiple matches of a pattern,
+it is important to distinguish between the start of the original
+string and the start of the current search.
+For example, when searching for the second occurrence of a
+match, the \fIstring\fR argument might point to the character
+just after the first match;  however, it is important for the
+pattern matcher to know that this is not the start of the entire string,
+so that it doesn't allow \fB^\fR atoms in the pattern to match.
+The \fIstart\fR argument provides this information by pointing
+to the start of the overall string containing \fIstring\fR.
+\fIStart\fR will be less than or equal to \fIstring\fR;  if it
+is less than \fIstring\fR then no \fB^\fR matches will be allowed.
+.PP
+\fBTcl_RegExpRange\fR may be invoked after \fBTcl_RegExpExec\fR
+returns;  it provides detailed information about what ranges of
+the string matched what parts of the pattern.
+\fBTcl_RegExpRange\fR returns a pair of pointers in \fI*startPtr\fR
+and \fI*endPtr\fR that identify a range of characters in
+the source string for the most recent call to \fBTcl_RegExpExec\fR.
+\fIIndex\fR indicates which of several ranges is desired:
+if \fIindex\fR is 0, information is returned about the overall range
+of characters that matched the entire pattern;  otherwise,
+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.
+
+.SH KEYWORDS
+match, pattern, regular expression, string, subexpression
diff --git a/tcl/doc/SetErrno.3 b/tcl/doc/SetErrno.3
new file mode 100644
index 00000000000..2385c484036
--- /dev/null
+++ b/tcl/doc/SetErrno.3
@@ -0,0 +1,48 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH Tcl_SetErrno 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SetErrno, Tcl_GetErrno \- manipulate errno to store and retrieve error codes
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_SetErrno\fR(\fIerrorCode\fR)
+.sp
+int
+\fBTcl_GetErrno\fR()
+.sp
+.SH ARGUMENTS
+.AS Tcl_Interp *errorCode in
+.AP int errorCode in
+A POSIX error code such as \fBENOENT\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_SetErrno\fR and \fBTcl_GetErrno\fR provide portable access
+to the \fBerrno\fR variable, which is used to record a POSIX error
+code after system calls and other operations such as \fBTcl_Gets\fR.
+These procedures are necessary because global variable accesses cannot
+be made across module boundaries on some platforms.
+.PP
+\fBTcl_SetErrno\fR sets the \fBerrno\fR variable to the value of the
+\fIerrorCode\fR argument
+C procedures that wish to return error information to their callers
+via \fBerrno\fR should call \fBTcl_SetErrno\fR rather than setting
+\fBerrno\fR directly.
+.PP
+\fBTcl_GetErrno\fR returns the current value of \fBerrno\fR.
+Procedures wishing to access \fBerrno\fR should call this procedure
+instead of accessing \fBerrno\fR directly.
+
+.SH KEYWORDS
+errno, error code, global variables
diff --git a/tcl/doc/SetRecLmt.3 b/tcl/doc/SetRecLmt.3
new file mode 100644
index 00000000000..33ab852f35c
--- /dev/null
+++ b/tcl/doc/SetRecLmt.3
@@ -0,0 +1,55 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_SetRecursionLimit\fR(\fIinterp, depth\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Interpreter whose recursion limit is to be set.
+Must be greater than zero.
+.AP int depth in
+New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+At any given time Tcl enforces a limit on the number of recursive
+calls that may be active for \fBTcl_Eval\fR and related procedures
+such as \fBTcl_GlobalEval\fR.
+Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with
+an error.
+By default the recursion limit is 1000.
+.PP
+\fBTcl_SetRecursionLimit\fR may be used to change the maximum
+allowable nesting depth for an interpreter.
+The \fIdepth\fR argument specifies a new limit for \fIinterp\fR,
+and \fBTcl_SetRecursionLimit\fR returns the old limit.
+To read out the old limit without modifying it, invoke
+\fBTcl_SetRecursionDepth\fR with \fIdepth\fR equal to 0.
+.PP
+The \fBTcl_SetRecursionLimit\fR only sets the size of the Tcl
+call stack:  it cannot by itself prevent stack overflows on the
+C stack being used by the application.  If your machine has a
+limit on the size of the C stack, you may get stack overflows
+before reaching the limit set by \fBTcl_SetRecursionLimit\fR.
+If this happens, see if there is a mechanism in your system for
+increasing the maximum size of the C stack.
+
+.SH KEYWORDS
+nesting depth, recursion
diff --git a/tcl/doc/SetResult.3 b/tcl/doc/SetResult.3
new file mode 100644
index 00000000000..918843c1224
--- /dev/null
+++ b/tcl/doc/SetResult.3
@@ -0,0 +1,217 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_SetResult 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+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
+char *
+\fBTcl_GetStringResult\fR(\fIinterp\fR)
+.sp
+\fBTcl_AppendResult\fR(\fIinterp, string, string, ... , \fB(char *) NULL\fR)
+.sp
+\fBTcl_AppendElement\fR(\fIinterp, string\fR)
+.sp
+\fBTcl_ResetResult\fR(\fIinterp\fR)
+.sp
+\fBTcl_FreeResult\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_FreeProc freeProc
+.AP Tcl_Interp *interp out
+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 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
+\fBTCL_VOLATILE\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+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_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
+\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 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
+\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
+to the current result associated with \fIinterp\fR.
+If the result is in its initialized empty state (e.g. a command procedure
+was just invoked or \fBTcl_ResetResult\fR was just called),
+then \fBTcl_AppendResult\fR sets the result to the concatenation of
+its \fIstring\fR arguments.
+\fBTcl_AppendResult\fR may be called repeatedly as additional pieces
+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.
+.PP
+\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
+that it allows results to be built up in pieces.
+However, \fBTcl_AppendElement\fR takes only a single \fIstring\fR
+argument and it appends that argument to the current result
+as a proper Tcl list element.
+\fBTcl_AppendElement\fR adds backslashes or braces if necessary
+to ensure that \fIinterp\fR's result can be parsed as a list and that
+\fIstring\fR will be extracted as a single element.
+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.
+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.
+.PP
+\fBTcl_FreeResult\fR performs part of the work
+of \fBTcl_ResetResult\fR.
+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_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp
+
+.SH KEYWORDS
+append, command, element, list, object, result, return value, interpreter
diff --git a/tcl/doc/SetVar.3 b/tcl/doc/SetVar.3
new file mode 100644
index 00000000000..7de2f44651d
--- /dev/null
+++ b/tcl/doc/SetVar.3
@@ -0,0 +1,204 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_SetVar 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SetVar, Tcl_SetVar2, Tcl_GetVar, Tcl_GetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_SetVar\fR(\fIinterp, varName, newValue, flags\fR)
+.sp
+char *
+\fBTcl_SetVar2\fR(\fIinterp, name1, name2, newValue, flags\fR)
+.sp
+char *
+\fBTcl_GetVar\fR(\fIinterp, varName, flags\fR)
+.sp
+char *
+\fBTcl_GetVar2\fR(\fIinterp, name1, name2, flags\fR)
+.sp
+int
+\fBTcl_UnsetVar\fR(\fIinterp, varName, flags\fR)
+.sp
+int
+\fBTcl_UnsetVar2\fR(\fIinterp, name1, name2, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *newValue
+.AP Tcl_Interp *interp in
+Interpreter containing variable.
+.AP char *varName in
+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.
+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.
+.AP char *newValue in
+New value for variable.
+.AP int flags in
+OR-ed combination of bits providing additional information for
+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.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures may be used to create, modify, read, and delete
+Tcl variables from C code.
+.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
+variable structure.
+Tcl keeps a private copy of the variable's value, so the caller
+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),
+they return NULL.
+.PP
+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
+close parenthesis, then the value between the parentheses is
+treated as an index (which can have any string value) and
+the characters before the first open
+parenthesis are treated as the name of an array variable.
+If \fIvarName\fR doesn't have parentheses as described above, then
+the entire string is treated as the name of a scalar variable.
+If \fBTcl_SetVar2\fR is called, then the array name and index
+have been separated by the caller into two separate strings,
+\fIname1\fR and \fIname2\fR respectively;  if \fIname2\fR is
+zero it means that a scalar variable is being referenced.
+.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 the following bits.
+Note that the flag bit TCL_PARSE_PART1 is only meaningful
+for the procedures Tcl_SetVar2 and Tcl_GetVar2.
+.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 \fInewValue\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 \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
+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 when calling \fITcl_SetVar2\fR and \fITcl_GetVar2\fR,
+\fIname1\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,
+\fIname2\fR should be NULL since the array and element names
+are taken from \fIname1\fR.
+.PP
+\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
+to the variable's value (which is stored in Tcl's variable
+structure and will not change before the next call to \fBTcl_SetVar\fR
+or \fBTcl_SetVar2\fR).
+\fBTcl_GetVar\fR and \fBTcl_GetVar2\fR use the flag bits TCL_GLOBAL_ONLY
+and TCL_LEAVE_ERR_MSG, both of
+which have
+the same meaning as for \fBTcl_SetVar\fR.
+In addition, \fBTcl_GetVar2\fR uses the bit TCL_PARSE_PART1,
+which has the same meaning as for \fBTcl_SetVar2\fR.
+If an error occurs in reading the variable (e.g. the variable
+doesn't exist or an array element is specified for a scalar
+variable), then NULL is returned.
+.PP
+\fBTcl_UnsetVar\fR and \fBTcl_UnsetVar2\fR may be used to remove
+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.
+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.
+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_GetObjResult, Tcl_GetStringResult, Tcl_ObjGetVar2, Tcl_ObjSetVar2, Tcl_TraceVar
+
+.SH KEYWORDS
+array, interpreter, object, scalar, set, unset, variable
diff --git a/tcl/doc/Sleep.3 b/tcl/doc/Sleep.3
new file mode 100644
index 00000000000..dc5bdb7a5a0
--- /dev/null
+++ b/tcl/doc/Sleep.3
@@ -0,0 +1,37 @@
+'\"
+'\" Copyright (c) 1990 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Sleep \- delay execution for a given number of milliseconds
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_Sleep\fR(\fIms\fR)
+.SH ARGUMENTS
+.AP int ms in
+Number of milliseconds to sleep.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure delays the calling process by the number of
+milliseconds given by the \fIms\fR parameter and returns
+after that time has elapsed.  It is typically used for things
+like flashing a button, where the delay is short and the
+application needn't do anything while it waits.  For longer
+delays where the application needs to respond to other events
+during the delay, the procedure \fBTcl_CreateTimerHandler\fR
+should be used instead of \fBTcl_Sleep\fR.
+
+.SH KEYWORDS
+sleep, time, wait
diff --git a/tcl/doc/SplitList.3 b/tcl/doc/SplitList.3
new file mode 100644
index 00000000000..8db202d2117
--- /dev/null
+++ b/tcl/doc/SplitList.3
@@ -0,0 +1,191 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_SplitList 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement \- manipulate Tcl lists
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
+.sp
+char *
+\fBTcl_Merge\fR(\fIargc, argv\fR)
+.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
+.VS
+Interpreter to use for error reporting.  If NULL, then no error message
+is left.
+.VE
+.AP char *list in
+Pointer to a string with proper list structure.
+.AP int *argcPtr out
+Filled in with number of elements in \fIlist\fR.
+.AP char ***argvPtr out
+\fI*argvPtr\fR will be filled in with the address of an array of
+pointers to the strings that are the extracted elements of \fIlist\fR.
+There will be \fI*argcPtr\fR valid entries in the array, followed by
+a NULL entry.
+.AP int argc in
+Number of elements in \fIargv\fR.
+.AP char **argv in
+Array of strings to merge together into a single list.
+Each string will become a separate element of the list.
+.AP char *src in
+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.
+.AP int flags in
+Information about \fIsrc\fR. Must be value returned by previous
+call to \fBTcl_ScanElement\fR, possibly OR-ed
+with \fBTCL_DONT_USE_BRACES\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures may be used to disassemble and reassemble Tcl lists.
+\fBTcl_SplitList\fR breaks a list up into its constituent elements,
+returning an array of pointers to the elements using
+\fIargcPtr\fR and \fIargvPtr\fR.
+While extracting the arguments, \fBTcl_SplitList\fR obeys the usual
+rules for backslash substitutions and braces.  The area of
+memory pointed to by \fI*argvPtr\fR is dynamically allocated;  in
+addition to the array of pointers, it
+also holds copies of all the list elements.  It is the caller's
+responsibility to free up all of this storage.
+For example, suppose that you have called \fBTcl_SplitList\fR with
+the following code:
+.CS
+int argc, code;
+char *string;
+char **argv;
+\&...
+code = Tcl_SplitList(interp, string, &argc, &argv);
+.CE
+Then you should eventually free the storage with a call like the
+following:
+.VS
+.CS
+Tcl_Free((char *) argv);
+.CE
+.VE
+.PP
+\fBTcl_SplitList\fR normally returns \fBTCL_OK\fR, which means the list was
+successfully parsed.
+If there was a syntax error in \fIlist\fR, then \fBTCL_ERROR\fR is returned
+and \fIinterp->result\fR will point to an error message describing the
+.VS
+problem (if \fIinterp\fR was not NULL).
+.VE
+If \fBTCL_ERROR\fR is returned then no memory is allocated and \fI*argvPtr\fR
+is not modified.
+.PP
+\fBTcl_Merge\fR is the inverse of \fBTcl_SplitList\fR:  it
+takes a collection of strings given by \fIargc\fR
+and \fIargv\fR and generates a result string
+that has proper list structure.
+This means that commands like \fBindex\fR may be used to
+extract the original elements again.
+In addition, if the result of \fBTcl_Merge\fR is passed to \fBTcl_Eval\fR,
+it will be parsed into \fIargc\fR words whose values will
+be the same as the \fIargv\fR strings passed to \fBTcl_Merge\fR.
+\fBTcl_Merge\fR will modify the list elements with braces and/or
+backslashes in order to produce proper Tcl list structure.
+.VS
+The result string is dynamically allocated
+using \fBTcl_Alloc\fR;  the caller must eventually release the space
+using \fBTcl_Free\fR.
+.VE
+.PP
+If the result of \fBTcl_Merge\fR is passed to \fBTcl_SplitList\fR,
+the elements returned by \fBTcl_SplitList\fR will be identical to
+those passed into \fBTcl_Merge\fR.
+However, the converse is not true:  if \fBTcl_SplitList\fR
+is passed a given string, and the resulting \fIargc\fR and
+\fIargv\fR are passed to \fBTcl_Merge\fR, the resulting string
+may not be the same as the original string passed to \fBTcl_SplitList\fR.
+This is because \fBTcl_Merge\fR may use backslashes and braces
+differently than the original string.
+.PP
+\fBTcl_ScanElement\fR and \fBTcl_ConvertElement\fR are the
+procedures that do all of the real work of \fBTcl_Merge\fR.
+\fBTcl_ScanElement\fR scans its \fIsrc\fR argument
+and determines how to use backslashes and braces
+when converting it to a list element.
+It returns an overestimate of the number of characters
+required to represent \fIsrc\fR as a list element, and
+it stores information in \fI*flagsPtr\fR that is needed
+by \fBTcl_ConvertElement\fR.
+.PP
+\fBTcl_ConvertElement\fR is a companion procedure to \fBTcl_ScanElement\fR.
+It does the actual work of converting a string to a list element.
+Its \fIflags\fR argument must be the same as the value returned
+by \fBTcl_ScanElement\fR.
+\fBTcl_ConvertElement\fR writes a proper list element to memory
+starting at *\fIdst\fR and returns a count of the total number
+of characters written, which will be no more than the result
+returned by \fBTcl_ScanElement\fR.
+\fBTcl_ConvertElement\fR writes out only the actual list element
+without any leading or trailing spaces: it is up to the caller to
+include spaces between adjacent list elements.
+.PP
+\fBTcl_ConvertElement\fR uses one of two different approaches to
+handle the special characters in \fIsrc\fR.  Wherever possible, it
+handles special characters by surrounding the string with braces.
+This produces clean-looking output, but can't be used in some situations,
+such as when \fIsrc\fR contains unmatched braces.
+In these situations, \fBTcl_ConvertElement\fR handles special
+characters by generating backslash sequences for them.
+The caller may insist on the second approach by OR-ing the
+flag value returned by \fBTcl_ScanElement\fR with
+\fBTCL_DONT_USE_BRACES\fR.
+Although this will produce an uglier result, it is useful in some
+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/tcl/doc/SplitPath.3 b/tcl/doc/SplitPath.3
new file mode 100644
index 00000000000..7491a40e014
--- /dev/null
+++ b/tcl/doc/SplitPath.3
@@ -0,0 +1,93 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SplitPath, Tcl_JoinPath, Tcl_GetPathType \- manipulate platform-dependent file paths
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_SplitPath\fR(\fIpath, argcPtr, argvPtr\fR)
+.sp
+char *
+\fBTcl_JoinPath\fR(\fIargc, argv, resultPtr\fR)
+.sp
+Tcl_PathType
+\fBTcl_GetPathType\fR(\fIpath\fR)
+.SH ARGUMENTS
+.AS Tcl_DString ***argvPtr
+.AP char *path in
+File path in a form appropriate for the current platform (see the
+\fBfilename\fR manual entry for acceptable forms for path names).
+.AP int *argcPtr out
+Filled in with number of path elements in \fIpath\fR.
+.AP char ***argvPtr out
+\fI*argvPtr\fR will be filled in with the address of an array of
+pointers to the strings that are the extracted elements of \fIpath\fR.
+There will be \fI*argcPtr\fR valid entries in the array, followed by
+a NULL entry.
+.AP int argc in
+Number of elements in \fIargv\fR.
+.AP char **argv in
+Array of path elements to merge together into a single path.
+.AP Tcl_DString *resultPtr in/out
+A pointer to an initialized \fBTcl_DString\fR to which the result of
+\fBTcl_JoinPath\fR will be appended.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures may be used to disassemble and reassemble file
+paths in a platform independent manner: they provide C-level access to
+the same functionality as the \fBfile split\fR, \fBfile join\fR, and
+\fBfile pathtype\fR commands.
+.PP
+\fBTcl_SplitPath\fR breaks a path into its constituent elements,
+returning an array of pointers to the elements using \fIargcPtr\fR and
+\fIargvPtr\fR.  The area of memory pointed to by \fI*argvPtr\fR is
+dynamically allocated; in addition to the array of pointers, it also
+holds copies of all the path elements.  It is the caller's
+responsibility to free all of this storage.
+For example, suppose that you have called \fBTcl_SplitPath\fR with the
+following code:
+.CS
+int argc;
+char *path;
+char **argv;
+\&...
+Tcl_SplitPath(string, &argc, &argv);
+.CE
+Then you should eventually free the storage with a call like the
+following:
+.CS
+Tcl_Free((char *) argv);
+.CE
+.PP
+\fBTcl_JoinPath\fR is the inverse of \fBTcl_SplitPath\fR: it takes a
+collection of path elements given by \fIargc\fR and \fIargv\fR and
+generates a result string that is a properly constructed path. The
+result string is appended to \fIresultPtr\fR.  \fIResultPtr\fR must
+refer to an initialized \fBTcl_DString\fR.
+.PP
+If the result of \fBTcl_SplitPath\fR is passed to \fBTcl_JoinPath\fR,
+the result will refer to the same location, but may not be in the same
+form.  This is because \fBTcl_SplitPath\fR and \fBTcl_JoinPath\fR
+eliminate duplicate path separators and return a normalized form for
+each platform.
+.PP
+\fBTcl_GetPathType\fR returns the type of the specified \fIpath\fR,
+where \fBTcl_PathType\fR is one of \fBTCL_PATH_ABSOLUTE\fR,
+\fBTCL_PATH_RELATIVE\fR, or \fBTCL_PATH_VOLUME_RELATIVE\fR.  See the
+\fBfilename\fR manual entry for a description of the path types for
+each platform.
+
+.SH KEYWORDS
+file, filename, join, path, split, type
diff --git a/tcl/doc/StaticPkg.3 b/tcl/doc/StaticPkg.3
new file mode 100644
index 00000000000..f5295d215bb
--- /dev/null
+++ b/tcl/doc/StaticPkg.3
@@ -0,0 +1,70 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_StaticPackage \- make a statically linked package available via the \fBload\fR command
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_StaticPackage\fR(\fIinterp, pkgName, initProc, safeInitProc\fR)
+.SH ARGUMENTS
+.AS Tcl_PackageInitProc *safeInitProc
+.AP Tcl_Interp *interp in
+If not NULL, points to an interpreter into which the package has
+already been loaded (i.e., the caller has already invoked the
+appropriate initialization procedure).  NULL means the package
+hasn't yet been incorporated into any interpreter.
+.AP char *pkgName in
+Name of the package;  should be properly capitalized (first letter
+upper-case, all others lower-case).
+.AP Tcl_PackageInitProc *initProc in
+Procedure to invoke to incorporate this package into a trusted
+interpreter.
+.AP Tcl_PackageInitProc *safeInitProc in
+Procedure to call to incorporate this package into a safe interpreter
+(one that will execute untrusted scripts).   NULL means the package
+can't be used in safe interpreters.
+.BE
+
+.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
+has already been loaded into an interpreter.
+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
+be invoked, depending on whether the target interpreter is safe
+or not.
+\fIinitProc\fR and \fIsafeInitProc\fR must both match the
+following prototype:
+.CS
+typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
+.CE
+The \fIinterp\fR argument identifies the interpreter in which the
+package is to be loaded.  The initialization procedure must return
+\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
+successfully;  in the event of an error it should set \fIinterp->result\fR
+to point to an error message.
+The result or error from the initialization procedure will be returned
+as the result of the \fBload\fR command that caused the
+initialization procedure to be invoked.
+
+.SH KEYWORDS
+initialization procedure, package, static linking
diff --git a/tcl/doc/StrMatch.3 b/tcl/doc/StrMatch.3
new file mode 100644
index 00000000000..ea17d0b17f1
--- /dev/null
+++ b/tcl/doc/StrMatch.3
@@ -0,0 +1,39 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_StringMatch 3 "" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_StringMatch \- test whether a string matches a pattern
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_StringMatch\fR(\fIstring\fR, \fIpattern\fR)
+.SH ARGUMENTS
+.AP char *string in
+String to test.
+.AP char *pattern in
+Pattern to match against string.  May contain special
+characters from the set *?\e[].
+.BE
+
+.SH DESCRIPTION
+.PP
+This utility procedure determines whether a string matches
+a given pattern.  If it does, then \fBTcl_StringMatch\fR returns
+1.  Otherwise \fBTcl_StringMatch\fR returns 0.  The algorithm
+used for matching is the same algorithm used in the ``string match''
+Tcl command and is similar to the algorithm used by the C-shell
+for file name matching;  see the Tcl manual entry for details.
+
+.SH KEYWORDS
+match, pattern, string
diff --git a/tcl/doc/StringObj.3 b/tcl/doc/StringObj.3
new file mode 100644
index 00000000000..e3766ca5284
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/Tcl.n b/tcl/doc/Tcl.n
new file mode 100644
index 00000000000..47f2faa3012
--- /dev/null
+++ b/tcl/doc/Tcl.n
@@ -0,0 +1,181 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'
+.so man.macros
+.TH Tcl n "" Tcl "Tcl Built-In Commands"
+.BS
+.SH NAME
+Tcl \- Summary of Tcl language syntax.
+.BE
+
+.SH DESCRIPTION
+.PP
+The following rules define the syntax and semantics of the Tcl language:
+.IP [1]
+A Tcl script is a string containing one or more commands.
+Semi-colons and newlines are command separators unless quoted as
+described below.
+Close brackets are command terminators during command substitution
+(see below) unless quoted.
+.IP [2]
+A command is evaluated in two steps.
+First, the Tcl interpreter breaks the command into \fIwords\fR
+and performs substitutions as described below.
+These substitutions are performed in the same way for all
+commands.
+The first word is used to locate a command procedure to
+carry out the command, then all of the words of the command are
+passed to the command procedure.
+The command procedure is free to interpret each of its words
+in any way it likes, such as an integer, variable name, list,
+or Tcl script.
+Different commands interpret their words differently.
+.IP [3]
+Words of a command are separated by white space (except for
+newlines, which are command separators).
+.IP [4]
+If the first character of a word is double-quote (``"'') then
+the word is terminated by the next double-quote character.
+If semi-colons, close brackets, or white space characters
+(including newlines) appear between the quotes then they are treated
+as ordinary characters and included in the word.
+Command substitution, variable substitution, and backslash substitution
+are performed on the characters between the quotes as described below.
+The double-quotes are not retained as part of the word.
+.IP [5]
+If the first character of a word is an open brace (``{'') then
+the word is terminated by the matching close brace (``}'').
+Braces nest within the word: for each additional open
+brace there must be an additional close brace (however,
+if an open brace or close brace within the word is
+quoted with a backslash then it is not counted in locating the
+matching close brace).
+No substitutions are performed on the characters between the
+braces except for backslash-newline substitutions described
+below, nor do semi-colons, newlines, close brackets,
+or white space receive any special interpretation.
+The word will consist of exactly the characters between the
+outer braces, not including the braces themselves.
+.IP [6]
+If a word contains an open bracket (``['') then Tcl performs
+\fIcommand substitution\fR.
+To do this it invokes the Tcl interpreter recursively to process
+the characters following the open bracket as a Tcl script.
+The script may contain any number of commands and must be terminated
+by a close bracket (``]'').
+The result of the script (i.e. the result of its last command) is
+substituted into the word in place of the brackets and all of the
+characters between them.
+There may be any number of command substitutions in a single word.
+Command substitution is not performed on words enclosed in braces.
+.IP [7]
+If a word contains a dollar-sign (``$'') then Tcl performs \fIvariable
+substitution\fR:  the dollar-sign and the following characters are
+replaced in the word by the value of a variable.
+Variable substitution may take any of the following forms:
+.RS
+.TP 15
+\fB$\fIname\fR
+\fIName\fR is the name of a scalar variable;  the name is terminated
+by any character that isn't a letter, digit, or underscore.
+.TP 15
+\fB$\fIname\fB(\fIindex\fB)\fR
+\fIName\fR gives the name of an array variable and \fIindex\fR gives
+the name of an element within that array.
+\fIName\fR must contain only letters, digits, and underscores.
+Command substitutions, variable substitutions, and backslash
+substitutions are performed on the characters of \fIindex\fR.
+.TP 15
+\fB${\fIname\fB}\fR
+\fIName\fR is the name of a scalar variable.  It may contain any
+characters whatsoever except for close braces.
+.LP
+There may be any number of variable substitutions in a single word.
+Variable substitution is not performed on words enclosed in braces.
+.RE
+.IP [8]
+If a backslash (``\e'') appears within a word then
+\fIbackslash substitution\fR occurs.
+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.
+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
+.TP 6
+\e\fBa\fR
+Audible alert (bell) (0x7).
+.TP 6
+\e\fBb\fR
+Backspace (0x8).
+.TP 6
+\e\fBf\fR
+Form feed (0xc).
+.TP 6
+\e\fBn\fR
+Newline (0xa).
+.TP 6
+\e\fBr\fR
+Carriage-return (0xd).
+.TP 6
+\e\fBt\fR
+Tab (0x9).
+.TP 6
+\e\fBv\fR
+Vertical tab (0xb).
+.TP 6
+\e\fB<newline>\fIwhiteSpace\fR
+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
+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.
+.TP 6
+\e\e
+Backslash (``\e'').
+.TP 6
+\e\fIooo\fR
+The digits \fIooo\fR (one, two, or three of them) give the octal value of
+the character.
+.TP 6
+\e\fBx\fIhh\fR
+The hexadecimal digits \fIhh\fR give the hexadecimal value of
+the character.  Any number of digits may be present.
+.LP
+Backslash substitution is not performed on words enclosed in braces,
+except for backslash-newline as described above.
+.RE
+.IP [9]
+If a hash character (``#'') appears at a point where Tcl is
+expecting the first character of the first word of a command,
+then the hash character and the characters that follow it, up
+through the next newline, are treated as a comment and ignored.
+The comment character only has significance when it appears
+at the beginning of a command.
+.IP [10]
+Each character is processed exactly once by the Tcl interpreter
+as part of creating the words of a command.
+For example, if variable substitution occurs then no further
+substitutions are performed on the value of the variable;  the
+value is inserted into the word verbatim.
+If command substitution occurs then the nested command is
+processed entirely by the recursive call to the Tcl interpreter;
+no substitutions are performed before making the recursive
+call and no additional substitutions are performed on the result
+of the nested script.
+.IP [11]
+Substitutions do not affect the word boundaries of a command.
+For example, during variable substitution the entire value of
+the variable becomes part of a single word, even if the variable's
+value contains spaces.
diff --git a/tcl/doc/Tcl_Main.3 b/tcl/doc/Tcl_Main.3
new file mode 100644
index 00000000000..75549225629
--- /dev/null
+++ b/tcl/doc/Tcl_Main.3
@@ -0,0 +1,61 @@
+'\"
+'\" Copyright (c) 1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_Main 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Main \- main program for Tcl-based applications
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_Main\fR(\fIargc, argv, appInitProc\fR)
+.SH ARGUMENTS
+.AS Tcl_AppInitProc *appInitProc
+.AP int argc in
+Number of elements in \fIargv\fR.
+.AP char *argv[] in
+Array of strings containing command-line arguments.
+.AP Tcl_AppInitProc *appInitProc in
+Address of an application-specific initialization procedure.
+The value for this argument is usually \fBTcl_AppInit\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_Main\fR acts as the main program for most Tcl-based applications.
+Starting with Tcl 7.4 it is not called \fBmain\fR anymore because it 
+is part of the Tcl library and having a function \fBmain\fR
+in a library (particularly a shared library) causes problems on many
+systems.
+Having \fBmain\fR in the Tcl library would also make it hard to use
+Tcl in C++ programs, since C++ programs must have special C++
+\fBmain\fR functions.
+.PP
+Normally each application contains a small \fBmain\fR function that does
+nothing but invoke \fBTcl_Main\fR.
+\fBTcl_Main\fR then does all the work of creating and running a
+\fBtclsh\fR-like application.
+.PP
+When it is has finished its own initialization, but before
+it processes commands, \fBTcl_Main\fR calls the procedure given by
+the \fIappInitProc\fR argument.  This procedure provides a ``hook''
+for the application to perform its own initialization, such as defining
+application-specific commands.  The procedure must have an interface
+that matches the type \fBTcl_AppInitProc\fR:
+.CS
+typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR);
+.CE
+\fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR;
+for more details on this procedure, see the documentation
+for \fBTcl_AppInit\fR.
+
+.SH KEYWORDS
+application-specific initialization, command-line arguments, main program
diff --git a/tcl/doc/TraceVar.3 b/tcl/doc/TraceVar.3
new file mode 100644
index 00000000000..b45e754f3c8
--- /dev/null
+++ b/tcl/doc/TraceVar.3
@@ -0,0 +1,348 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_TraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR
+.sp
+int
+\fBTcl_TraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
+.sp
+\fBTcl_UntraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR
+.sp
+\fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
+.sp
+ClientData
+\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR
+.sp
+ClientData
+\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR
+.SH ARGUMENTS
+.AS Tcl_VarTraceProc prevClientData
+.AP Tcl_Interp *interp in
+Interpreter containing variable.
+.AP char *varName in
+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.
+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.
+.AP int flags in
+OR-ed combination of the values TCL_TRACE_READS, TCL_TRACE_WRITES, and
+TCL_TRACE_UNSETS, TCL_PARSE_PART1, and TCL_GLOBAL_ONLY.  
+Not all flags are used by all
+procedures.  See below for more information.
+.AP Tcl_VarTraceProc *proc in
+Procedure to invoke whenever one of the traced operations occurs.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.AP char *name1 in
+Name of scalar or array variable (without array index).
+.AP char *name2 in
+For a trace on an element of an array, gives the index of the
+element.  For traces on scalar variables or on whole arrays,
+is NULL.
+.AP ClientData prevClientData in
+If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or
+\fBTcl_VarTraceInfo2\fR, so this call will return information about
+next trace.  If NULL, this call will return information about first
+trace.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_TraceVar\fR allows a C procedure to monitor and control
+access to a Tcl variable, so that the C procedure is invoked
+whenever the variable is read or written or unset.
+If the trace is created successfully then \fBTcl_TraceVar\fR returns
+TCL_OK.  If an error occurred (e.g. \fIvarName\fR specifies an element
+of an array, but the actual variable isn't an array) then TCL_ERROR
+is returned and an error message is left in \fIinterp->result\fR.
+.PP
+The \fIflags\fR argument to \fBTcl_TraceVar\fR indicates when the
+trace procedure is to be invoked and provides information
+for setting up the trace.  It consists of an OR-ed combination
+of any of the following values:
+.TP
+\fBTCL_GLOBAL_ONLY\fR
+Normally, the variable will be looked up at the current level of
+procedure call;  if this bit is set then the variable will be looked
+up at global level, ignoring any active procedures.
+.TP
+\fBTCL_TRACE_READS\fR
+Invoke \fIproc\fR whenever an attempt is made to read the variable.
+.TP
+\fBTCL_TRACE_WRITES\fR
+Invoke \fIproc\fR whenever an attempt is made to modify the variable.
+.TP
+\fBTCL_TRACE_UNSETS\fR
+Invoke \fIproc\fR whenever the variable is unset.
+A variable may be unset either explicitly by an \fBunset\fR command,
+or implicitly when a procedure returns (its local variables are
+automatically unset) or when the interpreter is deleted (all
+variables are automatically unset).
+.PP
+Whenever one of the specified operations occurs on the variable,
+\fIproc\fR will be invoked.
+It should have arguments and result that match the type
+\fBTcl_VarTraceProc\fR:
+.CS
+typedef char *Tcl_VarTraceProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	char *\fIname1\fR,
+	char *\fIname2\fR,
+	int \fIflags\fR);
+.CE
+The \fIclientData\fR and \fIinterp\fR parameters will
+have the same values as those passed to \fBTcl_TraceVar\fR when the
+trace was created.
+\fIClientData\fR typically points to an application-specific
+data structure that describes what to do when \fIproc\fR
+is invoked.
+\fIName1\fR and \fIname2\fR give the name of the traced variable
+in the normal two-part form (see the description of \fBTcl_TraceVar2\fR
+below for details).
+\fIFlags\fR is an OR-ed combination of bits providing several
+pieces of information.
+One of the bits TCL_TRACE_READS, TCL_TRACE_WRITES, or TCL_TRACE_UNSETS
+will be set in \fIflags\fR to indicate which operation is being performed
+on the variable.
+The bit TCL_GLOBAL_ONLY will be set whenever the variable being
+accessed is a global one not accessible from the current level of
+procedure call:  the trace procedure will need to pass this flag
+back to variable-related procedures like \fBTcl_GetVar\fR if it
+attempts to access the variable.
+The bit TCL_TRACE_DESTROYED will be set in \fIflags\fR if the trace is
+about to be destroyed;  this information may be useful to \fIproc\fR
+so that it can clean up its own internal data structures (see
+the section TCL_TRACE_DESTROYED below for more details).
+Lastly, the bit TCL_INTERP_DESTROYED will be set if the entire
+interpreter is being destroyed.
+When this bit is set, \fIproc\fR must be especially careful in
+the things it does (see the section TCL_INTERP_DESTROYED below).
+The trace procedure's return value should normally be NULL;  see
+ERROR RETURNS below for information on other possibilities.
+.PP
+\fBTcl_UntraceVar\fR may be used to remove a trace.
+If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR
+has a trace set with \fIflags\fR, \fIproc\fR, and
+\fIclientData\fR, then the corresponding trace is removed.
+If no such trace exists, then the call to \fBTcl_UntraceVar\fR
+has no effect.
+The same bits are valid for \fIflags\fR as for calls to \fBTcl_TraceVar\fR.
+.PP
+\fBTcl_VarTraceInfo\fR may be used to retrieve information about
+traces set on a given variable.
+The return value from \fBTcl_VarTraceInfo\fR is the \fIclientData\fR
+associated with a particular trace.
+The trace must be on the variable specified by the \fIinterp\fR,
+\fIvarName\fR, and \fIflags\fR arguments (only the TCL_GLOBAL_ONLY
+bit from \fIflags\fR is used;  other bits are ignored) and its trace procedure
+must the same as the \fIproc\fR argument.
+If the \fIprevClientData\fR argument is NULL then the return
+value corresponds to the first (most recently created) matching
+trace, or NULL if there are no matching traces.
+If the \fIprevClientData\fR argument isn't NULL, then it should
+be the return value from a previous call to \fBTcl_VarTraceInfo\fR.
+In this case, the new return value will correspond to the next
+matching trace after the one whose \fIclientData\fR matches
+\fIprevClientData\fR, or NULL if no trace matches \fIprevClientData\fR
+or if there are no more matching traces after it.
+This mechanism makes it possible to step through all of the
+traces for a given variable that have the same \fIproc\fR.
+
+.SH "TWO-PART NAMES"
+.PP
+The procedures \fBTcl_TraceVar2\fR, \fBTcl_UntraceVar2\fR, and
+\fBTcl_VarTraceInfo2\fR are identical to \fBTcl_TraceVar\fR,
+\fBTcl_UntraceVar\fR, and \fBTcl_VarTraceInfo\fR, respectively,
+except that the name of the variable consists of two parts.
+\fIName1\fR gives the name of a scalar variable or array,
+and \fIname2\fR gives the name of an element within an array.
+If \fIname2\fR is NULL it means that either the variable is
+a scalar or the trace is to be set on the entire array rather
+than an individual element (see WHOLE-ARRAY TRACES below for
+more information).
+As a special case, if the flag TCL_PARSE_PART1 is specified,
+\fIname1\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,
+\fIname2\fR should be NULL since the array and element names
+are taken from \fIname1\fR.
+
+.SH "ACCESSING VARIABLES DURING TRACES"
+.PP
+During read and write traces, the
+trace procedure can read, write, or unset the traced
+variable using \fBTcl_GetVar2\fR, \fBTcl_SetVar2\fR, and
+other procedures.
+While \fIproc\fR is executing, traces are temporarily disabled
+for the variable, so that calls to \fBTcl_GetVar2\fR and
+\fBTcl_SetVar2\fR will not cause \fIproc\fR or other trace procedures
+to be invoked again.
+Disabling only occurs for the variable whose trace procedure
+is active;  accesses to other variables will still be traced.
+However, if a variable is unset during a read or write trace then unset
+traces will be invoked.
+.PP
+During unset traces the variable has already been completely
+expunged.
+It is possible for the trace procedure to read or write the
+variable, but this will be a new version of the variable.
+Traces are not disabled during unset traces as they are for
+read and write traces, but existing traces have been removed
+from the variable before any trace procedures are invoked.
+If new traces are set by unset trace procedures, these traces
+will be invoked on accesses to the variable by the trace
+procedures.
+
+.SH "CALLBACK TIMING"
+.PP
+When read tracing has been specified for a variable, the trace
+procedure will be invoked whenever the variable's value is
+read.  This includes \fBset\fR Tcl commands, \fB$\fR-notation
+in Tcl commands, and invocations of the \fBTcl_GetVar\fR
+and \fBTcl_GetVar2\fR procedures.
+\fIProc\fR is invoked just before the variable's value is
+returned.
+It may modify the value of the variable to affect what
+is returned by the traced access.
+If it unsets the variable then the access will return an error
+just as if the variable never existed.
+.PP
+When write tracing has been specified for a variable, the
+trace procedure will be invoked whenever the variable's value
+is modified.  This includes \fBset\fR commands,
+commands that modify variables as side effects (such as
+\fBcatch\fR and \fBscan\fR), and calls to the \fBTcl_SetVar\fR
+and \fBTcl_SetVar2\fR procedures).
+\fIProc\fR will be invoked after the variable's value has been
+modified, but before the new value of the variable has been
+returned.
+It may modify the value of the variable to override the change
+and to determine the value actually returned by the traced
+access.
+If it deletes the variable then the traced access will return
+an empty string.
+.PP
+When unset tracing has been specified, the trace procedure
+will be invoked whenever the variable is destroyed.
+The traces will be called after the variable has been
+completely unset.
+
+.SH "WHOLE-ARRAY TRACES"
+.PP
+If a call to \fBTcl_TraceVar\fR or \fBTcl_TraceVar2\fR specifies
+the name of an array variable without an index into the array,
+then the trace will be set on the array as a whole.
+This means that \fIproc\fR will be invoked whenever any
+element of the array is accessed in the ways specified by
+\fIflags\fR.
+When an array is unset, a whole-array trace will be invoked
+just once, with \fIname1\fR equal to the name of the array
+and \fIname2\fR NULL;  it will not be invoked once for each
+element.
+
+.SH "MULTIPLE TRACES"
+.PP
+It is possible for multiple traces to exist on the same variable.
+When this happens, all of the trace procedures will be invoked on each
+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.
+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.
+
+.SH "ERROR RETURNS"
+.PP
+Under normal conditions trace procedures should return NULL, indicating
+successful completion.
+If \fIproc\fR returns a non-NULL value it signifies that an
+error occurred.
+The return value must be a pointer to a static character string
+containing an error message.
+If a trace procedure returns an error, no further traces are
+invoked for the access and the traced access aborts with the
+given message.
+Trace procedures can use this facility to make variables
+read-only, for example (but note that the value of the variable
+will already have been modified before the trace procedure is
+called, so the trace procedure will have to restore the correct
+value).
+.PP
+The return value from \fIproc\fR is only used during read and
+write tracing.
+During unset traces, the return value is ignored and all relevant
+trace procedures will always be invoked.
+
+.SH "RESTRICTIONS"
+.PP
+A trace procedure can be called at any time, even when there
+is a partially-formed result in the interpreter's result area.  If
+the trace procedure does anything that could damage this result (such
+as calling \fBTcl_Eval\fR) then it must save the original values of
+the interpreter's \fBresult\fR and \fBfreeProc\fR fields and restore
+them before it returns.
+
+.SH "UNDEFINED VARIABLES"
+.PP
+It is legal to set a trace on an undefined variable.
+The variable will still appear to be undefined until the
+first time its value is set.
+If an undefined variable is traced and then unset, the unset will fail
+with an error (``no such variable''), but the trace
+procedure will still be invoked.
+
+.SH "TCL_TRACE_DESTROYED FLAG"
+.PP
+In an unset callback to \fIproc\fR, the TCL_TRACE_DESTROYED bit
+is set in \fIflags\fR if the trace is being removed as part
+of the deletion.
+Traces on a variable are always removed whenever the variable
+is deleted;  the only time TCL_TRACE_DESTROYED isn't set is for
+a whole-array trace invoked when only a single element of an
+array is unset.
+
+.SH "TCL_INTERP_DESTROYED"
+.PP
+When an interpreter is destroyed, unset traces are called for
+all of its variables.
+The TCL_INTERP_DESTROYED bit will be set in the \fIflags\fR
+argument passed to the trace procedures.
+Trace procedures must be extremely careful in what they do if
+the TCL_INTERP_DESTROYED bit is set.
+It is not safe for the procedures to invoke any Tcl procedures
+on the interpreter, since its state is partially deleted.
+All that trace procedures should do under these circumstances is
+to clean up and free their own internal data structures.
+
+.SH BUGS
+.PP
+Tcl doesn't do any error checking to prevent trace procedures
+from misusing the interpreter during traces with TCL_INTERP_DESTROYED
+set.
+
+.SH KEYWORDS
+clientData, trace, variable
diff --git a/tcl/doc/Translate.3 b/tcl/doc/Translate.3
new file mode 100644
index 00000000000..9ebf1d16404
--- /dev/null
+++ b/tcl/doc/Translate.3
@@ -0,0 +1,66 @@
+'\"
+'\" Copyright (c) 1989-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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_TranslateFileName 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_TranslateFileName\fR(\fIinterp\fR, \fIname\fR, \fIbufferPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_DString *bufferPtr
+.AP Tcl_Interp *interp in
+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
+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.
+.BE
+
+.SH DESCRIPTION
+.PP
+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.
+.PP
+If
+\fBTcl_TranslateFileName\fR has to do tilde substitution or translate
+the name then it uses
+the dynamic string at \fI*bufferPtr\fR to hold the new string it
+generates.
+After \fBTcl_TranslateFileName\fR returns a non-NULL result, the caller must
+eventually invoke \fBTcl_DStringFree\fR to free any information
+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.
+.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.
+When an error occurs, \fBTcl_TranslateFileName\fR
+frees the dynamic string itself so that the caller need not call
+\fBTcl_DStringFree\fR.
+.PP
+The caller is responsible for making sure that \fIinterp->result\fR
+has its default empty value when \fBTcl_TranslateFileName\fR is invoked.
+
+.SH "SEE ALSO"
+filename
+
+.SH KEYWORDS
+file name, home directory, tilde, translate, user
diff --git a/tcl/doc/UpVar.3 b/tcl/doc/UpVar.3
new file mode 100644
index 00000000000..1594d3b9f4b
--- /dev/null
+++ b/tcl/doc/UpVar.3
@@ -0,0 +1,76 @@
+'\"
+'\" Copyright (c) 1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_UpVar, Tcl_UpVar2 \- link one variable to another
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_UpVar(\fIinterp, frameName, sourceName, destName, flags\fB)\fR
+.sp
+int
+\fBTcl_UpVar2(\fIinterp, frameName, name1, name2, destName, flags\fB)\fR
+.SH ARGUMENTS
+.AS Tcl_VarTraceProc prevClientData
+.AP Tcl_Interp *interp in
+Interpreter containing variables;  also used for error reporting.
+.AP char *frameName in
+Identifies the stack frame containing source variable.
+May have any of the forms accepted by
+the \fBupvar\fR command, such as \fB#0\fR or \fB1\fR.
+.AP char *sourceName in
+Name of source variable, in the frame given by \fIframeName\fR.
+May refer to a scalar variable or to an array variable with a
+parenthesized index.
+.AP char *destName in
+Name of destination variable, which is to be linked to source
+variable so that references to \fIdestName\fR
+refer to the other variable.  Must not currently exist except as
+an upvar-ed variable.
+.AP int flags in
+Either TCL_GLOBAL_ONLY or 0;  if non-zero, then \fIdestName\fR is
+a global variable;  otherwise it is a local to the current procedure
+(or global if no procedure is active).
+.AP char *name1 in
+First part of source variable's name (scalar name, or name of array
+without array index).
+.AP char *name2 in
+If source variable is an element of an array, gives the index of the element.
+For scalar source variables, is NULL.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_UpVar\fR and \fBTcl_UpVar2\fR provide the same functionality
+as the \fBupvar\fR command:  they make a link from a source variable
+to a destination variable, so that references to the destination are
+passed transparently through to the source.
+The name of the source variable may be specified either as a single
+string such as \fBxyx\fR or \fBa(24)\fR (by calling \fBTcl_UpVar\fR)
+or in two parts where the array name has been separated from the
+element name (by calling \fBTcl_UpVar2\fR).
+The destination variable name is specified in a single string;  it
+may not be an array element.
+.PP
+Both procedures return either TCL_OK or TCL_ERROR, and they
+leave an error message in \fIinterp->result\fR if an error
+occurs.
+.PP
+As with the \fBupvar\fR command, the source variable need not exist;
+if it does exist, unsetting it later does not destroy the link.  The
+destination variable may exist at the time of the call, but if so
+it must exist as a linked variable.
+
+.SH KEYWORDS
+linked variable, upvar, variable
diff --git a/tcl/doc/WrongNumArgs.3 b/tcl/doc/WrongNumArgs.3
new file mode 100644
index 00000000000..d8185f03130
--- /dev/null
+++ b/tcl/doc/WrongNumArgs.3
@@ -0,0 +1,79 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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.  This argument may be NULL.
+.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.  
+.PP
+Some of the objects in the \fIobjv\fR array may be abbreviations for
+a subcommand.  The command
+\fBTcl_GetIndexFromObj\fR will convert the abbreviated string object
+into an \fIindexObject\fR.  If an error occurs in the parsing of the
+subcommand we would like to use the full subcommand name rather than
+the abbreviation.  If the \fBTcl_WrongNumArgs\fR command finds any
+\fIindexObjects\fR in the \fIobjv\fR array it will use the full subcommand
+name in the error message instead of the abbreviated name that was
+origionally passed in.  Using the above example, lets assume that
+\fIbar\fR is actually an abbreviation for \fIbarfly\fR and the object
+is now an indexObject becasue it was passed to
+\fBTcl_GetIndexFromObj\fR.  In this case the error message would be:
+.CS
+wrong # args: should be "foo barfly fileName count"
+.CE
+
+.SH "SEE ALSO"
+Tcl_GetIndexFromObj
+
+.SH KEYWORDS
+command, error message, wrong number of arguments
diff --git a/tcl/doc/after.n b/tcl/doc/after.n
new file mode 100644
index 00000000000..3d51b4af16d
--- /dev/null
+++ b/tcl/doc/after.n
@@ -0,0 +1,109 @@
+'\"
+'\" Copyright (c) 1990-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH after n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+after \- Execute a command after a time delay
+.SH SYNOPSIS
+\fBafter \fIms\fR
+.sp
+\fBafter \fIms \fR?\fIscript script script ...\fR?
+.sp
+\fBafter cancel \fIid\fR
+.sp
+\fBafter cancel \fIscript script script ...\fR
+.sp
+\fBafter idle \fR?\fIscript script script ...\fR?
+.sp
+\fBafter info \fR?\fIid\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is used to delay execution of the program or to execute
+a command in background sometime in the future.  It has several forms,
+depending on the first argument to the command:
+.TP
+\fBafter \fIms\fR
+\fIMs\fR must be an integer giving a time in milliseconds.
+The command sleeps for \fIms\fR milliseconds and then returns.
+While the command is sleeping the application does not respond to
+events.
+.TP
+\fBafter \fIms \fR?\fIscript script script ...\fR?
+In this form the command returns immediately, but it arranges
+for a Tcl command to be executed \fIms\fR milliseconds later as an
+event handler.
+The command will be executed exactly once, at the given time.
+The delayed command is formed by concatenating all the \fIscript\fR
+arguments in the same fashion as the \fBconcat\fR command.
+The command will be executed at global level (outside the context
+of any Tcl procedure).
+If an error occurs while executing the delayed command then the
+\fBbgerror\fR mechanism is used to report the error.
+The \fBafter\fR command returns an identifier that can be used
+to cancel the delayed command using \fBafter cancel\fR.
+.TP
+\fBafter cancel \fIid\fR
+Cancels the execution of a delayed command that
+was previously scheduled.
+\fIId\fR indicates which command should be canceled;  it must have
+been the return value from a previous \fBafter\fR command.
+If the command given by \fIid\fR has already been executed then
+the \fBafter cancel\fR command has no effect.
+.TP
+\fBafter cancel \fIscript script ...\fR
+This command also cancels the execution of a delayed command.
+The \fIscript\fR arguments are concatenated together with space
+separators (just as in the \fBconcat\fR command).
+If there is a pending command that matches the string, it is
+cancelled and will never be executed;  if no such command is
+currently pending then the \fBafter cancel\fR command has no effect.
+.TP
+\fBafter idle \fIscript \fR?\fIscript script ...\fR?
+Concatenates the \fIscript\fR arguments together with space
+separators (just as in the \fBconcat\fR command), and arranges
+for the resulting script to be evaluated later as an idle callback.
+The script will be run exactly once, the next time the event
+loop is entered and there are no events to process.
+The command returns an identifier that can be used
+to cancel the delayed command using \fBafter cancel\fR.
+If an error occurs while executing the script then the
+\fBbgerror\fR mechanism is used to report the error.
+.TP
+\fBafter info \fR?\fIid\fR?
+This command returns information about existing event handlers.
+If no \fIid\fR argument is supplied, the command returns
+a list of the identifiers for all existing
+event handlers created by the \fBafter\fR command for this
+interpreter.
+If \fIid\fR is supplied, it specifies an existing handler;
+\fIid\fR must have been the return value from some previous call
+to \fBafter\fR and it must not have triggered yet or been cancelled.
+In this case the command returns a list with two elements.
+The first element of the list is the script associated
+with \fIid\fR, and the second element is either
+\fBidle\fR or \fBtimer\fR to indicate what kind of event
+handler it is.
+.LP
+The \fBafter \fIms\fR and \fBafter idle\fR forms of the command
+assume that the application is event driven:  the delayed commands
+will not be executed unless the application enters the event loop.
+In applications that are not normally event-driven, such as
+\fBtclsh\fR, the event loop can be entered with the \fBvwait\fR
+and \fBupdate\fR commands.
+
+.SH "SEE ALSO"
+bgerror
+
+.SH KEYWORDS
+cancel, delay, idle callback, sleep, time
diff --git a/tcl/doc/append.n b/tcl/doc/append.n
new file mode 100644
index 00000000000..1ecf946d923
--- /dev/null
+++ b/tcl/doc/append.n
@@ -0,0 +1,32 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH append n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+append \- Append to variable
+.SH SYNOPSIS
+\fBappend \fIvarName \fR?\fIvalue value value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Append all of the \fIvalue\fR arguments to the current value
+of variable \fIvarName\fR.  If \fIvarName\fR doesn't exist,
+it is given a value equal to the concatenation of all the
+\fIvalue\fR arguments.
+This command provides an efficient way to build up long
+variables incrementally.
+For example, ``\fBappend a $b\fR'' is much more efficient than
+``\fBset a $a$b\fR'' if \fB$a\fR is long.
+
+.SH KEYWORDS
+append, variable
diff --git a/tcl/doc/array.n b/tcl/doc/array.n
new file mode 100644
index 00000000000..bcf30918a5f
--- /dev/null
+++ b/tcl/doc/array.n
@@ -0,0 +1,116 @@
+'\"
+'\" Copyright (c) 1993-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH array n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+array \- Manipulate array variables
+.SH SYNOPSIS
+\fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command performs one of several operations on the
+variable given by \fIarrayName\fR.
+Unless otherwise specified for individual commands below,
+\fIarrayName\fR must be the name of an existing array variable.
+The \fIoption\fR argument determines what action is carried
+out by the command.
+The legal \fIoptions\fR (which may be abbreviated) are:
+.TP
+\fBarray anymore \fIarrayName searchId\fR
+Returns 1 if there are any more elements left to be processed
+in an array search, 0 if all elements have already been
+returned.
+\fISearchId\fR indicates which search on \fIarrayName\fR to
+check, and must have been the return value from a previous
+invocation of \fBarray startsearch\fR.
+This option is particularly useful if an array has an element
+with an empty name, since the return value from
+\fBarray nextelement\fR won't indicate whether the search
+has been completed.
+.TP
+\fBarray donesearch \fIarrayName searchId\fR
+This command terminates an array search and destroys all the
+state associated with that search.  \fISearchId\fR indicates
+which search on \fIarrayName\fR to destroy, and must have
+been the return value from a previous invocation of
+\fBarray startsearch\fR.  Returns an empty string.
+.TP
+\fBarray exists \fIarrayName\fR
+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.
+.TP
+\fBarray get \fIarrayName\fR ?\fIpattern\fR?
+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.
+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.
+If \fIarrayName\fR isn't the name of an array variable, or if
+the array contains no elements, then an empty list is returned.
+.TP
+\fBarray names \fIarrayName\fR ?\fIpattern\fR?
+Returns a list containing the names of all of the elements in
+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
+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.
+.TP
+\fBarray nextelement \fIarrayName searchId\fR
+Returns the name of the next element in \fIarrayName\fR, or
+an empty string if all elements of \fIarrayName\fR have
+already been returned in this search.  The \fIsearchId\fR
+argument identifies the search, and must have
+been the return value of an \fBarray startsearch\fR command.
+Warning:  if elements are added to or deleted from the array,
+then all searches are automatically terminated just as if
+\fBarray donesearch\fR had been invoked; this will cause
+\fBarray nextelement\fR operations to fail for those searches.
+.TP
+\fBarray set \fIarrayName list\fR
+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.
+If the variable \fIarrayName\fR does not already exist
+and \fIlist\fR is empty,
+\fIarrayName\fR is created with an empty array value.
+.TP
+\fBarray size \fIarrayName\fR
+Returns a decimal string giving the number of elements in the
+array.
+If \fIarrayName\fR isn't the name of an array then 0 is returned.
+.TP
+\fBarray startsearch \fIarrayName\fR
+This command initializes an element-by-element search through the
+array given by \fIarrayName\fR, such that invocations of the
+\fBarray nextelement\fR command will return the names of the
+individual elements in the array.
+When the search has been completed, the \fBarray donesearch\fR
+command should be invoked.
+The return value is a
+search identifier that must be used in \fBarray nextelement\fR
+and \fBarray donesearch\fR commands; it allows multiple
+searches to be underway simultaneously for the same array.
+
+.SH KEYWORDS
+array, element names, search
diff --git a/tcl/doc/bgerror.n b/tcl/doc/bgerror.n
new file mode 100644
index 00000000000..4ca2065e2e6
--- /dev/null
+++ b/tcl/doc/bgerror.n
@@ -0,0 +1,68 @@
+'\"
+'\" Copyright (c) 1990-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH bgerror n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+bgerror \- Command invoked to process background errors
+.SH SYNOPSIS
+\fBbgerror \fImessage\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBbgerror\fR command doesn't exist as built-in part of Tcl.  Instead,
+individual applications or users can define a \fBbgerror\fR
+command (e.g. as a Tcl procedure) if they wish to handle background
+errors.
+.PP
+A background error is one that occurs in an event handler or some
+other command that didn't originate with the application.
+For example, if an error occurs while executing a command specified
+with the \fBafter\fR command, then it is a background error.
+For a non-background error, the error can simply be returned up
+through nested Tcl command evaluations until it reaches the top-level
+code in the application; then the application can report the error
+in whatever way it wishes.
+When a background error occurs, the unwinding ends in
+the Tcl library and there is no obvious way for Tcl to report
+the error.
+.PP
+When Tcl detects a background error, it saves information about the
+error and invokes the \fBbgerror\fR command later as an idle event handler.
+Before invoking \fBbgerror\fR, Tcl restores the \fBerrorInfo\fR
+and \fBerrorCode\fR variables to their values at the time the
+error occurred, then it invokes \fBbgerror\fR with
+the error message as its only argument.
+Tcl assumes that the application has implemented the \fBbgerror\fR
+command, and that the command will report the error in a way that
+makes sense for the application.  Tcl will ignore any result returned
+by the \fBbgerror\fR command as long as no error is generated.
+.PP
+If another Tcl error occurs within the \fBbgerror\fR command
+(for example, because no \fBbgerror\fR command has been defined)
+then Tcl reports the error itself by writing a message to stderr.
+.PP
+If several background errors accumulate before \fBbgerror\fR
+is invoked to process them, \fBbgerror\fR will be invoked once
+for each error, in the order they occurred.
+However, if \fBbgerror\fR returns with a break exception, then
+any remaining errors are skipped without calling \fBbgerror\fR.
+.PP
+Tcl has no default implementation for \fBbgerror\fR.
+However, in applications using Tk there is a default
+\fBbgerror\fR procedure
+which posts a dialog box containing
+the error message and offers the user a chance to see a stack
+trace showing where the error occurred.
+
+.SH KEYWORDS
+background error, reporting
diff --git a/tcl/doc/binary.n b/tcl/doc/binary.n
new file mode 100644
index 00000000000..e03924688a8
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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 overflows the
+machine's native representation, then the value of 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/tcl/doc/break.n b/tcl/doc/break.n
new file mode 100644
index 00000000000..866ff0d4a63
--- /dev/null
+++ b/tcl/doc/break.n
@@ -0,0 +1,34 @@
+'\"
+'\" Copyright (c) 1993-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH break n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+break \- Abort looping command
+.SH SYNOPSIS
+\fBbreak\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is typically invoked inside the body of a looping command
+such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR.
+It returns a TCL_BREAK code, which causes a break exception
+to occur.
+The exception causes the current script to be aborted
+out to the innermost containing loop command, which then
+aborts its execution and returns normally.
+Break exceptions are also handled in a few other situations, such
+as the \fBcatch\fR command, Tk event bindings, and the outermost
+scripts of procedure bodies.
+
+.SH KEYWORDS
+abort, break, loop
diff --git a/tcl/doc/case.n b/tcl/doc/case.n
new file mode 100644
index 00000000000..33cdd4cf087
--- /dev/null
+++ b/tcl/doc/case.n
@@ -0,0 +1,59 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH case n 7.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+case \- Evaluate one of several scripts, depending on a given value
+.SH SYNOPSIS
+\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...?
+.sp
+\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?}
+.BE
+
+.SH DESCRIPTION
+.PP
+\fINote: the \fBcase\fI command is obsolete and is supported only
+for backward compatibility.  At some point in the future it may be
+removed entirely.  You should use the \fBswitch\fI command instead.\fR
+.PP
+The \fBcase\fR command matches \fIstring\fR against each of
+the \fIpatList\fR arguments in order.
+Each \fIpatList\fR argument is a list of one or
+more patterns.  If any of these patterns matches \fIstring\fR then
+\fBcase\fR evaluates the following \fIbody\fR argument
+by passing it recursively to the Tcl interpreter and returns the result
+of that evaluation.
+Each \fIpatList\fR argument consists of a single
+pattern or list of patterns.  Each pattern may contain any of the wild-cards
+described under \fBstring match\fR.  If a \fIpatList\fR
+argument is \fBdefault\fR, the corresponding body will be evaluated
+if no \fIpatList\fR matches \fIstring\fR.  If no \fIpatList\fR argument
+matches \fIstring\fR and no default is given, then the \fBcase\fR
+command returns an empty string.
+.PP
+Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments.
+The first uses a separate argument for each of the patterns and commands;
+this form is convenient if substitutions are desired on some of the
+patterns or commands.
+The second form places all of the patterns and commands together into
+a single argument; the argument must have proper list structure, with
+the elements of the list being the patterns and commands.
+The second form makes it easy to construct multi-line case commands,
+since the braces around the whole list make it unnecessary to include a
+backslash at the end of each line.
+Since the \fIpatList\fR arguments are in braces in the second form,
+no command or variable substitutions are performed on them;  this makes
+the behavior of the second form different than the first form in some
+cases.
+
+.SH KEYWORDS
+case, match, regular expression
diff --git a/tcl/doc/catch.n b/tcl/doc/catch.n
new file mode 100644
index 00000000000..73f8c50e9da
--- /dev/null
+++ b/tcl/doc/catch.n
@@ -0,0 +1,40 @@
+'\"
+'\" Copyright (c) 1993-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH catch n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+catch \- Evaluate script and trap exceptional returns
+.SH SYNOPSIS
+\fBcatch\fI script \fR?\fIvarName\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBcatch\fR command may be used to prevent errors from aborting
+command interpretation.  \fBCatch\fR calls the Tcl interpreter recursively
+to execute \fIscript\fR, and always returns a TCL_OK code, regardless of
+any errors that might occur while executing \fIscript\fR.  The return
+value from \fBcatch\fR is a decimal string giving the
+code returned by the Tcl interpreter after executing \fIscript\fR.
+This will be \fB0\fR (TCL_OK) if there were no errors in \fIscript\fR;
+otherwise
+it will have a non-zero value corresponding to one of the exceptional
+return codes (see tcl.h for the definitions of code values).  If the
+\fIvarName\fR argument is given, then it gives the name of a variable;
+\fBcatch\fR will set the variable to the string returned
+from \fIscript\fR (either a result or an error message).
+.PP
+Note that \fBcatch\fR catches all exceptions, including those
+generated by \fBbreak\fR and \fBcontinue\fR as well as errors.
+
+.SH KEYWORDS
+catch, error
diff --git a/tcl/doc/cd.n b/tcl/doc/cd.n
new file mode 100644
index 00000000000..fc5ed29eab5
--- /dev/null
+++ b/tcl/doc/cd.n
@@ -0,0 +1,28 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH cd n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+cd \- Change working directory
+.SH SYNOPSIS
+\fBcd \fR?\fIdirName\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Change the current working directory to \fIdirName\fR, or to the
+home directory (as specified in the HOME environment variable) if
+\fIdirName\fR is not given.
+Returns an empty string.
+
+.SH KEYWORDS
+working directory
diff --git a/tcl/doc/clock.n b/tcl/doc/clock.n
new file mode 100644
index 00000000000..2af5b6e08f1
--- /dev/null
+++ b/tcl/doc/clock.n
@@ -0,0 +1,188 @@
+'\"
+'\" Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
+'\" 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.
+'\" 
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH clock n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+clock \- Obtain and manipulate time
+.SH SYNOPSIS
+\fBclock \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command performs one of several operations that may obtain
+or manipulate strings or values that represent some notion of
+time.  The \fIoption\fR argument determines what action is carried
+out by the command.  The legal \fIoptions\fR (which may be
+abbreviated) are:
+.TP
+\fBclock clicks\fR
+Return a high-resolution time value as a system-dependent integer
+value.  The unit of the value is system-dependent but should be the
+highest resolution clock available on the system such as a CPU cycle
+counter. This value should only be used for the relative measurement
+of elapsed time.
+.TP
+\fBclock format \fIclockValue\fR ?\fB\-format \fIstring\fR? ?\fB\-gmt \fIboolean\fR?
+Converts an integer time value, typically returned by
+\fBclock seconds\fR, \fBclock scan\fR, or the \fBatime\fR, \fBmtime\fR,
+or \fBctime\fR options of the \fBfile\fR command, to human-readable
+form.  If the \fB\-format\fR argument is present the next argument is a
+string that describes how the date and time are to be formatted.
+Field descriptors consist of a \fB%\fR followed by a field
+descriptor character.  All other characters are copied into the result.
+Valid field descriptors are:
+.RS
+.IP \fB%%\fR
+Insert a %.
+.IP \fB%a\fR
+Abbreviated weekday name (Mon, Tue, etc.).
+.IP \fB%A\fR
+Full weekday name (Monday, Tuesday, etc.).
+.IP \fB%b\fR
+Abbreviated month name (Jan, Feb, etc.).
+.IP \fB%B\fR
+Full month name.
+.IP \fB%c\fR
+Locale specific date and time.
+.IP \fB%d\fR
+Day of month (01 - 31).
+.IP \fB%H\fR
+Hour in 24-hour format (00 - 23).
+.IP \fB%I\fR
+Hour in 12-hour format (00 - 12).
+.IP \fB%j\fR
+Day of year (001 - 366).
+.IP \fB%m\fR
+Month number (01 - 12).
+.IP \fB%M\fR
+Minute (00 - 59).
+.IP \fB%p\fR
+AM/PM indicator.
+.IP \fB%S\fR
+Seconds (00 - 59).
+.IP \fB%U\fR
+Week of year (01 - 52), Sunday is the first day of the week.
+.IP \fB%w\fR
+Weekday number (Sunday = 0).
+.IP \fB%W\fR
+Week of year (01 - 52), Monday is the first day of the week.
+.IP \fB%x\fR
+Locale specific date format.
+.IP \fB%X\fR
+Locale specific time format.
+.IP \fB%y\fR
+Year without century (00 - 99).
+.IP \fB%Y\fR
+Year with century (e.g. 1990)
+.IP \fB%Z\fR
+Time zone name.
+.RE
+.sp
+.RS
+In addition, the following field descriptors may be supported on some
+systems (e.g. Unix but not Windows):
+.IP \fB%D\fR
+Date as %m/%d/%y.
+.IP \fB%e\fR
+Day of month (1 - 31), no leading zeros.
+.IP \fB%h\fR
+Abbreviated month name.
+.IP \fB%n\fR
+Insert a newline.
+.IP \fB%r\fR
+Time as %I:%M:%S %p.
+.IP \fB%R\fR
+Time as %H:%M.
+.IP \fB%t\fR
+Insert a tab.
+.IP \fB%T\fR
+Time as %H:%M:%S.
+.RE
+.sp
+.RS
+If the \fB\-format\fR argument is not specified, the format string 
+"\fB%a %b %d %H:%M:%S %Z %Y\fR" is used.  If the \fB\-gmt\fR argument
+is present the next argument must be a boolean which if true specifies
+that the time will be formatted as Greenwich Mean Time. If false
+then the local timezone will be used as defined by the operating
+environment.
+.RE
+.TP
+\fBclock scan \fIdateString\fR ?\fB\-base \fIclockVal\fR? ?\fB\-gmt \fIboolean\fR?
+Convert \fIdateString\fR to an integer clock value (see \fBclock seconds\fR).
+This command can parse and convert virtually any standard date and/or time
+string, which can include standard time zone mnemonics.  If only a time is
+specified, the current date is assumed.  If the string does not contain a
+time zone mnemonic, the local time zone is assumed, unless the \fB\-gmt\fR 
+argument is true, in which case the clock value is calculated assuming
+that the specified time is relative to Greenwich Mean Time.
+.sp
+If the \fB\-base\fR flag is specified, the next argument should contain
+an integer clock value.  Only the date in this value is used, not the
+time.  This is useful for determining the time on a specific day or
+doing other date-relative conversions.
+.sp
+The \fIdateString\fR consists of zero or more specifications of the
+following form:
+.RS
+.TP
+\fItime\fR
+A time of day, which is of the form: \fIhh\fR?\fI:mm\fR?\fI:ss\fR?? 
+?\fImeridian\fR? ?\fIzone\fR? or \fIhhmm \fR?\fImeridian\fR? 
+?\fIzone\fR?. If no meridian is specified, \fIhh\fR is interpreted on
+a 24-hour clock.
+.TP
+\fIdate\fR
+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
+.VS
+than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
+as 1969-1999.  Not all platforms can represent the years 38-70, so
+an error may result if these years are used.
+.VE
+.TP
+\fIrelative time\fR
+A specification relative to the current time.  The format is \fInumber
+unit\fR acceptable units are \fByear\fR, \fBfortnight\fR, \fBmonth\fR, \fBweek\fR, \fBday\fR,
+\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
+unit can be specified as a singular or plural, as in \fB3 weeks\fR.
+These modifiers may also be specified:
+\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,
+\fBlast\fR, \fBthis\fR, \fBnext\fR, \fBago\fR.
+.RE
+.sp
+.RS
+The actual date is calculated according to the following steps.
+First, any absolute date and/or time is processed and converted.
+Using that time as the base, day-of-week specifications are added.
+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 and the correct date is given when going from the end
+of a long month to a short month.
+.RE
+.TP
+\fBclock seconds\fR
+Return the current date and time as a system-dependent integer value.  The
+unit of the value is seconds, allowing it to be used for relative time
+calculations.  The value is usually defined as total elapsed time from
+an ``epoch''.  You shouldn't assume the value of the epoch.
+
+.SH KEYWORDS
+clock, date, time
diff --git a/tcl/doc/close.n b/tcl/doc/close.n
new file mode 100644
index 00000000000..6d0b0df50d6
--- /dev/null
+++ b/tcl/doc/close.n
@@ -0,0 +1,59 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH close n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+close \- Close an open channel.
+.SH SYNOPSIS
+\fBclose \fIchannelId\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Closes the channel given by \fIchannelId\fR.  \fIChannelId\fR must be a
+channel identifier such as the return value from a previous \fBopen\fR
+or \fBsocket\fR command.
+All buffered output is flushed to the channel's output device,
+any buffered input is discarded, the underlying file or device is closed,
+and \fIchannelId\fR becomes unavailable for use.
+.VS "" br
+.PP
+If the channel is blocking, the command does not return until all output
+is flushed.
+If the channel is nonblocking and there is unflushed output, the
+channel remains open and the command
+returns immediately; output will be flushed in the background and the
+channel will be closed when all the flushing is complete.
+.VE
+.PP
+If \fIchannelId\fR is a blocking channel for a command pipeline then
+\fBclose\fR waits for the child processes to complete.
+.VS "" br
+.PP
+If the channel is shared between interpreters, then \fBclose\fR
+makes \fIchannelId\fR unavailable in the invoking interpreter but has no
+other effect until all of the sharing interpreters have closed the
+channel.
+When the last interpreter in which the channel is registered invokes
+\fBclose\fR, the cleanup actions described above occur. See the
+\fBinterp\fR command for a description of channel sharing.
+.PP
+Channels are automatically closed when an interpreter is destroyed and
+when the process exits.  Channels are switched to blocking mode, to ensure
+that all output is correctly flushed before the process exits.
+.VE
+.PP
+The command returns an empty string, and may generate an error if
+an error occurs while flushing output.
+
+.SH KEYWORDS
+blocking, channel, close, nonblocking
diff --git a/tcl/doc/concat.n b/tcl/doc/concat.n
new file mode 100644
index 00000000000..6124f54440b
--- /dev/null
+++ b/tcl/doc/concat.n
@@ -0,0 +1,40 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH concat n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+concat \- Join lists together
+.SH SYNOPSIS
+\fBconcat\fI \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command treats each argument as a list and concatenates them
+into a single list.
+It also eliminates leading and trailing spaces in the \fIarg\fR's
+and adds a single separator space between \fIarg\fR's.
+It permits any number of arguments.  For example,
+the command
+.CS
+\fBconcat a b {c d e} {f {g h}}\fR
+.CE
+will return
+.CS
+\fBa b c d e f {g h}\fR
+.CE
+as its result.
+.PP
+If no \fIarg\fRs are supplied, the result is an empty string.
+
+.SH KEYWORDS
+concatenate, join, lists
diff --git a/tcl/doc/continue.n b/tcl/doc/continue.n
new file mode 100644
index 00000000000..75babe8874c
--- /dev/null
+++ b/tcl/doc/continue.n
@@ -0,0 +1,34 @@
+'\"
+'\" Copyright (c) 1993-1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH continue n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+continue \- Skip to the next iteration of a loop
+.SH SYNOPSIS
+\fBcontinue\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is typically invoked inside the body of a looping command
+such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR.
+It returns a TCL_CONTINUE code, which causes a continue exception
+to occur.
+The exception causes the current script to be aborted
+out to the innermost containing loop command, which then
+continues with the next iteration of the loop.
+Catch exceptions are also handled in a few other situations, such
+as the \fBcatch\fR command and the outermost scripts of procedure
+bodies.
+
+.SH KEYWORDS
+continue, iteration, loop
diff --git a/tcl/doc/eof.n b/tcl/doc/eof.n
new file mode 100644
index 00000000000..f1435f7f818
--- /dev/null
+++ b/tcl/doc/eof.n
@@ -0,0 +1,27 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH eof n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+eof \- Check for end of file condition on channel
+.SH SYNOPSIS
+\fBeof \fIchannelId\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Returns 1 if an end of file condition occurred during the most
+recent input operation on \fIchannelId\fR (such as \fBgets\fR),
+0 otherwise.
+
+.SH KEYWORDS
+channel, end of file
diff --git a/tcl/doc/error.n b/tcl/doc/error.n
new file mode 100644
index 00000000000..11ee279b560
--- /dev/null
+++ b/tcl/doc/error.n
@@ -0,0 +1,58 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH error n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+error \- Generate an error
+.SH SYNOPSIS
+\fBerror \fImessage\fR ?\fIinfo\fR? ?\fIcode\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Returns a TCL_ERROR code, which causes command interpretation to be
+unwound.  \fIMessage\fR is a string that is returned to the application
+to indicate what went wrong.
+.PP
+If the \fIinfo\fR argument is provided and is non-empty,
+it is used to initialize the global variable \fBerrorInfo\fR.
+\fBerrorInfo\fR is used to accumulate a stack trace of what
+was in progress when an error occurred; as nested commands unwind,
+the Tcl interpreter adds information to \fBerrorInfo\fR.  If the
+\fIinfo\fR argument is present, it is used to initialize
+\fBerrorInfo\fR and the first increment of unwind information
+will not be added by the Tcl interpreter.  In other
+words, the command containing the \fBerror\fR command will not appear
+in \fBerrorInfo\fR; in its place will be \fIinfo\fR.
+This feature is most useful in conjunction with the \fBcatch\fR command:
+if a caught error cannot be handled successfully, \fIinfo\fR can be used
+to return a stack trace reflecting the original point of occurrence
+of the error:
+.CS
+\fBcatch {...} errMsg
+set savedInfo $errorInfo
+\&...
+error $errMsg $savedInfo\fR
+.CE
+.PP
+If the \fIcode\fR argument is present, then its value is stored
+in the \fBerrorCode\fR global variable.  This variable is intended
+to hold a machine-readable description of the error in cases where
+such information is available; see the \fBtclvars\fR manual
+page for information on the proper format for the variable.
+If the \fIcode\fR argument is not
+present, then \fBerrorCode\fR is automatically reset to
+``NONE'' by the Tcl interpreter as part of processing the
+error generated by the command.
+
+.SH KEYWORDS
+error, errorCode, errorInfo
diff --git a/tcl/doc/eval.n b/tcl/doc/eval.n
new file mode 100644
index 00000000000..a8abd20f902
--- /dev/null
+++ b/tcl/doc/eval.n
@@ -0,0 +1,30 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH eval n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+eval \- Evaluate a Tcl script
+.SH SYNOPSIS
+\fBeval \fIarg \fR?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBEval\fR takes one or more arguments, which together comprise a Tcl
+script containing one or more commands.
+\fBEval\fR concatenates all its arguments in the same
+fashion as the \fBconcat\fR command, passes the concatenated string to the
+Tcl interpreter recursively, and returns the result of that
+evaluation (or any error generated by it).
+
+.SH KEYWORDS
+concatenate, evaluate, script
diff --git a/tcl/doc/exec.n b/tcl/doc/exec.n
new file mode 100644
index 00000000000..8fc72c1195e
--- /dev/null
+++ b/tcl/doc/exec.n
@@ -0,0 +1,357 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH exec n 7.6 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+exec \- Invoke subprocess(es)
+.SH SYNOPSIS
+\fBexec \fR?\fIswitches\fR? \fIarg \fR?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command treats its arguments as the specification
+of one or more subprocesses to execute.
+The arguments take the form of a standard shell pipeline
+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
+they are treated as command-line switches and are not part
+of the pipeline specification.  The following switches are
+currently supported:
+.TP 13
+\fB\-keepnewline\fR
+Retains a trailing newline in the pipeline's output.
+Normally a trailing newline will be deleted.
+.TP 13
+\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.
+.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
+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'').
+.TP 15
+|
+Separates distinct commands in the pipeline.  The standard output
+of the preceding command will be piped into the standard input
+of the next command.
+.TP 15
+|&
+Separates distinct commands in the pipeline.  Both standard output
+and standard error of the preceding command will be piped into
+the standard input of the next command.
+This form of redirection overrides forms such as 2> and >&.
+.TP 15
+<\0\fIfileName\fR
+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
+\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.
+.TP 15
+<<\0\fIvalue\fR
+\fIValue\fR is passed to the first command as its standard input.
+.TP 15
+>\0\fIfileName\fR
+Standard output from the last command is redirected to the file named
+\fIfileName\fR, overwriting its previous contents.
+.TP 15
+2>\0\fIfileName\fR
+Standard error from all commands in the pipeline is redirected to the
+file named \fIfileName\fR, overwriting its previous contents.
+.TP 15
+>&\0\fIfileName\fR
+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.
+.TP 15
+>>\0\fIfileName\fR
+Standard output from the last command is
+redirected to the file named \fIfileName\fR, appending to it rather
+than overwriting it.
+.TP 15
+2>>\0\fIfileName\fR
+Standard error from all commands in the pipeline is
+redirected to the file named \fIfileName\fR, appending to it rather
+than overwriting it.
+.TP 15
+>>&\0\fIfileName\fR
+Both standard output from the last command and standard error from
+all commands are redirected to the file named \fIfileName\fR,
+appending to it rather than overwriting it.
+.TP 15
+>@\0\fIfileId\fR
+\fIFileId\fR must be the identifier for an open file, such as the return
+value from a previous call to \fBopen\fR.
+Standard output from the last command is redirected to \fIfileId\fR's
+file, which must have been opened for writing.
+.TP 15
+2>@\0\fIfileId\fR
+\fIFileId\fR must be the identifier for an open file, such as the return
+value from a previous call to \fBopen\fR.
+Standard error from all commands in the pipeline is
+redirected to \fIfileId\fR's file.
+The file must have been opened for writing.
+.TP 15
+>&@\0\fIfileId\fR
+\fIFileId\fR must be the identifier for an open file, such as the return
+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.
+.PP
+If standard output has not been redirected then the \fBexec\fR
+command returns the standard output from the last command
+in the pipeline.
+If any of the commands in the pipeline exit abnormally or
+are killed or suspended, then \fBexec\fR will return an error
+and the error message will include the pipeline's output followed by
+error messages describing the abnormal terminations; the
+\fBerrorCode\fR variable will contain additional information
+about the last abnormal termination encountered.
+If any of the commands writes to its standard error file and that
+standard error isn't redirected,
+then \fBexec\fR will return an error;  the error message
+will include the pipeline's standard output, followed by messages
+about abnormal terminations (if any), followed by the standard error
+output.
+.PP
+If the last character of the result or error message
+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.
+However, if \fB\-keepnewline\fR is specified then the trailing
+newline is retained.
+.PP
+If standard input isn't redirected with ``<'' or ``<<''
+or ``<@'' then the standard input for the first command in the
+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.
+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.
+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
+the commands in the pipeline will go to the application's
+standard error file unless redirected.
+.PP
+The first word in each command is taken as the command name;
+tilde-substitution is performed on it, and if the result contains
+no slashes then the directories
+in the PATH environment variable are searched for
+an executable by the given name.
+If the name contains a slash then it must refer to an executable
+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/tcl/doc/exit.n b/tcl/doc/exit.n
new file mode 100644
index 00000000000..d7fac6fb610
--- /dev/null
+++ b/tcl/doc/exit.n
@@ -0,0 +1,28 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH exit n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+exit \- End the application
+.SH SYNOPSIS
+\fBexit \fR?\fIreturnCode\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Terminate the process, returning \fIreturnCode\fR to the
+system as the exit status.
+If \fIreturnCode\fR isn't specified then it defaults
+to 0.
+
+.SH KEYWORDS
+exit, process
diff --git a/tcl/doc/expr.n b/tcl/doc/expr.n
new file mode 100644
index 00000000000..27545611cff
--- /dev/null
+++ b/tcl/doc/expr.n
@@ -0,0 +1,323 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH expr n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+expr \- Evaluate an expression
+.SH SYNOPSIS
+\fBexpr \fIarg \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Concatenates \fIarg\fR's (adding separator spaces between them),
+evaluates the result as a Tcl expression, and returns the value.
+The operators permitted in Tcl expressions are a subset of
+the operators permitted in C expressions, and they have the
+same meaning and precedence as the corresponding C operators.
+Expressions almost always yield numeric results
+(integer or floating-point values).
+For example, the expression
+.CS
+\fBexpr 8.2 + 6\fR
+.CE
+evaluates to 14.2.
+Tcl expressions differ from C expressions in the way that
+operands are specified.  Also, Tcl expressions support
+non-numeric operands and string comparisons.
+.SH OPERANDS
+.PP
+A Tcl expression consists of a combination of operands, operators,
+and parentheses.
+White space may be used between the operands and operators and
+parentheses; it is ignored by the expression's instructions.
+Where possible, operands are interpreted as integer values.
+Integer values may be specified in decimal (the normal case), in octal (if the
+first character of the operand is \fB0\fR), or in hexadecimal (if the first
+two characters of the operand are \fB0x\fR).
+If an operand does not have one of the integer formats given
+above, then it is treated as a floating-point number if that is
+possible.  Floating-point numbers may be specified in any of the
+ways accepted by an ANSI-compliant C compiler (except that the
+\fBf\fR, \fBF\fR, \fBl\fR, and \fBL\fR suffixes will not be permitted in
+most installations).  For example, all of the
+following are valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
+If no numeric interpretation is possible, then an operand is left
+as a string (and only a limited set of operators may be applied to
+it).
+.PP
+Operands may be specified in any of the following ways:
+.IP [1]
+As an numeric value, either integer or floating-point.
+.IP [2]
+As a Tcl variable, using standard \fB$\fR notation.
+The variable's value will be used as the operand.
+.IP [3]
+As a string enclosed in double-quotes.
+The expression parser will perform backslash, variable, and
+command substitutions on the information between the quotes,
+and use the resulting value as the operand
+.IP [4]
+As a string enclosed in braces.
+The characters between the open brace and matching close brace
+will be used as the operand without any substitutions.
+.IP [5]
+As a Tcl command enclosed in brackets.
+The command will be executed and its result will be used as
+the operand.
+.IP [6]
+As a mathematical function whose arguments have any of the above
+forms for operands, such as \fBsin($x)\fR.  See below for a list of defined
+functions.
+.LP
+Where substitutions occur above (e.g. inside quoted strings), they
+are performed by the expression's instructions.
+However, an additional layer of substitution may already have
+been performed by the command parser before the expression
+processor was called.
+As discussed below, it is usually best to enclose expressions
+in braces to prevent the command parser from performing substitutions
+on the contents.
+.PP
+For some examples of simple expressions, suppose the variable
+\fBa\fR has the value 3 and
+the variable \fBb\fR has the value 6.
+Then the command on the left side of each of the lines below
+will produce the value on the right side of the line:
+.CS
+.ta 6c
+\fBexpr 3.1 + $a	6.1
+expr 2 + "$a.$b"	5.6
+expr 4*[llength "6 2"]	8
+expr {{word one} < "word $a"}	0\fR
+.CE
+.SH OPERATORS
+.PP
+The valid operators are listed below, grouped in decreasing order
+of precedence:
+.TP 20
+\fB\-\0\0+\0\0~\0\0!\fR
+Unary minus, unary plus, bit-wise NOT, logical NOT.  None of these operands
+may be applied to string operands, and bit-wise NOT may be
+applied only to integers.
+.TP 20
+\fB*\0\0/\0\0%\fR
+Multiply, divide, remainder.  None of these operands may be
+applied to string operands, and remainder may be applied only
+to integers.
+The remainder will always have the same sign as the divisor and
+an absolute value smaller than the divisor.
+.TP 20
+\fB+\0\0\-\fR
+Add and subtract.  Valid for any numeric operands.
+.TP 20
+\fB<<\0\0>>\fR
+Left and right shift.  Valid for integer operands only.
+A right shift always propagates the sign bit.
+.TP 20
+\fB<\0\0>\0\0<=\0\0>=\fR
+Boolean less, greater, less than or equal, and greater than or equal.
+Each operator produces 1 if the condition is true, 0 otherwise.
+These operators may be applied to strings as well as numeric operands,
+in which case string comparison is used.
+.TP 20
+\fB==\0\0!=\fR
+Boolean equal and not equal.  Each operator produces a zero/one result.
+Valid for all operand types.
+.TP 20
+\fB&\fR
+Bit-wise AND.  Valid for integer operands only.
+.TP 20
+\fB^\fR
+Bit-wise exclusive OR.  Valid for integer operands only.
+.TP 20
+\fB|\fR
+Bit-wise OR.  Valid for integer operands only.
+.TP 20
+\fB&&\fR
+Logical AND.  Produces a 1 result if both operands are non-zero,
+0 otherwise.
+Valid for boolean and numeric (integers or floating-point) operands only.
+.TP 20
+\fB||\fR
+Logical OR.  Produces a 0 result if both operands are zero, 1 otherwise.
+Valid for boolean and numeric (integers or floating-point) operands only.
+.TP 20
+\fIx\fB?\fIy\fB:\fIz\fR
+If-then-else, as in C.  If \fIx\fR
+evaluates to non-zero, then the result is the value of \fIy\fR.
+Otherwise the result is the value of \fIz\fR.
+The \fIx\fR operand must have a numeric value.
+.LP
+See the C manual for more details on the results
+produced by each operator.
+All of the binary operators group left-to-right within the same
+precedence level.  For example, the command
+.CS
+\fBexpr 4*2 < 7\fR
+.CE
+returns 0.
+.PP
+The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have ``lazy
+evaluation'', just as in C, 
+which means that operands are not evaluated if they are
+not needed to determine the outcome.  For example, in the command
+.CS
+\fBexpr {$v ? [a] : [b]}\fR
+.CE
+only one of \fB[a]\fR or \fB[b]\fR will actually be evaluated,
+depending on the value of \fB$v\fR.  Note, however, that this is
+only true if the entire expression is enclosed in braces;  otherwise
+the Tcl parser will evaluate both \fB[a]\fR and \fB[b]\fR before
+invoking the \fBexpr\fR command.
+.SH "MATH FUNCTIONS"
+.PP
+Tcl supports the following mathematical functions in expressions:
+.DS
+.ta 3c 6c 9c
+\fBacos\fR	\fBcos\fR	\fBhypot\fR	\fBsinh\fR
+\fBasin\fR	\fBcosh\fR	\fBlog\fR	\fBsqrt\fR
+\fBatan\fR	\fBexp\fR	\fBlog10\fR	\fBtan\fR
+\fBatan2\fR	\fBfloor\fR	\fBpow\fR	\fBtanh\fR
+\fBceil\fR	\fBfmod\fR	\fBsin\fR
+.DE
+Each of these functions invokes the math library function of the same
+name;  see the manual entries for the library functions for details
+on what they do.  Tcl also implements the following functions for
+conversion between integers and floating-point numbers and the
+generation of random numbers:
+.TP
+\fBabs(\fIarg\fB)\fR
+Returns the absolute value of \fIarg\fR.  \fIArg\fR may be either
+integer or floating-point, and the result is returned in the same form.
+.TP
+\fBdouble(\fIarg\fB)\fR
+If \fIarg\fR is a floating value, returns \fIarg\fR, otherwise converts
+\fIarg\fR to floating and returns the converted value.
+.TP
+\fBint(\fIarg\fB)\fR
+If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
+\fIarg\fR to integer by truncation and returns the converted value.
+.TP
+\fBrand()\fR
+Returns a floating point number from zero to just less than one or,
+in mathematical terms, the range [0,1).  The seed comes from the
+internal clock of the machine or may be set manual with the srand
+function.
+.TP
+\fBround(\fIarg\fB)\fR
+If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
+\fIarg\fR to integer by rounding and returns the converted value.
+.TP
+\fBsrand(\fIarg\fB)\fR
+The \fIarg\fR, which must be an integer, is used to reset the seed for
+the random number generator.  Returns the first random number from
+that seed.  Each interpreter has it's own seed.
+.PP
+In addition to these predefined functions, applications may
+define additional functions using \fBTcl_CreateMathFunc\fR().
+.SH "TYPES, OVERFLOW, AND PRECISION"
+.PP
+All internal computations involving integers are done with the C type
+\fIlong\fR, and all internal computations involving floating-point are
+done with the C type \fIdouble\fR.
+When converting a string to floating-point, exponent overflow is
+detected and results in a Tcl error.
+For conversion to integer from string, detection of overflow depends
+on the behavior of some routines in the local C library, so it should
+be regarded as unreliable.
+In any case, integer overflow and underflow are generally not detected
+reliably for intermediate results.  Floating-point overflow and underflow
+are detected to the degree supported by the hardware, which is generally
+pretty reliable.
+.PP
+Conversion among internal representations for integer, floating-point,
+and string operands is done automatically as needed.
+For arithmetic computations, integers are used until some
+floating-point number is introduced, after which floating-point is used.
+For example,
+.CS
+\fBexpr 5 / 4\fR
+.CE
+returns 1, while
+.CS
+\fBexpr 5 / 4.0\fR
+\fBexpr 5 / ( [string length "abcd"] + 0.0 )\fR
+.CE
+both return 1.25.
+Floating-point values are always returned with a ``\fB.\fR''
+or an \fBe\fR so that they will not look like integer values.  For
+example,
+.CS
+\fBexpr 20.0/5.0\fR
+.CE
+returns \fB4.0\fR, not \fB4\fR.
+
+.SH "STRING OPERATIONS"
+.PP
+String values may be used as operands of the comparison operators,
+although the expression evaluator tries to do comparisons as integer
+or floating-point when it can.
+If one of the operands of a comparison is a string and the other
+has a numeric value, the numeric operand is converted back to
+a string using the C \fIsprintf\fR format specifier
+\fB%d\fR for integers and \fB%g\fR for floating-point values.
+For example, the commands
+.CS
+\fBexpr {"0x03" > "2"}\fR
+\fBexpr {"0y" < "0x12"}\fR
+.CE
+both return 1.  The first comparison is done using integer
+comparison, and the second is done using string comparison after
+the second operand is converted to the string \fB18\fR.
+Because of Tcl's tendency to treat values as numbers whenever
+possible, it isn't generally a good idea to use operators like \fB==\fR
+when you really want string comparison and the values of the
+operands could be arbitrary;  it's better in these cases to use the
+\fBstring compare\fR command instead.
+
+.SH "PERFORMANCE CONSIDERATIONS"
+.VS
+.PP
+Enclose expressions in braces for the best speed and the smallest
+storage requirements.
+This allows the Tcl bytecode compiler to generate the best code.
+.PP
+As mentioned above, expressions are substituted twice:
+once by the Tcl parser and once by the \fBexpr\fR command.
+For example, the commands
+.CS
+\fBset a 3\fR
+\fBset b {$a + 2}\fR
+\fBexpr $b*4\fR
+.CE
+return 11, not a multiple of 4.
+This is because the Tcl parser will first substitute \fB$a + 2\fR for
+the variable \fBb\fR,
+then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR.
+.PP
+Most expressions do not require a second round of substitutions.
+Either they are enclosed in braces or, if not,
+their variable and command substitutions yield numbers or strings
+that don't themselves require substitutions.
+However, because a few unbraced expressions 
+need two rounds of substitutions,
+the bytecode compiler must emit
+additional instructions to handle this situation.
+The most expensive code is required for
+unbraced expressions that contain command substitutions.
+These expressions must be implemented by generating new code
+each time the expression is executed.
+.VE
+
+.SH KEYWORDS
+arithmetic, boolean, compare, expression, fuzzy comparison
diff --git a/tcl/doc/fblocked.n b/tcl/doc/fblocked.n
new file mode 100644
index 00000000000..3e3922a3931
--- /dev/null
+++ b/tcl/doc/fblocked.n
@@ -0,0 +1,32 @@
+'\" 
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH fblocked n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+fblocked \- Test whether the last input operation exhausted all available input
+.SH SYNOPSIS
+\fBfblocked \fIchannelId\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfblocked\fR command returns 1 if the most recent input operation
+on \fIchannelId\fR returned less information than requested because all
+available input was exhausted.
+For example, if \fBgets\fR is invoked when there are only three
+characters available for input and no end-of-line sequence, \fBgets\fR
+returns an empty string and a subsequent call to \fBfblocked\fR will
+return 1.
+.PP
+.SH "SEE ALSO"
+gets(n), read(n)
+
+.SH KEYWORDS
+blocking, nonblocking
diff --git a/tcl/doc/fconfigure.n b/tcl/doc/fconfigure.n
new file mode 100644
index 00000000000..80301fb672a
--- /dev/null
+++ b/tcl/doc/fconfigure.n
@@ -0,0 +1,178 @@
+'\" 
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH fconfigure n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+fconfigure \- Set and get options on a channel
+.SH SYNOPSIS
+.nf
+\fBfconfigure \fIchannelId\fR
+\fBfconfigure \fIchannelId\fR \fIname\fR
+\fBfconfigure \fIchannelId\fR \fIname value \fR?\fIname value ...\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfconfigure\fR command sets and retrieves options for channels.
+\fIChannelId\fR identifies the channel for which to set or query an option.
+If no \fIname\fR or \fIvalue\fR arguments are supplied, the command
+returns a list containing alternating option names and values for the channel.
+If \fIname\fR is supplied but no \fIvalue\fR then the command returns
+the current value of the given option.
+If one or more pairs of \fIname\fR and \fIvalue\fR are supplied, the
+command sets each of the named options to the corresponding \fIvalue\fR;
+in this case the return value is an empty string.
+.PP
+The options described below are supported for all channels. In addition,
+each channel type may add options that only it supports. See the manual
+entry for the command that creates each type of channels for the options
+that that specific type of channel supports. For example, see the manual
+entry for the \fBsocket\fR command for its additional options.
+.TP
+\fB\-blocking\fR \fIboolean\fR
+The \fB\-blocking\fR option determines whether I/O operations on the
+channel can cause the process to block indefinitely.
+The value of the option must be a proper boolean value.
+Channels are normally in blocking mode;  if a channel is placed into
+nonblocking mode it will affect the operation of the \fBgets\fR,
+\fBread\fR, \fBputs\fR, \fBflush\fR, and \fBclose\fR commands;
+see the documentation for those commands for details.
+For nonblocking mode to work correctly, the application must be
+using the Tcl event loop (e.g. by calling \fBTcl_DoOneEvent\fR or
+invoking the \fBvwait\fR command).
+.TP
+\fB\-buffering\fR \fInewValue\fR
+If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output
+until its internal buffer is full or until the \fBflush\fR command is
+invoked. If \fInewValue\fR is \fBline\fR, then the I/O system will
+automatically flush output for the channel whenever a newline character
+is output. If \fInewValue\fR is \fBnone\fR, the I/O system will flush
+automatically after every output operation.
+The default is for \fB\-buffering\fR to be set to \fBfull\fR except for
+channels that connect to terminal-like devices; for these channels the
+initial setting is \fBline\fR.
+.TP
+\fB\-buffersize\fR \fInewSize\fR
+\fINewvalue\fR must be an integer; its value is used to set the size of
+buffers, in bytes, subsequently allocated for this channel to store input
+or output. \fINewvalue\fR must be between ten and one million, allowing
+buffers of ten to one million bytes in size.
+.TP
+\fB\-eofchar\fR \fIchar\fR
+.TP
+\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
+This option supports DOS file systems that use Control-z (\ex1a) as
+an end of file marker.
+If \fIchar\fR is not an empty string, then this character signals
+end of file when it is encountered during input.
+For output, the end of file character is output when
+the channel is closed.
+If \fIchar\fR is the empty string, then there is no special
+end of file character marker.
+For read-write channels, a two-element list specifies
+the end of file marker for input and output, respectively.
+As a convenience, when setting the end-of-file character
+for a read-write channel
+you can specify a single value that will apply to both reading and writing.
+When querying the end-of-file character of a read-write channel,
+a two-element list will always be returned.
+The default value for \fB\-eofchar\fR is the empty string in all
+cases except for files under Windows.  In that case the \fB\-eofchar\fR
+is Control-z (\ex1a) for reading and the empty string for writing.
+.TP
+\fB\-translation\fR \fImode\fR
+.TP
+\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
+In Tcl scripts the end of a line is always represented using a
+single newline character (\en).
+However, in actual files and devices the end of a line may be
+represented differently on different platforms, or even for
+different devices on the same platform.  For example, under UNIX
+newlines are used in files, whereas carriage-return-linefeed
+sequences are normally used in network connections.
+On input (i.e., with \fBgets\fP and \fBread\fP)
+the Tcl I/O system automatically translates the external end-of-line
+representation into newline characters.
+Upon output (i.e., with \fBputs\fP),
+the I/O system translates newlines to the external
+end-of-line representation.
+The default translation mode, \fBauto\fP, handles all the common
+cases automatically, but the \fB\-translation\fR option provides
+explicit control over the end of line translations.
+.RS
+.PP
+The value associated with \fB\-translation\fR is a single item for
+read-only and write-only channels.
+The value is a two-element list for read-write channels;
+the read translation mode is the first element of the list,
+and the write translation mode is the second element.
+As a convenience, when setting the translation mode for a read-write channel
+you can specify a single value that will apply to both reading and writing.
+When querying the translation mode of a read-write channel,
+a two-element list will always be returned.
+The following values are currently supported:
+.TP
+\fBauto\fR
+As the input translation mode, \fBauto\fR treats any of newline (\fBlf\fP),
+carriage return (\fBcr\fP), or carriage return followed by a newline (\fBcrlf\fP)
+as the end of line representation.  The end of line representation can
+even change from line-to-line, and all cases are translated to a newline.
+As the output translation mode, \fBauto\fR chooses a platform specific
+representation; for sockets on all platforms Tcl
+chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, for the
+Macintosh platform it chooses \fBcr\fR and for the various flavors of
+Windows it chooses \fBcrlf\fR.
+The default setting for \fB\-translation\fR is \fBauto\fR for both
+input and output.
+.TP
+\fBbinary\fR
+No end-of-line translations are performed.  This is nearly identical to
+\fBlf\fP mode, except that in addition \fBbinary\fP mode also sets the
+end of file character to the empty string, which disables it.
+See the description of
+\fB\-eofchar\fP for more information.
+.TP
+\fBcr\fR
+The end of a line in the underlying file or device is represented
+by a single carriage return character.
+As the input translation mode, \fBcr\fP mode converts carriage returns
+to newline characters.
+As the output translation mode, \fBcr\fP mode
+translates newline characters to carriage returns.
+This mode is typically used on Macintosh platforms.
+.TP
+\fBcrlf\fR
+The end of a line in the underlying file or device is represented
+by a carriage return character followed by a linefeed character.
+As the input translation mode, \fBcrlf\fP mode converts
+carriage-return-linefeed sequences
+to newline characters.
+As the output translation mode, \fBcrlf\fP mode
+translates newline characters to
+carriage-return-linefeed sequences.
+This mode is typically used on Windows platforms and for network
+connections.
+.TP
+\fBlf\fR
+The end of a line in the underlying file or device is represented
+by a single newline (linefeed) character.
+In this mode no translations occur during either input or output.
+This mode is typically used on UNIX platforms.
+.RE
+.PP
+
+.SH "SEE ALSO"
+close(n), flush(n), gets(n), puts(n), read(n), socket(n)
+
+.SH KEYWORDS
+blocking, buffering, carriage return, end of line, flushing, linemode,
+newline, nonblocking, platform, translation
diff --git a/tcl/doc/fcopy.n b/tcl/doc/fcopy.n
new file mode 100644
index 00000000000..a381a4b4e0b
--- /dev/null
+++ b/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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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/tcl/doc/file.n b/tcl/doc/file.n
new file mode 100644
index 00000000000..530b9ffacf7
--- /dev/null
+++ b/tcl/doc/file.n
@@ -0,0 +1,331 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH file n 7.6 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+file \- Manipulate file names and attributes
+.SH SYNOPSIS
+\fBfile \fIoption\fR \fIname\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+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).  \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
+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''
+on the Macintosh).  If \fIname\fR refers to a root directory, then the
+root directory is returned.  For example,
+.RS
+.CS
+\fBfile dirname c:/\fR
+.CE
+returns \fBc:/\fR. 
+.PP
+Note that tilde substitution will only be
+performed if it is necessary to complete the command. For example,
+.CS
+\fBfile dirname ~/src/foo.c\fR
+.CE
+returns \fB~/src\fR, whereas
+.CS
+\fBfile dirname ~\fR
+.CE
+returns \fB/home\fR (or something similar).
+.RE
+.TP
+\fBfile executable \fIname\fR
+.
+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.
+.TP
+\fBfile isdirectory \fIname\fR
+.
+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.
+.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
+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,
+.RS
+.CS
+\fBfile join a b /foo bar\fR
+.CE
+returns \fB/foo/bar\fR.
+.PP
+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
+.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
+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.
+.VS
+.TP
+\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
+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.
+.TP
+\fBfile readable \fIname\fR
+.
+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.
+.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
+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.
+.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.
+For example, under Unix
+.RS
+.CS
+\fBfile split /foo/~bar/baz\fR
+.CE
+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
+.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.
+.TP
+\fBfile tail \fIname\fR
+.
+Returns all of the characters in \fIname\fR after the last directory
+separator.  If \fIname\fR contains no separators then returns
+\fIname\fR.
+.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.
+.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.
+.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. 
+
+.SH "SEE ALSO"
+filename
+
+.SH KEYWORDS
+attributes, copy files, delete files, directory, file, move files, name, rename files, stat
diff --git a/tcl/doc/fileevent.n b/tcl/doc/fileevent.n
new file mode 100644
index 00000000000..68c9b29aaf2
--- /dev/null
+++ b/tcl/doc/fileevent.n
@@ -0,0 +1,109 @@
+'\"
+'\" Copyright (c) 1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH fileevent n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+fileevent \- Execute a script when a channel becomes readable or writable
+.SH SYNOPSIS
+\fBfileevent \fIchannelId \fBreadable \fR?\fIscript\fR?
+.sp
+\fBfileevent \fIchannelId \fBwritable \fR?\fIscript\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is used to create \fIfile event handlers\fR.  A file event
+handler is a binding between a channel and a script, such that the script
+is evaluated whenever the channel becomes readable or writable.  File event
+handlers are most commonly used to allow data to be received from another
+process on an event-driven basis, so that the receiver can continue to
+interact with the user while waiting for the data to arrive.  If an
+application invokes \fBgets\fR or \fBread\fR on a blocking channel when
+there is no input data available, the process will block; until the input
+data arrives, it will not be able to service other events, so it will
+appear to the user to ``freeze up''.  With \fBfileevent\fR, the process can
+tell when data is present and only invoke \fBgets\fR or \fBread\fR when
+they won't block.
+.PP
+The \fIchannelId\fR argument to \fBfileevent\fR refers to an open channel,
+such as the return value from a previous \fBopen\fR or \fBsocket\fR
+command.
+If the \fIscript\fR argument is specified, then \fBfileevent\fR
+creates a new event handler:  \fIscript\fR will be evaluated
+whenever the channel becomes readable or writable (depending on the
+second argument to \fBfileevent\fR).
+In this case \fBfileevent\fR returns an empty string.
+The \fBreadable\fR and \fBwritable\fR event handlers for a file
+are independent, and may be created and deleted separately.
+However, there may be at most one \fBreadable\fR and one \fBwritable\fR
+handler for a file at a given time in a given interpreter.
+If \fBfileevent\fR is called when the specified handler already
+exists in the invoking interpreter, the new script replaces the old one.
+.PP
+If the \fIscript\fR argument is not specified, \fBfileevent\fR
+returns the current script for \fIchannelId\fR, or an empty string
+if there is none.
+If the \fIscript\fR argument is specified as an empty string
+then the event handler is deleted, so that no script will be invoked.
+A file event handler is also deleted automatically whenever
+its channel is closed or its interpreter is deleted.
+.PP
+A channel is considered to be readable if there is unread data
+available on the underlying device.
+A channel is also considered to be readable if there is unread
+data in an input buffer, except in the special case where the
+most recent attempt to read from the channel was a \fBgets\fR
+call that could not find a complete line in the input buffer.
+This feature allows a file to be read a line at a time in nonblocking mode
+using events.
+A channel is also considered to be readable if an end of file or
+error condition is present on the underlying file or device.
+It is important for \fIscript\fR to check for these conditions
+and handle them appropriately;  for example, if there is no special
+check for end of file, an infinite loop may occur where \fIscript\fR
+reads no data, returns, and is immediately invoked again.
+.PP
+A channel is considered to be writable if at least one byte of data
+can be written to the underlying file or device without blocking,
+or if an error condition is present on the underlying file or device.
+.PP
+Event-driven I/O works best for channels that have been
+placed into nonblocking mode with the \fBfconfigure\fR command.
+In blocking mode, a \fBputs\fR command may block if you give it
+more data than the underlying file or device can accept, and a
+\fBgets\fR or \fBread\fR command will block if you attempt to read
+more data than is ready;  no events will be processed while the
+commands block.
+In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block.
+See the documentation for the individual commands for information
+on how they handle blocking and nonblocking channels.
+.PP
+The script for a file event is executed at global level (outside the
+context of any Tcl procedure) in the interpreter in which the
+\fBfileevent\fR command was invoked.
+If an error occurs while executing the script then the
+\fBbgerror\fR mechanism is used to report the error.
+In addition, the file event handler is deleted if it ever returns
+an error;  this is done in order to prevent infinite loops due to
+buggy handlers.
+
+.SH CREDITS
+.PP
+\fBfileevent\fR is based on the \fBaddinput\fR command created
+by Mark Diekhans.
+
+.SH "SEE ALSO"
+bgerror, fconfigure, gets, puts, read
+
+.SH KEYWORDS
+asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
+script, writable.
diff --git a/tcl/doc/filename.n b/tcl/doc/filename.n
new file mode 100644
index 00000000000..b0a979aa084
--- /dev/null
+++ b/tcl/doc/filename.n
@@ -0,0 +1,197 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH filename n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+filename \- File name conventions supported by Tcl commands
+.BE
+.SH INTRODUCTION
+.PP
+All Tcl commands and C procedures that take file names as arguments
+expect the file names to be in one of three forms, depending on the
+current platform.  On each platform, Tcl supports file names in the
+standard forms(s) for that platform.  In addition, on all platforms,
+Tcl supports a Unix-like syntax intended to provide a convenient way
+of constructing simple file names.  However, scripts that are intended
+to be portable should not assume a particular form for file names.
+Instead, portable scripts must use the \fBfile split\fR and \fBfile
+join\fR commands to manipulate file names (see the \fBfile\fR manual
+entry for more details).
+
+.SH PATH TYPES
+.PP
+File names are grouped into three general types based on the starting point
+for the path used to specify the file: absolute, relative, and
+volume-relative.  Absolute names are completely qualified, giving a path to
+the file relative to a particular volume and the root directory on that
+volume.  Relative names are unqualified, giving a path to the file relative 
+to the current working directory.  Volume-relative names are partially
+qualified, either giving the path relative to the root directory on the
+current volume, or relative to the current directory of the specified
+volume.  The \fBfile pathtype\fR command can be used to determine the
+type of a given path.
+
+.SH PATH SYNTAX
+.PP
+The rules for native names depend on the value reported in the Tcl
+array element \fBtcl_platform(platform)\fR:
+.TP 10
+\fBmac\fR
+On Apple Macintosh systems, Tcl supports two forms of path names.  The
+normal Mac style names use colons as path separators.  Paths may be
+relative or absolute, and file names may contain any character other
+than colon.  A leading colon causes the rest of the path to be
+interpreted relative to the current directory.  If a path contains a
+colon that is not at the beginning, then the path is interpreted as an
+absolute path.  Sequences of two or more colons anywhere in the path
+are used to construct relative paths where \fB::\fR refers to the
+parent of the current directory, \fB:::\fR refers to the parent of the
+parent, and so forth.
+.RS
+.PP
+In addition to Macintosh style names, Tcl also supports a subset of
+Unix-like names.  If a path contains no colons, then it is interpreted
+like a Unix path.  Slash is used as the path separator.  The file name
+\fB\&.\fR refers to the current directory, and \fB\&..\fR refers to the
+parent of the current directory.  However, some names like \fB/\fR or
+\fB/..\fR have no mapping, and are interpreted as Macintosh names.  In
+general, commands that generate file names will return Macintosh style
+names, but commands that accept file names will take both Macintosh
+and Unix-style names.
+.PP
+The following examples illustrate various forms of path names:
+.TP 15
+\fB:\fR
+Relative path to the current folder.
+.TP 15
+\fBMyFile\fR
+Relative path to a file named \fBMyFile\fR in the current folder.
+.TP 15
+\fBMyDisk:MyFile\fR
+Absolute path to a file named \fBMyFile\fR on the device named \fBMyDisk\fR.
+.TP 15
+\fB:MyDir:MyFile\fR
+Relative path to a file name \fBMyFile\fR in a folder named
+\fBMyDir\fR in the current folder.
+.TP 15
+\fB::MyFile\fR
+Relative path to a file named \fBMyFile\fR in the folder above the
+current folder.
+.TP 15
+\fB:::MyFile\fR
+Relative path to a file named \fBMyFile\fR in the folder two levels above the
+current folder. 
+.TP 15
+\fB/MyDisk/MyFile\fR
+Absolute path to a file named \fBMyFile\fR on the device named
+\fBMyDisk\fR.
+.TP 15
+\fB\&../MyFile\fR
+Relative path to a file named \fBMyFile\fR in the folder above the
+current folder.
+.RE
+.TP
+\fBunix\fR
+On Unix platforms, Tcl uses path names where the components are
+separated by slashes.  Path names may be relative or absolute, and
+file names may contain any character other than slash.  The file names
+\fB\&.\fR and \fB\&..\fR are special and refer to the current directory
+and the parent of the current directory respectively.  Multiple
+adjacent slash characters are interpreted as a single separator.
+The following examples illustrate various forms of path names:
+.RS
+.TP 15
+\fB/\fR
+Absolute path to the root directory.
+.TP 15
+\fB/etc/passwd\fR
+Absolute path to the file named \fBpasswd\fR in the directory
+\fBetc\fR in the root directory.
+.TP 15
+\fB\&.\fR
+Relative path to the current directory.
+.TP 15
+\fBfoo\fR
+Relative path to the file \fBfoo\fR in the current directory.
+.TP 15
+\fBfoo/bar\fR
+Relative path to the file \fBbar\fR in the directory \fBfoo\fR in the
+current directory.
+.TP 15
+\fB\&../foo\fR
+Relative path to the file \fBfoo\fR in the directory above the current
+directory. 
+.RE
+.TP
+\fBwindows\fR
+On Microsoft Windows platforms, Tcl supports both drive-relative and UNC
+style names.  Both \fB/\fR and \fB\e\fR may be used as directory separators
+in either type of name.  Drive-relative names consist of an optional drive
+specifier followed by an absolute or relative path.  UNC paths follow the
+general form \fB\e\eservername\esharename\epath\efile\fR.  In both forms,
+the file names \fB.\fR and \fB..\fR are special and refer to the current
+directory and the parent of the current directory respectively.  The
+following examples illustrate various forms of path names:
+.RS
+.TP 15
+\fB\&\e\eHost\eshare/file\fR
+Absolute UNC path to a file called \fBfile\fR in the root directory of
+the export point \fBshare\fR on the host \fBHost\fR.
+.TP 15
+\fBc:foo\fR
+Volume-relative path to a file \fBfoo\fR in the current directory on drive
+\fBc\fR.
+.TP 15
+\fBc:/foo\fR
+Absolute path to a file \fBfoo\fR in the root directory of drive
+\fBc\fR.
+.TP 15
+\fBfoo\ebar\fR
+Relative path to a file \fBbar\fR in the \fBfoo\fR directory in the current
+directory on the current volume.
+.TP 15
+\fB\&\efoo\fR
+Volume-relative path to a file \fBfoo\fR in the root directory of the current
+volume.
+.RE
+
+.SH TILDE SUBSTITUTION
+.PP
+In addition to the file name rules described above, Tcl also supports
+\fIcsh\fR-style tilde substitution.  If a file name starts with a
+tilde, then the file name will be interpreted as if the first element
+is replaced with the location of the home directory for the given
+user.  If the tilde is followed immediately by a separator, then the
+\fB$HOME\fR environment variable is substituted.  Otherwise the
+characters between the tilde and the next separator are taken as a
+user name, which is used to retrieve the user's home directory for
+substitution.
+.PP
+The Macintosh and Windows platforms do not support tilde substitution
+when a user name follows the tilde.  On these platforms, attempts to
+use a tilde followed by a user name will generate an error.  File
+names that have a tilde without a user name will be substituted using
+the \fB$HOME\fR environment variable, just like for Unix.
+
+.SH PORTABILITY ISSUES
+.PP
+Not all file systems are case sensitive, so scripts should avoid code
+that depends on the case of characters in a file name.  In addition,
+the character sets allowed on different devices may differ, so scripts
+should choose file names that do not contain special characters like:
+\fB<>:"/\e|\fR.  The safest approach is to use names consisting of
+alphanumeric characters only.  Also Windows 3.1 only supports file
+names with a root of no more than 8 characters and an extension of no
+more than 3 characters.
+
+.SH KEYWORDS
+current directory, absolute file name, relative file name,
+volume-relative file name, portability
diff --git a/tcl/doc/flush.n b/tcl/doc/flush.n
new file mode 100644
index 00000000000..d7cd1e13116
--- /dev/null
+++ b/tcl/doc/flush.n
@@ -0,0 +1,35 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH flush n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+flush \- Flush buffered output for a channel
+.SH SYNOPSIS
+\fBflush \fIchannelId\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+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.
+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.
+
+.SH "SEE ALSO"
+open(n), socket(n)
+
+.SH KEYWORDS
+blocking, buffer, channel, flush, nonblocking, output
diff --git a/tcl/doc/for.n b/tcl/doc/for.n
new file mode 100644
index 00000000000..7e426045340
--- /dev/null
+++ b/tcl/doc/for.n
@@ -0,0 +1,60 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH for n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+for \- ``For'' loop
+.SH SYNOPSIS
+\fBfor \fIstart test next body\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBFor\fR is a looping command, similar in structure to the C
+\fBfor\fR statement.  The \fIstart\fR, \fInext\fR, and
+\fIbody\fR arguments must be Tcl command strings, and \fItest\fR
+is an expression string.
+The \fBfor\fR command first invokes the Tcl interpreter to
+execute \fIstart\fR.  Then it repeatedly evaluates \fItest\fR as
+an expression; if the result is non-zero it invokes the Tcl
+interpreter on \fIbody\fR, then invokes the Tcl interpreter on \fInext\fR,
+then repeats the loop.  The command terminates when \fItest\fR evaluates
+to 0.  If a \fBcontinue\fR command is invoked within \fIbody\fR then
+any remaining commands in the current execution of \fIbody\fR are skipped;
+processing continues by invoking the Tcl interpreter on \fInext\fR, then
+evaluating \fItest\fR, and so on.  If a \fBbreak\fR command is invoked
+within \fIbody\fR
+or \fInext\fR,
+then the \fBfor\fR command will
+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/tcl/doc/foreach.n b/tcl/doc/foreach.n
new file mode 100644
index 00000000000..7790b5ff22b
--- /dev/null
+++ b/tcl/doc/foreach.n
@@ -0,0 +1,86 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH foreach n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+foreach \- Iterate over all elements in one or more lists
+.SH SYNOPSIS
+\fBforeach \fIvarname list body\fR
+.br
+\fBforeach \fIvarlist1 list1\fR ?\fIvarlist2 list2 ...\fR? \fIbody\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBforeach\fR command implements a loop where the loop
+variable(s) take on values from one or more lists.
+In the simplest case there is one loop variable, \fIvarname\fR,
+and one list, \fIlist\fR, that is a list of values to assign to \fIvarname\fR.
+The \fIbody\fR argument is a Tcl script.
+For each element of \fIlist\fR (in order
+from first to last), \fBforeach\fR assigns the contents of the
+element to \fIvarname\fR as if the \fBlindex\fR command had been used
+to extract the element, then calls the Tcl interpreter to execute
+\fIbody\fR.
+.PP
+In the general case there can be more than one value list
+(e.g., \fIlist1\fR and \fIlist2\fR),
+and each value list can be associated with a list of loop variables
+(e.g., \fIvarlist1\fR and \fIvarlist2\fR).
+During each iteration of the loop
+the variables of each \fIvarlist\fP are assigned
+consecutive values from the corresponding \fIlist\fP.
+Values in each \fIlist\fP are used in order from first to last,
+and each value is used exactly once.
+The total number of loop iterations is large enough to use
+up all the values from all the value lists.
+If a value list does not contain enough
+elements for each of its loop variables in each iteration,
+empty values are used for the missing elements.
+.PP
+The \fBbreak\fR and \fBcontinue\fR statements may be
+invoked inside \fIbody\fR, with the same effect as in the \fBfor\fR
+command.  \fBForeach\fR returns an empty string.
+.SH EXAMPLES
+.PP
+The following loop uses i and j as loop variables to iterate over
+pairs of elements of a single list.
+.DS
+set x {}
+foreach {i j} {a b c d e f} {
+    lappend x $j $i
+}
+# The value of x is "b a d c f e"
+# There are 3 iterations of the loop.
+.DE
+.PP
+The next loop uses i and j to iterate over two lists in parallel.
+.DS
+set x {}
+foreach i {a b c} j {d e f g} {
+    lappend x $i $j
+}
+# The value of x is "a d b e c f {} g"
+# There are 4 iterations of the loop.
+.DE
+.PP
+The two forms are combined in the following example.
+.DS
+set x {}
+foreach i {a b c} {j k} {d e f g} {
+    lappend x $i $j $k
+}
+# The value of x is "a d e b f g c {} {}"
+# There are 3 iterations of the loop.
+.DE
+.SH KEYWORDS
+foreach, iteration, list, looping
diff --git a/tcl/doc/format.n b/tcl/doc/format.n
new file mode 100644
index 00000000000..d8d55622a20
--- /dev/null
+++ b/tcl/doc/format.n
@@ -0,0 +1,212 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH format n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+format \- Format a string in the style of sprintf
+.SH SYNOPSIS
+\fBformat \fIformatString \fR?\fIarg arg ...\fR?
+.BE
+
+.SH INTRODUCTION
+.PP
+This command generates a formatted string in the same way as the
+ANSI C \fBsprintf\fR procedure (it uses \fBsprintf\fR in its
+implementation).
+\fIFormatString\fR indicates how to format the result, using
+\fB%\fR conversion specifiers as in \fBsprintf\fR, and the additional
+arguments, if any, provide values to be substituted into the result.
+The return value from \fBformat\fR is the formatted string.
+
+.SH "DETAILS ON FORMATTING"
+.PP
+The command operates by scanning \fIformatString\fR from left to right. 
+Each character from the format string is appended to the result
+string unless it is a percent sign.
+If the character is a \fB%\fR then it is not copied to the result string.
+Instead, the characters following the \fB%\fR character are treated as
+a conversion specifier.
+The conversion specifier controls the conversion of the next successive
+\fIarg\fR to a particular format and the result is appended to 
+the result string in place of the conversion specifier.
+If there are multiple conversion specifiers in the format string,
+then each one controls the conversion of one additional \fIarg\fR.
+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:
+an XPG3 position specifier,
+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
+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.
+Instead, it is taken from the argument indicated by the number,
+where 1 corresponds to the first \fIarg\fR.
+If the conversion specifier requires multiple arguments because
+of \fB*\fR characters in the specifier then
+successive arguments are used, starting with the argument
+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.
+.PP
+The second portion of a conversion specifier may contain any of the
+following flag characters, in any order:
+.TP 10
+\fB\-\fR
+Specifies that the converted argument should be left-justified 
+in its field (numbers are normally right-justified with leading 
+spaces if needed).
+.TP 10
+\fB+\fR
+Specifies that a number should always be printed with a sign, 
+even if positive.
+.TP 10
+\fIspace\fR
+Specifies that a space should be added to the beginning of the 
+number if the first character isn't a sign.
+.TP 10
+\fB0\fR
+Specifies that the number should be padded on the left with 
+zeroes instead of spaces.
+.TP 10
+\fB#\fR
+Requests an alternate output form. For \fBo\fR and \fBO\fR
+conversions it guarantees that the first digit is always \fB0\fR.
+For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
+will be added to the beginning of the result unless it is zero.
+For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
+\fBg\fR, and \fBG\fR) it guarantees that the result always 
+has a decimal point.
+For \fBg\fR and \fBG\fR conversions it specifies that 
+trailing zeroes should not be removed.
+.PP
+The third portion of a conversion specifier is a number giving a
+minimum field width for this conversion.
+It is typically used to make columns line up in tabular printouts.
+If the converted argument contains fewer characters than the
+minimum field width then it will be padded so that it is as wide
+as the minimum field width.
+Padding normally occurs by adding extra spaces on the left of the
+converted argument, but the \fB0\fR and \fB\-\fR flags 
+may be used to specify padding with zeroes on the left or with
+spaces on the right, respectively.
+If the minimum field width is specified as \fB*\fR rather than
+a number, then the next argument to the \fBformat\fR command
+determines the minimum field width; it must be a numeric string.
+.PP
+The fourth portion of a conversion specifier is a precision,
+which consists of a period followed by a number.
+The number is used in different ways for different conversions.
+For \fBe\fR, \fBE\fR, and \fBf\fR conversions it specifies the number
+of digits to appear to the right of the decimal point.
+For \fBg\fR and \fBG\fR conversions it specifies the total number
+of digits to appear, including those on both sides of the decimal
+point (however, trailing zeroes after the decimal point will still
+be omitted unless the \fB#\fR flag has been specified).
+For integer conversions, it specifies a minimum number of digits
+to print (leading zeroes will be added if necessary).
+For \fBs\fR conversions it specifies the maximum number of characters to be 
+printed; if the string is longer than this then the trailing characters will be dropped.
+If the precision is specified with \fB*\fR rather than a number
+then the next argument to the \fBformat\fR command determines the precision;
+it must be a numeric string.
+.PP
+The fifth part of a conversion specifier is a length modifier,
+which must be \fBh\fR or \fBl\fR.
+If it is \fBh\fR it specifies that the numeric value should be
+truncated to a 16-bit value before converting.
+This option is rarely useful.
+The \fBl\fR modifier is ignored.
+.PP
+The last thing in a conversion specifier is an alphabetic character
+that determines what kind of conversion to perform.
+The following conversion characters are currently supported:
+.TP 10
+\fBd\fR
+Convert integer to signed decimal string.
+.TP 10
+\fBu\fR
+Convert integer to unsigned decimal string.
+.TP 10
+\fBi\fR
+Convert integer to signed decimal string;  the integer may either be
+in decimal, in octal (with a leading \fB0\fR) or in hexadecimal
+(with a leading \fB0x\fR).
+.TP 10
+\fBo\fR
+Convert integer to unsigned octal string.
+.TP 10
+\fBx\fR or \fBX\fR
+Convert integer to unsigned hexadecimal string, using digits
+``0123456789abcdef'' for \fBx\fR and ``0123456789ABCDEF'' for \fBX\fR).
+.TP 10
+\fBc\fR
+Convert integer to the 8-bit character it represents.
+.TP 10
+\fBs\fR
+No conversion; just insert string.
+.TP 10
+\fBf\fR
+Convert floating-point number to signed decimal string of 
+the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by 
+the precision (default: 6).
+If the precision is 0 then no decimal point is output.
+.TP 10
+\fBe\fR or \fBe\fR
+Convert floating-point number to scientific notation in the 
+form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined 
+by the precision (default: 6).
+If the precision is 0 then no decimal point is output.
+If the \fBE\fR form is used then \fBE\fR is 
+printed instead of \fBe\fR.
+.TP 10
+\fBg\fR or \fBG\fR
+If the exponent is less than \-4 or greater than or equal to the 
+precision, then convert floating-point number as for \fB%e\fR or 
+\fB%E\fR.
+Otherwise convert as for \fB%f\fR.
+Trailing zeroes and a trailing decimal point are omitted.
+.TP 10
+\fB%\fR
+No conversion: just insert \fB%\fR.
+.LP
+For the numerical conversions the argument being converted must
+be an integer or floating-point string; format converts the argument
+to binary and then converts it back to a string according to 
+the conversion specifier.
+
+.SH "DIFFERENCES FROM ANSI SPRINTF"
+.PP
+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.
+.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]
+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.
+
+.SH KEYWORDS
+conversion specifier, format, sprintf, string, substitution
diff --git a/tcl/doc/gets.n b/tcl/doc/gets.n
new file mode 100644
index 00000000000..d27c0b29c34
--- /dev/null
+++ b/tcl/doc/gets.n
@@ -0,0 +1,50 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH gets n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+gets \- Read a line from a channel
+.SH SYNOPSIS
+\fBgets \fIchannelId\fR ?\fIvarName\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command reads the next line from \fIchannelId\fR, returns everything
+in the line up to (but not including) the end-of-line character(s), and
+discards the end-of-line character(s).
+If \fIvarName\fR is omitted the line is returned as the result of the
+command.
+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
+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
+line of input available, the command returns an empty string and
+does not consume any input.
+If \fIvarName\fR is specified and an empty string is returned in
+\fIvarName\fR because of end-of-file or because of insufficient
+data in nonblocking mode, then the return count is -1.
+Note that if \fIvarName\fR is not specified then the end-of-file
+and no-full-line-available cases can
+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.
+
+.SH "SEE ALSO"
+eof(n), fblocked(n)
+
+.SH KEYWORDS
+blocking, channel, end of file, end of line, line, nonblocking, read
diff --git a/tcl/doc/glob.n b/tcl/doc/glob.n
new file mode 100644
index 00000000000..bfad9e4da32
--- /dev/null
+++ b/tcl/doc/glob.n
@@ -0,0 +1,84 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH glob n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+glob \- Return names of files that match patterns
+.SH SYNOPSIS
+\fBglob \fR?\fIswitches\fR? \fIpattern \fR?\fIpattern ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command performs file name ``globbing'' in a fashion similar to
+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
+they are treated as switches.  The following switches are
+currently supported:
+.TP 15
+\fB\-nocomplain\fR
+Allows an empty list to be returned without error;  without this
+switch an error is returned if the result list would be empty.
+.TP 15
+\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.
+.PP
+The \fIpattern\fR arguments may contain any of the following
+special characters:
+.TP 10
+\fB?\fR
+Matches any single character.
+.TP 10
+\fB*\fR
+Matches any sequence of zero or more characters.
+.TP 10
+\fB[\fIchars\fB]\fR
+Matches any single character in \fIchars\fR.  If \fIchars\fR
+contains a sequence of the form \fIa\fB\-\fIb\fR then any
+character between \fIa\fR and \fIb\fR (inclusive) will match.
+.TP 10
+\fB\e\fIx\fR
+Matches the character \fIx\fR.
+.TP 10
+\fB{\fIa\fB,\fIb\fB,\fI...\fR}
+Matches any of the strings \fIa\fR, \fIb\fR, etc.
+.LP
+As with csh, a  ``.'' at the beginning of a file's name or just
+after a ``/'' must be matched explicitly or with a {} construct.
+In addition, all ``/'' characters must be matched explicitly.
+.LP
+If the first character in a \fIpattern\fR is ``~'' then it refers
+to the home directory for the user whose name follows the ``~''.
+If the ``~'' is followed immediately by ``/'' then the value of
+the HOME environment variable is used.
+.LP
+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).
+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.
+
+.SH PORTABILITY ISSUES
+.PP
+Unlike other Tcl commands that will accept both network and native
+style names (see the \fBfilename\fR manual entry for details on how
+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. 
+
+.SH KEYWORDS
+exist, file, glob, pattern
diff --git a/tcl/doc/global.n b/tcl/doc/global.n
new file mode 100644
index 00000000000..bc27815b89b
--- /dev/null
+++ b/tcl/doc/global.n
@@ -0,0 +1,35 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH global n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+global \- Access global variables
+.SH SYNOPSIS
+\fBglobal \fIvarname \fR?\fIvarname ...\fR?
+.BE
+
+.SH DESCRIPTION
+.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.
+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, namespace, procedure, variable
diff --git a/tcl/doc/history.n b/tcl/doc/history.n
new file mode 100644
index 00000000000..2c394b8e599
--- /dev/null
+++ b/tcl/doc/history.n
@@ -0,0 +1,104 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH history n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+history \- Manipulate the history list
+.SH SYNOPSIS
+\fBhistory \fR?\fIoption\fR? ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBhistory\fR command performs one of several operations related to
+recently-executed commands recorded in a history list.  Each of
+these recorded commands is referred to as an ``event''.  When
+specifying an event to the \fBhistory\fR command, the following
+forms may be used:
+.IP [1]
+A number:  if positive, it refers to the event with
+that number (all events are numbered starting at 1).  If the number
+is negative, it selects an event relative to the current event
+(\fB\-1\fR refers to the previous event, \fB\-2\fR to the one before that, and
+so on).  Event \fB0\fP refers to the current event.
+.IP [2]
+A string:  selects the most recent event that matches the string.
+An event is considered to match the string either if the string is
+the same as the first characters of the event, or if the string
+matches the event in the sense of the \fBstring match\fR command.
+.PP
+The \fBhistory\fR command can take any of the following forms:
+.TP
+\fBhistory\fR
+Same
+as \fBhistory info\fR, described below.
+.TP
+\fBhistory add\fI command \fR?\fBexec\fR?
+Adds the \fIcommand\fR argument to the history list as a new event.  If
+\fBexec\fR is specified (or abbreviated) then the command is also
+executed and its result is returned.  If \fBexec\fR isn't specified
+then an empty string is returned as result.
+.TP
+\fBhistory change\fI newValue\fR ?\fIevent\fR?
+Replaces the value recorded for an event with \fInewValue\fR.  \fIEvent\fR
+specifies the event to replace, and
+defaults to the \fIcurrent\fR event (not event \fB\-1\fR).  This command
+is intended for use in commands that implement new forms of history
+substitution and wish to replace the current event (which invokes the
+substitution) with the command created through substitution.  The return
+value is an empty string.
+.TP
+\fBhistory clear\fR
+Erase the history list.  The current keep limit is retained.
+The history event numbers are reset.
+.TP
+\fBhistory event\fR ?\fIevent\fR?
+Returns the value of the event given by \fIevent\fR.  \fIEvent\fR
+defaults to \fB\-1\fR.
+.TP
+\fBhistory info \fR?\fIcount\fR?
+Returns a formatted string (intended for humans to read) giving
+the event number and contents for each of the events in the history
+list except the current event.  If \fIcount\fR is specified
+then only the most recent \fIcount\fR events are returned.
+.TP
+\fBhistory keep \fR?\fIcount\fR?
+This command may be used to change the size of the history list to
+\fIcount\fR events.  Initially, 20 events are retained in the history
+list.  If \fIcount\fR is not specified, the current keep limit is returned.
+.TP
+\fBhistory nextid\fR
+Returns the number of the next event to be recorded
+in the history list.  It is useful for things like printing the
+event number in command-line prompts.
+.TP
+\fBhistory redo \fR?\fIevent\fR?
+Re-executes the command indicated by \fIevent\fR and return its result.
+\fIEvent\fR defaults to \fB\-1\fR.  This command results in history
+revision:  see below for details.
+.SH "HISTORY REVISION"
+.PP
+Pre-8.0 Tcl had a complex history revision mechanism.
+The current mechanism is more limited, and the old
+history operations \fBsubstitute\fP and \fBwords\fP have been removed.
+(As a consolation, the \fBclear\fP operation was added.)
+.PP
+The history option \fBredo\fR results in much simpler ``history revision''.
+When this option is invoked then the most recent event
+is modified to eliminate the history command and replace it with
+the result of the history command.
+If you want to redo an event without modifying history, then use
+the \fBevent\fP operation to retrieve some event,
+and the \fBadd\fP operation to add it to history and execute it.
+
+.SH KEYWORDS
+event, history, record
diff --git a/tcl/doc/http.n b/tcl/doc/http.n
new file mode 100644
index 00000000000..18ffc89f88f
--- /dev/null
+++ b/tcl/doc/http.n
@@ -0,0 +1,360 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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 ?2.0?\fP
+.sp
+\fB::http::config \fI?options?\fR
+.sp
+\fB::http::geturl \fIurl ?options?\fR
+.sp
+\fB::http::formatQuery \fIlist\fR
+.sp
+\fB::http::reset \fItoken\fR
+.sp
+\fB::http::wait \fItoken\fR
+.sp
+\fB::http::status \fItoken\fR
+.sp
+\fB::http::size \fItoken\fR
+.sp
+\fB::http::code \fItoken\fR
+.sp
+\fB::http::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 \fB::http::geturl\fR procedure does a HTTP transaction.
+Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction
+is performed.  
+The return value of \fB::http::geturl\fR is a token for the transaction.
+The value is also the name of an array in the ::http namespace
+ 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.
+\fB::http::geturl\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 \fB::http::wait\fR after calling
+\fB::http::geturl\fR to start the event loop.
+.SH COMMANDS
+.TP
+\fB::http::config\fP ?\fIoptions\fR?
+The \fB::http::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
+\fB::http::geturl\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 2.0."\fR
+.RE
+.TP
+\fB::http::geturl\fP \fIurl\fP ?\fIoptions\fP? 
+The \fB::http::geturl \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 \fB::http::geturl\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 \fB::http::geturl\fR command blocks until the operation
+completes, unless the \fB\-command\fR option specifies a callback
+that is invoked when the HTTP transaction completes.
+\fB::http::geturl\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 \fB::http::geturl\fP to return immediately.
+The \fIcallback\fP gets an additional argument that is the \fItoken\fR returned
+from \fB::http::geturl\fR. This token is the name of an 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
+\fB::http::geturl\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
+\fB::http::geturl\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 \fB::http::geturl\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 \fB::http::formatQuery\fR procedure can be used to
+do the formatting.
+.TP
+\fB\-timeout\fP \fImilliseconds\fP
+If \fImilliseconds\fR is non-zero, then \fB::http::geturl\fR sets up a timeout
+to occur after the specified number of milliseconds.
+A timeout results in a call to \fB::http::reset\fP and to
+the \fB-command\fP callback, if specified.
+The return value of \fB::http::status\fP is \fBtimeout\fP
+after a timeout has occurred.
+.TP
+\fB\-validate\fP \fIboolean\fP
+If \fIboolean\fR is non-zero, then \fB::http::geturl\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
+\fB::http::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 \fB::http::geturl\fR.
+.TP
+\fB::http::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
+\fB::http::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
+\fB::http::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
+\fB::http::status\fP \fItoken\fP
+This is a convenience procedure that returns the \fBstatus\fP element of
+the state array.
+.TP
+\fB::http::code\fP \fItoken\fP
+This is a convenience procedure that returns the \fBhttp\fP element of the
+state array.
+.TP
+\fB::http::size\fP \fItoken\fP
+This is a convenience procedure that returns the \fBcurrentsize\fP
+element of the state array.
+.SH "STATE ARRAY"
+The \fB::http::geturl\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 \fB::http::data\fP command.
+.TP
+\fBcurrentsize\fR
+The current number of bytes fetched from the URL.
+This value is returned by the \fB::http::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 \fB::http::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
+\fB::http::geturl\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 [geturl $url -channel $out -progress ::http::Progress \\
+	-blocksize $chunk]
+    close $out
+    # This ends the line started by http::Progress
+    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 [copy [string trim $value] $file $chunk]
+	}
+    }
+    incr max
+    foreach {name value} $state(meta) {
+	puts [format "%-*s %s" $max $name: $value]
+    }
+
+    return $token
+}
+proc ::http::Progress {args} {
+    puts -nonewline stderr . ; flush stderr
+}
+
+.DE
+.SH "SEE ALSO"
+safe(n), socket(n), safesock(n)
+.SH KEYWORDS
+security policy, socket
+
+
diff --git a/tcl/doc/if.n b/tcl/doc/if.n
new file mode 100644
index 00000000000..98c314569ce
--- /dev/null
+++ b/tcl/doc/if.n
@@ -0,0 +1,43 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH if n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+if \- Execute scripts conditionally
+.SH SYNOPSIS
+\fBif \fIexpr1 \fR?\fBthen\fR? \fIbody1 \fBelseif \fIexpr2 \fR?\fBthen\fR? \fIbody2\fR \fBelseif\fR ... ?\fBelse\fR? ?\fIbodyN\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+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
+(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);
+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
+then \fBbody2\fR is executed, and so on.
+If none of the expressions evaluates to true then \fIbodyN\fR is
+executed.
+The \fBthen\fR and \fBelse\fR arguments are optional
+``noise words'' to make the command easier to read.
+There may be any number of \fBelseif\fR clauses, including zero.
+\fIBodyN\fR may also be omitted as long as \fBelse\fR is omitted too.
+The return value from the command is the result of the body script
+that was executed, or an empty string
+if none of the expressions was non-zero and there was no \fIbodyN\fR.
+
+.SH KEYWORDS
+boolean, conditional, else, false, if, true
diff --git a/tcl/doc/incr.n b/tcl/doc/incr.n
new file mode 100644
index 00000000000..c681ad74d1f
--- /dev/null
+++ b/tcl/doc/incr.n
@@ -0,0 +1,31 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH incr n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+incr \- Increment the value of a variable
+.SH SYNOPSIS
+\fBincr \fIvarName \fR?\fIincrement\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Increments the value stored in the variable whose name is \fIvarName\fR.
+The value of the variable must be an integer.
+If \fIincrement\fR is supplied then its value (which must be an
+integer) is added to the value of variable \fIvarName\fR;  otherwise
+1 is added to \fIvarName\fR.
+The new value is stored as a decimal string in variable \fIvarName\fR
+and also returned as result.
+
+.SH KEYWORDS
+add, increment, variable, value
diff --git a/tcl/doc/info.n b/tcl/doc/info.n
new file mode 100644
index 00000000000..e538086f077
--- /dev/null
+++ b/tcl/doc/info.n
@@ -0,0 +1,185 @@
+'\"
+'\" Copyright (c) 1993 The Regents of the University of California.
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH info n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+info \- Return information about the state of the Tcl interpreter
+.SH SYNOPSIS
+\fBinfo \fIoption \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command provides information about various internals of the Tcl
+interpreter.
+The legal \fIoption\fR's (which may be abbreviated) are:
+.TP
+\fBinfo args \fIprocname\fR
+Returns a list containing the names of the arguments to procedure
+\fIprocname\fR, in order.  \fIProcname\fR must be the name of a
+Tcl command procedure.
+.TP
+\fBinfo body \fIprocname\fR
+Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
+the name of a Tcl command procedure.
+.TP
+\fBinfo cmdcount\fR
+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 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.
+\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
+having no unclosed quotes, braces, brackets or array element names,
+If the command doesn't appear to be complete then 0 is returned.
+This command is typically used in line-oriented input environments
+to allow users to type in commands that span multiple lines;  if the
+command isn't complete, the script can delay evaluating it until additional
+lines have been typed to complete the command.
+.TP
+\fBinfo default \fIprocname arg varname\fR
+\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
+must be the name of an argument to that procedure.  If \fIarg\fR
+doesn't have a default value then the command returns \fB0\fR.
+Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
+into variable \fIvarname\fR.
+.TP
+\fBinfo exists \fIvarName\fR
+Returns \fB1\fR if the variable named \fIvarName\fR exists in the
+current context (either as a global or local variable), returns \fB0\fR
+otherwise.
+.TP
+\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.
+.TP
+\fBinfo hostname\fR
+Returns the name of the computer on which this invocation is being
+executed.
+.TP
+\fBinfo level\fR ?\fInumber\fR?
+If \fInumber\fR is not specified, this command returns a number
+giving the stack level of the invoking procedure, or 0 if the
+command is invoked at top-level.  If \fInumber\fR is specified,
+then the result is a list consisting of the name and arguments for the
+procedure call at level \fInumber\fR on the stack.  If \fInumber\fR
+is positive then it selects a particular stack level (1 refers
+to the top-most active procedure, 2 to the procedure it called, and
+so on); otherwise it gives a level relative to the current level
+(0 refers to the current procedure, -1 to its caller, and so on).
+See the \fBuplevel\fR command for more information on what stack
+levels mean.
+.TP
+\fBinfo library\fR
+Returns the name of the library directory in which standard Tcl
+scripts are stored.
+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.
+.TP
+\fBinfo loaded \fR?\fIinterp\fR?
+Returns a list describing all of the packages that have been loaded into
+\fIinterp\fR with the \fBload\fR command.
+Each list element is a sub-list with two elements consisting of the
+name of the file from which the package was loaded and the name of
+the package.
+For statically-loaded packages the file name will be an empty string.
+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.
+.TP
+\fBinfo locals \fR?\fIpattern\fR?
+If \fIpattern\fR isn't specified, returns a list of all the names
+of currently-defined local variables, including arguments to the
+current procedure, if any.
+Variables defined with the \fBglobal\fR and \fBupvar\fR commands
+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.
+.TP
+\fBinfo nameofexecutable\fR
+Returns the full path name of the binary file from which the application
+was invoked.  If Tcl was unable to identify the file, then an empty
+string is returned.
+.TP
+\fBinfo patchlevel\fR
+Returns the value of the global variable \fBtcl_patchLevel\fR; see
+the \fBtclvars\fR manual entry for more information.
+.TP
+\fBinfo procs \fR?\fIpattern\fR?
+If \fIpattern\fR isn't specified, returns a list of all the
+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
+If a Tcl script file is currently being evaluated (i.e. there is a
+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.
+.TP
+\fBinfo sharedlibextension\fR
+Returns the extension used on this platform for the names of files
+containing shared libraries (for example, \fB.so\fR under Solaris).
+If shared libraries aren't supported on this platform then an empty
+string is returned.
+.TP
+\fBinfo tclversion\fR
+Returns the value of the global variable \fBtcl_version\fR; see
+the \fBtclvars\fR manual entry for more information.
+.TP
+\fBinfo vars\fR ?\fIpattern\fR?
+If \fIpattern\fR isn't specified,
+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, namespace, procedure, variable
diff --git a/tcl/doc/interp.n b/tcl/doc/interp.n
new file mode 100644
index 00000000000..1f603c26a8b
--- /dev/null
+++ b/tcl/doc/interp.n
@@ -0,0 +1,540 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH interp n 7.6 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+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 
+interpreters that co-exist with the creating interpreter in the
+same application.  The creating interpreter is called the \fImaster\fR
+and the new interpreter is called a \fIslave\fR. 
+A master can create any number of slaves, and each slave can
+itself create additional slaves for which it is master, resulting
+in a hierarchy of interpreters.
+.PP
+Each interpreter is independent from the others: it has its own name
+space for commands, procedures, and global variables.
+A master interpreter may create connections between its slaves and
+itself using a mechanism called an \fIalias\fR.  An \fIalias\fR is
+a command in a slave interpreter which, when invoked, causes a
+command to be invoked in its master interpreter or in another slave
+interpreter.  The only other connections between interpreters are
+through environment variables (the \fBenv\fR variable), which are
+normally shared among all interpreters in the application. Note that the
+name space for files (such as the names returned by the \fBopen\fR command)
+is no longer shared between interpreters. Explicit commands are provided to
+share files and to transfer references to open files from one interpreter
+to another.
+.PP
+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 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 \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 \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, and to share or transfer
+channels between interpreters.  It can have any of several forms, depending
+on the \fIoption\fR argument:
+.TP
+\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR
+Returns a Tcl list whose elements are the \fItargetCmd\fR and
+\fIarg\fRs associated with the alias named \fIsrcCmd\fR
+(all of these are the values specified when the alias was
+created; it is possible that the actual source command in the
+slave is different from \fIsrcCmd\fR if it was renamed).
+.TP
+\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fB{}\fR
+Deletes the alias for \fIsrcCmd\fR in the slave interpreter identified by
+\fIsrcPath\fR.
+\fIsrcCmd\fR refers to the name under which the alias
+was created;  if the source command has been renamed, the renamed
+command will be deleted.
+.TP
+\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
+This command creates an alias between one slave and another (see the
+\fBalias\fR slave command below for creating aliases between a slave
+and its master).  In this command, either of the slave interpreters
+may be anywhere in the hierarchy of interpreters under the interpreter
+invoking the command.
+\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
+\fISrcPath\fR is a Tcl list whose elements select a particular
+interpreter.  For example, ``\fBa b\fR'' identifies an interpreter
+\fBb\fR, which is a slave of interpreter \fBa\fR, which is a slave
+of the invoking interpreter.  An empty list specifies the interpreter
+invoking the command.  \fIsrcCmd\fR gives the name of a new
+command, which will be created in the source interpreter.
+\fITargetPath\fR and \fItargetCmd\fR specify a target interpreter
+and command, and the \fIarg\fR arguments, if any, specify additional
+arguments to \fItargetCmd\fR which are prepended to any arguments specified
+in the invocation of \fIsrcCmd\fR.
+\fITargetCmd\fR may be undefined at the time of this call, or it may
+already exist; it is not created by this command.
+The alias arranges for the given target command to be invoked
+in the target interpreter whenever the given source command is
+invoked in the source interpreter.  See ALIAS INVOCATION below for
+more details.
+.TP
+\fBinterp\fR \fBaliases \fR?\fIpath\fR?
+This command returns a Tcl list of the names of all the source commands for
+aliases defined in the interpreter identified by \fIpath\fR.
+.TP
+\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
+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 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
+interpreter and the slave command. If the \fB\-safe\fR switch is specified
+(or if the master interpreter is a safe interpreter), the new slave
+interpreter will be created as a safe interpreter with limited
+functionality; otherwise the slave will include the full set of Tcl
+built-in commands and variables. The \fB\-\|\-\fR switch can be used to
+mark the end of switches;  it may be needed if \fIpath\fR is an unusual
+value such as \fB\-safe\fR. The result of the command is the name of the
+new interpreter. The name of a slave interpreter must be unique among all
+the slaves for its master;  an error occurs if a slave interpreter by the
+given name already exists in this master.
+.TP
+\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
+Deletes zero or more interpreters given by the optional \fIpath\fR
+arguments, and for each interpreter, it also deletes its slaves. The
+command also deletes the slave command for each interpreter deleted.
+For each \fIpath\fR argument, if no interpreter by that name
+exists, the command raises an error.
+.TP
+\fBinterp\fR \fBeval\fR \fIpath arg \fR?\fIarg ...\fR?
+This command concatenates all of the \fIarg\fR arguments in the same
+fashion as the \fBconcat\fR command, then evaluates the resulting string as
+a Tcl script in the slave interpreter identified by \fIpath\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.
+.TP
+\fBinterp exists \fIpath\fR
+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 expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
+Makes the hidden command \fIhiddenName\fR exposed, eventually bringing
+it back under a new \fIexposedCmdName\fR name (this name is currently
+accepted only if it is a valid global name space name without any ::),
+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\fR \fBhide\fR \fIpath\fR \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
+Makes the exposed command \fIexposedCmdName\fR hidden, renaming
+it to the hidden command \fIhiddenCmdName\fR, or keeping the same name if
+\fIhiddenCmdName\fR is not given, in the interpreter denoted 
+by \fIpath\fR.
+If a hidden command with the targetted name already exists, this command
+fails.
+Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can 
+not contain namespace qualifiers, or an error is raised.
+Commands to be hidden by \fBinterp hide\fR are looked up in the global
+namespace even if the current namespace is not the global one. This
+prevents slaves from fooling a master interpreter into hiding the wrong
+command, by making the current namespace be different from the global one.
+Hidden commands are explained in more detail in HIDDEN COMMANDS, below.
+.TP
+\fBinterp\fR \fBhidden\fR \fIpath\fR
+Returns a list of the names of all hidden commands in the interpreter
+identified by \fIpath\fR.
+.TP
+\fBinterp\fR \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 issafe\fR ?\fIpath\fR?
+Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR
+is safe, \fB0\fR otherwise.
+.VS "" BR
+.TP
+\fBinterp marktrusted\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\fR \fBshare\fR \fIsrcPath channelId destPath\fR
+Causes the IO channel identified by \fIchannelId\fR to become shared
+between the interpreter identified by \fIsrcPath\fR and the interpreter
+identified by \fIdestPath\fR. Both interpreters have the same permissions
+on the IO channel.
+Both interpreters must close it to close the underlying IO channel; IO
+channels accessible in an interpreter are automatically closed when an
+interpreter is destroyed.
+.TP
+\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
+Returns a Tcl list of the names of all the slave interpreters associated
+with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
+the invoking interpreter is used.
+.TP
+\fBinterp\fR \fBtarget\fR \fIpath alias\fR
+Returns a Tcl list describing the target interpreter for an alias. The
+alias is specified with an interpreter path and source command name, just
+as in \fBinterp alias\fR above. The name of the target interpreter is
+returned as an interpreter path, relative to the invoking interpreter.
+If the target interpreter for the alias is the invoking interpreter then an
+empty list is returned. If the target interpreter for the alias is not the
+invoking interpreter or one of its descendants then an error is generated.
+The target command does not have to be defined at the time of this invocation.
+.TP
+\fBinterp\fR \fBtransfer\fR \fIsrcPath channelId destPath\fR
+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
+new Tcl command is created in the master interpreter with the same
+name as the new interpreter. This command may be used to invoke
+various operations on the interpreter.  It has the following
+general form:
+.CS
+\fIslave command \fR?\fIarg arg ...\fR?
+.CE
+\fISlave\fR is the name of the interpreter, and \fIcommand\fR
+and the \fIarg\fRs determine the exact behavior of the command.
+The valid forms of this command are:
+.TP
+\fIslave \fBaliases\fR
+Returns a Tcl list whose elements are the names of all the
+aliases in \fIslave\fR.  The names returned are the \fIsrcCmd\fR
+values used when the aliases were created (which may not be the same
+as the current names of the commands, if they have been
+renamed).
+.TP
+\fIslave \fBalias \fIsrcCmd\fR
+Returns a Tcl list whose elements are the \fItargetCmd\fR and
+\fIarg\fRs associated with the alias named \fIsrcCmd\fR
+(all of these are the values specified when the alias was
+created; it is possible that the actual source command in the
+slave is different from \fIsrcCmd\fR if it was renamed).
+.TP
+\fIslave \fBalias \fIsrcCmd \fB{}\fR
+Deletes the alias for \fIsrcCmd\fR in the slave interpreter.
+\fIsrcCmd\fR refers to the name under which the alias
+was created;  if the source command has been renamed, the renamed
+command will be deleted.
+.TP
+\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
+Creates an alias such that whenever \fIsrcCmd\fR is invoked
+in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
+The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
+arguments, prepended before any arguments passed in the invocation of
+\fIsrcCmd\fR.
+See ALIAS INVOCATION below for details.
+.TP
+\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
+This command concatenates all of the \fIarg\fR arguments in
+the same fashion as the \fBconcat\fR command, then evaluates
+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 \fIhiddenName \fR?\fIexposedCmdName\fR?
+This command exposes the hidden command \fIhiddenName\fR, eventually bringing
+it back under a new \fIexposedCmdName\fR name (this name is currently
+accepted only if it is a valid global name space name without any ::),
+in \fIslave\fR.
+If an exposed command with the targetted 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, renaming it to 
+the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
+the argument is not given, in the \fIslave\fR interpreter.
+If a hidden command with the targetted name already exists, this command
+fails.
+Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can 
+not contain namespace qualifiers, or an error is raised.
+Commands to be hidden are looked up in the global
+namespace even if the current namespace is not the global one. This
+prevents slaves from fooling a master interpreter into hiding the wrong
+command, by making the current namespace be different from the global one.
+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 \fIhiddenName \fR?\fIarg ..\fR?
+This command invokes the hidden command \fIhiddenName\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.
+.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
+A safe interpreter is one with restricted functionality, so that
+is safe to execute an arbitrary script from your worst enemy without
+fear of that script damaging the enclosing application or the rest
+of your computing environment.  In order to make an interpreter
+safe, certain commands and variables are removed from the interpreter.
+For example, commands to create files on disk are removed, and the
+\fBexec\fR command is removed, since it could be used to cause damage
+through subprocesses.
+Limited access to these facilities can be provided, by creating
+aliases to the master interpreter which check their arguments carefully
+and provide restricted access to a safe subset of facilities.
+For example, file creation might be allowed in a particular subdirectory
+and subprocess invocation might be allowed for a carefully selected and
+fixed set of programs.
+.PP
+A safe interpreter is created by specifying the \fB\-safe\fR switch
+to the \fBinterp create\fR command.  Furthermore, any slave created
+by a safe interpreter will also be safe.
+.PP
+A safe interpreter is created with exactly the following set of
+built-in commands:
+.DS
+.ta 1.2i 2.4i 3.6i
+\fBafter	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	rename
+return	scan	seek	set
+split	string	subst	switch
+tell	trace	unset	update
+uplevel	upvar	vwait	while\fR
+.DE
+.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
+\fBenv\fR variable poses a security risk, because users can store
+sensitive information in an environment variable. For example, the PGP
+manual recommends storing the PGP private key protection password in
+the environment variable \fIPGPPASS\fR. Making this variable available
+to untrusted code executing in a safe interpreter would incur a
+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
+\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 targetted 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.
+.PP
+Currently, the names of hidden commands cannot contain namespace
+qualifiers, and you must first rename a command in a namespace to the
+global namespace before you can hide it.
+Commands to be hidden by \fBinterp hide\fR are looked up in the global
+namespace even if the current namespace is not the global one. This
+prevents slaves from fooling a master interpreter into hiding the wrong
+command, by making the current namespace be different from the global one.
+.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), safe(n), Tcl_CreateSlave(3)
+
+.SH KEYWORDS
+alias, master interpreter, safe interpreter, slave interpreter
diff --git a/tcl/doc/join.n b/tcl/doc/join.n
new file mode 100644
index 00000000000..f5be56b66cf
--- /dev/null
+++ b/tcl/doc/join.n
@@ -0,0 +1,29 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH join n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+join \- Create a string by joining together list elements
+.SH SYNOPSIS
+\fBjoin \fIlist \fR?\fIjoinString\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fIlist\fR argument must be a valid Tcl list.
+This command returns the string
+formed by joining all of the elements of \fIlist\fR together with
+\fIjoinString\fR separating each adjacent pair of elements.
+The \fIjoinString\fR argument defaults to a space character.
+
+.SH KEYWORDS
+element, join, list, separator
diff --git a/tcl/doc/lappend.n b/tcl/doc/lappend.n
new file mode 100644
index 00000000000..1351dedc40a
--- /dev/null
+++ b/tcl/doc/lappend.n
@@ -0,0 +1,35 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH lappend n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lappend \- Append list elements onto a variable
+.SH SYNOPSIS
+\fBlappend \fIvarName \fR?\fIvalue value value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command treats the variable given by \fIvarName\fR as a list
+and appends each of the \fIvalue\fR arguments to that list as a separate
+element, with spaces between elements.
+If \fIvarName\fR doesn't exist, it is created as a list with elements
+given by the \fIvalue\fR arguments.
+\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
+are appended as list elements rather than raw text.
+This command provides a relatively efficient way to build up
+large lists.  For example, ``\fBlappend a $b\fR'' is much
+more efficient than ``\fBset a [concat $a [list $b]]\fR'' when
+\fB$a\fR is long.
+
+.SH KEYWORDS
+append, element, list, variable
diff --git a/tcl/doc/library.n b/tcl/doc/library.n
new file mode 100644
index 00000000000..5b9c59d7ef5
--- /dev/null
+++ b/tcl/doc/library.n
@@ -0,0 +1,286 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH library n "8.0" Tcl "Tcl Built-In Commands"
+.BS
+.SH NAME
+library \- standard library of Tcl procedures
+.SH SYNOPSIS
+.nf
+\fBauto_execok \fIcmd\fR
+\fBauto_load \fIcmd\fR
+\fBauto_mkindex \fIdir pattern pattern ...\fR
+\fBauto_mkindex_old \fIdir pattern pattern ...\fR
+\fBauto_reset\fR
+\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\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
+.PP
+Tcl includes a library of Tcl procedures for commonly-needed functions.
+The procedures defined in the Tcl library are generic ones suitable
+for use by many different applications.
+The location of the Tcl library is returned by the \fBinfo library\fR
+command.
+In addition to the Tcl library, each application will normally have
+its own library of support procedures as well;  the location of this
+library is normally given by the value of the \fB$\fIapp\fB_library\fR
+global variable, where \fIapp\fR is the name of the application.
+For example, the location of the Tk library is kept in the variable
+\fB$tk_library\fR.
+.PP
+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 [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.
+The code in \fBinit.tcl\fR will define the \fBunknown\fR procedure
+and arrange for the other procedures to be loaded on-demand using
+the auto-load mechanism defined below.
+
+.SH "COMMAND PROCEDURES"
+.PP
+The following procedures are provided in the Tcl library:
+.TP
+\fBauto_execok \fIcmd\fR
+Determines whether there is an executable file by the name \fIcmd\fR.
+This command examines the directories in the current search path
+(given by the PATH environment variable) to see if there is an
+executable file named \fIcmd\fR in any of those directories.
+If so, it returns 1;  if not it returns 0.  \fBAuto_exec\fR
+remembers information about previous searches in an array
+named \fBauto_execs\fR;  this avoids the path search in
+future calls for the same \fIcmd\fR.  The command \fBauto_reset\fR
+may be used to force \fBauto_execok\fR to forget its cached
+information.
+.TP
+\fBauto_load \fIcmd\fR
+This command attempts to load the definition for a Tcl command named
+\fIcmd\fR.
+To do this, it searches an \fIauto-load path\fR, which is a list of
+one or more directories.
+The auto-load path is given by the global variable \fB$auto_path\fR
+if it exists.
+If there is no \fB$auto_path\fR variable, then the TCLLIBPATH environment
+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
+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.
+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
+or if the script didn't actually define \fIcmd\fR (e.g. because
+index information is out of date).
+If an error occurs while processing the script, then that error
+is returned.
+\fBAuto_load\fR only reads the index information once and saves it
+in the array \fBauto_index\fR;  future calls to \fBauto_load\fR
+check for \fIcmd\fR in the array rather than re-reading the index
+files.
+The cached index information may be deleted with the command
+\fBauto_reset\fR.
+This will force the next \fBauto_load\fR command to reload the
+index database from disk.
+.TP
+\fBauto_mkindex \fIdir pattern pattern ...\fR
+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
+(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
+index information in a file named \fBtclIndex\fR in \fIdir\fR.
+If no pattern is given a pattern of \fB*.tcl\fR will be assumed.  
+For example, the command
+.RS
+.CS
+\fBauto_mkindex foo *.tcl\fR
+.CE
+.LP
+will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR
+and generate a new index file \fBfoo/tclIndex\fR.
+.PP
+\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them
+into a slave interpreter and monitoring the proc and
+namespace commands that are executed.
+Extensions can use the (undocumented)
+auto_mkindex_parser package to register other commands that
+can contribute to the auto_load index.
+You will have to read through init.tcl to see how this works.
+.PP
+\fBAuto_mkindex_old\fR parses the Tcl scripts in a relatively
+unsophisticated way:  if any line contains the word \fBproc\fR
+as its first characters then it is assumed to be a procedure
+definition and the next word of the line is taken as the
+procedure's name.
+Procedure definitions that don't appear in this way (e.g. they
+have spaces before the \fBproc\fR) will not be indexed.
+.RE
+.TP
+\fBauto_reset\fR
+Destroys all the information cached by \fBauto_execok\fR and
+\fBauto_load\fR.
+This information will be re-read from disk the next time it is
+needed.
+\fBAuto_reset\fR also deletes any procedures listed in the auto-load
+index, so that fresh copies of them will be loaded the next time
+that they're used.
+.TP
+\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
+This is a standard search procedure for use by extensions during
+their initialization.  They call this procedure to look for their
+script library in several standard directories.
+The last component of the name of the library directory is 
+normally \fIbasenameversion\fP
+(e.g., tk8.0), but it might be "library" when in the build hierarchies.
+The \fIinitScript\fR file will be sourced into the interpreter
+once it is found.  The directory in which this file is found is
+stored into the global variable \fIvarName\fP.
+If this variable is already defined (e.g., by C code during
+application initialization) then no searching is done.
+Otherwise the search looks in these directories:
+the directory named by the environment variable \fIenVarName\fP;
+relative to the Tcl library directory;
+relative to the executable file in the standard installation
+bin or bin/\fIarch\fP directory;
+relative to the executable file in the current build tree;
+relative to the executable file in a parallel build tree.
+.TP
+\fBparray \fIarrayName\fR
+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
+The following global variables are defined or used by the procedures in
+the Tcl library:
+.TP
+\fBauto_execs\fR
+Used by \fBauto_execok\fR to record information about whether
+particular commands exist as executable files.
+.TP
+\fBauto_index\fR
+Used by \fBauto_load\fR to save the index information read from
+disk.
+.TP
+\fBauto_noexec\fR
+If set to any value, then \fBunknown\fR will not attempt to auto-exec
+any commands.
+.TP
+\fBauto_noload\fR
+If set to any value, then \fBunknown\fR will not attempt to auto-load
+any commands.
+.TP
+\fBauto_path\fR
+If set, then it must contain a valid Tcl list giving directories to
+search during auto-load operations.
+This variable is initialized during startup to contain, in order:
+the directories listed in the TCLLIBPATH environment variable,
+the directory named by the $tcl_library variable,
+the parent directory of $tcl_library,
+the directories listed in the $tcl_pkgPath variable.
+.TP
+\fBenv(TCL_LIBRARY)\fR
+If set, then it specifies the location of the directory containing
+library scripts (the value of this variable will be
+assigned to the \fBtcl_library\fR variable and therefore returned by
+the command \fBinfo library\fR).  If this variable isn't set then
+a default value is used.
+.TP
+\fBenv(TCLLIBPATH)\fR
+If set, then it must contain a valid Tcl list giving directories to
+search during auto-load operations.
+This variable is only used when
+initializing the \fBauto_path\fR variable.
+.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
+infinitely.
+The variable is unset before \fBunknown\fR returns.
+
+.SH KEYWORDS
+auto-exec, auto-load, library, unknown, word, whitespace 
diff --git a/tcl/doc/license.terms b/tcl/doc/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/doc/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/doc/lindex.n b/tcl/doc/lindex.n
new file mode 100644
index 00000000000..0771b53dfad
--- /dev/null
+++ b/tcl/doc/lindex.n
@@ -0,0 +1,35 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH lindex n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lindex \- Retrieve an element from a list
+.SH SYNOPSIS
+\fBlindex \fIlist index\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command treats \fIlist\fR as a Tcl list and returns the
+\fIindex\fR'th element from it (0 refers to the first element of the list).
+In extracting the element, \fIlindex\fR observes the same rules
+concerning braces and quotes and backslashes as the Tcl command
+interpreter; however, variable
+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.
+If \fIindex\fR has the value \fBend\fR, it refers to the last element
+in the list.
+
+.SH KEYWORDS
+element, index, list
diff --git a/tcl/doc/linsert.n b/tcl/doc/linsert.n
new file mode 100644
index 00000000000..a325e4e3f2f
--- /dev/null
+++ b/tcl/doc/linsert.n
@@ -0,0 +1,33 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH linsert n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+linsert \- Insert elements into a list
+.SH SYNOPSIS
+\fBlinsert \fIlist index element \fR?\fIelement element ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command produces a new list from \fIlist\fR by inserting all
+of the \fIelement\fR arguments just before the \fIindex\fRth
+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
+has the value \fBend\fR,
+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.
+
+.SH KEYWORDS
+element, insert, list
diff --git a/tcl/doc/list.n b/tcl/doc/list.n
new file mode 100644
index 00000000000..92a25cc640e
--- /dev/null
+++ b/tcl/doc/list.n
@@ -0,0 +1,45 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH list n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+list \- Create a list
+.SH SYNOPSIS
+\fBlist \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command returns a list comprised of all the \fIarg\fRs,
+or an empty string if no \fIarg\fRs are specified.
+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
+\fIarg1\fR comprising the command's name and the other \fIarg\fRs comprising
+its arguments.  \fBList\fR produces slightly different results than
+\fBconcat\fR:  \fBconcat\fR removes one level of grouping before forming
+the list, while \fBlist\fR works directly from the original arguments.
+For example, the command
+.CS
+\fBlist a b {c d e} {f {g h}}\fR
+.CE
+will return
+.CS
+\fBa b {c d e} {f {g h}}\fR
+.CE
+while \fBconcat\fR with the same arguments will return
+.CS
+\fBa b c d e f {g h}\fR
+.CE
+
+.SH KEYWORDS
+element, list
diff --git a/tcl/doc/llength.n b/tcl/doc/llength.n
new file mode 100644
index 00000000000..e581d1036e6
--- /dev/null
+++ b/tcl/doc/llength.n
@@ -0,0 +1,26 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH llength n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+llength \- Count the number of elements in a list
+.SH SYNOPSIS
+\fBllength \fIlist\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Treats \fIlist\fR as a list and returns a decimal string giving
+the number of elements in it.
+
+.SH KEYWORDS
+element, list, length
diff --git a/tcl/doc/load.n b/tcl/doc/load.n
new file mode 100644
index 00000000000..52538c9b06b
--- /dev/null
+++ b/tcl/doc/load.n
@@ -0,0 +1,120 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH load n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+load \- Load machine code and initialize new commands.
+.SH SYNOPSIS
+\fBload \fIfileName\fR
+.br
+\fBload \fIfileName packageName\fR
+.br
+\fBload \fIfileName packageName interp\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command loads binary code from a file into the
+application's address space and calls an initialization procedure
+in the package to incorporate it into an interpreter.  \fIfileName\fR
+is the name of the file containing the code;  its exact form varies
+from system to system but on most systems it is a shared library,
+such as a \fB.so\fR file under Solaris or a DLL under Windows.
+\fIpackageName\fR is the name of the package, and is used to
+compute the name of an initialization procedure.
+\fIinterp\fR is the path name of the interpreter into which to load
+the package (see the \fBinterp\fR manual entry for details);
+if \fIinterp\fR is omitted, it defaults to the
+interpreter in which the \fBload\fR command was invoked.
+.PP
+Once the file has been loaded into the application's address space,
+one of two initialization procedures will be invoked in the new code.
+Typically the initialization procedure will add new commands to a
+Tcl interpreter.
+The name of the initialization procedure is determined by
+\fIpackageName\fR and whether or not the target interpreter
+is a safe one.  For normal interpreters the name of the initialization
+procedure will have the form \fIpkg\fB_Init\fR, where \fIpkg\fR
+is the same as \fIpackageName\fR except that the first letter is
+converted to upper case and all other letters
+are converted to lower case.  For example, if \fIpackageName\fR is
+\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
+be \fBFoo_Init\fR.
+.PP
+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
+typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
+.CE
+The \fIinterp\fR argument identifies the interpreter in which the
+package is to be loaded.  The initialization procedure must return
+\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
+successfully;  in the event of an error it should set \fIinterp->result\fR
+to point to an error message.  The result of the \fBload\fR command
+will be the result returned by the initialization procedure.
+.PP
+The actual loading of a file will only be done once for each \fIfileName\fR
+in an application.  If a given \fIfileName\fR is loaded into multiple
+interpreters, then the first \fBload\fR will load the code and
+call the initialization procedure;  subsequent \fBload\fRs will
+call the initialization procedure without loading the code again.
+It is not possible to unload or reload a package.
+.PP
+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.
+.PP
+If \fIpackageName\fR is omitted or specified as an empty string,
+Tcl tries to guess the name of the package.
+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
+.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
+If the same file is \fBload\fRed by different \fIfileName\fRs, it will
+be loaded into the process's address space multiple times.  The
+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, safe(n)
+
+.SH KEYWORDS
+binary code, loading, safe interpreter, shared library
diff --git a/tcl/doc/lrange.n b/tcl/doc/lrange.n
new file mode 100644
index 00000000000..719ca29a359
--- /dev/null
+++ b/tcl/doc/lrange.n
@@ -0,0 +1,39 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH lrange n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lrange \- Return one or more adjacent elements from a list
+.SH SYNOPSIS
+\fBlrange \fIlist first last\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+\fIList\fR must be a valid Tcl list.  This command will
+return a new list consisting of elements
+\fIfirst\fR through \fIlast\fR, inclusive.
+\fIFirst\fR or \fIlast\fR
+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.
+If \fIlast\fR is greater than or equal to the number of elements
+in the list, then it is treated as if it were \fBend\fR.
+If \fIfirst\fR is greater than \fIlast\fR then an empty string
+is returned.
+Note: ``\fBlrange \fIlist first first\fR'' does not always produce the
+same result as ``\fBlindex \fIlist first\fR'' (although it often does
+for simple fields that aren't enclosed in braces); it does, however,
+produce exactly the same results as ``\fBlist [lindex \fIlist first\fB]\fR''
+
+.SH KEYWORDS
+element, list, range, sublist
diff --git a/tcl/doc/lreplace.n b/tcl/doc/lreplace.n
new file mode 100644
index 00000000000..c34ff74d5c0
--- /dev/null
+++ b/tcl/doc/lreplace.n
@@ -0,0 +1,43 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH lreplace n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lreplace \- Replace elements in a list with new elements
+.SH SYNOPSIS
+\fBlreplace \fIlist first last \fR?\fIelement element ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBLreplace\fR returns a new list formed by replacing one or more elements of
+\fIlist\fR with the \fIelement\fR arguments.
+\fIFirst\fR gives the index in \fIlist\fR of the first element
+to be replaced (0 refers to the first element).
+If \fIfirst\fR is less than zero then it refers to the first
+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.
+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
+(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.
+Each \fIelement\fR argument will become a separate element of
+the list.
+If no \fIelement\fR arguments are specified, then the elements
+between \fIfirst\fR and \fIlast\fR are simply deleted.
+
+.SH KEYWORDS
+element, list, replace
diff --git a/tcl/doc/lsearch.n b/tcl/doc/lsearch.n
new file mode 100644
index 00000000000..c0646dde878
--- /dev/null
+++ b/tcl/doc/lsearch.n
@@ -0,0 +1,45 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH lsearch n 7.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lsearch \- See if a list contains a particular element
+.SH SYNOPSIS
+\fBlsearch \fR?\fImode\fR? \fIlist pattern\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command searches the elements of \fIlist\fR to see if one
+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.
+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:
+.TP
+\fB\-exact\fR
+The list element must contain exactly the same string as \fIpattern\fR.
+.TP
+\fB\-glob\fR
+\fIPattern\fR is a glob-style pattern which is matched against each list
+element using the same rules as the \fBstring match\fR command.
+.TP
+\fB\-regexp\fR
+\fIPattern\fR is treated as a regular expression and matched against
+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.
+
+.SH KEYWORDS
+list, match, pattern, regular expression, search, string
diff --git a/tcl/doc/lsort.n b/tcl/doc/lsort.n
new file mode 100644
index 00000000000..bd3ed1e1a46
--- /dev/null
+++ b/tcl/doc/lsort.n
@@ -0,0 +1,85 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.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?\fIoptions\fR? \fIlist\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+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.
+However, any of the
+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 8.0 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.
+.TP 20
+\fB\-real\fR
+Convert list elements to floating-point values and use floating
+comparison.
+.TP 20
+\fB\-command\0\fIcommand\fR
+Use \fIcommand\fR as a comparison command.
+To compare two elements, evaluate a Tcl script consisting of
+\fIcommand\fR with the two elements appended as additional
+arguments.  The script should return an integer less than,
+equal to, or greater than zero if the first element is to
+be considered less than, equal to, or greater than the second,
+respectively.
+.TP 20
+\fB\-increasing\fR
+Sort the list in increasing order (``smallest'' items first).
+This is the default.
+.TP 20
+\fB\-decreasing\fR
+Sort the list in decreasing order (``largest'' items first).
+.VS 8.0 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/tcl/doc/man.macros b/tcl/doc/man.macros
new file mode 100644
index 00000000000..6f3016f492f
--- /dev/null
+++ b/tcl/doc/man.macros
@@ -0,0 +1,236 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .AP type name in/out ?indent?
+'\"	Start paragraph describing an argument to a library procedure.
+'\"	type is type of argument (int, etc.), in/out is either "in", "out",
+'\"	or "in/out" to describe whether procedure reads or modifies arg,
+'\"	and indent is equivalent to second arg of .IP (shouldn't ever be
+'\"	needed;  use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\"	Give maximum sizes of arguments for setting tab stops.  Type and
+'\"	name are examples of largest possible arguments that will be passed
+'\"	to .AP later.  If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\"	Start box enclosure.  From here until next .BE, everything will be
+'\"	enclosed in one large box.
+'\"
+'\" .BE
+'\"	End of box enclosure.
+'\"
+'\" .CS
+'\"	Begin code excerpt.
+'\"
+'\" .CE
+'\"	End code excerpt.
+'\"
+'\" .VS ?version? ?br?
+'\"	Begin vertical sidebar, for use in marking newly-changed parts
+'\"	of man pages.  The first argument is ignored and used for recording
+'\"	the version when the .VS was added, so that the sidebars can be
+'\"	found and removed when they reach a certain age.  If another argument
+'\"	is present, then a line break is forced before starting the sidebar.
+'\"
+'\" .VE
+'\"	End of vertical sidebar.
+'\"
+'\" .DS
+'\"	Begin an indented unfilled display.
+'\"
+'\" .DE
+'\"	End of indented unfilled display.
+'\"
+'\" .SO
+'\"	Start of list of standard options for a Tk widget.  The
+'\"	options follow on successive lines, in four columns separated
+'\"	by tabs.
+'\"
+'\" .SE
+'\"	End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\"	Start of description of a specific option.  cmdName gives the
+'\"	option's name as specified in the class command, dbName gives
+'\"	the option's name in the option database, and dbClass gives
+'\"	the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\"	Print arg1 underlined, then print arg2 normally.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\"	# Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+.   ie !"\\$2"" .TP \\n()Cu
+.   el          .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1	\\fI\\$2\\fP	(\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1	\\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\"	# define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\"	# BS - start boxed text
+'\"	# ^y = starting y location
+'\"	# ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\"	# BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\"	Draw four-sided box normally, but don't draw top of
+.\"	box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\"	# VS - start vertical sidebar
+'\"	# ^Y = starting y location
+'\"	# ^v = 1 (for troff;  for nroff this doesn't matter)
+.de VS
+.if !"\\$2"" .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\"	# VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\"	# Special macro to handle page bottom:  finish off current
+'\"	# box/sidebar if in box/sidebar mode, then invoked standard
+'\"	# page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\"	Draw three-sided box if this is the box's first page,
+.\"	draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\"	# DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\"	# DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\"	# SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\"	# SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\"	# OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name:	\\fB\\$1\\fR
+Database Name:	\\fB\\$2\\fR
+Database Class:	\\fB\\$3\\fR
+.fi
+.IP
+..
+'\"	# CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\"	# CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
diff --git a/tcl/doc/namespace.n b/tcl/doc/namespace.n
new file mode 100644
index 00000000000..6451a3b50df
--- /dev/null
+++ b/tcl/doc/namespace.n
@@ -0,0 +1,563 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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 \fR?\fIoption\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 \fIoption\fR's are listed below.
+Note that you can abbreviate the \fIoption\fR's.
+.TP
+\fBnamespace children \fR?\fInamespace\fR? ?\fIpattern\fR?
+Returns a list of all child namespaces that belong to the
+namespace \fInamespace\fR.
+If \fInamespace\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 \fInamespace\fR
+(or the fully-qualified name of the current namespace)
+is prepended onto the the pattern.
+.TP
+\fBnamespace code \fIscript\fR
+Captures the current namespace context for later execution
+of the script \fIscript\fR.
+It returns a new script in which \fIscript\fR has been wrapped
+in a \fBnamespace code\fR command.
+The new script has two important properties.
+First, it can be evaluated in any namespace and will cause
+\fIscript\fR to be evaluated in the current namespace
+(the one where the \fBnamespace code\fR command was invoked).
+Second, additional arguments can be appended to the resulting script
+and they will be passed to \fIscript\fR as additional arguments.
+For example, suppose the command
+\fBset script [namespace code {foo bar}]\fR
+is invoked in namespace \fB::a::b\fR.
+Then \fBeval "$script x y"\fR
+can be executed in any namespace (assuming the value of
+\fBscript\fR has been passed in properly)
+and will have the same effect as the command
+\fBnamespace eval ::a::b {foo bar x y}\fR.
+This command is needed because
+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.
+.TP
+\fBnamespace delete \fR?\fInamespace namespace ...\fR?
+Each namespace \fInamespace\fR is deleted
+and all variables, procedures, and child namespaces
+contained in the namespace are deleted.
+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 \fInamespace arg\fR ?\fIarg ...\fR?
+Activates a namespace called \fInamespace\fR and evaluates some code
+in that context.
+If the namespace does not already exist, it is created.
+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 \fBeval\fR command,
+and the result is evaluated.
+.br
+.sp
+If \fInamespace\fR has leading namespace qualifiers
+and any leading namespaces do not exist,
+they are automatically created.
+.TP
+\fBnamespace export \fR?\-\fBclear\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 \-\fBclear\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 \-\fBclear\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 qualified name such as
+\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 commands. 
+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 currently 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 \-\fBforce\fR option is given,
+imported commands will silently replace existing commands.
+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
+at the time when the \fBnamespace import\fR command is executed.
+If another command is defined and exported in this namespace later on,
+it will not be imported.
+.TP
+\fBnamespace inscope\fR \fInamespace 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 \fIcommand\fR
+Returns the fully-qualified name of the original command
+to which the imported command \fIcommand\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 \fIcommand\fR does not refer to an imported command,
+the command's own fully-qualified name is returned.
+.TP
+\fBnamespace parent\fR ?\fInamespace\fR?
+Returns the fully-qualified name of the parent namespace
+for namespace \fInamespace\fR.
+If \fInamespace\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 ?\-\fBcommand\fR? ?\-\fBvariable\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 be different from 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.
+
+.SH "QUALIFIED NAMES"
+.PP
+Each namespace has a textual name such as
+\fBhistory\fR or \fB::safe::interp\fR.
+Since namespaces may nest,
+qualified names are used to refer to
+commands, variables, and child namespaces contained inside namespaces.
+Qualified names are similar to the hierarchical path names for
+Unix files or Tk widgets,
+except that \fB::\fR is used as the separator
+instead of \fB/\fR or \fB.\fR.
+The topmost or global namespace has the name ``'' (i.e., an empty string),
+although \fB::\fR is a synonym.
+As an example, the name \fB::safe::interp::create\fR
+refers to the command \fBcreate\fR in the namespace \fBinterp\fR
+that is a child of of namespace \fB::safe\fR,
+which in turn is a child of the global namespace \fB::\fR.
+.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.
+From the global namespace,
+we might access the \fBCounter\fR procedures like this:
+.CS
+\fBCounter::Bump 5
+Counter::Reset\fR
+.CE
+We could access the current count like this:
+.CS
+\fBputs "count = $Counter::num"\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
+.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.
+Namespaces have nonempty names except for the global namespace.
+\fB::\fR is disallowed in simple command, variable, and namespace 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
+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
+from 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 exported 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
+The \fBnamespace import\fR command only imports commands
+from a namespace that that namespace exported
+with a \fBnamespace export\fR command.
+.PP
+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
+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 "SEE ALSO"
+variable(n)
+
+.SH KEYWORDS
+exported, internal, variable
diff --git a/tcl/doc/open.n b/tcl/doc/open.n
new file mode 100644
index 00000000000..39121b6c3e1
--- /dev/null
+++ b/tcl/doc/open.n
@@ -0,0 +1,249 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH open n 7.6 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+open \- Open a file-based or command pipeline channel
+.SH SYNOPSIS
+.sp
+\fBopen \fIfileName\fR
+.br
+\fBopen \fIfileName access\fR
+.br
+\fBopen \fIfileName access permissions\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+.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:
+\fIfileName\fR gives the name of the file to open, and it must conform to the
+conventions described in the \fBfilename\fR manual entry.
+.PP
+The \fIaccess\fR argument, if present, indicates the way in which the file
+(or command pipeline) is to be accessed.
+In the first form \fIaccess\fR may have any of the following values:
+.TP 15
+\fBr\fR
+Open the file for reading only; the file must already exist. This is the
+default value if \fIaccess\fR is not specified.
+.TP 15
+\fBr+\fR
+Open the file for both reading and writing; the file must
+already exist.
+.TP 15
+\fBw\fR
+Open the file for writing only.  Truncate it if it exists.  If it doesn't
+exist, create a new file.
+.TP 15
+\fBw+\fR
+Open the file for reading and writing.  Truncate it if it exists.
+If it doesn't exist, create a new file.
+.TP 15
+\fBa\fR
+Open the file for writing only.  The file must already exist, and the file
+is positioned so that new data is appended to the file.
+.TP 15
+\fBa+\fR
+Open the file for reading and writing.  If the file doesn't exist,
+create a new empty file.
+Set the initial access position  to the end of the file.
+.PP
+In the second form, \fIaccess\fR consists of a list of any of the
+following flags, all of which have the standard POSIX meanings.
+One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR.
+.TP 15
+\fBRDONLY\fR
+Open the file for reading only.
+.TP 15
+\fBWRONLY\fR
+Open the file for writing only.
+.TP 15
+\fBRDWR\fR
+Open the file for both reading and writing.
+.TP 15
+\fBAPPEND\fR
+Set the file pointer to the end of the file prior to each write.
+.TP 15
+\fBCREAT\fR
+Create the file if it doesn't already exist (without this flag it
+is an error for the file not to exist).
+.TP 15
+\fBEXCL\fR
+If \fBCREAT\fR is also specified, an error is returned if the
+file already exists.
+.TP 15
+\fBNOCTTY\fR
+If the file is a terminal device, this flag prevents the file from
+becoming the controlling terminal of the process.
+.TP 15
+\fBNONBLOCK\fR
+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
+(it is better to use the \fBfconfigure\fR command to put a file
+in nonblocking mode).
+For details refer to your system documentation on the \fBopen\fR system
+call's \fBO_NONBLOCK\fR flag.
+.TP 15
+\fBTRUNC\fR
+If the file exists it is truncated to zero length.
+.PP
+If a new file is created as part of opening it, \fIpermissions\fR
+(an integer) is used to set the permissions for the new file in
+conjunction with the process's file mode creation mask.
+\fIPermissions\fR defaults to 0666.
+.SH "COMMAND PIPELINES"
+.PP
+If the first character of \fIfileName\fR is ``|'' then the
+remaining characters of \fIfileName\fR are treated as a list of arguments
+that describe a command pipeline to invoke, in the same style as the
+arguments for \fBexec\fR.
+In this case, the channel identifier returned by \fBopen\fR may be used
+to write to the command's input pipe or read from its output pipe,
+depending on the value of \fIaccess\fR.
+If write-only access is used (e.g. \fIaccess\fR is \fBw\fR), then
+standard output for the pipeline is directed to the current standard
+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 "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, serial
diff --git a/tcl/doc/package.n b/tcl/doc/package.n
new file mode 100644
index 00000000000..9a7b4983c2f
--- /dev/null
+++ b/tcl/doc/package.n
@@ -0,0 +1,188 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH package n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+package \- Facilities for package loading and version control
+.SH SYNOPSIS
+.nf
+\fBpackage forget \fIpackage\fR
+\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
+\fBpackage names\fR
+\fBpackage provide \fIpackage \fR?\fIversion\fR?
+\fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+\fBpackage unknown \fR?\fIcommand\fR?
+\fBpackage vcompare \fIversion1 version2\fR
+\fBpackage versions \fIpackage\fR
+\fBpackage vsatisfies \fIversion1 version2\fR
+.fi
+.BE
+
+.SH DESCRIPTION
+.PP
+This command keeps a simple database of the packages available for
+use by the current interpreter and how to load them into the
+interpreter.
+It supports multiple versions of each package and arranges
+for the correct version of a package to be loaded based on what
+is needed by the application.
+This command also detects and reports version clashes.
+Typically, only the \fBpackage require\fR and \fBpackage provide\fR
+commands are invoked in normal Tcl scripts;  the other commands are used
+primarily by system scripts that maintain the package database.
+.PP
+The behavior of the \fBpackage\fR command is determined by its first argument.
+The following forms are permitted:
+.TP
+\fBpackage forget \fIpackage\fR
+Removes all information about \fIpackage\fR from this interpreter,
+including information provided by both \fBpackage ifneeded\fR and
+\fBpackage provide\fR.
+.TP
+\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
+This command typically appears only in system configuration
+scripts to set up the package database.
+It indicates that a particular version of
+a particular package is available if needed, and that the package
+can be added to the interpreter by executing \fIscript\fR.
+The script is saved in a database for use by subsequent
+\fBpackage require\fR commands;  typically, \fIscript\fR
+sets up auto-loading for the commands in the package (or calls
+\fBload\fR and/or \fBsource\fR directly), then invokes
+\fBpackage provide\fR to indicate that the package is present.
+There may be information in the database for several different
+versions of a single package.
+If the database already contains information for \fIpackage\fR
+and \fIversion\fR, the new \fIscript\fR replaces the existing
+one.
+If the \fIscript\fR argument is omitted, the current script for
+version \fIversion\fR of package \fIpackage\fR is returned,
+or an empty string if no \fBpackage ifneeded\fR command has
+been invoked for this \fIpackage\fR and \fIversion\fR.
+.TP
+\fBpackage names\fR
+Returns a list of the names of all packages in the
+interpreter for which a version has been provided (via
+\fBpackage provide\fR) or for which a \fBpackage ifneeded\fR
+script is available.
+The order of elements in the list is arbitrary.
+.TP
+\fBpackage provide \fIpackage \fR?\fIversion\fR?
+This command is invoked to indicate that version \fIversion\fR
+of package \fIpackage\fR is now present in the interpreter.
+It is typically invoked once as part of an \fBifneeded\fR script,
+and again by the package itself when it is finally loaded.
+An error occurs if a different version of \fIpackage\fR has been
+provided by a previous \fBpackage provide\fR command.
+If the \fIversion\fR argument is omitted, then the command
+returns the version number that is currently provided, or an
+empty string if no \fBpackage provide\fR command has been
+invoked for \fIpackage\fR in this interpreter.
+.TP
+\fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+This command is typically invoked by Tcl code that wishes to use
+a particular version of a particular package.  The arguments
+indicate which package is wanted, and the command ensures that
+a suitable version of the package is loaded into the interpreter.
+If the command succeeds, it returns the version number that is
+loaded;  otherwise it generates an error.
+If both the \fB\-exact\fR
+switch and the \fIversion\fR argument are specified then only the
+given version is acceptable.  If \fB\-exact\fR is omitted but
+\fIversion\fR is specified, then versions later than \fIversion\fR
+are also acceptable as long as they have the same major version
+number as \fIversion\fR.
+If both \fB\-exact\fR and \fIversion\fR are omitted then any
+version whatsoever is acceptable.
+If a version of \fIpackage\fR has already been provided (by invoking
+the \fBpackage provide\fR command), then its version number must
+satisfy the criteria given by \fB\-exact\fR and \fIversion\fR and
+the command returns immediately.
+Otherwise, the command searches the database of information provided by
+previous \fBpackage ifneeded\fR commands to see if an acceptable
+version of the package is available.
+If so, the script for the highest acceptable version number is invoked;
+it must do whatever is necessary to load the package,
+including calling \fBpackage provide\fR for the package.
+If the \fBpackage ifneeded\fR database does not contain an acceptable
+version of the package and a \fBpackage unknown\fR command has been
+specified for the interpreter then that command is invoked;  when
+it completes, Tcl checks again to see if the package is now provided
+or if there is a \fBpackage ifneeded\fR script for it.
+If all of these steps fail to provide an acceptable version of the
+package, then the command returns an error.
+.TP
+\fBpackage unknown \fR?\fIcommand\fR?
+This command supplies a ``last resort'' command to invoke during
+\fBpackage require\fR if no suitable version of a package can be found
+in the \fBpackage ifneeded\fR database.
+If the \fIcommand\fR argument is supplied, it contains the first part
+of a command;  when the command is invoked during a \fBpackage require\fR
+command, Tcl appends two additional arguments giving the desired package
+name and version.
+For example, if \fIcommand\fR is \fBfoo bar\fR and later the command
+\fBpackage require test 2.4\fR is invoked, then Tcl will execute
+the command \fBfoo bar test 2.4\fR to load the package.
+If no version number is supplied to the \fBpackage require\fR command,
+then the version argument for the invoked command will be an empty string.
+If the \fBpackage unknown\fR command is invoked without a \fIcommand\fR
+argument, then the current \fBpackage unknown\fR script is returned,
+or an empty string if there is none.
+If \fIcommand\fR is specified as an empty string, then the current
+\fBpackage unknown\fR script is removed, if there is one.
+.TP
+\fBpackage vcompare \fIversion1 version2\fR
+Compares the two version numbers given by \fIversion1\fR and \fIversion2\fR.
+Returns -1 if \fIversion1\fR is an earlier version than \fIversion2\fR,
+0 if they are equal, and 1 if \fIversion1\fR is later than \fBversion2\fR.
+.TP
+\fBpackage versions \fIpackage\fR
+Returns a list of all the version numbers of \fIpackage\fR
+for which information has been provided by \fBpackage ifneeded\fR
+commands.
+.TP
+\fBpackage vsatisfies \fIversion1 version2\fR
+Returns 1 if scripts written for \fIversion2\fR will work unchanged
+with \fIversion1\fR (i.e. \fIversion1\fR is equal to or greater
+than \fIversion2\fR and they both have the same major version
+number), 0 otherwise.
+
+.SH "VERSION NUMBERS"
+.PP
+Version numbers consist of one or more decimal numbers separated
+by dots, such as 2 or 1.162 or 3.1.13.1.
+The first number is called the major version number.
+Larger numbers correspond to later versions of a package, with
+leftmost numbers having greater significance.
+For example, version 2.1 is later than 1.3 and version
+3.4.6 is later than 3.3.5.
+Missing fields are equivalent to zeroes:  version 1.3 is the
+same as version 1.3.0 and 1.3.0.0, so it is earlier than 1.3.1 or 1.3.0.2.
+A later version number is assumed to be upwards compatible with
+an earlier version number as long as both versions have the same
+major version number.
+For example, Tcl scripts written for version 2.3 of a package should
+work unchanged under versions 2.3.2, 2.4, and 2.5.1.
+Changes in the major version number signify incompatible changes:
+if code is written to use version 2.1 of a package, it is not guaranteed
+to work unmodified with either version 1.7.3 or version 3.1.
+
+.SH "PACKAGE INDICES"
+.PP
+The recommended way to use packages in Tcl is to invoke \fBpackage require\fR
+and \fBpackage provide\fR commands in scripts, and use the procedure
+\fBpkg_mkIndex\fR to create package index files.
+Once you've done this, packages will be loaded automatically
+in response to \fBpackage require\fR commands.
+See the documentation for \fBpkg_mkIndex\fR for details.
+
+.SH KEYWORDS
+package, version
diff --git a/tcl/doc/pid.n b/tcl/doc/pid.n
new file mode 100644
index 00000000000..912e85c2e5c
--- /dev/null
+++ b/tcl/doc/pid.n
@@ -0,0 +1,34 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH pid n 7.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+pid \- Retrieve process id(s)
+.SH SYNOPSIS
+\fBpid \fR?\fIfileId\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+If the \fIfileId\fR argument is given then it should normally
+refer to a process pipeline created with the \fBopen\fR command.
+In this case the \fBpid\fR command will return a list whose elements
+are the process identifiers of all the processes in the pipeline,
+in order.
+The list will be empty if \fIfileId\fR refers to an open file
+that isn't a process pipeline.
+If no \fIfileId\fR argument is given then \fBpid\fR returns the process
+identifier of the current process.
+All process identifiers are returned as decimal strings.
+
+.SH KEYWORDS
+file, pipeline, process identifier
diff --git a/tcl/doc/pkgMkIndex.n b/tcl/doc/pkgMkIndex.n
new file mode 100644
index 00000000000..71683e48f4c
--- /dev/null
+++ b/tcl/doc/pkgMkIndex.n
@@ -0,0 +1,239 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH pkg_mkIndex n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+pkg_mkIndex \- Build an index for automatic loading of packages
+.SH SYNOPSIS
+.nf
+.VS 8.0.3
+\fBpkg_mkIndex ?\fI-direct\fR? ?\fI-load pkgPat\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+.VE
+.fi
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBPkg_mkIndex\fR is a utility procedure that is part of the standard
+Tcl library.
+It is used to create index files that allow packages to be loaded
+automatically when \fBpackage require\fR commands are executed.
+To use \fBpkg_mkIndex\fR, follow these steps:
+.IP [1]
+Create the package(s).
+Each package may consist of one or more Tcl script files or binary files.
+Binary files must be suitable for loading with the \fBload\fR command
+with a single argument;  for example, if the file is \fBtest.so\fR it must
+be possible to load this file with the command \fBload test.so\fR.
+Each script file must contain a \fBpackage provide\fR command to declare
+the package and version number, and each binary file must contain
+a call to \fBTcl_PkgProvide\fR.
+.IP [2]
+Create the index by invoking \fBpkg_mkIndex\fR.
+The \fIdir\fR argument gives the name of a directory and each
+\fIpattern\fR argument is a \fBglob\fR-style pattern that selects
+script or binary files in \fIdir\fR.
+.VS 8.0.3
+The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
+The optional switches are:
+.TP 15
+\fB\-direct\fR
+The generated index
+will manage to load the package immediately upon \fBpackage require\fR
+instead of delaying loading until actual use of one of the commands.
+.TP 15
+\fB\-load \fIpkgPat\fR
+The index process will pre-load any packages that exist in the
+current interpreter and match \fIpkgPat\fP into the slave interpreter used to
+generate the index.  The pattern match uses string match rules.
+See COMPLEX CASES below.
+.TP 15
+\fB\-verbose\fR
+Generate output during the indexing process.  Output is via
+the \fBtclLog\fP procedure, which by default prints to stderr.
+.TP 15
+\fB\-\-\fR
+End of the flags, in case \fIdir\fP begins with a dash.
+.VE
+.LP
+.RS
+\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
+with package information about all the files given by the \fIpattern\fR
+arguments.
+It does this by loading each file into a slave
+interpreter 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).
+If you have a package split among scripts and binary files, 
+or if you have dependencies among files,
+you may have to use the \fB-load\fP option
+or adjust the order in which \fBpkg_mkIndex\fR processes
+the files.  See COMPLEX CASES below.
+.RE
+.IP [3]
+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.
+.IP
+If you install the package anywhere else, then you must ensure that
+the directory containing 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; by default it
+includes \fB$tcl_pkgPath\fR.
+The package loader also checks all of the subdirectories of the
+directories in \fBauto_path\fR.
+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.
+.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 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
+in \fBauto_path\fR, but only one will actually be loaded in a given
+interpreter, based on the first call to \fBpackage require\fR.
+Different versions of a package may be loaded in different
+interpreters.
+
+.SH "PACKAGES AND THE AUTO-LOADER"
+.PP
+The package management facilities overlap somewhat with the auto-loader,
+in that both arrange for files to be loaded on-demand.
+However, package management is a higher-level mechanism that uses
+the auto-loader for the last step in the loading process.
+It is generally better to index a package with \fBpkg_mkIndex\fR
+rather than \fBauto_mkindex\fR because the package mechanism provides
+version control:  several versions of a package can be made available
+in the index files, with different applications using different
+versions based on \fBpackage require\fR commands.
+In contrast, \fBauto_mkindex\fR does not understand versions so
+it can only handle a single version of each package. 
+It is probably not a good idea to index a given package with both
+\fBpkg_mkIndex\fR and \fBauto_mkindex\fR.
+If you use \fBpkg_mkIndex\fR to index a package, its commands cannot
+be invoked until \fBpackage require\fR has been used to select a
+version;  in contrast, packages indexed with \fBauto_mkindex\fR
+can be used immediately since there is no version control.
+
+.SH "HOW IT WORKS"
+.PP
+\fBPkg_mkIndex\fR depends on the \fBpackage unknown\fR command,
+the \fBpackage ifneeded\fR command, and the auto-loader.
+The first time a \fBpackage require\fR command is invoked,
+the \fBpackage unknown\fR script is invoked.
+This is set by Tcl initialization to a script that
+evaluates all of the \fBpkgIndex.tcl\fR files in the
+\fBauto_path\fR.
+The \fBpkgIndex.tcl\fR files contain \fBpackage ifneeded\fR
+commands for each version of each available package;  these commands
+invoke \fBpackage provide\fR commands to announce the
+availability of the package, and they setup auto-loader
+information to load the files of the package.
+.VS 8.0.3
+Unless the \fI-direct\fR flag was provided when the \fBpkgIndex.tcl\fR
+was generated,
+.VE
+a given file of a given version of a given package isn't
+actually loaded until the first time one of its commands
+is invoked.
+Thus, after invoking \fBpackage require\fR you
+.VS 8.0.3
+may
+.VE
+not see
+the package's commands in the interpreter, but you will be able
+to invoke the commands and they will be auto-loaded.
+
+.VS 8.0.3
+.SH "DIRECT LOADING"
+.PP
+Some packages, for instance packages which use namespaces and export
+commands or those which require special initialization, might select
+that their package files be loaded immediately upon \fBpackage require\fR
+instead of delaying the actual loading to the first use of one of the
+package's command. This mode is enabled when generating the package
+index by specifying the \fI-direct\fR argument.
+.VE
+
+.SH "COMPLEX CASES"
+Most complex cases of dependencies among scripts
+and binary files, and packages being split among scripts and
+binary files are handled OK.  However, you may have to adjust
+the order in which files are processed by \fBpkg_mkIndex\fR.
+These issues are described in detail below.
+.PP
+If each script or file contains one package, and packages
+are only contained in one file, then things are easy.
+You simply specify all files to be indexed in any order
+with some glob patterns.
+.PP
+In general, it is OK for scripts to have dependencies on other
+packages.
+If scripts contain \fBpackage require\fP commands, these are
+stubbed out in the interpreter used to process the scripts,
+so these do not cause problems.
+If scripts call into other packages in global code,
+these calls are handled by a stub \fBunknown\fP command.
+However, if scripts make variable references to other package's
+variables in global code, these will cause errors.  That is
+also bad coding style.
+.PP
+If binary files have dependencies on other packages, things
+can become tricky because it is not possible to stub out
+C-level API's such as \fBTcl_PkgRequire\fP API
+when loading a binary file.
+For example, suppose the BLT package requires Tk, and expresses
+this with a call to \fBTcl_PkgRequire\fP in its \fBBlt_Init\fP routine.
+To support this, you must run \fBpkg_mkIndex\fR in an interpreter that
+has Tk loaded.  You can achieve this with the
+\fB-load \fIpkgPat\fR option.  If you specify this option,
+\fBpkg_mkIndex\fR will load any packages listed by
+\fBinfo loaded\fP and that match \fIpkgPat\fP
+into the interpreter used to process files.
+In most cases this will satisfy the \fBTcl_PkgRequire\fP calls
+made by binary files.
+.PP
+If you are indexing two binary files and one depends on the other,
+you should specify the one that has dependencies last.
+This way the one without dependencies will get loaded and indexed,
+and then the package it provides
+will be available when the second file is processed.
+You may also need to load the first package into the
+temporary interpreter used to create the index by using
+the \fB-load\fP flag;
+it won't hurt to specify package patterns that are not yet loaded.
+.PP
+If you have a package that is split across scripts and a binary file,
+then you should avoid the \fB-load\fP flag. The problem is that
+if you load a package before computing the index it masks any
+other files that provide part of the same package.
+If you must use \fB-load\fP,
+then you must specify the scripts first; otherwise the package loaded from
+the binary file may mask the package defined by the scripts.
+
+.SH KEYWORDS
+auto-load, index, package, version
diff --git a/tcl/doc/proc.n b/tcl/doc/proc.n
new file mode 100644
index 00000000000..f7b3ac22e79
--- /dev/null
+++ b/tcl/doc/proc.n
@@ -0,0 +1,74 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH proc n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+proc \- Create a Tcl procedure
+.SH SYNOPSIS
+\fBproc \fIname args body\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBproc\fR command creates a new Tcl procedure named
+\fIname\fR, replacing
+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
+one argument.  Each argument specifier is also a list with either
+one or two fields.  If there is only a single field in the specifier
+then it is the name of the argument; if there are two fields, then
+the first is the argument name and the second is its default value.
+.PP
+When \fIname\fR is invoked a local variable
+will be created for each of the formal arguments to the procedure; its
+value will be the value of corresponding argument in the invoking command
+or the argument's default value.
+Arguments with default values need not be
+specified in a procedure invocation.  However, there must be enough
+actual arguments for all the
+formal arguments that don't have defaults, and there must not be any extra
+actual arguments.  There is one special case to permit procedures with
+variable numbers of arguments.  If the last formal argument has the name
+\fBargs\fR, then a call to the procedure may contain more actual arguments
+than the procedure has formals.  In this case, all of the actual arguments
+starting at the one that would be assigned to \fBargs\fR are combined into
+a list (as if the \fBlist\fR command had been used); this combined value
+is assigned to the local variable \fBargs\fR.
+.PP
+When \fIbody\fR is being executed, variable names normally refer to
+local variables, which are created automatically when referenced and
+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
+\fBreturn\fR command.  If the procedure doesn't execute an explicit
+\fBreturn\fR, then its return value is the value of the last command
+executed in the procedure's body.
+If an error occurs while executing the procedure
+body, then the procedure-as-a-whole will return that same error.
+
+.SH KEYWORDS
+argument, procedure
diff --git a/tcl/doc/puts.n b/tcl/doc/puts.n
new file mode 100644
index 00000000000..1c5113ab48b
--- /dev/null
+++ b/tcl/doc/puts.n
@@ -0,0 +1,69 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH puts n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+puts \- Write to a channel
+.SH SYNOPSIS
+\fBputs \fR?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Writes the characters given by \fIstring\fR to the channel given
+by \fIchannelId\fR.
+\fIChannelId\fR must be a channel identifier such as returned from a
+previous invocation of \fBopen\fR or \fBsocket\fR. It must have been opened
+for output. If no \fIchannelId\fR is specified then it defaults to
+\fBstdout\fR. \fBPuts\fR normally outputs a newline character after
+\fIstring\fR, but this feature may be suppressed by specifying the
+\fB\-nonewline\fR switch.
+.PP
+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,
+on PCs newlines are normally replaced with carriage-return-linefeed
+sequences;  on Macintoshes newlines are normally replaced with
+carriage-returns).
+See the \fBfconfigure\fR manual entry for a discussion of end-of-line
+translations.
+.PP
+Tcl buffers output internally, so characters written with \fBputs\fR
+may not appear immediately on the output file or device;  Tcl will
+normally delay output until the buffer is full or the channel is
+closed.
+You can force output to appear immediately with the \fBflush\fR
+command.
+.PP
+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.
+If \fIchannelId\fR is in nonblocking mode then the \fBputs\fR command
+will not block even if the operating system cannot accept the data.
+Instead, Tcl continues to buffer the data and writes it in the
+background as fast as the underlying file or device can accept it.
+The application must use the Tcl event loop for nonblocking output
+to work;  otherwise Tcl never finds out that the file or device is
+ready for more output data.
+It is possible for an arbitrarily large amount of data to be
+buffered for a channel in nonblocking mode, which could consume a
+large amount of memory.
+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).
+
+.SH "SEE ALSO"
+fileevent(n)
+
+.SH KEYWORDS
+channel, newline, output, write
diff --git a/tcl/doc/pwd.n b/tcl/doc/pwd.n
new file mode 100644
index 00000000000..892324191e0
--- /dev/null
+++ b/tcl/doc/pwd.n
@@ -0,0 +1,25 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH pwd n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+pwd \- Return the current working directory
+.SH SYNOPSIS
+\fBpwd\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Returns the path name of the current working directory.
+
+.SH KEYWORDS
+working directory
diff --git a/tcl/doc/read.n b/tcl/doc/read.n
new file mode 100644
index 00000000000..f294a8bff04
--- /dev/null
+++ b/tcl/doc/read.n
@@ -0,0 +1,50 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH read n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+read \- Read from a channel
+.SH SYNOPSIS
+\fBread \fR?\fB\-nonewline\fR? \fIchannelId\fR
+.sp
+\fBread \fIchannelId numBytes\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+In the first form, the \fBread\fR command reads all of the data from
+\fIchannelId\fR up to the end of the file.
+If the \fB\-nonewline\fR switch is specified then the last character
+of the file is discarded if it is a newline.
+In the second form, the extra argument specifies how many bytes to
+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
+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
+for more input.
+The \fB\-nonewline\fR switch is ignored if the command returns
+before reaching the end of the file.
+.PP
+\fBRead\fR translates end-of-line sequences in the input into
+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.
+
+.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/tcl/doc/regexp.n b/tcl/doc/regexp.n
new file mode 100644
index 00000000000..af39c918314
--- /dev/null
+++ b/tcl/doc/regexp.n
@@ -0,0 +1,145 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH regexp n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+regexp \- Match a regular expression against a string
+.SH SYNOPSIS
+\fBregexp \fR?\fIswitches\fR? \fIexp string \fR?\fImatchVar\fR? ?\fIsubMatchVar subMatchVar ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Determines whether the regular expression \fIexp\fR matches part or
+all of \fIstring\fR and returns 1 if it does, 0 if it doesn't.
+.LP
+If additional arguments are specified after \fIstring\fR then they
+are treated as the names of variables in which to return
+information about which part(s) of \fIstring\fR matched \fIexp\fR.
+\fIMatchVar\fR will be set to the range of \fIstring\fR that
+matched all of \fIexp\fR.  The first \fIsubMatchVar\fR will contain
+the characters in \fIstring\fR that matched the leftmost parenthesized
+subexpression within \fIexp\fR, the next \fIsubMatchVar\fR will
+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
+they are treated as switches.  The following switches are
+currently supported:
+.TP 10
+\fB\-nocase\fR
+Causes upper-case characters in \fIstring\fR to be treated as
+lower case during the matching process.
+.TP 10
+\fB\-indices\fR
+Changes what is stored in the \fIsubMatchVar\fRs. 
+Instead of storing the matching characters from \fBstring\fR,
+each variable
+will contain a list of two decimal strings giving the indices
+in \fIstring\fR of the first and last characters in the matching
+range of characters.
+.TP 10
+\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.
+.LP
+If there are more \fIsubMatchVar\fR's than parenthesized
+subexpressions within \fIexp\fR, or if a particular subexpression
+in \fIexp\fR doesn't match the string (e.g. because it was in a
+portion of the expression that wasn't matched), then the corresponding
+\fIsubMatchVar\fR will be set to ``\fB\-1 \-1\fR'' if \fB\-indices\fR
+has been specified or to an empty string otherwise.
+
+.SH "REGULAR EXPRESSIONS"
+.PP
+Regular expressions are implemented using Henry Spencer's package
+(thanks, Henry!),
+and much of the description of regular expressions below is copied verbatim
+from his manual entry.
+.PP
+A regular expression is zero or more \fIbranches\fR, separated by ``|''.
+It matches anything that matches one of the branches.
+.PP
+A branch is zero or more \fIpieces\fR, concatenated.
+It matches a match for the first, followed by a match for the second, etc.
+.PP
+A piece is an \fIatom\fR possibly followed by ``*'', ``+'', or ``?''.
+An atom followed by ``*'' matches a sequence of 0 or more matches of the atom.
+An atom followed by ``+'' matches a sequence of 1 or more matches of the atom.
+An atom followed by ``?'' matches a match of the atom, or the null string.
+.PP
+An atom is a regular expression in parentheses (matching a match for the
+regular expression), a \fIrange\fR (see below), ``.''
+(matching any single character), ``^'' (matching the null string at the
+beginning of the input string), ``$'' (matching the null string at the
+end of the input string), a ``\e'' followed by a single character (matching
+that character), or a single character with no other significance
+(matching that character).
+.PP
+A \fIrange\fR is a sequence of characters enclosed in ``[]''.
+It normally matches any single character from the sequence.
+If the sequence begins with ``^'',
+it matches any single character \fInot\fR from the rest of the sequence.
+If two characters in the sequence are separated by ``\-'', this is shorthand
+for the full list of ASCII characters between them
+(e.g. ``[0-9]'' matches any decimal digit).
+To include a literal ``]'' in the sequence, make it the first character
+(following a possible ``^'').
+To include a literal ``\-'', make it the first or last character.
+
+.SH "CHOOSING AMONG ALTERNATIVE MATCHES"
+.PP
+In general there may be more than one way to match a regular expression
+to an input string.  For example, consider the command
+.CS
+\fBregexp  (a*)b*  aabaaabb  x  y\fR
+.CE
+Considering only the rules given so far, \fBx\fR and \fBy\fR could
+end up with the values \fBaabb\fR and \fBaa\fR, \fBaaab\fR and \fBaaa\fR,
+\fBab\fR and \fBa\fR, or any of several other combinations.
+To resolve this potential ambiguity \fBregexp\fR chooses among
+alternatives using the rule ``first then longest''.
+In other words, it considers the possible matches in order working
+from left to right across the input string and the pattern, and it
+attempts to match longer pieces of the input string before shorter
+ones.  More specifically, the following rules apply in decreasing
+order of priority:
+.IP [1]
+If a regular expression could match two different parts of an input string
+then it will match the one that begins earliest.
+.IP [2]
+If a regular expression contains \fB|\fR operators then the leftmost
+matching sub-expression is chosen.
+.IP [3]
+In \fB*\fR, \fB+\fR, and \fB?\fR constructs, longer matches are chosen
+in preference to shorter ones.
+.IP [4]
+In sequences of expression components the components are considered
+from left to right.
+.LP
+In the example from above, \fB(a*)b*\fR matches \fBaab\fR:  the \fB(a*)\fR
+portion of the pattern is matched first and it consumes the leading
+\fBaa\fR; then the \fBb*\fR portion of the pattern consumes the
+next \fBb\fR.  Or, consider the following example:
+.CS
+\fBregexp  (ab|a)(b*)c  abc  x  y  z\fR
+.CE
+After this command \fBx\fR will be \fBabc\fR, \fBy\fR will be
+\fBab\fR, and \fBz\fR will be an empty string.
+Rule 4 specifies that \fB(ab|a)\fR gets first shot at the input
+string and Rule 2 specifies that the \fBab\fR sub-expression
+is checked before the \fBa\fR sub-expression.
+Thus the \fBb\fR has already been claimed before the \fB(b*)\fR
+component is checked and \fB(b*)\fR must match an empty string.
+
+.SH KEYWORDS
+match, regular expression, string
diff --git a/tcl/doc/registry.n b/tcl/doc/registry.n
new file mode 100644
index 00000000000..f1b48b2146e
--- /dev/null
+++ b/tcl/doc/registry.n
@@ -0,0 +1,166 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+'\" 
+.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.  If the
+specified \fIkeyName\fR does not exist, then an error is generated.
+.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/tcl/doc/regsub.n b/tcl/doc/regsub.n
new file mode 100644
index 00000000000..a6605d1bfca
--- /dev/null
+++ b/tcl/doc/regsub.n
@@ -0,0 +1,72 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH regsub n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+regsub \- Perform substitutions based on regular expression pattern matching
+.SH SYNOPSIS
+\fBregsub \fR?\fIswitches\fR? \fIexp string subSpec varName\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command matches the regular expression \fIexp\fR against
+\fIstring\fR,
+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
+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
+matched \fIexp\fR.
+If \fIsubSpec\fR contains a ``\e\fIn\fR'', where \fIn\fR is a digit
+between 1 and 9, then it is replaced in the substitution with
+the portion of \fIstring\fR that matched the \fIn\fR-th
+parenthesized subexpression of \fIexp\fR.
+Additional backslashes may be used in \fIsubSpec\fR to prevent special
+interpretation of ``&'' or ``\e0'' or ``\e\fIn\fR'' or
+backslash.
+The use of backslashes in \fIsubSpec\fR tends to interact badly
+with the Tcl parser's use of backslashes, so it's generally
+safest to enclose \fIsubSpec\fR in braces if it includes
+backslashes.
+.LP
+If the initial arguments to \fBregexp\fR start with \fB\-\fR then
+they are treated as switches.  The following switches are
+currently supported:
+.TP 10
+\fB\-all\fR
+All ranges in \fIstring\fR that match \fIexp\fR are found and
+substitution is performed for each of these ranges.
+Without this switch only the first
+matching range is found and substituted.
+If \fB\-all\fR is specified, then ``&'' and ``\e\fIn\fR''
+sequences are handled for each substitution using the information
+from the corresponding match.
+.TP 10
+\fB\-nocase\fR
+Upper-case characters in \fIstring\fR will be converted to lower-case
+before matching against \fIexp\fR;  however, substitutions specified
+by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
+.TP 10
+\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.
+.PP
+The command returns a count of the number of matching ranges that
+were found and replaced.
+See the manual entry for \fBregexp\fR for details on the interpretation
+of regular expressions.
+
+.SH KEYWORDS
+match, pattern, regular expression, substitute
diff --git a/tcl/doc/rename.n b/tcl/doc/rename.n
new file mode 100644
index 00000000000..9ff53cf37cc
--- /dev/null
+++ b/tcl/doc/rename.n
@@ -0,0 +1,32 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH rename n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+rename \- Rename or delete a command
+.SH SYNOPSIS
+\fBrename \fIoldName newName\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Rename the command that used to be called \fIoldName\fR so that it
+is now called \fInewName\fR.
+If \fInewName\fR is an empty string then \fIoldName\fR is deleted.
+\fIoldName\fR and \fInewName\fR may include namespace qualifiers
+(names of containing namespaces).
+If a command is renamed into a different namespace,
+future invocations of it will execute in the new namespace.
+The \fBrename\fR command returns an empty string as result.
+
+.SH KEYWORDS
+command, delete, namespace, rename
diff --git a/tcl/doc/resource.n b/tcl/doc/resource.n
new file mode 100644
index 00000000000..3bedadad09f
--- /dev/null
+++ b/tcl/doc/resource.n
@@ -0,0 +1,155 @@
+'\"
+'\" 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.
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH resource n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+resource \- Manipulate Macintosh resources
+.SH SYNOPSIS
+\fBresource \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBresource\fR command provides some generic operations for
+dealing with Macintosh resources.  This command is only supported on
+the Macintosh platform.  Each Macintosh file consists of two
+\fIforks\fR: a \fIdata\fR fork and a \fIresource\fR fork.  You use the
+normal open, puts, close, etc. commands to manipulate the data fork.
+You must use this command, however, to interact with the resource
+fork.  \fIOption\fR indicates what resource command to perform.  Any
+unique abbreviation for \fIoption\fR is acceptable.  The valid options
+are:
+.TP
+\fBresource close \fIrsrcRef\fR
+Closes the given resource reference (obtained from \fBresource
+open\fR).  Resources from that resource file will no longer be
+available.
+.TP
+\fBresource delete\fR ?\fIoptions\fR? \fIresourceType\fR
+This command will delete the resource specified by \fIoptions\fR and
+type \fIresourceType\fR (see RESOURCE TYPES below).  The options
+give you several ways to specify the resource to be deleted.
+.RS
+.TP
+\fB\-id\fR \fIresourceId\fR
+If the \fB-id\fR option is given the id \fIresourceId\fR (see RESOURCE
+IDS below) is used to specify the resource to be deleted.  The id must 
+be a number - to specify a name use the \fB\-name\fR option.
+.TP
+\fB\-name\fR \fIresourceName\fR
+If \fB-name\fR is specified, the resource named
+\fIresourceName\fR will be deleted.  If the \fB-id\fR is also
+provided, then there must be a resource with BOTH this name and
+this id.  If no name is provided, then the id will be used regardless
+of the name of the actual resource.
+.TP
+\fB\-file\fR \fIresourceRef\fR
+If the \fB-file\fR option is specified then the resource will be
+deleted from the file pointed to by \fIresourceRef\fR.  Otherwise the
+first resource with the given \fIresourceName\fR and or
+\fIresourceId\fR which is found on the resource file path will be 
+deleted.  To inspect the file path, use the \fIresource files\fB command.
+.RE
+.TP
+\fBresource files ?\fIresourceRef\fR?
+If \fIresourceRef\fRis not provided, this command returns a Tcl list
+of the resource references for all the currently open resource files.
+The list is in the normal Macintosh search order for resources.  If 
+\fIresourceRef\fR is specified, the command will
+return the path to the file whose resource fork is represented by that
+token.
+.TP
+\fBresource list \fIresourceType\fR ?\fIresourceRef\fR?
+List all of the resources ids of type \fIresourceType\fR (see RESOURCE
+TYPES below).  If \fIresourceRef\fR is specified then the command will
+limit the search to that particular resource file.  Otherwise, all
+resource files currently opened by the application will be searched.
+A Tcl list of either the resource name's or resource id's of the found
+resources will be returned.  See the RESOURCE IDS section below for
+more details about what a resource id is.
+.TP
+\fBresource open \fIfileName\fR ?\fIpermissions\fR?
+Open the resource for the file \fIfileName\fR.  Standard file
+permissions may also be specified (see the manual entry for \fBopen\fR
+for details).  A resource reference (\fIresourceRef\fR) is returned
+that can be used by the other resource commands.  An error can occur
+if the file doesn't exist or the file does not have a resource fork.
+However, if you open the file with write permissions the file and/or
+resource fork will be created instead of generating an error.
+.TP
+\fBresource read \fIresourceType\fR \fIresourceId\fR ?\fIresourceRef\fR?
+Read the entire resource of type \fIresourceType\fR (see RESOURCE
+TYPES below) and the name or id of \fIresourceId\fR (see RESOURCE IDS
+below) into memory and return the result.  If \fIresourceRef\fR is
+specified we limit our search to that resource file, otherwise we
+search all open resource forks in the application.  It is important to
+note that most Macintosh resource use a binary format and the data
+returned from this command may have embedded NULLs or other non-ASCII
+data.
+.TP
+\fBresource types ?\fIresourceRef\fR?
+This command returns a Tcl list of all resource types (see RESOURCE
+TYPES below) found in the resource file pointed to by
+\fIresourceRef\fR.  If \fIresourceRef\fR is not specified it will
+return all the resource types found in every resource file currently
+opened by the application.
+.TP
+\fBresource write\fR ?\fIoptions\fR? \fIresourceType\fR \fIdata\fR
+This command will write the passed in \fIdata\fR as a new resource of
+type \fIresourceType\fR (see RESOURCE TYPES below).  Several options
+are available that describe where and how the resource is stored.
+.RS
+.TP
+\fB\-id\fR \fIresourceId\fR
+If the \fB-id\fR option is given the id \fIresourceId\fR (see RESOURCE
+IDS below) is used for the new resource, otherwise a unique id will be
+generated that will not conflict with any existing resource.  However,
+the id must be a number - to specify a name use the \fB\-name\fR option.
+.TP
+\fB\-name\fR \fIresourceName\fR
+If \fB-name\fR is specified the resource will be named
+\fIresourceName\fR, otherwise it will have the empty string as the
+name.
+.TP
+\fB\-file\fR \fIresourceRef\fR
+If the \fB-file\fR option is specified then the resource will be
+written in the file pointed to by \fIresourceRef\fR, otherwise the
+most resently open resource will be used.
+.TP
+\fB\-force\fR
+If the target resource already exists, then by default Tcl will not
+overwrite it, but raise an error instead.  Use the -force flag to
+force overwriting the extant resource.
+.RE
+
+.SH "RESOURCE TYPES"
+Resource types are defined as a four character string that is then
+mapped to an underlying id.  For example, \fBTEXT\fR refers to the
+Macintosh resource type for text.  The type \fBSTR#\fR is a list of
+counted strings.  All Macintosh resources must be of some type.  See
+Macintosh documentation for a more complete list of resource types
+that are commonly used.
+
+.SH "RESOURCE IDS"
+For this command the notion of a resource id actually refers to two
+ideas in Macintosh resources.  Every place you can use a resource Id
+you can use either the resource name or a resource number.  Names are
+always searched or returned in preference to numbers.  For example,
+the \fBresource list\fR command will return names if they exist or
+numbers if the name is NULL.
+
+.SH "SEE ALSO"
+open
+
+.SH "PORTABILITY ISSUES"
+The resource command is only available on Macintosh.
+
+.SH KEYWORDS
+open, resource
diff --git a/tcl/doc/return.n b/tcl/doc/return.n
new file mode 100644
index 00000000000..bba4854237b
--- /dev/null
+++ b/tcl/doc/return.n
@@ -0,0 +1,89 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH return n 7.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+return \- Return from a procedure
+.SH SYNOPSIS
+\fBreturn \fR?\fB\-code \fIcode\fR? ?\fB\-errorinfo \fIinfo\fR? ?\fB\-errorcode\fI code\fR? ?\fIstring\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Return immediately from the current procedure
+(or top-level command or \fBsource\fR command),
+with \fIstring\fR as the return value.  If \fIstring\fR is not specified then
+an empty string will be returned as result.
+
+.SH "EXCEPTIONAL RETURNS"
+.PP
+In the usual case where the \fB\-code\fR option isn't
+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
+exceptional return from the procedure.
+\fICode\fR may have any of the following values:
+.TP 10
+\fBok\fR
+Normal return:  same as if the option is omitted.
+.TP 10
+\fBerror\fR
+Error return: same as if the \fBerror\fR command were used to
+terminate the procedure, except for handling of \fBerrorInfo\fR
+and \fBerrorCode\fR variables (see below).
+.TP 10
+\fBreturn\fR
+The current procedure will return with a completion code of
+TCL_RETURN, so that the procedure that invoked it will return
+also.
+.TP 10
+\fBbreak\fR
+The current procedure will return with a completion code of
+TCL_BREAK, which will terminate the innermost nested loop in
+the code that invoked the current procedure.
+.TP 10
+\fBcontinue\fR
+The current procedure will return with a completion code of
+TCL_CONTINUE, which will terminate the current iteration of
+the innermost nested loop in the code that invoked the current
+procedure.
+.TP 10
+\fIvalue\fR
+\fIValue\fR must be an integer;  it will be returned as the
+completion code for the current procedure.
+.LP
+The \fB\-code\fR option is rarely used.
+It is provided so that procedures that implement
+new control structures can reflect exceptional conditions back to
+their callers.
+.PP
+Two additional options, \fB\-errorinfo\fR and \fB\-errorcode\fR,
+may be used to provide additional information during error
+returns.
+These options are ignored unless \fIcode\fR is \fBerror\fR.
+.PP
+The \fB\-errorinfo\fR option specifies an initial stack
+trace for the \fBerrorInfo\fR variable;  if it is not specified then
+the stack trace left in \fBerrorInfo\fR will include the call to
+the procedure and higher levels on the stack but it will not include
+any information about the context of the error within the procedure.
+Typically the \fIinfo\fR value is supplied from the value left
+in \fBerrorInfo\fR after a \fBcatch\fR command trapped an error within
+the procedure.
+.PP
+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.
+
+.SH KEYWORDS
+break, continue, error, procedure, return
diff --git a/tcl/doc/safe.n b/tcl/doc/safe.n
new file mode 100644
index 00000000000..ae6847f45c2
--- /dev/null
+++ b/tcl/doc/safe.n
@@ -0,0 +1,345 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Safe Base \- A mechanism for creating and manipulating safe interpreters.
+.SH SYNOPSIS
+.PP
+\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
+.sp
+\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
+.sp
+\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
+.sp
+\fB::safe::interpDelete\fR \fIslave\fR
+.sp
+\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
+.sp
+\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
+.sp
+\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
+.SH OPTIONS
+.PP
+?\fB\-accessPath\fR \fIpathList\fR?
+?\fB\-statics\fR \fIboolean\fR? ?\fB\-noStatics\fR?
+?\fB\-nested\fR \fIboolean\fR? ?\fB\-nestedLoadOk\fR?
+?\fB\-deleteHook\fR \fIscript\fR?
+.BE
+
+.SH DESCRIPTION
+Safe Tcl is a mechanism for executing untrusted Tcl scripts
+safely and for providing mediated access by such scripts to
+potentially dangerous functionality.
+.PP
+The Safe Base ensures that untrusted Tcl scripts cannot harm the
+hosting application.
+The Safe Base prevents integrity and privacy attacks. Untrusted Tcl
+scripts are prevented from corrupting the state of the hosting
+application or computer. Untrusted scripts are also prevented from
+disclosing information stored on the hosting computer or in the
+hosting application to any party.
+.PP
+The Safe Base allows a master interpreter to create safe, restricted
+interpreters that contain a set of predefined aliases for the \fBsource\fR,
+\fBload\fR, \fBfile\fR and \fBexit\fR commands and
+are able to use the auto-loading and package mechanisms.
+.PP
+No knowledge of the file system structure is leaked to the
+safe interpreter, because it has access only to a virtualized path
+containing tokens. When the safe interpreter requests to source a file, it
+uses the token in the virtual path as part of the file name to source; the
+master interpreter transparently 
+translates the token into a real directory name and executes the 
+requested operation (see the section \fBSECURITY\fR below for details).
+Different levels of security can be selected by using the optional flags
+of the commands described below.
+.PP
+All commands provided in the master interpreter by the Safe Base reside in
+the \fBsafe\fR namespace:
+
+.SH COMMANDS
+The following commands are provided in the master interpreter:
+.TP
+\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
+Creates a safe interpreter, installs the aliases described in the section
+\fBALIASES\fR and initializes the auto-loading and package mechanism as
+specified by the supplied \fBoptions\fR.
+See the \fBOPTIONS\fR section below for a description of the
+optional arguments.
+If the \fIslave\fR argument is omitted, a name will be generated.
+\fB::safe::interpCreate\fR always returns the interpreter name.
+.TP
+\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
+This command is similar to \fBinterpCreate\fR except it that does not
+create the safe interpreter. \fIslave\fR must have been created by some
+other means, like \fBinterp create \-safe\fR.
+.TP
+\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
+If no \fIoptions\fR are given, returns the settings for all options for the
+named safe interpreter as a list of options and their current values
+for that \fIslave\fR. 
+If a single additional argument is provided,
+it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
+\fIname\fR is the full name of that option and \fIvalue\fR the current value
+for that option and the \fIslave\fR.
+If more than two additional arguments are provided, it will reconfigure the
+safe interpreter and change each and only the provided options.
+See the section on \fBOPTIONS\fR below for options description.
+Example of use:
+.RS
+.CS
+# Create a new interp with the same configuration as "$i0" :
+set i1 [eval safe::interpCreate [safe::interpConfigure $i0]]
+# Get the current deleteHook
+set dh [safe::interpConfigure $i0  \-del]
+# Change (only) the statics loading ok attribute of an interp
+# and its deleteHook (leaving the rest unchanged) :
+safe::interpConfigure $i0  \-delete {foo bar} \-statics 0 ;
+.CE
+.RE
+.TP
+\fB::safe::interpDelete\fR \fIslave\fR
+Deletes the safe interpreter and cleans up the corresponding  
+master interpreter data structures.
+If a \fIdeleteHook\fR script was specified for this interpreter it is
+evaluated before the interpreter is deleted, with the name of the
+interpreter as an additional argument.
+.TP
+\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
+This command finds and returns the token for the real directory
+\fIdirectory\fR in the safe interpreter's current virtual access path.
+It generates an error if the directory is not found.
+Example of use:
+.RS
+.CS
+$slave eval [list set tk_library [::safe::interpFindInAccessPath $name $tk_library]]
+.CE
+.RE
+.TP
+\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
+This command adds \fIdirectory\fR to the virtual path maintained for the
+safe interpreter in the master, and returns the token that can be used in
+the safe interpreter to obtain access to files in that directory.
+If the directory is already in the virtual path, it only returns the token
+without adding the directory to the virtual path again.
+Example of use:
+.RS
+.CS
+$slave eval [list set tk_library [::safe::interpAddToAccessPath $name $tk_library]]
+.CE
+.RE
+.TP
+\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
+This command installs a script that will be called when interesting
+life cycle events occur for a safe interpreter.
+When called with no arguments, it returns the currently installed script.
+When called with one argument, an empty string, the currently installed
+script is removed and logging is turned off.
+The script will be invoked with one additional argument, a string
+describing the event of interest.
+The main purpose is to help in debugging safe interpreters.
+Using this facility you can get complete error messages while the safe
+interpreter gets only generic error messages.
+This prevents a safe interpreter from seeing messages about failures
+and other events that might contain sensitive information such as real
+directory names.
+.RS
+Example of use:
+.CS
+::safe::setLogCmd puts stderr
+.CE
+Below is the output of a sample session in which a safe interpreter
+attempted to source a file not found in its virtual access path.
+Note that the safe interpreter only received an error message saying that
+the file was not found:
+.CS
+NOTICE for slave interp10 : Created
+NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
+NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
+ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
+.CE
+.RE
+
+.SH OPTIONS
+The following options are common to 
+\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR, 
+and \fB::safe::interpConfigure\fR.
+Any option name can be abbreviated to its minimal 
+non-ambiguous name.
+Option names are not case sensitive.
+.TP 
+\fB\-accessPath\fR \fIdirectoryList\fR
+This option sets the list of directories from which the safe interpreter
+can \fBsource\fR and \fBload\fR files.
+If this option is not specified, or if it is given as the
+empty list, the safe interpreter will use the same directories as its
+master for auto-loading.
+See the section \fBSECURITY\fR below for more detail about virtual paths, 
+tokens and access control.
+.TP
+\fB\-statics\fR \fIboolean\fR
+This option specifies if the safe interpreter will be allowed
+to load statically linked packages (like \fBload {} Tk\fR).
+The default value is \fBtrue\fR : 
+safe interpreters are allowed to load statically linked packages.
+.TP
+\fB\-noStatics\fR
+This option is a convenience shortcut for \fB-statics false\fR and
+thus specifies that the safe interpreter will not be allowed
+to load statically linked packages.
+.TP
+\fB\-nested\fR \fIboolean\fR
+This option specifies if the safe interpreter will be allowed
+to load packages into its own sub-interpreters.
+The default value is \fBfalse\fR : 
+safe interpreters are not allowed to load packages into
+their own sub-interpreters.
+.TP
+\fB\-nestedLoadOk\fR
+This option is a convenience shortcut for \fB-nested true\fR and
+thus specifies the safe interpreter will be allowed
+to load packages into its own sub-interpreters.
+.TP 
+\fB\-deleteHook\fR \fIscript\fR
+When this option is given an non empty \fIscript\fR, it will be
+evaluated in the master with the name of
+the safe interpreter as an additional argument
+just before actually deleting the safe interpreter.
+Giving an empty value removes any currently installed deletion hook
+script for that safe interpreter.
+The default value (\fB{}\fR) is not to have any deletion call back.
+.SH ALIASES
+The following aliases are provided in a safe interpreter:
+.TP
+\fBsource\fR \fIfileName\fR
+The requested file, a Tcl source file, is sourced into the safe interpreter
+if it is found.
+The \fBsource\fR alias can only source files from directories in
+the virtual path for the safe interpreter. The \fBsource\fR alias requires
+the safe interpreter to
+use one of the token names in its virtual path to denote the directory in
+which the file to be sourced can be found.
+See the section on \fBSECURITY\fR for more discussion of restrictions on
+valid filenames.
+.TP
+\fBload\fR \fIfileName\fR
+The requested file, a shared object file, is dynamically loaded into the
+safe interpreter if it is found.
+The filename must contain a token name mentioned in the virtual path for
+the safe interpreter for it to be found successfully.
+Additionally, the shared object file must contain a safe entry point; see
+the manual page for the \fBload\fR command for more details.
+.TP
+\fBfile\fR ?\fIsubCmd args...\fR?
+The \fBfile\fR alias provides access to a safe subset of the subcommands of
+the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR,
+\fBextension\fR, \fBroot\fR, \fBtail\fR, \fBpathname\fR and \fBsplit\fR
+subcommands. For more details on what these subcommands do see the manual
+page for the \fBfile\fR command.
+.TP
+\fBexit\fR
+The calling interpreter is deleted and its computation is stopped, but the
+Tcl process in which this interpreter exists is not terminated.
+
+.SH SECURITY
+The Safe Base does not attempt to completely prevent annoyance and
+denial of service attacks. These forms of attack prevent the
+application or user from temporarily using the computer to perform
+useful work, for example by consuming all available CPU time or
+all available screen real estate.
+These attacks, while aggravating, are deemed to be of lesser importance
+in general than integrity and privacy attacks that the Safe Base
+is to prevent.
+.PP
+The commands available in a safe interpreter, in addition to
+the safe set as defined in \fBinterp\fR manual page, are mediated aliases
+for \fBsource\fR, \fBload\fR, \fBexit\fR, and a safe subset of \fBfile\fR.
+The safe interpreter can also auto-load code and it can request that
+packages be loaded.
+.PP
+Because some of these commands access the local file system, there is a
+potential for information leakage about its directory structure.
+To prevent this, commands that take file names as arguments in a safe
+interpreter use tokens instead of the real directory names.
+These tokens are translated to the real directory name while a request to,
+e.g., source a file is mediated by the master interpreter.
+This virtual path system is maintained in the master interpreter for each safe
+interpreter created by \fB::safe::interpCreate\fR or initialized by
+\fB::safe::interpInit\fR and
+the path maps tokens accessible in the safe interpreter into real path
+names on the local file system thus preventing safe interpreters 
+from gaining knowledge about the
+structure of the file system of the host on which the interpreter is
+executing.
+The only valid file names arguments
+for the \fBsource\fR and \fBload\fR aliases provided to the slave
+are path in the form of 
+\fB[file join \fR\fItoken filename\fR\fB]\fR (ie, when using the
+native file path formats: \fItoken\fR\fB/\fR\fIfilename\fR
+on Unix, \fItoken\fR\fB\\\fIfilename\fR on Windows, 
+and \fItoken\fR\fB:\fR\fIfilename\fR on the Mac),
+where \fItoken\fR is representing one of the directories 
+of the \fIaccessPath\fR list and \fIfilename\fR is
+one file in that directory (no sub directories access are allowed).
+.PP
+When a token is used in a safe interpreter in a request to source or
+load a file, the token is checked and
+translated to a real path name and the file to be
+sourced or loaded is located on the file system.
+The safe interpreter never gains knowledge of the actual path name under
+which the file is stored on the file system.
+.PP
+To further prevent potential information leakage from sensitive files that
+are accidentally included in the set of files that can be sourced by a safe
+interpreter, the \fBsource\fR alias restricts access to files
+meeting the following constraints: the file name must
+fourteen characters or shorter, must not contain more than one dot ("\fB.\fR"),
+must end up with the extension \fB.tcl\fR or be called \fBtclIndex\fR.
+.PP
+Each element of the initial access path
+list will be assigned a token that will be set in
+the slave \fBauto_path\fR and the first element of that list will be set as
+the \fBtcl_library\fR for that slave.
+.PP
+If the access path argument is not given or is the empty list, 
+the default behavior is to let the slave access the same packages
+as the master has access to (Or to be more precise: 
+only packages written in Tcl (which by definition can't be dangerous
+as they run in the slave interpreter) and C extensions that
+provides a Safe_Init entry point). For that purpose, the master's 
+\fBauto_path\fR will be used to construct the slave access path. 
+In order that the slave successfully loads the Tcl library files
+(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
+added or moved to the first position if necessary, in the 
+slave access path, so the slave
+\fBtcl_library\fR will be the same as the master's (its real
+path will still be invisible to the slave though). 
+In order that auto-loading works the same for the slave and
+the master in this by default case, the first-level
+sub directories of each directory in the master \fBauto_path\fR will
+also be added (if not already included) to the slave access path.
+You can always specify a more
+restrictive path for which sub directories will never be searched by 
+explicitly specifying your directory list with the \fB\-accessPath\fR flag
+instead of relying on this default mechanism.
+.PP
+When the \fIaccessPath\fR is changed after the first creation or
+initialization (ie through \fBinterpConfigure -accessPath \fR\fIlist\fR),
+an \fBauto_reset\fR is automatically evaluated in the safe interpreter
+to synchronize its \fBauto_index\fR with the new token list.
+
+.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, safe
+interpreter, slave interpreter, source
diff --git a/tcl/doc/scan.n b/tcl/doc/scan.n
new file mode 100644
index 00000000000..6ad163d6843
--- /dev/null
+++ b/tcl/doc/scan.n
@@ -0,0 +1,134 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH scan n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+scan \- Parse string using conversion specifiers in the style of sscanf
+.SH SYNOPSIS
+\fBscan \fIstring format varName \fR?\fIvarName ...\fR?
+.BE
+
+.SH INTRODUCTION
+.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
+of conversions performed, or -1 if the end of the input string is
+reached before any conversions have been performed.
+\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
+scanned from \fIstring\fR the result is converted back into a string
+and assigned to the corresponding variable.
+
+.SH "DETAILS ON SCANNING"
+.PP
+\fBScan\fR operates by scanning \fIstring\fR and \fIformatString\fR together.
+If the next character in \fIformatString\fR is a blank or tab then it
+matches any number of white space characters in \fIstring\fR (including
+zero).
+Otherwise, if it isn't a \fB%\fR character then it 
+must match the next character of \fIstring\fR.
+When a \fB%\fR is encountered in \fIformatString\fR, it indicates
+the start of a conversion specifier.
+A conversion specifier contains three fields after the \fB%\fR:
+a \fB*\fR, which indicates that the converted value is to be discarded 
+instead of assigned to a variable; a number indicating a maximum field
+width; and a conversion character.
+All of these fields are optional except for the conversion character.
+.PP
+When \fBscan\fR finds a conversion specifier in \fIformatString\fR, it
+first skips any white-space characters in \fIstring\fR.
+Then it converts the next input characters according to the 
+conversion specifier and stores the result in the variable given
+by the next argument to \fBscan\fR.
+The following conversion characters are supported:
+.TP 10
+\fBd\fR
+The input field must be a decimal integer.
+It is read in and the value is stored in the variable as a decimal string.
+.TP 10
+\fBo\fR
+The input field must be an octal integer. It is read in and the 
+value is stored in the variable as a decimal string.
+.TP 10
+\fBx\fR
+The input field must be a hexadecimal integer. It is read in 
+and the value is stored in the variable as a decimal string.
+.TP 10
+\fBc\fR
+A single character is read in and its binary value is stored in 
+the variable as a decimal string.
+Initial white space is not skipped in this case, so the input
+field may be a white-space character.
+This conversion is different from the ANSI standard in that the
+input field always consists of a single character and no field
+width may be specified.
+.TP 10
+\fBs\fR
+The input field consists of all the characters up to the next 
+white-space character; the characters are copied to the variable.
+.TP 10
+\fBe\fR or \fBf\fR or \fBg\fR
+The input field must be a floating-point number consisting 
+of an optional sign, a string of decimal digits possibly
+containing a decimal point, and an optional exponent consisting 
+of an \fBe\fR or \fBE\fR followed by an optional sign and a string of 
+decimal digits.
+It is read in and stored in the variable as a floating-point string.
+.TP 10
+\fB[\fIchars\fB]\fR
+The input field consists of any number of characters in 
+\fIchars\fR.
+The matching string is stored in the variable.
+If the first character between the brackets is a \fB]\fR then
+it is treated as part of \fIchars\fR rather than the closing
+bracket for the set.
+.TP 10
+\fB[^\fIchars\fB]\fR
+The input field consists of any number of characters not in 
+\fIchars\fR.
+The matching string is stored in the variable.
+If the character immediately following the \fB^\fR is a \fB]\fR then it is 
+treated as part of the set rather than the closing bracket for 
+the set.
+.LP
+The number of characters read from the input for a conversion is the
+largest number that makes sense for that particular conversion (e.g.
+as many decimal digits as possible for \fB%d\fR, as 
+many octal digits as possible for \fB%o\fR, and so on).
+The input field for a given conversion terminates either when a
+white-space character is encountered or when the maximum field 
+width has been reached, whichever comes first.
+If a \fB*\fR is present in the conversion specifier 
+then no variable is assigned and the next scan argument is not consumed.
+
+.SH "DIFFERENCES FROM ANSI SSCANF"
+.PP
+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]
+\fB%p\fR and \fB%n\fR conversion specifiers are not currently
+supported.
+.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]
+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).
+
+.SH KEYWORDS
+conversion specifier, parse, scan
diff --git a/tcl/doc/seek.n b/tcl/doc/seek.n
new file mode 100644
index 00000000000..bd87e3c75df
--- /dev/null
+++ b/tcl/doc/seek.n
@@ -0,0 +1,55 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH seek n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+seek \- Change the access position for an open channel
+.SH SYNOPSIS
+\fBseek \fIchannelId offset \fR?\fIorigin\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Changes the current access position for \fIchannelId\fR.
+\fIChannelId\fR must be a channel identifier such as returned from a
+previous invocation of \fBopen\fR or \fBsocket\fR.
+The \fIoffset\fR and \fIorigin\fR
+arguments specify the position at which the next read or write will occur
+for \fIchannelId\fR. \fIOffset\fR must be an integer (which may be
+negative) and \fIorigin\fR must be one of the following:
+.TP 10
+\fBstart\fR
+The new access position will be \fIoffset\fR bytes from the start
+of the underlying file or device.
+.TP 10
+\fBcurrent\fR
+The new access position will be \fIoffset\fR bytes from the current
+access position; a negative \fIoffset\fR moves the access position
+backwards in the underlying file or device.
+.TP 10
+\fBend\fR
+The new access position will be \fIoffset\fR bytes from the end of
+the file or device.  A negative \fIoffset\fR places the access position
+before the end of file, and a positive \fIoffset\fR places the access
+position after the end of file.
+.LP
+The \fIorigin\fR argument defaults to \fBstart\fR.
+.PP
+The command flushes all buffered output for the channel before the command
+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
+file or device does not support seeking.
+
+.SH KEYWORDS
+access position, file, seek
diff --git a/tcl/doc/set.n b/tcl/doc/set.n
new file mode 100644
index 00000000000..78c5b3bcb64
--- /dev/null
+++ b/tcl/doc/set.n
@@ -0,0 +1,48 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH set n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+set \- Read and write variables
+.SH SYNOPSIS
+\fBset \fIvarName \fR?\fIvalue\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Returns the value of variable \fIvarName\fR.
+If \fIvalue\fR is specified, then set
+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.
+Otherwise \fIvarName\fR refers to a scalar 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 \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/tcl/doc/socket.n b/tcl/doc/socket.n
new file mode 100644
index 00000000000..289512fd91a
--- /dev/null
+++ b/tcl/doc/socket.n
@@ -0,0 +1,125 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH socket n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+socket \- Open a TCP network connection
+.SH SYNOPSIS
+.sp
+\fBsocket \fR?\fIoptions\fR? \fIhost port\fR
+.sp
+\fBsocket\fR \fB\-server \fIcommand\fR ?\fIoptions\fR? \fIport\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command opens a network socket and returns a channel
+identifier that may be used in future invocations of commands like
+\fBread\fR, \fBputs\fR and \fBflush\fR.
+At present only the TCP network protocol is supported;  future
+releases may include support for additional protocols.
+The \fBsocket\fR command may be used to open either the client or
+server side of a connection, depending on whether the \fB\-server\fR
+switch is specified.
+
+.SH "CLIENT SOCKETS"
+.PP
+If the \fB\-server\fR option is not specified, then the client side of a
+connection is opened and the command returns a channel identifier
+that can be used for both reading and writing.
+\fIPort\fR and \fIhost\fR specify a port
+to connect to;  there must be a server accepting connections on
+this port.  \fIPort\fR is an integer port number and \fIhost\fR
+is either a domain-style name such as \fBwww.sunlabs.com\fR or
+a numerical IP address such as \fB127.0.0.1\fR.
+Use \fIlocalhost\fR to refer to the host on which the command is invoked.
+.PP
+The following options may also be present before \fIhost\fR
+to specify additional information about the connection:
+.TP
+\fB\-myaddr\fI addr\fR
+\fIAddr\fR gives the domain-style name or numerical IP address of
+the client-side network interface to use for the connection.
+This option may be useful if the client machine has multiple network
+interfaces.  If the option is omitted then the client-side interface
+will be chosen by the system software.
+.TP
+\fB\-myport\fI port\fR
+\fIPort\fR specifies an integer port number to use for the client's
+side of the connection.  If this option is omitted, the client's
+port number will be chosen at random by the system software.
+.TP
+\fB\-async\fR
+The \fB\-async\fR option will cause the client socket to be connected
+asynchronously. This means that the socket will be created immediately but
+may not yet be connected to the server, when the call to \fBsocket\fR
+returns. When a \fBgets\fR or \fBflush\fR is done on the socket before the
+connection attempt succeeds or fails, if the socket is in blocking mode, the
+operation will wait until the connection is completed or fails. If the
+socket is in nonblocking mode and a \fBgets\fR or \fBflush\fR is done on
+the socket before the connection attempt succeeds or fails, the operation
+returns immediately and \fBfblocked\fR on the socket returns 1.
+
+.SH "SERVER SOCKETS"
+.PP
+If the \fB\-server\fR option is specified then the new socket
+will be a server for the port given by \fIport\fR.
+Tcl will automatically accept connections to the given port.
+For each connection Tcl will create a new channel that may be used to
+communicate with the client.  Tcl then invokes \fIcommand\fR
+with three additional arguments: the name of the new channel, the
+address, in network address notation, of the client's host, and
+the client's port number.
+.PP
+The following additional option may also be specified before \fIhost\fR:
+.TP
+\fB\-myaddr\fI addr\fR
+\fIAddr\fR gives the domain-style name or numerical IP address of
+the server-side network interface to use for the connection.
+This option may be useful if the server machine has multiple network
+interfaces.  If the option is omitted then the server socket is bound
+to the special address INADDR_ANY so that it can accept connections from
+any interface.
+.PP
+Server channels cannot be used for input or output; their sole use is to
+accept new client connections. The channels created for each incoming
+client connection are opened for input and output. Closing the server
+channel shuts down the server so that no new connections will be
+accepted;  however, existing connections will be unaffected.
+.PP
+Server sockets depend on the Tcl event mechanism to find out when
+new connections are opened.  If the application doesn't enter the
+event loop, for example by invoking the \fBvwait\fR command or
+calling the C procedure \fBTcl_DoOneEvent\fR, then no connections
+will be accepted.
+
+.SH CONFIGURATION OPTIONS
+The \fBfconfigure\fR command can be used to query several readonly
+configuration options for socket channels:
+.TP
+\fB\-sockname\fR
+This option returns a list of three elements, the address, the host name
+and the port number for the socket. If the host name cannot be computed,
+the second element is identical to the address, the first element of the
+list.
+.TP
+\fB\-peername\fR
+This option is not supported by server sockets. For client and accepted
+sockets, this option returns a list of three elements; these are the
+address, the host name and the port to which the peer socket is connected
+or bound. If the host name cannot be computed, the second element of the
+list is identical to the address, its first element.
+.PP
+
+.SH "SEE ALSO"
+flush(n), open(n), read(n)
+
+.SH KEYWORDS
+bind, channel, connection, domain name, host, network address, socket, tcp
diff --git a/tcl/doc/source.n b/tcl/doc/source.n
new file mode 100644
index 00000000000..ba6449645d2
--- /dev/null
+++ b/tcl/doc/source.n
@@ -0,0 +1,44 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH source n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+source \- Evaluate a file or resource as a Tcl script
+.SH SYNOPSIS
+\fBsource \fIfileName\fR
+.sp
+\fBsource\fR \fB\-rsrc \fIresourceName \fR?\fIfileName\fR?
+.sp
+\fBsource\fR \fB\-rsrcid \fIresourceId \fR?\fIfileName\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command takes the contents of the specified file or resource
+and passes it to the Tcl interpreter as a text script.  The return
+value from \fBsource\fR is the return value of the last command
+executed in the script.  If an error occurs in evaluating the contents
+of the script then the \fBsource\fR command will return that error.
+If a \fBreturn\fR command is invoked from within the script then the
+remainder of the file will be skipped and the \fBsource\fR command
+will return normally with the result from the \fBreturn\fR command.
+
+The \fI\-rsrc\fR and \fI\-rsrcid\fR forms of this command are only
+available on Macintosh computers.  These versions of the command
+allow you to source a script from a \fBTEXT\fR resource.  You may specify
+what \fBTEXT\fR resource to source by either name or id.  By default Tcl
+searches all open resource files, which include the current
+application and any loaded C extensions.  Alternatively, you may
+specify the \fIfileName\fR where the \fBTEXT\fR resource can be found.
+
+.SH KEYWORDS
+file, script
diff --git a/tcl/doc/split.n b/tcl/doc/split.n
new file mode 100644
index 00000000000..4bea7897dc0
--- /dev/null
+++ b/tcl/doc/split.n
@@ -0,0 +1,44 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH split n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+split \- Split a string into a proper Tcl list
+.SH SYNOPSIS
+\fBsplit \fIstring \fR?\fIsplitChars\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Returns a list created by splitting \fIstring\fR at each character
+that is in the \fIsplitChars\fR argument.
+Each element of the result list will consist of the
+characters from \fIstring\fR that lie between instances of the
+characters in \fIsplitChars\fR.
+Empty list elements will be generated if \fIstring\fR contains
+adjacent characters in \fIsplitChars\fR, or if the first or last
+character of \fIstring\fR is in \fIsplitChars\fR.
+If \fIsplitChars\fR is an empty string then each character of
+\fIstring\fR becomes a separate element of the result list.
+\fISplitChars\fR defaults to the standard white-space characters.
+For example,
+.CS
+\fBsplit "comp.unix.misc" .\fR
+.CE
+returns \fB"comp unix misc"\fR and
+.CS
+\fBsplit "Hello world" {}\fR
+.CE
+returns \fB"H e l l o { } w o r l d"\fR.
+
+.SH KEYWORDS
+list, split, string
diff --git a/tcl/doc/string.n b/tcl/doc/string.n
new file mode 100644
index 00000000000..2b93d4c268b
--- /dev/null
+++ b/tcl/doc/string.n
@@ -0,0 +1,131 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH string n 7.6 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+string \- Manipulate strings
+.SH SYNOPSIS
+\fBstring \fIoption arg \fR?\fIarg ...?\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Performs one of several string operations, depending on \fIoption\fR.
+The legal \fIoption\fRs (which may be abbreviated) are:
+.TP
+\fBstring compare \fIstring1 string2\fR
+Perform a character-by-character comparison of strings \fIstring1\fR and
+\fIstring2\fR in the same way as the C \fBstrcmp\fR procedure.  Return
+\-1, 0, or 1, depending on whether \fIstring1\fR is lexicographically
+less than, equal to, or greater than \fIstring2\fR.
+.TP
+\fBstring first \fIstring1 string2\fR
+Search \fIstring2\fR for a sequence of characters that exactly match
+the characters in \fIstring1\fR.  If found, return the index of the
+first character in the first such match within \fIstring2\fR.  If not
+found, return \-1.
+.TP
+\fBstring index \fIstring charIndex\fR
+Returns the \fIcharIndex\fR'th character of the \fIstring\fR
+argument.  A \fIcharIndex\fR of 0 corresponds to the first
+character of the string.
+If \fIcharIndex\fR is less than 0 or greater than
+or equal to the length of the string then an empty string is
+returned.
+.TP
+\fBstring last \fIstring1 string2\fR
+Search \fIstring2\fR for a sequence of characters that exactly match
+the characters in \fIstring1\fR.  If found, return the index of the
+first character in the last such match within \fIstring2\fR.  If there
+is no match, then return \-1.
+.TP
+\fBstring length \fIstring\fR
+Returns a decimal string giving the number of characters in \fIstring\fR.
+.TP
+\fBstring match \fIpattern\fR \fIstring\fR
+See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0
+if it doesn't.  Matching is done in a fashion similar to that
+used by the C-shell.  For the two strings to match, their contents
+must be identical except that the following special sequences
+may appear in \fIpattern\fR:
+.RS
+.IP \fB*\fR 10
+Matches any sequence of characters in \fIstring\fR,
+including a null string.
+.IP \fB?\fR 10
+Matches any single character in \fIstring\fR.
+.IP \fB[\fIchars\fB]\fR 10
+Matches any character in the set given by \fIchars\fR.  If a sequence
+of the form
+\fIx\fB\-\fIy\fR appears in \fIchars\fR, then any character
+between \fIx\fR and \fIy\fR, inclusive, will match.
+.IP \fB\e\fIx\fR 10
+Matches the single character \fIx\fR.  This provides a way of
+avoiding the special interpretation of the characters
+\fB*?[]\e\fR in \fIpattern\fR.
+.RE
+.TP
+\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.  
+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
+\fIlast\fR then an empty string is returned.
+.TP
+\fBstring tolower \fIstring\fR
+Returns a value equal to \fIstring\fR except that all upper case
+letters have been converted to lower case.
+.TP
+\fBstring toupper \fIstring\fR
+Returns a value equal to \fIstring\fR except that all lower case
+letters have been converted to upper case.
+.TP
+\fBstring trim \fIstring\fR ?\fIchars\fR?
+Returns a value equal to \fIstring\fR except that any leading
+or trailing characters from the set given by \fIchars\fR are
+removed.
+If \fIchars\fR is not specified then white space is removed
+(spaces, tabs, newlines, and carriage returns).
+.TP
+\fBstring trimleft \fIstring\fR ?\fIchars\fR?
+Returns a value equal to \fIstring\fR except that any
+leading characters from the set given by \fIchars\fR are
+removed.
+If \fIchars\fR is not specified then white space is removed
+(spaces, tabs, newlines, and carriage returns).
+.TP
+\fBstring trimright \fIstring\fR ?\fIchars\fR?
+Returns a value equal to \fIstring\fR except that any
+trailing characters from the set given by \fIchars\fR are
+removed.
+If \fIchars\fR is not specified then white space is removed
+(spaces, tabs, newlines, and carriage returns).
+.TP
+\fBstring wordend \fIstring index\fR
+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
+or underscore characters, or any single character other than these.
+.TP
+\fBstring wordstart \fIstring index\fR
+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.
+
+.SH KEYWORDS
+case conversion, compare, index, match, pattern, string, word
diff --git a/tcl/doc/subst.n b/tcl/doc/subst.n
new file mode 100644
index 00000000000..9fd17112aa7
--- /dev/null
+++ b/tcl/doc/subst.n
@@ -0,0 +1,48 @@
+'\"
+'\" Copyright (c) 1994 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH subst n 7.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+subst \- Perform backslash, command, and variable substitutions
+.SH SYNOPSIS
+\fBsubst \fR?\fB\-nobackslashes\fR? ?\fB\-nocommands\fR? ?\fB\-novariables\fR? \fIstring\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command performs variable substitutions, command substitutions,
+and backslash substitutions on its \fIstring\fR argument and
+returns the fully-substituted result.
+The substitutions are performed in exactly the same way as for
+Tcl commands.
+As a result, the \fIstring\fR argument is actually substituted twice,
+once by the Tcl parser in the usual fashion for Tcl commands, and
+again by the \fIsubst\fR command.
+.PP
+If any of the \fB\-nobackslashes\fR, \fB\-nocommands\fR, or
+\fB\-novariables\fR are specified, then the corresponding substitutions
+are not performed.
+For example, if \fB\-nocommands\fR is specified, no command substitution
+is performed:  open and close brackets are treated as ordinary characters
+with no special interpretation.
+.PP
+Note: when it performs its substitutions, \fIsubst\fR does not
+give any special treatment to double quotes or curly braces.  For
+example, the script
+.CS
+\fBset a 44
+subst {xyz {$a}}\fR
+.CE
+returns ``\fBxyz {44}\fR'', not ``\fBxyz {$a}\fR''.
+
+.SH KEYWORDS
+backslash substitution, command substitution, variable substitution
diff --git a/tcl/doc/switch.n b/tcl/doc/switch.n
new file mode 100644
index 00000000000..c0aecfa369f
--- /dev/null
+++ b/tcl/doc/switch.n
@@ -0,0 +1,107 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH switch n 7.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+switch \- Evaluate one of several scripts, depending on a given value
+.SH SYNOPSIS
+\fBswitch \fR?\fIoptions\fR?\fI string pattern body \fR?\fIpattern body \fR...?
+.sp
+\fBswitch \fR?\fIoptions\fR?\fI string \fR{\fIpattern body \fR?\fIpattern body \fR...?}
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBswitch\fR command matches its \fIstring\fR argument against each of
+the \fIpattern\fR arguments in order.
+As soon as it finds a \fIpattern\fR that matches \fIstring\fR it
+evaluates the following \fIbody\fR argument by passing it recursively
+to the Tcl interpreter and returns the result of that evaluation.
+If the last \fIpattern\fR argument is \fBdefault\fR then it matches
+anything.
+If no \fIpattern\fR argument
+matches \fIstring\fR and no default is given, then the \fBswitch\fR
+command returns an empty string.
+.PP
+If the initial arguments to \fBswitch\fR start with \fB\-\fR then
+they are treated as options.  The following options are
+currently supported:
+.TP 10
+\fB\-exact\fR
+Use exact matching when comparing \fIstring\fR to a pattern.  This
+is the default.
+.TP 10
+\fB\-glob\fR
+When matching \fIstring\fR to the patterns, use glob-style matching
+(i.e. the same as implemented by the \fBstring match\fR command).
+.TP 10
+\fB\-regexp\fR
+When matching \fIstring\fR to the patterns, use regular
+expression matching
+(i.e. the same as implemented by the \fBregexp\fR command).
+.TP 10
+\fB\-\|\-\fR
+Marks the end of options.  The argument following this one will
+be treated as \fIstring\fR even if it starts with a \fB\-\fR.
+.PP
+Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
+The first uses a separate argument for each of the patterns and commands;
+this form is convenient if substitutions are desired on some of the
+patterns or commands.
+The second form places all of the patterns and commands together into
+a single argument; the argument must have proper list structure, with
+the elements of the list being the patterns and commands.
+The second form makes it easy to construct multi-line switch commands,
+since the braces around the whole list make it unnecessary to include a
+backslash at the end of each line.
+Since the \fIpattern\fR arguments are in braces in the second form,
+no command or variable substitutions are performed on them;  this makes
+the behavior of the second form different than the first form in some
+cases.
+.PP
+If a \fIbody\fR is specified as ``\fB\-\fR'' it means that the \fIbody\fR
+for the next pattern should also be used as the body for this
+pattern (if the next pattern also has a body of ``\fB\-\fR''
+then the body after that is used, and so on).
+This feature makes it possible to share a single \fIbody\fR among
+several patterns.
+.PP
+Below are some examples of \fBswitch\fR commands:
+.CS
+\fBswitch\0abc\0a\0\-\0b\0{format 1}\0abc\0{format 2}\0default\0{format 3}\fR
+.CE
+will return \fB2\fR, 
+.CS
+\fBswitch\0\-regexp\0aaab {
+	^a.*b$\0\-
+	b\0{format 1}
+	a*\0{format 2}
+	default\0{format 3}
+}\fR
+.CE
+will return \fB1\fR, and
+.CS
+\fBswitch\0xyz {
+	a
+		\-
+	b
+		{format 1}
+	a*
+		{format 2}
+	default
+		{format 3}
+}\fR
+.CE
+will return \fB3\fR.
+
+.SH KEYWORDS
+switch, match, regular expression
diff --git a/tcl/doc/tclsh.1 b/tcl/doc/tclsh.1
new file mode 100644
index 00000000000..a429d82e8dc
--- /dev/null
+++ b/tcl/doc/tclsh.1
@@ -0,0 +1,118 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH tclsh 1 "" Tcl "Tcl Applications"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+tclsh \- Simple shell containing Tcl interpreter
+.SH SYNOPSIS
+\fBtclsh\fR ?\fIfileName arg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTclsh\fR is a shell-like application that reads Tcl commands
+from its standard input or from a file and evaluates them.
+If invoked with no arguments then it runs interactively, reading
+Tcl commands from standard input and printing command results and
+error messages to standard output.
+It runs until the \fBexit\fR command is invoked or until it
+reaches end-of-file on its standard input.
+If there exists a file \fB.tclshrc\fR in the home directory of
+the user, \fBtclsh\fR evaluates the file as a Tcl script
+just before reading the first command from standard input.
+
+.SH "SCRIPT FILES"
+.PP
+If \fBtclsh\fR is invoked with arguments then the first argument
+is the name of a script file and any additional arguments
+are made available to the script as variables (see below).
+Instead of reading commands from standard input \fBtclsh\fR will
+read Tcl commands from the named file;  \fBtclsh\fR will exit
+when it reaches the end of the file.
+There is no automatic evaluation of \fB.tclshrc\fR in this
+case, but the script file can always \fBsource\fR it if desired.
+.PP
+If you create a Tcl script in a file whose first line is
+.CS
+\fB#!/usr/local/bin/tclsh\fR
+.CE
+then you can invoke the script file directly from your shell if
+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.
+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.
+.PP
+An even better approach is to start your script files with the
+following three lines:
+.CS
+\fB#!/bin/sh
+# the next line restarts using tclsh \e
+exec tclsh "$0" "$@"\fR
+.CE
+This approach has three advantages over the approach in the previous
+paragraph.  First, the location of the \fBtclsh\fR binary doesn't have
+to be hard-wired into the script:  it can be anywhere in your shell
+search path.  Second, it gets around the 30-character file name limit
+in the previous approach.
+Third, this approach will work even if \fBtclsh\fR is
+itself a shell script (this is done on some systems in order to
+handle multiple architectures or operating systems:  the \fBtclsh\fR
+script selects one of several binaries to run).  The three lines
+cause both \fBsh\fR and \fBtclsh\fR to process the script, but the
+\fBexec\fR is only executed by \fBsh\fR.
+\fBsh\fR processes the script first;  it treats the second
+line as a comment and executes the third line.
+The \fBexec\fR statement cause the shell to stop processing and
+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.
+
+.SH "VARIABLES"
+.PP
+\fBTclsh\fR sets the following Tcl variables:
+.TP 15
+\fBargc\fR
+Contains a count of the number of \fIarg\fR arguments (0 if none),
+not including the name of the script file.
+.TP 15
+\fBargv\fR
+Contains a Tcl list whose elements are the \fIarg\fR arguments,
+in order, or an empty string if there are no \fIarg\fR arguments.
+.TP 15
+\fBargv0\fR
+Contains \fIfileName\fR if it was specified.
+Otherwise, contains the name by which \fBtclsh\fR was invoked.
+.TP 15
+\fBtcl_interactive\fR
+Contains 1 if \fBtclsh\fR is running interactively (no
+\fIfileName\fR was specified and standard input is a terminal-like
+device), 0 otherwise.
+
+.SH PROMPTS
+.PP
+When \fBtclsh\fR is invoked interactively it normally prompts for each
+command with ``\fB% \fR''.  You can change the prompt by setting the
+variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR.  If variable
+\fBtcl_prompt1\fR exists then it must consist of a Tcl script
+to output a prompt;  instead of outputting a prompt \fBtclsh\fR
+will evaluate the script in \fBtcl_prompt1\fR.
+The variable \fBtcl_prompt2\fR is used in a similar way when
+a newline is typed but the current command isn't yet complete;
+if \fBtcl_prompt2\fR isn't set then no prompt is output for
+incomplete commands.
+
+.SH KEYWORDS
+argument, interpreter, prompt, script file, shell
diff --git a/tcl/doc/tclvars.n b/tcl/doc/tclvars.n
new file mode 100644
index 00000000000..a80ac3e6f8f
--- /dev/null
+++ b/tcl/doc/tclvars.n
@@ -0,0 +1,356 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+tclvars \- Variables used by Tcl
+.BE
+
+.SH DESCRIPTION
+.PP
+The following global variables are created and managed automatically
+by the Tcl library.  Except where noted below, these variables should
+normally be treated as read-only by application-specific code and by users.
+.TP
+\fBenv\fR
+This variable is maintained by Tcl as an array
+whose elements are the environment variables for the process.
+Reading an element will return the value of the corresponding
+environment variable.
+Setting an element of the array will modify the corresponding
+environment variable or create a new one if it doesn't already
+exist.
+Unsetting an element of \fBenv\fR will remove the corresponding
+environment variable.
+Changes to the \fBenv\fR array will affect the environment
+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
+.VS 8.0 
+Under Windows, the environment variables PATH and COMSPEC 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.
+.VE
+.RE
+.RS
+On the Macintosh, the environment variable is constructed by Tcl as no
+global environment variable exists.  The environment variables that
+are created for Tcl include:
+.TP
+\fBLOGIN\fR
+This holds the Chooser name of the Macintosh.
+.TP
+\fBUSER\fR
+This also holds the Chooser name of the Macintosh.
+.TP
+\fBSYS_FOLDER\fR
+The path to the system directory.
+.TP
+\fBAPPLE_M_FOLDER\fR
+The path to the Apple Menu directory.
+.TP
+\fBCP_FOLDER\fR
+The path to the control panels directory.
+.TP
+\fBDESK_FOLDER\fR
+The path to the desk top directory.
+.TP
+\fBEXT_FOLDER\fR
+The path to the system extensions directory.
+.TP
+\fBPREF_FOLDER\fR
+The path to the preferences directory.
+.TP
+\fBPRINT_MON_FOLDER\fR
+The path to the print monitor directory.
+.TP
+\fBSHARED_TRASH_FOLDER\fR
+The path to the network trash directory.
+.TP
+\fBTRASH_FOLDER\fR
+The path to the trash directory.
+.TP
+\fBSTART_UP_FOLDER\fR
+The path to the start up directory.
+.TP
+\fBPWD\fR
+The path to the application's default directory.
+.PP
+You can also create your own environment variables for the Macintosh.
+A file named  \fITcl Environment Variables\fR may be placed in the
+preferences folder in the Mac system folder.  Each line of this file
+should be of the form \fIVAR_NAME=var_data\fR.
+.PP
+The last alternative is to place environment variables in a 'STR#' 
+resource named \fITcl Environment Variables\fR of the application.  This
+is considered a little more ``Mac like'' than a Unix style Environment
+Variable file.  Each entry in the 'STR#' resource has the same format
+as above.  The source code file \fItclMacEnv.c\fR contains the
+implementation of the env mechanisms.  This file contains many
+#define's that allow customization of the env mechanisms to fit your
+applications needs.
+.RE
+.TP
+\fBerrorCode\fR
+After an error has occurred, this variable will be set to hold
+additional information about the error in a form that is easy
+to process with programs.
+\fBerrorCode\fR consists of a Tcl list with one or more elements.
+The first element of the list identifies a general class of
+errors, and determines the format of the rest of the list.
+The following formats for \fBerrorCode\fR are used by the
+Tcl core; individual applications may define additional formats.
+.RS
+.TP
+\fBARITH\fI code msg\fR
+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
+human-readable description of the error.  \fICode\fR will be either
+DIVZERO (for an attempt to divide by zero),
+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).
+.TP
+\fBCHILDKILLED\fI pid sigName msg\fR
+This format is used when a child process has been killed because of
+a signal.  The second element of \fBerrorCode\fR will be the
+process's identifier (in decimal).
+The third element will be the symbolic name of the signal that caused
+the process to terminate; it will be one of the names from the
+include file signal.h, such as \fBSIGPIPE\fR.
+The fourth element will be a short human-readable message
+describing the signal, such as ``write on pipe with no readers''
+for \fBSIGPIPE\fR.
+.TP
+\fBCHILDSTATUS\fI pid code\fR
+This format is used when a child process has exited with a non-zero
+exit status.  The second element of \fBerrorCode\fR will be the
+process's identifier (in decimal) and the third element will be the exit
+code returned by the process (also in decimal).
+.TP
+\fBCHILDSUSP\fI pid sigName msg\fR
+This format is used when a child process has been suspended because
+of a signal.
+The second element of \fBerrorCode\fR will be the process's identifier,
+in decimal.
+The third element will be the symbolic name of the signal that caused
+the process to suspend; this will be one of the names from the
+include file signal.h, such as \fBSIGTTIN\fR.
+The fourth element will be a short human-readable message
+describing the signal, such as ``background tty read''
+for \fBSIGTTIN\fR.
+.TP
+\fBNONE\fR
+This format is used for errors where no additional information is
+available for an error besides the message returned with the
+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
+If the first element of \fBerrorCode\fR is \fBPOSIX\fR, then
+the error occurred during a POSIX kernel call.
+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.
+The third element of the list will be a human-readable
+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 \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
+the next error.
+.RE
+.TP
+\fBerrorInfo\fR
+After an error has occurred, this string will contain one or more lines
+identifying the Tcl commands and procedures that were being executed
+when the most recent error occurred.
+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
+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 
+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
+\fB$\fIapp\fB_library\fR (where \fIapp\fR is the application's name)
+to hold the network file name for that application's library directory.
+The initial value of \fBtcl_library\fR is set when an interpreter
+is created by searching several different directories until one is
+found that contains an appropriate Tcl startup script.
+If the \fBTCL_LIBRARY\fR environment variable exists, then
+the directory it names is checked first.
+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.
+.TP
+\fBtcl_patchLevel\fR
+When an interpreter is created Tcl initializes this variable to
+hold a string giving the current patch level for Tcl, such as
+\fB7.3p2\fR for Tcl 7.3 with the first two official patches, or
+\fB7.4b4\fR for the fourth beta release of Tcl 7.4.
+The value of this variable is returned by the \fBinfo patchlevel\fR
+command.
+.VS 8.0 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
+the operating system, its current release number, and the machine's
+instruction set.  The elements listed below will always
+be defined, but they may have empty strings as values if Tcl couldn't
+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
+\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 \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.
+On UNIX machines, this is the value returned by \fBuname -r\fR.
+.TP
+\fBplatform\fR
+Either \fBwindows\fR, \fBmacintosh\fR, or \fBunix\fR.  This identifies the
+general operating environment of the machine.
+.RE
+.TP
+\fBtcl_precision\fR
+.VS
+This variable controls the number of digits to generate
+when converting floating-point values to strings.  It defaults
+to 12.
+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 information.  However, using 17 digits prevents
+any rounding, which produces longer, less intuitive results.  For example,
+\fBexpr 1.4\fR returns 1.3999999999999999 with \fBtcl_precision\fR
+set to 17, vs. 1.4 if \fBtcl_precision\fR is 12.
+.RS
+All interpreters in a process share a single \fBtcl_precision\fR value:
+changing it in one interpreter will affect all other interpreters as
+well.  However, safe interpreters are not allowed to modify the
+variable.
+.RE
+.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 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
+hold the version number for this version of Tcl in the form \fIx.y\fR.
+Changes to \fIx\fR represent major changes with probable
+incompatibilities and changes to \fIy\fR represent small enhancements and
+bug fixes that retain backward compatibility.
+The value of this variable is returned by the \fBinfo tclversion\fR
+command.
+
+.SH KEYWORDS
+arithmetic, bytecode, compiler, error, environment, POSIX, precision, subprocess, variables
diff --git a/tcl/doc/tell.n b/tcl/doc/tell.n
new file mode 100644
index 00000000000..f46cf9b06e6
--- /dev/null
+++ b/tcl/doc/tell.n
@@ -0,0 +1,28 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH tell n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+tell \- Return current access position for an open channel
+.SH SYNOPSIS
+\fBtell \fIchannelId\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Returns a decimal string giving the current access position in
+\fIchannelId\fR.
+The value returned is -1 for channels that do not support
+seeking.
+
+.SH KEYWORDS
+access position, channel, seeking
diff --git a/tcl/doc/time.n b/tcl/doc/time.n
new file mode 100644
index 00000000000..66ba27b2dc0
--- /dev/null
+++ b/tcl/doc/time.n
@@ -0,0 +1,33 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH time n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+time \- Time the execution of a script
+.SH SYNOPSIS
+\fBtime \fIscript\fR ?\fIcount\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command will call the Tcl interpreter \fIcount\fR
+times to evaluate \fIscript\fR (or once if \fIcount\fR isn't
+specified).  It will then return a string of the form
+.CS
+\fB503 microseconds per iteration\fR
+.CE
+which indicates the average amount of time required per iteration,
+in microseconds.
+Time is measured in elapsed time, not CPU time.
+
+.SH KEYWORDS
+script, time
diff --git a/tcl/doc/trace.n b/tcl/doc/trace.n
new file mode 100644
index 00000000000..ff3911dc032
--- /dev/null
+++ b/tcl/doc/trace.n
@@ -0,0 +1,158 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH trace n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+trace \- Monitor variable accesses
+.SH SYNOPSIS
+\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command causes Tcl commands to be executed whenever certain operations are
+invoked.  At present, only variable tracing is implemented. The
+legal \fIoption\fR's (which may be abbreviated) are:
+.TP
+\fBtrace variable \fIname ops command\fR
+Arrange for \fIcommand\fR to be executed whenever variable \fIname\fR
+is accessed in one of the ways given by \fIops\fR.  \fIName\fR may
+refer to a normal variable, an element of an array, or to an array
+as a whole (i.e. \fIname\fR may be just the name of an array, with no
+parenthesized index).  If \fIname\fR refers to a whole array, then
+\fIcommand\fR is invoked whenever any element of the array is
+manipulated.
+.RS
+.PP
+\fIOps\fR indicates which operations are of interest, and consists of
+one or more of the following letters:
+.TP
+\fBr\fR
+Invoke \fIcommand\fR whenever the variable is read.
+.TP
+\fBw\fR
+Invoke \fIcommand\fR whenever the variable is written.
+.TP
+\fBu\fR
+Invoke \fIcommand\fR whenever the variable is unset.  Variables
+can be unset explicitly with the \fBunset\fR command, or
+implicitly when procedures return (all of their local variables
+are unset).  Variables are also unset when interpreters are
+deleted, but traces will not be invoked because there is no
+interpreter in which to execute them.
+.PP
+When the trace triggers, three arguments are appended to
+\fIcommand\fR so that the actual command is as follows:
+.CS
+\fIcommand name1 name2 op\fR
+.CE
+\fIName1\fR and \fIname2\fR give the name(s) for the variable
+being accessed:  if the variable is a scalar then \fIname1\fR
+gives the variable's name and \fIname2\fR is an empty string;
+if the variable is an array element then \fIname1\fR gives the
+name of the array and name2 gives the index into the array;
+if an entire array is being deleted and the trace was registered
+on the overall array, rather than a single element, then \fIname1\fR
+gives the array name and \fIname2\fR is an empty string.
+\fIName1\fR and \fIname2\fR are not necessarily the same as the
+name used in the \fBtrace variable\fR command:  the \fBupvar\fR
+command allows a procedure to reference a variable under a
+different name.
+\fIOp\fR indicates what operation is being performed on the
+variable, and is one of \fBr\fR, \fBw\fR, or \fBu\fR as
+defined above.
+.PP
+\fICommand\fR executes in the same context as the code that invoked
+the traced operation:  if the variable was accessed as part of a
+Tcl procedure, then \fIcommand\fR will have access to the same
+local variables as code in the procedure.  This context may be
+different than the context in which the trace was created.
+If \fIcommand\fR invokes a procedure (which it normally does) then
+the procedure will have to use \fBupvar\fR or \fBuplevel\fR if it
+wishes to access the traced variable.
+Note also that \fIname1\fR may not necessarily be the same as the name
+used to set the trace on the variable;  differences can occur if
+the access is made through a variable defined with the \fBupvar\fR
+command.
+.PP
+For read and write traces, \fIcommand\fR can modify
+the variable to affect the result of the traced operation.
+If \fIcommand\fR modifies the value of a variable during a
+read or write trace, then the new value will be returned as the
+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
+the same error message returned by the trace command
+(this mechanism can be used to implement read-only variables, for
+example).
+For write traces, \fIcommand\fR is invoked after the variable's
+value has been changed; it can write a new value into the variable
+to override the original value specified in the write operation.
+To implement read-only variables, \fIcommand\fR will have to restore
+the old value of the variable.
+.PP
+While \fIcommand\fR is executing during a read or write trace, traces
+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.
+However, if \fIcommand\fR unsets the variable then unset traces
+will be invoked.
+.PP
+When an unset trace is invoked, the variable has already been
+deleted:  it will appear to be undefined with no traces.
+If an unset occurs because of a procedure return, then the
+trace will be invoked in the variable context of the procedure
+being returned to:  the stack frame of the returning procedure
+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.
+Any errors in unset traces are ignored.
+.PP
+If there are multiple traces on a variable they are invoked
+in order of creation, most-recent first.
+If one trace returns an error, then no further traces are
+invoked for the variable.
+If an array element has a trace set, and there is also a trace
+set on the array as a whole, the trace on the overall array
+is invoked before the one on the element.
+.PP
+Once created, the trace remains in effect either until the
+trace is removed with the \fBtrace vdelete\fR command described
+below, until the variable is unset, or until the interpreter
+is deleted.
+Unsetting an element of array will remove any traces on that
+element, but will not remove traces on the overall array.
+.PP
+This command returns an empty string.
+.RE
+.TP
+\fBtrace vdelete \fIname ops command\fR
+If there is a trace set on variable \fIname\fR with the
+operations and command given by \fIops\fR and \fIcommand\fR,
+then the trace is removed, so that \fIcommand\fR will never
+again be invoked.
+Returns an empty string.
+.TP
+\fBtrace vinfo \fIname\fR
+Returns a list containing one element for each trace
+currently set on variable \fIname\fR.
+Each element of the list is itself a list containing two
+elements, which are the \fIops\fR and \fIcommand\fR associated
+with the trace.
+If \fIname\fR doesn't exist or doesn't have any traces set, then
+the result of the command will be an empty string.
+
+.SH KEYWORDS
+read, variable, write, trace, unset
diff --git a/tcl/doc/unknown.n b/tcl/doc/unknown.n
new file mode 100644
index 00000000000..3bf1ad2b09a
--- /dev/null
+++ b/tcl/doc/unknown.n
@@ -0,0 +1,75 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH unknown n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+unknown \- Handle attempts to use non-existent commands
+.SH SYNOPSIS
+\fBunknown \fIcmdName \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is invoked by the Tcl interpreter whenever a script
+tries to invoke a command that doesn't exist.  The implementation
+of \fBunknown\fR isn't part of the Tcl core;  instead, it is a
+library procedure defined by default when Tcl starts up.  You
+can override the default \fBunknown\fR to change its functionality.
+.PP
+If the Tcl interpreter encounters a command name for which there
+is not a defined command, then Tcl checks for the existence of
+a command named \fBunknown\fR.
+If there is no such command, then the interpreter returns an
+error.
+If the \fBunknown\fR command exists, then it is invoked with
+arguments consisting of the fully-substituted name and arguments
+for the original non-existent command.
+The \fBunknown\fR command typically does things like searching
+through library directories for a command procedure with the name
+\fIcmdName\fR, or expanding abbreviated command names to full-length,
+or automatically executing unknown commands as sub-processes.
+In some cases (such as expanding abbreviations) \fBunknown\fR will
+change the original command slightly and then (re-)execute it.
+The result of the \fBunknown\fR command is used as the result for
+the original non-existent command.
+.PP
+The default implementation of \fBunknown\fR behaves as follows.
+It first calls the \fBauto_load\fR library procedure to load the command.
+If this succeeds, then it executes the original command with its
+original arguments.
+If the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR
+to see if there is an executable file by the name \fIcmd\fR.
+If so, it invokes the Tcl \fBexec\fR command
+with \fIcmd\fR and all the \fIargs\fR as arguments.
+If \fIcmd\fR can't be auto-executed, \fBunknown\fR checks to
+see if the command was invoked at top-level and outside of any
+script.  If so, then \fBunknown\fR takes two additional steps.
+First, it sees if \fIcmd\fR has one of the following three forms:
+\fB!!\fR, \fB!\fIevent\fR, or \fB^\fIold\fB^\fInew\fR?\fB^\fR?.
+If so, then \fBunknown\fR carries out history substitution
+in the same way that \fBcsh\fR would for these constructs.
+Finally, \fBunknown\fR checks to see if \fIcmd\fR is
+a unique abbreviation for an existing Tcl command.
+If so, it expands the command name and executes the command with
+the original arguments.
+If none of the above efforts has been able to execute
+the command, \fBunknown\fR generates an error return.
+If the global variable \fBauto_noload\fR is defined, then the auto-load
+step is skipped.
+If the global variable \fBauto_noexec\fR is defined then the
+auto-exec step is skipped.
+Under normal circumstances the return value from \fBunknown\fR
+is the return value from the command that was eventually
+executed.
+
+.SH KEYWORDS
+error, non-existent command
diff --git a/tcl/doc/unset.n b/tcl/doc/unset.n
new file mode 100644
index 00000000000..94ac4ef2e9d
--- /dev/null
+++ b/tcl/doc/unset.n
@@ -0,0 +1,34 @@
+'\"
+'\" Copyright (c) 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH unset n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+unset \- Delete variables
+.SH SYNOPSIS
+\fBunset \fIname \fR?\fIname name ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command removes one or more variables.
+Each \fIname\fR is a variable name, specified in any of the
+ways acceptable to the \fBset\fR command.
+If a \fIname\fR refers to an element of an array then that
+element is removed without affecting the rest of the array.
+If a \fIname\fR consists of an array name with no parenthesized
+index, then the entire array is deleted.
+The \fBunset\fR command returns an empty string as result.
+An error occurs if any of the variables doesn't exist, and any variables
+after the non-existent one are not deleted.
+
+.SH KEYWORDS
+remove, variable
diff --git a/tcl/doc/update.n b/tcl/doc/update.n
new file mode 100644
index 00000000000..27484e4d6d8
--- /dev/null
+++ b/tcl/doc/update.n
@@ -0,0 +1,48 @@
+'\"
+'\" Copyright (c) 1990-1992 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH update n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+update \- Process pending events and idle callbacks
+.SH SYNOPSIS
+\fBupdate\fR ?\fBidletasks\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is used to bring the application ``up to date''
+by entering the event loop repeated until all pending events
+(including idle callbacks) have been processed.
+.PP
+If the \fBidletasks\fR keyword is specified as an argument to the
+command, then no new events or errors are processed;  only idle
+callbacks are invoked.
+This causes operations that are normally deferred, such as display
+updates and window layout calculations, to be performed immediately.
+.PP
+The \fBupdate idletasks\fR command is useful in scripts where
+changes have been made to the application's state and you want those
+changes to appear on the display immediately, rather than waiting
+for the script to complete.  Most display updates are performed as
+idle callbacks, so \fBupdate idletasks\fR will cause them to run.
+However, there are some kinds of updates that only happen in
+response to events, such as those triggered by window size changes;
+these updates will not occur in \fBupdate idletasks\fR.
+.PP
+The \fBupdate\fR command with no options is useful in scripts where
+you are performing a long-running computation but you still want
+the application to respond to events such as user interactions;  if
+you occasionally call \fBupdate\fR then user input will be processed
+during the next call to \fBupdate\fR.
+
+.SH KEYWORDS
+event, flush, handler, idle, update
diff --git a/tcl/doc/uplevel.n b/tcl/doc/uplevel.n
new file mode 100644
index 00000000000..8dd64288cc7
--- /dev/null
+++ b/tcl/doc/uplevel.n
@@ -0,0 +1,80 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH uplevel n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+uplevel \- Execute a script in a different stack frame
+.SH SYNOPSIS
+\fBuplevel \fR?\fIlevel\fR?\fI arg \fR?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+All of the \fIarg\fR arguments are concatenated as if they had
+been passed to \fBconcat\fR; the result is then evaluated in the
+variable context indicated by \fIlevel\fR.  \fBUplevel\fR returns
+the result of that evaluation.
+.PP
+If \fIlevel\fR is an integer then
+it gives a distance (up the procedure calling stack) to move before
+executing the command.  If \fIlevel\fR consists of \fB#\fR followed by
+a number then the number gives an absolute level number.  If \fIlevel\fR
+is omitted then it defaults to \fB1\fR.  \fILevel\fR cannot be
+defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
+.PP
+For example, suppose that procedure \fBa\fR was invoked
+from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
+Suppose that \fBc\fR invokes the \fBuplevel\fR command.  If \fIlevel\fR
+is \fB1\fR or \fB#2\fR  or omitted, then the command will be executed
+in the variable context of \fBb\fR.  If \fIlevel\fR is \fB2\fR or \fB#1\fR
+then the command will be executed in the variable context of \fBa\fR.
+If \fIlevel\fR is \fB3\fR or \fB#0\fR then the command will be executed
+at top-level (only global variables will be visible).
+.PP
+The \fBuplevel\fR command causes the invoking procedure to disappear
+from the procedure calling stack while the command is being executed.
+In the above example, suppose \fBc\fR invokes the command
+.CS
+\fBuplevel 1 {set x 43; d}\fR
+.CE
+where \fBd\fR is another Tcl procedure.  The \fBset\fR command will
+modify the variable \fBx\fR in \fBb\fR's context, and \fBd\fR will execute
+at level 3, as if called from \fBb\fR.  If it in turn executes
+the command
+.CS
+\fBuplevel {set x 42}\fR
+.CE
+then the \fBset\fR command will modify the same variable \fBx\fR in \fBb\fR's
+context:  the procedure \fBc\fR does not appear to be on the call stack
+when \fBd\fR is executing.  The command ``\fBinfo level\fR'' may
+be used to obtain the level of the current procedure.
+.PP
+\fBUplevel\fR makes it possible to implement new control
+constructs as Tcl procedures (for example, \fBuplevel\fR could
+be used to implement the \fBwhile\fR construct as a Tcl procedure).
+.PP
+\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).
+
+.SH "SEE ALSO"
+namespace(n)
+
+.SH KEYWORDS
+context, level, namespace, stack frame, variables
diff --git a/tcl/doc/upvar.n b/tcl/doc/upvar.n
new file mode 100644
index 00000000000..35c1daa9d44
--- /dev/null
+++ b/tcl/doc/upvar.n
@@ -0,0 +1,92 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH upvar n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+upvar \- Create link to variable in a different stack frame
+.SH SYNOPSIS
+\fBupvar \fR?\fIlevel\fR? \fIotherVar myVar \fR?\fIotherVar myVar \fR...?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command arranges for one or more local variables in the current
+procedure to refer to variables in an enclosing procedure call or
+to global variables.
+\fILevel\fR may have any of the forms permitted for the \fBuplevel\fR
+command, and may be omitted if the first letter of the first \fIotherVar\fR
+isn't \fB#\fR or a digit (it defaults to \fB1\fR).
+For each \fIotherVar\fR argument, \fBupvar\fR makes the variable
+by that name in the procedure frame given by \fIlevel\fR (or at
+global level, if \fIlevel\fR is \fB#0\fR) accessible
+in the current procedure by the name given in the corresponding
+\fImyVar\fR argument.
+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.
+\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.
+\fBUpvar\fR returns an empty string.
+.PP
+The \fBupvar\fR command simplifies the implementation of call-by-name
+procedure calling and also makes it easier to build new control constructs
+as Tcl procedures.
+For example, consider the following procedure:
+.CS
+\fBproc add2 name {
+	upvar $name x
+	set x [expr $x+2]
+}\fR
+.CE
+\fBAdd2\fR is invoked with an argument giving the name of a variable,
+and it adds two to the value of that variable.
+Although \fBadd2\fR could have been implemented using \fBuplevel\fR
+instead of \fBupvar\fR, \fBupvar\fR makes it simpler for \fBadd2\fR
+to access the variable in the caller's procedure frame.
+.PP
+\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).
+.PP
+.VS
+If an upvar variable is unset (e.g. \fBx\fR in \fBadd2\fR above), the
+\fBunset\fR operation affects the variable it is linked to, not the
+upvar variable.  There is no way to unset an upvar variable except
+by exiting the procedure in which it is defined.  However, it is
+possible to retarget an upvar variable by executing another \fBupvar\fR
+command.
+
+.SH BUGS
+.PP
+If \fIotherVar\fR refers to an element of an array, then variable
+traces set for the entire array will not be invoked when \fImyVar\fR
+is accessed (but traces on the particular element will still be
+invoked).  In particular, if the array is \fBenv\fR, then changes
+made to \fImyVar\fR will not be passed to subprocesses correctly.
+.VE
+
+.SH "SEE ALSO"
+namespace(n)
+
+.SH KEYWORDS
+context, frame, global, level, namespace, procedure, variable
diff --git a/tcl/doc/variable.n b/tcl/doc/variable.n
new file mode 100644
index 00000000000..8b7aae0d9ec
--- /dev/null
+++ b/tcl/doc/variable.n
@@ -0,0 +1,63 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.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.
+In this case, if \fIvalue\fR is specified,
+it is assigned to the newly created variable.
+If no \fIvalue\fR is specified, the new variable is left undefined.
+If the variable already exists,
+it is set to \fIvalue\fR if \fIvalue\fR is specified
+or left unchanged if no \fIvalue\fR is given.
+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.
+
+.SH "SEE ALSO"
+global(n), namespace(n)
+
+.SH KEYWORDS
+global, namespace, procedure, variable
diff --git a/tcl/doc/vwait.n b/tcl/doc/vwait.n
new file mode 100644
index 00000000000..66a498ec59d
--- /dev/null
+++ b/tcl/doc/vwait.n
@@ -0,0 +1,38 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH vwait n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+vwait \- Process events until a variable is written
+.SH SYNOPSIS
+\fBvwait\fR \fIvarName\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command enters the Tcl event loop to process events, blocking
+the application if no events are ready.  It continues processing
+events until some event handler sets the value of variable
+\fIvarName\fR.  Once \fIvarName\fR has been set, the \fBvwait\fR
+command will return as soon as the event handler that modified
+\fIvarName\fR completes.
+.PP
+In some cases the \fBvwait\fR command may not return immediately
+after \fIvarName\fR is set.  This can happen if the event handler
+that sets \fIvarName\fR does not complete immediately.  For example,
+if an event handler sets \fIvarName\fR and then itself calls
+\fBvwait\fR to wait for a different variable, then it may not return
+for a long time.  During this time the top-level \fBvwait\fR is
+blocked waiting for the event handler to complete, so it cannot
+return either.
+
+.SH KEYWORDS
+event, variable, wait
diff --git a/tcl/doc/while.n b/tcl/doc/while.n
new file mode 100644
index 00000000000..ddac08573ad
--- /dev/null
+++ b/tcl/doc/while.n
@@ -0,0 +1,55 @@
+'\"
+'\" 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.
+'\" 
+'\" RCS: @(#) $Id$
+'\" 
+.so man.macros
+.TH while n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+while \- Execute script repeatedly as long as a condition is met
+.SH SYNOPSIS
+\fBwhile \fItest body\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+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
+then \fIbody\fR is executed by passing it to the Tcl interpreter.
+Once \fIbody\fR has been executed then \fItest\fR is evaluated
+again, and the process repeats until eventually \fItest\fR
+evaluates to a false boolean value.  \fBContinue\fR
+commands may be executed inside \fIbody\fR to terminate the current
+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/tcl/generic/README b/tcl/generic/README
new file mode 100644
index 00000000000..b7d94230b29
--- /dev/null
+++ b/tcl/generic/README
@@ -0,0 +1,5 @@
+This directory contains Tcl source files that work on all the platforms
+where Tcl runs (e.g. UNIX, PCs, and Macintoshes).  Platform-specific
+sources are in the directories ../unix, ../win, and ../mac.
+
+RCS: @(#) $Id$
diff --git a/tcl/generic/tcl.h b/tcl/generic/tcl.h
new file mode 100644
index 00000000000..c0569829f8b
--- /dev/null
+++ b/tcl/generic/tcl.h
@@ -0,0 +1,1567 @@
+/*
+ * tcl.h --
+ *
+ *	This header file describes the externally-visible facilities
+ *	of the Tcl interpreter.
+ *
+ * Copyright (c) 1987-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1996 Lucent Technologies.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCL
+#define _TCL
+
+/*
+ * When version numbers change here, must also go into the following files
+ * and update the version numbers:
+ *
+ * README
+ * library/init.tcl	(only if major.minor changes, not patchlevel)
+ * unix/configure.in
+ * win/makefile.bc	(only if major.minor changes, not patchlevel)
+ * win/makefile.vc	(only if major.minor changes, not patchlevel)
+ * win/README
+ * win/README.binary
+ *
+ * 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   2
+#define TCL_RELEASE_SERIAL  4
+
+#define TCL_VERSION	    "8.0"
+#define TCL_PATCH_LEVEL	    "8.0.4"
+
+/*
+ * The following definitions set up the proper options for Windows
+ * compilers.  We use this method because there is no autoconf equivalent.
+ */
+
+#ifndef __WIN32__
+#   if defined(_WIN32) || defined(WIN32)
+#	define __WIN32__
+#   endif
+#endif
+
+#ifdef __WIN32__
+#   ifndef STRICT
+#	define STRICT
+#   endif
+#   ifndef USE_PROTOTYPE
+#	define USE_PROTOTYPE 1
+#   endif
+#   ifndef HAS_STDARG
+#	define HAS_STDARG 1
+#   endif
+#   ifndef USE_PROTOTYPE
+#	define USE_PROTOTYPE 1
+#   endif
+#   ifndef USE_TCLALLOC
+#	define USE_TCLALLOC 1
+#   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
+
+/*
+ * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
+ * quotation marks), JOIN joins two arguments.
+ */
+
+#define VERBATIM(x) x
+#ifdef _MSC_VER
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+# define JOIN(a,b) JOIN1(a,b)
+# define JOIN1(a,b) a##b
+#else
+# ifdef RESOURCE_INCLUDED
+#  define STRINGIFY(x) STRINGIFY1(x)
+#  define STRINGIFY1(x) #x
+#  define JOIN(a,b) JOIN1(a,b)
+#  define JOIN1(a,b) a##b
+# else
+#  ifdef __STDC__
+#   define STRINGIFY(x) #x
+#   define JOIN(a,b) a##b
+#  else
+#   define STRINGIFY(x) "x"
+#   define JOIN(a,b) VERBATIM(a)VERBATIM(b)
+#  endif
+# 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
+
+/*
+ * Definitions that allow Tcl functions with variable numbers of
+ * arguments to be used with either varargs.h or stdarg.h.  TCL_VARARGS
+ * is used in procedure prototypes.  TCL_VARARGS_DEF is used to declare
+ * the arguments in a function definiton: it takes the type and name of
+ * the first argument and supplies the appropriate argument declaration
+ * string for use in the function definition.  TCL_VARARGS_START
+ * initializes the va_list data structure and returns the first argument.
+ */
+
+#if defined(__STDC__) || defined(HAS_STDARG)
+#   define TCL_VARARGS(type, name) (type name, ...)
+#   define TCL_VARARGS_DEF(type, name) (type name, ...)
+#   define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
+#else
+#   ifdef __cplusplus
+#	define TCL_VARARGS(type, name) (type name, ...)
+#	define TCL_VARARGS_DEF(type, name) (type va_alist, ...)
+#   else
+#	define TCL_VARARGS(type, name) ()
+#	define TCL_VARARGS_DEF(type, name) (va_alist)
+#   endif
+#   define TCL_VARARGS_START(type, name, list) \
+	(va_start(list), va_arg(list, type))
+#endif
+
+/*
+ * Macros used to declare a function to be exported by a DLL.
+ * Used by Windows, maps to no-op declarations on non-Windows systems.
+ * The default build on windows is for a DLL, which causes the DLLIMPORT
+ * and DLLEXPORT macros to be nonempty. To build a static library, the
+ * macro STATIC_BUILD should be defined.
+ * The support follows the convention that a macro called BUILD_xxxx, where
+ * xxxx is the name of a library we are building, is set on the compile line
+ * for sources that are to be placed in the library. See BUILD_tcl in this
+ * file for an example of how the macro is to be used.
+ */
+
+#ifdef __WIN32__
+# ifdef STATIC_BUILD
+#  define DLLIMPORT
+#  define DLLEXPORT
+# else
+#  ifdef _MSC_VER
+#   define DLLIMPORT __declspec(dllimport)
+#   define DLLEXPORT __declspec(dllexport)
+#  else
+#   define DLLIMPORT
+#   define DLLEXPORT
+#  endif
+# endif
+#else
+# define DLLIMPORT
+# define DLLEXPORT
+#endif
+
+#ifdef TCL_STORAGE_CLASS
+# undef TCL_STORAGE_CLASS
+#endif
+#ifdef BUILD_tcl
+# define TCL_STORAGE_CLASS DLLEXPORT
+#else
+# define TCL_STORAGE_CLASS DLLIMPORT
+#endif
+
+/*
+ * Definitions that allow this header file to be used either with or
+ * without ANSI C features like function prototypes.
+ */
+
+#undef _ANSI_ARGS_
+#undef CONST
+
+#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE)
+#   define _USING_PROTOTYPES_ 1
+#   define _ANSI_ARGS_(x)	x
+#   define CONST const
+#else
+#   define _ANSI_ARGS_(x)	()
+#   define CONST
+#endif
+
+#ifdef __cplusplus
+#   define EXTERN extern "C" TCL_STORAGE_CLASS
+#else
+#   define EXTERN extern TCL_STORAGE_CLASS
+#endif
+
+/*
+ * Macro to use instead of "void" for arguments that must have
+ * type "void *" in ANSI C;  maps them to type "char *" in
+ * non-ANSI systems.
+ */
+#ifndef __WIN32__
+#ifndef VOID
+#   ifdef __STDC__
+#       define VOID void
+#   else
+#       define VOID char
+#   endif
+#endif
+#else /* __WIN32__ */
+/*
+ * The following code is copied from winnt.h
+ */
+#ifndef VOID
+#define VOID void
+typedef char CHAR;
+typedef short SHORT;
+typedef long LONG;
+#endif
+#endif /* __WIN32__ */
+
+/*
+ * Miscellaneous declarations.
+ */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+#ifndef _CLIENTDATA
+#   if defined(__STDC__) || defined(__cplusplus)
+    typedef void *ClientData;
+#   else
+    typedef int *ClientData;
+#   endif /* __STDC__ */
+#define _CLIENTDATA
+#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 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;		/* If the last command returned a string
+				 * result, this points to it. */
+    void (*freeProc) _ANSI_ARGS_((char *blockPtr));
+				/* 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_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 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; the interpreter's
+ *			result contains	the command's result.
+ * TCL_ERROR		The command couldn't be completed successfully;
+ *			the interpreter's result describes what went wrong.
+ * TCL_RETURN		The command requests that the current procedure
+ *			return; the interpreter's result contains the
+ *			procedure's return value.
+ * TCL_BREAK		The command requests that the innermost loop
+ *			be exited; the interpreter's result is meaningless.
+ * TCL_CONTINUE		Go on to the next iteration of the current loop;
+ *			the interpreter's result is meaningless.
+ */
+
+#define TCL_OK		0
+#define TCL_ERROR	1
+#define TCL_RETURN	2
+#define TCL_BREAK	3
+#define TCL_CONTINUE	4
+
+#define TCL_RESULT_SIZE 200
+
+/*
+ * Argument descriptors for math function callbacks in expressions:
+ */
+
+typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType;
+typedef struct Tcl_Value {
+    Tcl_ValueType type;		/* Indicates intValue or doubleValue is
+				 * valid, or both. */
+    long intValue;		/* Integer value. */
+    double doubleValue;		/* Double-precision floating 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:
+ */
+
+typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int code));
+typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
+typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
+typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int argc, char *argv[]));
+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));
+typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr,
+        ClientData clientData));
+typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
+	int flags));
+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 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.
+ */
+
+EXTERN void		Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN void		Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN int		Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+#ifdef TCL_MEM_DEBUG
+#   define Tcl_IncrRefCount(objPtr) \
+	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
+#   define Tcl_DecrRefCount(objPtr) \
+	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+#   define Tcl_IsShared(objPtr) \
+	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
+#else
+#   define Tcl_IncrRefCount(objPtr) \
+	++(objPtr)->refCount
+#   define Tcl_DecrRefCount(objPtr) \
+	if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr)
+#   define Tcl_IsShared(objPtr) \
+	((objPtr)->refCount > 1)
+#endif
+
+/*
+ * 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_GetCommandInfo and
+ * passed to Tcl_SetCommandInfo. 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 {
+    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;
+
+/*
+ * The structure defined below is used to hold dynamic strings.  The only
+ * field that clients should use is the string field, and they should
+ * never modify it.
+ */
+
+#define TCL_DSTRING_STATIC_SIZE 200
+typedef struct Tcl_DString {
+    char *string;		/* Points to beginning of string:  either
+				 * 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
+				 * string and its terminating NULL char. */
+    char staticSpace[TCL_DSTRING_STATIC_SIZE];
+				/* Space to use in common case where string
+				 * is small. */
+} Tcl_DString;
+
+#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
+#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
+#define Tcl_DStringTrunc Tcl_DStringSetLength
+
+/*
+ * Definitions for the maximum number of digits of precision that may
+ * 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)
+
+/*
+ * Flag that may be passed to Tcl_ConvertElement to force it not to
+ * output braces (careful!  if you change this flag be sure to change
+ * the definitions at the front of tclUtil.c).
+ */
+
+#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!!
+ */
+
+#define TCL_NO_EVAL		0x10000
+#define TCL_EVAL_GLOBAL		0x20000
+
+/*
+ * Special freeProc values that may be passed to Tcl_SetResult (see
+ * the man page for details):
+ */
+
+#define TCL_VOLATILE	((Tcl_FreeProc *) 1)
+#define TCL_STATIC	((Tcl_FreeProc *) 0)
+#define TCL_DYNAMIC	((Tcl_FreeProc *) 3)
+
+/*
+ * Flag values passed to variable-related procedures.
+ */
+
+#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:
+ */
+
+#define TCL_LINK_INT		1
+#define TCL_LINK_DOUBLE		2
+#define TCL_LINK_BOOLEAN	3
+#define TCL_LINK_STRING		4
+#define TCL_LINK_READ_ONLY	0x80
+
+/*
+ * The following declarations either map ckalloc and ckfree to
+ * malloc and free, or they map them to procedures with all sorts
+ * of debugging hooks defined in tclCkalloc.c.
+ */
+
+EXTERN char *		Tcl_Alloc _ANSI_ARGS_((unsigned int size));
+EXTERN void		Tcl_Free _ANSI_ARGS_((char *ptr));
+EXTERN char *		Tcl_Realloc _ANSI_ARGS_((char *ptr,
+			    unsigned int size));
+
+#ifdef TCL_MEM_DEBUG
+
+#  define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+#  define Tcl_Free(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
+#  define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
+#  define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+
+EXTERN int		Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
+EXTERN void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
+			    int line));
+
+#else
+
+/* CYGNUS LOCAL: Always use TCLALLOC.  This means that calls to malloc
+   will always be checked to make sure that malloc succeeded.
+
+   NOTE: In tcl8.1a2, the definition of TclpAlloc was removed from
+   unix/tclUnixPort.h.  That means that in tcl8.1a2, this will wind up
+   calling the special allocator in tclAlloc.c, which would be bad.
+   When tcl 8.1 is imported, this needs to be checked.  */
+#ifndef USE_TCLALLOC
+#define USE_TCLALLOC 1
+#endif
+/* END CYGNUS LOCAL */
+
+#  if USE_TCLALLOC
+#     define ckalloc(x) Tcl_Alloc(x)
+#     define ckfree(x) Tcl_Free(x)
+#     define ckrealloc(x,y) Tcl_Realloc(x,y)
+#  else
+#     define ckalloc(x) malloc(x)
+#     define ckfree(x)  free(x)
+#     define ckrealloc(x,y) realloc(x,y)
+#  endif
+#  define Tcl_DumpActiveMemory(x)
+#  define Tcl_ValidateAllMemory(x,y)
+
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * 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.
+ */
+
+#ifdef __cplusplus
+struct Tcl_HashTable;
+#endif
+
+/*
+ * Structure definition for an entry in a hash table.  No-one outside
+ * Tcl should access any of these fields directly;  use the macros
+ * defined below.
+ */
+
+typedef struct Tcl_HashEntry {
+    struct Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this
+					 * hash bucket, or NULL for end of
+					 * chain. */
+    struct Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
+    struct Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to
+					 * first entry in this entry's chain:
+					 * used for deleting the entry. */
+    ClientData clientData;		/* Application stores something here
+					 * with Tcl_SetHashValue. */
+    union {				/* Key has one of these forms: */
+	char *oneWordValue;		/* One-word value for key. */
+	int words[1];			/* Multiple integer words for key.
+					 * The actual size will be as large
+					 * as necessary for this table's
+					 * keys. */
+	char string[4];			/* String for key.  The actual size
+					 * will be as large as needed to hold
+					 * the key. */
+    } key;				/* MUST BE LAST FIELD IN RECORD!! */
+} Tcl_HashEntry;
+
+/*
+ * Structure definition for a hash table.  Must be in tcl.h so clients
+ * can allocate space for these structures, but clients should never
+ * access any fields in this structure.
+ */
+
+#define TCL_SMALL_HASH_TABLE 4
+typedef struct Tcl_HashTable {
+    Tcl_HashEntry **buckets;		/* Pointer to bucket array.  Each
+					 * element points to first entry in
+					 * bucket's hash chain, or NULL. */
+    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
+					/* Bucket array used for small tables
+					 * (to avoid mallocs and frees). */
+    int numBuckets;			/* Total number of buckets allocated
+					 * at **bucketPtr. */
+    int numEntries;			/* Total number of entries present
+					 * in table. */
+    int rebuildSize;			/* Enlarge table when numEntries gets
+					 * to be this large. */
+    int downShift;			/* Shift count used in hashing
+					 * function.  Designed to use high-
+					 * order bits of randomized keys. */
+    int mask;				/* Mask value used in hashing
+					 * function. */
+    int keyType;			/* Type of keys used in this table. 
+					 * It's either TCL_STRING_KEYS,
+					 * TCL_ONE_WORD_KEYS, or an integer
+					 * giving the number of ints that
+                                         * is the size of the key.
+					 */
+    Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+	    CONST char *key));
+    Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+	    CONST char *key, int *newPtr));
+} Tcl_HashTable;
+
+/*
+ * Structure definition for information used to keep track of searches
+ * through hash tables:
+ */
+
+typedef struct Tcl_HashSearch {
+    Tcl_HashTable *tablePtr;		/* Table being searched. */
+    int nextIndex;			/* Index of next bucket to be
+					 * enumerated after present one. */
+    Tcl_HashEntry *nextEntryPtr;	/* Next entry to be enumerated in the
+					 * the current bucket. */
+} Tcl_HashSearch;
+
+/*
+ * Acceptable key types for hash tables:
+ */
+
+#define TCL_STRING_KEYS		0
+#define TCL_ONE_WORD_KEYS	1
+
+/*
+ * Macros for clients to use to access fields of hash entries:
+ */
+
+#define Tcl_GetHashValue(h) ((h)->clientData)
+#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
+#define Tcl_GetHashKey(tablePtr, h) \
+    ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
+						: (h)->key.string))
+
+/*
+ * Macros to use for clients to use to invoke find and create procedures
+ * for hash tables:
+ */
+
+#define Tcl_FindHashEntry(tablePtr, key) \
+	(*((tablePtr)->findProc))(tablePtr, key)
+#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
+	(*((tablePtr)->createProc))(tablePtr, key, newPtr)
+
+/*
+ * Flag values to pass to Tcl_DoOneEvent to disable searches
+ * for some kinds of events:
+ */
+
+#define TCL_DONT_WAIT		(1<<1)
+#define TCL_WINDOW_EVENTS	(1<<2)
+#define TCL_FILE_EVENTS		(1<<3)
+#define TCL_TIMER_EVENTS	(1<<4)
+#define TCL_IDLE_EVENTS		(1<<5)	/* WAS 0x10 ???? */
+#define TCL_ALL_EVENTS		(~TCL_DONT_WAIT)
+
+/*
+ * The following structure defines a generic event for the Tcl event
+ * system.  These are the things that are queued in calls to Tcl_QueueEvent
+ * and serviced later by Tcl_DoOneEvent.  There can be many different
+ * kinds of events with different fields, corresponding to window events,
+ * timer events, etc.  The structure for a particular event consists of
+ * a Tcl_Event header followed by additional information specific to that
+ * event.
+ */
+
+struct Tcl_Event {
+    Tcl_EventProc *proc;	/* Procedure to call to service this event. */
+    struct Tcl_Event *nextPtr;	/* Next in list of pending events, or NULL. */
+};
+
+/*
+ * Positions to pass to Tcl_QueueEvent:
+ */
+
+typedef enum {
+    TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK
+} 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.
+ * On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT.
+ */
+
+typedef struct Tcl_Time {
+    long sec;			/* Seconds. */
+    long usec;			/* Microseconds. */
+} Tcl_Time;
+
+/*
+ * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
+ * to indicate what sorts of events are of interest:
+ */
+
+#define TCL_READABLE	(1<<1)
+#define TCL_WRITABLE	(1<<2)
+#define TCL_EXCEPTION	(1<<3)
+
+/*
+ * Flag values to pass to Tcl_OpenCommandChannel to indicate the
+ * disposition of the stdio handles.  TCL_STDIN, TCL_STDOUT, TCL_STDERR,
+ * are also used in Tcl_GetStdChannel.
+ */
+
+#define TCL_STDIN		(1<<1)	
+#define TCL_STDOUT		(1<<2)
+#define TCL_STDERR		(1<<3)
+#define TCL_ENFORCE_MODE	(1<<4)
+
+/*
+ * Typedefs for the various operations in a channel type:
+ */
+
+typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mode));
+typedef int	(Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
+		    Tcl_Interp *interp));
+typedef int	(Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
+		    char *buf, int toRead, int *errorCodePtr));
+typedef int	(Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
+		    char *buf, int toWrite, int *errorCodePtr));
+typedef int	(Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
+		    long offset, int mode, int *errorCodePtr));
+typedef int	(Tcl_DriverSetOptionProc) _ANSI_ARGS_((
+		    ClientData instanceData, Tcl_Interp *interp,
+	            char *optionName, char *value));
+typedef int	(Tcl_DriverGetOptionProc) _ANSI_ARGS_((
+		    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.
+ */
+
+typedef enum Tcl_EolTranslation {
+    TCL_TRANSLATE_AUTO,			/* Eol == \r, \n and \r\n. */
+    TCL_TRANSLATE_CR,			/* Eol == \r. */
+    TCL_TRANSLATE_LF,			/* Eol == \n. */
+    TCL_TRANSLATE_CRLF			/* Eol == \r\n. */
+} Tcl_EolTranslation;
+
+/*
+ * struct Tcl_ChannelType:
+ *
+ * One such structure exists for each type (kind) of channel.
+ * It collects together in one place all the functions that are
+ * part of the specific channel type.
+ */
+
+typedef struct Tcl_ChannelType {
+    char *typeName;			/* The name of the channel type in Tcl
+                                         * commands. This storage is owned by
+                                         * channel type. */
+    Tcl_DriverBlockModeProc *blockModeProc;
+    					/* Set blocking mode for the
+                                         * raw channel. May be NULL. */
+    Tcl_DriverCloseProc *closeProc;	/* Procedure to call to close
+                                         * the channel. */
+    Tcl_DriverInputProc *inputProc;	/* Procedure to call for input
+                                         * on channel. */
+    Tcl_DriverOutputProc *outputProc;	/* Procedure to call for output
+                                         * on channel. */
+    Tcl_DriverSeekProc *seekProc;	/* Procedure to call to seek
+                                         * on the channel. May be NULL. */
+    Tcl_DriverSetOptionProc *setOptionProc;
+    					/* 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. */
+    VOID *reserved;			/* reserved for future expansion */
+} Tcl_ChannelType;
+
+/*
+ * The following flags determine whether the blockModeProc above should
+ * set the channel into blocking or nonblocking mode. They are passed
+ * as arguments to the blockModeProc procedure in the above structure.
+ */
+
+#define TCL_MODE_BLOCKING 0		/* Put channel into blocking mode. */
+#define TCL_MODE_NONBLOCKING 1		/* Put channel into nonblocking
+					 * mode. */
+
+/*
+ * Enum for different types of file paths.
+ */
+
+typedef enum Tcl_PathType {
+    TCL_PATH_ABSOLUTE,
+    TCL_PATH_RELATIVE,
+    TCL_PATH_VOLUME_RELATIVE
+} Tcl_PathType;
+
+/*
+ * 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));
+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));
+EXTERN void		Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN int		Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+			    int code));
+EXTERN void		Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN int		Tcl_AsyncReady _ANSI_ARGS_((void));
+EXTERN void		Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN char		Tcl_Backslash _ANSI_ARGS_((CONST 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));
+EXTERN void		Tcl_CancelIdleCall _ANSI_ARGS_((Tcl_IdleProc *idleProc,
+			    ClientData clientData));
+#define Tcl_Ckalloc Tcl_Alloc
+#define Tcl_Ckfree Tcl_Free
+#define Tcl_Ckrealloc Tcl_Realloc
+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_((CONST char *src,
+			    int length, char *dst, int flags));
+EXTERN int		Tcl_ConvertElement _ANSI_ARGS_((CONST 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,
+                            ClientData instanceData, int mask));
+EXTERN void		Tcl_CreateChannelHandler _ANSI_ARGS_((
+			    Tcl_Channel chan, int mask,
+                            Tcl_ChannelProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateCloseHandler _ANSI_ARGS_((
+			    Tcl_Channel chan, Tcl_CloseProc *proc,
+                            ClientData clientData));
+EXTERN Tcl_Command	Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdProc *proc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc));
+EXTERN void		Tcl_CreateEventSource _ANSI_ARGS_((
+			    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_((
+    			    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 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));
+EXTERN Tcl_Trace	Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
+			    int level, Tcl_CmdTraceProc *proc,
+			    ClientData clientData));
+EXTERN char *		Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
+			    char *file, int line));
+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 void		Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *file, int line));
+EXTERN void		Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    char *file, int line));
+EXTERN int		Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj *objPtr,
+			    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_DeleteExitHandler _ANSI_ARGS_((Tcl_ExitProc *proc,
+			    ClientData clientData));
+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_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, Tcl_Pid *pidPtr));
+EXTERN void		Tcl_DontCallWhenDeleted _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_DoOneEvent _ANSI_ARGS_((int flags));
+EXTERN void		Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc *proc,
+			    ClientData clientData));
+EXTERN char *		Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
+			    CONST char *string, int length));
+EXTERN char *		Tcl_DStringAppendElement _ANSI_ARGS_((
+			    Tcl_DString *dsPtr, CONST char *string));
+EXTERN void		Tcl_DStringEndSublist _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_DString *dsPtr));
+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 *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 *hiddenCmdToken, 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 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		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 int		Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
+	        	    int direction, ClientData *handlePtr));
+EXTERN ClientData	Tcl_GetChannelInstanceData _ANSI_ARGS_((
+    			    Tcl_Channel chan));
+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));
+EXTERN char *		Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Command command));
+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 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 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 CONST char *	Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
+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_PathType	Tcl_GetPathType _ANSI_ARGS_((char *path));
+EXTERN int		Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
+        		    Tcl_DString *dsPtr));
+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 *hiddenCmdToken));
+EXTERN int		Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    int keyType));
+EXTERN void		Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
+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 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));
+EXTERN Tcl_Channel	Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *fileName, char *modeString,
+                            int permissions));
+EXTERN Tcl_Channel	Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp *interp,
+			    int port, char *address, char *myaddr,
+		            int myport, int async));
+EXTERN Tcl_Channel	Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp *interp,
+		            int port, char *host,
+        		    Tcl_TcpAcceptProc *acceptProc,
+			    ClientData callbackData));
+EXTERN char *		Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char **termPtr));
+EXTERN int		Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, char *version));
+EXTERN char *		Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name, char *version, int exact));
+EXTERN char *		Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_Preserve _ANSI_ARGS_((ClientData data));
+EXTERN void		Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    double value, char *dst));
+EXTERN int		Tcl_PutEnv _ANSI_ARGS_((CONST char *string));
+EXTERN void		Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event *evPtr,
+			    Tcl_QueuePosition position));
+EXTERN int		Tcl_Read _ANSI_ARGS_((Tcl_Channel chan,
+	        	    char *bufPtr, int toRead));
+EXTERN void		Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+EXTERN int		Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmd, int flags));
+EXTERN int		Tcl_RecordAndEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *cmdPtr, int flags));
+EXTERN Tcl_RegExp	Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+EXTERN int		Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_RegExp regexp, char *string, char *start));
+EXTERN int		Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char *pattern));
+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_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
+#define Tcl_Return Tcl_SetResult
+EXTERN int		Tcl_ScanCountedElement _ANSI_ARGS_((CONST char *string,
+			    int length, int *flagPtr));
+EXTERN int		Tcl_ScanElement _ANSI_ARGS_((CONST 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_((
+			    Tcl_Interp *interp, Tcl_Channel chan,
+	        	    char *optionName, char *newValue));
+EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, Tcl_CmdInfo *infoPtr));
+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 *,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_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,
+			    char *part1, char *part2, char *newValue,
+			    int flags));
+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,
+			    int *argcPtr, char ***argvPtr));
+EXTERN void		Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *pkgName, Tcl_PackageInitProc *initProc,
+			    Tcl_PackageInitProc *safeInitProc));
+EXTERN int		Tcl_StringMatch _ANSI_ARGS_((char *string,
+			    char *pattern));
+EXTERN int		Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+#define Tcl_TildeSubst Tcl_TranslateFileName
+EXTERN int		Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags, Tcl_VarTraceProc *proc,
+			    ClientData clientData));
+EXTERN int		Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    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,
+			    Tcl_Channel chan));
+EXTERN int		Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags));
+EXTERN int		Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags));
+EXTERN void		Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags, Tcl_VarTraceProc *proc,
+			    ClientData clientData));
+EXTERN void		Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *proc, ClientData clientData));
+EXTERN void		Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName));
+EXTERN int		Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *frameName, char *varName,
+			    char *localName, int flags));
+EXTERN int		Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *frameName, char *part1, char *part2,
+			    char *localName, int flags));
+EXTERN int		Tcl_VarEval _ANSI_ARGS_(
+    			    TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN ClientData	Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, int flags,
+			    Tcl_VarTraceProc *procPtr,
+			    ClientData prevClientData));
+EXTERN ClientData	Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, int flags,
+			    Tcl_VarTraceProc *procPtr,
+			    ClientData prevClientData));
+EXTERN int		Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time *timePtr));
+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));
+EXTERN void		Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[], char *message));
+
+#endif /* RESOURCE_INCLUDED */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCL */
diff --git a/tcl/generic/tclAlloc.c b/tcl/generic/tclAlloc.c
new file mode 100644
index 00000000000..cdb0e3df5d8
--- /dev/null
+++ b/tcl/generic/tclAlloc.c
@@ -0,0 +1,458 @@
+/* 
+ * tclAlloc.c --
+ *
+ *	This is a very fast storage allocator.  It allocates blocks of a
+ *	small number of different sizes, and keeps free lists of each size.
+ *	Blocks that don't exactly fit are passed up to the next larger size.
+ *	Blocks over a certain size are directly allocated from the system.
+ *
+ * Copyright (c) 1983 Regents of the University of California.
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef TCL_DEBUG
+#   define DEBUG
+/* #define MSTATS */
+#   define RCHECK
+#endif
+
+#ifndef __CYGWIN32__
+typedef unsigned long caddr_t;
+#endif
+
+/*
+ * The overhead on a block is at least 4 bytes.  When free, this space
+ * contains a pointer to the next free block, and the bottom two bits must
+ * be zero.  When in use, the first byte is set to MAGIC, and the second
+ * byte is the size index.  The remaining bytes are for alignment.
+ * If range checking is enabled then a second word holds the size of the
+ * requested block, less 1, rounded up to a multiple of sizeof(RMAGIC).
+ * The order of elements is critical: ov_magic must overlay the low order
+ * bits of ov_next, and ov_magic can not be a valid ov_next bit pattern.
+ */
+
+union overhead {
+    union overhead *ov_next;	/* when free */
+    struct {
+	unsigned char	ovu_magic0;	/* magic number */
+	unsigned char	ovu_index;	/* bucket # */
+	unsigned char	ovu_unused;	/* unused */
+	unsigned char	ovu_magic1;	/* other magic number */
+#ifdef RCHECK
+	unsigned short	ovu_rmagic;	/* range magic number */
+	unsigned long	ovu_size;	/* actual block size */
+#endif
+    } ovu;
+#define ov_magic0	ovu.ovu_magic0
+#define ov_magic1	ovu.ovu_magic1
+#define ov_index	ovu.ovu_index
+#define ov_rmagic	ovu.ovu_rmagic
+#define ov_size	ovu.ovu_size
+};
+
+
+#define MAGIC		0xef		/* magic # on accounting info */
+#define RMAGIC		0x5555		/* magic # on range info */
+
+#ifdef RCHECK
+#define	RSLOP		sizeof (unsigned short)
+#else
+#define	RSLOP		0
+#endif
+
+#define OVERHEAD (sizeof(union overhead) + RSLOP)
+
+/*
+ * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
+ * smallest allocatable block is 8 bytes.  The overhead information
+ * precedes the data area returned to the user.
+ */
+
+#define NBUCKETS	13
+#define MAXMALLOC	(1<<(NBUCKETS+2))
+static	union overhead *nextf[NBUCKETS];
+
+#ifdef MSTATS
+
+/*
+ * nmalloc[i] is the difference between the number of mallocs and frees
+ * for a given block size.
+ */
+
+static	unsigned int nmalloc[NBUCKETS+1];
+#include <stdio.h>
+#endif
+
+#if defined(DEBUG) || defined(RCHECK)
+#define	ASSERT(p)   if (!(p)) panic(# p)
+#define RANGE_ASSERT(p) if (!(p)) panic(# p)
+#else
+#define	ASSERT(p)
+#define RANGE_ASSERT(p)
+#endif
+
+/*
+ * Prototypes for functions used only in this file.
+ */
+
+static void 		MoreCore _ANSI_ARGS_((int bucket));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpAlloc --
+ *
+ *	Allocate more memory.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpAlloc(
+    unsigned int nbytes)	/* Number of bytes to allocate. */
+{
+    register union overhead *op;
+    register long bucket;
+    register unsigned amt;
+
+    /*
+     * First the simple case: we simple allocate big blocks directly
+     */
+    if (nbytes + OVERHEAD >= MAXMALLOC) {
+	op = (union overhead *)TclpSysAlloc(nbytes+OVERHEAD, 0);
+	if (op == NULL) {
+	    return NULL;
+	}
+	op->ov_magic0 = op->ov_magic1 = MAGIC;
+	op->ov_index = 0xff;
+#ifdef MSTATS
+	nmalloc[NBUCKETS]++;
+#endif
+#ifdef RCHECK
+	/*
+	 * Record allocated size of block and
+	 * bound space with magic numbers.
+	 */
+	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+	op->ov_rmagic = RMAGIC;
+	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+#endif
+	return (void *)(op+1);
+    }
+    /*
+     * Convert amount of memory requested into closest block size
+     * stored in hash buckets which satisfies request.
+     * Account for space used per block for accounting.
+     */
+#ifndef RCHECK
+    amt = 8;	/* size of first bucket */
+    bucket = 0;
+#else
+    amt = 16;	/* size of first bucket */
+    bucket = 1;
+#endif
+    while (nbytes + OVERHEAD > amt) {
+	amt <<= 1;
+	if (amt == 0) {
+	    return (NULL);
+	}
+	bucket++;
+    }
+    ASSERT( bucket < NBUCKETS );
+
+    /*
+     * If nothing in hash bucket right now,
+     * request more memory from the system.
+     */
+    if ((op = nextf[bucket]) == NULL) {
+	MoreCore(bucket);
+	if ((op = nextf[bucket]) == NULL) {
+	    return (NULL);
+	}
+    }
+    /*
+     * Remove from linked list
+     */
+    nextf[bucket] = op->ov_next;
+    op->ov_magic0 = op->ov_magic1 = MAGIC;
+    op->ov_index = (unsigned char) bucket;
+#ifdef MSTATS
+    nmalloc[bucket]++;
+#endif
+#ifdef RCHECK
+    /*
+     * Record allocated size of block and
+     * bound space with magic numbers.
+     */
+    op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+    op->ov_rmagic = RMAGIC;
+    *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+#endif
+    return ((char *)(op + 1));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MoreCore --
+ *
+ *	Allocate more memory to the indicated bucket.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Attempts to get more memory from the system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MoreCore(
+    int bucket)		/* What bucket to allocat to. */
+{
+    register union overhead *op;
+    register long sz;		/* size of desired block */
+    long amt;			/* amount to allocate */
+    int nblks;			/* how many blocks we get */
+
+    /*
+     * sbrk_size <= 0 only for big, FLUFFY, requests (about
+     * 2^30 bytes on a VAX, I think) or for a negative arg.
+     */
+    sz = 1 << (bucket + 3);
+    ASSERT(sz > 0);
+
+    amt = MAXMALLOC;
+    nblks = amt / sz;
+    ASSERT(nblks*sz == amt);
+
+    op = (union overhead *)TclpSysAlloc(amt, 1);
+    /* no more room! */
+    if (op == NULL) {
+	return;
+    }
+    
+    /*
+     * Add new memory allocated to that on
+     * free list for this hash bucket.
+     */
+    nextf[bucket] = op;
+    while (--nblks > 0) {
+	op->ov_next = (union overhead *)((caddr_t)op + sz);
+	op = (union overhead *)((caddr_t)op + sz);
+    }
+    op->ov_next = (union overhead *)NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFree --
+ *
+ *	Free memory.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFree(
+    char *cp)		/* Pointer to memory to free. */
+{   
+    register long size;
+    register union overhead *op;
+
+    if (cp == NULL) {
+	return;
+    }
+
+    op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+
+    ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
+    ASSERT(op->ov_magic1 == MAGIC);
+    if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+	return;
+    }
+
+    RANGE_ASSERT(op->ov_rmagic == RMAGIC);
+    RANGE_ASSERT(*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) == RMAGIC);
+    size = op->ov_index;
+    if ( size == 0xff ) {
+#ifdef MSTATS
+	nmalloc[NBUCKETS]--;
+#endif
+	TclpSysFree(op);
+	return;
+    }
+    ASSERT(size < NBUCKETS);
+    op->ov_next = nextf[size];	/* also clobbers ov_magic */
+    nextf[size] = op;
+#ifdef MSTATS
+    nmalloc[size]--;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpRealloc --
+ *
+ *	Reallocate memory.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpRealloc(
+    char *cp,			/* Pointer to alloced block. */
+    unsigned int nbytes)	/* New size of memory. */
+{   
+    int i;
+    union overhead *op;
+    int expensive;
+    unsigned long maxsize;
+
+    if (cp == NULL) {
+	return (TclpAlloc(nbytes));
+    }
+
+    op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+
+    ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
+    ASSERT(op->ov_magic1 == MAGIC);
+    if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+	return NULL;
+    }
+
+    RANGE_ASSERT(op->ov_rmagic == RMAGIC);
+    RANGE_ASSERT(*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) == RMAGIC);
+    i = op->ov_index;
+
+    /*
+     * If the block isn't in a bin, just realloc it.
+     */
+
+    if (i == 0xff) {
+	op = (union overhead *) TclpSysRealloc(op, nbytes+OVERHEAD);
+	if (op == NULL) {
+	    return NULL;
+	}
+#ifdef MSTATS
+	nmalloc[NBUCKETS]++;
+#endif
+#ifdef RCHECK
+	/*
+	 * Record allocated size of block and update magic number bounds.
+	 */
+
+	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+#endif
+	return (char *)(op+1);
+    }
+    maxsize = 1 << (i+3);
+    expensive = 0;
+    if ( nbytes + OVERHEAD > maxsize ) {
+	expensive = 1;
+    } else if ( i > 0 && nbytes + OVERHEAD < (maxsize/2) ) {
+	expensive = 1;
+    }
+
+    if (expensive) {
+	void *newp;
+		
+	newp = TclpAlloc(nbytes);
+	if ( newp == NULL ) {
+	    return NULL;
+	}
+	maxsize -= OVERHEAD;
+	if ( maxsize < nbytes )
+	    nbytes = maxsize;
+	memcpy((VOID *) newp, (VOID *) cp, (size_t) nbytes);
+	TclpFree(cp);
+	return newp;
+    }
+    
+    /*
+     * Ok, we don't have to copy, it fits as-is
+     */
+#ifdef RCHECK
+    op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+    *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+#endif
+    return(cp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * mstats --
+ *
+ *	Prints two lines of numbers, one showing the length of the 
+ *	free list for each size category, the second showing the 
+ *	number of mallocs - frees for each size category.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef MSTATS
+void
+mstats(
+    char *s)	/* Where to write info. */
+{
+    register int i, j;
+    register union overhead *p;
+    int totfree = 0,
+	totused = 0;
+
+    fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
+    for (i = 0; i < NBUCKETS; i++) {
+	for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+	    fprintf(stderr, " %d", j);
+	totfree += j * (1 << (i + 3));
+    }
+    fprintf(stderr, "\nused:\t");
+    for (i = 0; i < NBUCKETS; i++) {
+	fprintf(stderr, " %d", nmalloc[i]);
+	totused += nmalloc[i] * (1 << (i + 3));
+    }
+    fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
+	    totused, totfree);
+    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", 
+	    MAXMALLOC, nmalloc[NBUCKETS]);
+}
+#endif
diff --git a/tcl/generic/tclAsync.c b/tcl/generic/tclAsync.c
new file mode 100644
index 00000000000..2159d3f8342
--- /dev/null
+++ b/tcl/generic/tclAsync.c
@@ -0,0 +1,265 @@
+/* 
+ * tclAsync.c --
+ *
+ *	This file provides low-level support needed to invoke signal
+ *	handlers in a safe way.  The code here doesn't actually handle
+ *	signals, though.  This code is based on proposals made by
+ *	Mark Diekhans and Don Libes.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * One of the following structures exists for each asynchronous
+ * handler:
+ */
+
+typedef struct AsyncHandler {
+    int ready;				/* Non-zero means this handler should
+					 * be invoked in the next call to
+					 * Tcl_AsyncInvoke. */
+    struct AsyncHandler *nextPtr;	/* Next in list of all handlers for
+					 * the process. */
+    Tcl_AsyncProc *proc;		/* Procedure to call when handler
+					 * is invoked. */
+    ClientData clientData;		/* Value to pass to handler when it
+					 * is invoked. */
+} AsyncHandler;
+
+/*
+ * The variables below maintain a list of all existing handlers.
+ */
+
+static AsyncHandler *firstHandler;	/* First handler defined for process,
+					 * or NULL if none. */
+static AsyncHandler *lastHandler;	/* Last handler or NULL. */
+
+/*
+ * The variable below is set to 1 whenever a handler becomes ready and
+ * it is cleared to zero whenever Tcl_AsyncInvoke is called.  It can be
+ * checked elsewhere in the application by calling Tcl_AsyncReady to see
+ * if Tcl_AsyncInvoke should be invoked.
+ */
+
+static int asyncReady = 0;
+
+/*
+ * The variable below indicates whether Tcl_AsyncInvoke is currently
+ * working.  If so then we won't set asyncReady again until
+ * Tcl_AsyncInvoke returns.
+ */
+
+static int asyncActive = 0;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncCreate --
+ *
+ *	This procedure creates the data structures for an asynchronous
+ *	handler, so that no memory has to be allocated when the handler
+ *	is activated.
+ *
+ * Results:
+ *	The return value is a token for the handler, which can be used
+ *	to activate it later on.
+ *
+ * Side effects:
+ *	Information about the handler is recorded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_AsyncHandler
+Tcl_AsyncCreate(proc, clientData)
+    Tcl_AsyncProc *proc;		/* Procedure to call when handler
+					 * is invoked. */
+    ClientData clientData;		/* Argument to pass to handler. */
+{
+    AsyncHandler *asyncPtr;
+
+    asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
+    asyncPtr->ready = 0;
+    asyncPtr->nextPtr = NULL;
+    asyncPtr->proc = proc;
+    asyncPtr->clientData = clientData;
+    if (firstHandler == NULL) {
+	firstHandler = asyncPtr;
+    } else {
+	lastHandler->nextPtr = asyncPtr;
+    }
+    lastHandler = asyncPtr;
+    return (Tcl_AsyncHandler) asyncPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncMark --
+ *
+ *	This procedure is called to request that an asynchronous handler
+ *	be invoked as soon as possible.  It's typically called from
+ *	an interrupt handler, where it isn't safe to do anything that
+ *	depends on or modifies application state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The handler gets marked for invocation later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AsyncMark(async)
+    Tcl_AsyncHandler async;		/* Token for handler. */
+{
+    ((AsyncHandler *) async)->ready = 1;
+    if (!asyncActive) {
+	asyncReady = 1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncInvoke --
+ *
+ *	This procedure is called at a "safe" time at background level
+ *	to invoke any active asynchronous handlers.
+ *
+ * Results:
+ *	The return value is a normal Tcl result, which is intended to
+ *	replace the code argument as the current completion code for
+ *	interp.
+ *
+ * Side effects:
+ *	Depends on the handlers that are active.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AsyncInvoke(interp, code)
+    Tcl_Interp *interp;			/* If invoked from Tcl_Eval just after
+					 * completing a command, points to
+					 * interpreter.  Otherwise it is
+					 * NULL. */
+    int code; 				/* If interp is non-NULL, this gives
+					 * completion code from command that
+					 * just completed. */
+{
+    AsyncHandler *asyncPtr;
+
+    if (asyncReady == 0) {
+	return code;
+    }
+    asyncReady = 0;
+    asyncActive = 1;
+    if (interp == NULL) {
+	code = 0;
+    }
+
+    /*
+     * Make one or more passes over the list of handlers, invoking
+     * at most one handler in each pass.  After invoking a handler,
+     * go back to the start of the list again so that (a) if a new
+     * higher-priority handler gets marked while executing a lower
+     * priority handler, we execute the higher-priority handler
+     * next, and (b) if a handler gets deleted during the execution
+     * of a handler, then the list structure may change so it isn't
+     * safe to continue down the list anyway.
+     */
+
+    while (1) {
+	for (asyncPtr = firstHandler; asyncPtr != NULL;
+		asyncPtr = asyncPtr->nextPtr) {
+	    if (asyncPtr->ready) {
+		break;
+	    }
+	}
+	if (asyncPtr == NULL) {
+	    break;
+	}
+	asyncPtr->ready = 0;
+	code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
+    }
+    asyncActive = 0;
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncDelete --
+ *
+ *	Frees up all the state for an asynchronous handler.  The handler
+ *	should never be used again.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The state associated with the handler is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AsyncDelete(async)
+    Tcl_AsyncHandler async;		/* Token for handler to delete. */
+{
+    AsyncHandler *asyncPtr = (AsyncHandler *) async;
+    AsyncHandler *prevPtr;
+
+    if (firstHandler == asyncPtr) {
+	firstHandler = asyncPtr->nextPtr;
+	if (firstHandler == NULL) {
+	    lastHandler = NULL;
+	}
+    } else {
+	prevPtr = firstHandler;
+	while (prevPtr->nextPtr != asyncPtr) {
+	    prevPtr = prevPtr->nextPtr;
+	}
+	prevPtr->nextPtr = asyncPtr->nextPtr;
+	if (lastHandler == asyncPtr) {
+	    lastHandler = prevPtr;
+	}
+    }
+    ckfree((char *) asyncPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AsyncReady --
+ *
+ *	This procedure can be used to tell whether Tcl_AsyncInvoke
+ *	needs to be called.  This procedure is the external interface
+ *	for checking the internal asyncReady variable.
+ *
+ * Results:
+ * 	The return value is 1 whenever a handler is ready and is 0
+ *	when no handlers are ready.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AsyncReady()
+{
+    return asyncReady;
+}
diff --git a/tcl/generic/tclBasic.c b/tcl/generic/tclBasic.c
new file mode 100644
index 00000000000..044974cb13a
--- /dev/null
+++ b/tcl/generic/tclBasic.c
@@ -0,0 +1,4094 @@
+/* 
+ * tclBasic.c --
+ *
+ *	Contains the basic facilities for TCL command interpretation,
+ *	including interpreter creation and deletion, command creation
+ *	and deletion, and command parsing and execution.
+ *
+ * Copyright (c) 1987-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#ifndef TCL_GENERIC_ONLY
+#   include "tclPort.h"
+#endif
+
+/*
+ * 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 the commands in the Tcl core.
+ */
+
+typedef struct {
+    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;
+
+/*
+ * The built-in commands, and the procedures that implement them:
+ */
+
+static CmdInfo builtInCmds[] = {
+    /*
+     * 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_CmdProc *) NULL,	Tcl_FormatObjCmd,
+        (CompileProc *) NULL,		1},
+    {"global",		(Tcl_CmdProc *) NULL,	Tcl_GlobalObjCmd,
+        (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_CmdProc *) NULL,	Tcl_SplitObjCmd,
+        (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_CmdProc *) NULL,	Tcl_AfterObjCmd,
+        (CompileProc *) NULL,		1},
+    {"cd",		(Tcl_CmdProc *) NULL,	Tcl_CdObjCmd,
+        (CompileProc *) NULL,		0},
+    {"close",		(Tcl_CmdProc *) NULL,	Tcl_CloseObjCmd,
+        (CompileProc *) NULL,		1},
+    {"eof",		(Tcl_CmdProc *) NULL,	Tcl_EofObjCmd,
+        (CompileProc *) NULL,		1},
+    {"fblocked",	(Tcl_CmdProc *) NULL,	Tcl_FblockedObjCmd,
+        (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,		1},
+    
+#ifdef MAC_TCL
+    {"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,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateInterp --
+ *
+ *	Create a new TCL command interpreter.
+ *
+ * Results:
+ *	The return value is a token for the interpreter, which may be
+ *	used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
+ *	Tcl_DeleteInterp.
+ *
+ * Side effects:
+ *	The command interpreter is initialized with an empty variable
+ *	table and the built-in commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tcl_CreateInterp()
+{
+    register Interp *iPtr;
+    register Command *cmdPtr;
+    register CmdInfo *cmdInfoPtr;
+    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)) {
+	/*NOTREACHED*/
+        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->mathFuncTable, TCL_STRING_KEYS);
+    iPtr->numLevels = 0;
+    iPtr->maxNestingDepth = 1000;
+    iPtr->framePtr = NULL;
+    iPtr->varFramePtr = NULL;
+    iPtr->activeTracePtr = NULL;
+    iPtr->returnCode = TCL_OK;
+    iPtr->errorInfo = NULL;
+    iPtr->errorCode = NULL;
+    iPtr->appendResult = NULL;
+    iPtr->appendAvl = 0;
+    iPtr->appendUsed = 0;
+    for (i = 0; i < NUM_REGEXPS; i++) {
+	iPtr->patterns[i] = NULL;
+	iPtr->patLengths[i] = -1;
+	iPtr->regexps[i] = NULL;
+    }
+    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
+    iPtr->packageUnknown = NULL;
+    iPtr->cmdCount = 0;
+    iPtr->termOffset = 0;
+    iPtr->compileEpoch = 0;
+    iPtr->compiledProcPtr = NULL;
+    iPtr->resolverPtr = 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");
+    }
+
+    /*
+     * 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);
+
+    /*
+     * 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;
+
+	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->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);
+	}
+    }
+
+    /*
+     *  Initialize/Create "errorInfo" and "errorCode" global vars
+     *  (because some part of the C code assume they exists
+     *   and we can get a seg fault otherwise (in multiple 
+     *   interps loading of extensions for instance) --dl)
+     */
+     /*
+      *  We can't assume that because we initialize 
+      *  the variables here, they won't be unset later.
+      *  so we had 2 choices:
+      *    + Check every place where a GetVar of those is used 
+      *      and the NULL result is not checked (like in tclLoad.c)
+      *    + Make SetVar,... NULL friendly
+      *  We choosed the second option because :
+      *    + It is easy and low cost to check for NULL pointer before
+      *      calling strlen()
+      *    + It can be helpfull to other people using those API
+      *    + Passing a NULL value to those closest 'meaning' is empty string
+      *      (specially with the new objects where 0 bytes strings are ok)
+      * So the following init is commented out:              -- dl
+      */
+    /*
+      (void)Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL, "",
+         TCL_GLOBAL_ONLY);
+      (void)Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL, "NONE",
+	    TCL_GLOBAL_ONLY);
+     */
+
+#ifndef TCL_GENERIC_ONLY
+    TclSetupEnv((Tcl_Interp *) iPtr);
+#endif
+
+    /*
+     * Do Multiple/Safe Interps Tcl init stuff
+     */
+    (void) TclInterpInit((Tcl_Interp *)iPtr);
+
+    /*
+     * Set up variables such as tcl_version.
+     */
+
+    TclPlatformInit((Tcl_Interp *)iPtr);
+    Tcl_SetVar((Tcl_Interp *) iPtr, "tcl_patchLevel", TCL_PATCH_LEVEL,
+	    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_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    TclPrecTraceProc, (ClientData) NULL);
+
+    /*
+     * Compute the byte order of this machine.
+     */
+
+    order.s = 1;
+    Tcl_SetVar2((Tcl_Interp *) iPtr, "tcl_platform", "byteOrder",
+	    (order.c[0] == 1) ? "littleEndian" : "bigEndian",
+	    TCL_GLOBAL_ONLY);
+
+    /*
+     * Register Tcl's version number.
+     */
+
+    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 --
+ *
+ *	Arrange for a procedure to be called before a given
+ *	interpreter is deleted. The procedure is called as soon
+ *	as Tcl_DeleteInterp is called; if Tcl_CallWhenDeleted is
+ *	called on an interpreter that has already been deleted,
+ *	the procedure will be called when the last Tcl_Release is
+ *	done on the interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When Tcl_DeleteInterp is invoked to delete interp,
+ *	proc will be invoked.  See the manual entry for
+ *	details.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_CallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    Interp *iPtr = (Interp *) interp;
+    static int assocDataCounter = 0;
+    int new;
+    char buffer[128];
+    AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+    Tcl_HashEntry *hPtr;
+
+    sprintf(buffer, "Assoc Data Key #%d", assocDataCounter);
+    assocDataCounter++;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    }
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
+    dPtr->proc = proc;
+    dPtr->clientData = clientData;
+    Tcl_SetHashValue(hPtr, dPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_DontCallWhenDeleted --
+ *
+ *	Cancel the arrangement for a procedure to be called when
+ *	a given interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If proc and clientData were previously registered as a
+ *	callback via Tcl_CallWhenDeleted, they are unregistered.
+ *	If they weren't previously registered then nothing
+ *	happens.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_DontCallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashTable *hTablePtr;
+    Tcl_HashSearch hSearch;
+    Tcl_HashEntry *hPtr;
+    AssocData *dPtr;
+
+    hTablePtr = iPtr->assocData;
+    if (hTablePtr == (Tcl_HashTable *) NULL) {
+        return;
+    }
+    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&hSearch)) {
+        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+        if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
+            ckfree((char *) dPtr);
+            Tcl_DeleteHashEntry(hPtr);
+            return;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetAssocData --
+ *
+ *	Creates a named association between user-specified data, a delete
+ *	function and this interpreter. If the association already exists
+ *	the data is overwritten with the new data. The delete function will
+ *	be invoked when the interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the associated data, creates the association if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetAssocData(interp, name, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to associate with. */
+    char *name;			/* Name for association. */
+    Tcl_InterpDeleteProc *proc;	/* Proc to call when interpreter is
+                                 * about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    Interp *iPtr = (Interp *) interp;
+    AssocData *dPtr;
+    Tcl_HashEntry *hPtr;
+    int new;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    }
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
+    if (new == 0) {
+        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    } else {
+        dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+    }
+    dPtr->proc = proc;
+    dPtr->clientData = clientData;
+
+    Tcl_SetHashValue(hPtr, dPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteAssocData --
+ *
+ *	Deletes a named association of user-specified data with
+ *	the specified interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the association.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteAssocData(interp, name)
+    Tcl_Interp *interp;			/* Interpreter to associate with. */
+    char *name;				/* Name of association. */
+{
+    Interp *iPtr = (Interp *) interp;
+    AssocData *dPtr;
+    Tcl_HashEntry *hPtr;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        return;
+    }
+    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return;
+    }
+    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    if (dPtr->proc != NULL) {
+        (dPtr->proc) (dPtr->clientData, interp);
+    }
+    ckfree((char *) dPtr);
+    Tcl_DeleteHashEntry(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAssocData --
+ *
+ *	Returns the client data associated with this name in the
+ *	specified interpreter.
+ *
+ * Results:
+ *	The client data in the AssocData record denoted by the named
+ *	association, or NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_GetAssocData(interp, name, procPtr)
+    Tcl_Interp *interp;			/* Interpreter associated with. */
+    char *name;				/* Name of association. */
+    Tcl_InterpDeleteProc **procPtr;	/* Pointer to place to store address
+					 * of current deletion callback. */
+{
+    Interp *iPtr = (Interp *) interp;
+    AssocData *dPtr;
+    Tcl_HashEntry *hPtr;
+
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        return (ClientData) NULL;
+    }
+    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return (ClientData) NULL;
+    }
+    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    if (procPtr != (Tcl_InterpDeleteProc **) NULL) {
+        *procPtr = dPtr->proc;
+    }
+    return dPtr->clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteInterpProc --
+ *
+ *	Helper procedure to delete an interpreter. This procedure is
+ *	called when the last call to Tcl_Preserve on this interpreter
+ *	is matched by a call to Tcl_Release. The procedure cleans up
+ *	all resources used in the interpreter and calls all currently
+ *	registered interpreter deletion callbacks.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Whatever the interpreter deletion callbacks do. Frees resources
+ *	used by the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteInterpProc(interp)
+    Tcl_Interp *interp;			/* Interpreter to delete. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_HashTable *hTablePtr;
+    AssocData *dPtr;
+    ResolverScheme *resPtr, *nextResPtr;
+    int i;
+
+    /*
+     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
+     */
+    
+    if (iPtr->numLevels > 0) {
+        panic("DeleteInterpProc called with active evals");
+    }
+
+    /*
+     * The interpreter should already be marked deleted; otherwise how
+     * did we get here?
+     */
+
+    if (!(iPtr->flags & DELETED)) {
+        panic("DeleteInterpProc called on interpreter not marked deleted");
+    }
+
+    /*
+     * 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.
+     */
+    
+    TclTeardownNamespace(iPtr->globalNsPtr);
+
+    /*
+     * Tear down the math function table.
+     */
+
+    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.
+     */
+
+    while (iPtr->assocData != (Tcl_HashTable *) NULL) {
+        hTablePtr = iPtr->assocData;
+        iPtr->assocData = (Tcl_HashTable *) NULL;
+        for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
+                 hPtr != NULL;
+                 hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
+            dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+            Tcl_DeleteHashEntry(hPtr);
+            if (dPtr->proc != NULL) {
+                (*dPtr->proc)(dPtr->clientData, interp);
+            }
+            ckfree((char *) dPtr);
+        }
+        Tcl_DeleteHashTable(hTablePtr);
+        ckfree((char *) hTablePtr);
+    }
+
+    /*
+     * Finish deleting the global namespace.
+     */
+    
+    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
+
+    /*
+     * Free up the result *after* deleting variables, since variable
+     * deletion could have transferred ownership of the result string
+     * to Tcl.
+     */
+
+    Tcl_FreeResult(interp);
+    interp->result = NULL;
+    Tcl_DecrRefCount(iPtr->objResultPtr);
+    iPtr->objResultPtr = NULL;
+    if (iPtr->errorInfo != NULL) {
+	ckfree(iPtr->errorInfo);
+        iPtr->errorInfo = NULL;
+    }
+    if (iPtr->errorCode != NULL) {
+	ckfree(iPtr->errorCode);
+        iPtr->errorCode = NULL;
+    }
+    if (iPtr->appendResult != NULL) {
+	ckfree(iPtr->appendResult);
+        iPtr->appendResult = NULL;
+    }
+    for (i = 0; i < NUM_REGEXPS; i++) {
+	if (iPtr->patterns[i] == NULL) {
+	    break;
+	}
+	ckfree(iPtr->patterns[i]);
+	ckfree((char *) iPtr->regexps[i]);
+        iPtr->regexps[i] = NULL;
+    }
+    TclFreePackageInfo(iPtr);
+    while (iPtr->tracePtr != NULL) {
+	Trace *nextPtr = iPtr->tracePtr->nextPtr;
+
+	ckfree((char *) iPtr->tracePtr);
+	iPtr->tracePtr = nextPtr;
+    }
+    if (iPtr->execEnvPtr != NULL) {
+	TclDeleteExecEnv(iPtr->execEnvPtr);
+    }
+    Tcl_DecrRefCount(iPtr->emptyObjPtr);
+    iPtr->emptyObjPtr = NULL;
+
+    resPtr = iPtr->resolverPtr;
+    while (resPtr) {
+	nextResPtr = resPtr->nextPtr;
+	ckfree(resPtr->name);
+	ckfree((char *) resPtr);
+        resPtr = nextResPtr;
+    }
+    
+    ckfree((char *) iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InterpDeleted --
+ *
+ *	Returns nonzero if the interpreter has been deleted with a call
+ *	to Tcl_DeleteInterp.
+ *
+ * Results:
+ *	Nonzero if the interpreter is deleted, zero otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InterpDeleted(interp)
+    Tcl_Interp *interp;
+{
+    return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteInterp --
+ *
+ *	Ensures that the interpreter will be deleted eventually. If there
+ *	are no Tcl_Preserve calls in effect for this interpreter, it is
+ *	deleted immediately, otherwise the interpreter is deleted when
+ *	the last Tcl_Preserve is matched by a call to Tcl_Release. In either
+ *	case, the procedure runs the currently registered deletion callbacks. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The interpreter is marked as deleted. The caller may still use it
+ *	safely if there are calls to Tcl_Preserve in effect for the
+ *	interpreter, but further calls to Tcl_Eval etc in this interpreter
+ *	will fail.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteInterp(interp)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    /*
+     * If the interpreter has already been marked deleted, just punt.
+     */
+
+    if (iPtr->flags & DELETED) {
+        return;
+    }
+    
+    /*
+     * Mark the interpreter as deleted. No further evals will be allowed.
+     */
+
+    iPtr->flags |= DELETED;
+
+    /*
+     * Ensure that the interpreter is eventually deleted.
+     */
+
+    Tcl_EventuallyFree((ClientData) interp,
+            (Tcl_FreeProc *) DeleteInterpProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    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);
+        }
+	
+        /*
+	 * 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);
+    }
+    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:
+ *	Removes a command from the command table and create an entry
+ *      into the hidden command table under the specified token name.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
+    Tcl_Interp *interp;		/* Interpreter in which to hide command. */
+    char *cmdName;		/* Name of command to hide. */
+    char *hiddenCmdToken;	/* Token name of the to-be-hidden command. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    Tcl_HashTable *hTblPtr;
+    Tcl_HashEntry *hPtr;
+    int 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;
+    }
+
+    /*
+     * Disallow hiding of commands that are currently in a namespace or
+     * renaming (as part of hiding) into a namespace.
+     *
+     * (because the current implementation with a single global table
+     *  and the needed uniqueness of names cause problems with namespaces)
+     *
+     * we don't need to check for "::" in cmdName because the real check is
+     * on the nsPtr below.
+     *
+     * hiddenCmdToken is just a string which is not interpreted in any way.
+     * It may contain :: but the string is not interpreted as a namespace
+     * qualifier command name. Thus, hiding foo::bar to foo::bar and then
+     * trying to expose or invoke ::foo::bar will NOT work; but if the
+     * application always uses the same strings it will get consistent
+     * behaviour.
+     *
+     * But as we currently limit ourselves to the global namespace only
+     * for the source, in order to avoid potential confusion,
+     * lets prevent "::" in the token too.  --dl
+     */
+
+    if (strstr(hiddenCmdToken, "::") != NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "cannot use namespace qualifiers as hidden command",
+		"token (rename)", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find the command to hide. An error is returned if cmdName can't
+     * be found. Look up the command only from the global namespace.
+     * Full path of the command must be given if using namespaces.
+     */
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+	    /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
+    if (cmd == (Tcl_Command) NULL) {
+	return TCL_ERROR;
+    }
+    cmdPtr = (Command *) cmd;
+
+    /*
+     * Check that the command is really in global namespace
+     */
+
+    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "can only hide global namespace commands",
+		" (use rename then hide)", (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    /*
+     * 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
+     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
+     * exists.
+     */
+    
+    hPtr = Tcl_CreateHashEntry(hTblPtr, hiddenCmdToken, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "hidden command named \"", hiddenCmdToken, "\" already exists",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Nb : This code is currently 'like' a rename to a specialy set apart
+     * name table. Changes here and in TclRenameCommand must
+     * be kept in synch untill the common parts are actually
+     * factorized out.
+     */
+
+    /*
+     * 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++;
+    }
+
+    /*
+     * Now link the hash table entry with the command structure.
+     * We ensured above that the nsPtr was right.
+     */
+    
+    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, hiddenCmdToken, cmdName)
+    Tcl_Interp *interp;		/* Interpreter in which to make command
+                                 * callable. */
+    char *hiddenCmdToken;	/* Name of hidden command. */
+    char *cmdName;		/* Name of to-be-exposed command. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Command *cmdPtr;
+    Namespace *nsPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashTable *hTblPtr;
+    int 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;
+    }
+
+    /*
+     * Check that we have a regular name for the command
+     * (that the user is not trying to do an expose and a rename
+     *  (to another namespace) at the same time)
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "can not expose to a namespace ",
+		"(use expose to toplevel, then rename)",
+                 (char *) NULL);
+        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 \"", hiddenCmdToken,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+        
+    /*
+     * Get the command from the hidden command table:
+     */
+
+    hPtr = Tcl_FindHashEntry(hTblPtr, hiddenCmdToken);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown hidden command \"", hiddenCmdToken,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    
+
+    /*
+     * Check that we have a true global namespace
+     * command (enforced by Tcl_HideCommand() but let's double
+     * check. (If it was not, we would not really know how to
+     * handle it).
+     */
+    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
+	/* 
+	 * This case is theoritically impossible,
+	 * we might rather panic() than 'nicely' erroring out ?
+	 */
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "trying to expose a non global command name space command",
+		(char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    /* This is the global table */
+    nsPtr = cmdPtr->nsPtr;
+
+    /*
+     * It is an error to overwrite an existing exposed command as a result
+     * of exposing a previously hidden command.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &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;
+    }
+
+    /*
+     * 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;
+
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+
+    /*
+     * Not needed as we are only in the global namespace
+     * (but would be needed again if we supported namespace command hiding)
+     *
+     * 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_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. 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. 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. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ImportRef *oldRefPtr = NULL;
+    Namespace *nsPtr, *dummy1, *dummy2;
+    Command *cmdPtr, *refCmdPtr;
+    Tcl_HashEntry *hPtr;
+    char *tail;
+    int new, result;
+    ImportedCmdData *dataPtr;
+
+    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;
+    }
+    
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+	/*
+	 * Command already exists. Delete the old one.
+	 * Be careful to preserve any existing import links so we can
+	 * restore them down below.  That way, you can redefine a
+	 * command and its import status will remain intact.
+	 */
+
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+	oldRefPtr = cmdPtr->importRefPtr;
+	cmdPtr->importRefPtr = NULL;
+
+	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;
+
+    /*
+     * Plug in any existing import references found above.  Be sure
+     * to update all of these references to point to the new command.
+     */
+
+    if (oldRefPtr != NULL) {
+	cmdPtr->importRefPtr = oldRefPtr;
+	while (oldRefPtr != NULL) {
+	    refCmdPtr = oldRefPtr->importedCmdPtr;
+	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+	    dataPtr->realCmdPtr = cmdPtr;
+	    oldRefPtr = oldRefPtr->nextPtr;
+	}
+    }
+
+    /*
+     * 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;
+    ImportRef *oldRefPtr = NULL;
+    Namespace *nsPtr, *dummy1, *dummy2;
+    Command *cmdPtr, *refCmdPtr;
+    Tcl_HashEntry *hPtr;
+    char *tail;
+    int new, result;
+    ImportedCmdData *dataPtr;
+
+    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;
+    }
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+	/*
+	 * 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. 
+	 */
+
+	if (cmdPtr->objProc == TclInvokeStringCommand) {
+	    cmdPtr->objProc = proc;
+	    cmdPtr->objClientData = clientData;
+            cmdPtr->deleteProc = deleteProc;
+            cmdPtr->deleteData = clientData;
+	    return (Tcl_Command) cmdPtr;
+	}
+
+	/*
+	 * Otherwise, we delete the old command.  Be careful to preserve
+	 * any existing import links so we can restore them down below.
+	 * That way, you can redefine a command and its import status
+	 * will remain intact.
+	 */
+
+	oldRefPtr = cmdPtr->importRefPtr;
+	cmdPtr->importRefPtr = NULL;
+
+	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 *) Tcl_GetHashValue(hPtr));
+	}
+    }
+    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 = proc;
+    cmdPtr->objClientData = clientData;
+    cmdPtr->proc = TclInvokeObjectCommand;
+    cmdPtr->clientData = (ClientData) cmdPtr;
+    cmdPtr->deleteProc = deleteProc;
+    cmdPtr->deleteData = clientData;
+    cmdPtr->deleted = 0;
+    cmdPtr->importRefPtr = NULL;
+
+    /*
+     * Plug in any existing import references found above.  Be sure
+     * to update all of these references to point to the new command.
+     */
+
+    if (oldRefPtr != NULL) {
+	cmdPtr->importRefPtr = oldRefPtr;
+	while (oldRefPtr != NULL) {
+	    refCmdPtr = oldRefPtr->importedCmdPtr;
+	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+	    dataPtr->realCmdPtr = cmdPtr;
+	    oldRefPtr = oldRefPtr->nextPtr;
+	}
+    }
+    
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 will be moved to that namespace and will execute in
+ *	the context of that new 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 *newTail;
+    Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
+    Tcl_Command cmd;
+    Command *cmdPtr;
+    Tcl_HashEntry *hPtr, *oldHPtr;
+    int new, 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;
+    }
+    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;
+    }
+
+
+    /*
+     * Warning: any changes done in the code here are likely
+     * to be needed in Tcl_HideCommand() code too.
+     * (until the common parts are extracted out)     --dl
+     */
+
+    /*
+     * 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.
+     */
+    
+    oldHPtr = cmdPtr->hPtr;
+    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    cmdPtr->hPtr = hPtr;
+    cmdPtr->nsPtr = newNsPtr;
+    TclResetShadowedCmdRefs(interp, cmdPtr);
+
+    /*
+     * Now 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++;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCommandInfo --
+ *
+ *	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. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{
+    Tcl_Command cmd;
+    Command *cmdPtr;
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+	return 0;
+    }
+
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandInfo --
+ *
+ *	Returns various information about a Tcl command.
+ *
+ * Results:
+ *	If cmdName exists in interp, then *infoPtr is modified to
+ *	hold information about cmdName and 1 is returned.  If the
+ *	command doesn't exist then 0 is returned and *infoPtr isn't
+ *	modified.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{
+    Tcl_Command cmd;
+    Command *cmdPtr;
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+	return 0;
+    }
+
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandName --
+ *
+ *	Given a token returned by Tcl_CreateCommand, this procedure
+ *	returns the current name of the command (which may have changed
+ *	due to renaming).
+ *
+ * Results:
+ *	The return value is the name of the given command.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetCommandName(interp, command)
+    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. */
+{
+    Command *cmdPtr = (Command *) command;
+
+    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.
+	 */
+
+	return "";
+    }
+    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);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteCommand --
+ *
+ *	Remove the given command from the given interpreter.
+ *
+ * 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:
+ *	cmdName will no longer be recognized as a valid command for
+ *	interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DeleteCommand(interp, cmdName)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous Tcl_CreateInterp call). */
+    char *cmdName;		/* Name of command to remove. */
+{
+    Tcl_Command cmd;
+
+    /*
+     *  Find the desired command and delete it.
+     */
+
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+	return -1;
+    }
+    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;
+    ImportRef *refPtr, *nextRefPtr;
+    Tcl_Command importCmd;
+
+    /*
+     * 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;
+	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);
+    }
+
+    /*
+     * 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);
+    }
+
+    /*
+     * 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 --
+ *
+ *	Execute a Tcl command in a string.
+ *
+ * Results:
+ *	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 or Tcl_EvalObj:
+ *	you must copy it or lose it!
+ *
+ * Side effects:
+ *	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, string)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by previous call to Tcl_CreateInterp). */
+    char *string;		/* Pointer to TCL command to execute. */
+{
+    register Tcl_Obj *cmdPtr;
+    int length = strlen(string);
+    int result;
+
+    if (length > 0) {
+	/*
+	 * Initialize a Tcl object from the command string.
+	 */
+
+	TclNewObj(cmdPtr);
+	TclInitStringRep(cmdPtr, string, length);
+	Tcl_IncrRefCount(cmdPtr);
+
+	/*
+	 * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_EvalObj
+
+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. */
+    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;
+    Namespace *namespacePtr;
+
+    /*
+     * 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_ResetResult(interp);
+
+    /*
+     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
+     * it's probably because of an infinite loop somewhere.
+     */
+
+    iPtr->numLevels++;
+    if (iPtr->numLevels > iPtr->maxNestingDepth) {
+	iPtr->numLevels--;
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
+	return TCL_ERROR;
+    }
+
+    /*
+     * On the Mac, we will never reach the default recursion limit before blowing
+     * the stack. So we need to do a check here.
+     */
+    
+    if (TclpCheckStackSpace() == 0) {
+	/*NOTREACHED*/
+    	iPtr->numLevels--;
+    	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+    		"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
+    	return TCL_ERROR;
+    }
+
+    /*
+     * 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;
+    }
+
+    /*
+     * 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,
+     * or for a different namespace, or for the same namespace but
+     * with different name resolution rules, we recompile it.
+     *
+     * Precompiled objects, however, are immutable and therefore
+     * they are not recompiled, even if the epoch has changed.
+     */
+
+    if (iPtr->varFramePtr != NULL) {
+        namespacePtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        namespacePtr = iPtr->globalNsPtr;
+    }
+
+    if (objPtr->typePtr == &tclByteCodeType) {
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	
+	if ((codePtr->iPtr != iPtr)
+	        || (codePtr->compileEpoch != iPtr->compileEpoch)
+	        || (codePtr->nsPtr != namespacePtr)
+	        || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
+            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+                if (codePtr->iPtr != iPtr) {
+                    panic("Tcl_EvalObj: compiled script jumped interps");
+                }
+	        codePtr->compileEpoch = iPtr->compileEpoch;
+            } else {
+                tclByteCodeType.freeIntRepProc(objPtr);
+            }
+	}
+    }
+    if (objPtr->typePtr != &tclByteCodeType) {
+	/*
+	 * First reset any error line number information.
+	 */
+	
+	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;
+
+    /*
+     * Extract then reset the compilation flags in the interpreter.
+     * Resetting the flags must be done after any compilation.
+     */
+
+    flags = iPtr->evalFlags;
+    iPtr->evalFlags = 0;
+
+    /*
+     * Execute the commands. If the code was compiled from an empty string,
+     * don't bother executing the code.
+     */
+
+    numSrcChars = codePtr->numSrcChars;
+    if ((numSrcChars > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+	/*
+	 * 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);
+	}
+    } else {
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+
+    /*
+     * 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.
+     */
+
+    if ((oldCount == iPtr->cmdCount) && (Tcl_AsyncReady())) {
+	result = Tcl_AsyncInvoke(interp, result);
+    }
+
+    /*
+     * Free up any extra resources that were allocated.
+     */
+
+    iPtr->numLevels--;
+    if (iPtr->numLevels == 0) {
+	if (result == TCL_RETURN) {
+	    result = TclUpdateReturnInfo(iPtr);
+	}
+	if ((result != TCL_OK) && (result != TCL_ERROR)
+		&& !(flags & TCL_ALLOW_EXCEPTIONS)) {
+	    Tcl_ResetResult(interp);
+	    if (result == TCL_BREAK) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "invoked \"break\" outside of a loop", -1);
+	    } else if (result == TCL_CONTINUE) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "invoked \"continue\" outside of a loop", -1);
+	    } else {
+		char buf[50];
+		sprintf(buf, "command returned bad code: %d", result);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	    }
+	    result = TCL_ERROR;
+	}
+    }
+
+    /*
+     * If an error occurred, record information about what was being
+     * executed when the error occurred.
+     */
+
+    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	char buf[200];
+	char *ellipsis = "";
+	char *bytes;
+	int length;
+
+	/*
+	 * 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.
+	 */
+
+	bytes = Tcl_GetStringFromObj(objPtr, &length);
+	length = TclMin(numSrcChars, length);
+	if (length > 150) {
+	    length = 150;
+	    ellipsis = " ...";
+	}
+
+	if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+	    sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+		    length, bytes, ellipsis);
+	} else {
+	    sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+		    length, bytes, ellipsis);
+	}
+	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) {
+            badhiddenCmdToken:
+	    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 badhiddenCmdToken;
+        }
+	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;
+    }
+
+    /*
+     * 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_IncrRefCount(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;
+    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.
+     *
+     * Precompiled expressions, however, are immutable and therefore
+     * they are not recompiled, even if the epoch has changed.
+     *
+     * 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)) {
+            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+                if (codePtr->iPtr != iPtr) {
+                    panic("Tcl_ExprObj: compiled expression jumped interps");
+                }
+	        codePtr->compileEpoch = iPtr->compileEpoch;
+            } else {
+                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->type->freeProc != NULL) {
+		    auxDataPtr->type->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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateTrace --
+ *
+ *	Arrange for a procedure to be called to trace command execution.
+ *
+ * Results:
+ *	The return value is a token for the trace, which may be passed
+ *	to Tcl_DeleteTrace to eliminate the trace.
+ *
+ * Side effects:
+ *	From now on, proc will be called just before a command procedure
+ *	is called to execute a Tcl command.  Calls to proc will have the
+ *	following form:
+ *
+ *	void
+ *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
+ *		argc, argv)
+ *	    ClientData clientData;
+ *	    Tcl_Interp *interp;
+ *	    int level;
+ *	    char *command;
+ *	    int (*cmdProc)();
+ *	    ClientData cmdClientData;
+ *	    int argc;
+ *	    char **argv;
+ *	{
+ *	}
+ *
+ *	The clientData and interp arguments to proc will be the same
+ *	as the corresponding arguments to this procedure.  Level gives
+ *	the nesting level of command interpretation for this interpreter
+ *	(0 corresponds to top level).  Command gives the ASCII text of
+ *	the raw command, cmdProc and cmdClientData give the procedure that
+ *	will be called to process the command and the ClientData value it
+ *	will receive, and argc and argv give the arguments to the
+ *	command, after any argument parsing and substitution.  Proc
+ *	does not return a value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Trace
+Tcl_CreateTrace(interp, level, proc, clientData)
+    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 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;
+    tracePtr->clientData = clientData;
+    tracePtr->nextPtr = iPtr->tracePtr;
+    iPtr->tracePtr = tracePtr;
+
+    return (Tcl_Trace) tracePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteTrace --
+ *
+ *	Remove a trace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	From now on there will be no more calls to the procedure given
+ *	in trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteTrace(interp, trace)
+    Tcl_Interp *interp;		/* Interpreter that contains trace. */
+    Tcl_Trace trace;		/* Token for trace (returned previously by
+				 * Tcl_CreateTrace). */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Trace *tracePtr = (Trace *) trace;
+    register Trace *tracePtr2;
+
+    if (iPtr->tracePtr == tracePtr) {
+	iPtr->tracePtr = tracePtr->nextPtr;
+	ckfree((char *) tracePtr);
+    } else {
+	for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
+		tracePtr2 = tracePtr2->nextPtr) {
+	    if (tracePtr2->nextPtr == tracePtr) {
+		tracePtr2->nextPtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+		break;
+	    }
+	}
+    }
+
+    if (iPtr->tracePtr == NULL) {
+	/*
+	 * When compiling new code, allow commands to be compiled inline.
+	 */
+
+	iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddErrorInfo --
+ *
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AddErrorInfo(interp, message)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    char *message;		/* Message to record. */
+{
+    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 we are just starting to log an error, errorInfo is initialized
+     * from the error message in the interpreter's result.
+     */
+
+    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".
+	 */
+
+	if (!(iPtr->flags & ERROR_CODE_SET)) {
+	    (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
+		    TCL_GLOBAL_ONLY);
+	}
+    }
+
+    /*
+     * Now append "message" to the end of errorInfo.
+     */
+
+    if (length != 0) {
+	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 */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarEval --
+ *
+ *	Given a variable number of string arguments, concatenate them
+ *	all together and execute the result as a Tcl command.
+ *
+ * Results:
+ *	A standard Tcl return result.  An error message or other
+ *	result may be left in interp->result.
+ *
+ * Side effects:
+ *	Depends on what was done by the command.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* VARARGS2 */ /* ARGSUSED */
+int
+Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    va_list argList;
+    Tcl_DString buf;
+    char *string;
+    Tcl_Interp *interp;
+    int result;
+
+    /*
+     * Copy the strings one after the other into a single larger
+     * string.  Use stack-allocated space for small commands, but if
+     * the command gets too large than call ckalloc to create the
+     * space.
+     */
+
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    Tcl_DStringInit(&buf);
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	Tcl_DStringAppend(&buf, string, -1);
+    }
+    va_end(argList);
+
+    result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
+    Tcl_DStringFree(&buf);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobalEval --
+ *
+ *	Evaluate a command at global level in an interpreter.
+ *
+ * Results:
+ *	A standard Tcl result is returned, and interp->result is
+ *	modified accordingly.
+ *
+ * Side effects:
+ *	The command string is 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_GlobalEval(interp, command)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
+    char *command;		/* Command to evaluate. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = Tcl_Eval(interp, command);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ *	for an interpreter at once.
+ *
+ * Results:
+ *	The return value is the old limit on nesting for interp.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetRecursionLimit(interp, depth)
+    Tcl_Interp *interp;			/* Interpreter whose nesting limit
+					 * is to be set. */
+    int depth;				/* New value for maximimum depth. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int old;
+
+    old = iPtr->maxNestingDepth;
+    if (depth > 0) {
+	iPtr->maxNestingDepth = depth;
+    }
+    return old;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AllowExceptions --
+ *
+ *	Sets a flag in an interpreter so that exceptions can occur
+ *	in the next call to Tcl_Eval without them being turned into
+ *	errors.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's
+ *	evalFlags structure.  See the reference documentation for
+ *	more details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AllowExceptions(interp)
+    Tcl_Interp *interp;		/* Interpreter in which to set flag. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
+}
+
diff --git a/tcl/generic/tclBinary.c b/tcl/generic/tclBinary.c
new file mode 100644
index 00000000000..b059ce83aea
--- /dev/null
+++ b/tcl/generic/tclBinary.c
@@ -0,0 +1,1013 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <math.h>
+#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((VOID *) cursor, (VOID *) str,
+				    (size_t) count);
+			} else {
+			    memcpy((VOID *) cursor, (VOID *) 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(UCHAR(**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') {
+	/*
+	 * For floating point types, we need to copy the data using
+	 * memcpy to avoid alignment issues.
+	 */
+
+	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (cmd == 'd') {
+	    memcpy((*cursorPtr), &dvalue, sizeof(double));
+	    (*cursorPtr) += sizeof(double);
+	} else {
+	    float fvalue;
+
+	    /*
+	     * 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 (fabs(dvalue) > (double)FLT_MAX) {
+		fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
+	    } else {
+		fvalue = (float) dvalue;
+	    }
+	    memcpy((*cursorPtr), &fvalue, sizeof(float));
+	    (*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;			/* Format character from "binary scan" */
+{
+    int value;
+
+    /*
+     * We cannot rely on the compiler to properly sign extend integer values
+     * when we cast from smaller values to larger values because we don't know
+     * the exact size of the integer types.  So, we have to handle sign
+     * extension explicitly by checking the high bit and padding with 1's as
+     * needed.
+     */
+
+    switch ((char) type) {
+	case 'c':
+	    value = buffer[0];
+
+	    if (value & 0x80) {
+		value |= -0x100;
+	    }
+	    return Tcl_NewLongObj((long)value);
+	case 's':
+	    value = (((unsigned char)buffer[0])
+		    + ((unsigned char)buffer[1] << 8));
+	    goto shortValue;
+	case 'S':
+	    value = (((unsigned char)buffer[1])
+		    + ((unsigned char)buffer[0] << 8));
+	    shortValue:
+	    if (value & 0x8000) {
+		value |= -0x10000;
+	    }
+	    return Tcl_NewLongObj((long)value);
+	case 'i':
+	    value =  (((unsigned char)buffer[0])
+		    + ((unsigned char)buffer[1] << 8)
+		    + ((unsigned char)buffer[2] << 16)
+		    + ((unsigned char)buffer[3] << 24));
+	    goto intValue;
+	case 'I':
+	    value = (((unsigned char)buffer[3])
+		    + ((unsigned char)buffer[2] << 8)
+		    + ((unsigned char)buffer[1] << 16)
+		    + ((unsigned char)buffer[0] << 24));
+	    intValue:
+	    /*
+	     * Check to see if the value was sign extended properly on
+	     * systems where an int is more than 32-bits.
+	     */
+
+	    if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
+		value -= (((unsigned int)1)<<31);
+		value -= (((unsigned int)1)<<31);
+	    }
+		
+	    return Tcl_NewLongObj((long)value);
+	case 'f': {
+	    float fvalue;
+	    memcpy(&fvalue, buffer, sizeof(float));
+	    return Tcl_NewDoubleObj(fvalue);
+	}
+	case 'd': {
+	    double dvalue;
+	    memcpy(&dvalue, buffer, sizeof(double));
+	    return Tcl_NewDoubleObj(dvalue);
+	}
+    }
+    return NULL;
+}
diff --git a/tcl/generic/tclCkalloc.c b/tcl/generic/tclCkalloc.c
new file mode 100644
index 00000000000..fa089fccfea
--- /dev/null
+++ b/tcl/generic/tclCkalloc.c
@@ -0,0 +1,817 @@
+/* 
+ * tclCkalloc.c --
+ *
+ *    Interface to malloc and free that provides support for debugging problems
+ *    involving overwritten, double freeing memory and loss of memory.
+ *
+ * Copyright (c) 1991-1994 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.
+ *
+ * This code contributed by Karl Lehenbauer and Mark Diekhans
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#define FALSE	0
+#define TRUE	1
+
+#ifdef TCL_MEM_DEBUG
+
+/*
+ * One of the following structures is allocated each time the
+ * "memory tag" command is invoked, to hold the current tag.
+ */
+
+typedef struct MemTag {
+    int refCount;		/* Number of mem_headers referencing
+				 * this tag. */
+    char string[4];		/* Actual size of string will be as
+				 * large as needed for actual tag.  This
+				 * must be the last field in the structure. */
+} MemTag;
+
+#define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
+
+static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers
+				 * (set by "memory tag" command). */
+
+/*
+ * One of the following structures is allocated just before each
+ * dynamically allocated chunk of memory, both to record information
+ * about the chunk and to help detect chunk under-runs.
+ */
+
+#define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
+struct mem_header {
+    struct mem_header *flink;
+    struct mem_header *blink;
+    MemTag *tagPtr;		/* Tag from "memory tag" command;  may be
+				 * NULL. */
+    char *file;
+    long length;
+    int line;
+    unsigned char low_guard[LOW_GUARD_SIZE];
+				/* Aligns body on 8-byte boundary, plus
+				 * provides at least 8 additional guard bytes
+				 * to detect underruns. */
+    char body[1];		/* First byte of client's space.  Actual
+				 * size of this field will be larger than
+				 * one. */
+};
+
+static struct mem_header *allocHead = NULL;  /* List of allocated structures */
+
+#define GUARD_VALUE  0141
+
+/*
+ * The following macro determines the amount of guard space *above* each
+ * chunk of memory.
+ */
+
+#define HIGH_GUARD_SIZE 8
+
+/*
+ * The following macro computes the offset of the "body" field within
+ * mem_header.  It is used to get back to the header pointer from the
+ * body pointer that's used by clients.
+ */
+
+#define BODY_OFFSET \
+	((unsigned long) (&((struct mem_header *) 0)->body))
+
+static int total_mallocs = 0;
+static int total_frees = 0;
+static int current_bytes_malloced = 0;
+static int maximum_bytes_malloced = 0;
+static int current_malloc_packets = 0;
+static int maximum_malloc_packets = 0;
+static int break_on_malloc = 0;
+static int trace_on_at_malloc = 0;
+static int  alloc_tracing = FALSE;
+static int  init_malloced_bodies = TRUE;
+#ifdef MEM_VALIDATE
+    static int  validate_memory = TRUE;
+#else
+    static int  validate_memory = FALSE;
+#endif
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDumpMemoryInfo --
+ *     Display the global memory management statistics.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclDumpMemoryInfo(outFile) 
+    FILE *outFile;
+{
+        fprintf(outFile,"total mallocs             %10d\n", 
+                total_mallocs);
+        fprintf(outFile,"total frees               %10d\n", 
+                total_frees);
+        fprintf(outFile,"current packets allocated %10d\n", 
+                current_malloc_packets);
+        fprintf(outFile,"current bytes allocated   %10d\n", 
+                current_bytes_malloced);
+        fprintf(outFile,"maximum packets allocated %10d\n", 
+                maximum_malloc_packets);
+        fprintf(outFile,"maximum bytes allocated   %10d\n", 
+                maximum_bytes_malloced);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateMemory --
+ *     Procedure to validate allocted memory guard zones.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ValidateMemory(memHeaderP, file, line, nukeGuards)
+    struct mem_header *memHeaderP;
+    char              *file;
+    int                line;
+    int                nukeGuards;
+{
+    unsigned char *hiPtr;
+    int   idx;
+    int   guard_failed = FALSE;
+    int byte;
+    
+    for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
+        byte = *(memHeaderP->low_guard + idx);
+        if (byte != GUARD_VALUE) {
+            guard_failed = TRUE;
+            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) {
+        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,
+		memHeaderP->file, memHeaderP->line);
+        panic ("Memory validation failure");
+    }
+
+    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
+    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
+        byte = *(hiPtr + idx);
+        if (byte != GUARD_VALUE) {
+            guard_failed = TRUE;
+            fflush (stdout);
+	    byte &= 0xff;
+            fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", idx, byte,
+		    (isprint(UCHAR(byte)) ? byte : ' '));
+        }
+    }
+
+    if (guard_failed) {
+        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",
+		memHeaderP->length, memHeaderP->file,
+		memHeaderP->line);
+        panic("Memory validation failure");
+    }
+
+    if (nukeGuards) {
+        memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); 
+        memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE); 
+    }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ValidateAllMemory --
+ *     Validates guard regions for all allocated memory.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tcl_ValidateAllMemory (file, line)
+    char  *file;
+    int    line;
+{
+    struct mem_header *memScanP;
+
+    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
+        ValidateMemory(memScanP, file, line, FALSE);
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DumpActiveMemory --
+ *     Displays all allocated memory to stderr.
+ *
+ * Results:
+ *     Return TCL_ERROR if an error accessing the file occures, `errno' 
+ *     will have the file error number left in it.
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_DumpActiveMemory (fileName)
+    char *fileName;
+{
+    FILE              *fileP;
+    struct mem_header *memScanP;
+    char              *address;
+
+    fileP = fopen(fileName, "w");
+    if (fileP == NULL)
+        return TCL_ERROR;
+
+    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
+        address = &memScanP->body [0];
+        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,
+		 (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
+	(void) fputc('\n', fileP);
+    }
+    fclose (fileP);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbCkalloc - debugging ckalloc
+ *
+ *        Allocate the requested amount of space plus some extra for
+ *        guard bands at both ends of the request, plus a size, panicing 
+ *        if there isn't enough space, then write in the guard bands
+ *        and return the address of the space in the middle that the
+ *        user asked for.
+ *
+ *        The second and third arguments are file and line, these contain
+ *        the filename and line number corresponding to the caller.
+ *        These are sent by the ckalloc macro; it uses the preprocessor
+ *        autodefines __FILE__ and __LINE__.
+ *
+ *----------------------------------------------------------------------
+ */
+char *
+Tcl_DbCkalloc(size, file, line)
+    unsigned int size;
+    char        *file;
+    int          line;
+{
+    struct mem_header *result;
+
+    if (validate_memory)
+        Tcl_ValidateAllMemory (file, line);
+
+    result = (struct mem_header *) TclpAlloc((unsigned)size + 
+                              sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+    if (result == NULL) {
+        fflush(stdout);
+        TclDumpMemoryInfo(stderr);
+        panic("unable to alloc %d bytes, %s line %d", size, file, 
+              line);
+    }
+
+    /*
+     * Fill in guard zones and size.  Also initialize the contents of
+     * the block with bogus bytes to detect uses of initialized data.
+     * Link into allocated list.
+     */
+    if (init_malloced_bodies) {
+        memset ((VOID *) result, GUARD_VALUE,
+		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+    } else {
+	memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+    }
+    result->length = size;
+    result->tagPtr = curTagPtr;
+    if (curTagPtr != NULL) {
+	curTagPtr->refCount++;
+    }
+    result->file = file;
+    result->line = line;
+    result->flink = allocHead;
+    result->blink = NULL;
+    if (allocHead != NULL)
+        allocHead->blink = result;
+    allocHead = result;
+
+    total_mallocs++;
+    if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
+        (void) fflush(stdout);
+        fprintf(stderr, "reached malloc trace enable point (%d)\n",
+                total_mallocs);
+        fflush(stderr);
+        alloc_tracing = TRUE;
+        trace_on_at_malloc = 0;
+    }
+
+    if (alloc_tracing)
+        fprintf(stderr,"ckalloc %lx %d %s %d\n",
+		(long unsigned int) result->body, size, file, line);
+
+    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
+        break_on_malloc = 0;
+        (void) fflush(stdout);
+        fprintf(stderr,"reached malloc break limit (%d)\n", 
+                total_mallocs);
+        fprintf(stderr, "program will now enter C debugger\n");
+        (void) fflush(stderr);
+	abort();
+    }
+
+    current_malloc_packets++;
+    if (current_malloc_packets > maximum_malloc_packets)
+        maximum_malloc_packets = current_malloc_packets;
+    current_bytes_malloced += size;
+    if (current_bytes_malloced > maximum_bytes_malloced)
+        maximum_bytes_malloced = current_bytes_malloced;
+
+    return result->body;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbCkfree - debugging ckfree
+ *
+ *        Verify that the low and high guards are intact, and if so
+ *        then free the buffer else panic.
+ *
+ *        The guards are erased after being checked to catch duplicate
+ *        frees.
+ *
+ *        The second and third arguments are file and line, these contain
+ *        the filename and line number corresponding to the caller.
+ *        These are sent by the ckfree macro; it uses the preprocessor
+ *        autodefines __FILE__ and __LINE__.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DbCkfree(ptr, file, line)
+    char *  ptr;
+    char     *file;
+    int       line;
+{
+    /*
+     * The following cast is *very* tricky.  Must convert the pointer
+     * to an integer before doing arithmetic on it, because otherwise
+     * the arithmetic will be done differently (and incorrectly) on
+     * word-addressed machines such as Crays (will subtract only bytes,
+     * even though BODY_OFFSET is in words on these machines).
+     */
+
+    struct mem_header *memp = (struct mem_header *)
+	    (((unsigned long) ptr) - BODY_OFFSET);
+
+    if (alloc_tracing)
+        fprintf(stderr, "ckfree %lx %ld %s %d\n",
+		(long unsigned int) memp->body, memp->length, file, line);
+
+    if (validate_memory)
+        Tcl_ValidateAllMemory(file, line);
+
+    ValidateMemory(memp, file, line, TRUE);
+    if (init_malloced_bodies) {
+	memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
+    }
+
+    total_frees++;
+    current_malloc_packets--;
+    current_bytes_malloced -= memp->length;
+
+    if (memp->tagPtr != NULL) {
+	memp->tagPtr->refCount--;
+	if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
+	    TclpFree((char *) memp->tagPtr);
+	}
+    }
+
+    /*
+     * Delink from allocated list
+     */
+    if (memp->flink != NULL)
+        memp->flink->blink = memp->blink;
+    if (memp->blink != NULL)
+        memp->blink->flink = memp->flink;
+    if (allocHead == memp)
+        allocHead = memp->flink;
+    TclpFree((char *) memp);
+    return 0;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tcl_DbCkrealloc - debugging ckrealloc
+ *
+ *	Reallocate a chunk of memory by allocating a new one of the
+ *	right size, copying the old data to the new location, and then
+ *	freeing the old memory space, using all the memory checking
+ *	features of this package.
+ *
+ *--------------------------------------------------------------------
+ */
+char *
+Tcl_DbCkrealloc(ptr, size, file, line)
+    char *ptr;
+    unsigned int size;
+    char *file;
+    int line;
+{
+    char *new;
+    unsigned int copySize;
+
+    /*
+     * See comment from Tcl_DbCkfree before you change the following
+     * line.
+     */
+
+    struct mem_header *memp = (struct mem_header *)
+	    (((unsigned long) ptr) - BODY_OFFSET);
+
+    copySize = size;
+    if (copySize > (unsigned int) memp->length) {
+	copySize = memp->length;
+    }
+    new = Tcl_DbCkalloc(size, file, line);
+    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+    Tcl_DbCkfree(ptr, file, line);
+    return(new);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Alloc, et al. --
+ *
+ *	These functions are defined in terms of the debugging versions
+ *	when TCL_MEM_DEBUG is set.
+ *
+ * Results:
+ *	Same as the debug versions.
+ *
+ * Side effects:
+ *	Same as the debug versions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+
+char *
+Tcl_Alloc(size)
+    unsigned int size;
+{
+    return Tcl_DbCkalloc(size, "unknown", 0);
+}
+
+void
+Tcl_Free(ptr)
+    char *ptr;
+{
+    Tcl_DbCkfree(ptr, "unknown", 0);
+}
+
+char *
+Tcl_Realloc(ptr, size)
+    char *ptr;
+    unsigned int size;
+{
+    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MemoryCmd --
+ *     Implements the TCL memory command:
+ *       memory info
+ *       memory display
+ *       break_on_malloc count
+ *       trace_on_at_malloc count
+ *       trace on|off
+ *       validate on|off
+ *
+ * Results:
+ *     Standard TCL results.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+static int
+MemoryCmd (clientData, interp, argc, argv)
+    ClientData  clientData;
+    Tcl_Interp *interp;
+    int         argc;
+    char      **argv;
+{
+    char *fileName;
+    Tcl_DString buffer;
+    int result;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option [args..]\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1],"active") == 0) {
+        if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " active file\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+	if (fileName == NULL) {
+	    return TCL_ERROR;
+	}
+	result = Tcl_DumpActiveMemory (fileName);
+	Tcl_DStringFree(&buffer);
+	if (result != TCL_OK) {
+	    Tcl_AppendResult(interp, "error accessing ", argv[2], 
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    if (strcmp(argv[1],"break_on_malloc") == 0) {
+        if (argc != 3) {
+            goto argError;
+	}
+        if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+        return TCL_OK;
+    }
+    if (strcmp(argv[1],"info") == 0) {
+        TclDumpMemoryInfo(stdout);
+        return TCL_OK;
+    }
+    if (strcmp(argv[1],"init") == 0) {
+        if (argc != 3) {
+            goto bad_suboption;
+	}
+        init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+        return TCL_OK;
+    }
+    if (strcmp(argv[1],"tag") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " tag string\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
+	    TclpFree((char *) curTagPtr);
+	}
+	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) {
+            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) {
+            goto argError;
+	}
+        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;
+	}
+        validate_memory = (strcmp(argv[2],"on") == 0);
+        return TCL_OK;
+    }
+
+    Tcl_AppendResult(interp, "bad option \"", argv[1],
+	    "\": should be active, break_on_malloc, info, init, ",
+	    "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
+    return TCL_ERROR;
+
+argError:
+    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+	    " ", argv[1], " count\"", (char *) NULL);
+    return TCL_ERROR;
+
+bad_suboption:
+    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+	    " ", argv[1], " on|off\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitMemory --
+ *     Initialize the memory command.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tcl_InitMemory(interp)
+    Tcl_Interp *interp;
+{
+    Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, 
+	    (Tcl_CmdDeleteProc *) NULL);
+}
+
+#else
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Alloc --
+ *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does check
+ *     that memory was actually allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Alloc (size)
+    unsigned int size;
+{
+        char *result;
+
+        result = TclpAlloc(size);
+	/* CYGNUS LOCAL -- check that size is not zero */
+        if (result == NULL && size ) 
+                panic("unable to alloc %d bytes", size);
+	/* End CYGNUS LOCAL */
+        return result;
+}
+
+char *
+Tcl_DbCkalloc(size, file, line)
+    unsigned int size;
+    char        *file;
+    int          line;
+{
+    char *result;
+
+    result = (char *) TclpAlloc(size);
+
+    if (result == NULL) {
+        fflush(stdout);
+        panic("unable to alloc %d bytes, %s line %d", size, file, 
+              line);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Realloc --
+ *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does 
+ *     check that memory was actually allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Realloc(ptr, size)
+    char *ptr;
+    unsigned int size;
+{
+    char *result;
+
+    result = TclpRealloc(ptr, size);
+    if (result == NULL) 
+	panic("unable to realloc %d bytes", size);
+    return result;
+}
+
+char *
+Tcl_DbCkrealloc(ptr, size, file, line)
+    char *ptr;
+    unsigned int size;
+    char *file;
+    int line;
+{
+    char *result;
+
+    result = (char *) TclpRealloc(ptr, size);
+
+    if (result == NULL) {
+        fflush(stdout);
+        panic("unable to realloc %d bytes, %s line %d", size, file, 
+              line);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Free --
+ *     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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Free (ptr)
+    char *ptr;
+{
+        TclpFree(ptr);
+}
+
+int
+Tcl_DbCkfree(ptr, file, line)
+    char *  ptr;
+    char     *file;
+    int       line;
+{
+    TclpFree(ptr);
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitMemory --
+ *     Dummy initialization for memory command, which is only available 
+ *     if TCL_MEM_DEBUG is on.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+void
+Tcl_InitMemory(interp)
+    Tcl_Interp *interp;
+{
+}
+
+#undef Tcl_DumpActiveMemory
+#undef Tcl_ValidateAllMemory
+
+extern int		Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
+extern void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
+			    int line));
+
+int
+Tcl_DumpActiveMemory(fileName)
+    char *fileName;
+{
+    return TCL_OK;
+}
+
+void
+Tcl_ValidateAllMemory(file, line)
+    char  *file;
+    int    line;
+{
+}
+
+#endif
diff --git a/tcl/generic/tclClock.c b/tcl/generic/tclClock.c
new file mode 100644
index 00000000000..29ed3560539
--- /dev/null
+++ b/tcl/generic/tclClock.c
@@ -0,0 +1,307 @@
+/* 
+ * tclClock.c --
+ *
+ *	Contains the time and date related commands.  This code
+ *	is derived from the time and date facilities of TclX,
+ *	by Mark Diekhans and Karl Lehenbauer.
+ *
+ * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Function prototypes for local procedures in this file:
+ */
+
+static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
+			    unsigned long clockVal, int useGMT,
+			    char *format));
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_ClockObjCmd --
+ *
+ *	This procedure is invoked to process the "clock" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+Tcl_ClockObjCmd (client, interp, objc, objv)
+    ClientData client;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument values. */
+{
+    Tcl_Obj *resultPtr;
+    int index;
+    Tcl_Obj *CONST *objPtr;
+    int useGMT = 0;
+    char *format = "%a %b %d %X %Z %Y";
+    int dummy;
+    unsigned long baseClock, clockVal;
+    long zone;
+    Tcl_Obj *baseObjPtr = NULL;
+    char *scanStr;
+    
+    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;
+    }
+
+    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, 2, objv, NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
+	    return TCL_OK;
+	case 1:			/* format */
+	    if ((objc < 3) || (objc > 7)) {
+		wrongFmtArgs:
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"clockval ?-format string? ?-gmt boolean?");
+		return TCL_ERROR;
+	    }
+
+	    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;
+		}
+		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, 2, objv,
+			"dateString ?-base clockValue? ?-gmt boolean?");
+		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;
+	    }
+
+	    if (baseObjPtr != NULL) {
+		if (Tcl_GetLongFromObj(interp, baseObjPtr,
+			(long*) &baseClock) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } else {
+		baseClock = TclpGetSeconds();
+	    }
+
+	    if (useGMT) {
+		zone = -50000; /* Force GMT */
+	    } else {
+		zone = TclpGetTimeZone((unsigned long) baseClock);
+	    }
+
+	    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;
+	    }
+
+	    Tcl_SetLongObj(resultPtr, (long) clockVal);
+	    return TCL_OK;
+	case 3:			/* seconds */
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
+	    return TCL_OK;
+	default:
+	    return TCL_ERROR;	/* Should never be reached. */
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FormatClock --
+ *
+ *      Formats a time value based on seconds into a human readable
+ *	string.
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+FormatClock(interp, clockVal, useGMT, format)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    unsigned long clockVal;	       	/* Time in seconds. */
+    int useGMT;				/* Boolean */
+    char *format;			/* Format string */
+{
+    struct tm *timeDataPtr;
+    Tcl_DString buffer;
+    int bufSize;
+    char *p;
+#ifdef TCL_USE_TIMEZONE_VAR
+    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.
+     */
+    static int  calledTzset = 0;
+
+    if (!calledTzset) {
+        tzset();
+        calledTzset = 1;
+    }
+#endif
+
+#ifdef TCL_USE_TIMEZONE_VAR
+    /*
+     * This is a horrible kludge for systems not having the timezone in
+     * struct tm.  No matter what was specified, they use the global time
+     * zone.  (Thanks Solaris).
+     */
+    if (useGMT) {
+        char *varValue;
+
+        varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
+        if (varValue != NULL) {
+	    savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
+        } else {
+            savedTZEnv = NULL;
+	}
+        Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
+        savedTimeZone = timezone;
+        timezone = 0;
+        tzset();
+    }
+#endif
+
+    timeDataPtr = TclpGetDate((time_t *) &clockVal, useGMT);
+    
+    /*
+     * Make a guess at the upper limit on the substituted string size
+     * based on the number of percents in the string.
+     */
+
+    for (bufSize = 1, p = format; *p != '\0'; p++) {
+	if (*p == '%') {
+	    bufSize += 40;
+	} else {
+	    bufSize++;
+	}
+    }
+    Tcl_DStringInit(&buffer);
+    Tcl_DStringSetLength(&buffer, bufSize);
+
+    if ((TclStrftime(buffer.string, (unsigned int) bufSize, format,
+	    timeDataPtr) == 0) && (*format != '\0')) {
+	Tcl_AppendStringsToObj(resultPtr, "bad format string \"",
+		format, "\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+#ifdef TCL_USE_TIMEZONE_VAR
+    if (useGMT) {
+        if (savedTZEnv != NULL) {
+            Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
+            ckfree(savedTZEnv);
+        } else {
+            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
+        }
+        timezone = savedTimeZone;
+        tzset();
+    }
+#endif
+
+    Tcl_SetStringObj(resultPtr, buffer.string, -1);
+    Tcl_DStringFree(&buffer);
+    return TCL_OK;
+}
+
diff --git a/tcl/generic/tclCmdAH.c b/tcl/generic/tclCmdAH.c
new file mode 100644
index 00000000000..4382b508220
--- /dev/null
+++ b/tcl/generic/tclCmdAH.c
@@ -0,0 +1,1977 @@
+/* 
+ * tclCmdAH.c --
+ *
+ *	This file contains the top-level command routines for most of
+ *	the Tcl built-in commands whose names begin with the letters
+ *	A to H.
+ *
+ * Copyright (c) 1987-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static char *		GetTypeFromMode _ANSI_ARGS_((int mode));
+static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *varName, struct stat *statPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_BreakCmd --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_BreakCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], "\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_BREAK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    register int i;
+    int body, result;
+    char *string, *arg;
+    int argLen, caseObjc;
+    Tcl_Obj *CONST *caseObjv;
+    Tcl_Obj *armPtr;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"string ?in? patList body ... ?default body?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
+     */
+    
+    string = Tcl_GetStringFromObj(objv[1], &argLen);
+    body = -1;
+
+    arg = Tcl_GetStringFromObj(objv[2], &argLen);
+    if (strcmp(arg, "in") == 0) {
+	i = 3;
+    } else {
+	i = 2;
+    }
+    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
+     */
+
+    if (caseObjc == 1) {
+	Tcl_Obj **newObjv;
+	
+	Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+	caseObjv = newObjv;
+    }
+
+    for (i = 0;  i < caseObjc;  i += 2) {
+	int patObjc, j;
+	char **patObjv;
+	char *pat;
+	register char *p;
+
+	if (i == (caseObjc-1)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "extra case pattern with no body", -1);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Check for special case of single pattern (no list) with
+	 * no backslash sequences.
+	 */
+
+	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 ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
+		body = i+1;
+	    }
+	    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, pat, &patObjc, &patObjv);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	for (j = 0; j < patObjc; j++) {
+	    if (Tcl_StringMatch(string, patObjv[j])) {
+		body = i+1;
+		break;
+	    }
+	}
+	ckfree((char *) patObjv);
+	if (j < patObjc) {
+	    break;
+	}
+    }
+
+    match:
+    if (body != -1) {
+	armPtr = caseObjv[body-1];
+	result = Tcl_EvalObj(interp, caseObjv[body]);
+	if (result == TCL_ERROR) {
+	    char msg[100];
+	    
+	    arg = Tcl_GetStringFromObj(armPtr, &argLen);
+	    sprintf(msg, "\n    (\"%.*s\" arm line %d)", argLen, arg,
+	            interp->errorLine);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	}
+	return result;
+    }
+
+    /*
+     * Nothing matched: return nothing.
+     */
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CatchObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    Tcl_Obj *varNamePtr = NULL;
+    int result;
+
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * 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.
+     */
+    
+    if (objc == 3) {
+	varNamePtr = objv[2];
+    }
+    
+    result = Tcl_EvalObj(interp, objv[1]);
+    
+    if (objc == 3) {
+	if (Tcl_ObjSetVar2(interp, varNamePtr, 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);
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CdObjCmd --
+ *
+ *	This procedure is invoked to process the "cd" 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_CdObjCmd(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 *dirName;
+    int dirLength;
+    Tcl_DString buffer;
+    int result;
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dirName");
+	return TCL_ERROR;
+    }
+
+    if (objc == 2) {
+	dirName = Tcl_GetStringFromObj(objv[1], &dirLength);
+    } else {
+	dirName = "~";
+    }
+    dirName = Tcl_TranslateFileName(interp, dirName, &buffer);
+    if (dirName == NULL) {
+	return TCL_ERROR;
+    }
+    result = TclChdir(interp, dirName);
+    Tcl_DStringFree(&buffer);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConcatObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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 (objc >= 2) {
+	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ContinueCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		"\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_CONTINUE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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 ((objc < 2) || (objc > 4)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
+	return TCL_ERROR;
+    }
+    
+    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 (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_SetObjResult(interp, objv[1]);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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;
+    register Tcl_Obj *objPtr;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
+	return TCL_ERROR;
+    }
+    
+    if (objc == 2) {
+	result = Tcl_EvalObj(interp, objv[1]);
+    } else {
+	/*
+	 * More than one argument: concatenate them together with spaces
+	 * between, then evaluate the result.
+	 */
+    
+	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+	result = Tcl_EvalObj(interp, objPtr);
+	Tcl_DecrRefCount(objPtr);  /* we're done with the object */
+    }
+    if (result == TCL_ERROR) {
+	char msg[60];
+	sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
+	Tcl_AddObjErrorInfo(interp, msg, -1);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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 ((objc != 1) && (objc != 2)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
+	return TCL_ERROR;
+    }
+    
+    if (objc == 1) {
+	value = 0;
+    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    Tcl_Exit(value);
+    /*NOTREACHED*/
+    return TCL_OK;			/* Better not ever reach this! */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ExprObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    register Tcl_Obj *objPtr;
+    Tcl_Obj *resultPtr;
+    register char *bytes;
+    int length, i, result;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    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 */
+	}
+	return result;
+    }
+
+    /*
+     * 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);
+    }
+
+    /*
+     * 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.
+     */
+    
+    Tcl_DecrRefCount(objPtr);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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, *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;
+
+/*
+ * 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;
+    }
+    
+    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);
+    
+
+    /*
+     * 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;
+	    }
+
+	    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.
+	     */
+
+	    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);
+	    }
+
+	    /*
+	     * 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_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;
+	}
+    	case FILE_TAIL: {
+	    int pargc;
+	    char **pargv;
+
+	    if (objc != 3) {
+	    	errorString = "tail name";
+	    	goto not3Args;
+	    }
+	    
+	    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.
+	     */
+
+	    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);
+	    }
+
+	    /*
+	     * 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_SetStringObj(resultPtr, pargv[pargc - 1], -1);
+	    	}
+	    }
+	    ckfree((char *)pargv);
+	    goto done;
+	}
+	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;
+	}
+	case FILE_EXTENSION:
+	    if (objc != 3) {
+	    	errorString = "extension name";
+	    	goto not3Args;
+	    }
+	    extension = TclGetExtension(Tcl_GetStringFromObj(objv[2],&length));
+
+	    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;
+	}
+	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;
+	}
+	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;
+	}
+	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;
+	}
+	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;
+	}
+	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;
+	}
+	case FILE_NATIVENAME:
+	    fileName = Tcl_TranslateFileName(interp,
+	    	    Tcl_GetStringFromObj(objv[2], &length), &buffer);
+	    if (fileName == NULL) {
+		result = TCL_ERROR ;
+	    } else {
+		Tcl_SetStringObj(resultPtr, fileName, -1);
+	    }
+	    goto done;
+    }
+
+    /*
+     * Next, handle operations that can be satisfied with the "access"
+     * kernel call.
+     */
+
+    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:
+	    /*
+	     * The result might have been set within Tcl_TranslateFileName
+	     * (like no such user "blah" for file exists ~blah)
+	     * but we don't want to flag an error in that case.
+	     */
+	    if (fileName == NULL) {
+		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+	    } else {
+		Tcl_SetBooleanObj(resultPtr, (TclAccess(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 (fileName == NULL) {
+	result = TCL_ERROR;
+	goto done;
+    }
+    
+    switch (index) {
+    	case FILE_ATIME:
+    	    if (objc != 3) {
+	    	errorString = "atime name";
+	    	goto not3Args;
+	    }
+	    
+	    if (TclStat(fileName, &statBuf) == -1) {
+	    	goto badStat;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) statBuf.st_atime);
+	    goto done;
+    	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 (TclStat(fileName, &statBuf) == -1) {
+	    	goto badStat;
+	    }
+	    Tcl_SetLongObj(resultPtr, (long) statBuf.st_mtime);
+	    goto done;
+	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.
+	     */
+
+#ifndef S_IFLNK
+	    linkLength = -1;
+	    errno = EINVAL;
+#else
+	    linkLength = readlink(fileName, linkValue, sizeof(linkValue) - 1);
+#endif /* S_IFLNK */
+	    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;
+	}
+	case FILE_SIZE:
+	    if (objc != 3) {
+	    	errorString = "size name";
+	    	goto not3Args;
+	    }
+	    if (TclStat(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 (TclStat(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;
+    }
+
+    if (TclStat(fileName, &statBuf) == -1) {
+    	Tcl_SetBooleanObj(resultPtr, 0);
+	goto done;
+    }
+    switch (statOp) {
+	case 0:
+	    /*
+	     * For Windows and Macintosh, there are no user ids 
+	     * associated with a file, so we always return 1.
+	     */
+
+#if (defined(__WIN32__) || defined(MAC_TCL))
+	    mode = 1;
+#else
+	    mode = (geteuid() == statBuf.st_uid);
+#endif
+	    break;
+	case 1:
+	    mode = S_ISREG(statBuf.st_mode);
+	    break;
+	case 2:
+	    mode = S_ISDIR(statBuf.st_mode);
+	    break;
+    }
+    Tcl_SetBooleanObj(resultPtr, mode);
+
+done:
+    Tcl_DStringFree(&buffer);
+    return result;
+
+not3Args:
+    Tcl_WrongNumArgs(interp, 1, objv, errorString);
+    result = TCL_ERROR;
+    goto done;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StoreStatData --
+ *
+ *	This is a utility procedure that breaks out the fields of a
+ *	"stat" structure and stores them in textual form into the
+ *	elements of an associative array.
+ *
+ * Results:
+ *	Returns a standard Tcl return value.  If an error occurs then
+ *	a message is left in interp->result.
+ *
+ * Side effects:
+ *	Elements of the associative array given by "varName" are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StoreStatData(interp, varName, statPtr)
+    Tcl_Interp *interp;			/* Interpreter for error reports. */
+    char *varName;			/* Name of associative array variable
+					 * in which to store stat results. */
+    struct stat *statPtr;		/* Pointer to buffer containing
+					 * stat data to store in varName. */
+{
+    char string[30];
+
+    sprintf(string, "%ld", (long) statPtr->st_dev);
+    if (Tcl_SetVar2(interp, varName, "dev", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_ino);
+    if (Tcl_SetVar2(interp, varName, "ino", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_mode);
+    if (Tcl_SetVar2(interp, varName, "mode", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_nlink);
+    if (Tcl_SetVar2(interp, varName, "nlink", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_uid);
+    if (Tcl_SetVar2(interp, varName, "uid", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_gid);
+    if (Tcl_SetVar2(interp, varName, "gid", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%lu", (unsigned long) statPtr->st_size);
+    if (Tcl_SetVar2(interp, varName, "size", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_atime);
+    if (Tcl_SetVar2(interp, varName, "atime", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_mtime);
+    if (Tcl_SetVar2(interp, varName, "mtime", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    sprintf(string, "%ld", (long) statPtr->st_ctime);
+    if (Tcl_SetVar2(interp, varName, "ctime", string, TCL_LEAVE_ERR_MSG)
+	    == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_SetVar2(interp, varName, "type",
+	    GetTypeFromMode((int) statPtr->st_mode), TCL_LEAVE_ERR_MSG) 
+            == NULL) {
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTypeFromMode --
+ *
+ *	Given a mode word, returns a string identifying the type of a
+ *	file.
+ *
+ * Results:
+ *	A static text string giving the file type from mode.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetTypeFromMode(mode)
+    int mode;
+{
+    if (S_ISREG(mode)) {
+	return "file";
+    } else if (S_ISDIR(mode)) {
+	return "directory";
+    } else if (S_ISCHR(mode)) {
+	return "characterSpecial";
+    } else if (S_ISBLK(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";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ForCmd --
+ *
+ *      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.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+        /* 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. */
+{
+    int result, value;
+
+    if (argc != 5) {
+        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;
+    }
+    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]);
+	if (result == TCL_BREAK) {
+            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;
+    }
+    if (result == TCL_OK) {
+        Tcl_ResetResult(interp);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ForeachObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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;
+
+    /*
+     * We copy the argument object pointers into a local array to avoid
+     * the problem that "objv" might become invalid. It is a pointer into
+     * the evaluation stack and that stack might be grown and reallocated
+     * if the loop body requires a large amount of stack space.
+     */
+    
+#define NUM_ARGS 9
+    Tcl_Obj *(argObjStorage[NUM_ARGS]);
+    Tcl_Obj **argObjv = argObjStorage;
+    
+#define STATIC_LIST_SIZE 4
+    int indexArray[STATIC_LIST_SIZE];	  /* Array of value list indices */
+    int varcListArray[STATIC_LIST_SIZE];  /* # loop variables per list */
+    Tcl_Obj **varvListArray[STATIC_LIST_SIZE]; /* Array of var name lists */
+    int argcListArray[STATIC_LIST_SIZE];  /* Array of value list sizes */
+    Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; /* Array of value lists */
+
+    int *index = indexArray;
+    int *varcList = varcListArray;
+    Tcl_Obj ***varvList = varvListArray;
+    int *argcList = argcListArray;
+    Tcl_Obj ***argvList = argvListArray;
+
+    if (objc < 4 || (objc%2 != 0)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"varList list ?varList list ...? command");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Create the object argument array "argObjv". Make sure argObjv is
+     * large enough to hold the objc arguments.
+     */
+
+    if (objc > NUM_ARGS) {
+	argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
+    }
+    for (i = 0;  i < objc;  i++) {
+	argObjv[i] = objv[i];
+    }
+
+    /*
+     * Manage numList parallel value lists.
+     * argvList[i] is a value list counted by argcList[i]
+     * varvList[i] is the list of variables associated with the value list
+     * varcList[i] is the number of variables associated with the value list
+     * index[i] is the current pointer into the value list argvList[i]
+     */
+
+    numLists = (objc-2)/2;
+    if (numLists > STATIC_LIST_SIZE) {
+	index = (int *) ckalloc(numLists * sizeof(int));
+	varcList = (int *) ckalloc(numLists * sizeof(int));
+	varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
+	argcList = (int *) ckalloc(numLists * sizeof(int));
+	argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
+    }
+    for (i = 0;  i < numLists;  i++) {
+	index[i] = 0;
+	varcList[i] = 0;
+	varvList[i] = (Tcl_Obj **) NULL;
+	argcList[i] = 0;
+	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_ListObjGetElements(interp, argObjv[1+i*2],
+	        &varcList[i], &varvList[i]);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	if (varcList[i] < 1) {
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "foreach varlist is empty", -1);
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	
+	result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+	        &argcList[i], &argvList[i]);
+	if (result != TCL_OK) {
+	    goto done;
+	}
+	
+	j = argcList[i] / varcList[i];
+	if ((argcList[i] % varcList[i]) != 0) {
+	    j++;
+	}
+	if (j > maxj) {
+	    maxj = j;
+	}
+    }
+
+    /*
+     * Iterate maxj times through the lists in parallel
+     * If some value lists run out of values, set loop vars to ""
+     */
+    
+    bodyPtr = argObjv[objc-1];
+    for (j = 0;  j < maxj;  j++) {
+	for (i = 0;  i < numLists;  i++) {
+	    /*
+	     * If a variable or value list object has been converted to
+	     * another kind of Tcl object, convert it back to a list object
+	     * and refetch the pointer to its element array.
+	     */
+
+	    if (argObjv[1+i*2]->typePtr != &tclListType) {
+		result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
+		        &varcList[i], &varvList[i]);
+		if (result != TCL_OK) {
+		    panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
+		}
+	    }
+	    if (argObjv[2+i*2]->typePtr != &tclListType) {
+		result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+	                &argcList[i], &argvList[i]);
+		if (result != TCL_OK) {
+		    panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
+		}
+	    }
+	    
+	    for (v = 0;  v < varcList[i];  v++) {
+		int k = index[i]++;
+		Tcl_Obj *valuePtr, *varValuePtr;
+		int isEmptyObj = 0;
+		
+		if (k < argcList[i]) {
+		    valuePtr = argvList[i][k];
+		} else {
+		    valuePtr = Tcl_NewObj(); /* empty string */
+		    isEmptyObj = 1;
+		}
+		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 done;
+		}
+
+	    }
+	}
+
+	result = Tcl_EvalObj(interp, bodyPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_CONTINUE) {
+		result = TCL_OK;
+	    } else if (result == TCL_BREAK) {
+		result = TCL_OK;
+		break;
+	    } else if (result == TCL_ERROR) {
+		char msg[100];
+		sprintf(msg, "\n    (\"foreach\" body line %d)",
+			interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		break;
+	    } else {
+		break;
+	    }
+	}
+    }
+    if (result == TCL_OK) {
+	Tcl_ResetResult(interp);
+    }
+
+    done:
+    if (numLists > STATIC_LIST_SIZE) {
+	ckfree((char *) index);
+	ckfree((char *) varcList);
+	ckfree((char *) argcList);
+	ckfree((char *) varvList);
+	ckfree((char *) argvList);
+    }
+    if (argObjv != argObjStorage) {
+	ckfree((char *) argObjv);
+    }
+    return result;
+#undef STATIC_LIST_SIZE
+#undef NUM_ARGS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FormatObjCmd --
+ *
+ *	This procedure is invoked to process the "format" 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_FormatObjCmd(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 *format;	/* Used to read characters from the format
+				 * string. */
+    int formatLen;              /* The length of the format string */
+    char *endPtr;               /* Points to the last char in format array */
+    char newFormat[40];		/* A new format specifier is generated here. */
+    int width;			/* Field width from field specifier, or 0 if
+				 * no width given. */
+    int precision;		/* Field precision from field specifier, or 0
+				 * if no precision given. */
+    int size;			/* Number of bytes needed for result of
+				 * conversion, based on type of conversion
+				 * ("e", "s", etc.), width, and precision. */
+    int intValue;		/* Used to hold value to pass to sprintf, if
+				 * it's a one-word integer or char value */
+    char *ptrValue = NULL;	/* Used to hold value to pass to sprintf, if
+				 * it's a one-word value. */
+    double doubleValue;		/* Used to hold value to pass to sprintf if
+				 * it's a double value. */
+    int whichValue;		/* Indicates which of intValue, ptrValue,
+				 * or doubleValue has the value to pass to
+				 * sprintf, according to the following
+				 * definitions: */
+#   define INT_VALUE 0
+#   define PTR_VALUE 1
+#   define DOUBLE_VALUE 2
+#   define MAX_FLOAT_SIZE 320
+    
+    Tcl_Obj *resultPtr;  	/* Where result is stored finally. */
+    char staticBuf[MAX_FLOAT_SIZE + 1];
+                                /* A static buffer to copy the format results 
+				 * into */
+    char *dst = staticBuf;      /* The buffer that sprintf writes into each
+				 * time the format processes a specifier */
+    int dstSize = MAX_FLOAT_SIZE;
+                                /* The size of the dst buffer */
+    int noPercent;		/* Special case for speed:  indicates there's
+				 * no field specifier, just a string to copy.*/
+    int objIndex;		/* Index of argument to substitute next. */
+    int gotXpg = 0;		/* Non-zero means that an XPG3 %n$-style
+				 * specifier has been seen. */
+    int gotSequential = 0;	/* Non-zero means that a regular sequential
+				 * (non-XPG3) conversion specifier has been
+				 * seen. */
+    int useShort;		/* Value to be printed is short (half word). */
+    char *end;			/* Used to locate end of numerical fields. */
+
+    /*
+     * This procedure is a bit nasty.  The goal is to use sprintf to
+     * do most of the dirty work.  There are several problems:
+     * 1. this procedure can't trust its arguments.
+     * 2. we must be able to provide a large enough result area to hold
+     *    whatever's generated.  This is hard to estimate.
+     * 2. there's no way to move the arguments from objv to the call
+     *    to sprintf in a reasonable way.  This is particularly nasty
+     *    because some of the arguments may be two-word values (doubles).
+     * So, what happens here is to scan the format string one % group
+     * at a time, making many individual calls to sprintf.
+     */
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+		"formatString ?arg arg ...?");
+	return TCL_ERROR;
+    }
+
+    format = Tcl_GetStringFromObj(objv[1], &formatLen);
+    endPtr = format + formatLen;
+    resultPtr = Tcl_NewObj();
+    objIndex = 2;
+
+    while (format < endPtr) {
+	register char *newPtr = newFormat;
+
+	width = precision = noPercent = useShort = 0;
+	whichValue = PTR_VALUE;
+
+	/*
+	 * Get rid of any characters before the next field specifier.
+	 */
+	if (*format != '%') {
+	    ptrValue = format;
+	    while ((*format != '%') && (format < endPtr)) {
+		format++;
+	    }
+	    size = format - ptrValue;
+	    noPercent = 1;
+	    goto doField;
+	}
+
+	if (format[1] == '%') {
+	    ptrValue = format;
+	    size = 1;
+	    noPercent = 1;
+	    format += 2;
+	    goto doField;
+	}
+
+	/*
+	 * Parse off a field specifier, compute how many characters
+	 * will be needed to store the result, and substitute for
+	 * "*" size specifiers.
+	 */
+	*newPtr = '%';
+	newPtr++;
+	format++;
+	if (isdigit(UCHAR(*format))) {
+	    int tmp;
+
+	    /*
+	     * Check for an XPG3-style %n$ specification.  Note: there
+	     * must not be a mixture of XPG3 specs and non-XPG3 specs
+	     * in the same format string.
+	     */
+
+	    tmp = strtoul(format, &end, 10);
+	    if (*end != '$') {
+		goto notXpg;
+	    }
+	    format = end+1;
+	    gotXpg = 1;
+	    if (gotSequential) {
+		goto mixedXPG;
+	    }
+	    objIndex = tmp+1;
+	    if ((objIndex < 2) || (objIndex >= objc)) {
+		goto badIndex;
+	    }
+	    goto xpgCheckDone;
+	}
+
+	notXpg:
+	gotSequential = 1;
+	if (gotXpg) {
+	    goto mixedXPG;
+	}
+
+	xpgCheckDone:
+	while ((*format == '-') || (*format == '#') || (*format == '0')
+		|| (*format == ' ') || (*format == '+')) {
+	    *newPtr = *format;
+	    newPtr++;
+	    format++;
+	}
+	if (isdigit(UCHAR(*format))) {
+	    width = strtoul(format, &end, 10);
+	    format = end;
+	} else if (*format == '*') {
+	    if (objIndex >= objc) {
+		goto badIndex;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+                    &width) != TCL_OK) {
+		goto fmtError;
+	    }
+	    objIndex++;
+	    format++;
+	}
+	if (width > 100000) {
+	    /*
+	     * Don't allow arbitrarily large widths:  could cause core
+	     * dump when we try to allocate a zillion bytes of memory
+	     * below.
+	     */
+
+	    width = 100000;
+	} else if (width < 0) {
+	    width = 0;
+	}
+	if (width != 0) {
+	    TclFormatInt(newPtr, width);
+	    while (*newPtr != 0) {
+		newPtr++;
+	    }
+	}
+	if (*format == '.') {
+	    *newPtr = '.';
+	    newPtr++;
+	    format++;
+	}
+	if (isdigit(UCHAR(*format))) {
+	    precision = strtoul(format, &end, 10);
+	    format = end;
+	} else if (*format == '*') {
+	    if (objIndex >= objc) {
+		goto badIndex;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+                    &precision) != TCL_OK) {
+		goto fmtError;
+	    }
+	    objIndex++;
+	    format++;
+	}
+	if (precision != 0) {
+	    TclFormatInt(newPtr, precision);
+	    while (*newPtr != 0) {
+		newPtr++;
+	    }
+	}
+	if (*format == 'l') {
+	    format++;
+	} else if (*format == 'h') {
+	    useShort = 1;
+	    *newPtr = 'h';
+	    newPtr++;
+	    format++;
+	}
+	*newPtr = *format;
+	newPtr++;
+	*newPtr = 0;
+	if (objIndex >= objc) {
+	    goto badIndex;
+	}
+	switch (*format) {
+	    case 'i':
+		newPtr[-1] = 'd';
+	    case 'd':
+	    case 'o':
+	    case 'u':
+	    case 'x':
+	    case 'X':
+		if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+		        (int *) &intValue) != TCL_OK) {
+		    goto fmtError;
+		}
+		whichValue = INT_VALUE;
+		size = 40 + precision;
+		break;
+	    case 's':
+		ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
+		break;
+	    case 'c':
+		if (Tcl_GetIntFromObj(interp, objv[objIndex], 
+                        (int *) &intValue) != TCL_OK) {
+		    goto fmtError;
+		}
+		whichValue = INT_VALUE;
+		size = 1;
+		break;
+	    case 'e':
+	    case 'E':
+	    case 'f':
+	    case 'g':
+	    case 'G':
+		if (Tcl_GetDoubleFromObj(interp, objv[objIndex], 
+			&doubleValue) != TCL_OK) {
+		    goto fmtError;
+		}
+		whichValue = DOUBLE_VALUE;
+		size = MAX_FLOAT_SIZE;
+		if (precision > 10) {
+		    size += precision;
+		}
+		break;
+	    case 0:
+		Tcl_SetResult(interp,
+		        "format string ended in middle of field specifier",
+			TCL_STATIC);
+		goto fmtError;
+	    default:
+		{
+		    char buf[40];
+		    sprintf(buf, "bad field specifier \"%c\"", *format);
+		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		    goto fmtError;
+		}
+	}
+	objIndex++;
+	format++;
+
+	/*
+	 * Make sure that there's enough space to hold the formatted
+	 * result, then format it.
+	 */
+
+	doField:
+	if (width > size) {
+	    size = width;
+	}
+	if (noPercent) {
+	    Tcl_AppendToObj(resultPtr, ptrValue, size);
+	} else {
+	    if (size > dstSize) {
+	        if (dst != staticBuf) {
+		    ckfree(dst);
+		}
+		dst = (char *) ckalloc((unsigned) (size + 1));
+		dstSize = size;
+	    }
+
+	    if (whichValue == DOUBLE_VALUE) {
+	        sprintf(dst, newFormat, doubleValue);
+	    } else if (whichValue == INT_VALUE) {
+		if (useShort) {
+		    sprintf(dst, newFormat, (short) intValue);
+		} else {
+		    sprintf(dst, newFormat, intValue);
+		}
+	    } else {
+	        sprintf(dst, newFormat, ptrValue);
+	    }
+	    Tcl_AppendToObj(resultPtr, dst, -1);
+	}
+    }
+
+    Tcl_SetObjResult(interp, resultPtr);
+    if(dst != staticBuf) {
+        ckfree(dst);
+    }
+    return TCL_OK;
+
+    mixedXPG:
+    Tcl_SetResult(interp, 
+            "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
+    goto fmtError;
+
+    badIndex:
+    if (gotXpg) {
+        Tcl_SetResult(interp, 
+                "\"%n$\" argument index out of range", TCL_STATIC);
+    } else {
+        Tcl_SetResult(interp, 
+                "not enough arguments for all format specifiers", TCL_STATIC);
+    }
+
+    fmtError:
+    if(dst != staticBuf) {
+        ckfree(dst);
+    }
+    Tcl_DecrRefCount(resultPtr);
+    return TCL_ERROR;
+}
diff --git a/tcl/generic/tclCmdIL.c b/tcl/generic/tclCmdIL.c
new file mode 100644
index 00000000000..94b8fc2dfc7
--- /dev/null
+++ b/tcl/generic/tclCmdIL.c
@@ -0,0 +1,2951 @@
+/* 
+ * tclCmdIL.c --
+ *
+ *	This file contains the top-level command routines for most of
+ *	the Tcl built-in commands whose names begin with the letters
+ *	I through L.  It contains only commands in the generic core
+ *	(i.e. those that don't depend much upon UNIX facilities).
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclCompile.h"
+
+/*
+ * 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.
+ */
+
+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.*/
+    int 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 void		AppendLocals _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, char *pattern,
+			    int includeLinks));
+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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IfCmd --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_IfCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int i, result, value;
+
+    i = 1;
+    while (1) {
+	/*
+	 * At this point in the loop, argv and argc refer to an expression
+	 * to test, either for 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.
+	 */
+
+	if (i >= argc) {
+	    Tcl_AppendResult(interp, "wrong # args: no expression after \"",
+		    argv[i-1], "\" argument", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	result = Tcl_ExprBoolean(interp, argv[i], &value);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	i++;
+	if ((i < argc) && (strcmp(argv[i], "then") == 0)) {
+	    i++;
+	}
+	if (i >= argc) {
+	    Tcl_AppendResult(interp, "wrong # args: no script following \"",
+		    argv[i-1], "\" argument", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	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.
+	 */
+
+	i++;
+	if (i >= argc) {
+	    return TCL_OK;
+	}
+	if ((argv[i][0] == 'e') && (strcmp(argv[i], "elseif") == 0)) {
+	    i++;
+	    continue;
+	}
+	break;
+    }
+
+    /*
+     * Couldn't find a "then" or "elseif" clause to execute.  Check now
+     * for an "else" clause.  We know that there's at least one more
+     * argument when we get here.
+     */
+
+    if (strcmp(argv[i], "else") == 0) {
+	i++;
+	if (i >= argc) {
+	    Tcl_AppendResult(interp,
+		    "wrong # args: no script following \"else\" argument",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    return Tcl_Eval(interp, argv[i]);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IncrCmd --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+int
+Tcl_IncrCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int value;
+    char *oldString, *result;
+    char newString[30];
+
+    if ((argc != 2) && (argc != 3)) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" varName ?increment?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    oldString = Tcl_GetVar(interp, argv[1], TCL_LEAVE_ERR_MSG);
+    if (oldString == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, oldString, &value) != TCL_OK) {
+	Tcl_AddErrorInfo(interp,
+		"\n    (reading value of variable to increment)");
+	return TCL_ERROR;
+    }
+    if (argc == 2) {
+	value += 1;
+    } else {
+	int increment;
+
+	if (Tcl_GetInt(interp, argv[2], &increment) != TCL_OK) {
+	    Tcl_AddErrorInfo(interp,
+		    "\n    (reading increment)");
+	    return TCL_ERROR;
+	}
+	value += increment;
+    }
+    TclFormatInt(newString, value);
+    result = Tcl_SetVar(interp, argv[1], newString, TCL_LEAVE_ERR_MSG);
+    if (result == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Copy the result since the variable's value might change.
+     */
+    
+    Tcl_SetResult(interp, result, TCL_VOLATILE);
+    return TCL_OK; 
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InfoObjCmd --
+ *
+ *	This procedure is invoked to process the "info" 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_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;
+    char *name;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *listObjPtr;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "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;
+    }
+
+    /*
+     * Build a return list containing the arguments.
+     */
+    
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+            localPtr = localPtr->nextPtr) {
+        if (TclIsVarArgument(localPtr)) {
+            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;
+    Tcl_Obj *bodyPtr, *resultPtr;
+    
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "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;
+    }
+
+    /*
+     * we need to check if the body from this procedure had been generated
+     * from a precompiled body. If that is the case, then the bodyPtr's
+     * string representation is bogus, since sources are not available.
+     * In order to make sure that later manipulations of the object do not
+     * invalidate the internal representation, we make a copy of the string
+     * representation and return that one, instead.
+     */
+
+    bodyPtr = procPtr->bodyPtr;
+    resultPtr = bodyPtr;
+    if (bodyPtr->typePtr == &tclByteCodeType) {
+        ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+
+        if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+            resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
+        }
+    }
+    
+    Tcl_SetObjResult(interp, resultPtr);
+    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, 2, objv, NULL);
+        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;
+	}
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+	}
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?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 {
+		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+		}
+		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+	    }
+	    entryPtr = Tcl_NextHashEntry(&search);
+	}
+
+	/*
+	 * 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 ((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);
+	    }
+	}
+    }
+    
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "command");
+        return TCL_ERROR;
+    }
+
+    if (TclObjCommandComplete(objv[2])) {
+	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, 2, objv, "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 (TclIsVarArgument(localPtr)
+		&& (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, 2, objv, "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, 2, objv, "?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. */
+{
+    char *name;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    name = Tcl_GetHostName();
+    if (name) {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+	return TCL_OK;
+    } else {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp),
+		"unable to determine name of host", -1);
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 (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;
+    }
+
+    Tcl_WrongNumArgs(interp, 2, objv, "?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, 2, objv, NULL);
+        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, 2, objv, "?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;
+    char *pattern;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+    
+    if (iPtr->varFramePtr == NULL || !iPtr->varFramePtr->isProcCallFrame) {
+        return TCL_OK;
+    }
+
+    /*
+     * 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);
+    AppendLocals(interp, listPtr, pattern, 0);
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendLocals --
+ *
+ *	Append the local variables for the current frame to the
+ *	specified list object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendLocals(interp, listPtr, pattern, includeLinks)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    Tcl_Obj *listPtr;		/* List object to append names to. */
+    char *pattern;		/* Pattern to match against. */
+    int includeLinks;		/* 1 if upvars should be included, else 0. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CompiledLocal *localPtr;
+    Var *varPtr;
+    int i, localVarCt;
+    char *varName;
+    Tcl_HashTable *localVarTablePtr;
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+
+    localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
+    localVarCt = iPtr->varFramePtr->numCompiledLocals;
+    varPtr = iPtr->varFramePtr->compiledLocals;
+    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
+
+    for (i = 0; i < localVarCt; i++) {
+	/*
+	 * Skip nameless (temporary) variables and undefined variables
+	 */
+
+	if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)) {
+	    varName = varPtr->name;
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+		        Tcl_NewStringObj(varName, -1));
+	    }
+        }
+	varPtr++;
+	localPtr = localPtr->nextPtr;
+    }
+    
+    if (localVarTablePtr != NULL) {
+	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
+	        entryPtr != NULL;
+                entryPtr = Tcl_NextHashEntry(&search)) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr)
+		    && (includeLinks || !TclIsVarLink(varPtr))) {
+		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
+		if ((pattern == NULL)
+		        || Tcl_StringMatch(varName, pattern)) {
+		    Tcl_ListObjAppendElement(interp, listPtr,
+			    Tcl_NewStringObj(varName, -1));
+		}
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    CONST char *nameOfExecutable;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+
+    nameOfExecutable = Tcl_GetNameOfExecutable();
+    
+    if (nameOfExecutable != NULL) {
+	Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *)nameOfExecutable, -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, 2, objv, NULL);
+        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, 2, objv, "?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, 2, objv, NULL);
+        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, 2, objv, NULL);
+        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, 2, objv, NULL);
+        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;
+    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 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;
+	}
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+	}
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * If the namespace specified in the pattern wasn't found, just return.
+     */
+
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+    
+    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)
+		    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+		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);
+		}
+	    }
+	    entryPtr = Tcl_NextHashEntry(&search);
+	}
+
+	/*
+	 * 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.
+	 */
+
+	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
+	    while (entryPtr != NULL) {
+		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+		if (!TclIsVarUndefined(varPtr)
+		        || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+		    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);
+	    }
+	}
+    } else {
+	AppendLocals(interp, listPtr, simplePattern, 1);
+    }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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, *bytes;
+    int joinLength, listLen, length, i, result;
+    Tcl_Obj **elemPtrs;
+    Tcl_Obj *resObjPtr;
+
+    if (objc == 2) {
+	joinString = " ";
+	joinLength = 1;
+    } else if (objc == 3) {
+	joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
+	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;
+    }
+
+    /*
+     * Now concatenate strings to form the "joined" result. We append
+     * directly into the interpreter's result object.
+     */
+
+    resObjPtr = Tcl_GetObjResult(interp);
+
+    for (i = 0;  i < listLen;  i++) {
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
+	if (i > 0) {
+	    Tcl_AppendToObj(resObjPtr, joinString, joinLength);
+	}
+	Tcl_AppendToObj(resObjPtr, bytes, length);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LindexObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+int
+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. */
+{
+    Tcl_Obj *listPtr;
+    Tcl_Obj **elemPtrs;
+    int listLen, index, result;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index");
+	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) || (index >= listLen)) {
+	/*
+	 * The index is out of range: the result is an empty string object.
+	 */
+	
+	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;
+	}
+    }
+
+    /*
+     * Set the interpreter's object result to the index-th list element.
+     */
+
+    Tcl_SetObjResult(interp, elemPtrs[index]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LinsertObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "linsert" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A new Tcl list object formed by inserting zero or more elements 
+ *	into a list.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    Tcl_Obj *listPtr, *resultPtr;
+    Tcl_ObjType *typePtr;
+    int index, isDuplicate, len, result;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the index first since, if a conversion to int is needed, it
+     * will invalidate the list's internal representation.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ INT_MAX,
+	    &index);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * 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.
+     */
+    
+    listPtr = objv[1];
+    isDuplicate = 0;
+    if (Tcl_IsShared(listPtr)) {
+	/*
+	 * The following code must reflect the logic in Tcl_DuplicateObj()
+	 * except that it must duplicate the list object directly into the
+	 * interpreter's result.
+	 */
+	
+	Tcl_ResetResult(interp);
+	resultPtr = Tcl_GetObjResult(interp);
+	typePtr = listPtr->typePtr;
+	if (listPtr->bytes == NULL) {
+	    resultPtr->bytes = NULL;
+	} else if (listPtr->bytes != tclEmptyStringRep) {
+	    len = listPtr->length;
+	    TclInitStringRep(resultPtr, listPtr->bytes, len);
+	}
+	if (typePtr != NULL) {
+	    if (typePtr->dupIntRepProc == NULL) {
+		resultPtr->internalRep = listPtr->internalRep;
+		resultPtr->typePtr = typePtr;
+	    } else {
+		(*typePtr->dupIntRepProc)(listPtr, resultPtr);
+	    }
+	}
+	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;
+    }
+    
+    /*
+     * Set the interpreter's object result.
+     */
+
+    if (!isDuplicate) {
+	Tcl_SetObjResult(interp, listPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ListObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    register int objc;			/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LlengthObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LlengthObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    int listLen, result;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list");
+	return TCL_ERROR;
+    }
+
+    result = Tcl_ListObjLength(interp, objv[1], &listLen);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    /*
+     * Set the interpreter's object result to an integer object holding the
+     * length. 
+     */
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
+    ClientData notUsed;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Obj *listPtr;
+    Tcl_Obj **elemPtrs;
+    int listLen, first, last, numElems, result;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
+	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;
+    }
+
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+	    &last);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (last >= listLen) {
+	last = (listLen - 1);
+    }
+    
+    if (first > last) {
+	return TCL_OK;		/* the result is an empty object */
+    }
+
+    /*
+     * 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;
+        }
+    }
+
+    /*
+     * Extract a range of fields. We modify the interpreter's result object
+     * to be a list object containing the specified elements.
+     */
+
+    numElems = (last - first + 1);
+    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LreplaceObjCmd --
+ *
+ *	This object-based procedure is invoked to process the "lreplace" 
+ *	Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A new Tcl list object formed by replacing zero or more elements of
+ *	a list.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    register Tcl_Obj *listPtr;
+    int createdNewObj, first, last, listLen, numToDelete;
+    int firstArgLen, result;
+    char *firstArg;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"list first last ?element element ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If the list object is unshared we can modify it directly, otherwise
+     * we create a copy to modify: this is "copy on write".
+     */
+    
+    listPtr = objv[1];
+    createdNewObj = 0;
+    if (Tcl_IsShared(listPtr)) {
+	listPtr = Tcl_DuplicateObj(listPtr);
+	createdNewObj = 1;
+    }
+    result = Tcl_ListObjLength(interp, listPtr, &listLen);
+    if (result != TCL_OK) {
+        errorReturn:
+	if (createdNewObj) {
+	    Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+	}
+	return result;
+    }
+
+    /*
+     * Get the first and last indexes.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+	    &first);
+    if (result != TCL_OK) {
+	goto errorReturn;
+    }
+    firstArg = Tcl_GetStringFromObj(objv[2], &firstArgLen);
+
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+	    &last);
+    if (result != TCL_OK) {
+	goto errorReturn;
+    }
+
+    if (first < 0)  {
+    	first = 0;
+    }
+    if ((first >= listLen) && (listLen > 0)
+	    && (strncmp(firstArg, "end", (unsigned) firstArgLen) != 0)) {
+	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;
+    }
+
+    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;
+    }
+
+    /*
+     * Set the interpreter's object result. 
+     */
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LsearchObjCmd --
+ *
+ *	This procedure is invoked to process the "lsearch" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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
+#define DICTIONARY 3
+#define NOCASE  4
+    char *bytes, *patternBytes;
+    int i, match, mode, index, result, listLen, length, elemLen;
+    Tcl_Obj **elemPtrs;
+    static char *switches[] =
+	    {"-exact", "-glob", "-regexp", "-dictionary", "-nocase", (char *) NULL};
+
+    mode = GLOB;
+    if (objc == 4) {
+	if (Tcl_GetIndexFromObj(interp, objv[1], switches,
+		"search mode", 0, &mode) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?mode? list pattern");
+	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 < listLen; i++) {
+	match = 0;
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
+	switch (mode) {
+	    case EXACT:
+		if (length == elemLen) {
+		    match = (memcmp(bytes, patternBytes,
+			    (size_t) length) == 0);
+		}
+		break;
+	    case GLOB:
+		/*
+		 * WARNING: will not work with data containing NULLs.
+		 */
+		match = Tcl_StringMatch(bytes, patternBytes);
+		break;
+	    case REGEXP:
+		/*
+		 * WARNING: will not work with data containing NULLs.
+		 */
+		match = Tcl_RegExpMatch(interp, bytes, patternBytes);
+		if (match < 0) {
+		    return TCL_ERROR;
+		}
+		break;
+	     case DICTIONARY:
+	     case NOCASE:
+#if defined(__MSVC__) || defined(_MSC_VER)
+		match = strnicmp (bytes, patternBytes, length) == 0;
+#else
+	     	match = strncasecmp (bytes, patternBytes, length) == 0;
+#endif
+		break;
+	}
+	if (match) {
+	    index = i;
+	    break;
+	}
+    }
+
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LsortObjCmd --
+ *
+ *	This procedure is invoked to process the "lsort" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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 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;
+    }
+
+    /*
+     * Parse arguments to set up the mode for the sort.
+     */
+
+    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;
+	}
+	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 (TclGetIntForIndex(interp, objv[i+1], -2, &sortInfo.index)
+			!= TCL_OK) {
+		    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 (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_DStringInit(&sortInfo.compareCmd);
+	Tcl_DStringAppend(&sortInfo.compareCmd,
+		Tcl_GetStringFromObj(cmdPtr, &dummy), -1);
+    }
+
+    sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
+	    &length, &listObjPtrs);
+    if (sortInfo.resultCode != TCL_OK) {
+	goto done;
+    }
+    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];
+    }
+    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*) elementArray);
+
+    done:
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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:
+ *      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
+ *	weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SortCompare(objPtr1, objPtr2, infoPtr)
+    Tcl_Obj *objPtr1, *objPtr2;		/* Values to be compared. */
+    SortInfo *infoPtr;                  /* Information passed from the
+                                         * top-level "lsort" command */
+{
+    int order, dummy, listLen, index;
+    Tcl_Obj *objPtr;
+    char buffer[30];
+
+    order = 0;
+    if (infoPtr->resultCode != TCL_OK) {
+	/*
+	 * Once an error has occurred, skip any future comparisons
+	 * so as to preserve the error message in sortInterp->result.
+	 */
+
+	return order;
+    }
+    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, "%d", 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_GetIntFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
+		|| (Tcl_GetIntFromObj(infoPtr->interp, objPtr2, &b)
+		!= TCL_OK)) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return order;
+	}
+	if (a > b) {
+	    order = 1;
+	} else if (b > a) {
+	    order = -1;
+	}
+    } else if (infoPtr->sortMode == SORTMODE_REAL) {
+	double a, b;
+
+	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) {
+	    order = 1;
+	} else if (b > a) {
+	    order = -1;
+	}
+    } else {
+	int oldLength;
+
+	/*
+	 * Generate and evaluate a command to determine which string comes
+	 * first.
+	 */
+
+	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;
+	}
+
+	/*
+	 * Parse the result of the command.
+	 */
+
+	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 (!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') && (isdigit(UCHAR(right[1])))) {
+		right++;
+		zeros--;
+	    }
+	    while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
+		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 = UCHAR(*left) - UCHAR(*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 = UCHAR(*left) - UCHAR(*right);
+        if (diff) {
+            if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
+                diff = UCHAR(tolower(*left)) - UCHAR(*right);
+                if (diff) {
+		    return diff;
+                } else if (secondaryDiff == 0) {
+		    secondaryDiff = -1;
+                }
+            } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
+                diff = UCHAR(*left) - UCHAR(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/tcl/generic/tclCmdMZ.c b/tcl/generic/tclCmdMZ.c
new file mode 100644
index 00000000000..87cfd108752
--- /dev/null
+++ b/tcl/generic/tclCmdMZ.c
@@ -0,0 +1,2186 @@
+/* 
+ * tclCmdMZ.c --
+ *
+ *	This file contains the top-level command routines for most of
+ *	the Tcl built-in commands whose names begin with the letters
+ *	M to Z.  It contains only commands in the generic core (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-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclCompile.h"
+
+/*
+ * Structure used to hold information about variable traces:
+ */
+
+typedef struct {
+    int flags;			/* Operations for which Tcl command is
+				 * to be invoked. */
+    char *errMsg;		/* Error message returned from Tcl command,
+				 * or NULL.  Malloc'ed. */
+    int length;			/* Number of non-NULL chars. in command. */
+    char command[4];		/* Space for Tcl command to invoke.  Actual
+				 * size will be as large as necessary to
+				 * hold command.  This field must be the
+				 * last in the structure, so that it can
+				 * be larger than 4 bytes. */
+} TraceVarInfo;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static char *		TraceVarProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PwdCmd --
+ *
+ *	This procedure is invoked to process the "pwd" 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_PwdCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    char *dirName;
+
+    if (argc != 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], "\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    dirName = TclGetCwd(interp);
+    if (dirName == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetResult(interp, dirName, TCL_VOLATILE);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegexpCmd --
+ *
+ *	This procedure is invoked to process the "regexp" 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_RegexpCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int noCase = 0;
+    int indices = 0;
+    Tcl_RegExp regExpr;
+    char **argPtr, *string, *pattern, *start, *end;
+    int match = 0;			/* Initialization needed only to
+					 * prevent compiler warning. */
+    int i;
+    Tcl_DString stringDString, patternDString;
+
+    if (argc < 3) {
+	wrongNumArgs:
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ?switches? exp string ?matchVar? ?subMatchVar ",
+		"subMatchVar ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    argPtr = argv+1;
+    argc--;
+    while ((argc > 0) && (argPtr[0][0] == '-')) {
+	if (strcmp(argPtr[0], "-indices") == 0) {
+	    indices = 1;
+	} else if (strcmp(argPtr[0], "-nocase") == 0) {
+	    noCase = 1;
+	} else if (strcmp(argPtr[0], "--") == 0) {
+	    argPtr++;
+	    argc--;
+	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad switch \"", argPtr[0],
+		    "\": must be -indices, -nocase, or --", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	argPtr++;
+	argc--;
+    }
+    if (argc < 2) {
+	goto wrongNumArgs;
+    }
+
+    /*
+     * Convert the string and pattern to lower case, if desired, and
+     * perform the matching operation.
+     */
+
+    if (noCase) {
+	register char *p;
+
+	Tcl_DStringInit(&patternDString);
+	Tcl_DStringAppend(&patternDString, argPtr[0], -1);
+	pattern = Tcl_DStringValue(&patternDString);
+	for (p = pattern; *p != 0; p++) {
+	    if (isupper(UCHAR(*p))) {
+		*p = (char)tolower(UCHAR(*p));
+	    }
+	}
+	Tcl_DStringInit(&stringDString);
+	Tcl_DStringAppend(&stringDString, argPtr[1], -1);
+	string = Tcl_DStringValue(&stringDString);
+	for (p = string; *p != 0; p++) {
+	    if (isupper(UCHAR(*p))) {
+		*p = (char)tolower(UCHAR(*p));
+	    }
+	}
+    } else {
+	pattern = argPtr[0];
+	string = argPtr[1];
+    }
+    regExpr = Tcl_RegExpCompile(interp, pattern);
+    if (regExpr != NULL) {
+	match = Tcl_RegExpExec(interp, regExpr, string, string);
+    }
+    if (noCase) {
+	Tcl_DStringFree(&stringDString);
+	Tcl_DStringFree(&patternDString);
+    }
+    if (regExpr == NULL) {
+	return TCL_ERROR;
+    }
+    if (match < 0) {
+	return TCL_ERROR;
+    }
+    if (!match) {
+	Tcl_SetResult(interp, "0", TCL_STATIC);
+	return TCL_OK;
+    }
+
+    /*
+     * If additional variable names have been specified, return
+     * index information in those variables.
+     */
+
+    argc -= 2;
+    for (i = 0; i < argc; i++) {
+	char *result, info[50];
+
+	Tcl_RegExpRange(regExpr, i, &start, &end);
+	if (start == NULL) {
+	    if (indices) {
+		result = Tcl_SetVar(interp, argPtr[i+2], "-1 -1", 0);
+	    } else {
+		result = Tcl_SetVar(interp, argPtr[i+2], "", 0);
+	    }
+	} else {
+	    if (indices) {
+		sprintf(info, "%d %d", (int)(start - string),
+			(int)(end - string - 1));
+		result = Tcl_SetVar(interp, argPtr[i+2], info, 0);
+	    } else {
+		char savedChar, *first, *last;
+
+		first = argPtr[1] + (start - string);
+		last = argPtr[1] + (end - string);
+		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) {
+	    Tcl_AppendResult(interp, "couldn't set variable \"",
+		    argPtr[i+2], "\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetResult(interp, "1", TCL_STATIC);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegsubCmd --
+ *
+ *	This procedure is invoked to process the "regsub" 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_RegsubCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int noCase = 0, all = 0;
+    Tcl_RegExp regExpr;
+    char *string, *pattern, *p, *firstChar, **argPtr;
+    int match, code, numMatches;
+    char *start, *end, *subStart, *subEnd;
+    register char *src, c;
+    Tcl_DString stringDString, patternDString, resultDString;
+
+    if (argc < 5) {
+	wrongNumArgs:
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ?switches? exp string subSpec varName\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    argPtr = argv+1;
+    argc--;
+    while (argPtr[0][0] == '-') {
+	if (strcmp(argPtr[0], "-nocase") == 0) {
+	    noCase = 1;
+	} else if (strcmp(argPtr[0], "-all") == 0) {
+	    all = 1;
+	} else if (strcmp(argPtr[0], "--") == 0) {
+	    argPtr++;
+	    argc--;
+	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad switch \"", argPtr[0],
+		    "\": must be -all, -nocase, or --", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	argPtr++;
+	argc--;
+    }
+    if (argc != 4) {
+	goto wrongNumArgs;
+    }
+
+    /*
+     * Convert the string and pattern to lower case, if desired.
+     */
+
+    if (noCase) {
+	Tcl_DStringInit(&patternDString);
+	Tcl_DStringAppend(&patternDString, argPtr[0], -1);
+	pattern = Tcl_DStringValue(&patternDString);
+	for (p = pattern; *p != 0; p++) {
+	    if (isupper(UCHAR(*p))) {
+		*p = (char)tolower(UCHAR(*p));
+	    }
+	}
+	Tcl_DStringInit(&stringDString);
+	Tcl_DStringAppend(&stringDString, argPtr[1], -1);
+	string = Tcl_DStringValue(&stringDString);
+	for (p = string; *p != 0; p++) {
+	    if (isupper(UCHAR(*p))) {
+		*p = (char)tolower(UCHAR(*p));
+	    }
+	}
+    } else {
+	pattern = argPtr[0];
+	string = argPtr[1];
+    }
+    Tcl_DStringInit(&resultDString);
+    regExpr = Tcl_RegExpCompile(interp, pattern);
+    if (regExpr == NULL) {
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * The following loop is to handle multiple matches within the
+     * same source string;  each iteration handles one match and its
+     * corresponding substitution.  If "-all" hasn't been specified
+     * then the loop body only gets executed once.
+     */
+
+    numMatches = 0;
+    for (p = string; *p != 0; ) {
+	match = Tcl_RegExpExec(interp, regExpr, p, string);
+	if (match < 0) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	if (!match) {
+	    break;
+	}
+	numMatches += 1;
+
+	/*
+	 * Copy the portion of the source string before the match to the
+	 * result variable.
+	 */
+
+	Tcl_RegExpRange(regExpr, 0, &start, &end);
+	Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), start - p);
+    
+	/*
+	 * Append the subSpec argument to the variable, making appropriate
+	 * substitutions.  This code is a bit hairy because of the backslash
+	 * conventions and because the code saves up ranges of characters in
+	 * subSpec to reduce the number of calls to Tcl_SetVar.
+	 */
+    
+	for (src = firstChar = argPtr[2], c = *src; c != 0; src++, c = *src) {
+	    int index;
+    
+	    if (c == '&') {
+		index = 0;
+	    } else if (c == '\\') {
+		c = src[1];
+		if ((c >= '0') && (c <= '9')) {
+		    index = c - '0';
+		} else if ((c == '\\') || (c == '&')) {
+		    *src = c;
+		    src[1] = 0;
+		    Tcl_DStringAppend(&resultDString, firstChar, -1);
+		    *src = '\\';
+		    src[1] = c;
+		    firstChar = src+2;
+		    src++;
+		    continue;
+		} else {
+		    continue;
+		}
+	    } else {
+		continue;
+	    }
+	    if (firstChar != src) {
+		c = *src;
+		*src = 0;
+		Tcl_DStringAppend(&resultDString, firstChar, -1);
+		*src = c;
+	    }
+	    Tcl_RegExpRange(regExpr, index, &subStart, &subEnd);
+	    if ((subStart != NULL) && (subEnd != NULL)) {
+		char *first, *last, saved;
+    
+		first = argPtr[1] + (subStart - string);
+		last = argPtr[1] + (subEnd - string);
+		saved = *last;
+		*last = 0;
+		Tcl_DStringAppend(&resultDString, first, -1);
+		*last = saved;
+	    }
+	    if (*src == '\\') {
+		src++;
+	    }
+	    firstChar = src+1;
+	}
+	if (firstChar != src) {
+	    Tcl_DStringAppend(&resultDString, firstChar, -1);
+	}
+	if (end == p) {
+
+	    /*
+	     * Always consume at least one character of the input string
+	     * in order to prevent infinite loops.
+	     */
+
+	    Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), 1);
+	    p = end + 1;
+	} else {
+	    p = end;
+	}
+	if (!all) {
+	    break;
+	}
+    }
+
+    /*
+     * Copy the portion of the source string after the last match to the
+     * result variable.
+     */
+
+    if ((*p != 0) || (numMatches == 0)) {
+	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;
+    }
+
+    done:
+    if (noCase) {
+	Tcl_DStringFree(&stringDString);
+	Tcl_DStringFree(&patternDString);
+    }
+    Tcl_DStringFree(&resultDString);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    char *oldName, *newName;
+    
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
+	return TCL_ERROR;
+    }
+
+    oldName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    newName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    return TclRenameCommand(interp, oldName, newName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ReturnObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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 optionLen, argLen, code, result;
+
+    if (iPtr->errorInfo != NULL) {
+	ckfree(iPtr->errorInfo);
+	iPtr->errorInfo = NULL;
+    }
+    if (iPtr->errorCode != NULL) {
+	ckfree(iPtr->errorCode);
+	iPtr->errorCode = NULL;
+    }
+    code = TCL_OK;
+
+   /*
+    * 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(arg, "error") == 0)) {
+		code = TCL_ERROR;
+	    } else if ((c == 'r') && (strcmp(arg, "return") == 0)) {
+		code = TCL_RETURN;
+	    } else if ((c == 'b') && (strcmp(arg, "break") == 0)) {
+		code = TCL_BREAK;
+	    } else if ((c == 'c') && (strcmp(arg, "continue") == 0)) {
+		code = TCL_CONTINUE;
+	    } 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(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_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "bad option \"", option,
+		    "\": must be -code, -errorcode, or -errorinfo",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanCmd --
+ *
+ *	This procedure is invoked to process the "scan" 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_ScanCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+#   define MAX_FIELDS 20
+    typedef struct {
+	char fmt;			/* Format for field. */
+	int size;			/* How many bytes to allow for
+					 * field. */
+	char *location;			/* Where field will be stored. */
+    } Field;
+    Field fields[MAX_FIELDS];		/* Info about all the fields in the
+					 * format string. */
+    register Field *curField;
+    int numFields = 0;			/* Number of fields actually
+					 * specified. */
+    int suppress;			/* Current field is assignment-
+					 * suppressed. */
+    int totalSize = 0;			/* Number of bytes needed to store
+					 * all results combined. */
+    char *results;			/* Where scanned output goes.
+					 * Malloced; NULL means not allocated
+					 * yet. */
+    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
+     * string, so that we can replace format specifiers like "%f"
+     * and "%F" with specifiers like "%lf"
+     */
+
+#   define STATIC_SIZE 5
+    char copyBuf[STATIC_SIZE], *fmtCopy;
+    register char *dst;
+
+    if (argc < 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" string format ?varName varName ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * This procedure operates in four stages:
+     * 1. Scan the format string, collecting information about each field.
+     * 2. Allocate an array to hold all of the scanned fields.
+     * 3. Call sscanf to do all the dirty work, and have it store the
+     *    parsed fields in the array.
+     * 4. Pick off the fields from the array and assign them to variables.
+     */
+
+    code = TCL_OK;
+    results = NULL;
+    length = strlen(argv[2]) * 2 + 1;
+    if (length < STATIC_SIZE) {
+	fmtCopy = copyBuf;
+    } else {
+	fmtCopy = (char *) ckalloc((unsigned) length);
+    }
+    dst = fmtCopy;
+    for (fmt = argv[2]; *fmt != 0; fmt++) {
+	*dst = *fmt;
+	dst++;
+	if (*fmt != '%') {
+	    continue;
+	}
+	fmt++;
+	if (*fmt == '%') {
+	    *dst = *fmt;
+	    dst++;
+	    continue;
+	}
+	if (*fmt == '*') {
+	    suppress = 1;
+	    *dst = *fmt;
+	    dst++;
+	    fmt++;
+	} else {
+	    suppress = 0;
+	}
+	widthSpecified = 0;
+	while (isdigit(UCHAR(*fmt))) {
+	    widthSpecified = 1;
+	    *dst = *fmt;
+	    dst++;
+	    fmt++;
+	}
+	if ((*fmt == 'l') || (*fmt == 'h') || (*fmt == 'L')) {
+	    fmt++;
+	}
+	*dst = *fmt;
+	dst++;
+	if (suppress) {
+	    continue;
+	}
+	if (numFields == MAX_FIELDS) {
+	    Tcl_SetResult(interp, "too many fields to scan", TCL_STATIC);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	curField = &fields[numFields];
+	numFields++;
+	switch (*fmt) {
+	    case 'd':
+	    case 'i':
+	    case 'o':
+	    case 'x':
+		curField->fmt = 'd';
+		curField->size = sizeof(int);
+		break;
+
+	    case 'u':
+		curField->fmt = 'u';
+		curField->size = sizeof(int);
+		break;
+
+	    case 's':
+		curField->fmt = 's';
+		curField->size = strlen(argv[1]) + 1;
+		break;
+
+	    case 'c':
+                if (widthSpecified) {
+		    Tcl_SetResult(interp,
+		            "field width may not be specified in %c conversion",
+			    TCL_STATIC);
+		    code = TCL_ERROR;
+		    goto done;
+                }
+		curField->fmt = 'c';
+		curField->size = sizeof(int);
+		break;
+
+	    case 'e':
+	    case 'f':
+	    case 'g':
+		dst[-1] = 'l';
+		dst[0] = 'f';
+		dst++;
+		curField->fmt = 'f';
+		curField->size = sizeof(double);
+		break;
+
+	    case '[':
+		curField->fmt = 's';
+		curField->size = strlen(argv[1]) + 1;
+		do {
+		    fmt++;
+		    if (*fmt == 0) {
+			Tcl_SetResult(interp,
+			        "unmatched [ in format string", TCL_STATIC);
+			code = TCL_ERROR;
+			goto done;
+		    }
+		    *dst = *fmt;
+		    dst++;
+		} while (*fmt != ']');
+		break;
+
+	    default:
+		{
+		    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;
+    }
+    *dst = 0;
+
+    if (numFields != (argc-3)) {
+	Tcl_SetResult(interp,
+		"different numbers of variable names and field specifiers",
+		TCL_STATIC);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Step 2:
+     */
+
+    results = (char *) ckalloc((unsigned) totalSize);
+    for (i = 0, totalSize = 0, curField = fields;
+	    i < numFields; i++, curField++) {
+	curField->location = results + totalSize;
+	totalSize += curField->size;
+    }
+
+    /*
+     * Fill in the remaining fields with NULL;  the only purpose of
+     * this is to keep some memory analyzers, like Purify, from
+     * complaining.
+     */
+
+    for ( ; i < MAX_FIELDS; i++, curField++) {
+	curField->location = NULL;
+    }
+
+    /*
+     * Step 3:
+     */
+
+    numScanned = sscanf(argv[1], fmtCopy,
+	    fields[0].location, fields[1].location, fields[2].location,
+	    fields[3].location, fields[4].location, fields[5].location,
+	    fields[6].location, fields[7].location, fields[8].location,
+	    fields[9].location, fields[10].location, fields[11].location,
+	    fields[12].location, fields[13].location, fields[14].location,
+	    fields[15].location, fields[16].location, fields[17].location,
+	    fields[18].location, fields[19].location);
+
+    /*
+     * Step 4:
+     */
+
+    if (numScanned < numFields) {
+	numFields = numScanned;
+    }
+    for (i = 0, curField = fields; i < numFields; i++, curField++) {
+	switch (curField->fmt) {
+	    char string[TCL_DOUBLE_SPACE];
+
+	    case 'd':
+		TclFormatInt(string, *((int *) curField->location));
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    storeError:
+		    Tcl_AppendResult(interp,
+			    "couldn't set variable \"", argv[i+3], "\"",
+			    (char *) NULL);
+		    code = TCL_ERROR;
+		    goto done;
+		}
+		break;
+
+	    case 'u':
+		sprintf(string, "%u", *((int *) curField->location));
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    goto storeError;
+		}
+		break;
+
+	    case 'c':
+		TclFormatInt(string, *((char *) curField->location) & 0xff);
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    goto storeError;
+		}
+		break;
+
+	    case 's':
+		if (Tcl_SetVar(interp, argv[i+3], curField->location, 0)
+			== NULL) {
+		    goto storeError;
+		}
+		break;
+
+	    case 'f':
+		Tcl_PrintDouble((Tcl_Interp *) NULL,
+			*((double *) curField->location), string);
+		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
+		    goto storeError;
+		}
+		break;
+	}
+    }
+    TclFormatInt(buf, numScanned);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    done:
+    if (results != NULL) {
+	ckfree(results);
+    }
+    if (fmtCopy != copyBuf) {
+	ckfree(fmtCopy);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    char *bytes;
+    int result;
+    
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
+	return TCL_ERROR;
+    }
+
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SplitObjCmd --
+ *
+ *	This procedure is invoked to process the "split" 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_SplitObjCmd(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 *p, *p2;
+    char *splitChars, *string, *elementStart;
+    int splitCharLen, stringLen, i, j;
+    Tcl_Obj *listPtr;
+
+    if (objc == 2) {
+	splitChars = " \n\t\r";
+	splitCharLen = 4;
+    } else if (objc == 3) {
+	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
+	return TCL_ERROR;
+    }
+
+    string = Tcl_GetStringFromObj(objv[1], &stringLen);
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    
+    /*
+     * Handle the special case of splitting on every character.
+     */
+
+    if (splitCharLen == 0) {
+	for (i = 0, p = string;  i < stringLen;  i++, p++) {
+	    Tcl_ListObjAppendElement(interp, listPtr,
+                    Tcl_NewStringObj(p, 1));
+	}
+    } else {
+	/*
+	 * Normal case: split on any of a given set of characters.
+	 * Discard instances of the split characters.
+	 */
+
+	for (i = 0, p = elementStart = string;  i < stringLen;  i++, p++) {
+	    for (j = 0, p2 = splitChars;  j < splitCharLen;  j++, p2++) {
+		if (*p2 == *p) {
+		    Tcl_ListObjAppendElement(interp, listPtr,
+                            Tcl_NewStringObj(elementStart, (p-elementStart)));
+		    elementStart = p+1;
+		    break;
+		}
+	    }
+	}
+	if (p != string) {
+	    int remainingChars = stringLen - (elementStart-string);
+	    Tcl_ListObjAppendElement(interp, listPtr,
+                    Tcl_NewStringObj(elementStart, remainingChars));
+	}
+    }
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StringObjCmd --
+ *
+ *	This procedure is invoked to process the "string" 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_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. */
+{
+    int index, 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;
+    }
+    
+    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;
+	}
+	case STR_FIRST: {
+	    register char *p, *end;
+	    int match;
+
+	    if (objc != 4) {
+	        badFirstLastArgs:
+	        Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+		return TCL_ERROR;
+	    }
+
+	    match = -1;
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    if (length1 > 0) {
+		end = string2 + length2 - length1 + 1;
+		for (p = string2;  p < end;  p++) {
+		  /*
+		   * Scan forward to find the first character.
+		   */
+		    
+		  p = memchr(p, *string1, (unsigned) (end - p));
+		  if (p == NULL) {
+		      break;
+		  }
+		  if (memcmp(string1, p, (unsigned) length1) == 0) {
+		      match = p - string2;
+		      break;
+		  }
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, match);
+	    break;
+	}
+	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;
+	}
+	case STR_LAST: {
+	    register char *p;
+	    int match;
+
+	    if (objc != 4) {
+	        goto badFirstLastArgs;
+	    }
+
+	    match = -1;
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    if (length1 > 0) {
+		for (p = string2 + length2 - length1;  p >= string2;  p--) {
+		    /*
+		     * Scan backwards to find the first character.
+		     */
+		    
+		    while ((p != string2) && (*p != *string1)) {
+			p--;
+		    }
+		    if (memcmp(string1, p, (unsigned) length1) == 0) {
+			match = p - string2;
+			break;
+		    }
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, match);
+	    break;
+	}
+	case STR_LENGTH: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
+	    }
+
+	    (void) Tcl_GetStringFromObj(objv[2], &length1);
+	    Tcl_SetIntObj(resultPtr, length1);
+	    break;
+	}
+	case STR_MATCH: {
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "pattern string");
+		return TCL_ERROR;
+	    }
+
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
+	    Tcl_SetBooleanObj(resultPtr, Tcl_StringMatch(string2, string1));
+	    break;
+	}
+	case STR_RANGE: {
+	    int first, last;
+
+	    if (objc != 5) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
+		return TCL_ERROR;
+	    }
+
+	    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;
+	}
+	case STR_TOLOWER: {
+	    register 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 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;
+	}
+	case STR_TOUPPER: {
+	    register 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;
+	}
+	case STR_TRIM: {
+	    char ch;
+	    register char *p, *end;
+	    char *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;
+			}
+		    }
+		}
+	    }
+	    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;
+			}
+		    }
+		}
+	    }
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    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;
+	}
+	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;
+	    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;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SubstCmd --
+ *
+ *	This procedure is invoked to process the "subst" Tcl command.
+ *	See the user documentation for details on what it does.  This
+ *	command is an almost direct copy of an implementation by
+ *	Andrew Payne.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_SubstCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_DString result;
+    char *p, *old, *value;
+    int code, count, doVars, doCmds, doBackslashes, i;
+    size_t length;
+    char c;
+
+    /*
+     * Parse command-line options.
+     */
+
+    doVars = doCmds = doBackslashes = 1;
+    for (i = 1; i < (argc-1); i++) {
+	p = argv[i];
+	if (*p != '-') {
+	    break;
+	}
+	length = strlen(p);
+	if (length < 4) {
+	    badSwitch:
+	    Tcl_AppendResult(interp, "bad switch \"", p,
+		    "\": must be -nobackslashes, -nocommands, ",
+		    "or -novariables", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((p[3] == 'b') && (strncmp(p, "-nobackslashes", length) == 0)) {
+	    doBackslashes = 0;
+	} else if ((p[3] == 'c') && (strncmp(p, "-nocommands", length) == 0)) {
+	    doCmds = 0;
+	} else if ((p[3] == 'v') && (strncmp(p, "-novariables", length) == 0)) {
+	    doVars = 0;
+	} else {
+	    goto badSwitch;
+	}
+    }
+    if (i != (argc-1)) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ?-nobackslashes? ?-nocommands? ?-novariables? string\"",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the string one character at a time, performing
+     * command, variable, and backslash substitutions.
+     */
+
+    Tcl_DStringInit(&result);
+    old = p = argv[i];
+    while (*p != 0) {
+	switch (*p) {
+	    case '\\':
+		if (doBackslashes) {
+		    if (p != old) {
+			Tcl_DStringAppend(&result, old, p-old);
+		    }
+		    c = Tcl_Backslash(p, &count);
+		    Tcl_DStringAppend(&result, &c, 1);
+		    p += count;
+		    old = p;
+		} else {
+		    p++;
+		}
+		break;
+
+	    case '$':
+		if (doVars) {
+		    if (p != old) {
+			Tcl_DStringAppend(&result, old, p-old);
+		    }
+		    value = Tcl_ParseVar(interp, p, &p);
+		    if (value == NULL) {
+			Tcl_DStringFree(&result);
+			return TCL_ERROR;
+		    }
+		    Tcl_DStringAppend(&result, value, -1);
+		    old = p;
+		} else {
+		    p++;
+		}
+		break;
+
+	    case '[':
+		if (doCmds) {
+		    if (p != old) {
+			Tcl_DStringAppend(&result, old, p-old);
+		    }
+		    iPtr->evalFlags = TCL_BRACKET_TERM;
+		    code = Tcl_Eval(interp, p+1);
+		    if (code == TCL_ERROR) {
+			Tcl_DStringFree(&result);
+			return code;
+		    }
+		    old = p = (p+1 + iPtr->termOffset+1);
+		    Tcl_DStringAppend(&result, iPtr->result, -1);
+		    Tcl_ResetResult(interp);
+		} else {
+		    p++;
+		}
+		break;
+
+	    default:
+		p++;
+		break;
+	}
+    }
+    if (p != old) {
+	Tcl_DStringAppend(&result, old, p-old);
+    }
+    Tcl_DStringResult(interp, &result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SwitchObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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 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 (switchObjc > 0) {
+	string = Tcl_GetStringFromObj(switchObjv[0], &length);
+	if (*string != '-') {
+	    break;
+	}
+	if (Tcl_GetIndexFromObj(interp, switchObjv[0], switches,
+		"option", 0, &index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	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++;
+    }
+
+    doneWithSwitches:
+    if (switchObjc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?switches? string pattern body ... ?default body?");
+	return TCL_ERROR;
+    }
+    
+    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.
+     */
+
+    splitObjs = 0;
+    if (switchObjc == 1) {
+	code = Tcl_ListObjLength(interp, switchObjv[0], &switchObjc);
+	if (code != TCL_OK) {
+	    return code;
+	}
+	splitObjs = 1;
+    }
+
+    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 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 ((*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, pattern) == 0);
+		    break;
+		case GLOB:
+		    matched = Tcl_StringMatch(string, pattern);
+		    break;
+		case REGEXP:
+		    matched = Tcl_RegExpMatch(interp, string, pattern);
+		    if (matched < 0) {
+			code = TCL_ERROR;
+			goto done;
+		    }
+		    break;
+	    }
+	}
+	if (!matched) {
+	    continue;
+	}
+
+	/*
+	 * We've got a match. Find a body to execute, skipping bodies
+	 * that are "-".
+	 */
+
+	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 done;
+	    }
+	    
+	    if (splitObjs) {
+		code = Tcl_ListObjIndex(interp, switchObjv[0], bodyIdx,
+		        &bodyObj);
+		if (code != TCL_OK) {
+		    return code;
+		}
+	    } else {
+		bodyObj = switchObjv[bodyIdx];
+	    }
+	    /*
+	     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL.
+	     */
+	    body = Tcl_GetStringFromObj(bodyObj, &length);
+	    if ((length != 1) || (body[0] != '-')) {
+		break;
+	    }
+	}
+	code = Tcl_EvalObj(interp, bodyObj);
+	if (code == TCL_ERROR) {
+	    char msg[100];
+	    sprintf(msg, "\n    (\"%.50s\" arm line %d)", pattern,
+		    interp->errorLine);
+	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	}
+	goto done;
+    }
+
+    /*
+     * Nothing matched:  return nothing.
+     */
+
+    code = TCL_OK;
+
+    done:
+    return code;
+#undef EXACT
+#undef GLOB
+#undef REGEXP
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TimeObjCmd --
+ *
+ *	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 object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    register Tcl_Obj *objPtr;
+    register int i, result;
+    int count;
+    double totalMicroSec;
+    Tcl_Time start, stop;
+    char buf[100];
+
+    if (objc == 2) {
+	count = 1;
+    } else if (objc == 3) {
+	result = Tcl_GetIntFromObj(interp, objv[2], &count);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
+	return TCL_ERROR;
+    }
+    
+    objPtr = objv[1];
+    i = count;
+    TclpGetTime(&start);
+    while (i-- > 0) {
+	result = Tcl_EvalObj(interp, objPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    TclpGetTime(&stop);
+    
+    totalMicroSec =
+	(stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+    sprintf(buf, "%.0f microseconds per iteration",
+	((count <= 0) ? 0 : totalMicroSec/count));
+    Tcl_ResetResult(interp);
+    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceCmd --
+ *
+ *	This procedure is invoked to process the "trace" 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_TraceCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int c;
+    size_t length;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "too few args: should be \"",
+		argv[0], " option [arg arg ...]\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    c = argv[1][1];
+    length = strlen(argv[1]);
+    if ((c == 'a') && (strncmp(argv[1], "variable", length) == 0)
+	    && (length >= 2)) {
+	char *p;
+	int flags, length;
+	TraceVarInfo *tvarPtr;
+
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " variable name ops command\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+
+	flags = 0;
+	for (p = argv[3] ; *p != 0; p++) {
+	    if (*p == 'r') {
+		flags |= TCL_TRACE_READS;
+	    } else if (*p == 'w') {
+		flags |= TCL_TRACE_WRITES;
+	    } else if (*p == 'u') {
+		flags |= TCL_TRACE_UNSETS;
+	    } else {
+		goto badOps;
+	    }
+	}
+	if (flags == 0) {
+	    goto badOps;
+	}
+
+	length = strlen(argv[4]);
+	tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
+		(sizeof(TraceVarInfo) - sizeof(tvarPtr->command) + length + 1));
+	tvarPtr->flags = flags;
+	tvarPtr->errMsg = NULL;
+	tvarPtr->length = length;
+	flags |= TCL_TRACE_UNSETS;
+	strcpy(tvarPtr->command, argv[4]);
+	if (Tcl_TraceVar(interp, argv[2], flags, TraceVarProc,
+		(ClientData) tvarPtr) != TCL_OK) {
+	    ckfree((char *) tvarPtr);
+	    return TCL_ERROR;
+	}
+    } else if ((c == 'd') && (strncmp(argv[1], "vdelete", length)
+	    && (length >= 2)) == 0) {
+	char *p;
+	int flags, length;
+	TraceVarInfo *tvarPtr;
+	ClientData clientData;
+
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " vdelete name ops command\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+
+	flags = 0;
+	for (p = argv[3] ; *p != 0; p++) {
+	    if (*p == 'r') {
+		flags |= TCL_TRACE_READS;
+	    } else if (*p == 'w') {
+		flags |= TCL_TRACE_WRITES;
+	    } else if (*p == 'u') {
+		flags |= TCL_TRACE_UNSETS;
+	    } else {
+		goto badOps;
+	    }
+	}
+	if (flags == 0) {
+	    goto badOps;
+	}
+
+	/*
+	 * Search through all of our traces on this variable to
+	 * see if there's one with the given command.  If so, then
+	 * delete the first one that matches.
+	 */
+
+	length = strlen(argv[4]);
+	clientData = 0;
+	while ((clientData = Tcl_VarTraceInfo(interp, argv[2], 0,
+		TraceVarProc, clientData)) != 0) {
+	    tvarPtr = (TraceVarInfo *) clientData;
+	    if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+		    && (strncmp(argv[4], tvarPtr->command,
+		    (size_t) length) == 0)) {
+		Tcl_UntraceVar(interp, argv[2], flags | TCL_TRACE_UNSETS,
+			TraceVarProc, clientData);
+		if (tvarPtr->errMsg != NULL) {
+		    ckfree(tvarPtr->errMsg);
+		}
+		ckfree((char *) tvarPtr);
+		break;
+	    }
+	}
+    } else if ((c == 'i') && (strncmp(argv[1], "vinfo", length) == 0)
+	    && (length >= 2)) {
+	ClientData clientData;
+	char ops[4], *p;
+	char *prefix = "{";
+
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " vinfo name\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	clientData = 0;
+	while ((clientData = Tcl_VarTraceInfo(interp, argv[2], 0,
+		TraceVarProc, clientData)) != 0) {
+	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+	    p = ops;
+	    if (tvarPtr->flags & TCL_TRACE_READS) {
+		*p = 'r';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
+		*p = 'w';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+		*p = 'u';
+		p++;
+	    }
+	    *p = '\0';
+	    Tcl_AppendResult(interp, prefix, (char *) NULL);
+	    Tcl_AppendElement(interp, ops);
+	    Tcl_AppendElement(interp, tvarPtr->command);
+	    Tcl_AppendResult(interp, "}", (char *) NULL);
+	    prefix = " {";
+	}
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": should be variable, vdelete, or vinfo",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+
+    badOps:
+    Tcl_AppendResult(interp, "bad operations \"", argv[3],
+	    "\": should be one or more of rwu", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVarProc --
+ *
+ *	This procedure is called to handle variable accesses that have
+ *	been traced using the "trace" command.
+ *
+ * Results:
+ *	Normally returns NULL.  If the trace command returns an error,
+ *	then this procedure returns an error string.
+ *
+ * Side effects:
+ *	Depends on the command associated with the trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static char *
+TraceVarProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Information about the variable trace. */
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *name1;		/* Name of variable or array. */
+    char *name2;		/* Name of element within array;  NULL means
+				 * scalar variable is being referenced. */
+    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) {
+	ckfree(tvarPtr->errMsg);
+	tvarPtr->errMsg = NULL;
+    }
+    if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
+
+	/*
+	 * Generate a command to execute by appending list elements
+	 * for the two variable names and the operation.  The five
+	 * extra characters are for three space, the opcode character,
+	 * and the terminating null.
+	 */
+
+	if (name2 == NULL) {
+	    name2 = "";
+	}
+	Tcl_DStringInit(&cmd);
+	Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length);
+	Tcl_DStringAppendElement(&cmd, name1);
+	Tcl_DStringAppendElement(&cmd, name2);
+	if (flags & TCL_TRACE_READS) {
+	    Tcl_DStringAppend(&cmd, " r", 2);
+	} else if (flags & TCL_TRACE_WRITES) {
+	    Tcl_DStringAppend(&cmd, " w", 2);
+	} else if (flags & TCL_TRACE_UNSETS) {
+	    Tcl_DStringAppend(&cmd, " u", 2);
+	}
+
+	/*
+	 * 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);
+	} 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));
+	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. */
+	}
+
+	/*
+	 * 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 */
+	Tcl_DecrRefCount(oldObjResultPtr);
+
+	Tcl_DecrRefCount(dummy.objResultPtr);
+	dummy.objResultPtr = NULL;
+	Tcl_DStringFree(&cmd);
+    }
+    if (flags & TCL_TRACE_DESTROYED) {
+	result = NULL;
+	if (tvarPtr->errMsg != NULL) {
+	    ckfree(tvarPtr->errMsg);
+	}
+	ckfree((char *) tvarPtr);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WhileCmd --
+ *
+ *      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.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+        /* 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. */
+{
+    int result, value;
+
+    if (argc != 3) {
+        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;
+        }
+    }
+    if (result == TCL_BREAK) {
+        result = TCL_OK;
+    }
+    if (result == TCL_OK) {
+        Tcl_ResetResult(interp);
+    }
+    return result;
+}
+
diff --git a/tcl/generic/tclCompExpr.c b/tcl/generic/tclCompExpr.c
new file mode 100644
index 00000000000..d83752fe801
--- /dev/null
+++ b/tcl/generic/tclCompExpr.c
@@ -0,0 +1,2386 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. If 1 the
+				 * expr is compiled out-of-line in order to
+				 * implement expr's 2 level substitution
+				 * semantics properly. */
+    int exprIsComparison;	/* Set 1 if the top-level operator in the
+				 * expr is a comparison. Otherwise 0. If 1,
+				 * because the operands might be strings,
+				 * the expr is compiled out-of-line in order
+				 * 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.
+ *
+ *	envPtr->exprIsComparison is set 1 if the top-level operator in the
+ *	expr is a comparison. Otherwise it is set 0. If 1, because the
+ *	operands might be strings, the expr is compiled out-of-line in order
+ *	to implement expr's 2 level 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 */
+    info.exprIsComparison = 0;	/* set 1 if topmost operator is <,==,etc. */
+
+    /*
+     * 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;
+    envPtr->exprIsComparison = info.exprIsComparison;
+    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;
+	infoPtr->exprIsComparison = 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;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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);
+    }
+
+    /*
+     * We get here only if one or more ||'s appear as top-level operators.
+     */
+
+    done:
+    infoPtr->exprIsComparison = 0;
+    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);
+    }
+
+    /*
+     * We get here only if one or more &&'s appear as top-level operators.
+     */
+
+    done:
+    infoPtr->exprIsComparison = 0;
+    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);
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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);
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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);
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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;
+
+	/*
+	 * A comparison _is_ the top-level operator in this expression.
+	 */
+	
+	infoPtr->exprIsComparison = 1;
+    }
+
+    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;
+
+	/*
+	 * A comparison _is_ the top-level operator in this expression.
+	 */
+	
+	infoPtr->exprIsComparison = 1;
+    }
+
+    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;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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;
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    }
+
+    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;
+	}
+
+	/*
+	 * A comparison is not the top-level operator in this expression.
+	 */
+
+	infoPtr->exprIsComparison = 0;
+    } 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) && (theToken != OPEN_PAREN)) {
+	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;
+	}
+	infoPtr->exprIsComparison = 0;
+	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++) {
+	    infoPtr->exprIsComparison = 0;
+	    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);
+    }
+
+    /*
+     * A comparison is not the top-level operator in this expression.
+     */
+
+    done:
+    infoPtr->exprIsComparison = 0;
+    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;
+	    }
+	    if (termPtr != src) {
+		/*
+		 * src was the start of a valid integer. Find/create an
+		 * object in envPtr's object array to contain 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;	 /* Set below to point 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 will start 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.
+	 */
+
+	string++;
+	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/tcl/generic/tclCompile.c b/tcl/generic/tclCompile.c
new file mode 100644
index 00000000000..a6220af88ee
--- /dev/null
+++ b/tcl/generic/tclCompile.c
@@ -0,0 +1,8089 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 and various other compilation-
+ * related statistics.
+ */
+
+#ifdef TCL_COMPILE_STATS
+long tclNumCompilations = 0;
+double tclTotalSourceBytes = 0.0;
+double tclTotalCodeBytes = 0.0;
+
+double tclTotalInstBytes = 0.0;
+double tclTotalObjBytes = 0.0;
+double tclTotalExceptBytes = 0.0;
+double tclTotalAuxBytes = 0.0;
+double tclTotalCmdMapBytes = 0.0;
+
+double tclCurrentSourceBytes = 0.0;
+double tclCurrentCodeBytes = 0.0;
+
+int tclSourceCount[32];
+int tclByteCodeCount[32];
+#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,
+};
+
+/*
+ * Table of all AuxData types.
+ */
+
+static Tcl_HashTable auxDataTypeTable;
+static int auxDataTypeTableInitialized = 0;    /* 0 means not yet
+                                                * initialized. */
+
+/*
+ * 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 unsigned char *	EncodeCmdLocMap _ANSI_ARGS_((
+			    CompileEnv *envPtr, ByteCode *codePtr,
+			    unsigned char *startPtr));
+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 int		GetCmdLocEncodingSize _ANSI_ARGS_((
+			    CompileEnv *envPtr));
+static void		InitArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
+static int		IsLocalScalar  _ANSI_ARGS_((char *name, int len));
+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 */
+};
+
+/*
+ * The structures below define the AuxData types defined in this file.
+ */
+
+AuxDataType tclForeachInfoType = {
+    "ForeachInfo",				/* name */
+    DupForeachInfo,				/* dupProc */
+    FreeForeachInfo				/* freeProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    unsigned char *codeStart, *codeLimit, *pc;
+    unsigned char *codeDeltaNext, *codeLengthNext;
+    unsigned char *srcDeltaNext, *srcLengthNext;
+    int codeOffset, codeLen, srcOffset, srcLen;
+    int numCmds, numObjs, delta, objBytes, i;
+
+    if (codePtr->refCount <= 0) {
+	return;			/* already freed */
+    }
+
+    codeStart = codePtr->codeStart;
+    codeLimit = (codeStart + codePtr->numCodeBytes);
+    numCmds = codePtr->numCommands;
+    numObjs = codePtr->numObjects;
+
+    objBytes = (numObjs * sizeof(Tcl_Obj));
+    for (i = 0;  i < numObjs;  i++) {
+	Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
+	if (litObjPtr->bytes != NULL) {
+	    objBytes += litObjPtr->length;
+	}
+    }
+
+    /*
+     * Print header lines describing the ByteCode.
+     */
+
+    fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
+	    (unsigned int) codePtr, codePtr->refCount,
+	    codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
+	    codePtr->iPtr->compileEpoch);
+    fprintf(stdout, "  Source ");
+    TclPrintSource(stdout, codePtr->source,
+	    TclMin(codePtr->numSrcChars, 70));
+    fprintf(stdout, "\n  Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
+	    numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
+	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
+	    (codePtr->numSrcChars?
+	            ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
+    fprintf(stdout, "  Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
+	    codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
+	    objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
+	    (codePtr->numAuxDataItems * sizeof(AuxData)),
+	    codePtr->numCmdLocBytes);
+
+    /*
+     * If the ByteCode is the compiled body of a Tcl procedure, print
+     * information about that procedure. Note that we don't know the
+     * procedure's name since ByteCode's can be shared among procedures.
+     */
+    
+    if (codePtr->procPtr != NULL) {
+	Proc *procPtr = codePtr->procPtr;
+	int numCompiledLocals = procPtr->numCompiledLocals;
+	fprintf(stdout,
+	        "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\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: slot %d%s%s%s%s%s%s",
+			i, localPtr->frameIndex,
+			((localPtr->flags & VAR_SCALAR)?  ", scalar"  : ""),
+			((localPtr->flags & VAR_ARRAY)?  ", array"  : ""),
+			((localPtr->flags & VAR_LINK)?  ", link"  : ""),
+			((localPtr->flags & VAR_ARGUMENT)?  ", arg"  : ""),
+			((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
+			((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
+		if (TclIsVarTemporary(localPtr)) {
+		    fprintf(stdout,	"\n");
+		} else {
+		    fprintf(stdout,	", name=\"%s\"\n", localPtr->name);
+		}
+		localPtr = localPtr->nextPtr;
+	    }
+	}
+    }
+
+    /*
+     * Print the ExceptionRange array.
+     */
+
+    if (codePtr->numExcRanges > 0) {
+	fprintf(stdout, "  Exception ranges %d, depth %d:\n",
+	        codePtr->numExcRanges, codePtr->maxExcRangeDepth);
+	for (i = 0;  i < codePtr->numExcRanges;  i++) {
+	    ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
+	    fprintf(stdout, "      %d: level %d, %s, pc %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:
+		panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
+		        rangePtr->type);
+	    }
+	}
+    }
+    
+    /*
+     * If there were no commands (e.g., an expression or an empty string
+     * was compiled), just print all instructions and return.
+     */
+
+    if (numCmds == 0) {
+	pc = codeStart;
+	while (pc < codeLimit) {
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
+	}
+	return;
+    }
+    
+    /*
+     * Print table showing the code offset, source offset, and source
+     * length for each command. These are encoded as a sequence of bytes.
+     */
+
+    fprintf(stdout, "  Commands %d:", numCmds);
+    codeDeltaNext = codePtr->codeDeltaStart;
+    codeLengthNext = codePtr->codeLengthStart;
+    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+	    codeLengthNext++;
+	    codeLen = TclGetInt4AtPtr(codeLengthNext);
+	    codeLengthNext += 4;
+	} else {
+	    codeLen = TclGetInt1AtPtr(codeLengthNext);
+	    codeLengthNext++;
+	}
+	
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+	
+	fprintf(stdout,	"%s%4d: pc %d-%d, source %d-%d",
+		((i % 2)? "	" : "\n   "),
+		(i+1), codeOffset, (codeOffset + codeLen - 1),
+		srcOffset, (srcOffset + srcLen - 1));
+    }
+    if ((numCmds > 0) && ((numCmds % 2) != 0)) {
+	fprintf(stdout,	"\n");
+    }
+    
+    /*
+     * Print each instruction. If the instruction corresponds to the start
+     * of a command, print the command's source. Note that we don't need
+     * the code length here.
+     */
+
+    codeDeltaNext = codePtr->codeDeltaStart;
+    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    pc = codeStart;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+
+	/*
+	 * Print instructions before command i.
+	 */
+	
+	while ((pc-codeStart) < codeOffset) {
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
+	}
+
+	fprintf(stdout, "  Command %d: ", (i+1));
+	TclPrintSource(stdout, (codePtr->source + srcOffset),
+	        TclMin(srcLen, 70));
+	fprintf(stdout, "\n");
+    }
+    if (pc < codeLimit) {
+	/*
+	 * Print instructions after the last command.
+	 */
+
+	while (pc < codeLimit) {
+	    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 = TclGetInt1AtPtr(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 = TclGetInt4AtPtr(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 = TclGetUInt1AtPtr(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 (TclIsVarTemporary(localPtr)) {
+		    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 = TclGetUInt4AtPtr(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 (TclIsVarTemporary(localPtr)) {
+		    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupByteCode --
+ *
+ *	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;
+
+#ifdef TCL_COMPILE_STATS    
+    tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
+    tclCurrentCodeBytes -= (double) codePtr->totalSize;
+#endif /* TCL_COMPILE_STATS */
+
+    /*
+     * 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->type->freeProc != NULL) {
+	    auxDataPtr->type->freeProc(auxDataPtr->clientData);
+	}
+	auxDataPtr++;
+    }
+    
+    ckfree((char *) codePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupByteCodeInternalRep --
+ *
+ *	Part of the bytecode Tcl object type implementation. However, it
+ *	does not copy the internal representation of a bytecode Tcl_Obj, but
+ *	instead leaves the new object untyped (with a NULL type pointer).
+ *	Code will be compiled for the new object only if necessary.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupByteCodeInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+{
+    return;
+}
+
+/*
+ *-----------------------------------------------------------------------
+ *
+ * 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;
+    }
+    
+    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->type->freeProc != NULL) {
+            auxDataPtr->type->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->exprIsComparison = 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, exceptArrayBytes, cmdLocBytes;
+    size_t auxDataArrayBytes;
+    register size_t size, objBytes, totalSize;
+    register unsigned char *p;
+    unsigned char *nextPtr;
+    int srcLen = envPtr->termOffset;
+    int numObjects, i;
+    Namespace *namespacePtr;
+#ifdef TCL_COMPILE_STATS
+    int srcLenLog2, sizeLog2;
+#endif /*TCL_COMPILE_STATS*/
+
+    codeBytes = (envPtr->codeNext - envPtr->codeStart);
+    numObjects = envPtr->objArrayNext;
+    objArrayBytes = (envPtr->objArrayNext * sizeof(Tcl_Obj *));
+    exceptArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
+    auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
+    cmdLocBytes = GetCmdLocEncodingSize(envPtr);
+    
+    size = sizeof(ByteCode);
+    size += TCL_ALIGN(codeBytes);       /* align object array */
+    size += TCL_ALIGN(objArrayBytes);   /* align exception range array */
+    size += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+    size += auxDataArrayBytes;
+    size += cmdLocBytes;
+
+    /*
+     * Compute the total number of bytes needed for this bytecode
+     * including the storage for the Tcl objects in its object array.
+     */
+
+    objBytes = (numObjects * sizeof(Tcl_Obj));
+    for (i = 0;  i < numObjects;  i++) {
+	Tcl_Obj *litObjPtr = envPtr->objArrayPtr[i];
+	if (litObjPtr->bytes != NULL) {
+	    objBytes += litObjPtr->length;
+	}
+    }
+    totalSize = (size + objBytes);
+
+#ifdef TCL_COMPILE_STATS
+    tclNumCompilations++;
+    tclTotalSourceBytes += (double) srcLen;
+    tclTotalCodeBytes += (double) totalSize;
+    
+    tclTotalInstBytes += (double) codeBytes;
+    tclTotalObjBytes += (double) objBytes;
+    tclTotalExceptBytes += exceptArrayBytes;
+    tclTotalAuxBytes += (double) auxDataArrayBytes;
+    tclTotalCmdMapBytes += (double) cmdLocBytes;
+
+    tclCurrentSourceBytes += (double) srcLen;
+    tclCurrentCodeBytes += (double) totalSize;
+
+    srcLenLog2 = TclLog2(srcLen);
+    sizeLog2 = TclLog2((int) totalSize);
+    if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
+	panic("TclInitByteCodeObj: bad source or code sizes\n");
+    }
+    tclSourceCount[srcLenLog2]++;
+    tclByteCodeCount[sizeLog2]++;
+#endif /* TCL_COMPILE_STATS */    
+
+    if (envPtr->iPtr->varFramePtr != NULL) {
+        namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
+    } else {
+        namespacePtr = envPtr->iPtr->globalNsPtr;
+    }
+    
+    p = (unsigned char *) ckalloc(size);
+    codePtr = (ByteCode *) p;
+    codePtr->iPtr = envPtr->iPtr;
+    codePtr->compileEpoch = envPtr->iPtr->compileEpoch;
+    codePtr->nsPtr = namespacePtr;
+    codePtr->nsEpoch = namespacePtr->resolverEpoch;
+    codePtr->refCount = 1;
+    codePtr->flags = 0;
+    codePtr->source = envPtr->source;
+    codePtr->procPtr = envPtr->procPtr;
+    codePtr->totalSize = totalSize;
+    codePtr->numCommands = envPtr->numCommands;
+    codePtr->numSrcChars = srcLen;
+    codePtr->numCodeBytes = codeBytes;
+    codePtr->numObjects = numObjects;
+    codePtr->numExcRanges = envPtr->excRangeArrayNext;
+    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
+    codePtr->auxDataArrayPtr = NULL;
+    codePtr->numCmdLocBytes = cmdLocBytes;
+    codePtr->maxExcRangeDepth = envPtr->maxExcRangeDepth;
+    codePtr->maxStackDepth = envPtr->maxStackDepth;
+    
+    p += sizeof(ByteCode);
+    codePtr->codeStart = p;
+    memcpy((VOID *) p, (VOID *) envPtr->codeStart, codeBytes);
+    
+    p += TCL_ALIGN(codeBytes);	      /* align object array */
+    codePtr->objArrayPtr = (Tcl_Obj **) p;
+    memcpy((VOID *) p, (VOID *) envPtr->objArrayPtr, objArrayBytes);
+
+    p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
+    if (exceptArrayBytes > 0) {
+	codePtr->excRangeArrayPtr = (ExceptionRange *) p;
+	memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr,
+	        exceptArrayBytes);
+    }
+    
+    p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+    if (auxDataArrayBytes > 0) {
+	codePtr->auxDataArrayPtr = (AuxData *) p;
+	memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
+	        auxDataArrayBytes);
+    }
+
+    p += auxDataArrayBytes;
+    nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
+    if (((size_t)(nextPtr - p)) != cmdLocBytes) {	
+	panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
+    }
+    
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCmdLocEncodingSize --
+ *
+ *	Computes the total number of bytes needed to encode the command
+ *	location information for some compiled code.
+ *
+ * Results:
+ *	The byte count needed to encode the compiled location information.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCmdLocEncodingSize(envPtr)
+     CompileEnv *envPtr;	/* Points to compilation environment
+				 * structure containing the CmdLocation
+				 * structure to encode. */
+{
+    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+    int numCmds = envPtr->numCommands;
+    int codeDelta, codeLen, srcDelta, srcLen;
+    int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
+				/* The offsets in their respective byte
+				 * sequences where the next encoded offset
+				 * or length should go. */
+    int prevCodeOffset, prevSrcOffset, i;
+
+    codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
+    prevCodeOffset = prevSrcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
+	if (codeDelta < 0) {
+	    panic("GetCmdLocEncodingSize: bad code offset");
+	} else if (codeDelta <= 127) {
+	    codeDeltaNext++;
+	} else {
+	    codeDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for positive delta */
+	}
+	prevCodeOffset = mapPtr[i].codeOffset;
+
+	codeLen = mapPtr[i].numCodeBytes;
+	if (codeLen < 0) {
+	    panic("GetCmdLocEncodingSize: bad code length");
+	} else if (codeLen <= 127) {
+	    codeLengthNext++;
+	} else {
+	    codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+	}
+
+	srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
+	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+	    srcDeltaNext++;
+	} else {
+	    srcDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for delta */
+	}
+	prevSrcOffset = mapPtr[i].srcOffset;
+
+	srcLen = mapPtr[i].numSrcChars;
+	if (srcLen < 0) {
+	    panic("GetCmdLocEncodingSize: bad source length");
+	} else if (srcLen <= 127) {
+	    srcLengthNext++;
+	} else {
+	    srcLengthNext += 5;	 /* 1 byte for 0xFF, 4 for length */
+	}
+    }
+
+    return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodeCmdLocMap --
+ *
+ *	Encode the command location information for some compiled code into
+ *	a ByteCode structure. The encoded command location map is stored as
+ *	three adjacent byte sequences.
+ *
+ * Results:
+ *	Pointer to the first byte after the encoded command location
+ *	information.
+ *
+ * Side effects:
+ *	The encoded information is stored into the block of memory headed
+ *	by codePtr. Also records pointers to the start of the four byte
+ *	sequences in fields in codePtr's ByteCode header structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned char *
+EncodeCmdLocMap(envPtr, codePtr, startPtr)
+     CompileEnv *envPtr;	/* Points to compilation environment
+				 * structure containing the CmdLocation
+				 * structure to encode. */
+     ByteCode *codePtr;		/* ByteCode in which to encode envPtr's
+				 * command location information. */
+     unsigned char *startPtr;	/* Points to the first byte in codePtr's
+				 * memory block where the location
+				 * information is to be stored. */
+{
+    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+    int numCmds = envPtr->numCommands;
+    register unsigned char *p = startPtr;
+    int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
+    register int i;
+    
+    /*
+     * Encode the code offset for each command as a sequence of deltas.
+     */
+
+    codePtr->codeDeltaStart = p;
+    prevOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	codeDelta = (mapPtr[i].codeOffset - prevOffset);
+	if (codeDelta < 0) {
+	    panic("EncodeCmdLocMap: bad code offset");
+	} else if (codeDelta <= 127) {
+	    TclStoreInt1AtPtr(codeDelta, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(codeDelta, p);
+	    p += 4;
+	}
+	prevOffset = mapPtr[i].codeOffset;
+    }
+
+    /*
+     * Encode the code length for each command.
+     */
+
+    codePtr->codeLengthStart = p;
+    for (i = 0;  i < numCmds;  i++) {
+	codeLen = mapPtr[i].numCodeBytes;
+	if (codeLen < 0) {
+	    panic("EncodeCmdLocMap: bad code length");
+	} else if (codeLen <= 127) {
+	    TclStoreInt1AtPtr(codeLen, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(codeLen, p);
+	    p += 4;
+	}
+    }
+
+    /*
+     * Encode the source offset for each command as a sequence of deltas.
+     */
+
+    codePtr->srcDeltaStart = p;
+    prevOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	srcDelta = (mapPtr[i].srcOffset - prevOffset);
+	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+	    TclStoreInt1AtPtr(srcDelta, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(srcDelta, p);
+	    p += 4;
+	}
+	prevOffset = mapPtr[i].srcOffset;
+    }
+
+    /*
+     * Encode the source length for each command.
+     */
+
+    codePtr->srcLengthStart = p;
+    for (i = 0;  i < numCmds;  i++) {
+	srcLen = mapPtr[i].numSrcChars;
+	if (srcLen < 0) {
+	    panic("EncodeCmdLocMap: bad source length");
+	} else if (srcLen <= 127) {
+	    TclStoreInt1AtPtr(srcLen, p);
+	    p++;
+	} else {
+	    TclStoreInt1AtPtr(0xFF, p);
+	    p++;
+	    TclStoreInt4AtPtr(srcLen, p);
+	    p += 4;
+	}
+    }
+    
+    return p;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;		/* The index of the current command in the
+ 				 * compilation environment's command
+ 				 * location table. */
+    int lastTopLevelCmdIndex = -1;
+    				/* Index of most recent toplevel command in
+ 				 * the 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 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;
+		}
+	    } 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;  /* 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.
+		 */
+		
+	        (envPtr->cmdMapPtr[lastTopLevelCmdIndex]).numCodeBytes =
+		    (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset;
+	    }
+	}
+
+	/*
+	 * 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.
+	 */
+
+	envPtr->numCommands++;
+	cmdIndex = (envPtr->numCommands - 1);
+	if (!(flags & TCL_BRACKET_TERM)) {
+	    lastTopLevelCmdIndex = cmdIndex;
+	}
+	
+	cmdSrcStart = src;
+	cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	cmdWords = 0;
+	EnterCmdStartData(envPtr, cmdIndex, src-envPtr->source,
+		cmdCodeOffset);
+	    
+	if ((!(flags & TCL_BRACKET_TERM))
+	        && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+	    /*
+	     * Display a line summarizing the top level command we are about
+	     * to compile.
+	     */
+	    
+	    char *p = cmdSrcStart;
+	    int numChars, complete;
+	    
+	    while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+		   || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+		p++;
+	    }
+	    numChars = (p - cmdSrcStart);
+	    complete = 1;
+	    if (numChars > 60) {
+		numChars = 60;
+		complete = 0;
+	    } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+		complete = 0;
+	    }
+	    fprintf(stdout, "Compiling: %.*s%s\n",
+		    numChars, cmdSrcStart, (complete? "" : " ..."));
+	}
+	
+	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;
+		    }
+		} 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;
+	    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+		src++;
+		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. Note that if we are
+		     * compiling a procedure, we must look up the command
+		     * in the procedure's namespace and not the current
+		     * namespace.
+		     */
+
+		    Namespace *cmdNsPtr;
+
+		    if (envPtr->procPtr != NULL) {
+			cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+		    } else {
+			cmdNsPtr = NULL;
+		    }
+
+		    cmdPtr = NULL;
+		    cmd = Tcl_FindCommand(interp, src,
+			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+                    if (cmd != (Tcl_Command) NULL) {
+                        cmdPtr = (Command *) cmd;
+                    }
+		    if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)) {
+			char *firstArg = termPtr;
+			src[numChars] = savedChar;
+			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;
+			} else if (result == TCL_OUT_LINE_COMPILE) {
+			    result = TCL_OK;
+			    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.twoPtrValue.ptr1 =
+				(VOID *) resPtr;
+			    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+                            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)) {
+			int code = TclGetLong(interp, src, &n);
+			if (code == 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;
+			    }
+			} else {
+			    Tcl_ResetResult(interp);
+			}
+		    }
+		    if (!isCompilableInt) {
+			objIndex = TclObjIndexForString(src, numChars,
+			        /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		    }
+		}
+		src[numChars] = savedChar;
+		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.
+	 */
+
+	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.
+	 */
+
+        finishCommand:
+	EnterCmdExtentData(envPtr, cmdIndex, src-cmdSrcStart,
+	        (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset);
+	
+	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;
+	}
+    } else {
+	/*
+	 * Add additional error information. First compute the line number
+	 * where the error occurred.
+	 */
+
+	register char *p;
+	int numChars;
+	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 end of the command).
+	 */
+
+	p = cmdSrcStart;
+	while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
+		|| ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
+	    p++;
+	}
+	numChars = (p - cmdSrcStart);
+	if (numChars > 150) {
+	    numChars = 150;
+	    ellipsis = " ...";
+	} else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
+	    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++;
+	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;
+		    }
+		    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;
+			}
+			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;
+	    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++;
+	    } 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++;
+	    }
+	    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++;
+		    }
+		    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;
+	    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++;
+    }
+
+    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); /* 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;
+    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++;
+        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;
+		    while (*src == ':') {
+			src++;
+		    }
+                    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];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    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];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		TclEmitPush(objIndex, envPtr); 
+		TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+		maxDepth = 1;
+	    }
+	}
+    } else {			/* array reference */
+	if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
+	    savedChar = name[nameChars];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    TclEmitPush(objIndex, envPtr);
+	    maxDepth = 1;
+	} else {
+	    localIndex = LookupCompiledLocal(name, nameChars,
+	            /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
+		    envPtr->procPtr);
+	    if (localIndex < 0) {
+		savedChar = name[nameChars];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		TclEmitPush(objIndex, envPtr);
+		maxDepth = 1;
+	    }
+	}
+
+	/*
+	 * Parse and push the array element. Perform substitutions on it,
+	 * just as is done for quoted strings.
+	 */
+
+	src++;
+	envPtr->pushSimpleWords = 1;
+	result = TclCompileQuotes(interp, src, lastChar, ')', flags,
+		envPtr);
+	src += envPtr->termOffset;
+	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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsLocalScalar --
+ *
+ *	Checks to see if a variable name refers to a local scalar.
+ *
+ * Results:
+ *	Returns 1 if the variable is a local scalar.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsLocalScalar(varName, length)
+    char *varName;		/* The name to check. */
+    int length;		/* The number of characters in the string.  */
+{
+    char *p;
+    char *lastChar = varName + (length - 1);
+
+    for (p = varName; p <= lastChar; p++) {
+	if ((CHAR_TYPE(p, lastChar) != TCL_NORMAL) &&
+	    (CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)) {
+	    /*
+	     * TCL_COMMAND_END is returned for the last character
+	     * of the string.  By this point we know it isn't
+	     * an array or namespace reference.
+	     */
+
+	    return 0;
+	}
+	if  (*p == '(') {
+	    if (*lastChar == ')') { /* we have an array element */
+		return 0;
+	    }
+	} else if (*p == ':') {
+	    if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
+		return 0;
+	    }
+	}
+    }
+	
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 (!IsLocalScalar(firstChar, nameChars)) {
+	    result = TCL_OUT_LINE_COMPILE;
+	    goto done;
+	}
+
+	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);
+    *(bodyEnd+1) = '\0';
+    result = CompileCmdWordInline(interp, bodyStart, (bodyEnd+1),
+	    flags, envPtr);
+    *(bodyEnd+1) = savedChar;
+    
+    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);
+
+    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.
+     */
+
+    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);
+    }
+    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;
+    int saveExprIsComparison = envPtr->exprIsComparison;
+
+    /*
+     * 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';
+	    result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
+		    flags, envPtr);
+	    *wordEnd = '}';
+	    
+	    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';
+	result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
+	*(last + 1) = savedChar;
+	
+	maxDepth = envPtr->maxStackDepth;
+	envPtr->excRangeArrayPtr[range].numCodeBytes =
+	        TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+	
+	if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+	        || (envPtr->exprIsComparison)) {
+	    /*
+	     * We must call the expr command at runtime. Either there was a
+	     * compilation error or the inline code might fail to give the
+	     * correct 2 level substitution semantics.
+	     *
+	     * The latter can happen if the expression consisted of just a
+	     * single variable reference or if the top-level operator in the
+	     * expr is a comparison (which might operate on strings). In the
+	     * latter case, the expression's code might execute (apparently)
+	     * successfully but produce the wrong result. We depend on its
+	     * execution failing if a second level of substitutions is
+	     * required. This causes the "catch" code we generate around the
+	     * inline code to back off to a call on the expr command at
+	     * runtime, and this always gives the right 2 level substitution
+	     * semantics.
+	     *
+	     * We 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';
+	envPtr->pushSimpleWords = 1;
+	result = CompileWord(interp, wordStart, wordEnd+1, flags, envPtr);
+	*(wordEnd + 1) = savedChar;
+	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.
+	     */
+	    
+	    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->exprIsComparison = saveExprIsComparison;
+    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 = -1, 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 not enclosed in braces, 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.
+     * NOTE: This is an overly aggressive test, since there are legitimate
+     * literals that could be compiled but aren't in braces.  However, until
+     * the parser is integrated in 8.1, this is the simplest implementation.
+     */
+
+    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);
+    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.
+	 */
+
+	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.
+     */
+
+    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;
+    }
+
+    done:
+    if (numWords == 0) {
+	envPtr->termOffset = 0;
+    } else {
+	envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+    }
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    if (range1 != -1) {
+	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 = -1;		/* 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);
+	*(varListEnd+1) = '\0';
+	result = Tcl_SplitList(interp, varListStart,
+			       &varcList[i], &varvList[i]);
+	*(varListEnd+1) = savedChar;
+        if (result != TCL_OK) {
+            goto done;
+        }
+
+	/*
+	 * Check that each variable name has no substitutions and that
+	 * it is a local scalar name.
+	 */
+
+	numVars = varcList[i];
+	for (j = 0;  j < numVars;  j++) {
+	    char *varName = varvList[i][j];
+	    if (!IsLocalScalar(varName, (int) strlen(varName))) {
+		result = TCL_OUT_LINE_COMPILE;
+		goto done;
+	    }
+	}
+    }
+
+    /*
+     *==== 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,
+            &tclForeachInfoType, 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);
+    }
+
+    /*
+     * 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);
+    *(bodyEnd+1) = '\0';
+    envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
+    result = CompileCmdWordInline(interp, bodyStart, bodyEnd+1, flags,
+	    envPtr);
+    *(bodyEnd+1) = savedChar;
+    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);
+    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.
+	 */
+
+	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.
+     */
+
+    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;
+    }
+
+    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;
+    if (range != -1) {
+	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);
+	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;
+	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;
+		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) {
+		char msg[60];
+		sprintf(msg, "\n    (\"if\" then script line %d)",
+		        interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -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;
+		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;
+    } /* 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;
+		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) {
+		char msg[60];
+		sprintf(msg, "\n    (\"if\" else script line %d)",
+		        interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -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 = TclGetInt1AtPtr(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
+	    } else if (opCode == INST_JUMP_FALSE4) {
+		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclStoreInt4AtPtr(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);
+    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;
+    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++;
+	}
+	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];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    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];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		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];
+	    elName[elNameChars] = '\0';
+	    envPtr->pushSimpleWords = 1;
+	    result = TclCompileQuotes(interp, elName, elName+elNameChars,
+		    0, flags, envPtr);
+	    elName[elNameChars] = savedChar;
+	    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;
+	result = CompileWord(interp, src, lastChar, flags, envPtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddObjErrorInfo(interp,
+		        "\n    (increment expression)", -1);
+	    }
+	    goto done;
+	}
+	if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
+	    src++;
+	}
+	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)) {
+		int code = TclGetLong(interp, src, &n);
+		if (code == 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;
+			}
+		    }
+		} else {
+		    Tcl_ResetResult(interp);
+		}
+	    }
+	    if (!isCompilableInt) {
+		objIndex = TclObjIndexForString(src, numChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		TclEmitPush(objIndex, envPtr);
+		maxDepth += 1;
+	    }
+	    src[numChars] = savedChar;
+	} 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 (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;
+	}
+    }
+
+    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;
+    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];
+	    name[nameChars] = '\0';
+	    objIndex = TclObjIndexForString(name, nameChars,
+		    /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+	    name[nameChars] = savedChar;
+	    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];
+		name[nameChars] = '\0';
+		objIndex = TclObjIndexForString(name, nameChars,
+			/*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+		name[nameChars] = savedChar;
+		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];
+	    elName[elNameChars] = '\0';
+	    envPtr->pushSimpleWords = 1;
+	    result = TclCompileQuotes(interp, elName, elName+elNameChars,
+		    0, flags, envPtr);
+	    elName[elNameChars] = savedChar;
+	    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++;
+	    }
+	    savedChar = p[envPtr->numSimpleWordChars];
+	    p[envPtr->numSimpleWordChars] = '\0';
+	    isCompilableInt = 0;
+	    if (TclLooksLikeInt(p)) {
+		int code = TclGetLong(interp, p, &n);
+		if (code == 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;
+		    }
+		} else {
+		    Tcl_ResetResult(interp);
+		}
+	    }
+	    if (!isCompilableInt) {
+		objIndex = TclObjIndexForString(p,
+			envPtr->numSimpleWordChars, /*allocStrRep*/ 1,
+			/*inHeap*/ 0, envPtr);
+	    }
+	    p[envPtr->numSimpleWordChars] = savedChar;
+	    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 = -1;		/* 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;
+
+    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),
+	        "wrong # args: should be \"while test command\"", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * If the test expression is not enclosed in braces, 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; whie "$x > 5" {incr x}": the loop body 
+     * should never be executed.
+     * NOTE: This is an overly aggressive test, since there are legitimate
+     * literals that could be compiled but aren't in braces.  However, until
+     * the parser is integrated in 8.1, this is the simplest implementation.
+     */
+
+    if (*src != '{') {
+	result = TCL_OUT_LINE_COMPILE;
+	goto done;
+    }
+
+    /*
+     * 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);
+    envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
+
+    /*
+     * Compile the next word: the test expression.
+     */
+
+    envPtr->pushSimpleWords = 1;
+    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);
+    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);
+    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.
+	 */
+
+	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.
+     */
+
+    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;
+    }
+
+    /*
+     * 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;
+	}
+    }
+
+    done:
+    envPtr->termOffset = (src - string);
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->maxStackDepth = maxDepth;
+    if (range != -1) {
+	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 enable proper cleanup. */
+    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 saveExprIsComparison = envPtr->exprIsComparison;
+    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) {
+	    goto badArgs;
+	}
+	if (*src != '}') {
+	    goto badArgs;
+	}
+	last = (src-1);
+
+	numChars = (last - first + 1);
+	savedChar = first[numChars];
+	first[numChars] = '\0';
+	result = TclCompileExpr(interp, first, first+numChars,
+		flags, envPtr);
+	first[numChars] = savedChar;
+
+	src++;
+	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';
+	    result = TclCompileExpr(interp, first, first + numChars,
+		    flags, envPtr);
+	    first[numChars] = savedChar;
+	    
+	    envPtr->excRangeArrayPtr[range].numCodeBytes =
+		TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+
+	    if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+	            || (envPtr->exprIsComparison)) {
+		/*
+		 * We must call the expr command at runtime. Either there
+		 * was a compilation error or the inline code might fail to
+		 * give the correct 2 level substitution semantics.
+		 *
+		 * The latter can happen if the expression consisted of just
+		 * a single variable reference or if the top-level operator
+		 * in the expr is a comparison (which might operate on
+		 * strings). In the latter case, the expression's code might
+		 * execute (apparently) successfully but produce the wrong
+		 * result. We depend on its execution failing if a second
+		 * level of substitutions is required. This causes the
+		 * "catch" code we generate around the inline code to back
+		 * off to a call on the expr command at runtime, and this
+		 * always gives the right 2 level substitution semantics.
+		 *
+		 * We 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.
+		 */
+
+		envPtr->excRangeArrayPtr[range].catchOffset += 3;
+	    }
+	}
+    } /* if expression isn't in {}s */
+    
+    done:
+    if (range != -1) {
+	envPtr->excRangeDepth--;
+    }
+    envPtr->termOffset = (src - string);
+    envPtr->maxStackDepth = maxDepth;
+    envPtr->pushSimpleWords = savePushSimpleWords;
+    envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
+    envPtr->exprIsComparison = saveExprIsComparison;
+    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++;
+	envPtr->pushSimpleWords = 0;
+	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;
+	    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;
+
+	    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;
+		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;
+		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;
+	    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;
+    int localCt;
+
+    /*
+     * If not creating a temporary, does a local variable of the specified
+     * name already exist?
+     */
+
+    if (name != NULL) {	
+	localCt = procPtr->numCompiledLocals;
+	localPtr = procPtr->firstLocalPtr;
+	for (i = 0;  i < localCt;  i++) {
+	    if (!TclIsVarTemporary(localPtr)) {
+		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->flags = flagsIfCreated;
+	if (name == NULL) {
+	    localPtr->flags |= VAR_TEMPORARY;
+	}
+	localPtr->defValuePtr = NULL;
+ 	localPtr->resolveInfo = NULL;
+ 	
+	if (name != NULL) {
+	    memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars);
+	}
+	localPtr->name[nameChars] = '\0';
+	procPtr->numCompiledLocals++;
+    }
+    return localIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitCompiledLocals --
+ *
+ *	This routine is invoked in order to initialize the compiled
+ *	locals table for a new call frame.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitCompiledLocals(interp, framePtr, nsPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    CallFrame *framePtr;	/* Call frame to initialize. */
+    Namespace *nsPtr;		/* Pointer to current namespace. */
+{
+    register CompiledLocal *localPtr;
+    Interp *iPtr = (Interp*) interp;
+    Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
+    Var *varPtr = framePtr->compiledLocals;
+    Var *resolvedVarPtr;
+    ResolverScheme *resPtr;
+    int result;
+
+    /*
+     * Initialize the array of local variables stored in the call frame.
+     * Some variables may have special resolution rules.  In that case,
+     * we call their "resolver" procs to get our hands on the variable,
+     * and we make the compiled local a link to the real variable.
+     */
+
+    for (localPtr = framePtr->procPtr->firstLocalPtr;
+	 localPtr != NULL;
+	 localPtr = localPtr->nextPtr) {
+
+	/*
+	 * Check to see if this local is affected by namespace or
+	 * interp resolvers.  The resolver to use is cached for the
+	 * next invocation of the procedure.
+	 */
+
+	if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
+		&& (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
+	    resPtr = iPtr->resolverPtr;
+
+	    if (nsPtr->compiledVarResProc) {
+		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
+			localPtr->name, localPtr->nameLength,
+			(Tcl_Namespace *) nsPtr, &vinfo);
+	    } else {
+		result = TCL_CONTINUE;
+	    }
+
+	    while ((result == TCL_CONTINUE) && resPtr) {
+		if (resPtr->compiledVarResProc) {
+		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+			    localPtr->name, localPtr->nameLength,
+			    (Tcl_Namespace *) nsPtr, &vinfo);
+		}
+		resPtr = resPtr->nextPtr;
+	    }
+	    if (result == TCL_OK) {
+		localPtr->resolveInfo = vinfo;
+		localPtr->flags |= VAR_RESOLVED;
+	    }
+	}
+
+	/*
+	 * Now invoke the resolvers to determine the exact variables that
+	 * should be used.
+	 */
+
+        resVarInfo = localPtr->resolveInfo;
+        resolvedVarPtr = NULL;
+
+        if (resVarInfo && resVarInfo->fetchProc) {
+            resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
+                resVarInfo);
+        }
+
+        if (resolvedVarPtr) {
+	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+	    varPtr->nsPtr = NULL;
+	    varPtr->hPtr = NULL;
+	    varPtr->refCount = 0;
+	    varPtr->tracePtr = NULL;
+	    varPtr->searchPtr = NULL;
+	    varPtr->flags = 0;
+            TclSetVarLink(varPtr);
+            varPtr->value.linkPtr = resolvedVarPtr;
+            resolvedVarPtr->refCount++;
+        } else {
+	    varPtr->value.objPtr = NULL;
+	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+	    varPtr->nsPtr = NULL;
+	    varPtr->hPtr = NULL;
+	    varPtr->refCount = 0;
+	    varPtr->tracePtr = NULL;
+	    varPtr->searchPtr = NULL;
+	    varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
+        }
+	varPtr++;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+    CONST char *src;		/* Points to the backslash character of
+				 * a backslash sequence. */
+    int *readPtr;		/* Fill in with number of characters read
+				 * from src, unless NULL. */
+{
+    CONST 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);
+	    }
+	    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 {
+	    if (length > 0) {
+		objPtr->bytes = ckalloc((unsigned) length + 1);
+		memcpy((VOID *) objPtr->bytes, (VOID *) string,
+			(size_t) length);
+		objPtr->bytes[length] = '\0';
+	    }
+	}
+	objPtr->length = length;
+    } else {			/* leave the string rep NULL */
+	if (inHeap) {
+	    ckfree(string);
+	}
+    }
+
+    if (envPtr->objArrayNext >= envPtr->objArrayEnd) {
+        ExpandObjectArray(envPtr);
+    }
+    objIndex = envPtr->objArrayNext;
+    envPtr->objArrayPtr[objIndex] = objPtr;
+    Tcl_IncrRefCount(objPtr);
+    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;
+    }
+
+    if (cmdIndex > 0) {
+	if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
+	    panic("EnterCmdStartData: cmd map table not sorted by code offset");
+	}
+    }
+
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr->codeOffset = codeOffset;
+    cmdLocPtr->srcOffset = srcOffset;
+    cmdLocPtr->numSrcChars = -1;
+    cmdLocPtr->numCodeBytes = -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EnterCmdExtentData --
+ *
+ *	Registers the source and bytecode length for 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) {
+	        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++;
+	    } else if ((*src == ';') && (*prev == '"')) {
+		scanningArgs = 0;
+		wordEnd = prev;
+	    } else {
+		goto badStringTermination;
+	    }
+	} else if (*src == '{') {
+	    wordStart = src;
+	    src = TclWordEnd(src, lastChar, nestedCmd, NULL);
+	    if (src == lastChar) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-brace", -1);
+		return TCL_ERROR;
+	    }
+	    prev = (src-1);
+	    if (*src == '}') {
+		wordEnd = src;
+		src++;
+	    } else if ((*src == ';') && (*prev == '}')) {
+		scanningArgs = 0;
+		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) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		        "missing close-bracket or close-brace", -1);
+		return TCL_ERROR;
+	    } else if (*src == ';') {
+		scanningArgs = 0;
+		wordEnd = prev;
+	    } else {
+		wordEnd = src;
+		src++;
+		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);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateExceptionRange --
+ *
+ *	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, typePtr, envPtr)
+    ClientData clientData;	/* The compilation auxiliary data to store
+                             * in the new aux data record. */
+    AuxDataType *typePtr;	/* Pointer to the type to attach to this AuxData */
+    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->type = typePtr;
+    auxDataPtr->clientData = clientData;
+    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;
+    
+    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;
+    }
+
+    /*
+     * 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 */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInstructionTable --
+ *
+ *  Returns a pointer to the table describing Tcl bytecode instructions.
+ *  This procedure is defined so that clients can access the pointer from
+ *  outside the TCL DLLs.
+ *
+ * Results:
+ *	Returns a pointer to the global instruction table, same as the expression
+ *  (&instructionTable[0]).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+InstructionDesc *
+TclGetInstructionTable()
+{
+    return &instructionTable[0];
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclRegisterAuxDataType --
+ *
+ *	This procedure is called to register a new AuxData type
+ *	in the table of all AuxData types supported by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The type is registered in the AuxData type table. If there was already
+ *	a type with the same name as in typePtr, it is replaced with the
+ *	new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclRegisterAuxDataType(typePtr)
+    AuxDataType *typePtr;	/* Information about object type;
+                             * storage must be statically
+                             * allocated (must live forever). */
+{
+    register Tcl_HashEntry *hPtr;
+    int new;
+
+    if (!auxDataTypeTableInitialized) {
+        TclInitAuxDataTypeTable();
+    }
+
+    /*
+     * If there's already a type with the given name, remove it.
+     */
+
+    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * Now insert the new object type.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
+    if (new) {
+        Tcl_SetHashValue(hPtr, typePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetAuxDataType --
+ *
+ *	This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ *	If an AuxData type with name matching "typeName" is found, a pointer
+ *	to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+AuxDataType *
+TclGetAuxDataType(typeName)
+    char *typeName;		/* Name of AuxData type to look up. */
+{
+    register Tcl_HashEntry *hPtr;
+    AuxDataType *typePtr = NULL;
+
+    if (!auxDataTypeTableInitialized) {
+        TclInitAuxDataTypeTable();
+    }
+
+    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
+    }
+
+    return typePtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclInitAuxDataTypeTable --
+ *
+ *	This procedure is invoked to perform once-only initialization of
+ *	the AuxData type table. It also registers the AuxData types defined in 
+ *	this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the table of defined AuxData types "auxDataTypeTable" with
+ *	builtin AuxData types defined in this file.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclInitAuxDataTypeTable()
+{
+    auxDataTypeTableInitialized = 1;
+
+    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+    TclRegisterAuxDataType(&tclForeachInfoType);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeAuxDataTypeTable --
+ *
+ *	This procedure is called by Tcl_Finalize after all exit handlers
+ *	have been run to free up storage associated with the table of AuxData
+ *	types.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes all entries in the hash table of AuxData types, "auxDataTypeTable".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeAuxDataTypeTable()
+{
+    if (auxDataTypeTableInitialized) {
+        Tcl_DeleteHashTable(&auxDataTypeTable);
+        auxDataTypeTableInitialized = 0;
+    }
+}
diff --git a/tcl/generic/tclCompile.h b/tcl/generic/tclCompile.h
new file mode 100644
index 00000000000..20a0f0fc17b
--- /dev/null
+++ b/tcl/generic/tclCompile.h
@@ -0,0 +1,1054 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLCOMPILATION
+#define _TCLCOMPILATION 1
+
+#ifndef _TCLINT
+#include "tclInt.h"
+#endif /* _TCLINT */
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ *------------------------------------------------------------------------
+ * 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 and various other compilation-related
+ * statistics. The tclByteCodeCount and tclSourceCount arrays are used to
+ * hold the count of ByteCodes and sources whose sizes fall into various
+ * binary decades; e.g., tclByteCodeCount[5] is a count of the ByteCodes
+ * with size larger than 2**4 and less than or equal to 2**5.
+ */
+
+#ifdef TCL_COMPILE_STATS
+extern long		tclNumCompilations;
+extern double		tclTotalSourceBytes;
+extern double		tclTotalCodeBytes;
+
+extern double		tclTotalInstBytes;
+extern double		tclTotalObjBytes;
+extern double		tclTotalExceptBytes;
+extern double		tclTotalAuxBytes;
+extern double		tclTotalCmdMapBytes;
+
+extern double		tclCurrentSourceBytes;
+extern double		tclCurrentCodeBytes;
+
+extern int		tclSourceCount[32];
+extern int		tclByteCodeCount[32];
+#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 its code's starting offset and 
+ * its source's starting offset and length. Note that the code offset
+ * increases monotonically: that is, the table is sorted in code offset
+ * order. The source offset is not monotonic.
+ */
+
+typedef struct CmdLocation {
+    int codeOffset;		/* Offset of first byte of command code. */
+    int numCodeBytes;		/* Number of bytes for command's code. */
+    int srcOffset;		/* Offset of first char of the command. */
+    int numSrcChars;		/* Number of command source chars. */
+} 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));
+
+/*
+ * We define a separate AuxDataType struct to hold type-related information
+ * for the AuxData structure. This separation makes it possible for clients
+ * outside of the TCL core to manipulate (in a limited fashion!) AuxData;
+ * for example, it makes it possible to pickle and unpickle AuxData structs.
+ */
+
+typedef struct AuxDataType {
+    char *name;					/* the name of the type. Types can be
+                                 * registered and found by name */
+    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. */
+} AuxDataType;
+
+/*
+ * The definition of the AuxData structure that holds information created
+ * during compilation by CompileProcs and used by instructions during
+ * execution.
+ */
+
+typedef struct AuxData {
+    AuxDataType *type;		/* pointer to the AuxData type associated with
+                             * this ClientData. */
+    ClientData clientData;	/* The compilation data itself. */
+} 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 exprIsComparison;	/* Set 1 if the top-level operator in the
+				 * expression last compiled is a comparison.
+				 * Otherwise 0. If 1, since the operands
+				 * might be strings, the expr is compiled
+				 * out-of-line 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.
+ */
+
+/*
+ * A PRECOMPILED bytecode struct is one that was generated from a compiled
+ * image rather than implicitly compiled from source
+ */
+#define TCL_BYTECODE_PRECOMPILED		0x0001
+
+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. */
+    Namespace *nsPtr;		/* Namespace context in which this code
+				 * was compiled. If the code is executed
+				 * if a different namespace, it must be
+				 * recompiled. */
+    int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
+				 * ByteCode was compiled. Used to invalidate
+				 * code when new namespace resolution rules
+				 * are put into effect. */
+    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. */
+    unsigned int flags;		/* flags describing state for the codebyte.
+                                 * this variable holds ORed values from the
+                                 * TCL_BYTECODE_ masks defined above */
+    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. */
+    size_t totalSize;		/* Total number of bytes required for this
+				 * ByteCode structure including the storage
+				 * for Tcl objects in its object array. */
+    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 numCmdLocBytes;		/* Number of bytes needed for encoded
+				 * command location information. */
+    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. */
+    AuxData *auxDataArrayPtr;   /* Points to the start of the auxiliary data
+				 * array. This is just after the last entry
+				 * in the ExceptionRange array. */
+    unsigned char *codeDeltaStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the change in the
+				 * starting offset of each command's code.
+				 * If -127<=delta<=127, it is encoded as 1
+				 * byte, otherwise 0xFF (128) appears and
+				 * the delta is encoded by the next 4 bytes.
+				 * Code deltas are always positive. This
+				 * sequence is just after the last entry in
+				 * the AuxData array. */
+    unsigned char *codeLengthStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the length of each
+				 * command's code. The encoding is the same
+				 * as for code deltas. Code lengths are
+				 * always positive. This sequence is just
+				 * after the last entry in the code delta
+				 * sequence. */
+    unsigned char *srcDeltaStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the change in the
+				 * starting offset of each command's source.
+				 * The encoding is the same as for code
+				 * deltas. Source deltas can be negative.
+				 * This sequence is just after the last byte
+				 * in the code length sequence. */
+    unsigned char *srcLengthStart;
+				/* Points to the first of a sequence of
+				 * bytes that encode the length of each
+				 * command's source. The encoding is the
+				 * same as for code deltas. Source lengths
+				 * are always positive. This sequence is
+				 * just after the last byte in the source
+				 * delta sequence. */
+} 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,
+                AuxDataType *typePtr, 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 AuxDataType *TclGetAuxDataType _ANSI_ARGS_((char *typeName));
+EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
+			    unsigned char *pc, int catchOnly,
+			    ByteCode* codePtr));
+EXTERN InstructionDesc * TclGetInstructionTable _ANSI_ARGS_(());
+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 void		TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
+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 void		TclInitAuxDataTypeTable _ANSI_ARGS_((void));
+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));
+#ifdef TCL_COMPILE_STATS
+EXTERN int		TclLog2 _ANSI_ARGS_((int value));
+#endif /*TCL_COMPILE_STATS*/
+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));
+EXTERN void		TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
+
+/*
+ *----------------------------------------------------------------
+ * 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 pointer.
+ * The two variants depend on the number of bytes. The ANSI C "prototypes"
+ * for these macros are:
+ *
+ * EXTERN void	TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ * EXTERN void	TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ */
+    
+#define TclStoreInt1AtPtr(i, p) \
+    *(p)   = (unsigned char) ((unsigned int) (i))
+    
+#define TclStoreInt4AtPtr(i, p) \
+    *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
+    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
+    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
+    *(p+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); \
+    TclStoreInt1AtPtr((i), ((pc)+1))
+
+#define TclUpdateInstInt4AtPc(op, i, pc) \
+    *(pc) = (unsigned char) (op); \
+    TclStoreInt4AtPtr((i), ((pc)+1))
+    
+/*
+ * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
+ * (GET_UINT{1,2}) from a pointer. There are two variants for each
+ * return type that depend on the number of bytes fetched.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * EXTERN int	        TclGetInt1AtPtr  _ANSI_ARGS_((unsigned char *p));
+ * EXTERN int	        TclGetInt4AtPtr  _ANSI_ARGS_((unsigned char *p));
+ * EXTERN unsigned int	TclGetUInt1AtPtr _ANSI_ARGS_((unsigned char *p));
+ * EXTERN unsigned int	TclGetUInt4AtPtr _ANSI_ARGS_((unsigned char *p));
+ */
+
+/*
+ * The TclGetInt1AtPtr 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 TclGetInt1AtPtr(p) ((int) *((char *) p))
+#else
+#   ifdef HAVE_SIGNED_CHAR
+#	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
+#    else
+#	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
+		| ((*(p) & 0200) ? (-256) : 0))
+#    endif
+#endif
+
+#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
+		                  	    (*((p)+1) << 16) | \
+				  	    (*((p)+2) <<  8) | \
+				  	    (*((p)+3)))
+
+#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
+#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p)     << 24) | \
+		                            (*((p)+1) << 16) | \
+				            (*((p)+2) <<  8) | \
+				            (*((p)+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
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLCOMPILATION */
diff --git a/tcl/generic/tclDate.c b/tcl/generic/tclDate.c
new file mode 100644
index 00000000000..9d91c2b4719
--- /dev/null
+++ b/tcl/generic/tclDate.c
@@ -0,0 +1,1638 @@
+/* 
+ * tclDate.c --
+ *
+ *	This file is generated from a yacc grammar defined in
+ *	the file tclGetDate.y.  It should not be edited directly.
+ *
+ * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
+ * 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.
+ *
+ * RCS: @(#) $Id$ 
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef MAC_TCL
+#   define EPOCH           1904
+#   define START_OF_TIME   1904
+#   define END_OF_TIME     2039
+#else
+#   define EPOCH           1970
+#   define START_OF_TIME   1902
+#   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)
+
+
+/*
+ *  An entry in the lexical lookup table.
+ */
+typedef struct _TABLE {
+    char        *name;
+    int         type;
+    time_t      value;
+} TABLE;
+
+
+/*
+ *  Daylight-savings mode:  on, off, or not yet known.
+ */
+typedef enum _DSTMODE {
+    DSTon, DSToff, DSTmaybe
+} DSTMODE;
+
+/*
+ *  Meridian:  am, pm, or 24-hour style.
+ */
+typedef enum _MERIDIAN {
+    MERam, MERpm, MER24
+} MERIDIAN;
+
+
+/*
+ *  Global variables.  We could get rid of most of these by using a good
+ *  union as the yacc stack.  (This routine was originally written before
+ *  yacc had the %union construct.)  Maybe someday; right now we only use
+ *  the %union very rarely.
+ */
+static char     *TclDateInput;
+static DSTMODE  TclDateDSTmode;
+static time_t   TclDateDayOrdinal;
+static time_t   TclDateDayNumber;
+static int      TclDateHaveDate;
+static int      TclDateHaveDay;
+static int      TclDateHaveRel;
+static int      TclDateHaveTime;
+static int      TclDateHaveZone;
+static time_t   TclDateTimezone;
+static time_t   TclDateDay;
+static time_t   TclDateHour;
+static time_t   TclDateMinutes;
+static time_t   TclDateMonth;
+static time_t   TclDateSeconds;
+static time_t   TclDateYear;
+static MERIDIAN TclDateMeridian;
+static time_t   TclDateRelMonth;
+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));
+
+int
+TclDateparse _ANSI_ARGS_((void));
+typedef union
+#ifdef __cplusplus
+	YYSTYPE
+#endif
+ {
+    time_t              Number;
+    enum _MERIDIAN      Meridian;
+} YYSTYPE;
+# define tAGO 257
+# define tDAY 258
+# define tDAYZONE 259
+# define tID 260
+# define tMERIDIAN 261
+# define tMINUTE_UNIT 262
+# define tMONTH 263
+# define tMONTH_UNIT 264
+# define tSEC_UNIT 265
+# define tSNUMBER 266
+# define tUNUMBER 267
+# define tZONE 268
+# define tEPOCH 269
+# define tDST 270
+
+
+
+#ifdef __cplusplus
+
+#ifndef TclDateerror
+	void TclDateerror(const char *);
+#endif
+
+#ifndef TclDatelex
+#ifdef __EXTERN_C__
+	extern "C" { int TclDatelex(void); }
+#else
+	int TclDatelex(void);
+#endif
+#endif
+	int TclDateparse(void);
+
+#endif
+#define TclDateclearin TclDatechar = -1
+#define TclDateerrok TclDateerrflag = 0
+extern int TclDatechar;
+extern int TclDateerrflag;
+YYSTYPE TclDatelval;
+YYSTYPE TclDateval;
+typedef int TclDatetabelem;
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH 150
+#endif
+#if YYMAXDEPTH > 0
+int TclDate_TclDates[YYMAXDEPTH], *TclDates = TclDate_TclDates;
+YYSTYPE TclDate_TclDatev[YYMAXDEPTH], *TclDatev = TclDate_TclDatev;
+#else	/* user does initial allocation */
+int *TclDates;
+YYSTYPE *TclDatev;
+#endif
+static int TclDatemaxdepth = YYMAXDEPTH;
+# define YYERRCODE 256
+
+
+/*
+ * Month and day table.
+ */
+static TABLE    MonthDayTable[] = {
+    { "january",        tMONTH,  1 },
+    { "february",       tMONTH,  2 },
+    { "march",          tMONTH,  3 },
+    { "april",          tMONTH,  4 },
+    { "may",            tMONTH,  5 },
+    { "june",           tMONTH,  6 },
+    { "july",           tMONTH,  7 },
+    { "august",         tMONTH,  8 },
+    { "september",      tMONTH,  9 },
+    { "sept",           tMONTH,  9 },
+    { "october",        tMONTH, 10 },
+    { "november",       tMONTH, 11 },
+    { "december",       tMONTH, 12 },
+    { "sunday",         tDAY, 0 },
+    { "monday",         tDAY, 1 },
+    { "tuesday",        tDAY, 2 },
+    { "tues",           tDAY, 2 },
+    { "wednesday",      tDAY, 3 },
+    { "wednes",         tDAY, 3 },
+    { "thursday",       tDAY, 4 },
+    { "thur",           tDAY, 4 },
+    { "thurs",          tDAY, 4 },
+    { "friday",         tDAY, 5 },
+    { "saturday",       tDAY, 6 },
+    { NULL }
+};
+
+/*
+ * Time units table.
+ */
+static TABLE    UnitsTable[] = {
+    { "year",           tMONTH_UNIT,    12 },
+    { "month",          tMONTH_UNIT,    1 },
+    { "fortnight",      tMINUTE_UNIT,   14 * 24 * 60 },
+    { "week",           tMINUTE_UNIT,   7 * 24 * 60 },
+    { "day",            tMINUTE_UNIT,   1 * 24 * 60 },
+    { "hour",           tMINUTE_UNIT,   60 },
+    { "minute",         tMINUTE_UNIT,   1 },
+    { "min",            tMINUTE_UNIT,   1 },
+    { "second",         tSEC_UNIT,      1 },
+    { "sec",            tSEC_UNIT,      1 },
+    { NULL }
+};
+
+/*
+ * Assorted relative-time words.
+ */
+static TABLE    OtherTable[] = {
+    { "tomorrow",       tMINUTE_UNIT,   1 * 24 * 60 },
+    { "yesterday",      tMINUTE_UNIT,   -1 * 24 * 60 },
+    { "today",          tMINUTE_UNIT,   0 },
+    { "now",            tMINUTE_UNIT,   0 },
+    { "last",           tUNUMBER,       -1 },
+    { "this",           tMINUTE_UNIT,   0 },
+    { "next",           tUNUMBER,       2 },
+#if 0
+    { "first",          tUNUMBER,       1 },
+/*  { "second",         tUNUMBER,       2 }, */
+    { "third",          tUNUMBER,       3 },
+    { "fourth",         tUNUMBER,       4 },
+    { "fifth",          tUNUMBER,       5 },
+    { "sixth",          tUNUMBER,       6 },
+    { "seventh",        tUNUMBER,       7 },
+    { "eighth",         tUNUMBER,       8 },
+    { "ninth",          tUNUMBER,       9 },
+    { "tenth",          tUNUMBER,       10 },
+    { "eleventh",       tUNUMBER,       11 },
+    { "twelfth",        tUNUMBER,       12 },
+#endif
+    { "ago",            tAGO,   1 },
+    { "epoch",          tEPOCH,   0 },
+    { NULL }
+};
+
+/*
+ * The timezone table.  (Note: This table was modified to not use any floating
+ * point constants to work around an SGI compiler bug).
+ */
+static TABLE    TimezoneTable[] = {
+    { "gmt",    tZONE,     HOUR( 0) },      /* Greenwich Mean */
+    { "ut",     tZONE,     HOUR( 0) },      /* Universal (Coordinated) */
+    { "utc",    tZONE,     HOUR( 0) },
+    { "wet",    tZONE,     HOUR( 0) } ,     /* Western European */
+    { "bst",    tDAYZONE,  HOUR( 0) },      /* British Summer */
+    { "wat",    tZONE,     HOUR( 1) },      /* West Africa */
+    { "at",     tZONE,     HOUR( 2) },      /* Azores */
+#if     0
+    /* For completeness.  BST is also British Summer, and GST is
+     * also Guam Standard. */
+    { "bst",    tZONE,     HOUR( 3) },      /* Brazil Standard */
+    { "gst",    tZONE,     HOUR( 3) },      /* Greenland Standard */
+#endif
+    { "nft",    tZONE,     HOUR( 7/2) },    /* Newfoundland */
+    { "nst",    tZONE,     HOUR( 7/2) },    /* Newfoundland Standard */
+    { "ndt",    tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
+    { "ast",    tZONE,     HOUR( 4) },      /* Atlantic Standard */
+    { "adt",    tDAYZONE,  HOUR( 4) },      /* Atlantic Daylight */
+    { "est",    tZONE,     HOUR( 5) },      /* Eastern Standard */
+    { "edt",    tDAYZONE,  HOUR( 5) },      /* Eastern Daylight */
+    { "cst",    tZONE,     HOUR( 6) },      /* Central Standard */
+    { "cdt",    tDAYZONE,  HOUR( 6) },      /* Central Daylight */
+    { "mst",    tZONE,     HOUR( 7) },      /* Mountain Standard */
+    { "mdt",    tDAYZONE,  HOUR( 7) },      /* Mountain Daylight */
+    { "pst",    tZONE,     HOUR( 8) },      /* Pacific Standard */
+    { "pdt",    tDAYZONE,  HOUR( 8) },      /* Pacific Daylight */
+    { "yst",    tZONE,     HOUR( 9) },      /* Yukon Standard */
+    { "ydt",    tDAYZONE,  HOUR( 9) },      /* Yukon Daylight */
+    { "hst",    tZONE,     HOUR(10) },      /* Hawaii Standard */
+    { "hdt",    tDAYZONE,  HOUR(10) },      /* Hawaii Daylight */
+    { "cat",    tZONE,     HOUR(10) },      /* Central Alaska */
+    { "ahst",   tZONE,     HOUR(10) },      /* Alaska-Hawaii Standard */
+    { "nt",     tZONE,     HOUR(11) },      /* Nome */
+    { "idlw",   tZONE,     HOUR(12) },      /* International Date Line West */
+    { "cet",    tZONE,    -HOUR( 1) },      /* Central European */
+    { "met",    tZONE,    -HOUR( 1) },      /* Middle European */
+    { "mewt",   tZONE,    -HOUR( 1) },      /* Middle European Winter */
+    { "mest",   tDAYZONE, -HOUR( 1) },      /* Middle European Summer */
+    { "swt",    tZONE,    -HOUR( 1) },      /* Swedish Winter */
+    { "sst",    tDAYZONE, -HOUR( 1) },      /* Swedish Summer */
+    { "fwt",    tZONE,    -HOUR( 1) },      /* French Winter */
+    { "fst",    tDAYZONE, -HOUR( 1) },      /* French Summer */
+    { "eet",    tZONE,    -HOUR( 2) },      /* Eastern Europe, USSR Zone 1 */
+    { "bt",     tZONE,    -HOUR( 3) },      /* Baghdad, USSR Zone 2 */
+    { "it",     tZONE,    -HOUR( 7/2) },    /* Iran */
+    { "zp4",    tZONE,    -HOUR( 4) },      /* USSR Zone 3 */
+    { "zp5",    tZONE,    -HOUR( 5) },      /* USSR Zone 4 */
+    { "ist",    tZONE,    -HOUR(11/2) },    /* Indian Standard */
+    { "zp6",    tZONE,    -HOUR( 6) },      /* USSR Zone 5 */
+#if     0
+    /* For completeness.  NST is also Newfoundland Stanard, nad SST is
+     * also Swedish Summer. */
+    { "nst",    tZONE,    -HOUR(13/2) },    /* North Sumatra */
+    { "sst",    tZONE,    -HOUR( 7) },      /* South Sumatra, USSR Zone 6 */
+#endif  /* 0 */
+    { "wast",   tZONE,    -HOUR( 7) },      /* West Australian Standard */
+    { "wadt",   tDAYZONE, -HOUR( 7) },      /* West Australian Daylight */
+    { "jt",     tZONE,    -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
+    { "cct",    tZONE,    -HOUR( 8) },      /* China Coast, USSR Zone 7 */
+    { "jst",    tZONE,    -HOUR( 9) },      /* Japan Standard, USSR Zone 8 */
+    { "cast",   tZONE,    -HOUR(19/2) },    /* Central Australian Standard */
+    { "cadt",   tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
+    { "east",   tZONE,    -HOUR(10) },      /* Eastern Australian Standard */
+    { "eadt",   tDAYZONE, -HOUR(10) },      /* Eastern Australian Daylight */
+    { "gst",    tZONE,    -HOUR(10) },      /* Guam Standard, USSR Zone 9 */
+    { "nzt",    tZONE,    -HOUR(12) },      /* New Zealand */
+    { "nzst",   tZONE,    -HOUR(12) },      /* New Zealand Standard */
+    { "nzdt",   tDAYZONE, -HOUR(12) },      /* New Zealand Daylight */
+    { "idle",   tZONE,    -HOUR(12) },      /* International Date Line East */
+    /* ADDED BY Marco Nijdam */
+    { "dst",    tDST,     HOUR( 0) },       /* DST on (hour is ignored) */
+    /* End ADDED */
+    {  NULL  }
+};
+
+/*
+ * Military timezone table.
+ */
+static TABLE    MilitaryTable[] = {
+    { "a",      tZONE,  HOUR(  1) },
+    { "b",      tZONE,  HOUR(  2) },
+    { "c",      tZONE,  HOUR(  3) },
+    { "d",      tZONE,  HOUR(  4) },
+    { "e",      tZONE,  HOUR(  5) },
+    { "f",      tZONE,  HOUR(  6) },
+    { "g",      tZONE,  HOUR(  7) },
+    { "h",      tZONE,  HOUR(  8) },
+    { "i",      tZONE,  HOUR(  9) },
+    { "k",      tZONE,  HOUR( 10) },
+    { "l",      tZONE,  HOUR( 11) },
+    { "m",      tZONE,  HOUR( 12) },
+    { "n",      tZONE,  HOUR(- 1) },
+    { "o",      tZONE,  HOUR(- 2) },
+    { "p",      tZONE,  HOUR(- 3) },
+    { "q",      tZONE,  HOUR(- 4) },
+    { "r",      tZONE,  HOUR(- 5) },
+    { "s",      tZONE,  HOUR(- 6) },
+    { "t",      tZONE,  HOUR(- 7) },
+    { "u",      tZONE,  HOUR(- 8) },
+    { "v",      tZONE,  HOUR(- 9) },
+    { "w",      tZONE,  HOUR(-10) },
+    { "x",      tZONE,  HOUR(-11) },
+    { "y",      tZONE,  HOUR(-12) },
+    { "z",      tZONE,  HOUR(  0) },
+    { NULL }
+};
+
+
+/*
+ * Dump error messages in the bit bucket.
+ */
+static void
+TclDateerror(s)
+    char  *s;
+{
+}
+
+
+static time_t
+ToSeconds(Hours, Minutes, Seconds, Meridian)
+    time_t      Hours;
+    time_t      Minutes;
+    time_t      Seconds;
+    MERIDIAN    Meridian;
+{
+    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
+        return -1;
+    switch (Meridian) {
+    case MER24:
+        if (Hours < 0 || Hours > 23)
+            return -1;
+        return (Hours * 60L + Minutes) * 60L + Seconds;
+    case MERam:
+        if (Hours < 1 || Hours > 12)
+            return -1;
+        return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
+    case MERpm:
+        if (Hours < 1 || Hours > 12)
+            return -1;
+        return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
+    }
+    return -1;  /* Should never be reached */
+}
+
+
+static int
+Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
+    time_t      Month;
+    time_t      Day;
+    time_t      Year;
+    time_t      Hours;
+    time_t      Minutes;
+    time_t      Seconds;
+    MERIDIAN    Meridian;
+    DSTMODE     DSTmode;
+    time_t     *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;
+
+    DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0)
+                    ? 29 : 28;
+    if (Month < 1 || Month > 12
+     || Year < START_OF_TIME || Year > END_OF_TIME
+     || Day < 1 || Day > DaysInMonth[(int)--Month])
+        return -1;
+
+    for (Julian = Day - 1, i = 0; i < Month; i++)
+        Julian += DaysInMonth[i];
+    if (Year >= EPOCH) {
+        for (i = EPOCH; i < Year; i++)
+            Julian += 365 + (i % 4 == 0);
+    } else {
+        for (i = Year; i < EPOCH; i++)
+            Julian -= 365 + (i % 4 == 0);
+    }
+    Julian *= SECSPERDAY;
+    Julian += TclDateTimezone * 60L;
+    if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
+        return -1;
+    Julian += tod;
+    if (DSTmode == DSTon
+     || (DSTmode == DSTmaybe && TclpGetDate(&Julian, 0)->tm_isdst))
+        Julian -= 60 * 60;
+    *TimePtr = Julian;
+    return 0;
+}
+
+
+static time_t
+DSTcorrect(Start, Future)
+    time_t      Start;
+    time_t      Future;
+{
+    time_t      StartDay;
+    time_t      FutureDay;
+
+    StartDay = (TclpGetDate(&Start, 0)->tm_hour + 1) % 24;
+    FutureDay = (TclpGetDate(&Future, 0)->tm_hour + 1) % 24;
+    return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
+}
+
+
+static time_t
+RelativeDate(Start, DayOrdinal, DayNumber)
+    time_t      Start;
+    time_t      DayOrdinal;
+    time_t      DayNumber;
+{
+    struct tm   *tm;
+    time_t      now;
+
+    now = Start;
+    tm = TclpGetDate(&now, 0);
+    now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
+    now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
+    return DSTcorrect(Start, now);
+}
+
+
+static int
+RelativeMonth(Start, RelMonth, TimePtr)
+    time_t Start;
+    time_t RelMonth;
+    time_t *TimePtr;
+{
+    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_YEAR_BASE) + tm->tm_mon + RelMonth;
+    Year = Month / 12;
+    Month = Month % 12 + 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;
+}
+
+
+static int
+LookupWord(buff)
+    char                *buff;
+{
+    register char *p;
+    register char *q;
+    register TABLE *tp;
+    int i;
+    int abbrev;
+
+    /*
+     * Make it lowercase.
+     */
+    for (p = buff; *p; p++) {
+        if (isupper(UCHAR(*p))) {
+            *p = (char) tolower(UCHAR(*p));
+	}
+    }
+
+    if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
+        TclDatelval.Meridian = MERam;
+        return tMERIDIAN;
+    }
+    if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
+        TclDatelval.Meridian = MERpm;
+        return tMERIDIAN;
+    }
+
+    /*
+     * See if we have an abbreviation for a month.
+     */
+    if (strlen(buff) == 3) {
+        abbrev = 1;
+    } else if (strlen(buff) == 4 && buff[3] == '.') {
+        abbrev = 1;
+        buff[3] = '\0';
+    } else {
+        abbrev = 0;
+    }
+
+    for (tp = MonthDayTable; tp->name; tp++) {
+        if (abbrev) {
+            if (strncmp(buff, tp->name, 3) == 0) {
+                TclDatelval.Number = tp->value;
+                return tp->type;
+            }
+        } else if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    for (tp = TimezoneTable; tp->name; tp++) {
+        if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    for (tp = UnitsTable; tp->name; tp++) {
+        if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    /*
+     * Strip off any plural and try the units table again.
+     */
+    i = strlen(buff) - 1;
+    if (buff[i] == 's') {
+        buff[i] = '\0';
+        for (tp = UnitsTable; tp->name; tp++) {
+            if (strcmp(buff, tp->name) == 0) {
+                TclDatelval.Number = tp->value;
+                return tp->type;
+            }
+	}
+    }
+
+    for (tp = OtherTable; tp->name; tp++) {
+        if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    /*
+     * Military timezones.
+     */
+    if (buff[1] == '\0' && isalpha(UCHAR(*buff))) {
+        for (tp = MilitaryTable; tp->name; tp++) {
+            if (strcmp(buff, tp->name) == 0) {
+                TclDatelval.Number = tp->value;
+                return tp->type;
+            }
+	}
+    }
+
+    /*
+     * Drop out any periods and try the timezone table again.
+     */
+    for (i = 0, p = q = buff; *q; q++)
+        if (*q != '.') {
+            *p++ = *q;
+        } else {
+            i++;
+	}
+    *p = '\0';
+    if (i) {
+        for (tp = TimezoneTable; tp->name; tp++) {
+            if (strcmp(buff, tp->name) == 0) {
+                TclDatelval.Number = tp->value;
+                return tp->type;
+            }
+	}
+    }
+    
+    return tID;
+}
+
+
+static int
+TclDatelex()
+{
+    register char       c;
+    register char       *p;
+    char                buff[20];
+    int                 Count;
+    int                 sign;
+
+    for ( ; ; ) {
+        while (isspace((unsigned char) (*TclDateInput))) {
+            TclDateInput++;
+	}
+
+        if (isdigit(c = *TclDateInput) || c == '-' || c == '+') {
+            if (c == '-' || c == '+') {
+                sign = c == '-' ? -1 : 1;
+                if (!isdigit(*++TclDateInput)) {
+                    /*
+		     * skip the '-' sign
+		     */
+                    continue;
+		}
+            } else {
+                sign = 0;
+	    }
+            for (TclDatelval.Number = 0; isdigit(c = *TclDateInput++); ) {
+                TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
+	    }
+            TclDateInput--;
+            if (sign < 0) {
+                TclDatelval.Number = -TclDatelval.Number;
+	    }
+            return sign ? tSNUMBER : tUNUMBER;
+        }
+        if (isalpha(UCHAR(c))) {
+            for (p = buff; isalpha(c = *TclDateInput++) || c == '.'; ) {
+                if (p < &buff[sizeof buff - 1]) {
+                    *p++ = c;
+		}
+	    }
+            *p = '\0';
+            TclDateInput--;
+            return LookupWord(buff);
+        }
+        if (c != '(') {
+            return *TclDateInput++;
+	}
+        Count = 0;
+        do {
+            c = *TclDateInput++;
+            if (c == '\0') {
+                return c;
+	    } else if (c == '(') {
+                Count++;
+	    } else if (c == ')') {
+                Count--;
+	    }
+        } while (Count > 0);
+    }
+}
+
+/*
+ * Specify zone is of -50000 to force GMT.  (This allows BST to work).
+ */
+
+int
+TclGetDate(p, now, zone, timePtr)
+    char *p;
+    unsigned long now;
+    long zone;
+    unsigned long *timePtr;
+{
+    struct tm *tm;
+    time_t Start;
+    time_t Time;
+    time_t tod;
+    int thisyear;
+
+    TclDateInput = p;
+    tm = TclpGetDate((time_t *) &now, 0);
+    thisyear = tm->tm_year + TM_YEAR_BASE;
+    TclDateYear = thisyear;
+    TclDateMonth = tm->tm_mon + 1;
+    TclDateDay = tm->tm_mday;
+    TclDateTimezone = zone;
+    if (zone == -50000) {
+        TclDateDSTmode = DSToff;  /* assume GMT */
+        TclDateTimezone = 0;
+    } else {
+        TclDateDSTmode = DSTmaybe;
+    }
+    TclDateHour = 0;
+    TclDateMinutes = 0;
+    TclDateSeconds = 0;
+    TclDateMeridian = MER24;
+    TclDateRelSeconds = 0;
+    TclDateRelMonth = 0;
+    TclDateHaveDate = 0;
+    TclDateHaveDay = 0;
+    TclDateHaveRel = 0;
+    TclDateHaveTime = 0;
+    TclDateHaveZone = 0;
+
+    if (TclDateparse() || TclDateHaveTime > 1 || TclDateHaveZone > 1 || TclDateHaveDate > 1 ||
+	    TclDateHaveDay > 1) {
+        return -1;
+    }
+    
+    if (TclDateHaveDate || TclDateHaveTime || TclDateHaveDay) {
+	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 {
+        Start = now;
+        if (!TclDateHaveRel) {
+            Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec;
+	}
+    }
+
+    Start += TclDateRelSeconds;
+    if (RelativeMonth(Start, TclDateRelMonth, &Time) < 0) {
+        return -1;
+    }
+    Start += Time;
+
+    if (TclDateHaveDay && !TclDateHaveDate) {
+        tod = RelativeDate(Start, TclDateDayOrdinal, TclDateDayNumber);
+        Start += tod;
+    }
+
+    *timePtr = Start;
+    return 0;
+}
+TclDatetabelem TclDateexca[] ={
+-1, 1,
+	0, -1,
+	-2, 0,
+	};
+# define YYNPROD 41
+# define YYLAST 227
+TclDatetabelem TclDateact[]={
+
+    14,    11,    23,    28,    17,    12,    19,    18,    16,     9,
+    10,    13,    42,    21,    46,    45,    44,    48,    41,    37,
+    36,    35,    32,    29,    34,    33,    31,    43,    39,    38,
+    30,    15,     8,     7,     6,     5,     4,     3,     2,     1,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,    47,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,     0,    22,     0,     0,    20,    25,    24,    27,
+    26,    42,     0,     0,     0,     0,    40 };
+TclDatetabelem TclDatepact[]={
+
+-10000000,  -258,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,   -45,
+  -267,-10000000,  -244,-10000000,   -14,  -231,  -240,-10000000,-10000000,-10000000,
+-10000000,  -246,-10000000,  -247,  -248,-10000000,-10000000,-10000000,-10000000,   -15,
+-10000000,-10000000,-10000000,-10000000,-10000000,   -40,   -20,-10000000,  -251,-10000000,
+-10000000,  -252,-10000000,  -253,-10000000,  -249,-10000000,-10000000,-10000000 };
+TclDatetabelem TclDatepgo[]={
+
+     0,    28,    39,    38,    37,    36,    35,    34,    33,    32,
+    31 };
+TclDatetabelem TclDater1[]={
+
+     0,     2,     2,     3,     3,     3,     3,     3,     3,     4,
+     4,     4,     4,     4,     5,     5,     5,     7,     7,     7,
+     6,     6,     6,     6,     6,     6,     6,     8,     8,    10,
+    10,    10,    10,    10,    10,    10,    10,    10,     9,     1,
+     1 };
+TclDatetabelem TclDater2[]={
+
+     0,     0,     4,     3,     3,     3,     3,     3,     2,     5,
+     9,     9,    13,    13,     5,     3,     3,     3,     5,     5,
+     7,    11,     5,     9,     5,     3,     7,     5,     2,     5,
+     5,     3,     5,     5,     3,     5,     5,     3,     3,     1,
+     3 };
+TclDatetabelem TclDatechk[]={
+
+-10000000,    -2,    -3,    -4,    -5,    -6,    -7,    -8,    -9,   267,
+   268,   259,   263,   269,   258,   -10,   266,   262,   265,   264,
+   261,    58,   258,    47,   263,   262,   265,   264,   270,   267,
+    44,   257,   262,   265,   264,   267,   267,   267,    44,    -1,
+   266,    58,   261,    47,   267,   267,   267,    -1,   266 };
+TclDatetabelem TclDatedef[]={
+
+     1,    -2,     2,     3,     4,     5,     6,     7,     8,    38,
+    15,    16,     0,    25,    17,    28,     0,    31,    34,    37,
+     9,     0,    19,     0,    24,    29,    33,    36,    14,    22,
+    18,    27,    30,    32,    35,    39,    20,    26,     0,    10,
+    11,     0,    40,     0,    23,    39,    21,    12,    13 };
+typedef struct
+#ifdef __cplusplus
+	TclDatetoktype
+#endif
+{ char *t_name; int t_val; } TclDatetoktype;
+#ifndef YYDEBUG
+#	define YYDEBUG	0	/* don't allow debugging */
+#endif
+
+#if YYDEBUG
+
+TclDatetoktype TclDatetoks[] =
+{
+	"tAGO",	257,
+	"tDAY",	258,
+	"tDAYZONE",	259,
+	"tID",	260,
+	"tMERIDIAN",	261,
+	"tMINUTE_UNIT",	262,
+	"tMONTH",	263,
+	"tMONTH_UNIT",	264,
+	"tSEC_UNIT",	265,
+	"tSNUMBER",	266,
+	"tUNUMBER",	267,
+	"tZONE",	268,
+	"tEPOCH",	269,
+	"tDST",	270,
+	"-unknown-",	-1	/* ends search */
+};
+
+char * TclDatereds[] =
+{
+	"-no such reduction-",
+	"spec : /* empty */",
+	"spec : spec item",
+	"item : time",
+	"item : zone",
+	"item : date",
+	"item : day",
+	"item : rel",
+	"item : number",
+	"time : tUNUMBER tMERIDIAN",
+	"time : tUNUMBER ':' tUNUMBER o_merid",
+	"time : tUNUMBER ':' tUNUMBER tSNUMBER",
+	"time : tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid",
+	"time : tUNUMBER ':' tUNUMBER ':' tUNUMBER tSNUMBER",
+	"zone : tZONE tDST",
+	"zone : tZONE",
+	"zone : tDAYZONE",
+	"day : tDAY",
+	"day : tDAY ','",
+	"day : tUNUMBER tDAY",
+	"date : tUNUMBER '/' tUNUMBER",
+	"date : tUNUMBER '/' tUNUMBER '/' tUNUMBER",
+	"date : tMONTH tUNUMBER",
+	"date : tMONTH tUNUMBER ',' tUNUMBER",
+	"date : tUNUMBER tMONTH",
+	"date : tEPOCH",
+	"date : tUNUMBER tMONTH tUNUMBER",
+	"rel : relunit tAGO",
+	"rel : relunit",
+	"relunit : tUNUMBER tMINUTE_UNIT",
+	"relunit : tSNUMBER tMINUTE_UNIT",
+	"relunit : tMINUTE_UNIT",
+	"relunit : tSNUMBER tSEC_UNIT",
+	"relunit : tUNUMBER tSEC_UNIT",
+	"relunit : tSEC_UNIT",
+	"relunit : tSNUMBER tMONTH_UNIT",
+	"relunit : tUNUMBER tMONTH_UNIT",
+	"relunit : tMONTH_UNIT",
+	"number : tUNUMBER",
+	"o_merid : /* empty */",
+	"o_merid : tMERIDIAN",
+};
+#endif /* YYDEBUG */
+/*
+ * Copyright (c) 1993 by Sun Microsystems, Inc.
+ */
+
+
+/*
+** Skeleton parser driver for yacc output
+*/
+
+/*
+** yacc user known macros and defines
+*/
+#define YYERROR		goto TclDateerrlab
+#define YYACCEPT	return(0)
+#define YYABORT		return(1)
+#define YYBACKUP( newtoken, newvalue )\
+{\
+	if ( TclDatechar >= 0 || ( TclDater2[ TclDatetmp ] >> 1 ) != 1 )\
+	{\
+		TclDateerror( "syntax error - cannot backup" );\
+		goto TclDateerrlab;\
+	}\
+	TclDatechar = newtoken;\
+	TclDatestate = *TclDateps;\
+	TclDatelval = newvalue;\
+	goto TclDatenewstate;\
+}
+#define YYRECOVERING()	(!!TclDateerrflag)
+#define YYNEW(type)	malloc(sizeof(type) * TclDatenewmax)
+#define YYCOPY(to, from, type) \
+	(type *) memcpy(to, (char *) from, TclDatenewmax * sizeof(type))
+#define YYENLARGE( from, type) \
+	(type *) realloc((char *) from, TclDatenewmax * sizeof(type))
+#ifndef YYDEBUG
+#	define YYDEBUG	1	/* make debugging available */
+#endif
+
+/*
+** user known globals
+*/
+int TclDatedebug;			/* set to 1 to get debugging */
+
+/*
+** driver internal defines
+*/
+#define YYFLAG		(-10000000)
+
+/*
+** global variables used by the parser
+*/
+YYSTYPE *TclDatepv;			/* top of value stack */
+int *TclDateps;			/* top of state stack */
+
+int TclDatestate;			/* current state */
+int TclDatetmp;			/* extra var (lasts between blocks) */
+
+int TclDatenerrs;			/* number of errors */
+int TclDateerrflag;			/* error recovery flag */
+int TclDatechar;			/* current input token number */
+
+
+
+#ifdef YYNMBCHARS
+#define YYLEX()		TclDatecvtok(TclDatelex())
+/*
+** TclDatecvtok - return a token if i is a wchar_t value that exceeds 255.
+**	If i<255, i itself is the token.  If i>255 but the neither 
+**	of the 30th or 31st bit is on, i is already a token.
+*/
+#if defined(__STDC__) || defined(__cplusplus)
+int TclDatecvtok(int i)
+#else
+int TclDatecvtok(i) int i;
+#endif
+{
+	int first = 0;
+	int last = YYNMBCHARS - 1;
+	int mid;
+	wchar_t j;
+
+	if(i&0x60000000){/*Must convert to a token. */
+		if( TclDatembchars[last].character < i ){
+			return i;/*Giving up*/
+		}
+		while ((last>=first)&&(first>=0)) {/*Binary search loop*/
+			mid = (first+last)/2;
+			j = TclDatembchars[mid].character;
+			if( j==i ){/*Found*/ 
+				return TclDatembchars[mid].tvalue;
+			}else if( j<i ){
+				first = mid + 1;
+			}else{
+				last = mid -1;
+			}
+		}
+		/*No entry in the table.*/
+		return i;/* Giving up.*/
+	}else{/* i is already a token. */
+		return i;
+	}
+}
+#else/*!YYNMBCHARS*/
+#define YYLEX()		TclDatelex()
+#endif/*!YYNMBCHARS*/
+
+/*
+** TclDateparse - return 0 if worked, 1 if syntax error not recovered from
+*/
+#if defined(__STDC__) || defined(__cplusplus)
+int TclDateparse(void)
+#else
+int TclDateparse()
+#endif
+{
+	register YYSTYPE *TclDatepvt;	/* top of value stack for $vars */
+
+#if defined(__cplusplus) || defined(lint)
+/*
+	hacks to please C++ and lint - goto's inside switch should never be
+	executed; TclDatepvt is set to 0 to avoid "used before set" warning.
+*/
+	static int __yaccpar_lint_hack__ = 0;
+	switch (__yaccpar_lint_hack__)
+	{
+		case 1: goto TclDateerrlab;
+		case 2: goto TclDatenewstate;
+	}
+	TclDatepvt = 0;
+#endif
+
+	/*
+	** Initialize externals - TclDateparse may be called more than once
+	*/
+	TclDatepv = &TclDatev[-1];
+	TclDateps = &TclDates[-1];
+	TclDatestate = 0;
+	TclDatetmp = 0;
+	TclDatenerrs = 0;
+	TclDateerrflag = 0;
+	TclDatechar = -1;
+
+#if YYMAXDEPTH <= 0
+	if (TclDatemaxdepth <= 0)
+	{
+		if ((TclDatemaxdepth = YYEXPAND(0)) <= 0)
+		{
+			TclDateerror("yacc initialization error");
+			YYABORT;
+		}
+	}
+#endif
+
+	{
+		register YYSTYPE *TclDate_pv;	/* top of value stack */
+		register int *TclDate_ps;		/* top of state stack */
+		register int TclDate_state;		/* current state */
+		register int  TclDate_n;		/* internal state number info */
+	goto TclDatestack;	/* moved from 6 lines above to here to please C++ */
+
+		/*
+		** get globals into registers.
+		** branch to here only if YYBACKUP was called.
+		*/
+		TclDate_pv = TclDatepv;
+		TclDate_ps = TclDateps;
+		TclDate_state = TclDatestate;
+		goto TclDate_newstate;
+
+		/*
+		** get globals into registers.
+		** either we just started, or we just finished a reduction
+		*/
+	TclDatestack:
+		TclDate_pv = TclDatepv;
+		TclDate_ps = TclDateps;
+		TclDate_state = TclDatestate;
+
+		/*
+		** top of for (;;) loop while no reductions done
+		*/
+	TclDate_stack:
+		/*
+		** put a state and value onto the stacks
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, look up token value in list of value vs.
+		** name pairs.  0 and negative (-1) are special values.
+		** Note: linear search is used since time is not a real
+		** consideration while debugging.
+		*/
+		if ( TclDatedebug )
+		{
+			register int TclDate_i;
+
+			printf( "State %d, token ", TclDate_state );
+			if ( TclDatechar == 0 )
+				printf( "end-of-file\n" );
+			else if ( TclDatechar < 0 )
+				printf( "-none-\n" );
+			else
+			{
+				for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0;
+					TclDate_i++ )
+				{
+					if ( TclDatetoks[TclDate_i].t_val == TclDatechar )
+						break;
+				}
+				printf( "%s\n", TclDatetoks[TclDate_i].t_name );
+			}
+		}
+#endif /* YYDEBUG */
+		if ( ++TclDate_ps >= &TclDates[ TclDatemaxdepth ] )	/* room on stack? */
+		{
+			/*
+			** reallocate and recover.  Note that pointers
+			** have to be reset, or bad things will happen
+			*/
+			int TclDateps_index = (TclDate_ps - TclDates);
+			int TclDatepv_index = (TclDate_pv - TclDatev);
+			int TclDatepvt_index = (TclDatepvt - TclDatev);
+			int TclDatenewmax;
+#ifdef YYEXPAND
+			TclDatenewmax = YYEXPAND(TclDatemaxdepth);
+#else
+			TclDatenewmax = 2 * TclDatemaxdepth;	/* double table size */
+			if (TclDatemaxdepth == YYMAXDEPTH)	/* first time growth */
+			{
+				char *newTclDates = (char *)YYNEW(int);
+				char *newTclDatev = (char *)YYNEW(YYSTYPE);
+				if (newTclDates != 0 && newTclDatev != 0)
+				{
+					TclDates = YYCOPY(newTclDates, TclDates, int);
+					TclDatev = YYCOPY(newTclDatev, TclDatev, YYSTYPE);
+				}
+				else
+					TclDatenewmax = 0;	/* failed */
+			}
+			else				/* not first time */
+			{
+				TclDates = YYENLARGE(TclDates, int);
+				TclDatev = YYENLARGE(TclDatev, YYSTYPE);
+				if (TclDates == 0 || TclDatev == 0)
+					TclDatenewmax = 0;	/* failed */
+			}
+#endif
+			if (TclDatenewmax <= TclDatemaxdepth)	/* tables not expanded */
+			{
+				TclDateerror( "yacc stack overflow" );
+				YYABORT;
+			}
+			TclDatemaxdepth = TclDatenewmax;
+
+			TclDate_ps = TclDates + TclDateps_index;
+			TclDate_pv = TclDatev + TclDatepv_index;
+			TclDatepvt = TclDatev + TclDatepvt_index;
+		}
+		*TclDate_ps = TclDate_state;
+		*++TclDate_pv = TclDateval;
+
+		/*
+		** we have a new state - find out what to do
+		*/
+	TclDate_newstate:
+		if ( ( TclDate_n = TclDatepact[ TclDate_state ] ) <= YYFLAG )
+			goto TclDatedefault;		/* simple state */
+#if YYDEBUG
+		/*
+		** if debugging, need to mark whether new token grabbed
+		*/
+		TclDatetmp = TclDatechar < 0;
+#endif
+		if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) )
+			TclDatechar = 0;		/* reached EOF */
+#if YYDEBUG
+		if ( TclDatedebug && TclDatetmp )
+		{
+			register int TclDate_i;
+
+			printf( "Received token " );
+			if ( TclDatechar == 0 )
+				printf( "end-of-file\n" );
+			else if ( TclDatechar < 0 )
+				printf( "-none-\n" );
+			else
+			{
+				for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0;
+					TclDate_i++ )
+				{
+					if ( TclDatetoks[TclDate_i].t_val == TclDatechar )
+						break;
+				}
+				printf( "%s\n", TclDatetoks[TclDate_i].t_name );
+			}
+		}
+#endif /* YYDEBUG */
+		if ( ( ( TclDate_n += TclDatechar ) < 0 ) || ( TclDate_n >= YYLAST ) )
+			goto TclDatedefault;
+		if ( TclDatechk[ TclDate_n = TclDateact[ TclDate_n ] ] == TclDatechar )	/*valid shift*/
+		{
+			TclDatechar = -1;
+			TclDateval = TclDatelval;
+			TclDate_state = TclDate_n;
+			if ( TclDateerrflag > 0 )
+				TclDateerrflag--;
+			goto TclDate_stack;
+		}
+
+	TclDatedefault:
+		if ( ( TclDate_n = TclDatedef[ TclDate_state ] ) == -2 )
+		{
+#if YYDEBUG
+			TclDatetmp = TclDatechar < 0;
+#endif
+			if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) )
+				TclDatechar = 0;		/* reached EOF */
+#if YYDEBUG
+			if ( TclDatedebug && TclDatetmp )
+			{
+				register int TclDate_i;
+
+				printf( "Received token " );
+				if ( TclDatechar == 0 )
+					printf( "end-of-file\n" );
+				else if ( TclDatechar < 0 )
+					printf( "-none-\n" );
+				else
+				{
+					for ( TclDate_i = 0;
+						TclDatetoks[TclDate_i].t_val >= 0;
+						TclDate_i++ )
+					{
+						if ( TclDatetoks[TclDate_i].t_val
+							== TclDatechar )
+						{
+							break;
+						}
+					}
+					printf( "%s\n", TclDatetoks[TclDate_i].t_name );
+				}
+			}
+#endif /* YYDEBUG */
+			/*
+			** look through exception table
+			*/
+			{
+				register int *TclDatexi = TclDateexca;
+
+				while ( ( *TclDatexi != -1 ) ||
+					( TclDatexi[1] != TclDate_state ) )
+				{
+					TclDatexi += 2;
+				}
+				while ( ( *(TclDatexi += 2) >= 0 ) &&
+					( *TclDatexi != TclDatechar ) )
+					;
+				if ( ( TclDate_n = TclDatexi[1] ) < 0 )
+					YYACCEPT;
+			}
+		}
+
+		/*
+		** check for syntax error
+		*/
+		if ( TclDate_n == 0 )	/* have an error */
+		{
+			/* no worry about speed here! */
+			switch ( TclDateerrflag )
+			{
+			case 0:		/* new error */
+				TclDateerror( "syntax error" );
+				goto skip_init;
+				/*
+				** get globals into registers.
+				** we have a user generated syntax type error
+				*/
+				TclDate_pv = TclDatepv;
+				TclDate_ps = TclDateps;
+				TclDate_state = TclDatestate;
+			skip_init:
+				TclDatenerrs++;
+				/* FALLTHRU */
+			case 1:
+			case 2:		/* incompletely recovered error */
+					/* try again... */
+				TclDateerrflag = 3;
+				/*
+				** find state where "error" is a legal
+				** shift action
+				*/
+				while ( TclDate_ps >= TclDates )
+				{
+					TclDate_n = TclDatepact[ *TclDate_ps ] + YYERRCODE;
+					if ( TclDate_n >= 0 && TclDate_n < YYLAST &&
+						TclDatechk[TclDateact[TclDate_n]] == YYERRCODE)					{
+						/*
+						** simulate shift of "error"
+						*/
+						TclDate_state = TclDateact[ TclDate_n ];
+						goto TclDate_stack;
+					}
+					/*
+					** current state has no shift on
+					** "error", pop stack
+					*/
+#if YYDEBUG
+#	define _POP_ "Error recovery pops state %d, uncovers state %d\n"
+					if ( TclDatedebug )
+						printf( _POP_, *TclDate_ps,
+							TclDate_ps[-1] );
+#	undef _POP_
+#endif
+					TclDate_ps--;
+					TclDate_pv--;
+				}
+				/*
+				** there is no state on stack with "error" as
+				** a valid shift.  give up.
+				*/
+				YYABORT;
+			case 3:		/* no shift yet; eat a token */
+#if YYDEBUG
+				/*
+				** if debugging, look up token in list of
+				** pairs.  0 and negative shouldn't occur,
+				** but since timing doesn't matter when
+				** debugging, it doesn't hurt to leave the
+				** tests here.
+				*/
+				if ( TclDatedebug )
+				{
+					register int TclDate_i;
+
+					printf( "Error recovery discards " );
+					if ( TclDatechar == 0 )
+						printf( "token end-of-file\n" );
+					else if ( TclDatechar < 0 )
+						printf( "token -none-\n" );
+					else
+					{
+						for ( TclDate_i = 0;
+							TclDatetoks[TclDate_i].t_val >= 0;
+							TclDate_i++ )
+						{
+							if ( TclDatetoks[TclDate_i].t_val
+								== TclDatechar )
+							{
+								break;
+							}
+						}
+						printf( "token %s\n",
+							TclDatetoks[TclDate_i].t_name );
+					}
+				}
+#endif /* YYDEBUG */
+				if ( TclDatechar == 0 )	/* reached EOF. quit */
+					YYABORT;
+				TclDatechar = -1;
+				goto TclDate_newstate;
+			}
+		}/* end if ( TclDate_n == 0 ) */
+		/*
+		** reduction by production TclDate_n
+		** put stack tops, etc. so things right after switch
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, print the string that is the user's
+		** specification of the reduction which is just about
+		** to be done.
+		*/
+		if ( TclDatedebug )
+			printf( "Reduce by (%d) \"%s\"\n",
+				TclDate_n, TclDatereds[ TclDate_n ] );
+#endif
+		TclDatetmp = TclDate_n;			/* value to switch over */
+		TclDatepvt = TclDate_pv;			/* $vars top of value stack */
+		/*
+		** Look in goto table for next state
+		** Sorry about using TclDate_state here as temporary
+		** register variable, but why not, if it works...
+		** If TclDater2[ TclDate_n ] doesn't have the low order bit
+		** set, then there is no action to be done for
+		** this reduction.  So, no saving & unsaving of
+		** registers done.  The only difference between the
+		** code just after the if and the body of the if is
+		** the goto TclDate_stack in the body.  This way the test
+		** can be made before the choice of what to do is needed.
+		*/
+		{
+			/* length of production doubled with extra bit */
+			register int TclDate_len = TclDater2[ TclDate_n ];
+
+			if ( !( TclDate_len & 01 ) )
+			{
+				TclDate_len >>= 1;
+				TclDateval = ( TclDate_pv -= TclDate_len )[1];	/* $$ = $1 */
+				TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] +
+					*( TclDate_ps -= TclDate_len ) + 1;
+				if ( TclDate_state >= YYLAST ||
+					TclDatechk[ TclDate_state =
+					TclDateact[ TclDate_state ] ] != -TclDate_n )
+				{
+					TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ];
+				}
+				goto TclDate_stack;
+			}
+			TclDate_len >>= 1;
+			TclDateval = ( TclDate_pv -= TclDate_len )[1];	/* $$ = $1 */
+			TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] +
+				*( TclDate_ps -= TclDate_len ) + 1;
+			if ( TclDate_state >= YYLAST ||
+				TclDatechk[ TclDate_state = TclDateact[ TclDate_state ] ] != -TclDate_n )
+			{
+				TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ];
+			}
+		}
+					/* save until reenter driver code */
+		TclDatestate = TclDate_state;
+		TclDateps = TclDate_ps;
+		TclDatepv = TclDate_pv;
+	}
+	/*
+	** code supplied by user is placed in this switch
+	*/
+	switch( TclDatetmp )
+	{
+		
+case 3:{
+            TclDateHaveTime++;
+        } break;
+case 4:{
+            TclDateHaveZone++;
+        } break;
+case 5:{
+            TclDateHaveDate++;
+        } break;
+case 6:{
+            TclDateHaveDay++;
+        } break;
+case 7:{
+            TclDateHaveRel++;
+        } break;
+case 9:{
+            TclDateHour = TclDatepvt[-1].Number;
+            TclDateMinutes = 0;
+            TclDateSeconds = 0;
+            TclDateMeridian = TclDatepvt[-0].Meridian;
+        } break;
+case 10:{
+            TclDateHour = TclDatepvt[-3].Number;
+            TclDateMinutes = TclDatepvt[-1].Number;
+            TclDateSeconds = 0;
+            TclDateMeridian = TclDatepvt[-0].Meridian;
+        } break;
+case 11:{
+            TclDateHour = TclDatepvt[-3].Number;
+            TclDateMinutes = TclDatepvt[-1].Number;
+            TclDateMeridian = MER24;
+            TclDateDSTmode = DSToff;
+            TclDateTimezone = - (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
+        } break;
+case 12:{
+            TclDateHour = TclDatepvt[-5].Number;
+            TclDateMinutes = TclDatepvt[-3].Number;
+            TclDateSeconds = TclDatepvt[-1].Number;
+            TclDateMeridian = TclDatepvt[-0].Meridian;
+        } break;
+case 13:{
+            TclDateHour = TclDatepvt[-5].Number;
+            TclDateMinutes = TclDatepvt[-3].Number;
+            TclDateSeconds = TclDatepvt[-1].Number;
+            TclDateMeridian = MER24;
+            TclDateDSTmode = DSToff;
+            TclDateTimezone = - (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
+        } break;
+case 14:{
+            TclDateTimezone = TclDatepvt[-1].Number;
+            TclDateDSTmode = DSTon;
+        } break;
+case 15:{
+            TclDateTimezone = TclDatepvt[-0].Number;
+            TclDateDSTmode = DSToff;
+        } break;
+case 16:{
+            TclDateTimezone = TclDatepvt[-0].Number;
+            TclDateDSTmode = DSTon;
+        } break;
+case 17:{
+            TclDateDayOrdinal = 1;
+            TclDateDayNumber = TclDatepvt[-0].Number;
+        } break;
+case 18:{
+            TclDateDayOrdinal = 1;
+            TclDateDayNumber = TclDatepvt[-1].Number;
+        } break;
+case 19:{
+            TclDateDayOrdinal = TclDatepvt[-1].Number;
+            TclDateDayNumber = TclDatepvt[-0].Number;
+        } break;
+case 20:{
+            TclDateMonth = TclDatepvt[-2].Number;
+            TclDateDay = TclDatepvt[-0].Number;
+        } break;
+case 21:{
+            TclDateMonth = TclDatepvt[-4].Number;
+            TclDateDay = TclDatepvt[-2].Number;
+            TclDateYear = TclDatepvt[-0].Number;
+        } break;
+case 22:{
+            TclDateMonth = TclDatepvt[-1].Number;
+            TclDateDay = TclDatepvt[-0].Number;
+        } break;
+case 23:{
+            TclDateMonth = TclDatepvt[-3].Number;
+            TclDateDay = TclDatepvt[-2].Number;
+            TclDateYear = TclDatepvt[-0].Number;
+        } break;
+case 24:{
+            TclDateMonth = TclDatepvt[-0].Number;
+            TclDateDay = TclDatepvt[-1].Number;
+        } break;
+case 25:{
+				TclDateMonth = 1;
+				TclDateDay = 1;
+				TclDateYear = EPOCH;
+		  } break;
+case 26:{
+            TclDateMonth = TclDatepvt[-1].Number;
+            TclDateDay = TclDatepvt[-2].Number;
+            TclDateYear = TclDatepvt[-0].Number;
+        } break;
+case 27:{
+            TclDateRelSeconds = -TclDateRelSeconds;
+            TclDateRelMonth = -TclDateRelMonth;
+        } break;
+case 29:{
+            TclDateRelSeconds += TclDatepvt[-1].Number * TclDatepvt[-0].Number * 60L;
+        } break;
+case 30:{
+            TclDateRelSeconds += TclDatepvt[-1].Number * TclDatepvt[-0].Number * 60L;
+        } break;
+case 31:{
+            TclDateRelSeconds += TclDatepvt[-0].Number * 60L;
+        } break;
+case 32:{
+            TclDateRelSeconds += TclDatepvt[-1].Number;
+        } break;
+case 33:{
+            TclDateRelSeconds += TclDatepvt[-1].Number;
+        } break;
+case 34:{
+            TclDateRelSeconds++;
+        } break;
+case 35:{
+            TclDateRelMonth += TclDatepvt[-1].Number * TclDatepvt[-0].Number;
+        } break;
+case 36:{
+            TclDateRelMonth += TclDatepvt[-1].Number * TclDatepvt[-0].Number;
+        } break;
+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 = 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;
+case 40:{
+            TclDateval.Meridian = TclDatepvt[-0].Meridian;
+        } break;
+	}
+	goto TclDatestack;		/* reset registers in driver code */
+}
+
diff --git a/tcl/generic/tclEnv.c b/tcl/generic/tclEnv.c
new file mode 100644
index 00000000000..f67918b506d
--- /dev/null
+++ b/tcl/generic/tclEnv.c
@@ -0,0 +1,829 @@
+/* 
+ * tclEnv.c --
+ *
+ *	Tcl support for environment variables, including a setenv
+ *	procedure.  This file contains the generic portion of the
+ *	environment module.  It is primarily responsible for keeping
+ *	the "env" arrays in sync with the system environment variables.
+ *
+ * Copyright (c) 1991-1994 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+
+/* On cygwin32, the environment is imported from the cygwin32 DLL.  */
+
+extern char ***__imp___cygwin_environ;
+
+#define environ (*__imp___cygwin_environ)
+
+/* We need to use a special putenv function to handle PATH.  */
+#ifndef USE_PUTENV
+#define USE_PUTENV
+#endif
+#define putenv TclCygwin32Putenv
+
+#endif
+/* END CYGNUS LOCAL */
+
+/*
+ * The structure below is used to keep track of all of the interpereters
+ * for which we're managing the "env" array.  It's needed so that they
+ * can all be updated whenever an environment variable is changed
+ * anywhere.
+ */
+
+typedef struct EnvInterp {
+    Tcl_Interp *interp;		/* Interpreter for which we're managing
+				 * the env array. */
+    struct EnvInterp *nextPtr;	/* Next in list of all such interpreters,
+				 * or zero. */
+} EnvInterp;
+
+static EnvInterp *firstInterpPtr = NULL;
+				/* First in list of all managed interpreters,
+				 * or NULL if none. */
+
+static int cacheSize = 0;	/* Number of env strings in environCache. */
+static char **environCache = NULL;
+				/* Array containing all of the environment
+				 * strings that Tcl has allocated. */
+
+#ifndef USE_PUTENV
+static int environSize = 0;	/* Non-zero means that the environ array was
+				 * malloced and has this many total entries
+				 * allocated to it (not all may be in use at
+				 * once).  Zero means that the environment
+				 * array is in its original static state. */
+#endif
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static char *		EnvTraceProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+static int		FindVariable _ANSI_ARGS_((CONST char *name,
+			    int *lengthPtr));
+static void		ReplaceString _ANSI_ARGS_((CONST char *oldStr,
+			    char *newStr));
+void			TclSetEnv _ANSI_ARGS_((CONST char *name,
+			    CONST char *value));
+void			TclUnsetEnv _ANSI_ARGS_((CONST char *name));
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+static void		TclCygwin32Putenv _ANSI_ARGS_((CONST char *string));
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetupEnv --
+ *
+ *	This procedure is invoked for an interpreter to make environment
+ *	variables accessible from that interpreter via the "env"
+ *	associative array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The interpreter is added to a list of interpreters managed
+ *	by us, so that its view of envariables can be kept consistent
+ *	with the view in other interpreters.  If this is the first
+ *	call to Tcl_SetupEnv, then additional initialization happens,
+ *	such as copying the environment to dynamically-allocated space
+ *	for ease of management.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetupEnv(interp)
+    Tcl_Interp *interp;		/* Interpreter whose "env" array is to be
+				 * managed. */
+{
+    EnvInterp *eiPtr;
+    char *p, *p2;
+    Tcl_DString ds;
+    int i, sz;
+
+#ifdef MAC_TCL
+    if (environ == NULL) {
+	environSize = TclMacCreateEnv();
+    }
+#endif
+
+    /*
+     * 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.
+     */
+
+    eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
+    eiPtr->interp = interp;
+    eiPtr->nextPtr = firstInterpPtr;
+    firstInterpPtr = eiPtr;
+
+    /*
+     * Store the environment variable values into the interpreter's
+     * "env" array, and arrange for us to be notified on future
+     * writes and unsets to that array.
+     */
+
+    (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
+    for (i = 0; ; i++) {
+	p = environ[i];
+	if (p == NULL) {
+	    break;
+	}
+	for (p2 = p; *p2 != '='; p2++) {
+	    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;
+	    }
+	}
+        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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetEnv --
+ *
+ *	Set an environment variable, replacing an existing value
+ *	or creating a new variable if there doesn't exist a variable
+ *	by the given name.  This procedure is intended to be a
+ *	stand-in for the  UNIX "setenv" procedure so that applications
+ *	using that procedure will interface properly to Tcl.  To make
+ *	it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The environ array gets updated, as do all of the interpreters
+ *	that we manage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetEnv(name, value)
+    CONST char *name;		/* Name of variable whose value is to be
+				 * set. */
+    CONST char *value;		/* New value for variable. */
+{
+    int index, length, nameLength;
+    char *p, *oldValue;
+    EnvInterp *eiPtr;
+
+#ifdef MAC_TCL
+    if (environ == NULL) {
+	environSize = TclMacCreateEnv();
+    }
+#endif
+
+    /*
+     * Figure out where the entry is going to go.  If the name doesn't
+     * already exist, enlarge the array if necessary to make room.  If
+     * the name exists, free its old entry.
+     */
+
+    index = FindVariable(name, &length);
+    if (index == -1) {
+#ifndef USE_PUTENV
+	if ((length+2) > environSize) {
+	    char **newEnviron;
+
+	    newEnviron = (char **) ckalloc((unsigned)
+		    ((length+5) * sizeof(char *)));
+
+	    /* CYGNUS LOCAL: Added to avoid an error from Purify,
+               although I don't personally see where the error would
+               occur--ian.  */
+	    memset((VOID *) newEnviron, 0, (length+5) * sizeof(char *));
+
+	    memcpy((VOID *) newEnviron, (VOID *) environ,
+		    length*sizeof(char *));
+	    if (environSize != 0) {
+		ckfree((char *) environ);
+	    }
+	    environ = newEnviron;
+	    environSize = length+5;
+	}
+	index = length;
+	environ[index+1] = NULL;
+#endif
+	oldValue = NULL;
+	nameLength = strlen(name);
+    } else {
+	/*
+	 * Compare the new value to the existing value.  If they're
+	 * the same then quit immediately (e.g. don't rewrite the
+	 * value or propagate it to other interpreters).  Otherwise,
+	 * when there are N interpreters there will be N! propagations
+	 * of the same value among the interpreters.
+	 */
+
+	if (strcmp(value, environ[index]+length+1) == 0) {
+	    return;
+	}
+	oldValue = environ[index];
+	nameLength = length;
+    }
+	
+
+    /*
+     * Create a new entry.
+     */
+
+    p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
+    strcpy(p, name);
+    p[nameLength] = '=';
+    strcpy(p+nameLength+1, value);
+
+    /*
+     * Update the system environment.
+     */
+
+#ifdef USE_PUTENV
+    putenv(p);
+#else
+    environ[index] = p;
+#endif
+
+    /*
+     * Replace the old value with the new value in the cache.
+     */
+
+    ReplaceString(oldValue, p);
+
+    /*
+     * Update all of the interpreters.
+     */
+
+    /* CYGNUS LOCAL: The original code was bogus.  If we are being
+       called because of a trace on the env array, then the call to
+       Tcl_SetVar2 would free value.  We avoid that by checking
+       whether the value is the same before calling Tcl_SetVar2.
+
+       NOTE: This is not necessary in tcl8.1a2 which handles this in a
+       completely different, and better, way.  */
+
+    for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
+	CONST char *v;
+
+	v = Tcl_GetVar2(eiPtr->interp, "env", (char *) name, TCL_GLOBAL_ONLY);
+	if (v == NULL || (v != value && strcmp (v, value) != 0)) {
+	    (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
+		    (char *) value, TCL_GLOBAL_ONLY);
+	}
+    }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PutEnv --
+ *
+ *	Set an environment variable.  Similar to setenv except that
+ *	the information is passed in a single string of the form
+ *	NAME=value, rather than as separate name strings.  This procedure
+ *	is intended to be a stand-in for the  UNIX "putenv" procedure
+ *	so that applications using that procedure will interface
+ *	properly to Tcl.  To make it a stand-in, the Makefile will
+ *	define "Tcl_PutEnv" to "putenv".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The environ array gets updated, as do all of the interpreters
+ *	that we manage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_PutEnv(string)
+    CONST char *string;		/* Info about environment variable in the
+				 * form NAME=value. */
+{
+    int nameLength;
+    char *name, *value;
+
+    if (string == NULL) {
+	return 0;
+    }
+
+    /*
+     * Separate the string into name and value parts, then call
+     * TclSetEnv to do all of the real work.
+     */
+
+    value = strchr(string, '=');
+    if (value == NULL) {
+	return 0;
+    }
+    nameLength = value - string;
+    if (nameLength == 0) {
+	return 0;
+    }
+    name = (char *) ckalloc((unsigned) nameLength+1);
+    memcpy((VOID *) name, (VOID *) string, (size_t) nameLength);
+    name[nameLength] = 0;
+    TclSetEnv(name, value+1);
+    ckfree(name);
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUnsetEnv --
+ *
+ *	Remove an environment variable, updating the "env" arrays
+ *	in all interpreters managed by us.  This function is intended
+ *	to replace the UNIX "unsetenv" function (but to do this the
+ *	Makefile must be modified to redefine "TclUnsetEnv" to
+ *	"unsetenv".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Interpreters are updated, as is environ.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclUnsetEnv(name)
+    CONST char *name;			/* Name of variable to remove. */
+{
+    EnvInterp *eiPtr;
+    char *oldValue;
+    int length, index;
+#ifdef USE_PUTENV
+    char *string;
+#else
+    char **envPtr;
+#endif
+
+#ifdef MAC_TCL
+    if (environ == NULL) {
+	environSize = TclMacCreateEnv();
+    }
+#endif
+
+    index = FindVariable(name, &length);
+
+    /*
+     * First make sure that the environment variable exists to avoid
+     * doing needless work and to avoid recursion on the unset.
+     */
+    
+    if (index == -1) {
+	return;
+    }
+    /*
+     * Remember the old value so we can free it if Tcl created the string.
+     */
+
+    oldValue = environ[index];
+
+    /*
+     * Update the system environment.  This must be done before we 
+     * update the interpreters or we will recurse.
+     */
+
+#ifdef USE_PUTENV
+    string = ckalloc(length+2);
+    memcpy((VOID *) string, (VOID *) name, (size_t) length);
+    string[length] = '=';
+    string[length+1] = '\0';
+    putenv(string);
+    ckfree(string);
+#else
+    for (envPtr = environ+index+1; ; envPtr++) {
+	envPtr[-1] = *envPtr;
+	if (*envPtr == NULL) {
+	    break;
+	}
+    }
+#endif
+
+    /*
+     * Replace the old value in the cache.
+     */
+
+    ReplaceString(oldValue, NULL);
+
+    /*
+     * Update all of the interpreters.
+     */
+
+    for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
+	(void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
+		TCL_GLOBAL_ONLY);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetEnv --
+ *
+ *	Retrieve the value of an environment variable.
+ *
+ * Results:
+ *	Returns a pointer to a static string in the environment,
+ *	or NULL if the value was not found.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetEnv(name)
+    CONST char *name;		/* Name of variable to find. */
+{
+    int length, index;
+
+#ifdef MAC_TCL
+    if (environ == NULL) {
+	environSize = TclMacCreateEnv();
+    }
+#endif
+
+    index = FindVariable(name, &length);
+    if ((index != -1) &&  (*(environ[index]+length) == '=')) {
+	return environ[index]+length+1;
+    } else {
+	return NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EnvTraceProc --
+ *
+ *	This procedure is invoked whenever an environment variable
+ *	is modified or deleted.  It propagates the change to the
+ *	"environ" array and to any other interpreters for whom
+ *	we're managing an "env" array.
+ *
+ * Results:
+ *	Always returns NULL to indicate success.
+ *
+ * Side effects:
+ *	Environment variable changes get propagated.  If the whole
+ *	"env" array is deleted, then we stop managing things for
+ *	this interpreter (usually this happens because the whole
+ *	interpreter is being deleted).
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static char *
+EnvTraceProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Interpreter whose "env" variable is
+				 * being modified. */
+    char *name1;		/* Better be "env". */
+    char *name2;		/* Name of variable being modified, or
+				 * NULL if whole array is being deleted. */
+    int flags;			/* Indicates what's happening. */
+{
+    /*
+     * First see if the whole "env" variable is being deleted.  If
+     * so, just forget about this interpreter.
+     */
+
+    if (name2 == NULL) {
+	register EnvInterp *eiPtr, *prevPtr;
+
+	if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
+		!= (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
+	    panic("EnvTraceProc called with confusing arguments");
+	}
+	eiPtr = firstInterpPtr;
+	if (eiPtr->interp == interp) {
+	    firstInterpPtr = eiPtr->nextPtr;
+	} else {
+	    for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
+		    prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
+		if (eiPtr == NULL) {
+		    panic("EnvTraceProc couldn't find interpreter");
+		}
+		if (eiPtr->interp == interp) {
+		    prevPtr->nextPtr = eiPtr->nextPtr;
+		    break;
+		}
+	    }
+	}
+	ckfree((char *) eiPtr);
+	return NULL;
+    }
+
+    /*
+     * If a value is being set, call TclSetEnv to do all of the work.
+     */
+
+    if (flags & TCL_TRACE_WRITES) {
+	TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
+    }
+
+    if (flags & TCL_TRACE_UNSETS) {
+	TclUnsetEnv(name2);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReplaceString --
+ *
+ *	Replace one string with another in the environment variable
+ *	cache.  The cache keeps track of all of the environment
+ *	variables that Tcl has modified so they can be freed later.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May free the old string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReplaceString(oldStr, newStr)
+    CONST char *oldStr;		/* Old environment string. */
+    char *newStr;		/* New environment string. */
+{
+    int i;
+    char **newCache;
+
+    /*
+     * Check to see if the old value was allocated by Tcl.  If so,
+     * it needs to be deallocated to avoid memory leaks.  Note that this
+     * algorithm is O(n), not O(1).  This will result in n-squared behavior
+     * if lots of environment changes are being made.
+     */
+
+    for (i = 0; i < cacheSize; i++) {
+	if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
+	    break;
+	}
+    }
+    if (i < cacheSize) {
+	/*
+	 * Replace or delete the old value.
+	 */
+
+	if (environCache[i]) {
+	    ckfree(environCache[i]);
+	}
+	    
+	if (newStr) {
+	    environCache[i] = newStr;
+	} else {
+	    for (; i < cacheSize-1; i++) {
+		environCache[i] = environCache[i+1];
+	    }
+	    environCache[cacheSize-1] = NULL;
+	}
+    } else {	
+        int allocatedSize = (cacheSize + 5) * sizeof(char *);
+
+	/*
+	 * We need to grow the cache in order to hold the new string.
+	 */
+
+	newCache = (char **) ckalloc((size_t) allocatedSize);
+        (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
+        
+	if (environCache) {
+	    memcpy((VOID *) newCache, (VOID *) environCache,
+		    (size_t) (cacheSize * sizeof(char*)));
+	    ckfree((char *) environCache);
+	}
+	environCache = newCache;
+	environCache[cacheSize] = (char *) newStr;
+	environCache[cacheSize+1] = NULL;
+	cacheSize += 5;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindVariable --
+ *
+ *	Locate the entry in environ for a given name.
+ *
+ * Results:
+ *	The return value is the index in environ of an entry with the
+ *	name "name", or -1 if there is no such entry.   The integer at
+ *	*lengthPtr is filled in with the length of name (if a matching
+ *	entry is found) or the length of the environ array (if no matching
+ *	entry is found).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FindVariable(name, lengthPtr)
+    CONST char *name;		/* Name of desired environment variable. */
+    int *lengthPtr;		/* Used to return length of name (for
+				 * successful searches) or number of non-NULL
+				 * entries in environ (for unsuccessful
+				 * searches). */
+{
+    int i;
+    register CONST char *p1, *p2;
+
+    for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
+	for (p2 = name; *p2 == *p1; p1++, p2++) {
+	    /* NULL loop body. */
+	}
+	if ((*p1 == '=') && (*p2 == '\0')) {
+	    *lengthPtr = p2-name;
+	    return i;
+	}
+    }
+    *lengthPtr = i;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeEnvironment --
+ *
+ *	This function releases any storage allocated by this module
+ *	that isn't still in use by the global environment.  Any
+ *	strings that are still in the environment will be leaked.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May deallocate storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeEnvironment()
+{
+    /*
+     * For now we just deallocate the cache array and none of the environment
+     * strings.  This may leak more memory that strictly necessary, since some
+     * of the strings may no longer be in the environment.  However,
+     * determining which ones are ok to delete is n-squared, and is pretty
+     * unlikely, so we don't bother.
+     */
+
+    if (environCache) {
+	ckfree((char *) environCache);
+	environCache = NULL;
+	cacheSize    = 0;
+#ifndef USE_PUTENV
+	environSize  = 0;
+#endif
+    }
+}
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+
+#include "windows.h"
+
+/* When using cygwin32, when an environment variable changes, we need
+   to synch with both the cygwin32 environment (in case the
+   application C code calls fork) and the Windows environment (in case
+   the application TCL code calls exec, which calls the Windows
+   CreateProcess function).  */
+
+static void
+TclCygwin32Putenv(str)
+     const char *str;
+{
+  char *name, *value;
+
+  /* Get the name and value, so that we can change the environment
+     variable for Windows.  */
+  name = (char *) alloca (strlen (str) + 1);
+  strcpy (name, str);
+  for (value = name; *value != '=' && *value != '\0'; ++value)
+    ;
+  if (*value == '\0')
+    {
+      /* Can't happen.  */
+      return;
+    }
+  *value = '\0';
+  ++value;
+  if (*value == '\0')
+    value = NULL;
+
+  /* Set the cygwin32 environment variable.  */
+#undef putenv
+  if (value == NULL)
+    unsetenv (name);
+  else
+    putenv(str);
+
+  /* Before changing the environment variable in Windows, if this is
+     PATH, we need to convert the value back to a Windows style path.
+
+     FIXME: The calling program may now it is running under windows,
+     and may have set the path to a Windows path, or, worse, appended
+     or prepended a Windows path to PATH.  */
+  if (strcmp (name, "PATH") != 0)
+    {
+      /* If this is Path, eliminate any PATH variable, to prevent any
+         confusion.  */
+      if (strcmp (name, "Path") == 0)
+	{
+	  SetEnvironmentVariable ("PATH", (char *) NULL);
+	  unsetenv ("PATH");
+	}
+
+      SetEnvironmentVariable (name, value);
+    }
+  else
+    {
+      char *buf;
+
+      /* Eliminate any Path variable, to prevent any confusion.  */
+      SetEnvironmentVariable ("Path", (char *) NULL);
+      unsetenv ("Path");
+
+      if (value == NULL)
+	buf = NULL;
+      else
+	{
+	  int size;
+
+	  size = cygwin32_posix_to_win32_path_list_buf_size (value);
+	  buf = (char *) alloca (size + 1);
+	  cygwin32_posix_to_win32_path_list (value, buf);
+	}
+
+      SetEnvironmentVariable (name, buf);
+    }
+}
+
+#endif /* __CYGWIN32__ */
+/* END CYGNUS LOCAL */
diff --git a/tcl/generic/tclEvent.c b/tcl/generic/tclEvent.c
new file mode 100644
index 00000000000..554878884a3
--- /dev/null
+++ b/tcl/generic/tclEvent.c
@@ -0,0 +1,698 @@
+/* 
+ * tclEvent.c --
+ *
+ *	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-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * 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
+ * later as an idle handler.
+ */
+
+typedef struct BgError {
+    Tcl_Interp *interp;		/* Interpreter in which error occurred.  NULL
+				 * means this error report has been cancelled
+				 * (a previous report generated a break). */
+    char *errorMsg;		/* The error message (interp->result when
+				 * the error occurred).  Malloc-ed. */
+    char *errorInfo;		/* Value of the errorInfo variable
+				 * (malloc-ed). */
+    char *errorCode;		/* Value of the errorCode variable
+				 * (malloc-ed). */
+    struct BgError *nextPtr;	/* Next in list of all pending error
+				 * reports for this interpreter, or NULL
+				 * for end of list. */
+} BgError;
+
+/*
+ * One of the structures below is associated with the "tclBgError"
+ * assoc data for each interpreter.  It keeps track of the head and
+ * tail of the list of pending background errors for the interpreter.
+ */
+
+typedef struct ErrAssocData {
+    BgError *firstBgPtr;	/* First in list of all background errors
+				 * waiting to be processed for this
+				 * interpreter (NULL if none). */
+    BgError *lastBgPtr;		/* Last in list of all background errors
+				 * waiting to be processed for this
+				 * interpreter (NULL if none). */
+} ErrAssocData;
+
+/*
+ * For each exit handler created with a call to Tcl_CreateExitHandler
+ * there is a structure of the following type:
+ */
+
+typedef struct ExitHandler {
+    Tcl_ExitProc *proc;		/* Procedure to call when process exits. */
+    ClientData clientData;	/* One word of information to pass to proc. */
+    struct ExitHandler *nextPtr;/* Next in list of all exit handlers for
+				 * this application, or NULL for end of list. */
+} ExitHandler;
+
+static ExitHandler *firstExitPtr = NULL;
+				/* First in list of all exit handlers for
+				 * application. */
+
+/*
+ * 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
+ * dump memory usage information.
+ */
+
+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		BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp));
+static void		HandleBgErrors _ANSI_ARGS_((ClientData clientData));
+static char *		VwaitVarProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_BackgroundError --
+ *
+ *	This procedure is invoked to handle errors that occur in Tcl
+ *	commands that are invoked in "background" (e.g. from event or
+ *	timer bindings).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The command "bgerror" is invoked later as an idle handler to
+ *	process the error, passing it the error message.  If that fails,
+ *	then an error message is output on stderr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_BackgroundError(interp)
+    Tcl_Interp *interp;		/* Interpreter in which an error has
+				 * occurred. */
+{
+    BgError *errPtr;
+    char *errResult, *varValue;
+    ErrAssocData *assocPtr;
+
+    /*
+     * The Tcl_AddErrorInfo call below (with an empty string) ensures that
+     * errorInfo gets properly set.  It's needed in cases where the error
+     * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
+     * in these cases errorInfo still won't have been set when this
+     * procedure is called.
+     */
+
+    Tcl_AddErrorInfo(interp, "");
+
+    errResult = TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL);
+	
+    errPtr = (BgError *) ckalloc(sizeof(BgError));
+    errPtr->interp = interp;
+    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;
+    }
+    errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
+    strcpy(errPtr->errorInfo, varValue);
+    varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
+    if (varValue == NULL) {
+	varValue = "";
+    }
+    errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
+    strcpy(errPtr->errorCode, varValue);
+    errPtr->nextPtr = NULL;
+
+    assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
+	    (Tcl_InterpDeleteProc **) NULL);
+    if (assocPtr == NULL) {
+
+	/*
+	 * This is the first time a background error has occurred in
+	 * this interpreter.  Create associated data to keep track of
+	 * pending error reports.
+	 */
+
+	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+	assocPtr->firstBgPtr = NULL;
+	assocPtr->lastBgPtr = NULL;
+	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
+		(ClientData) assocPtr);
+    }
+    if (assocPtr->firstBgPtr == NULL) {
+	assocPtr->firstBgPtr = errPtr;
+	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
+    } else {
+	assocPtr->lastBgPtr->nextPtr = errPtr;
+    }
+    assocPtr->lastBgPtr = errPtr;
+    Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleBgErrors --
+ *
+ *	This procedure is invoked as an idle handler to process all of
+ *	the accumulated background errors.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on what actions "bgerror" takes for the errors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+HandleBgErrors(clientData)
+    ClientData clientData;	/* Pointer to ErrAssocData structure. */
+{
+    Tcl_Interp *interp;
+    char *command;
+    char *argv[2];
+    int code;
+    BgError *errPtr;
+    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+    Tcl_Channel errChannel;
+
+    Tcl_Preserve((ClientData) assocPtr);
+    
+    while (assocPtr->firstBgPtr != NULL) {
+	interp = assocPtr->firstBgPtr->interp;
+	if (interp == NULL) {
+	    goto doneWithInterp;
+	}
+
+	/*
+	 * Restore important state variables to what they were at
+	 * the time the error occurred.
+	 */
+
+	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
+		TCL_GLOBAL_ONLY);
+	Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,
+		TCL_GLOBAL_ONLY);
+
+	/*
+	 * Create and invoke the bgerror command.
+	 */
+
+	argv[0] = "bgerror";
+	argv[1] = assocPtr->firstBgPtr->errorMsg;
+	command = Tcl_Merge(2, argv);
+	Tcl_AllowExceptions(interp);
+        Tcl_Preserve((ClientData) interp);
+	code = Tcl_GlobalEval(interp, command);
+	ckfree(command);
+	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.
+             */
+            
+            errChannel = Tcl_GetStdChannel(TCL_STDERR);
+            if (errChannel != (Tcl_Channel) NULL) {
+                if (strcmp(interp->result,
+           "\"bgerror\" is an invalid command name or ambiguous abbreviation")
+                        == 0) {
+                    Tcl_Write(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
+                    Tcl_Write(errChannel, "\n", -1);
+                } else {
+                    Tcl_Write(errChannel,
+                            "bgerror failed to handle background error.\n",
+                            -1);
+                    Tcl_Write(errChannel, "    Original error: ", -1);
+                    Tcl_Write(errChannel, assocPtr->firstBgPtr->errorMsg,
+                            -1);
+                    Tcl_Write(errChannel, "\n", -1);
+                    Tcl_Write(errChannel, "    Error in bgerror: ", -1);
+                    Tcl_Write(errChannel, interp->result, -1);
+                    Tcl_Write(errChannel, "\n", -1);
+                }
+                Tcl_Flush(errChannel);
+            }
+	} else if (code == TCL_BREAK) {
+
+	    /*
+	     * Break means cancel any remaining error reports for this
+	     * interpreter.
+	     */
+
+	    for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;
+		    errPtr = errPtr->nextPtr) {
+		if (errPtr->interp == interp) {
+		    errPtr->interp = NULL;
+		}
+	    }
+	}
+
+	/*
+	 * Discard the command and the information about the error report.
+	 */
+
+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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BgErrorDeleteProc --
+ *
+ *	This procedure is associated with the "tclBgError" assoc data
+ *	for an interpreter;  it is invoked when the interpreter is
+ *	deleted in order to free the information assoicated with any
+ *	pending error reports.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Background error information is freed: if there were any
+ *	pending error reports, they are cancelled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BgErrorDeleteProc(clientData, interp)
+    ClientData clientData;	/* Pointer to ErrAssocData structure. */
+    Tcl_Interp *interp;		/* Interpreter being deleted. */
+{
+    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+    BgError *errPtr;
+
+    while (assocPtr->firstBgPtr != NULL) {
+	errPtr = assocPtr->firstBgPtr;
+	assocPtr->firstBgPtr = errPtr->nextPtr;
+	ckfree(errPtr->errorMsg);
+	ckfree(errPtr->errorInfo);
+	ckfree(errPtr->errorCode);
+	ckfree((char *) errPtr);
+    }
+    Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
+    Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateExitHandler --
+ *
+ *	Arrange for a given procedure to be invoked just before the
+ *	application exits.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Proc will be invoked with clientData as argument when the
+ *	application exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr;
+
+    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+    exitPtr->proc = proc;
+    exitPtr->clientData = clientData;
+    exitPtr->nextPtr = firstExitPtr;
+    firstExitPtr = exitPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteExitHandler --
+ *
+ *	This procedure cancels an existing exit handler matching proc
+ *	and clientData, if such a handler exits.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there is an exit handler corresponding to proc and clientData
+ *	then it is cancelled;  if no such handler exists then nothing
+ *	happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr, *prevPtr;
+
+    for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
+	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+	if ((exitPtr->proc == proc)
+		&& (exitPtr->clientData == clientData)) {
+	    if (prevPtr == NULL) {
+		firstExitPtr = exitPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = exitPtr->nextPtr;
+	    }
+	    ckfree((char *) exitPtr);
+	    return;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Exit --
+ *
+ *	This procedure is called to terminate the application.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	All existing exit handlers are invoked, then the application
+ *	ends.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Exit(status)
+    int status;			/* Exit status for application;  typically
+				 * 0 for normal return, 1 for error return. */
+{
+    Tcl_Finalize();
+#ifdef TCL_MEM_DEBUG
+    if (tclMemDumpFileName != NULL) {
+	Tcl_DumpActiveMemory(tclMemDumpFileName);
+    }
+#endif
+    TclPlatformExit(status);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Finalize --
+ *
+ *	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:
+ *	Whatever the exit handlers do. Also frees up storage associated
+ *	with the Tcl object type table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Finalize()
+{
+    ExitHandler *exitPtr;
+    
+    /*
+     * Invoke exit handler first.
+     */
+
+    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.
+	 */
+
+	firstExitPtr = exitPtr->nextPtr;
+	(*exitPtr->proc)(exitPtr->clientData);
+	ckfree((char *) exitPtr);
+    }
+
+    /*
+     * Now finalize the Tcl execution environment.  Note that this must be done
+     * after the exit handlers, because there are order dependencies.
+     */
+    
+    TclFinalizeCompExecEnv();
+    TclFinalizeEnvironment();
+    TclpFinalize();
+    firstExitPtr = NULL;
+    tclInExit = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInExit --
+ *
+ *	Determines if we are in the middle of exit-time cleanup.
+ *
+ * Results:
+ *	If we are in the middle of exiting, 1, otherwise 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInExit()
+{
+    return tclInExit;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VwaitCmd --
+ *
+ *	This procedure is invoked to process the "vwait" 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_VwaitCmd(clientData, interp, argc, argv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+{
+    int done, foundEvent;
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " name\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (Tcl_TraceVar(interp, argv[1],
+	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
+	return TCL_ERROR;
+    };
+    done = 0;
+    foundEvent = 1;
+    while (!done && foundEvent) {
+	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+    }
+    Tcl_UntraceVar(interp, argv[1],
+	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    VwaitVarProc, (ClientData) &done);
+
+    /*
+     * Clear out the interpreter's result, since it may have been set
+     * by event handlers.
+     */
+
+    Tcl_ResetResult(interp);
+    if (!foundEvent) {
+	Tcl_AppendResult(interp, "can't wait for variable \"", argv[1],
+		"\":  would wait forever", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+	/* ARGSUSED */
+static char *
+VwaitVarProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Pointer to integer to set to 1. */
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *name1;		/* Name of variable. */
+    char *name2;		/* Second part of variable name. */
+    int flags;			/* Information about what happened. */
+{
+    int *donePtr = (int *) clientData;
+
+    *donePtr = 1;
+    return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpdateCmd --
+ *
+ *	This procedure is invoked to process the "update" 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_UpdateCmd(clientData, interp, argc, argv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+{
+    int flags;
+
+    if (argc == 1) {
+	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
+    } else if (argc == 2) {
+	if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
+	    Tcl_AppendResult(interp, "bad option \"", argv[1],
+		    "\": must be idletasks", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+    } else {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " ?idletasks?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    while (Tcl_DoOneEvent(flags) != 0) {
+	/* Empty loop body */
+    }
+
+    /*
+     * Must clear the interpreter's result because event handlers could
+     * have executed commands.
+     */
+
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
diff --git a/tcl/generic/tclExecute.c b/tcl/generic/tclExecute.c
new file mode 100644
index 00000000000..fdfe08344b9
--- /dev/null
+++ b/tcl/generic/tclExecute.c
@@ -0,0 +1,4928 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+#ifdef NO_FLOAT_H
+#   include "../compat/float.h"
+#else
+#   include <float.h>
+#endif
+#ifndef TCL_NO_MATH
+#include "tclMath.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 long numExecutions = 0;
+static int instructionCount[256];
+#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 char *		GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
+        		    ByteCode* codePtr, int *lengthPtr));
+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 void		PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
+static void		RecordTracebackInfo _ANSI_ARGS_((Tcl_Interp *interp,
+			    unsigned char *pc, ByteCode *codePtr));
+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));
+#ifdef TCL_COMPILE_DEBUG
+static void		ValidatePcAndStackTop _ANSI_ARGS_((
+			    ByteCode *codePtr, unsigned char *pc,
+			    int stackTop, int stackLowerBound,
+			    int stackUpperBound));
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * 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));
+    (VOID *) memset(tclByteCodeCount, 0, sizeof(tclByteCodeCount));
+    (VOID *) memset(tclSourceCount, 0, sizeof(tclSourceCount));
+
+    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) {
+        TclInitAuxDataTypeTable();
+        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;
+    TclFinalizeAuxDataTypeTable();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) {
+	PrintByteCodeInfo(codePtr);
+#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 (;;) {
+#ifdef TCL_COMPILE_DEBUG
+	ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
+		eePtr->stackEnd);
+#else /* not TCL_COMPILE_DEBUG */
+	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 */
+	
+	opCode = *pc;
+#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);
+	    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[TclGetUInt1AtPtr(pc+1)];
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPtr(pc+1)),
+	            valuePtr);
+	    ADJUST_PC(2);
+	    
+	case INST_PUSH4:
+	    valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPtr(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 = TclGetUInt1AtPtr(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 = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doInvocation;
+
+	case INST_INVOKE_STK1:
+	    opnd = TclGetUInt1AtPtr(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. */
+		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.
+		 */
+
+		if (iPtr->tracePtr != NULL) {
+		    Trace *tracePtr, *nextTracePtr;
+
+		    for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
+		            tracePtr = nextTracePtr) {
+			nextTracePtr = tracePtr->nextPtr;
+			if (iPtr->numLevels <= tracePtr->level) {
+			    int numChars;
+			    char *cmd = GetSrcInfoForPc(pc, codePtr,
+				    &numChars);
+			    if (cmd != NULL) {
+				DECACHE_STACK_INFO();
+				CallTraceProcedure(interp, tracePtr, cmdPtr,
+				        cmd, 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. 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));
+		    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);
+		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);
+		    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);
+			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);
+		    goto processCatch;  /* it will use rangePtr */
+		default:
+		    panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+		}
+		Tcl_DecrRefCount(objPtr);
+		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);
+		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);
+		goto checkForCatch;
+	    }
+	    stackPtr[++stackTop].o = valuePtr; /* already has right refct */
+	    TRACE_WITH_OBJ(("exprStk \"%.30s\" => ", O2S(objPtr)), valuePtr);
+	    TclDecrRefCount(objPtr);
+	    ADJUST_PC(1);
+
+	case INST_LOAD_SCALAR4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doLoadScalar;
+
+	case INST_LOAD_SCALAR1:
+	    opnd = TclGetUInt1AtPtr(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);
+		result = TCL_ERROR;
+		goto checkForCatch;
+            }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ",
+		    O2S(namePtr)), valuePtr);
+	    TclDecrRefCount(namePtr);
+	    ADJUST_PC(1);
+
+	case INST_LOAD_ARRAY4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doLoadArray;
+
+	case INST_LOAD_ARRAY1:
+	    opnd = TclGetUInt1AtPtr(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);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(valuePtr);
+		TRACE_WITH_OBJ(("%s %u \"%.30s\" => ",
+		        opName[opCode], opnd, O2S(elemPtr)), valuePtr);
+		TclDecrRefCount(elemPtr);
+	    }
+	    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);
+		    Tcl_DecrRefCount(elemPtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(valuePtr);
+		TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ",
+		        O2S(namePtr), O2S(elemPtr)), valuePtr);
+		TclDecrRefCount(namePtr);
+		TclDecrRefCount(elemPtr);
+	    }
+	    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);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(valuePtr);
+	    TRACE_WITH_OBJ(("loadStk \"%.30s\" => ", O2S(namePtr)),
+		    valuePtr);
+	    TclDecrRefCount(namePtr);
+	    ADJUST_PC(1);
+	    
+	case INST_STORE_SCALAR4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doStoreScalar;
+
+	case INST_STORE_SCALAR1:
+	    opnd = TclGetUInt1AtPtr(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);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ",
+		    opName[opCode], opnd, O2S(valuePtr)), value2Ptr);
+	    TclDecrRefCount(valuePtr);
+	    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);
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(
+		    ("storeScalarStk \"%.30s\" <- \"%.30s\" => ",
+		    O2S(namePtr),
+		    O2S(valuePtr)),
+		    value2Ptr);
+	    TclDecrRefCount(namePtr);
+	    TclDecrRefCount(valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_STORE_ARRAY4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doStoreArray;
+
+	case INST_STORE_ARRAY1:
+	    opnd = TclGetUInt1AtPtr(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);
+		    Tcl_DecrRefCount(valuePtr);
+		    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);
+		TclDecrRefCount(valuePtr);
+	    }
+	    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);
+		    Tcl_DecrRefCount(elemPtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ",
+		        O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+			value2Ptr);
+		TclDecrRefCount(namePtr);
+		TclDecrRefCount(elemPtr);
+		TclDecrRefCount(valuePtr);
+	    }
+	    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);
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ",
+		    O2S(namePtr), O2S(valuePtr)), value2Ptr);
+	    TclDecrRefCount(namePtr);
+	    TclDecrRefCount(valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_INCR_SCALAR1:
+	    opnd = TclGetUInt1AtPtr(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);
+		    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);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ", opnd, i),
+		    value2Ptr);
+	    TclDecrRefCount(valuePtr);
+	    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);
+		    Tcl_DecrRefCount(valuePtr);
+		    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);
+		Tcl_DecrRefCount(valuePtr);
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ",
+	            opName[opCode], O2S(namePtr), i), value2Ptr);
+	    Tcl_DecrRefCount(namePtr);
+	    Tcl_DecrRefCount(valuePtr);
+	    ADJUST_PC(1);
+
+	case INST_INCR_ARRAY1:
+	    {
+		Tcl_Obj *elemPtr;
+
+		opnd = TclGetUInt1AtPtr(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);
+			Tcl_DecrRefCount(valuePtr);
+			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);
+		    Tcl_DecrRefCount(valuePtr);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ",
+	                opnd, O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(elemPtr);
+		Tcl_DecrRefCount(valuePtr);
+	    }
+	    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);
+			Tcl_DecrRefCount(elemPtr);
+			Tcl_DecrRefCount(valuePtr);
+			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);
+		    Tcl_DecrRefCount(elemPtr);
+		    Tcl_DecrRefCount(valuePtr);
+		    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);
+		Tcl_DecrRefCount(elemPtr);
+		Tcl_DecrRefCount(valuePtr);
+	    }
+	    ADJUST_PC(1);
+	    
+	case INST_INCR_SCALAR1_IMM:
+	    opnd = TclGetUInt1AtPtr(pc+1);
+	    i = TclGetInt1AtPtr(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 = TclGetInt1AtPtr(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);
+		goto checkForCatch;
+	    }
+	    PUSH_OBJECT(value2Ptr);
+	    TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ",
+	            opName[opCode], O2S(namePtr), i), value2Ptr);
+	    TclDecrRefCount(namePtr);
+	    ADJUST_PC(2);
+
+	case INST_INCR_ARRAY1_IMM:
+	    {
+		Tcl_Obj *elemPtr;
+
+		opnd = TclGetUInt1AtPtr(pc+1);
+		i = TclGetInt1AtPtr(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);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		PUSH_OBJECT(value2Ptr);
+		TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ",
+	                opnd, O2S(elemPtr), i), value2Ptr);
+		Tcl_DecrRefCount(elemPtr);
+	    }
+	    ADJUST_PC(3);
+	    
+	case INST_INCR_ARRAY_STK_IMM:
+	    {
+		Tcl_Obj *elemPtr;
+
+		i = TclGetInt1AtPtr(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);
+		    Tcl_DecrRefCount(elemPtr);
+		    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);
+		Tcl_DecrRefCount(elemPtr);
+	    }
+	    ADJUST_PC(2);
+
+	case INST_JUMP1:
+	    opnd = TclGetInt1AtPtr(pc+1);
+	    TRACE(("jump1 %d => new pc %u\n", opnd,
+		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    ADJUST_PC(opnd);
+
+	case INST_JUMP4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    TRACE(("jump4 %d => new pc %u\n", opnd,
+		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    ADJUST_PC(opnd);
+
+	case INST_JUMP_TRUE4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doJumpTrue;
+
+	case INST_JUMP_TRUE1:
+	    opnd = TclGetInt1AtPtr(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);
+			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);
+		    ADJUST_PC(opnd);
+		} else {
+		    TRACE(("%s %d => %.20s false\n", opName[opCode], opnd,
+		            O2S(valuePtr)));
+		    TclDecrRefCount(valuePtr);
+		    ADJUST_PC(pcAdjustment);
+		}
+	    }
+	    
+	case INST_JUMP_FALSE4:
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    pcAdjustment = 5;
+	    goto doJumpFalse;
+
+	case INST_JUMP_FALSE1:
+	    opnd = TclGetInt1AtPtr(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);
+			goto checkForCatch;
+		    }
+		}
+		if (b) {
+		    TRACE(("%s %d => %.20s true\n", opName[opCode], opnd,
+		            O2S(valuePtr)));
+		    TclDecrRefCount(valuePtr);
+		    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);
+		    ADJUST_PC(opnd);
+		}
+	    }
+	    
+	case INST_LOR:
+	case INST_LAND:
+	    {
+		/*
+		 * Operands must be boolean or numeric. No int->double
+		 * conversions are performed.
+		 */
+		
+		int i1, i2;
+		int iResult;
+		char *s;
+		Tcl_ObjType *t1Ptr, *t2Ptr;
+		
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+		t1Ptr = valuePtr->typePtr;
+		t2Ptr = value2Ptr->typePtr;
+		
+		if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
+		    i1 = (valuePtr->internalRep.longValue != 0);
+		} else if (t1Ptr == &tclDoubleType) {
+		    i1 = (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);
+			i1 = (i != 0);
+		    } else {
+			result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+				valuePtr, &i1);
+			i1 = (i1 != 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);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		}
+		
+		if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
+		    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, &i);
+			i2 = (i != 0);
+		    } else {
+			result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+				value2Ptr, &i2);
+			i2 = (i2 != 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);
+			Tcl_DecrRefCount(value2Ptr);
+			goto checkForCatch;
+		    }
+		}
+		
+		/*
+		 * Reuse the valuePtr object already on stack if possible.
+		 */
+
+		if (opCode == INST_LOR) {
+		    iResult = (i1 || i2);
+		} else {
+		    iResult = (i1 && i2);
+		}
+		if (Tcl_IsShared(valuePtr)) {
+		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
+		    TRACE(("%s %.20s %.20s => %d\n", opName[opCode],
+			   O2S(valuePtr), O2S(value2Ptr), iResult));
+		    TclDecrRefCount(valuePtr);
+		} else {	/* reuse the valuePtr object */
+		    TRACE(("%s %.20s %.20s => %d\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);
+	    }
+	    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);
+		} 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);
+	    }
+	    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);
+			Tcl_DecrRefCount(value2Ptr);
+			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);
+			Tcl_DecrRefCount(value2Ptr);
+			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);
+			Tcl_DecrRefCount(value2Ptr);
+			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);
+		} 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);
+	    }
+	    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);
+			Tcl_DecrRefCount(value2Ptr);
+			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);
+			Tcl_DecrRefCount(value2Ptr);
+			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);
+			    Tcl_DecrRefCount(value2Ptr);
+			    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);
+			Tcl_DecrRefCount(value2Ptr);
+			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);
+			    Tcl_DecrRefCount(value2Ptr);
+			    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);
+		} 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);
+	    }
+	    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);
+			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);
+		} 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);
+			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);
+		} 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 = TclGetUInt1AtPtr(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 = TclGetUInt1AtPtr(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);
+			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;
+			}
+		    }
+		    shared = shared;		/* lint, shared not used. */
+		    converted = converted;	/* lint, converted not used. */
+		    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;
+	    }
+	    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 = TclGetUInt4AtPtr(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;
+		if (oldValuePtr == NULL) {
+		    iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
+		    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
+		} else {
+		    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 = TclGetUInt4AtPtr(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;
+		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;
+		    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();
+			    } 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",
+		    TclGetUInt4AtPtr(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));
+	    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 "exception" such as TCL_ERROR. If the
+	 * exception is an error, record information about what was being
+	 * executed when the error occurred. Find the closest enclosing
+	 * catch range, if any. If no enclosing catch range is found, stop
+	 * execution and return the "exception" code.
+	 */
+	
+        checkForCatch:
+	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	    RecordTracebackInfo(interp, pc, codePtr);
+        }
+	rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+	if (rangePtr == NULL) {
+	    TRACE(("   ... no enclosing catch, returning %s\n",
+		    StringForResultCode(result)));
+	    goto abnormalReturn;
+	}
+
+	/*
+	 * A catch exception range (rangePtr) was found 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.
+	 */
+
+        processCatch:
+	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
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintByteCodeInfo --
+ *
+ *	This procedure prints a summary about a bytecode object to stdout.
+ *	It is called by TclExecuteByteCode when starting to execute the
+ *	bytecode object if tclTraceExec has the value 2 or more.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintByteCodeInfo(codePtr)
+    register ByteCode *codePtr;	/* The bytecode whose summary is printed
+				 * to stdout. */
+{
+    Proc *procPtr = codePtr->procPtr;
+    int numCmds = codePtr->numCommands;
+    int numObjs = codePtr->numObjects;
+    int objBytes, i;
+
+    objBytes = (numObjs * sizeof(Tcl_Obj));
+    for (i = 0;  i < numObjs;  i++) {
+	Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
+	if (litObjPtr->bytes != NULL) {
+	    objBytes += litObjPtr->length;
+	}
+    }
+    
+    fprintf(stdout, "\nExecuting ByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
+	    (unsigned int) codePtr, codePtr->refCount,
+	    codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
+	    codePtr->iPtr->compileEpoch);
+    
+    fprintf(stdout, "  Source: ");
+    TclPrintSource(stdout, codePtr->source, 70);
+
+    fprintf(stdout, "\n  Cmds %d, chars %d, inst %u, objs %u, aux %d, stk depth %u, code/src %.2fn",
+            numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
+	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
+	    (codePtr->numSrcChars?
+	            ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
+
+    fprintf(stdout, "  Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
+	    codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
+	    objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
+	    (codePtr->numAuxDataItems * sizeof(AuxData)),
+	    codePtr->numCmdLocBytes);
+
+    if (procPtr != NULL) {
+	fprintf(stdout,
+		"  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
+		(unsigned int) procPtr, procPtr->refCount,
+		procPtr->numArgs, procPtr->numCompiledLocals);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidatePcAndStackTop --
+ *
+ *	This procedure is called by TclExecuteByteCode when debugging to
+ *	verify that the program counter and stack top are valid during
+ *	execution.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Prints a message to stderr and panics if either the pc or stack
+ *	top are invalid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static void
+ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
+    register ByteCode *codePtr; /* The bytecode whose summary is printed
+				 * to stdout. */
+    unsigned char *pc;		/* Points to first byte of a bytecode
+				 * instruction. The program counter. */
+    int stackTop;		/* Current stack top. Must be between
+				 * stackLowerBound and stackUpperBound
+				 * (inclusive). */
+    int stackLowerBound;	/* Smallest legal value for stackTop. */
+    int stackUpperBound;	/* Greatest legal value for stackTop. */
+{
+    unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
+    unsigned int codeStart = (unsigned int) codePtr->codeStart;
+    unsigned int codeEnd = (unsigned int)
+	    (codePtr->codeStart + codePtr->numCodeBytes);
+    unsigned char opCode = *pc;
+
+    if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
+	fprintf(stderr, "\nBad instruction pc 0x%x in TclExecuteByteCode\n",
+		(unsigned int) pc);
+	panic("TclExecuteByteCode execution failure: bad pc");
+    }
+    if ((unsigned int) opCode > LAST_INST_OPCODE) {
+	fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
+		(unsigned int) opCode, relativePc);
+	panic("TclExecuteByteCode execution failure: bad opcode");
+    }
+    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
+	int numChars;
+	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+	char *ellipsis = "";
+	
+	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode",
+		stackTop, relativePc);
+	if (cmd != NULL) {
+	    if (numChars > 100) {
+		numChars = 100;
+		ellipsis = "...";
+	    }
+	    fprintf(stderr, "\n executing %.*s%s\n", numChars, cmd,
+		    ellipsis);
+	} else {
+	    fprintf(stderr, "\n");
+	}
+	panic("TclExecuteByteCode execution failure: bad stack top");
+    }
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_LOR], "\"", (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_LOR],
+		"\"", (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));
+    memcpy((VOID *) p, (VOID *) 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecordTracebackInfo --
+ *
+ *      Procedure called by TclExecuteByteCode to record information
+ *      about what was being executed when the error occurred.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Appends information about the command being executed to the
+ *      "errorInfo" variable. Sets the errorLine field in the interpreter
+ *      to the line number of that command. Sets the ERR_ALREADY_LOGGED
+ *      bit in the interpreter's execution flags.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecordTracebackInfo(interp, pc, codePtr)
+    Tcl_Interp *interp;         /* The interpreter in which the error
+                                 * occurred. */
+    unsigned char *pc;          /* The program counter value where the error                                 * occurred. This points to a bytecode
+                                 * instruction in codePtr's code. */
+    ByteCode *codePtr;          /* The bytecode sequence being executed. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    char *cmd, *ellipsis;
+    char buf[200];
+    register char *p;
+    int numChars;
+    
+    /*
+     * Record the command in errorInfo (up to a certain number of
+     * characters, or up to the first newline).
+     */
+    
+    iPtr->errorLine = 1;
+    cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+    if (cmd != NULL) {
+        for (p = codePtr->source;  p != cmd;  p++) {
+            if (*p == '\n') {
+                iPtr->errorLine++;
+            }
+        }
+        for ( ;  (isspace(UCHAR(*p)) || (*p == ';'));  p++) {
+            if (*p == '\n') {
+                iPtr->errorLine++;
+            }
+        }
+	
+        ellipsis = "";
+        if (numChars > 150) {
+            numChars = 150;
+            ellipsis = "...";
+        }
+        if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+            sprintf(buf, "\n    while executing\n\"%.*s%s\"",
+                    numChars, cmd, ellipsis);
+        } else {
+            sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
+                    numChars, cmd, ellipsis);
+        }
+        Tcl_AddObjErrorInfo(interp, buf, -1);
+        iPtr->flags |= ERR_ALREADY_LOGGED;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetSrcInfoForPc --
+ *
+ *	Given a program counter value, finds the closest command in the
+ *	bytecode code unit's CmdLocation array and returns information about
+ *	that command's source: a pointer to its first byte and the number of
+ *	characters.
+ *
+ * Results:
+ *	If a command is found that encloses the program counter value, a
+ *	pointer to the command's source is returned and the length of the
+ *	source is stored at *lengthPtr. If multiple commands resulted in
+ *	code at pc, information about the closest enclosing command is
+ *	returned. If no matching command is found, NULL is returned and
+ *	*lengthPtr is unchanged.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetSrcInfoForPc(pc, codePtr, lengthPtr)
+    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 *lengthPtr;		/* If non-NULL, the location where the
+				 * length of the command's source should be
+				 * stored. If NULL, no length is stored. */
+{
+    register int pcOffset = (pc - codePtr->codeStart);
+    int numCmds = codePtr->numCommands;
+    unsigned char *codeDeltaNext, *codeLengthNext;
+    unsigned char *srcDeltaNext, *srcLengthNext;
+    int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
+    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
+    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
+    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
+
+    if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
+	return NULL;
+    }
+
+    /*
+     * Decode the code and source offset and length for each command. The
+     * closest enclosing command is the last one whose code started before
+     * pcOffset.
+     */
+
+    codeDeltaNext = codePtr->codeDeltaStart;
+    codeLengthNext = codePtr->codeLengthStart;
+    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+	    codeLengthNext++;
+	    codeLen = TclGetInt4AtPtr(codeLengthNext);
+	    codeLengthNext += 4;
+	} else {
+	    codeLen = TclGetInt1AtPtr(codeLengthNext);
+	    codeLengthNext++;
+	}
+	codeEnd = (codeOffset + codeLen - 1);
+
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+	
+	if (codeOffset > pcOffset) {      /* best cmd already found */
+	    break;
+	} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
+	    int dist = (pcOffset - codeOffset);
+	    if (dist <= bestDist) {
+		bestDist = dist;
+		bestSrcOffset = srcOffset;
+		bestSrcLength = srcLen;
+	    }
+	}
+    }
+
+    if (bestDist == INT_MAX) {
+	return NULL;
+    }
+    
+    if (lengthPtr != NULL) {
+	*lengthPtr = bestSrcLength;
+    }
+    return (codePtr->source + bestSrcOffset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+    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);
+    Tcl_DecrRefCount(value2Ptr);
+    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);
+    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);
+    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);
+    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;
+    }
+
+    /*
+     * On 64-bit architectures we need to mask off the upper bits to
+     * ensure we only have a 32-bit range.  The constant has the
+     * bizarre form below in order to make sure that it doesn't
+     * get sign-extended (the rules for sign extension are very
+     * concat, particularly on 64-bit machines).
+     */
+
+    iPtr->randSeed &= ((((unsigned long) 0xfffffff) << 4) | 0xf);
+    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);
+    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;
+
+    /*
+     * 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);
+	    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
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLog2 --
+ *
+ *	Procedure used while collecting compilation statistics to determine
+ *	the log base 2 of an integer.
+ *
+ * Results:
+ *	Returns the log base 2 of the operand. If the argument is less
+ *	than or equal to zero, a zero is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLog2(value)
+    register int value;		/* The integer for which to compute the
+				 * log base 2. */
+{
+    register int n = value;
+    register int result = 0;
+
+    while (n > 1) {
+	n = n >> 1;
+	result++;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    int maxSizeDecade = 0;
+    double totalHeaderBytes = (tclNumCompilations * sizeof(ByteCode));
+
+    for (i = 0;  i < 256;  i++) {
+        if (instructionCount[i] != 0) {
+            total += instructionCount[i];
+        }
+    }
+
+    for (i = 31;  i >= 0;  i--) {
+        if ((tclSourceCount[i] > 0) && (tclByteCodeCount[i] > 0)) {
+            maxSizeDecade = i;
+	    break;
+        }
+    } 
+
+    fprintf(stdout, "\nNumber of compilations		%ld\n",
+	    tclNumCompilations);
+    fprintf(stdout, "Number of executions		%ld\n",
+	    numExecutions);
+    fprintf(stdout, "Average executions/compilation	%.0f\n",
+	    ((float) numExecutions/tclNumCompilations));
+    
+    fprintf(stdout, "\nInstructions executed		%.0f\n",
+	    total);
+    fprintf(stdout, "Average instructions/compile	%.0f\n",
+	    total/tclNumCompilations);
+    fprintf(stdout, "Average instructions/execution	%.0f\n",
+	    total/numExecutions);
+    
+    fprintf(stdout, "\nTotal source bytes		%.6g\n",
+	    tclTotalSourceBytes);
+    fprintf(stdout, "Total code bytes		%.6g\n",
+	    tclTotalCodeBytes);
+    fprintf(stdout, "Average code/compilation	%.0f\n",
+	    tclTotalCodeBytes/tclNumCompilations);
+    fprintf(stdout, "Average code/source		%.2f\n",
+	    tclTotalCodeBytes/tclTotalSourceBytes);
+    fprintf(stdout, "Current source bytes		%.6g\n",
+	    tclCurrentSourceBytes);
+    fprintf(stdout, "Current code bytes		%.6g\n",
+	    tclCurrentCodeBytes);
+    fprintf(stdout, "Current code/source		%.2f\n",
+	    tclCurrentCodeBytes/tclCurrentSourceBytes);
+    
+    fprintf(stdout, "\nTotal objects allocated		%ld\n",
+	    tclObjsAlloced);
+    fprintf(stdout, "Total objects freed		%ld\n",
+	    tclObjsFreed);
+    fprintf(stdout, "Current objects:	 	%ld\n",
+	    (tclObjsAlloced - tclObjsFreed));
+
+    fprintf(stdout, "\nBreakdown of code byte requirements:\n");
+    fprintf(stdout, "                   Total bytes      Pct of    Avg per\n");
+    fprintf(stdout, "                                  all code    compile\n");
+    fprintf(stdout, "Total code        %12.6g        100%%   %8.2f\n",
+	    tclTotalCodeBytes, tclTotalCodeBytes/tclNumCompilations);
+    fprintf(stdout, "Header            %12.6g   %8.2f%%   %8.2f\n",
+	    totalHeaderBytes,
+	    ((totalHeaderBytes * 100.0) / tclTotalCodeBytes),
+	    totalHeaderBytes/tclNumCompilations);
+    fprintf(stdout, "Instructions      %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalInstBytes,
+	    ((tclTotalInstBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalInstBytes/tclNumCompilations);
+    fprintf(stdout, "Objects           %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalObjBytes,
+	    ((tclTotalObjBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalObjBytes/tclNumCompilations);
+    fprintf(stdout, "Exception table   %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalExceptBytes,
+	    ((tclTotalExceptBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalExceptBytes/tclNumCompilations);
+    fprintf(stdout, "Auxiliary data    %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalAuxBytes,
+	    ((tclTotalAuxBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalAuxBytes/tclNumCompilations);
+    fprintf(stdout, "Command map       %12.6g   %8.2f%%   %8.2f\n",
+	    tclTotalCmdMapBytes,
+	    ((tclTotalCmdMapBytes * 100.0) / tclTotalCodeBytes),
+	    tclTotalCmdMapBytes/tclNumCompilations);
+    
+    fprintf(stdout, "\nSource and ByteCode size distributions:\n");
+    fprintf(stdout, "	 binary decade		source	  code\n");
+    for (i = 0;  i <= maxSizeDecade;  i++) {
+	int decadeLow, decadeHigh;
+
+	if (i == 0) {
+	    decadeLow = 0;
+	} else {
+	    decadeLow = 1 << i;
+	}
+	decadeHigh = (1 << (i+1)) - 1;
+        fprintf(stdout,	"	%6d -%6d		%6d	%6d\n",
+		decadeLow, decadeHigh,
+		tclSourceCount[i], tclByteCodeCount[i]);
+    }
+
+    fprintf(stdout, "\nInstruction counts:\n");
+    for (i = 0;  i < 256;  i++) {
+        if (instructionCount[i]) {
+            fprintf(stdout, "%20s %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.twoPtrValue.ptr1 = (VOID *) resPtr;
+    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    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->internalRep.twoPtrValue.ptr2 = NULL;
+    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/tcl/generic/tclFCmd.c b/tcl/generic/tclFCmd.c
new file mode 100644
index 00000000000..1260cda4f05
--- /dev/null
+++ b/tcl/generic/tclFCmd.c
@@ -0,0 +1,816 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 TclStat() 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 ((TclStat(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 TclStat() so that if target is a symlink that points
+	     * to a directory we will create subdirectories in that
+	     * directory.
+	     */
+
+	    if (TclStat(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/tcl/generic/tclFileName.c b/tcl/generic/tclFileName.c
new file mode 100644
index 00000000000..d57aaedefdb
--- /dev/null
+++ b/tcl/generic/tclFileName.c
@@ -0,0 +1,1619 @@
+/* 
+ * tclFileName.c --
+ *
+ *	This file contains routines for converting file names betwen
+ *	native and network form.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclRegexp.h"
+
+/*
+ * This variable indicates whether the cleanup procedure has been
+ * registered for this file yet.
+ */
+
+static int initialized = 0;
+
+/*
+ * The following regular expression matches the root portion of a Windows
+ * absolute or volume relative path.  It will match both UNC and drive relative
+ * paths.
+ */
+
+#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*"
+
+/*
+ * The following regular expression matches the root portion of a Macintosh
+ * absolute path.  It will match degenerate Unix-style paths, tilde paths,
+ * Unix-style paths, and Mac paths.
+ */
+
+#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
+
+/*
+ * The following variables are used to hold precompiled regular expressions
+ * for use in filename matching.
+ */
+
+static regexp *winRootPatternPtr = NULL;
+static regexp *macRootPatternPtr = NULL;
+
+/*
+ * The following variable is set in the TclPlatformInit call to one
+ * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
+ */
+
+TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static char *		DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *user, Tcl_DString *resultPtr));
+static char *		ExtractWinRoot _ANSI_ARGS_((char *path,
+			    Tcl_DString *resultPtr, int offset));
+static void		FileNameCleanup _ANSI_ARGS_((ClientData clientData));
+static int		SkipToChar _ANSI_ARGS_((char **stringPtr,
+			    char *match));
+static char *		SplitMacPath _ANSI_ARGS_((char *path,
+			    Tcl_DString *bufPtr));
+static char *		SplitWinPath _ANSI_ARGS_((char *path,
+			    Tcl_DString *bufPtr));
+static char *		SplitUnixPath _ANSI_ARGS_((char *path,
+			    Tcl_DString *bufPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileNameCleanup --
+ *
+ *	This procedure is a Tcl_ExitProc used to clean up the static
+ *	data structures used in this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates storage used by the procedures in this file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileNameCleanup(clientData)
+    ClientData clientData;	/* Not used. */
+{
+    if (winRootPatternPtr != NULL) {
+	ckfree((char *)winRootPatternPtr);
+        winRootPatternPtr = (regexp *) NULL;
+    }
+    if (macRootPatternPtr != NULL) {
+	ckfree((char *)macRootPatternPtr);
+        macRootPatternPtr = (regexp *) NULL;
+    }
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExtractWinRoot --
+ *
+ *	Matches the root portion of a Windows path and appends it
+ *	to the specified Tcl_DString.
+ *	
+ * Results:
+ *	Returns the position in the path immediately after the root
+ *	including any trailing slashes.
+ *	Appends a cleaned up version of the root to the Tcl_DString
+ *	at the specified offest.
+ *
+ * Side effects:
+ *	Modifies the specified Tcl_DString.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ExtractWinRoot(path, resultPtr, offset)
+    char *path;			/* Path to parse. */
+    Tcl_DString *resultPtr;	/* Buffer to hold result. */
+    int offset;			/* Offset in buffer where result should be
+				 * stored. */
+{
+    int length;
+
+    /*
+     * Initialize the path name parser for Windows path names.
+     */
+
+    if (winRootPatternPtr == NULL) {
+	winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
+	if (!initialized) {
+	    Tcl_CreateExitHandler(FileNameCleanup, NULL);
+	    initialized = 1;
+	}
+    }
+
+    /*
+     * Match the root portion of a Windows path name.
+     */
+
+    if (!TclRegExec(winRootPatternPtr, path, path)) {
+	return path;
+    }
+
+    Tcl_DStringSetLength(resultPtr, offset);
+
+    if (winRootPatternPtr->startp[2] != NULL) {
+	Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
+	if (winRootPatternPtr->startp[6] != NULL) {
+	    Tcl_DStringAppend(resultPtr, "/", 1);
+	}
+    } else if (winRootPatternPtr->startp[4] != NULL) {
+	Tcl_DStringAppend(resultPtr, "//", 2);
+	length = winRootPatternPtr->endp[3]
+	    - winRootPatternPtr->startp[3];
+	Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
+	Tcl_DStringAppend(resultPtr, "/", 1);
+	length = winRootPatternPtr->endp[4]
+	    - winRootPatternPtr->startp[4];
+	Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
+    } else {
+	Tcl_DStringAppend(resultPtr, "/", 1);
+    }
+    return winRootPatternPtr->endp[0];
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetPathType --
+ *
+ *	Determines whether a given path is relative to the current
+ *	directory, relative to the current volume, or absolute.
+ *
+ * Results:
+ *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ *	TCL_PATH_VOLUME_RELATIVE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_PathType
+Tcl_GetPathType(path)
+    char *path;
+{
+    Tcl_PathType type = TCL_PATH_ABSOLUTE;
+
+    switch (tclPlatform) {
+   	case TCL_PLATFORM_UNIX:
+	    /*
+	     * Paths that begin with / or ~ are absolute.
+	     */
+
+	    if ((path[0] != '/') && (path[0] != '~')) {
+		type = TCL_PATH_RELATIVE;
+	    }
+	    break;
+
+	case TCL_PLATFORM_MAC:
+	    if (path[0] == ':') {
+		type = TCL_PATH_RELATIVE;
+	    } else if (path[0] != '~') {
+
+		/*
+		 * Since we have eliminated the easy cases, use the
+		 * root pattern to look for the other types.
+		 */
+
+		if (!macRootPatternPtr) {
+		    macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
+		    if (!initialized) {
+			Tcl_CreateExitHandler(FileNameCleanup, NULL);
+			initialized = 1;
+		    }
+		}
+		if (!TclRegExec(macRootPatternPtr, path, path)
+			|| (macRootPatternPtr->startp[2] != NULL)) {
+		    type = TCL_PATH_RELATIVE;
+		}
+	    }
+	    break;
+	
+	case TCL_PLATFORM_WINDOWS:
+	    if (path[0] != '~') {
+
+		/*
+		 * Since we have eliminated the easy cases, check for
+		 * drive relative paths using the regular expression.
+		 */
+
+		if (!winRootPatternPtr) {
+		    winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
+		    if (!initialized) {
+			Tcl_CreateExitHandler(FileNameCleanup, NULL);
+			initialized = 1;
+		    }
+		}
+		if (TclRegExec(winRootPatternPtr, path, path)) {
+		    if (winRootPatternPtr->startp[5]
+			    || (winRootPatternPtr->startp[2]
+				    && !(winRootPatternPtr->startp[6]))) {
+			type = TCL_PATH_VOLUME_RELATIVE;
+		    }
+		} else {
+		    type = TCL_PATH_RELATIVE;
+		}
+	    }
+	    break;
+    }
+    return type;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SplitPath --
+ *
+ *	Split a path into a list of path components.  The first element
+ *	of the list will have the same path type as the original path.
+ *
+ * Results:
+ *	Returns a standard Tcl result.  The interpreter result contains
+ *	a list of path components.
+ *	*argvPtr will be filled in with the address of an array
+ *	whose elements point to the elements of path, in order.
+ *	*argcPtr will get filled in with the number of valid elements
+ *	in the array.  A single block of memory is dynamically allocated
+ *	to hold both the argv array and a copy of the path elements.
+ *	The caller must eventually free this memory by calling ckfree()
+ *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
+ *	if the procedure returns normally.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SplitPath(path, argcPtr, argvPtr)
+    char *path;			/* Pointer to string containing a path. */
+    int *argcPtr;		/* Pointer to location to fill in with
+				 * the number of elements in the path. */
+    char ***argvPtr;		/* Pointer to place to store pointer to array
+				 * of pointers to path elements. */
+{
+    int i, size;
+    char *p;
+    Tcl_DString buffer;
+    Tcl_DStringInit(&buffer);
+
+    /*
+     * Perform platform specific splitting.  These routines will leave the
+     * result in the specified buffer.  Individual elements are terminated
+     * with a null character.
+     */
+
+    p = NULL;			/* Needed only to prevent gcc warnings. */
+    switch (tclPlatform) {
+   	case TCL_PLATFORM_UNIX:
+	    p = SplitUnixPath(path, &buffer);
+	    break;
+
+	case TCL_PLATFORM_WINDOWS:
+	    p = SplitWinPath(path, &buffer);
+	    break;
+	    
+	case TCL_PLATFORM_MAC:
+	    p = SplitMacPath(path, &buffer);
+	    break;
+    }
+
+    /*
+     * Compute the number of elements in the result.
+     */
+
+    size = Tcl_DStringLength(&buffer);
+    *argcPtr = 0;
+    for (i = 0; i < size; i++) {
+	if (p[i] == '\0') {
+	    (*argcPtr)++;
+	}
+    }
+    
+    /*
+     * Allocate a buffer large enough to hold the contents of the
+     * DString plus the argv pointers and the terminating NULL pointer.
+     */
+
+    *argvPtr = (char **) ckalloc((unsigned)
+	    ((((*argcPtr) + 1) * sizeof(char *)) + size));
+
+    /*
+     * Position p after the last argv pointer and copy the contents of
+     * the DString.
+     */
+
+    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
+    memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
+
+    /*
+     * Now set up the argv pointers.
+     */
+
+    for (i = 0; i < *argcPtr; i++) {
+	(*argvPtr)[i] = p;
+	while ((*p++) != '\0') {}
+    }
+    (*argvPtr)[i] = NULL;
+
+    Tcl_DStringFree(&buffer);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SplitUnixPath --
+ *
+ *	This routine is used by Tcl_SplitPath to handle splitting
+ *	Unix paths.
+ *
+ * Results:
+ *	Stores a null separated array of strings in the specified
+ *	Tcl_DString.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+SplitUnixPath(path, bufPtr)
+    char *path;			/* Pointer to string containing a path. */
+    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
+{
+    int length;
+    char *p, *elementStart;
+
+    /*
+     * Deal with the root directory as a special case.
+     */
+
+    if (path[0] == '/') {
+	Tcl_DStringAppend(bufPtr, "/", 2);
+	p = path+1;
+    } else {
+	p = path;
+    }
+
+    /*
+     * Split on slashes.  Embedded elements that start with tilde will be
+     * prefixed with "./" so they are not affected by tilde substitution.
+     */
+
+    for (;;) {
+	elementStart = p;
+	while ((*p != '\0') && (*p != '/')) {
+	    p++;
+	}
+	length = p - elementStart;
+	if (length > 0) {
+	    if ((elementStart[0] == '~') && (elementStart != path)) {
+		Tcl_DStringAppend(bufPtr, "./", 2);
+	    }
+	    Tcl_DStringAppend(bufPtr, elementStart, length);
+	    Tcl_DStringAppend(bufPtr, "", 1);
+	}
+	if (*p++ == '\0') {
+	    break;
+	}
+    }
+    return Tcl_DStringValue(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SplitWinPath --
+ *
+ *	This routine is used by Tcl_SplitPath to handle splitting
+ *	Windows paths.
+ *
+ * Results:
+ *	Stores a null separated array of strings in the specified
+ *	Tcl_DString.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+SplitWinPath(path, bufPtr)
+    char *path;			/* Pointer to string containing a path. */
+    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
+{
+    int length;
+    char *p, *elementStart;
+
+    p = ExtractWinRoot(path, bufPtr, 0);
+
+    /*
+     * Terminate the root portion, if we matched something.
+     */
+
+    if (p != path) {
+	Tcl_DStringAppend(bufPtr, "", 1);
+    }
+
+    /*
+     * Split on slashes.  Embedded elements that start with tilde will be
+     * prefixed with "./" so they are not affected by tilde substitution.
+     */
+
+    do {
+	elementStart = p;
+	while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
+	    p++;
+	}
+	length = p - elementStart;
+	if (length > 0) {
+	    if ((elementStart[0] == '~') && (elementStart != path)) {
+		Tcl_DStringAppend(bufPtr, "./", 2);
+	    }
+	    Tcl_DStringAppend(bufPtr, elementStart, length);
+	    Tcl_DStringAppend(bufPtr, "", 1);
+	}
+    } while (*p++ != '\0');
+
+    return Tcl_DStringValue(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SplitMacPath --
+ *
+ *	This routine is used by Tcl_SplitPath to handle splitting
+ *	Macintosh paths.
+ *
+ * Results:
+ *	Returns a newly allocated argv array.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+SplitMacPath(path, bufPtr)
+    char *path;			/* Pointer to string containing a path. */
+    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
+{
+    int isMac = 0;		/* 1 if is Mac-style, 0 if Unix-style path. */
+    int i, length;
+    char *p, *elementStart;
+
+    /*
+     * Initialize the path name parser for Macintosh path names.
+     */
+
+    if (macRootPatternPtr == NULL) {
+	macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
+	if (!initialized) {
+	    Tcl_CreateExitHandler(FileNameCleanup, NULL);
+	    initialized = 1;
+	}
+    }
+
+    /*
+     * Match the root portion of a Mac path name.
+     */
+
+    i = 0;			/* Needed only to prevent gcc warnings. */
+    if (TclRegExec(macRootPatternPtr, path, path) == 1) {
+	/*
+	 * Treat degenerate absolute paths like / and /../.. as
+	 * Mac relative file names for lack of anything else to do.
+	 */
+
+	if (macRootPatternPtr->startp[2] != NULL) {
+	    Tcl_DStringAppend(bufPtr, ":", 1);
+	    Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
+		    - macRootPatternPtr->startp[0] + 1);
+	    return Tcl_DStringValue(bufPtr);
+	}
+
+	if (macRootPatternPtr->startp[5] != NULL) {
+
+	    /*
+	     * Unix-style tilde prefixed paths.
+	     */
+
+	    isMac = 0;
+	    i = 5;
+	} else if (macRootPatternPtr->startp[7] != NULL) {
+
+	    /*
+	     * Mac-style tilde prefixed paths.
+	     */
+
+	    isMac = 1;
+	    i = 7;
+	} else if (macRootPatternPtr->startp[10] != NULL) {
+
+	    /*
+	     * Normal Unix style paths.
+	     */
+
+	    isMac = 0;
+	    i = 10;
+	} else if (macRootPatternPtr->startp[12] != NULL) {
+
+	    /*
+	     * Normal Mac style paths.
+	     */
+
+	    isMac = 1;
+	    i = 12;
+	}
+
+	length = macRootPatternPtr->endp[i]
+	    - macRootPatternPtr->startp[i];
+
+	/*
+	 * Append the element and terminate it with a : and a null.  Note that
+	 * we are forcing the DString to contain an extra null at the end.
+	 */
+
+	Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
+	Tcl_DStringAppend(bufPtr, ":", 2);
+	p = macRootPatternPtr->endp[i];
+    } else {
+	isMac = (strchr(path, ':') != NULL);
+	p = path;
+    }
+    
+    if (isMac) {
+
+	/*
+	 * p is pointing at the first colon in the path.  There
+	 * will always be one, since this is a Mac-style path.
+	 */
+
+	elementStart = p++;
+	while ((p = strchr(p, ':')) != NULL) {
+	    length = p - elementStart;
+	    if (length == 1) {
+		while (*p == ':') {
+		    Tcl_DStringAppend(bufPtr, "::", 3);
+		    elementStart = p++;
+		}
+	    } else {
+		/*
+		 * If this is a simple component, drop the leading colon.
+		 */
+
+		if ((elementStart[1] != '~')
+			&& (strchr(elementStart+1, '/') == NULL)) {
+		    elementStart++;
+		    length--;
+		}
+		Tcl_DStringAppend(bufPtr, elementStart, length);
+		Tcl_DStringAppend(bufPtr, "", 1);
+		elementStart = p++;
+	    }
+	}
+	if (elementStart[1] != '\0' || elementStart == path) {
+	    if ((elementStart[1] != '~') && (elementStart[1] != '\0')
+			&& (strchr(elementStart+1, '/') == NULL)) {
+		    elementStart++;
+	    }
+	    Tcl_DStringAppend(bufPtr, elementStart, -1);
+	    Tcl_DStringAppend(bufPtr, "", 1);
+	}
+    } else {
+
+	/*
+	 * Split on slashes, suppress extra /'s, and convert .. to ::. 
+	 */
+
+	for (;;) {
+	    elementStart = p;
+	    while ((*p != '\0') && (*p != '/')) {
+		p++;
+	    }
+	    length = p - elementStart;
+	    if (length > 0) {
+		if ((length == 1) && (elementStart[0] == '.')) {
+		    Tcl_DStringAppend(bufPtr, ":", 2);
+		} else if ((length == 2) && (elementStart[0] == '.')
+			&& (elementStart[1] == '.')) {
+		    Tcl_DStringAppend(bufPtr, "::", 3);
+		} else {
+		    if (*elementStart == '~') {
+			Tcl_DStringAppend(bufPtr, ":", 1);
+		    }
+		    Tcl_DStringAppend(bufPtr, elementStart, length);
+		    Tcl_DStringAppend(bufPtr, "", 1);
+		}
+	    }
+	    if (*p++ == '\0') {
+		break;
+	    }
+	}
+    }
+    return Tcl_DStringValue(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_JoinPath --
+ *
+ *	Combine a list of paths in a platform specific manner.
+ *
+ * Results:
+ *	Appends the joined path to the end of the specified
+ *	returning a pointer to the resulting string.  Note that
+ *	the Tcl_DString must already be initialized.
+ *
+ * Side effects:
+ *	Modifies the Tcl_DString.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_JoinPath(argc, argv, resultPtr)
+    int argc;
+    char **argv;
+    Tcl_DString *resultPtr;	/* Pointer to previously initialized DString. */
+{
+    int oldLength, length, i, needsSep;
+    Tcl_DString buffer;
+    char *p, c, *dest;
+
+    Tcl_DStringInit(&buffer);
+    oldLength = Tcl_DStringLength(resultPtr);
+
+    switch (tclPlatform) {
+   	case TCL_PLATFORM_UNIX:
+	    for (i = 0; i < argc; i++) {
+		p = argv[i];
+		/*
+		 * If the path is absolute, reset the result buffer.
+		 * Consume any duplicate leading slashes or a ./ in
+		 * front of a tilde prefixed path that isn't at the
+		 * beginning of the path.
+		 */
+
+		if (*p == '/') {
+		    Tcl_DStringSetLength(resultPtr, oldLength);
+		    Tcl_DStringAppend(resultPtr, "/", 1);
+		    while (*p == '/') {
+			p++;
+		    }
+		} else if (*p == '~') {
+		    Tcl_DStringSetLength(resultPtr, oldLength);
+		} else if ((Tcl_DStringLength(resultPtr) != oldLength)
+			&& (p[0] == '.') && (p[1] == '/')
+			&& (p[2] == '~')) {
+		    p += 2;
+		}
+
+		if (*p == '\0') {
+		    continue;
+		}
+
+		/*
+		 * Append a separator if needed.
+		 */
+
+		length = Tcl_DStringLength(resultPtr);
+		if ((length != oldLength)
+			&& (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
+		    Tcl_DStringAppend(resultPtr, "/", 1);
+		    length++;
+		}
+
+		/*
+		 * Append the element, eliminating duplicate and trailing
+		 * slashes.
+		 */
+
+		Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
+		dest = Tcl_DStringValue(resultPtr) + length;
+		for (; *p != '\0'; p++) {
+		    if (*p == '/') {
+			while (p[1] == '/') {
+			    p++;
+			}
+			if (p[1] != '\0') {
+			    *dest++ = '/';
+			}
+		    } else {
+			*dest++ = *p;
+		    }
+		}
+		length = dest - Tcl_DStringValue(resultPtr);
+		Tcl_DStringSetLength(resultPtr, length);
+	    }
+	    break;
+
+	case TCL_PLATFORM_WINDOWS:
+	    /*
+	     * Iterate over all of the components.  If a component is
+	     * absolute, then reset the result and start building the
+	     * path from the current component on.
+	     */
+
+	    for (i = 0; i < argc; i++) {
+		p = ExtractWinRoot(argv[i], resultPtr, oldLength);
+		length = Tcl_DStringLength(resultPtr);
+		
+		/*
+		 * If the pointer didn't move, then this is a relative path
+		 * or a tilde prefixed path.
+		 */
+
+		if (p == argv[i]) {
+		    /*
+		     * Remove the ./ from tilde prefixed elements unless
+		     * it is the first component.
+		     */
+
+		    if ((length != oldLength)
+			    && (p[0] == '.')
+			    && ((p[1] == '/') || (p[1] == '\\'))
+			    && (p[2] == '~')) {
+			p += 2;
+		    } else if (*p == '~') {
+			Tcl_DStringSetLength(resultPtr, oldLength);
+			length = oldLength;
+		    }
+		}
+
+		if (*p != '\0') {
+		    /*
+		     * Check to see if we need to append a separator.
+		     */
+
+		    
+		    if (length != oldLength) {
+			c = Tcl_DStringValue(resultPtr)[length-1];
+			if ((c != '/') && (c != ':')) {
+			    Tcl_DStringAppend(resultPtr, "/", 1);
+			}
+		    }
+
+		    /*
+		     * Append the element, eliminating duplicate and
+		     * trailing slashes.
+		     */
+
+		    length = Tcl_DStringLength(resultPtr);
+		    Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
+		    dest = Tcl_DStringValue(resultPtr) + length;
+		    for (; *p != '\0'; p++) {
+			if ((*p == '/') || (*p == '\\')) {
+			    while ((p[1] == '/') || (p[1] == '\\')) {
+				p++;
+			    }
+			    if (p[1] != '\0') {
+				*dest++ = '/';
+			    }
+			} else {
+			    *dest++ = *p;
+			}
+		    }
+		    length = dest - Tcl_DStringValue(resultPtr);
+		    Tcl_DStringSetLength(resultPtr, length);
+		}
+	    }
+	    break;
+
+	case TCL_PLATFORM_MAC:
+	    needsSep = 1;
+	    for (i = 0; i < argc; i++) {
+		Tcl_DStringSetLength(&buffer, 0);
+		p = SplitMacPath(argv[i], &buffer);
+		if ((*p != ':') && (*p != '\0')
+			&& (strchr(p, ':') != NULL)) {
+		    Tcl_DStringSetLength(resultPtr, oldLength);
+		    length = strlen(p);
+		    Tcl_DStringAppend(resultPtr, p, length);
+		    needsSep = 0;
+		    p += length+1;
+		}
+
+		/*
+		 * Now append the rest of the path elements, skipping
+		 * : unless it is the first element of the path, and
+		 * watching out for :: et al. so we don't end up with
+		 * too many colons in the result.
+		 */
+
+		for (; *p != '\0'; p += length+1) {
+		    if (p[0] == ':' && p[1] == '\0') {
+			if (Tcl_DStringLength(resultPtr) != oldLength) {
+			    p++;
+			} else {
+			    needsSep = 0;
+			}
+		    } else {
+			c = p[1];
+			if (*p == ':') {
+			    if (!needsSep) {
+				p++;
+			    }
+			} else {
+			    if (needsSep) {
+				Tcl_DStringAppend(resultPtr, ":", 1);
+			    }
+			}
+			needsSep = (c == ':') ? 0 : 1;
+		    }
+		    length = strlen(p);
+		    Tcl_DStringAppend(resultPtr, p, length);
+		}
+	    }
+	    break;
+			       
+    }
+    Tcl_DStringFree(&buffer);
+    return Tcl_DStringValue(resultPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TranslateFileName --
+ *
+ *	Converts a file name into a form usable by the native system
+ *	interfaces.  If the name starts with a tilde, it will produce
+ *	a name where the tilde and following characters have been
+ *	replaced by the home directory location for the named user.
+ *
+ * Results:
+ *	The result is a pointer to a static string containing
+ *	the new name.  If there was an error in processing the
+ *	name, then an error message is left in interp->result
+ *	and the return value is NULL.  The result will be stored
+ *	in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
+ *	to free the name if the return value was not NULL.
+ *
+ * Side effects:
+ *	Information may be left in bufferPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_TranslateFileName(interp, name, bufferPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to store error
+				 * message (if necessary). */
+    char *name;			/* File name, which may begin with "~"
+				 * (to indicate current user's home directory)
+				 * or "~<user>" (to indicate any user's
+				 * home directory). */
+    Tcl_DString *bufferPtr;	/* May be used to hold result.  Must not hold
+				 * anything at the time of the call, and need
+				 * not even be initialized. */
+{
+    register char *p;
+
+    /*
+     * Handle tilde substitutions, if needed.
+     */
+
+    if (name[0] == '~') {
+	int argc, length;
+	char **argv;
+	Tcl_DString temp;
+
+	Tcl_SplitPath(name, &argc, &argv);
+	
+	/*
+	 * Strip the trailing ':' off of a Mac path
+	 * before passing the user name to DoTildeSubst.
+	 */
+
+	if (tclPlatform == TCL_PLATFORM_MAC) {
+	    length = strlen(argv[0]);
+	    argv[0][length-1] = '\0';
+	}
+	
+	Tcl_DStringInit(&temp);
+	argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
+	if (argv[0] == NULL) {
+	    Tcl_DStringFree(&temp);
+	    ckfree((char *)argv);
+	    return NULL;
+	}
+	Tcl_DStringInit(bufferPtr);
+	Tcl_JoinPath(argc, argv, bufferPtr);
+	Tcl_DStringFree(&temp);
+	ckfree((char*)argv);
+    } else {
+	Tcl_DStringInit(bufferPtr);
+	Tcl_JoinPath(1, &name, bufferPtr);
+    }
+
+    /*
+     * Convert forward slashes to backslashes in Windows paths because
+     * some system interfaces don't accept forward slashes.
+     */
+
+    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+	for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
+	    if (*p == '/') {
+		*p = '\\';
+	    }
+	}
+    }
+    return Tcl_DStringValue(bufferPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetExtension --
+ *
+ *	This function returns a pointer to the beginning of the
+ *	extension part of a file name.
+ *
+ * Results:
+ *	Returns a pointer into name which indicates where the extension
+ *	starts.  If there is no extension, returns NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetExtension(name)
+    char *name;			/* File name to parse. */
+{
+    char *p, *lastSep;
+
+    /*
+     * First find the last directory separator.
+     */
+
+    lastSep = NULL;		/* Needed only to prevent gcc warnings. */
+    switch (tclPlatform) {
+	case TCL_PLATFORM_UNIX:
+	    lastSep = strrchr(name, '/');
+	    break;
+
+	case TCL_PLATFORM_MAC:
+	    if (strchr(name, ':') == NULL) {
+		lastSep = strrchr(name, '/');
+	    } else {
+		lastSep = strrchr(name, ':');
+	    }
+	    break;
+
+	case TCL_PLATFORM_WINDOWS:
+	    lastSep = NULL;
+	    for (p = name; *p != '\0'; p++) {
+		if (strchr("/\\:", *p) != NULL) {
+		    lastSep = p;
+		}
+	    }
+	    break;
+    }
+    p = strrchr(name, '.');
+    if ((p != NULL) && (lastSep != NULL)
+	    && (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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoTildeSubst --
+ *
+ *	Given a string following a tilde, this routine returns the
+ *	corresponding home directory.
+ *
+ * Results:
+ *	The result is a pointer to a static string containing the home
+ *	directory in native format.  If there was an error in processing
+ *	the substitution, then an error message is left in interp->result
+ *	and the return value is NULL.  On success, the results are appended
+ * 	to resultPtr, and the contents of resultPtr are returned.
+ *
+ * Side effects:
+ *	Information may be left in resultPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+DoTildeSubst(interp, user, resultPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to store error
+				 * message (if necessary). */
+    char *user;			/* Name of user whose home directory should be
+				 * substituted, or "" for current user. */
+    Tcl_DString *resultPtr;	/* May be used to hold result.  Must not hold
+				 * anything at the time of the call, and need
+				 * not even be initialized. */
+{
+    char *dir;
+
+    if (*user == '\0') {
+	dir = TclGetEnv("HOME");
+	if (dir == NULL) {
+	    if (interp) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "couldn't find HOME environment ",
+			"variable to expand path", (char *) NULL);
+	    }
+	    return NULL;
+	}
+	Tcl_JoinPath(1, &dir, resultPtr);
+    } else {
+	
+	/* lint, TclGetuserHome() always NULL under windows. */
+	if (TclGetUserHome(user, resultPtr) == NULL) {	
+	    if (interp) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
+			(char *) NULL);
+	    }
+	    return NULL;
+	}
+    }
+    return resultPtr->string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobCmd --
+ *
+ *	This procedure is invoked to process the "glob" 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_GlobCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int i, noComplain, firstArg;
+    char c;
+    int result = TCL_OK;
+    Tcl_DString buffer;
+    char *separators, *head, *tail;
+
+    noComplain = 0;
+    for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
+	    firstArg++) {
+	if (strcmp(argv[firstArg], "-nocomplain") == 0) {
+	    noComplain = 1;
+	} else if (strcmp(argv[firstArg], "--") == 0) {
+	    firstArg++;
+	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
+		    "\": must be -nocomplain or --", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    if (firstArg >= argc) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ?switches? name ?name ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    Tcl_DStringInit(&buffer);
+    separators = NULL;		/* Needed only to prevent gcc warnings. */
+    for (i = firstArg; i < argc; i++) {
+	switch (tclPlatform) {
+	case TCL_PLATFORM_UNIX:
+	    separators = "/";
+	    break;
+	case TCL_PLATFORM_WINDOWS:
+	    separators = "/\\:";
+	    break;
+	case TCL_PLATFORM_MAC:
+	    separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
+	    break;
+	}
+
+	Tcl_DStringSetLength(&buffer, 0);
+
+	/*
+	 * Perform tilde substitution, if needed.
+	 */
+
+	if (argv[i][0] == '~') {
+	    char *p;
+
+	    /*
+	     * Find the first path separator after the tilde.
+	     */
+
+	    for (tail = argv[i]; *tail != '\0'; tail++) {
+		if (*tail == '\\') {
+		    if (strchr(separators, tail[1]) != NULL) {
+			break;
+		    }
+		} else if (strchr(separators, *tail) != NULL) {
+		    break;
+		}
+	    }
+
+	    /*
+	     * Determine the home directory for the specified user.  Note that
+	     * we don't allow special characters in the user name.
+	     */
+
+	    c = *tail;
+	    *tail = '\0';
+	    p = strpbrk(argv[i]+1, "\\[]*?{}");
+	    if (p == NULL) {
+		head = DoTildeSubst(interp, argv[i]+1, &buffer);
+	    } else {
+		if (!noComplain) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendResult(interp, "globbing characters not ",
+			    "supported in user names", (char *) NULL);
+		}
+		head = NULL;
+	    }
+	    *tail = c;
+	    if (head == NULL) {
+		if (noComplain) {
+		    Tcl_ResetResult(interp);
+		    continue;
+		} else {
+		    result = TCL_ERROR;
+		    goto done;
+		}
+	    }
+	    if (head != Tcl_DStringValue(&buffer)) {
+		Tcl_DStringAppend(&buffer, head, -1);
+	    }
+	} else {
+	    tail = argv[i];
+	}
+
+	result = TclDoGlob(interp, separators, &buffer, tail);
+	if (result != TCL_OK) {
+	    if (noComplain) {
+		/*
+		 * We should in fact pass down the nocomplain flag 
+		 * or save the interp result or use another mecanism
+		 * so the interp result is not mangled on errors in that case.
+		 * but that would a bigger change than reasonable for a patch
+		 * release.
+		 * (see fileName.test 15.2-15.4 for expected behaviour)
+		 */
+		Tcl_ResetResult(interp);
+		result = TCL_OK;
+		continue;
+	    } else {
+		goto done;
+	    }
+	}
+    }
+
+    if ((*interp->result == 0) && !noComplain) {
+	char *sep = "";
+
+	Tcl_AppendResult(interp, "no files matched glob pattern",
+		(argc == 2) ? " \"" : "s \"", (char *) NULL);
+	for (i = firstArg; i < argc; i++) {
+	    Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
+	    sep = " ";
+	}
+	Tcl_AppendResult(interp, "\"", (char *) NULL);
+	result = TCL_ERROR;
+    }
+done:
+    Tcl_DStringFree(&buffer);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SkipToChar --
+ *
+ *	This function traverses a glob pattern looking for the next
+ *	unquoted occurance of the specified character at the same braces
+ *	nesting level.
+ *
+ * Results:
+ *	Updates stringPtr to point to the matching character, or to
+ *	the end of the string if nothing matched.  The return value
+ *	is 1 if a match was found at the top level, otherwise it is 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SkipToChar(stringPtr, match)
+    char **stringPtr;			/* Pointer string to check. */
+    char *match;			/* Pointer to character to find. */
+{
+    int quoted, level;
+    register char *p;
+
+    quoted = 0;
+    level = 0;
+
+    for (p = *stringPtr; *p != '\0'; p++) {
+	if (quoted) {
+	    quoted = 0;
+	    continue;
+	}
+	if ((level == 0) && (*p == *match)) {
+	    *stringPtr = p;
+	    return 1;
+	}
+	if (*p == '{') {
+	    level++;
+	} else if (*p == '}') {
+	    level--;
+	} else if (*p == '\\') {
+	    quoted = 1;
+	}
+    }
+    *stringPtr = p;
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDoGlob --
+ *
+ *	This recursive procedure forms the heart of the globbing
+ *	code.  It performs a depth-first traversal of the tree
+ *	given by the path name to be globbed.  The directory and
+ *	remainder are assumed to be native format paths.
+ *
+ * Results:
+ *	The return value is a standard Tcl result indicating whether
+ *	an error occurred in globbing.  After a normal return the
+ *	result in interp will be set to hold all of the file names
+ *	given by the dir and rem arguments.  After an error the
+ *	result in interp will hold an error message.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclDoGlob(interp, separators, headPtr, tail)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting
+				 * (e.g. unmatched brace). */
+    char *separators;		/* String containing separator characters
+				 * that should be used to identify globbing
+				 * boundaries. */
+    Tcl_DString *headPtr;	/* Completely expanded prefix. */
+    char *tail;			/* The unexpanded remainder of the path. */
+{
+    int baseLength, quoted, count;
+    int result = TCL_OK;
+    char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
+    char lastChar = 0;
+    int length = Tcl_DStringLength(headPtr);
+
+    if (length > 0) {
+	lastChar = Tcl_DStringValue(headPtr)[length-1];
+    }
+
+    /*
+     * Consume any leading directory separators, leaving tail pointing
+     * just past the last initial separator.
+     */
+
+    count = 0;
+    name = tail;
+    for (; *tail != '\0'; tail++) {
+	if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
+	    tail++;
+	} else if (strchr(separators, *tail) == NULL) {
+	    break;
+	}
+	count++;
+    }
+
+    /*
+     * Deal with path separators.  On the Mac, we have to watch out
+     * for multiple separators, since they are special in Mac-style
+     * paths.
+     */
+
+    switch (tclPlatform) {
+	case TCL_PLATFORM_MAC:
+	    if (*separators == '/') {
+		if (((length == 0) && (count == 0))
+			|| ((length > 0) && (lastChar != ':'))) {
+		    Tcl_DStringAppend(headPtr, ":", 1);
+		}
+	    } else {
+		if (count == 0) {
+		    if ((length > 0) && (lastChar != ':')) {
+			Tcl_DStringAppend(headPtr, ":", 1);
+		    }
+		} else {
+		    if (lastChar == ':') {
+			count--;
+		    }
+		    while (count-- > 0) {
+			Tcl_DStringAppend(headPtr, ":", 1);
+		    }
+		}
+	    }
+	    break;
+	case TCL_PLATFORM_WINDOWS:
+	    /*
+	     * If this is a drive relative path, add the colon and the
+	     * trailing slash if needed.  Otherwise add the slash if
+	     * this is the first absolute element, or a later relative
+	     * element.  Add an extra slash if this is a UNC path.
+	     */
+
+	    if (*name == ':') {
+		Tcl_DStringAppend(headPtr, ":", 1);
+		if (count > 1) {
+		    Tcl_DStringAppend(headPtr, "/", 1);
+		}
+	    } else if ((*tail != '\0')
+		    && (((length > 0)
+			    && (strchr(separators, lastChar) == NULL))
+			    || ((length == 0) && (count > 0)))) {
+		Tcl_DStringAppend(headPtr, "/", 1);
+		if ((length == 0) && (count > 1)) {
+		    Tcl_DStringAppend(headPtr, "/", 1);
+		}
+	    }
+	    
+	    break;
+	case TCL_PLATFORM_UNIX:
+	    /*
+	     * Add a separator if this is the first absolute element, or
+	     * a later relative element.
+	     */
+
+	    if ((*tail != '\0')
+		    && (((length > 0)
+			    && (strchr(separators, lastChar) == NULL))
+			    || ((length == 0) && (count > 0)))) {
+		Tcl_DStringAppend(headPtr, "/", 1);
+	    }
+	    break;
+    }
+
+    /*
+     * Look for the first matching pair of braces or the first
+     * directory separator that is not inside a pair of braces.
+     */
+
+    openBrace = closeBrace = NULL;
+    quoted = 0;
+    for (p = tail; *p != '\0'; p++) {
+	if (quoted) {
+	    quoted = 0;
+	} else if (*p == '\\') {
+	    quoted = 1;
+	    if (strchr(separators, p[1]) != NULL) {
+		break;			/* Quoted directory separator. */
+	    }
+	} else if (strchr(separators, *p) != NULL) {
+	    break;			/* Unquoted directory separator. */
+	} else if (*p == '{') {
+	    openBrace = p;
+	    p++;
+	    if (SkipToChar(&p, "}")) {
+		closeBrace = p;		/* Balanced braces. */
+		break;
+	    }
+	    Tcl_SetResult(interp, "unmatched open-brace in file name",
+		    TCL_STATIC);
+	    return TCL_ERROR;
+	} else if (*p == '}') {
+	    Tcl_SetResult(interp, "unmatched close-brace in file name",
+		    TCL_STATIC);
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Substitute the alternate patterns from the braces and recurse.
+     */
+
+    if (openBrace != NULL) {
+	char *element;
+	Tcl_DString newName;
+	Tcl_DStringInit(&newName);
+
+	/*
+	 * For each element within in the outermost pair of braces,
+	 * append the element and the remainder to the fixed portion
+	 * before the first brace and recursively call TclDoGlob.
+	 */
+
+	Tcl_DStringAppend(&newName, tail, openBrace-tail);
+	baseLength = Tcl_DStringLength(&newName);
+	length = Tcl_DStringLength(headPtr);
+	*closeBrace = '\0';
+	for (p = openBrace; p != closeBrace; ) {
+	    p++;
+	    element = p;
+	    SkipToChar(&p, ",");
+	    Tcl_DStringSetLength(headPtr, length);
+	    Tcl_DStringSetLength(&newName, baseLength);
+	    Tcl_DStringAppend(&newName, element, p-element);
+	    Tcl_DStringAppend(&newName, closeBrace+1, -1);
+	    result = TclDoGlob(interp, separators,
+		    headPtr, Tcl_DStringValue(&newName));
+	    if (result != TCL_OK) {
+		break;
+	    }
+	}
+	*closeBrace = '}';
+	Tcl_DStringFree(&newName);
+	return result;
+    }
+
+    /*
+     * At this point, there are no more brace substitutions to perform on
+     * 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.
+     */
+
+    if (*p != '\0') {
+	 savedChar = *p;
+	 *p = '\0';
+	 firstSpecialChar = strpbrk(tail, "*[]?\\");
+	 *p = savedChar;
+    } else {
+	firstSpecialChar = strpbrk(tail, "*[]?\\");
+    }
+
+    if (firstSpecialChar != NULL) {
+	/*
+	 * Look for matching files in the current directory.  The
+	 * implementation of this function is platform specific, but may
+	 * recursively call TclDoGlob.  For each file that matches, it will
+	 * add the match onto the interp->result, or call TclDoGlob if there
+	 * are more characters to be processed.
+	 */
+
+	return TclMatchFiles(interp, separators, headPtr, tail, p);
+    }
+    Tcl_DStringAppend(headPtr, tail, p-tail);
+    if (*p != '\0') {
+	return TclDoGlob(interp, separators, headPtr, p);
+    }
+
+    /*
+     * There are no more wildcards in the pattern and no more unprocessed
+     * characters in the tail, so now we can construct the path and verify
+     * the existence of the file.
+     */
+
+    switch (tclPlatform) {
+	case TCL_PLATFORM_MAC:
+	    if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
+		Tcl_DStringAppend(headPtr, ":", 1);
+	    }
+	    name = Tcl_DStringValue(headPtr);
+	    if (TclAccess(name, F_OK) == 0) {
+		if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
+		    Tcl_AppendElement(interp, name+1);
+		} else {
+		    Tcl_AppendElement(interp, name);
+		}
+	    }
+	    break;
+	case TCL_PLATFORM_WINDOWS: {
+	    int exists;
+	    /*
+	     * We need to convert slashes to backslashes before checking
+	     * for the existence of the file.  Once we are done, we need
+	     * to convert the slashes back.
+	     */
+
+	    if (Tcl_DStringLength(headPtr) == 0) {
+		if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
+			|| (*name == '/')) {
+		    Tcl_DStringAppend(headPtr, "\\", 1);
+		} else {
+		    Tcl_DStringAppend(headPtr, ".", 1);
+		}
+	    } else {
+		for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
+		    if (*p == '/') {
+			*p = '\\';
+		    }
+		}
+	    }
+	    name = Tcl_DStringValue(headPtr);
+	    exists = (TclAccess(name, F_OK) == 0);
+	    for (p = name; *p != '\0'; p++) {
+		if (*p == '\\') {
+		    *p = '/';
+		}
+	    }
+	    if (exists) {
+		Tcl_AppendElement(interp, name);
+	    }
+	    break;
+	}
+	case TCL_PLATFORM_UNIX:
+	    if (Tcl_DStringLength(headPtr) == 0) {
+		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
+		    Tcl_DStringAppend(headPtr, "/", 1);
+		} else {
+		    Tcl_DStringAppend(headPtr, ".", 1);
+		}
+	    }
+	    name = Tcl_DStringValue(headPtr);
+	    if (TclAccess(name, F_OK) == 0) {
+		Tcl_AppendElement(interp, name);
+	    }
+	    break;
+    }
+
+    return TCL_OK;
+}
diff --git a/tcl/generic/tclGet.c b/tcl/generic/tclGet.c
new file mode 100644
index 00000000000..e426cf59df9
--- /dev/null
+++ b/tcl/generic/tclGet.c
@@ -0,0 +1,328 @@
+/* 
+ * tclGet.c --
+ *
+ *	This file contains procedures to convert strings into
+ *	other forms, like integers or floating-point numbers or
+ *	booleans, doing syntax checking along the way.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetInt --
+ *
+ *	Given a string, produce the corresponding integer value.
+ *
+ * Results:
+ *	The return value is normally TCL_OK;  in this case *intPtr
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetInt(interp, string, intPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
+    char *string;		/* String containing a (possibly signed)
+				 * integer in a form acceptable to strtol. */
+    int *intPtr;		/* Place to store converted result. */
+{
+    char *end, *p;
+    long i;
+
+    /*
+     * 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++;
+	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++;
+	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;
+    }
+    if (errno == ERANGE) {
+        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;
+    }
+    *longPtr = i;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetDouble --
+ *
+ *	Given a string, produce the corresponding double-precision
+ *	floating-point value.
+ *
+ * Results:
+ *	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.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetDouble(interp, string, doublePtr)
+    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. */
+{
+    char *end;
+    double d;
+
+    errno = 0;
+    d = strtod(string, &end);
+    if (end == string) {
+	badDouble:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp,
+                    "expected floating-point number but got \"",
+                    string, "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    if (errno != 0) {
+        if (interp != (Tcl_Interp *) NULL) {
+            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;
+    }
+    while ((*end != 0) && isspace(UCHAR(*end))) {
+	end++;
+    }
+    if (*end != 0) {
+	goto badDouble;
+    }
+    *doublePtr = d;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetBoolean --
+ *
+ *	Given a string, return a 0/1 boolean value corresponding
+ *	to the string.
+ *
+ * Results:
+ *	The return value is normally TCL_OK;  in this case *boolPtr
+ *	will be set to the 0/1 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
+Tcl_GetBoolean(interp, string, boolPtr)
+    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. */
+    int *boolPtr;		/* Place to store converted result, which
+				 * will be 0 or 1. */
+{
+    int i;
+    char lowerCase[10], c;
+    size_t length;
+
+    /*
+     * Convert the input string to all lower-case.
+     */
+
+    for (i = 0; i < 9; i++) {
+	c = string[i];
+	if (c == 0) {
+	    break;
+	}
+	if ((c >= 'A') && (c <= 'Z')) {
+	    c += (char) ('a' - 'A');
+	}
+	lowerCase[i] = c;
+    }
+    lowerCase[i] = 0;
+
+    length = strlen(lowerCase);
+    c = lowerCase[0];
+    if ((c == '0') && (lowerCase[1] == '\0')) {
+	*boolPtr = 0;
+    } else if ((c == '1') && (lowerCase[1] == '\0')) {
+	*boolPtr = 1;
+    } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
+	*boolPtr = 1;
+    } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
+	*boolPtr = 0;
+    } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
+	*boolPtr = 1;
+    } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
+	*boolPtr = 0;
+    } else if ((c == 'o') && (length >= 2)) {
+	if (strncmp(lowerCase, "on", length) == 0) {
+	    *boolPtr = 1;
+	} else if (strncmp(lowerCase, "off", length) == 0) {
+	    *boolPtr = 0;
+	} else {
+	    goto badBoolean;
+	}
+    } else {
+	badBoolean:
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "expected boolean value but got \"",
+                    string, "\"", (char *) NULL);
+        }
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
diff --git a/tcl/generic/tclGetDate.y b/tcl/generic/tclGetDate.y
new file mode 100644
index 00000000000..f8b6ca29eab
--- /dev/null
+++ b/tcl/generic/tclGetDate.y
@@ -0,0 +1,958 @@
+/* 
+ * tclGetDate.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-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+%{
+/* 
+ * tclDate.c --
+ *
+ *	This file is generated from a yacc grammar defined in
+ *	the file tclGetDate.y.  It should not be edited directly.
+ *
+ * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
+ * 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.
+ *
+ * SCCSID
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef MAC_TCL
+#   define EPOCH           1904
+#   define START_OF_TIME   1904
+#   define END_OF_TIME     2039
+#else
+#   define EPOCH           1970
+#   define START_OF_TIME   1902
+#   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)
+
+
+/*
+ *  An entry in the lexical lookup table.
+ */
+typedef struct _TABLE {
+    char        *name;
+    int         type;
+    time_t      value;
+} TABLE;
+
+
+/*
+ *  Daylight-savings mode:  on, off, or not yet known.
+ */
+typedef enum _DSTMODE {
+    DSTon, DSToff, DSTmaybe
+} DSTMODE;
+
+/*
+ *  Meridian:  am, pm, or 24-hour style.
+ */
+typedef enum _MERIDIAN {
+    MERam, MERpm, MER24
+} MERIDIAN;
+
+
+/*
+ *  Global variables.  We could get rid of most of these by using a good
+ *  union as the yacc stack.  (This routine was originally written before
+ *  yacc had the %union construct.)  Maybe someday; right now we only use
+ *  the %union very rarely.
+ */
+static char     *yyInput;
+static DSTMODE  yyDSTmode;
+static time_t   yyDayOrdinal;
+static time_t   yyDayNumber;
+static int      yyHaveDate;
+static int      yyHaveDay;
+static int      yyHaveRel;
+static int      yyHaveTime;
+static int      yyHaveZone;
+static time_t   yyTimezone;
+static time_t   yyDay;
+static time_t   yyHour;
+static time_t   yyMinutes;
+static time_t   yyMonth;
+static time_t   yySeconds;
+static time_t   yyYear;
+static MERIDIAN yyMeridian;
+static time_t   yyRelMonth;
+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));
+
+int
+yyparse _ANSI_ARGS_((void));
+%}
+
+%union {
+    time_t              Number;
+    enum _MERIDIAN      Meridian;
+}
+
+%token  tAGO tDAY tDAYZONE tID tMERIDIAN tMINUTE_UNIT tMONTH tMONTH_UNIT
+%token  tSEC_UNIT tSNUMBER tUNUMBER tZONE tEPOCH tDST
+
+%type   <Number>        tDAY tDAYZONE tMINUTE_UNIT tMONTH tMONTH_UNIT tDST
+%type   <Number>        tSEC_UNIT tSNUMBER tUNUMBER tZONE
+%type   <Meridian>      tMERIDIAN o_merid
+
+%%
+
+spec    : /* NULL */
+        | spec item
+        ;
+
+item    : time {
+            yyHaveTime++;
+        }
+        | zone {
+            yyHaveZone++;
+        }
+        | date {
+            yyHaveDate++;
+        }
+        | day {
+            yyHaveDay++;
+        }
+        | rel {
+            yyHaveRel++;
+        }
+        | number
+        ;
+
+time    : tUNUMBER tMERIDIAN {
+            yyHour = $1;
+            yyMinutes = 0;
+            yySeconds = 0;
+            yyMeridian = $2;
+        }
+        | tUNUMBER ':' tUNUMBER o_merid {
+            yyHour = $1;
+            yyMinutes = $3;
+            yySeconds = 0;
+            yyMeridian = $4;
+        }
+        | tUNUMBER ':' tUNUMBER tSNUMBER {
+            yyHour = $1;
+            yyMinutes = $3;
+            yyMeridian = MER24;
+            yyDSTmode = DSToff;
+            yyTimezone = - ($4 % 100 + ($4 / 100) * 60);
+        }
+        | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
+            yyHour = $1;
+            yyMinutes = $3;
+            yySeconds = $5;
+            yyMeridian = $6;
+        }
+        | tUNUMBER ':' tUNUMBER ':' tUNUMBER tSNUMBER {
+            yyHour = $1;
+            yyMinutes = $3;
+            yySeconds = $5;
+            yyMeridian = MER24;
+            yyDSTmode = DSToff;
+            yyTimezone = - ($6 % 100 + ($6 / 100) * 60);
+        }
+        ;
+
+zone    : tZONE tDST {
+            yyTimezone = $1;
+            yyDSTmode = DSTon;
+        }
+        | tZONE {
+            yyTimezone = $1;
+            yyDSTmode = DSToff;
+        }
+        | tDAYZONE {
+            yyTimezone = $1;
+            yyDSTmode = DSTon;
+        }
+        ;
+
+day     : tDAY {
+            yyDayOrdinal = 1;
+            yyDayNumber = $1;
+        }
+        | tDAY ',' {
+            yyDayOrdinal = 1;
+            yyDayNumber = $1;
+        }
+        | tUNUMBER tDAY {
+            yyDayOrdinal = $1;
+            yyDayNumber = $2;
+        }
+        ;
+
+date    : tUNUMBER '/' tUNUMBER {
+            yyMonth = $1;
+            yyDay = $3;
+        }
+        | tUNUMBER '/' tUNUMBER '/' tUNUMBER {
+            yyMonth = $1;
+            yyDay = $3;
+            yyYear = $5;
+        }
+        | tMONTH tUNUMBER {
+            yyMonth = $1;
+            yyDay = $2;
+        }
+        | tMONTH tUNUMBER ',' tUNUMBER {
+            yyMonth = $1;
+            yyDay = $2;
+            yyYear = $4;
+        }
+        | tUNUMBER tMONTH {
+            yyMonth = $2;
+            yyDay = $1;
+        }
+		  | tEPOCH {
+				yyMonth = 1;
+				yyDay = 1;
+				yyYear = EPOCH;
+		  }
+        | tUNUMBER tMONTH tUNUMBER {
+            yyMonth = $2;
+            yyDay = $1;
+            yyYear = $3;
+        }
+        ;
+
+rel     : relunit tAGO {
+            yyRelSeconds = -yyRelSeconds;
+            yyRelMonth = -yyRelMonth;
+        }
+        | relunit
+        ;
+
+relunit : tUNUMBER tMINUTE_UNIT {
+            yyRelSeconds += $1 * $2 * 60L;
+        }
+        | tSNUMBER tMINUTE_UNIT {
+            yyRelSeconds += $1 * $2 * 60L;
+        }
+        | tMINUTE_UNIT {
+            yyRelSeconds += $1 * 60L;
+        }
+        | tSNUMBER tSEC_UNIT {
+            yyRelSeconds += $1;
+        }
+        | tUNUMBER tSEC_UNIT {
+            yyRelSeconds += $1;
+        }
+        | tSEC_UNIT {
+            yyRelSeconds++;
+        }
+        | tSNUMBER tMONTH_UNIT {
+            yyRelMonth += $1 * $2;
+        }
+        | tUNUMBER tMONTH_UNIT {
+            yyRelMonth += $1 * $2;
+        }
+        | tMONTH_UNIT {
+            yyRelMonth += $1;
+        }
+        ;
+
+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;
+        }
+        | tMERIDIAN {
+            $$ = $1;
+        }
+        ;
+
+%%
+
+/*
+ * Month and day table.
+ */
+static TABLE    MonthDayTable[] = {
+    { "january",        tMONTH,  1 },
+    { "february",       tMONTH,  2 },
+    { "march",          tMONTH,  3 },
+    { "april",          tMONTH,  4 },
+    { "may",            tMONTH,  5 },
+    { "june",           tMONTH,  6 },
+    { "july",           tMONTH,  7 },
+    { "august",         tMONTH,  8 },
+    { "september",      tMONTH,  9 },
+    { "sept",           tMONTH,  9 },
+    { "october",        tMONTH, 10 },
+    { "november",       tMONTH, 11 },
+    { "december",       tMONTH, 12 },
+    { "sunday",         tDAY, 0 },
+    { "monday",         tDAY, 1 },
+    { "tuesday",        tDAY, 2 },
+    { "tues",           tDAY, 2 },
+    { "wednesday",      tDAY, 3 },
+    { "wednes",         tDAY, 3 },
+    { "thursday",       tDAY, 4 },
+    { "thur",           tDAY, 4 },
+    { "thurs",          tDAY, 4 },
+    { "friday",         tDAY, 5 },
+    { "saturday",       tDAY, 6 },
+    { NULL }
+};
+
+/*
+ * Time units table.
+ */
+static TABLE    UnitsTable[] = {
+    { "year",           tMONTH_UNIT,    12 },
+    { "month",          tMONTH_UNIT,    1 },
+    { "fortnight",      tMINUTE_UNIT,   14 * 24 * 60 },
+    { "week",           tMINUTE_UNIT,   7 * 24 * 60 },
+    { "day",            tMINUTE_UNIT,   1 * 24 * 60 },
+    { "hour",           tMINUTE_UNIT,   60 },
+    { "minute",         tMINUTE_UNIT,   1 },
+    { "min",            tMINUTE_UNIT,   1 },
+    { "second",         tSEC_UNIT,      1 },
+    { "sec",            tSEC_UNIT,      1 },
+    { NULL }
+};
+
+/*
+ * Assorted relative-time words.
+ */
+static TABLE    OtherTable[] = {
+    { "tomorrow",       tMINUTE_UNIT,   1 * 24 * 60 },
+    { "yesterday",      tMINUTE_UNIT,   -1 * 24 * 60 },
+    { "today",          tMINUTE_UNIT,   0 },
+    { "now",            tMINUTE_UNIT,   0 },
+    { "last",           tUNUMBER,       -1 },
+    { "this",           tMINUTE_UNIT,   0 },
+    { "next",           tUNUMBER,       2 },
+#if 0
+    { "first",          tUNUMBER,       1 },
+/*  { "second",         tUNUMBER,       2 }, */
+    { "third",          tUNUMBER,       3 },
+    { "fourth",         tUNUMBER,       4 },
+    { "fifth",          tUNUMBER,       5 },
+    { "sixth",          tUNUMBER,       6 },
+    { "seventh",        tUNUMBER,       7 },
+    { "eighth",         tUNUMBER,       8 },
+    { "ninth",          tUNUMBER,       9 },
+    { "tenth",          tUNUMBER,       10 },
+    { "eleventh",       tUNUMBER,       11 },
+    { "twelfth",        tUNUMBER,       12 },
+#endif
+    { "ago",            tAGO,   1 },
+    { "epoch",          tEPOCH,   0 },
+    { NULL }
+};
+
+/*
+ * The timezone table.  (Note: This table was modified to not use any floating
+ * point constants to work around an SGI compiler bug).
+ */
+static TABLE    TimezoneTable[] = {
+    { "gmt",    tZONE,     HOUR( 0) },      /* Greenwich Mean */
+    { "ut",     tZONE,     HOUR( 0) },      /* Universal (Coordinated) */
+    { "utc",    tZONE,     HOUR( 0) },
+    { "wet",    tZONE,     HOUR( 0) } ,     /* Western European */
+    { "bst",    tDAYZONE,  HOUR( 0) },      /* British Summer */
+    { "wat",    tZONE,     HOUR( 1) },      /* West Africa */
+    { "at",     tZONE,     HOUR( 2) },      /* Azores */
+#if     0
+    /* For completeness.  BST is also British Summer, and GST is
+     * also Guam Standard. */
+    { "bst",    tZONE,     HOUR( 3) },      /* Brazil Standard */
+    { "gst",    tZONE,     HOUR( 3) },      /* Greenland Standard */
+#endif
+    { "nft",    tZONE,     HOUR( 7/2) },    /* Newfoundland */
+    { "nst",    tZONE,     HOUR( 7/2) },    /* Newfoundland Standard */
+    { "ndt",    tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
+    { "ast",    tZONE,     HOUR( 4) },      /* Atlantic Standard */
+    { "adt",    tDAYZONE,  HOUR( 4) },      /* Atlantic Daylight */
+    { "est",    tZONE,     HOUR( 5) },      /* Eastern Standard */
+    { "edt",    tDAYZONE,  HOUR( 5) },      /* Eastern Daylight */
+    { "cst",    tZONE,     HOUR( 6) },      /* Central Standard */
+    { "cdt",    tDAYZONE,  HOUR( 6) },      /* Central Daylight */
+    { "mst",    tZONE,     HOUR( 7) },      /* Mountain Standard */
+    { "mdt",    tDAYZONE,  HOUR( 7) },      /* Mountain Daylight */
+    { "pst",    tZONE,     HOUR( 8) },      /* Pacific Standard */
+    { "pdt",    tDAYZONE,  HOUR( 8) },      /* Pacific Daylight */
+    { "yst",    tZONE,     HOUR( 9) },      /* Yukon Standard */
+    { "ydt",    tDAYZONE,  HOUR( 9) },      /* Yukon Daylight */
+    { "hst",    tZONE,     HOUR(10) },      /* Hawaii Standard */
+    { "hdt",    tDAYZONE,  HOUR(10) },      /* Hawaii Daylight */
+    { "cat",    tZONE,     HOUR(10) },      /* Central Alaska */
+    { "ahst",   tZONE,     HOUR(10) },      /* Alaska-Hawaii Standard */
+    { "nt",     tZONE,     HOUR(11) },      /* Nome */
+    { "idlw",   tZONE,     HOUR(12) },      /* International Date Line West */
+    { "cet",    tZONE,    -HOUR( 1) },      /* Central European */
+    { "met",    tZONE,    -HOUR( 1) },      /* Middle European */
+    { "mewt",   tZONE,    -HOUR( 1) },      /* Middle European Winter */
+    { "mest",   tDAYZONE, -HOUR( 1) },      /* Middle European Summer */
+    { "swt",    tZONE,    -HOUR( 1) },      /* Swedish Winter */
+    { "sst",    tDAYZONE, -HOUR( 1) },      /* Swedish Summer */
+    { "fwt",    tZONE,    -HOUR( 1) },      /* French Winter */
+    { "fst",    tDAYZONE, -HOUR( 1) },      /* French Summer */
+    { "eet",    tZONE,    -HOUR( 2) },      /* Eastern Europe, USSR Zone 1 */
+    { "bt",     tZONE,    -HOUR( 3) },      /* Baghdad, USSR Zone 2 */
+    { "it",     tZONE,    -HOUR( 7/2) },    /* Iran */
+    { "zp4",    tZONE,    -HOUR( 4) },      /* USSR Zone 3 */
+    { "zp5",    tZONE,    -HOUR( 5) },      /* USSR Zone 4 */
+    { "ist",    tZONE,    -HOUR(11/2) },    /* Indian Standard */
+    { "zp6",    tZONE,    -HOUR( 6) },      /* USSR Zone 5 */
+#if     0
+    /* For completeness.  NST is also Newfoundland Stanard, nad SST is
+     * also Swedish Summer. */
+    { "nst",    tZONE,    -HOUR(13/2) },    /* North Sumatra */
+    { "sst",    tZONE,    -HOUR( 7) },      /* South Sumatra, USSR Zone 6 */
+#endif  /* 0 */
+    { "wast",   tZONE,    -HOUR( 7) },      /* West Australian Standard */
+    { "wadt",   tDAYZONE, -HOUR( 7) },      /* West Australian Daylight */
+    { "jt",     tZONE,    -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
+    { "cct",    tZONE,    -HOUR( 8) },      /* China Coast, USSR Zone 7 */
+    { "jst",    tZONE,    -HOUR( 9) },      /* Japan Standard, USSR Zone 8 */
+    { "cast",   tZONE,    -HOUR(19/2) },    /* Central Australian Standard */
+    { "cadt",   tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
+    { "east",   tZONE,    -HOUR(10) },      /* Eastern Australian Standard */
+    { "eadt",   tDAYZONE, -HOUR(10) },      /* Eastern Australian Daylight */
+    { "gst",    tZONE,    -HOUR(10) },      /* Guam Standard, USSR Zone 9 */
+    { "nzt",    tZONE,    -HOUR(12) },      /* New Zealand */
+    { "nzst",   tZONE,    -HOUR(12) },      /* New Zealand Standard */
+    { "nzdt",   tDAYZONE, -HOUR(12) },      /* New Zealand Daylight */
+    { "idle",   tZONE,    -HOUR(12) },      /* International Date Line East */
+    /* ADDED BY Marco Nijdam */
+    { "dst",    tDST,     HOUR( 0) },       /* DST on (hour is ignored) */
+    /* End ADDED */
+    {  NULL  }
+};
+
+/*
+ * Military timezone table.
+ */
+static TABLE    MilitaryTable[] = {
+    { "a",      tZONE,  HOUR(  1) },
+    { "b",      tZONE,  HOUR(  2) },
+    { "c",      tZONE,  HOUR(  3) },
+    { "d",      tZONE,  HOUR(  4) },
+    { "e",      tZONE,  HOUR(  5) },
+    { "f",      tZONE,  HOUR(  6) },
+    { "g",      tZONE,  HOUR(  7) },
+    { "h",      tZONE,  HOUR(  8) },
+    { "i",      tZONE,  HOUR(  9) },
+    { "k",      tZONE,  HOUR( 10) },
+    { "l",      tZONE,  HOUR( 11) },
+    { "m",      tZONE,  HOUR( 12) },
+    { "n",      tZONE,  HOUR(- 1) },
+    { "o",      tZONE,  HOUR(- 2) },
+    { "p",      tZONE,  HOUR(- 3) },
+    { "q",      tZONE,  HOUR(- 4) },
+    { "r",      tZONE,  HOUR(- 5) },
+    { "s",      tZONE,  HOUR(- 6) },
+    { "t",      tZONE,  HOUR(- 7) },
+    { "u",      tZONE,  HOUR(- 8) },
+    { "v",      tZONE,  HOUR(- 9) },
+    { "w",      tZONE,  HOUR(-10) },
+    { "x",      tZONE,  HOUR(-11) },
+    { "y",      tZONE,  HOUR(-12) },
+    { "z",      tZONE,  HOUR(  0) },
+    { NULL }
+};
+
+
+/*
+ * Dump error messages in the bit bucket.
+ */
+static void
+yyerror(s)
+    char  *s;
+{
+}
+
+
+static time_t
+ToSeconds(Hours, Minutes, Seconds, Meridian)
+    time_t      Hours;
+    time_t      Minutes;
+    time_t      Seconds;
+    MERIDIAN    Meridian;
+{
+    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
+        return -1;
+    switch (Meridian) {
+    case MER24:
+        if (Hours < 0 || Hours > 23)
+            return -1;
+        return (Hours * 60L + Minutes) * 60L + Seconds;
+    case MERam:
+        if (Hours < 1 || Hours > 12)
+            return -1;
+        return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
+    case MERpm:
+        if (Hours < 1 || Hours > 12)
+            return -1;
+        return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
+    }
+    return -1;  /* Should never be reached */
+}
+
+
+static int
+Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
+    time_t      Month;
+    time_t      Day;
+    time_t      Year;
+    time_t      Hours;
+    time_t      Minutes;
+    time_t      Seconds;
+    MERIDIAN    Meridian;
+    DSTMODE     DSTmode;
+    time_t     *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;
+
+    DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0)
+                    ? 29 : 28;
+    if (Month < 1 || Month > 12
+     || Year < START_OF_TIME || Year > END_OF_TIME
+     || Day < 1 || Day > DaysInMonth[(int)--Month])
+        return -1;
+
+    for (Julian = Day - 1, i = 0; i < Month; i++)
+        Julian += DaysInMonth[i];
+    if (Year >= EPOCH) {
+        for (i = EPOCH; i < Year; i++)
+            Julian += 365 + (i % 4 == 0);
+    } else {
+        for (i = Year; i < EPOCH; i++)
+            Julian -= 365 + (i % 4 == 0);
+    }
+    Julian *= SECSPERDAY;
+    Julian += yyTimezone * 60L;
+    if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
+        return -1;
+    Julian += tod;
+    if (DSTmode == DSTon
+     || (DSTmode == DSTmaybe && TclpGetDate(&Julian, 0)->tm_isdst))
+        Julian -= 60 * 60;
+    *TimePtr = Julian;
+    return 0;
+}
+
+
+static time_t
+DSTcorrect(Start, Future)
+    time_t      Start;
+    time_t      Future;
+{
+    time_t      StartDay;
+    time_t      FutureDay;
+
+    StartDay = (TclpGetDate(&Start, 0)->tm_hour + 1) % 24;
+    FutureDay = (TclpGetDate(&Future, 0)->tm_hour + 1) % 24;
+    return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
+}
+
+
+static time_t
+RelativeDate(Start, DayOrdinal, DayNumber)
+    time_t      Start;
+    time_t      DayOrdinal;
+    time_t      DayNumber;
+{
+    struct tm   *tm;
+    time_t      now;
+
+    now = Start;
+    tm = TclpGetDate(&now, 0);
+    now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
+    now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
+    return DSTcorrect(Start, now);
+}
+
+
+static int
+RelativeMonth(Start, RelMonth, TimePtr)
+    time_t Start;
+    time_t RelMonth;
+    time_t *TimePtr;
+{
+    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_YEAR_BASE) + tm->tm_mon + RelMonth;
+    Year = Month / 12;
+    Month = Month % 12 + 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;
+}
+
+
+static int
+LookupWord(buff)
+    char                *buff;
+{
+    register char *p;
+    register char *q;
+    register TABLE *tp;
+    int i;
+    int abbrev;
+
+    /*
+     * Make it lowercase.
+     */
+    for (p = buff; *p; p++) {
+        if (isupper(UCHAR(*p))) {
+            *p = (char) tolower(UCHAR(*p));
+	}
+    }
+
+    if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
+        yylval.Meridian = MERam;
+        return tMERIDIAN;
+    }
+    if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
+        yylval.Meridian = MERpm;
+        return tMERIDIAN;
+    }
+
+    /*
+     * See if we have an abbreviation for a month.
+     */
+    if (strlen(buff) == 3) {
+        abbrev = 1;
+    } else if (strlen(buff) == 4 && buff[3] == '.') {
+        abbrev = 1;
+        buff[3] = '\0';
+    } else {
+        abbrev = 0;
+    }
+
+    for (tp = MonthDayTable; tp->name; tp++) {
+        if (abbrev) {
+            if (strncmp(buff, tp->name, 3) == 0) {
+                yylval.Number = tp->value;
+                return tp->type;
+            }
+        } else if (strcmp(buff, tp->name) == 0) {
+            yylval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    for (tp = TimezoneTable; tp->name; tp++) {
+        if (strcmp(buff, tp->name) == 0) {
+            yylval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    for (tp = UnitsTable; tp->name; tp++) {
+        if (strcmp(buff, tp->name) == 0) {
+            yylval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    /*
+     * Strip off any plural and try the units table again.
+     */
+    i = strlen(buff) - 1;
+    if (buff[i] == 's') {
+        buff[i] = '\0';
+        for (tp = UnitsTable; tp->name; tp++) {
+            if (strcmp(buff, tp->name) == 0) {
+                yylval.Number = tp->value;
+                return tp->type;
+            }
+	}
+    }
+
+    for (tp = OtherTable; tp->name; tp++) {
+        if (strcmp(buff, tp->name) == 0) {
+            yylval.Number = tp->value;
+            return tp->type;
+        }
+    }
+
+    /*
+     * Military timezones.
+     */
+    if (buff[1] == '\0' && isalpha(UCHAR(*buff))) {
+        for (tp = MilitaryTable; tp->name; tp++) {
+            if (strcmp(buff, tp->name) == 0) {
+                yylval.Number = tp->value;
+                return tp->type;
+            }
+	}
+    }
+
+    /*
+     * Drop out any periods and try the timezone table again.
+     */
+    for (i = 0, p = q = buff; *q; q++)
+        if (*q != '.') {
+            *p++ = *q;
+        } else {
+            i++;
+	}
+    *p = '\0';
+    if (i) {
+        for (tp = TimezoneTable; tp->name; tp++) {
+            if (strcmp(buff, tp->name) == 0) {
+                yylval.Number = tp->value;
+                return tp->type;
+            }
+	}
+    }
+    
+    return tID;
+}
+
+
+static int
+yylex()
+{
+    register char       c;
+    register char       *p;
+    char                buff[20];
+    int                 Count;
+    int                 sign;
+
+    for ( ; ; ) {
+        while (isspace((unsigned char) (*yyInput))) {
+            yyInput++;
+	}
+
+        if (isdigit(c = *yyInput) || c == '-' || c == '+') {
+            if (c == '-' || c == '+') {
+                sign = c == '-' ? -1 : 1;
+                if (!isdigit(*++yyInput)) {
+                    /*
+		     * skip the '-' sign
+		     */
+                    continue;
+		}
+            } else {
+                sign = 0;
+	    }
+            for (yylval.Number = 0; isdigit(c = *yyInput++); ) {
+                yylval.Number = 10 * yylval.Number + c - '0';
+	    }
+            yyInput--;
+            if (sign < 0) {
+                yylval.Number = -yylval.Number;
+	    }
+            return sign ? tSNUMBER : tUNUMBER;
+        }
+        if (isalpha(UCHAR(c))) {
+            for (p = buff; isalpha(c = *yyInput++) || c == '.'; ) {
+                if (p < &buff[sizeof buff - 1]) {
+                    *p++ = c;
+		}
+	    }
+            *p = '\0';
+            yyInput--;
+            return LookupWord(buff);
+        }
+        if (c != '(') {
+            return *yyInput++;
+	}
+        Count = 0;
+        do {
+            c = *yyInput++;
+            if (c == '\0') {
+                return c;
+	    } else if (c == '(') {
+                Count++;
+	    } else if (c == ')') {
+                Count--;
+	    }
+        } while (Count > 0);
+    }
+}
+
+/*
+ * Specify zone is of -50000 to force GMT.  (This allows BST to work).
+ */
+
+int
+TclGetDate(p, now, zone, timePtr)
+    char *p;
+    unsigned long now;
+    long zone;
+    unsigned long *timePtr;
+{
+    struct tm *tm;
+    time_t Start;
+    time_t Time;
+    time_t tod;
+    int thisyear;
+
+    yyInput = p;
+    tm = TclpGetDate((time_t *) &now, 0);
+    thisyear = tm->tm_year + TM_YEAR_BASE;
+    yyYear = thisyear;
+    yyMonth = tm->tm_mon + 1;
+    yyDay = tm->tm_mday;
+    yyTimezone = zone;
+    if (zone == -50000) {
+        yyDSTmode = DSToff;  /* assume GMT */
+        yyTimezone = 0;
+    } else {
+        yyDSTmode = DSTmaybe;
+    }
+    yyHour = 0;
+    yyMinutes = 0;
+    yySeconds = 0;
+    yyMeridian = MER24;
+    yyRelSeconds = 0;
+    yyRelMonth = 0;
+    yyHaveDate = 0;
+    yyHaveDay = 0;
+    yyHaveRel = 0;
+    yyHaveTime = 0;
+    yyHaveZone = 0;
+
+    if (yyparse() || yyHaveTime > 1 || yyHaveZone > 1 || yyHaveDate > 1 ||
+	    yyHaveDay > 1) {
+        return -1;
+    }
+    
+    if (yyHaveDate || yyHaveTime || yyHaveDay) {
+	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 {
+        Start = now;
+        if (!yyHaveRel) {
+            Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec;
+	}
+    }
+
+    Start += yyRelSeconds;
+    if (RelativeMonth(Start, yyRelMonth, &Time) < 0) {
+        return -1;
+    }
+    Start += Time;
+
+    if (yyHaveDay && !yyHaveDate) {
+        tod = RelativeDate(Start, yyDayOrdinal, yyDayNumber);
+        Start += tod;
+    }
+
+    *timePtr = Start;
+    return 0;
+}
diff --git a/tcl/generic/tclHash.c b/tcl/generic/tclHash.c
new file mode 100644
index 00000000000..b38a2b1ce52
--- /dev/null
+++ b/tcl/generic/tclHash.c
@@ -0,0 +1,921 @@
+/* 
+ * tclHash.c --
+ *
+ *	Implementation of in-memory hash tables for Tcl and Tcl-based
+ *	applications.
+ *
+ * Copyright (c) 1991-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * When there are this many entries per bucket, on average, rebuild
+ * the hash table to make it larger.
+ */
+
+#define REBUILD_MULTIPLIER	3
+
+
+/*
+ * The following macro takes a preliminary integer hash value and
+ * produces an index into a hash tables bucket list.  The idea is
+ * to make it so that preliminary values that are arbitrarily similar
+ * will end up in different buckets.  The hash function was taken
+ * from a random-number generator.
+ */
+
+#define RANDOM_INDEX(tablePtr, i) \
+    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
+
+/*
+ * Procedure prototypes for static procedures in this file:
+ */
+
+static Tcl_HashEntry *	ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    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,
+			    CONST char *key));
+static Tcl_HashEntry *	StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+static Tcl_HashEntry *	OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key));
+static Tcl_HashEntry *	OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+			    CONST char *key, int *newPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitHashTable --
+ *
+ *	Given storage for a hash table, set up the fields to prepare
+ *	the hash table for use.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
+ *	Tcl_CreateHashEntry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_InitHashTable(tablePtr, keyType)
+    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
+					 * is supplied by the caller. */
+    int keyType;			/* Type of keys to use in table:
+					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
+					 * or an integer >= 2. */
+{
+    tablePtr->buckets = tablePtr->staticBuckets;
+    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
+    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
+    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
+    tablePtr->numEntries = 0;
+    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+    tablePtr->downShift = 28;
+    tablePtr->mask = 3;
+    tablePtr->keyType = keyType;
+    if (keyType == TCL_STRING_KEYS) {
+	tablePtr->findProc = StringFind;
+	tablePtr->createProc = StringCreate;
+    } else if (keyType == TCL_ONE_WORD_KEYS) {
+	tablePtr->findProc = OneWordFind;
+	tablePtr->createProc = OneWordCreate;
+    } else {
+	tablePtr->findProc = ArrayFind;
+	tablePtr->createProc = ArrayCreate;
+    };
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteHashEntry --
+ *
+ *	Remove a single entry from a hash table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The entry given by entryPtr is deleted from its table and
+ *	should never again be used by the caller.  It is up to the
+ *	caller to free the clientData field of the entry, if that
+ *	is relevant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteHashEntry(entryPtr)
+    Tcl_HashEntry *entryPtr;
+{
+    register Tcl_HashEntry *prevPtr;
+
+    if (*entryPtr->bucketPtr == entryPtr) {
+	*entryPtr->bucketPtr = entryPtr->nextPtr;
+    } else {
+	for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
+	    if (prevPtr == NULL) {
+		panic("malformed bucket chain in Tcl_DeleteHashEntry");
+	    }
+	    if (prevPtr->nextPtr == entryPtr) {
+		prevPtr->nextPtr = entryPtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    entryPtr->tablePtr->numEntries--;
+    ckfree((char *) entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteHashTable --
+ *
+ *	Free up everything associated with a hash table except for
+ *	the record for the table itself.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The hash table is no longer useable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteHashTable(tablePtr)
+    register Tcl_HashTable *tablePtr;		/* Table to delete. */
+{
+    register Tcl_HashEntry *hPtr, *nextPtr;
+    int i;
+
+    /*
+     * Free up all the entries in the table.
+     */
+
+    for (i = 0; i < tablePtr->numBuckets; i++) {
+	hPtr = tablePtr->buckets[i];
+	while (hPtr != NULL) {
+	    nextPtr = hPtr->nextPtr;
+	    ckfree((char *) hPtr);
+	    hPtr = nextPtr;
+	}
+    }
+
+    /*
+     * Free up the bucket array, if it was dynamically allocated.
+     */
+
+    if (tablePtr->buckets != tablePtr->staticBuckets) {
+	ckfree((char *) tablePtr->buckets);
+    }
+
+    /*
+     * Arrange for panics if the table is used again without
+     * re-initialization.
+     */
+
+    tablePtr->findProc = BogusFind;
+    tablePtr->createProc = BogusCreate;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FirstHashEntry --
+ *
+ *	Locate the first entry in a hash table and set up a record
+ *	that can be used to step through all the remaining entries
+ *	of the table.
+ *
+ * Results:
+ *	The return value is a pointer to the first entry in tablePtr,
+ *	or NULL if tablePtr has no entries in it.  The memory at
+ *	*searchPtr is initialized so that subsequent calls to
+ *	Tcl_NextHashEntry will return all of the entries in the table,
+ *	one at a time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashEntry *
+Tcl_FirstHashEntry(tablePtr, searchPtr)
+    Tcl_HashTable *tablePtr;		/* Table to search. */
+    Tcl_HashSearch *searchPtr;		/* Place to store information about
+					 * progress through the table. */
+{
+    searchPtr->tablePtr = tablePtr;
+    searchPtr->nextIndex = 0;
+    searchPtr->nextEntryPtr = NULL;
+    return Tcl_NextHashEntry(searchPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NextHashEntry --
+ *
+ *	Once a hash table enumeration has been initiated by calling
+ *	Tcl_FirstHashEntry, this procedure may be called to return
+ *	successive elements of the table.
+ *
+ * Results:
+ *	The return value is the next entry in the hash table being
+ *	enumerated, or NULL if the end of the table is reached.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashEntry *
+Tcl_NextHashEntry(searchPtr)
+    register Tcl_HashSearch *searchPtr;	/* Place to store information about
+					 * progress through the table.  Must
+					 * have been initialized by calling
+					 * Tcl_FirstHashEntry. */
+{
+    Tcl_HashEntry *hPtr;
+
+    while (searchPtr->nextEntryPtr == NULL) {
+	if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
+	    return NULL;
+	}
+	searchPtr->nextEntryPtr =
+		searchPtr->tablePtr->buckets[searchPtr->nextIndex];
+	searchPtr->nextIndex++;
+    }
+    hPtr = searchPtr->nextEntryPtr;
+    searchPtr->nextEntryPtr = hPtr->nextPtr;
+    return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_HashStats --
+ *
+ *	Return statistics describing the layout of the hash table
+ *	in its hash buckets.
+ *
+ * Results:
+ *	The return value is a malloc-ed string containing information
+ *	about tablePtr.  It is the caller's responsibility to free
+ *	this string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_HashStats(tablePtr)
+    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
+{
+#define NUM_COUNTERS 10
+    int count[NUM_COUNTERS], overflow, i, j;
+    double average, tmp;
+    register Tcl_HashEntry *hPtr;
+    char *result, *p;
+
+    /*
+     * Compute a histogram of bucket usage.
+     */
+
+    for (i = 0; i < NUM_COUNTERS; i++) {
+	count[i] = 0;
+    }
+    overflow = 0;
+    average = 0.0;
+    for (i = 0; i < tablePtr->numBuckets; i++) {
+	j = 0;
+	for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
+	    j++;
+	}
+	if (j < NUM_COUNTERS) {
+	    count[j]++;
+	} else {
+	    overflow++;
+	}
+	tmp = j;
+	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
+    }
+
+    /*
+     * Print out the histogram and a few other pieces of information.
+     */
+
+    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+    sprintf(result, "%d entries in table, %d buckets\n",
+	    tablePtr->numEntries, tablePtr->numBuckets);
+    p = result + strlen(result);
+    for (i = 0; i < NUM_COUNTERS; i++) {
+	sprintf(p, "number of buckets with %d entries: %d\n",
+		i, count[i]);
+	p += strlen(p);
+    }
+    sprintf(p, "number of buckets with %d or more entries: %d\n",
+	    NUM_COUNTERS, overflow);
+    p += strlen(p);
+    sprintf(p, "average search distance for entry: %.1f", average);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HashString --
+ *
+ *	Compute a one-word summary of a text string, which can be
+ *	used to generate a hash index.
+ *
+ * Results:
+ *	The return value is a one-word summary of the information in
+ *	string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+HashString(string)
+    register CONST char *string;/* String from which to compute hash value. */
+{
+    register unsigned int result;
+    register int c;
+
+    /*
+     * I tried a zillion different hash functions and asked many other
+     * people for advice.  Many people had their own favorite functions,
+     * all different, but no-one had much idea why they were good ones.
+     * I chose the one below (multiply by 9 and add new character)
+     * because of the following reasons:
+     *
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
+     *    and multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
+     *    character's bits hang around in the low-order bits of the
+     *    hash value for ever, plus they spread fairly rapidly up to
+     *    the high-order bits to fill out the hash value.  This seems
+     *    works well both for decimal and non-decimal strings.
+     */
+
+    result = 0;
+    while (1) {
+	c = *string;
+	string++;
+	if (c == 0) {
+	    break;
+	}
+	result += (result<<3) + c;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringFind --
+ *
+ *	Given a hash table with string keys, and a string key, find
+ *	the entry with a matching key.
+ *
+ * Results:
+ *	The return value is a token for the matching entry in the
+ *	hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+StringFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
+{
+    register Tcl_HashEntry *hPtr;
+    register CONST char *p1, *p2;
+    int index;
+
+    index = HashString(key) & tablePtr->mask;
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
+	    if (*p1 != *p2) {
+		break;
+	    }
+	    if (*p1 == '\0') {
+		return hPtr;
+	    }
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringCreate --
+ *
+ *	Given a hash table with string keys, and a string key, find
+ *	the entry with a matching key.  If there is no matching entry,
+ *	then create a new entry that does match.
+ *
+ * Results:
+ *	The return value is a pointer to the matching entry.  If this
+ *	is a newly-created entry, then *newPtr will be set to a non-zero
+ *	value;  otherwise *newPtr will be set to 0.  If this is a new
+ *	entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ *	A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+StringCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    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 CONST char *p1, *p2;
+    int index;
+
+    index = HashString(key) & tablePtr->mask;
+
+    /*
+     * Search all of the entries in this bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
+	    if (*p1 != *p2) {
+		break;
+	    }
+	    if (*p1 == '\0') {
+		*newPtr = 0;
+		return hPtr;
+	    }
+	}
+    }
+
+    /*
+     * Entry not found.  Add a new one to the bucket.
+     */
+
+    *newPtr = 1;
+    hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
+	    (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
+    hPtr->tablePtr = tablePtr;
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+    hPtr->nextPtr = *hPtr->bucketPtr;
+    hPtr->clientData = 0;
+    strcpy(hPtr->key.string, key);
+    *hPtr->bucketPtr = hPtr;
+    tablePtr->numEntries++;
+
+    /*
+     * If the table has exceeded a decent size, rebuild it with many
+     * more buckets.
+     */
+
+    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+	RebuildTable(tablePtr);
+    }
+    return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OneWordFind --
+ *
+ *	Given a hash table with one-word keys, and a one-word key, find
+ *	the entry with a matching key.
+ *
+ * Results:
+ *	The return value is a token for the matching entry in the
+ *	hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+OneWordFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    register CONST char *key;	/* Key to use to find matching entry. */
+{
+    register Tcl_HashEntry *hPtr;
+    int index;
+
+    index = RANDOM_INDEX(tablePtr, key);
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	if (hPtr->key.oneWordValue == key) {
+	    return hPtr;
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OneWordCreate --
+ *
+ *	Given a hash table with one-word keys, and a one-word key, find
+ *	the entry with a matching key.  If there is no matching entry,
+ *	then create a new entry that does match.
+ *
+ * Results:
+ *	The return value is a pointer to the matching entry.  If this
+ *	is a newly-created entry, then *newPtr will be set to a non-zero
+ *	value;  otherwise *newPtr will be set to 0.  If this is a new
+ *	entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ *	A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+OneWordCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    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. */
+{
+    register Tcl_HashEntry *hPtr;
+    int index;
+
+    index = RANDOM_INDEX(tablePtr, key);
+
+    /*
+     * Search all of the entries in this bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	if (hPtr->key.oneWordValue == key) {
+	    *newPtr = 0;
+	    return hPtr;
+	}
+    }
+
+    /*
+     * Entry not found.  Add a new one to the bucket.
+     */
+
+    *newPtr = 1;
+    hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
+    hPtr->tablePtr = tablePtr;
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+    hPtr->nextPtr = *hPtr->bucketPtr;
+    hPtr->clientData = 0;
+    hPtr->key.oneWordValue = (char *) key;	/* CONST XXXX */
+    *hPtr->bucketPtr = hPtr;
+    tablePtr->numEntries++;
+
+    /*
+     * If the table has exceeded a decent size, rebuild it with many
+     * more buckets.
+     */
+
+    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+	RebuildTable(tablePtr);
+    }
+    return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayFind --
+ *
+ *	Given a hash table with array-of-int keys, and a key, find
+ *	the entry with a matching key.
+ *
+ * Results:
+ *	The return value is a token for the matching entry in the
+ *	hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+ArrayFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
+{
+    register Tcl_HashEntry *hPtr;
+    int *arrayPtr = (int *) key;
+    register int *iPtr1, *iPtr2;
+    int index, count;
+
+    for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
+	    count > 0; count--, iPtr1++) {
+	index += *iPtr1;
+    }
+    index = RANDOM_INDEX(tablePtr, index);
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
+		count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
+	    if (count == 0) {
+		return hPtr;
+	    }
+	    if (*iPtr1 != *iPtr2) {
+		break;
+	    }
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayCreate --
+ *
+ *	Given a hash table with one-word keys, and a one-word key, find
+ *	the entry with a matching key.  If there is no matching entry,
+ *	then create a new entry that does match.
+ *
+ * Results:
+ *	The return value is a pointer to the matching entry.  If this
+ *	is a newly-created entry, then *newPtr will be set to a non-zero
+ *	value;  otherwise *newPtr will be set to 0.  If this is a new
+ *	entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ *	A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+ArrayCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    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. */
+{
+    register Tcl_HashEntry *hPtr;
+    int *arrayPtr = (int *) key;
+    register int *iPtr1, *iPtr2;
+    int index, count;
+
+    for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
+	    count > 0; count--, iPtr1++) {
+	index += *iPtr1;
+    }
+    index = RANDOM_INDEX(tablePtr, index);
+
+    /*
+     * Search all of the entries in the appropriate bucket.
+     */
+
+    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+	    hPtr = hPtr->nextPtr) {
+	for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
+		count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
+	    if (count == 0) {
+		*newPtr = 0;
+		return hPtr;
+	    }
+	    if (*iPtr1 != *iPtr2) {
+		break;
+	    }
+	}
+    }
+
+    /*
+     * Entry not found.  Add a new one to the bucket.
+     */
+
+    *newPtr = 1;
+    hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
+	    + (tablePtr->keyType*sizeof(int)) - 4));
+    hPtr->tablePtr = tablePtr;
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+    hPtr->nextPtr = *hPtr->bucketPtr;
+    hPtr->clientData = 0;
+    for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
+	    count > 0; count--, iPtr1++, iPtr2++) {
+	*iPtr2 = *iPtr1;
+    }
+    *hPtr->bucketPtr = hPtr;
+    tablePtr->numEntries++;
+
+    /*
+     * If the table has exceeded a decent size, rebuild it with many
+     * more buckets.
+     */
+
+    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+	RebuildTable(tablePtr);
+    }
+    return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BogusFind --
+ *
+ *	This procedure is invoked when an Tcl_FindHashEntry is called
+ *	on a table that has been deleted.
+ *
+ * Results:
+ *	If panic returns (which it shouldn't) this procedure returns
+ *	NULL.
+ *
+ * Side effects:
+ *	Generates a panic.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static Tcl_HashEntry *
+BogusFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
+{
+    panic("called Tcl_FindHashEntry on deleted table");
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BogusCreate --
+ *
+ *	This procedure is invoked when an Tcl_CreateHashEntry is called
+ *	on a table that has been deleted.
+ *
+ * Results:
+ *	If panic returns (which it shouldn't) this procedure returns
+ *	NULL.
+ *
+ * Side effects:
+ *	Generates a panic.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static Tcl_HashEntry *
+BogusCreate(tablePtr, key, newPtr)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find or create matching
+				 * entry. */
+    int *newPtr;		/* Store info here telling whether a new
+				 * entry was created. */
+{
+    panic("called Tcl_CreateHashEntry on deleted table");
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RebuildTable --
+ *
+ *	This procedure is invoked when the ratio of entries to hash
+ *	buckets becomes too large.  It creates a new table with a
+ *	larger bucket array and moves all of the entries into the
+ *	new table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets reallocated and entries get re-hashed to new
+ *	buckets.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RebuildTable(tablePtr)
+    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
+{
+    int oldSize, count, index;
+    Tcl_HashEntry **oldBuckets;
+    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
+    register Tcl_HashEntry *hPtr;
+
+    oldSize = tablePtr->numBuckets;
+    oldBuckets = tablePtr->buckets;
+
+    /*
+     * Allocate and initialize the new bucket array, and set up
+     * hashing constants for new array size.
+     */
+
+    tablePtr->numBuckets *= 4;
+    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
+	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
+	    count > 0; count--, newChainPtr++) {
+	*newChainPtr = NULL;
+    }
+    tablePtr->rebuildSize *= 4;
+    tablePtr->downShift -= 2;
+    tablePtr->mask = (tablePtr->mask << 2) + 3;
+
+    /*
+     * Rehash all of the existing entries into the new bucket array.
+     */
+
+    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
+	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
+	    *oldChainPtr = hPtr->nextPtr;
+	    if (tablePtr->keyType == TCL_STRING_KEYS) {
+		index = HashString(hPtr->key.string) & tablePtr->mask;
+	    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
+		index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
+	    } else {
+		register int *iPtr;
+		int count;
+
+		for (index = 0, count = tablePtr->keyType,
+			iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
+		    index += *iPtr;
+		}
+		index = RANDOM_INDEX(tablePtr, index);
+	    }
+	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
+	    hPtr->nextPtr = *hPtr->bucketPtr;
+	    *hPtr->bucketPtr = hPtr;
+	}
+    }
+
+    /*
+     * Free up the old bucket array, if it was dynamically allocated.
+     */
+
+    if (oldBuckets != tablePtr->staticBuckets) {
+	ckfree((char *) oldBuckets);
+    }
+}
diff --git a/tcl/generic/tclHistory.c b/tcl/generic/tclHistory.c
new file mode 100644
index 00000000000..99f9ebeb243
--- /dev/null
+++ b/tcl/generic/tclHistory.c
@@ -0,0 +1,155 @@
+/* 
+ * tclHistory.c --
+ *
+ *	This module and the Tcl library file history.tcl together implement
+ *	Tcl command history. Tcl_RecordAndEval(Obj) can be called to record
+ *	commands ("events") before they are executed. Commands defined in
+ *	history.tcl may be used to perform history substitutions.
+ *
+ * Copyright (c) 1990-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RecordAndEval --
+ *
+ *	This procedure adds its command argument to the current list of
+ *	recorded events and then executes the command by calling
+ *	Tcl_Eval.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value, the result of
+ *	executing cmd.
+ *
+ * Side effects:
+ *	The command is recorded and executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RecordAndEval(interp, cmd, flags)
+    Tcl_Interp *interp;		/* Token for interpreter in which command
+				 * will be executed. */
+    char *cmd;			/* Command to record. */
+    int flags;			/* Additional flags.  TCL_NO_EVAL means
+				 * only record: don't execute command.
+				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
+				 * instead of Tcl_Eval. */
+{
+    register Tcl_Obj *cmdPtr;
+    int length = strlen(cmd);
+    int result;
+
+    if (length > 0) {
+	/*
+	 * Call Tcl_RecordAndEvalObj to do the actual work.
+	 */
+
+	TclNewObj(cmdPtr);
+	TclInitStringRep(cmdPtr, cmd, length);
+	Tcl_IncrRefCount(cmdPtr);
+
+	result = Tcl_RecordAndEvalObj(interp, cmdPtr, 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);
+
+	/*
+	 * Discard the Tcl object created to hold the command.
+	 */
+	
+	Tcl_DecrRefCount(cmdPtr);	
+    } else {
+	/*
+	 * An empty string. Just reset the interpreter's result.
+	 */
+
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RecordAndEvalObj --
+ *
+ *	This procedure adds the command held in its argument object to the
+ *	current list of recorded events and then executes the command by
+ *	calling Tcl_EvalObj.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value, the result of
+ *	executing the command.
+ *
+ * Side effects:
+ *	The command is recorded and executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
+    Tcl_Interp *interp;		/* Token for interpreter in which command
+				 * will be executed. */
+    Tcl_Obj *cmdPtr;		/* Points to object holding the command to
+				 * record and execute. */
+    int flags;			/* Additional flags. TCL_NO_EVAL means
+				 * record only: don't execute the command.
+				 * TCL_EVAL_GLOBAL means use
+				 * Tcl_GlobalEvalObj instead of
+				 * Tcl_EvalObj. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int result;
+    Tcl_Obj *list[3];
+    register Tcl_Obj *objPtr;
+
+    /*
+     * Do recording by eval'ing a tcl history command: history add $cmd.
+     */
+
+    list[0] = Tcl_NewStringObj("history", -1);
+    list[1] = Tcl_NewStringObj("add", -1);
+    list[2] = cmdPtr;
+    
+    objPtr = Tcl_NewListObj(3, list);
+    Tcl_IncrRefCount(objPtr);
+    (void) Tcl_GlobalEvalObj(interp, objPtr);
+    Tcl_DecrRefCount(objPtr);
+
+    /*
+     * Execute the command.
+     */
+
+    result = TCL_OK;
+    if (!(flags & TCL_NO_EVAL)) {
+	iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL);
+	if (flags & TCL_EVAL_GLOBAL) {
+	    result = Tcl_GlobalEvalObj(interp, cmdPtr);
+	} else {
+	    result = Tcl_EvalObj(interp, cmdPtr);
+	}
+    }
+    return result;
+}
diff --git a/tcl/generic/tclIO.c b/tcl/generic/tclIO.c
new file mode 100644
index 00000000000..f3e080e7189
--- /dev/null
+++ b/tcl/generic/tclIO.c
@@ -0,0 +1,6053 @@
+/* 
+ * tclIO.c --
+ *
+ *	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) 1998 Scriptics Corporation
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include	"tclInt.h"
+#include	"tclPort.h"
+
+/*
+ * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
+ * compile on systems where neither is defined. We want both defined so
+ * that we can test safely for both. In the code we still have to test for
+ * both because there may be systems on which both are defined and have
+ * different values.
+ */
+
+#if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
+#   define EWOULDBLOCK EAGAIN
+#endif
+#if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
+#   define EAGAIN EWOULDBLOCK
+#endif
+#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
+    error one of EWOULDBLOCK or EAGAIN must be defined
+#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.
+ */
+
+typedef struct ChannelBuffer {
+    int nextAdded;		/* The next position into which a character
+                                 * will be put in the buffer. */
+    int nextRemoved;		/* Position of next byte to be removed
+                                 * from the buffer. */
+    int bufSize;		/* How big is the buffer? */
+    struct ChannelBuffer *nextPtr;
+    				/* Next buffer in chain. */
+    char buf[4];		/* Placeholder for real buffer. The real
+                                 * buffer occuppies this space + bufSize-4
+                                 * bytes. This must be the last field in
+                                 * the structure. */
+} ChannelBuffer;
+
+#define CHANNELBUFFER_HEADER_SIZE	(sizeof(ChannelBuffer) - 4)
+
+/*
+ * The following defines the *default* buffer size for channels.
+ */
+
+#define CHANNELBUFFER_DEFAULT_SIZE	(1024 * 4)
+
+/*
+ * Structure to record a close callback. One such record exists for
+ * each close callback registered for a channel.
+ */
+
+typedef struct CloseCallback {
+    Tcl_CloseProc *proc;		/* The procedure to call. */
+    ClientData clientData;		/* Arbitrary one-word data to pass
+                                         * to the callback. */
+    struct CloseCallback *nextPtr;	/* For chaining close callbacks. */
+} CloseCallback;
+
+/*
+ * 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.
+ */
+
+typedef struct EventScriptRecord {
+    struct Channel *chanPtr;	/* The channel for which this script is
+                                 * registered. This is used only when an
+                                 * error occurs during evaluation of the
+                                 * script, to delete the handler. */
+    char *script;		/* Script to invoke. */
+    Tcl_Interp *interp;		/* In what interpreter to invoke script? */
+    int mask;			/* Events must overlap current mask for the
+                                 * stored script to be invoked. */
+    struct EventScriptRecord *nextPtr;
+    				/* Next in chain of records. */
+} EventScriptRecord;
+
+/*
+ * struct Channel:
+ *
+ * One of these structures is allocated for each open channel. It contains data
+ * specific to the channel but which belongs to the generic part of the Tcl
+ * channel mechanism, and it points at an instance specific (and type
+ * specific) * instance data, and at a channel type structure.
+ */
+
+typedef struct Channel {
+    char *channelName;		/* The name of the channel instance in Tcl
+                                 * commands. Storage is owned by the generic IO
+                                 * code,  is dynamically allocated. */
+    int	flags;			/* ORed combination of the flags defined
+                                 * below. */
+    Tcl_EolTranslation inputTranslation;
+				/* What translation to apply for end of line
+                                 * sequences on input? */    
+    Tcl_EolTranslation outputTranslation;
+    				/* What translation to use for generating
+                                 * end of line sequences in output? */
+    int inEofChar;		/* If nonzero, use this as a signal of EOF
+                                 * on input. */
+    int outEofChar;             /* If nonzero, append this to the channel
+                                 * when it is closed if it is open for
+                                 * writing. */
+    int unreportedError;	/* Non-zero if an error report was deferred
+                                 * because it happened in the background. The
+                                 * value is the POSIX error code. */
+    ClientData instanceData;	/* Instance specific data. */
+    Tcl_ChannelType *typePtr;	/* Pointer to channel type structure. */
+    int refCount;		/* How many interpreters hold references to
+                                 * this IO channel? */
+    CloseCallback *closeCbPtr;	/* Callbacks registered to be called when the
+                                 * channel is closed. */
+    ChannelBuffer *curOutPtr;	/* Current output buffer being filled. */
+    ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
+    ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
+
+    ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
+                                 * need to allocate a new buffer for "gets"
+                                 * that crosses buffer boundaries. */
+    ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
+    ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */
+
+    struct ChannelHandler *chPtr;/* List of channel handlers registered
+                                  * for this channel. */
+    int interestMask;		/* Mask of all events this channel has
+                                 * handlers for. */
+    struct Channel *nextChanPtr;/* Next in list of channels currently open. */
+    EventScriptRecord *scriptRecordPtr;
+    				/* Chain of all scripts registered for
+                                 * 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;
+    
+/*
+ * Values for the flags field in Channel. Any ORed combination of the
+ * following flags can be stored in the field. These flags record various
+ * options and state bits about the channel. In addition to the flags below,
+ * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
+ */
+
+#define CHANNEL_NONBLOCKING	(1<<3)	/* Channel is currently in
+					 * nonblocking mode. */
+#define CHANNEL_LINEBUFFERED	(1<<4)	/* Output to the channel must be
+					 * flushed after every newline. */
+#define CHANNEL_UNBUFFERED	(1<<5)	/* Output to the channel must always
+					 * be flushed immediately. */
+#define BUFFER_READY		(1<<6)	/* Current output buffer (the
+					 * curOutPtr field in the
+                                         * channel structure) should be
+                                         * 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
+                                         * scheduled. */
+#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.
+					 * 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
+					 * on this channel. This bit is
+                                         * cleared before every input or
+                                         * output operation. */
+#define INPUT_SAW_CR		(1<<12)	/* Channel is in CRLF eol input
+					 * translation mode and the last
+                                         * byte seen was a "\r". */
+#define CHANNEL_DEAD		(1<<13)	/* The channel has been closed by
+					 * the exit handler (on exit) but
+                                         * not deallocated. When any IO
+                                         * operation sees this flag on a
+                                         * 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,
+ * there is one record of the following type. All of records for a specific
+ * channel are chained together in a singly linked list which is stored in
+ * the channel structure.
+ */
+
+typedef struct ChannelHandler {
+    Channel *chanPtr;		/* The channel structure for this channel. */
+    int mask;			/* Mask of desired events. */
+    Tcl_ChannelProc *proc;	/* Procedure to call in the type of
+                                 * Tcl_CreateChannelHandler. */
+    ClientData clientData;	/* Argument to pass to procedure. */
+    struct ChannelHandler *nextPtr;
+    				/* Next one in list of registered handlers. */
+} ChannelHandler;
+
+/*
+ * This structure keeps track of the current ChannelHandler being invoked in
+ * the current invocation of ChannelHandlerEventProc. There is a potential
+ * problem if a ChannelHandler is deleted while it is the current one, since
+ * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * problem, structures of the type below indicate the next handler to be
+ * processed for any (recursively nested) dispatches in progress. The
+ * nextHandlerPtr field is updated if the handler being pointed to is deleted.
+ * The nextPtr field is used to chain together all recursive invocations, so
+ * that Tcl_DeleteChannelHandler can find all the recursively nested
+ * invocations of ChannelHandlerEventProc and compare the handler being
+ * deleted against the NEXT handler to be invoked in that invocation; when it
+ * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
+ * field of the structure to the next handler.
+ */
+
+typedef struct NextChannelHandler {
+    ChannelHandler *nextHandlerPtr;	/* The next handler to be invoked in
+                                         * this invocation. */
+    struct NextChannelHandler *nestedHandlerPtr;
+					/* Next nested invocation of
+                                         * ChannelHandlerEventProc. */
+} NextChannelHandler;
+
+/*
+ * This variable holds the list of nested ChannelHandlerEventProc invocations.
+ */
+
+static NextChannelHandler *nestedHandlerPtr = (NextChannelHandler *) NULL;
+
+/*
+ * List of all channels currently open.
+ */
+
+static Channel *firstChanPtr = (Channel *) NULL;
+
+/*
+ * Has a channel exit handler been created yet?
+ */
+
+static int channelExitHandlerCreated = 0;
+
+/*
+ * The following structure describes the event that is added to the Tcl
+ * event queue by the channel handler check procedure.
+ */
+
+typedef struct ChannelHandlerEvent {
+    Tcl_Event header;		/* Standard header for all events. */
+    Channel *chanPtr;		/* The channel that is ready. */
+    int readyMask;		/* Events that have occurred. */
+} ChannelHandlerEvent;
+
+/*
+ * Static variables to hold channels for stdin, stdout and stderr.
+ */
+
+static Tcl_Channel stdinChannel = NULL;
+static int stdinInitialized = 0;
+static Tcl_Channel stdoutChannel = NULL;
+static int stdoutInitialized = 0;
+static Tcl_Channel stderrChannel = NULL;
+static int stderrInitialized = 0;
+
+/*
+ * Static functions in this file:
+ */
+
+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,
+                            Channel *chanPtr, int errorCode));
+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));
+static void		DeleteChannelTable _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp));
+static void		DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
+        		    Channel *chanPtr, int mask));
+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 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 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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetBlockMode --
+ *
+ *	This function sets the blocking mode for a channel and updates
+ *	the state flags.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Modifies the blocking mode of the channel and possibly generates
+ *	an error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    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;
+    }
+    if (mode == TCL_MODE_BLOCKING) {
+	chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
+    } else {
+	chanPtr->flags |= CHANNEL_NONBLOCKING;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetStdChannel --
+ *
+ *	This function is used to change the channels that are used
+ *	for stdin/stdout/stderr in new interpreters.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetStdChannel(channel, type)
+    Tcl_Channel channel;
+    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    switch (type) {
+	case TCL_STDIN:
+            stdinInitialized = 1;
+	    stdinChannel = channel;
+	    break;
+	case TCL_STDOUT:
+	    stdoutInitialized = 1;
+	    stdoutChannel = channel;
+	    break;
+	case TCL_STDERR:
+	    stderrInitialized = 1;
+	    stderrChannel = channel;
+	    break;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStdChannel --
+ *
+ *	Returns the specified standard channel.
+ *
+ * Results:
+ *	Returns the specified standard channel, or NULL.
+ *
+ * Side effects:
+ *	May cause the creation of a standard channel and the underlying
+ *	file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_GetStdChannel(type)
+    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    Tcl_Channel channel = NULL;
+
+    /*
+     * If the channels were not created yet, create them now and
+     * store them in the static variables.  Note that we need to set
+     * stdinInitialized before calling TclGetDefaultStdChannel in order
+     * to avoid recursive loops when TclGetDefaultStdChannel calls
+     * Tcl_CreateChannel.
+     */
+
+    switch (type) {
+	case TCL_STDIN:
+	    if (!stdinInitialized) {
+		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) {
+		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) {
+		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;
+    }
+    return channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateCloseHandler
+ *
+ *	Creates a close callback which will be called when the channel is
+ *	closed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Causes the callback to be called in the future when the channel
+ *	will be closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateCloseHandler(chan, proc, clientData)
+    Tcl_Channel chan;		/* The channel for which to create the
+                                 * close callback. */
+    Tcl_CloseProc *proc;	/* The callback routine to call when the
+                                 * channel will be closed. */
+    ClientData clientData;	/* Arbitrary data to pass to the
+                                 * close callback. */
+{
+    Channel *chanPtr;
+    CloseCallback *cbPtr;
+
+    chanPtr = (Channel *) chan;
+
+    cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
+    cbPtr->proc = proc;
+    cbPtr->clientData = clientData;
+
+    cbPtr->nextPtr = chanPtr->closeCbPtr;
+    chanPtr->closeCbPtr = cbPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteCloseHandler --
+ *
+ *	Removes a callback that would have been called on closing
+ *	the channel. If there is no matching callback then this
+ *	function has no effect.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The callback will not be called in the future when the channel
+ *	is eventually closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteCloseHandler(chan, proc, clientData)
+    Tcl_Channel chan;		/* The channel for which to cancel the
+                                 * close callback. */
+    Tcl_CloseProc *proc;	/* The procedure for the callback to
+                                 * remove. */
+    ClientData clientData;	/* The callback data for the callback
+                                 * to remove. */
+{
+    Channel *chanPtr;
+    CloseCallback *cbPtr, *cbPrevPtr;
+
+    chanPtr = (Channel *) chan;
+    for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
+             cbPtr != (CloseCallback *) NULL;
+             cbPtr = cbPtr->nextPtr) {
+        if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
+            if (cbPrevPtr == (CloseCallback *) NULL) {
+                chanPtr->closeCbPtr = cbPtr->nextPtr;
+            }
+            ckfree((char *) cbPtr);
+            break;
+        } else {
+            cbPrevPtr = cbPtr;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseChannelsOnExit --
+ *
+ *	Closes all the existing channels, on exit. This	routine is called
+ *	during exit processing.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Closes all channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+CloseChannelsOnExit(clientData)
+    ClientData clientData;		/* NULL - unused. */
+{
+    Channel *chanPtr;			/* Iterates over open channels. */
+    Channel *nextChanPtr;		/* Iterates over open channels. */
+
+
+    for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
+             chanPtr = nextChanPtr) {
+        nextChanPtr = chanPtr->nextChanPtr;
+
+        /*
+         * Set the channel back into blocking mode to ensure that we wait
+         * for all data to flush out.
+         */
+        
+        (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) {
+
+	    /*
+             * Close it only if the refcount indicates that the channel is not
+             * referenced from any interpreter. If it is, that interpreter will
+             * close the channel when it gets destroyed.
+             */
+
+            (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+
+        } else {
+
+            /*
+             * The refcount is greater than zero, so flush the channel.
+             */
+
+            Tcl_Flush((Tcl_Channel) chanPtr);
+
+            /*
+             * Call the device driver to actually close the underlying
+             * device for this channel.
+             */
+            
+            (chanPtr->typePtr->closeProc) (chanPtr->instanceData,
+                    (Tcl_Interp *) NULL);
+
+            /*
+             * Finally, we clean up the fields in the channel data structure
+             * since all of them have been deleted already. We mark the
+             * channel with CHANNEL_DEAD to prevent any further IO operations
+             * on it.
+             */
+
+            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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetChannelTable --
+ *
+ *	Gets and potentially initializes the channel table for an
+ *	interpreter. If it is initializing the table it also inserts
+ *	channels for stdin, stdout and stderr if the interpreter is
+ *	trusted.
+ *
+ * Results:
+ *	A pointer to the hash table created, for use by the caller.
+ *
+ * Side effects:
+ *	Initializes the channel table for an interpreter. May create
+ *	channels for stdin, stdout and stderr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashTable *
+GetChannelTable(interp)
+    Tcl_Interp *interp;
+{
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_Channel stdinChan, stdoutChan, stderrChan;
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
+
+        (void) Tcl_SetAssocData(interp, "tclIO",
+                (Tcl_InterpDeleteProc *) DeleteChannelTable,
+                (ClientData) hTblPtr);
+
+        /*
+         * If the interpreter is trusted (not "safe"), insert channels
+         * for stdin, stdout and stderr (possibly creating them in the
+         * process).
+         */
+
+        if (Tcl_IsSafe(interp) == 0) {
+            stdinChan = Tcl_GetStdChannel(TCL_STDIN);
+            if (stdinChan != NULL) {
+                Tcl_RegisterChannel(interp, stdinChan);
+            }
+            stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
+            if (stdoutChan != NULL) {
+                Tcl_RegisterChannel(interp, stdoutChan);
+            }
+            stderrChan = Tcl_GetStdChannel(TCL_STDERR);
+            if (stderrChan != NULL) {
+                Tcl_RegisterChannel(interp, stderrChan);
+            }
+        }
+
+    }
+    return hTblPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteChannelTable --
+ *
+ *	Deletes the channel table for an interpreter, closing any open
+ *	channels whose refcount reaches zero. This procedure is invoked
+ *	when an interpreter is deleted, via the AssocData cleanup
+ *	mechanism.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the hash table of channels. May close channels. May flush
+ *	output on closed channels. Removes any channeEvent handlers that were
+ *	registered in this interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteChannelTable(clientData, interp)
+    ClientData clientData;	/* The per-interpreter data structure. */
+    Tcl_Interp *interp;		/* The interpreter being deleted. */
+{
+    Tcl_HashTable *hTblPtr;	/* The hash table. */
+    Tcl_HashSearch hSearch;	/* Search variable. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    Channel *chanPtr;	/* Channel being deleted. */
+    EventScriptRecord *sPtr, *prevPtr, *nextPtr;
+    				/* 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.
+     */
+    
+    hTblPtr = (Tcl_HashTable *) clientData;
+    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+             hPtr != (Tcl_HashEntry *) NULL;
+             hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
+
+        chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+
+        /*
+         * Remove any fileevents registered in this interpreter.
+         */
+        
+        for (sPtr = chanPtr->scriptRecordPtr,
+                 prevPtr = (EventScriptRecord *) NULL;
+                 sPtr != (EventScriptRecord *) NULL;
+                 sPtr = nextPtr) {
+            nextPtr = sPtr->nextPtr;
+            if (sPtr->interp == interp) {
+                if (prevPtr == (EventScriptRecord *) NULL) {
+                    chanPtr->scriptRecordPtr = nextPtr;
+                } else {
+                    prevPtr->nextPtr = nextPtr;
+                }
+
+                Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                        ChannelEventScriptInvoker, (ClientData) sPtr);
+
+		ckfree(sPtr->script);
+                ckfree((char *) sPtr);
+            } else {
+                prevPtr = sPtr;
+            }
+        }
+
+        /*
+         * Cannot call Tcl_UnregisterChannel because that procedure calls
+         * Tcl_GetAssocData to get the channel table, which might already
+         * be inaccessible from the interpreter structure. Instead, we
+         * emulate the behavior of Tcl_UnregisterChannel directly here.
+         */
+
+        Tcl_DeleteHashEntry(hPtr);
+        chanPtr->refCount--;
+        if (chanPtr->refCount <= 0) {
+            if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+                (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
+            }
+        }
+    }
+    Tcl_DeleteHashTable(hTblPtr);
+    ckfree((char *) hTblPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Side effects:
+ *	Deletes the hash entry for a channel associated with an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnregisterChannel(interp, chan)
+    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
+    Tcl_Channel chan;		/* Channel to delete. */
+{
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    Channel *chanPtr;		/* The real IO channel. */
+
+    chanPtr = (Channel *) chan;
+    
+    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);
+    }
+
+    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);
+
+    /*
+     * If the refCount reached zero, close the actual channel.
+     */
+
+    if (chanPtr->refCount <= 0) {
+
+        /*
+         * Ensure that if there is another buffer, it gets flushed
+         * whether or not we are doing a background flush.
+         */
+
+        if ((chanPtr->curOutPtr != NULL) &&
+                (chanPtr->curOutPtr->nextAdded >
+                        chanPtr->curOutPtr->nextRemoved)) {
+            chanPtr->flags |= BUFFER_READY;
+        }
+        chanPtr->flags |= CHANNEL_CLOSED;
+        if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+            if (Tcl_Close(interp, chan) != TCL_OK) {
+                return TCL_ERROR;
+            }
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Side effects:
+ *	May increment the reference count of a channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_RegisterChannel(interp, chan)
+    Tcl_Interp *interp;		/* Interpreter in which to add the channel. */
+    Tcl_Channel chan;		/* The channel to add to this interpreter
+                                 * channel table. */
+{
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    int new;			/* Is the hash entry new or does it exist? */
+    Channel *chanPtr;		/* The actual channel. */
+
+    chanPtr = (Channel *) chan;
+
+    if (chanPtr->channelName == (char *) NULL) {
+        panic("Tcl_RegisterChannel: channel without name");
+    }
+    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");
+        }
+        Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
+    }
+    chanPtr->refCount++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannel --
+ *
+ *	Finds an existing Tcl_Channel structure by name in a given
+ *	interpreter. This function is public because it is used by
+ *	channel-type-specific functions.
+ *
+ * Results:
+ *	A Tcl_Channel or NULL on failure. If failed, interp->result
+ *	contains an error message. It also returns, in modePtr, the
+ *	modes in which the channel is opened.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_GetChannel(interp, chanName, modePtr)
+    Tcl_Interp *interp;		/* Interpreter in which to find or create
+                                 * the channel. */
+    char *chanName;		/* The name of the channel. */
+    int *modePtr;		/* Where to store the mode in which the
+                                 * channel was opened? Will contain an ORed
+                                 * combination of TCL_READABLE and
+                                 * TCL_WRITABLE, if non-NULL. */
+{
+    Channel *chanPtr;		/* The actual channel. */
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    char *name;			/* Translated name. */
+
+    /*
+     * Substitute "stdin", etc.  Note that even though we immediately
+     * find the channel using Tcl_GetStdChannel, we still need to look
+     * it up in the specified interpreter to ensure that it is present
+     * in the channel table.  Otherwise, safe interpreters would always
+     * have access to the standard channels.
+     */
+
+    name = chanName;
+    if ((chanName[0] == 's') && (chanName[1] == 't')) {
+	chanPtr = NULL;
+	if (strcmp(chanName, "stdin") == 0) {
+	    chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
+	} else if (strcmp(chanName, "stdout") == 0) {
+	    chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
+	} else if (strcmp(chanName, "stderr") == 0) {
+	    chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
+	}
+	if (chanPtr != NULL) {
+	    name = chanPtr->channelName;
+	}
+    }
+    
+    hTblPtr = GetChannelTable(interp);
+    hPtr = Tcl_FindHashEntry(hTblPtr, name);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendResult(interp, "can not find channel named \"",
+                chanName, "\"", (char *) NULL);
+        return NULL;
+    }
+
+    chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+    if (modePtr != NULL) {
+        *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
+    }
+    
+    return (Tcl_Channel) chanPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateChannel --
+ *
+ *	Creates a new entry in the hash table for a Tcl_Channel
+ *	record.
+ *
+ * Results:
+ *	Returns the new Tcl_Channel.
+ *
+ * Side effects:
+ *	Creates a new Tcl_Channel instance and inserts it into the
+ *	hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
+    Tcl_ChannelType *typePtr;	/* The channel type record. */
+    char *chanName;		/* Name of channel to record. */
+    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. */
+
+    chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+    
+    if (chanName != (char *) NULL) {
+        chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
+        strcpy(chanPtr->channelName, chanName);
+    } else {
+        panic("Tcl_CreateChannel: NULL channel name");
+    }
+
+    chanPtr->flags = mask;
+
+    /*
+     * Set the channel up initially in AUTO input translation mode to
+     * accept "\n", "\r" and "\r\n". Output translation mode is set to
+     * a platform specific default value. The eofChar is set to 0 for both
+     * input and output, so that Tcl does not look for an in-file EOF
+     * indicator (e.g. ^Z) and does not append an EOF indicator to files.
+     */
+
+    chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
+    chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+    chanPtr->inEofChar = 0;
+    chanPtr->outEofChar = 0;
+
+    chanPtr->unreportedError = 0;
+    chanPtr->instanceData = instanceData;
+    chanPtr->typePtr = typePtr;
+    chanPtr->refCount = 0;
+    chanPtr->closeCbPtr = (CloseCallback *) NULL;
+    chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+    chanPtr->outQueueHead = (ChannelBuffer *) NULL;
+    chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+    chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
+    chanPtr->inQueueHead = (ChannelBuffer *) NULL;
+    chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+    chanPtr->chPtr = (ChannelHandler *) NULL;
+    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
+     * handler if there is not one already, to close off all the channels
+     * in the list on exit.
+     */
+
+    chanPtr->nextChanPtr = firstChanPtr;
+    firstChanPtr = chanPtr;
+
+    if (!channelExitHandlerCreated) {
+        channelExitHandlerCreated = 1;
+        Tcl_CreateExitHandler(CloseChannelsOnExit, (ClientData) NULL);
+    }
+    
+    /*
+     * Install this channel in the first empty standard channel slot, if
+     * the channel was previously closed explicitly.
+     */
+
+    if ((stdinChannel == NULL) && (stdinInitialized == 1)) {
+	Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+    } else if ((stdoutChannel == NULL) && (stdoutInitialized == 1)) {
+	Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
+        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.
+ *
+ * Results:
+ *	The string containing the channel name. This memory is
+ *	owned by the generic layer and should not be modified by
+ *	the caller.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetChannelName(chan)
+    Tcl_Channel chan;		/* The channel for which to return the name. */
+{
+    Channel *chanPtr;		/* The actual channel. */
+
+    chanPtr = (Channel *) chan;
+    return chanPtr->channelName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelType --
+ *
+ *	Given a channel structure, returns the channel type structure.
+ *
+ * Results:
+ *	Returns a pointer to the channel type structure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ChannelType *
+Tcl_GetChannelType(chan)
+    Tcl_Channel chan;		/* The channel to return type for. */
+{
+    Channel *chanPtr;		/* The actual channel. */
+
+    chanPtr = (Channel *) chan;
+    return chanPtr->typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelHandle --
+ *
+ *	Returns an OS handle associated with a channel.
+ *
+ * Results:
+ *	Returns TCL_OK and places the handle in handlePtr, or returns
+ *	TCL_ERROR on failure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+    result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
+	    direction, &handle);
+    if (handlePtr) {
+	*handlePtr = handle;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelInstanceData --
+ *
+ *	Returns the client data associated with a channel.
+ *
+ * Results:
+ *	The client data.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_GetChannelInstanceData(chan)
+    Tcl_Channel chan;		/* Channel for which to return client data. */
+{
+    Channel *chanPtr;		/* The actual channel. */
+
+    chanPtr = (Channel *) chan;
+    return chanPtr->instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecycleBuffer --
+ *
+ *	Helper function to recycle input and output buffers. Ensures
+ *	that two input buffers are saved (one in the input queue and
+ *	another in the saveInBufPtr field) and that curOutPtr is set
+ *	to a buffer. Only if these conditions are met is the buffer
+ *	freed to the OS.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May free a buffer to the OS.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecycleBuffer(chanPtr, bufPtr, mustDiscard)
+    Channel *chanPtr;		/* Channel for which to recycle buffers. */
+    ChannelBuffer *bufPtr;	/* The buffer to recycle. */
+    int mustDiscard;		/* If nonzero, free the buffer to the
+                                 * OS, always. */
+{
+    /*
+     * Do we have to free the buffer to the OS?
+     */
+
+    if (mustDiscard) {
+        ckfree((char *) bufPtr);
+        return;
+    }
+    
+    /*
+     * Only save buffers for the input queue if the channel is readable.
+     */
+    
+    if (chanPtr->flags & TCL_READABLE) {
+        if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+            chanPtr->inQueueHead = bufPtr;
+            chanPtr->inQueueTail = bufPtr;
+            goto keepit;
+        }
+        if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
+            chanPtr->saveInBufPtr = bufPtr;
+            goto keepit;
+        }
+    }
+
+    /*
+     * Only save buffers for the output queue if the channel is writable.
+     */
+
+    if (chanPtr->flags & TCL_WRITABLE) {
+        if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
+            chanPtr->curOutPtr = bufPtr;
+            goto keepit;
+        }
+    }
+
+    /*
+     * If we reached this code we return the buffer to the OS.
+     */
+
+    ckfree((char *) bufPtr);
+    return;
+
+keepit:
+    bufPtr->nextRemoved = 0;
+    bufPtr->nextAdded = 0;
+    bufPtr->nextPtr = (ChannelBuffer *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DiscardOutputQueued --
+ *
+ *	Discards all output queued in the output queue of a channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Recycles buffers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DiscardOutputQueued(chanPtr)
+    Channel *chanPtr;		/* The channel for which to discard output. */
+{
+    ChannelBuffer *bufPtr;
+    
+    while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
+        bufPtr = chanPtr->outQueueHead;
+        chanPtr->outQueueHead = bufPtr->nextPtr;
+        RecycleBuffer(chanPtr, bufPtr, 0);
+    }
+    chanPtr->outQueueHead = (ChannelBuffer *) NULL;
+    chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ *	now. If calledFromAsyncFlush is nonzero, it is being called in an
+ *	event handler to flush channel output asynchronously.
+ *
+ * Results:
+ *	0 if successful, else the error code that was returned by the
+ *	channel type operation.
+ *
+ * Side effects:
+ *	May produce output on a channel. May block indefinitely if the
+ *	channel is synchronous. May schedule an async flush on the channel.
+ *	May recycle memory for buffers in the output queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FlushChannel(interp, chanPtr, calledFromAsyncFlush)
+    Tcl_Interp *interp;			/* For error reporting during close. */
+    Channel *chanPtr;			/* The channel to flush on. */
+    int calledFromAsyncFlush;		/* If nonzero then we are being
+                                         * called from an asynchronous
+                                         * flush callback. */
+{
+    ChannelBuffer *bufPtr;		/* Iterates over buffered output
+                                         * queue. */
+    int toWrite;			/* Amount of output data in current
+                                         * buffer available to be written. */
+    int written;			/* Amount of output data actually
+                                         * written in current round. */
+    int errorCode;			/* Stores POSIX error codes from
+                                         * channel driver operations. */
+    errorCode = 0;
+
+    /*
+     * Prevent writing on a dead channel -- a channel that has been closed
+     * but not yet deallocated. This can occur if the exit handler for the
+     * channel deallocation runs before all channels are deregistered in
+     * all interpreters.
+     */
+    
+    if (CheckForDeadChannel(interp,chanPtr)) return -1;
+    
+    /*
+     * Loop over the queued buffers and attempt to flush as
+     * much as possible of the queued output to the channel.
+     */
+
+    while (1) {
+
+        /*
+         * If the queue is empty and there is a ready current buffer, OR if
+         * the current buffer is full, then move the current buffer to the
+         * queue.
+         */
+        
+        if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
+                (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufSize))
+                || ((chanPtr->flags & BUFFER_READY) &&
+                        (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
+            chanPtr->flags &= (~(BUFFER_READY));
+            chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
+            if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
+                chanPtr->outQueueHead = chanPtr->curOutPtr;
+            } else {
+                chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
+            }
+            chanPtr->outQueueTail = chanPtr->curOutPtr;
+            chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+        }
+        bufPtr = chanPtr->outQueueHead;
+
+        /*
+         * If we are not being called from an async flush and an async
+         * flush is active, we just return without producing any output.
+         */
+
+        if ((!calledFromAsyncFlush) &&
+                (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+            return 0;
+        }
+
+        /*
+         * If the output queue is still empty, break out of the while loop.
+         */
+
+        if (bufPtr == (ChannelBuffer *) NULL) {
+            break;	/* Out of the "while (1)". */
+        }
+
+        /*
+         * Produce the output on the channel.
+         */
+        
+        toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
+        written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
+                bufPtr->buf + bufPtr->nextRemoved, toWrite, &errorCode);
+            
+	/*
+         * If the write failed completely attempt to start the asynchronous
+         * flush mechanism and break out of this loop - do not attempt to
+         * write any more output at this time.
+         */
+
+        if (written < 0) {
+            
+            /*
+             * If the last attempt to write was interrupted, simply retry.
+             */
+            
+            if (errorCode == EINTR) {
+                errorCode = 0;
+                continue;
+            }
+
+            /*
+             * 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)) {
+			chanPtr->flags |= BG_FLUSH_SCHEDULED;
+			UpdateInterest(chanPtr);
+                    }
+                    errorCode = 0;
+                    break;
+		} else {
+		    panic("Blocking channel driver did not block on output");
+                }
+            }
+
+            /*
+             * Decide whether to report the error upwards or defer it.
+             */
+
+            if (calledFromAsyncFlush) {
+                if (chanPtr->unreportedError == 0) {
+                    chanPtr->unreportedError = errorCode;
+                }
+            } else {
+                Tcl_SetErrno(errorCode);
+		if (interp != NULL) {
+		    Tcl_SetResult(interp,
+			    Tcl_PosixError(interp), TCL_VOLATILE);
+		}
+            }
+
+            /*
+             * When we get an error we throw away all the output
+             * currently queued.
+             */
+
+            DiscardOutputQueued(chanPtr);
+            continue;
+        }
+
+        bufPtr->nextRemoved += written;
+
+        /*
+         * If this buffer is now empty, recycle it.
+         */
+
+        if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+            chanPtr->outQueueHead = bufPtr->nextPtr;
+            if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
+                chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+            }
+            RecycleBuffer(chanPtr, bufPtr, 0);
+        }
+    }	/* Closes "while (1)". */
+    
+    /*
+     * 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));
+	(chanPtr->typePtr->watchProc)(chanPtr->instanceData,
+		chanPtr->interestMask);
+    }
+
+    /*
+     * 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.
+     */
+
+    if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
+            (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
+            ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
+                    (chanPtr->curOutPtr->nextAdded ==
+                            chanPtr->curOutPtr->nextRemoved))) {
+        return CloseChannel(interp, chanPtr, errorCode);
+    }
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseChannel --
+ *
+ *	Utility procedure to close a channel and free its associated
+ *	resources.
+ *
+ * Results:
+ *	0 on success or a POSIX error code if the operation failed.
+ *
+ * Side effects:
+ *	May close the actual channel; may free memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseChannel(interp, chanPtr, errorCode)
+    Tcl_Interp *interp;			/* For error reporting. */
+    Channel *chanPtr;			/* The channel to close. */
+    int errorCode;			/* Status of operation so far. */
+{
+    int result = 0;			/* Of calling driver close
+                                         * operation. */
+    Channel *prevChanPtr;		/* Preceding channel in list of
+                                         * all channels - used to splice a
+                                         * channel out of the list on close. */
+        
+    if (chanPtr == NULL) {
+        return result;
+    }
+    
+    /*
+     * No more input can be consumed so discard any leftover input.
+     */
+
+    DiscardInputQueued(chanPtr, 1);
+
+    /*
+     * Discard a leftover buffer in the current output buffer field.
+     */
+
+    if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
+        ckfree((char *) chanPtr->curOutPtr);
+        chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+    }
+    
+    /*
+     * The caller guarantees that there are no more buffers
+     * queued for output.
+     */
+
+    if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
+        panic("TclFlush, closed channel: queued output left");
+    }
+
+    /*
+     * If the EOF character is set in the channel, append that to the
+     * output device.
+     */
+
+    if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
+        int dummy;
+        char c;
+
+        c = (char) chanPtr->outEofChar;
+        (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
+    }
+
+    /*
+     * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
+     * that close callbacks can not do input or output (assuming they
+     * squirreled the channel away in their clientData). This also
+     * prevents infinite loops if the callback calls any C API that
+     * could call FlushChannel.
+     */
+
+    chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
+        
+    /*
+     * Splice this channel out of the list of all channels.
+     */
+
+    if (chanPtr == firstChanPtr) {
+        firstChanPtr = chanPtr->nextChanPtr;
+    } else {
+        for (prevChanPtr = firstChanPtr;
+                 (prevChanPtr != (Channel *) NULL) &&
+                     (prevChanPtr->nextChanPtr != chanPtr);
+                 prevChanPtr = prevChanPtr->nextChanPtr) {
+            /* Empty loop body. */
+        }
+        if (prevChanPtr == (Channel *) NULL) {
+            panic("FlushChannel: damaged channel list");
+        }
+        prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
+    }
+
+    /*
+     * OK, close the channel itself.
+     */
+        
+    result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp);
+    
+    if (chanPtr->channelName != (char *) NULL) {
+        ckfree(chanPtr->channelName);
+    }
+    
+    /*
+     * If we are being called synchronously, report either
+     * any latent error on the channel or the current error.
+     */
+        
+    if (chanPtr->unreportedError != 0) {
+        errorCode = chanPtr->unreportedError;
+    }
+    if (errorCode == 0) {
+        errorCode = result;
+        if (errorCode != 0) {
+            Tcl_SetErrno(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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Close --
+ *
+ *	Closes a channel.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Closes the channel if this is the last reference.
+ *
+ * NOTE:
+ *	Tcl_Close removes the channel as far as the user is concerned.
+ *	However, it may continue to exist for a while longer if it has
+ *	a background flush scheduled. The device itself is eventually
+ *	closed and the channel record removed, in CloseChannel, above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_Close(interp, chan)
+    Tcl_Interp *interp;			/* Interpreter for errors. */
+    Tcl_Channel chan;			/* The channel being closed. Must
+                                         * not be referenced in any
+                                         * interpreter. */
+{
+    ChannelHandler *chPtr, *chNext;	/* Iterate over channel handlers. */
+    CloseCallback *cbPtr;		/* Iterate over close callbacks
+                                         * for this channel. */
+    EventScriptRecord *ePtr, *eNextPtr;	/* Iterate over eventscript records. */
+    Channel *chanPtr;			/* The real IO channel. */
+    int result;				/* Of calling FlushChannel. */
+    NextChannelHandler *nhPtr;
+
+    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");
+    }
+
+    /*
+     * 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;
+        }
+    }
+
+    /*
+     * Remove all the channel handler records attached to the channel
+     * itself.
+     */
+        
+    for (chPtr = chanPtr->chPtr;
+             chPtr != (ChannelHandler *) NULL;
+             chPtr = chNext) {
+        chNext = chPtr->nextPtr;
+        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
+     * will occur if Tcl_DoOneEvent is called before the channel is
+     * finally deleted in FlushChannel. This can happen if the channel
+     * has a background flush active.
+     */
+        
+    chanPtr->interestMask = 0;
+    
+    /*
+     * Remove any EventScript records for this channel.
+     */
+
+    for (ePtr = chanPtr->scriptRecordPtr;
+             ePtr != (EventScriptRecord *) NULL;
+             ePtr = eNextPtr) {
+        eNextPtr = ePtr->nextPtr;
+	ckfree(ePtr->script);
+        ckfree((char *) ePtr);
+    }
+    chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+        
+    /*
+     * Invoke the registered close callbacks and delete their records.
+     */
+
+    while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
+        cbPtr = chanPtr->closeCbPtr;
+        chanPtr->closeCbPtr = cbPtr->nextPtr;
+        (cbPtr->proc) (cbPtr->clientData);
+        ckfree((char *) cbPtr);
+    }
+
+    /*
+     * Ensure that the last output buffer will be flushed.
+     */
+    
+    if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
+           (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
+        chanPtr->flags |= BUFFER_READY;
+    }
+
+    /*
+     * The call to FlushChannel will flush any queued output and invoke
+     * the close function of the channel driver, or it will set up the
+     * channel to be flushed and closed asynchronously.
+     */
+    
+    chanPtr->flags |= CHANNEL_CLOSED;
+    result = FlushChannel(interp, chanPtr, 0);
+    if (result != 0) {
+        return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Write --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Write(chan, srcPtr, slen)
+    Tcl_Channel chan;			/* The channel to buffer output for. */
+    char *srcPtr;			/* Output to buffer. */
+    int slen;				/* Its length. Negative means
+                                         * the output is null terminated
+                                         * and we must compute its length. */
+{
+    Channel *chanPtr = (Channel *) chan;
+
+    /*
+     * Check for unreported error.
+     */
+
+    if (chanPtr->unreportedError != 0) {
+        Tcl_SetErrno(chanPtr->unreportedError);
+        chanPtr->unreportedError = 0;
+        return -1;
+    }
+    
+    /*
+     * If the channel is not open for writing punt.
+     */
+
+    if (!(chanPtr->flags & TCL_WRITABLE)) {
+        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 length passed is negative, assume that the output is null terminated
+     * and compute its length.
+     */
+    
+    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.
+     */
+
+    crsent = 0;
+    
+    /*
+     * Loop filling buffers and flushing them until all output has been
+     * consumed.
+     */
+
+    srcCopied = 0;
+    totalDestCopied = 0;
+
+    while (slen > 0) {
+        
+        /*
+         * Make sure there is a current output buffer to accept output.
+         */
+
+        if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
+            chanPtr->curOutPtr = (ChannelBuffer *) ckalloc((unsigned)
+                    (CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
+            chanPtr->curOutPtr->nextAdded = 0;
+            chanPtr->curOutPtr->nextRemoved = 0;
+            chanPtr->curOutPtr->bufSize = chanPtr->bufSize;
+            chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
+        }
+
+        outBufPtr = chanPtr->curOutPtr;
+
+        destCopied = outBufPtr->bufSize - outBufPtr->nextAdded;
+        if (destCopied > slen) {
+            destCopied = slen;
+        }
+        
+        destPtr = outBufPtr->buf + outBufPtr->nextAdded;
+        switch (chanPtr->outputTranslation) {
+            case TCL_TRANSLATE_LF:
+                srcCopied = destCopied;
+                memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
+                break;
+            case TCL_TRANSLATE_CR:
+                srcCopied = destCopied;
+                memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
+                for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
+                    if (*dPtr == '\n') {
+                        *dPtr = '\r';
+                    }
+                }
+                break;
+            case TCL_TRANSLATE_CRLF:
+                for (srcCopied = 0, dPtr = destPtr, sPtr = srcPtr;
+                     dPtr < destPtr + destCopied;
+                     dPtr++, sPtr++, srcCopied++) {
+                    if (*sPtr == '\n') {
+                        if (crsent) {
+                            *dPtr = '\n';
+                            crsent = 0;
+                        } else {
+                            *dPtr = '\r';
+                            crsent = 1;
+                            sPtr--, srcCopied--;
+                        }
+                    } else {
+                        *dPtr = *sPtr;
+                    }
+                }
+                break;
+            case TCL_TRANSLATE_AUTO:
+                panic("Tcl_Write: AUTO output translation mode not supported");
+            default:
+                panic("Tcl_Write: unknown output translation mode");
+        }
+
+        /*
+         * The current buffer is ready for output if it is full, or if it
+         * contains a newline and this channel is line-buffered, or if it
+         * contains any output and this channel is unbuffered.
+         */
+
+        outBufPtr->nextAdded += destCopied;
+        if (!(chanPtr->flags & BUFFER_READY)) {
+            if (outBufPtr->nextAdded == outBufPtr->bufSize) {
+                chanPtr->flags |= BUFFER_READY;
+            } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+                for (sPtr = srcPtr, i = 0, foundNewline = 0;
+                         (i < srcCopied) && (!foundNewline);
+                         i++, sPtr++) {
+                    if (*sPtr == '\n') {
+                        foundNewline = 1;
+                        break;
+                    }
+                }
+                if (foundNewline) {
+                    chanPtr->flags |= BUFFER_READY;
+                }
+            } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
+                chanPtr->flags |= BUFFER_READY;
+            }
+        }
+        
+        totalDestCopied += srcCopied;
+        srcPtr += srcCopied;
+        slen -= srcCopied;
+
+        if (chanPtr->flags & BUFFER_READY) {
+            if (FlushChannel(NULL, chanPtr, 0) != 0) {
+                return -1;
+            }
+        }
+    } /* Closes "while" */
+
+    return totalDestCopied;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Flush --
+ *
+ *	Flushes output data on a channel.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May flush output queued on this channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Flush(chan)
+    Tcl_Channel chan;			/* The Channel to flush. */
+{
+    int result;				/* Of calling FlushChannel. */
+    Channel *chanPtr;			/* The actual channel. */
+
+    chanPtr = (Channel *) chan;
+
+    /*
+     * Check for unreported error.
+     */
+
+    if (chanPtr->unreportedError != 0) {
+        Tcl_SetErrno(chanPtr->unreportedError);
+        chanPtr->unreportedError = 0;
+        return TCL_ERROR;
+    }
+
+    /*
+     * If the channel is not open for writing punt.
+     */
+
+    if (!(chanPtr->flags & TCL_WRITABLE)) {
+        Tcl_SetErrno(EACCES);
+        return TCL_ERROR;
+    }
+    
+    /*
+     * 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.
+     */
+    
+    if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
+            (chanPtr->curOutPtr->nextAdded > 0)) {
+        chanPtr->flags |= BUFFER_READY;
+    }
+    
+    result = FlushChannel(NULL, chanPtr, 0);
+    if (result != 0) {
+        return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DiscardInputQueued --
+ *
+ *	Discards any input read from the channel but not yet consumed
+ *	by Tcl reading commands.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May discard input from the channel. If discardLastBuffer is zero,
+ *	leaves one buffer in place for back-filling.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DiscardInputQueued(chanPtr, discardSavedBuffers)
+    Channel *chanPtr;		/* Channel on which to discard
+                                 * the queued input. */
+    int discardSavedBuffers;	/* If non-zero, discard all buffers including
+                                 * last one. */
+{
+    ChannelBuffer *bufPtr, *nxtPtr;	/* Loop variables. */
+
+    bufPtr = chanPtr->inQueueHead;
+    chanPtr->inQueueHead = (ChannelBuffer *) NULL;
+    chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+    for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
+        nxtPtr = bufPtr->nextPtr;
+        RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
+    }
+
+    /*
+     * If discardSavedBuffers is nonzero, must also discard any previously
+     * saved buffer in the saveInBufPtr field.
+     */
+    
+    if (discardSavedBuffers) {
+        if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
+            ckfree((char *) chanPtr->saveInBufPtr);
+            chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetInput --
+ *
+ *	Reads input data from a device or file into an input buffer.
+ *
+ * Results:
+ *	A Posix error code or 0.
+ *
+ * Side effects:
+ *	Reads from the underlying device.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetInput(chanPtr)
+    Channel *chanPtr;			/* Channel to read input from. */
+{
+    int toRead;				/* How much to read? */
+    int result;				/* Of calling driver. */
+    int nread;				/* How much was read from channel? */
+    ChannelBuffer *bufPtr;		/* New buffer to add to input queue. */
+
+    /*
+     * Prevent reading from a dead channel -- a channel that has been closed
+     * but not yet deallocated, which can happen if the exit handler for
+     * channel cleanup has run but the channel is still registered in some
+     * interpreter.
+     */
+    
+    if (CheckForDeadChannel(NULL,chanPtr)) return EINVAL;
+
+    /*
+     * See if we can fill an existing buffer. If we can, read only
+     * as much as will fit in it. Otherwise allocate a new buffer,
+     * add it to the input queue and attempt to fill it to the max.
+     */
+
+    if ((chanPtr->inQueueTail != (ChannelBuffer *) NULL) &&
+           (chanPtr->inQueueTail->nextAdded < chanPtr->inQueueTail->bufSize)) {
+        bufPtr = chanPtr->inQueueTail;
+        toRead = bufPtr->bufSize - bufPtr->nextAdded;
+    } else {
+	if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
+	    bufPtr = chanPtr->saveInBufPtr;
+	    chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
+	} else {
+	    bufPtr = (ChannelBuffer *) ckalloc(
+		((unsigned) CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
+	    bufPtr->bufSize = chanPtr->bufSize;
+	}
+	bufPtr->nextRemoved = 0;
+	bufPtr->nextAdded = 0;
+        toRead = bufPtr->bufSize;
+        if (chanPtr->inQueueTail == (ChannelBuffer *) NULL) {
+            chanPtr->inQueueHead = bufPtr;
+        } else {
+            chanPtr->inQueueTail->nextPtr = bufPtr;
+        }
+        chanPtr->inQueueTail = bufPtr;
+        bufPtr->nextPtr = (ChannelBuffer *) NULL;
+    }
+      
+    /*
+     * 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) {
+	return 0;
+    }
+
+    nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
+	    bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+
+    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;
+	}
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyAndTranslateBuffer --
+ *
+ *	Copy at most one buffer of input to the result space, doing
+ *	eol translations according to mode in effect currently.
+ *
+ * Results:
+ *	Number of characters (as opposed to bytes) copied. May return
+ *	zero if no input is available to be translated.
+ *
+ * Side effects:
+ *	Consumes buffered input. May deallocate one buffer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyAndTranslateBuffer(chanPtr, result, space)
+    Channel *chanPtr;		/* The channel from which to read input. */
+    char *result;		/* Where to store the copied input. */
+    int space;			/* How many bytes are available in result
+                                 * to store the copied input? */
+{
+    int bytesInBuffer;		/* How many bytes are available to be
+                                 * copied in the current input buffer? */
+    int copied;			/* How many characters were already copied
+                                 * into the destination space? */
+    ChannelBuffer *bufPtr;	/* The buffer from which to copy bytes. */
+    char curByte;		/* The byte we are currently translating. */
+    int i;			/* Iterates over the copied input looking
+                                 * for the input eofChar. */
+    
+    /*
+     * If there is no input at all, return zero. The invariant is that either
+     * there is no buffer in the queue, or if the first buffer is empty, it
+     * is also the last buffer (and thus there is no input in the queue).
+     * Note also that if the buffer is empty, we leave it in the queue.
+     */
+    
+    if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+        return 0;
+    }
+    bufPtr = chanPtr->inQueueHead;
+    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+    if (bytesInBuffer < space) {
+        space = bytesInBuffer;
+    }
+    copied = 0;
+    switch (chanPtr->inputTranslation) {
+        case TCL_TRANSLATE_LF:
+
+            if (space == 0) {
+                return 0;
+            }
+            
+	    /*
+             * Copy the current chunk into the result buffer.
+             */
+
+            memcpy((VOID *) result,
+                    (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
+                    (size_t) space);
+            bufPtr->nextRemoved += space;
+            copied = space;
+            break;
+
+        case TCL_TRANSLATE_CR:
+
+            if (space == 0) {
+                return 0;
+            }
+
+	    /*
+             * Copy the current chunk into the result buffer, then
+             * replace all \r with \n.
+             */
+
+            memcpy((VOID *) result,
+                    (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
+                    (size_t) space);
+            bufPtr->nextRemoved += space;
+            for (copied = 0; copied < space; copied++) {
+                if (result[copied] == '\r') {
+                    result[copied] = '\n';
+                }
+            }
+            break;
+
+        case TCL_TRANSLATE_CRLF:
+
+            /*
+             * If there is a held-back "\r" at EOF, produce it now.
+             */
+            
+            if (space == 0) {
+                if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
+                        (INPUT_SAW_CR | CHANNEL_EOF)) {
+                    result[0] = '\r';
+                    chanPtr->flags &= (~(INPUT_SAW_CR));
+                    return 1;
+                }
+                return 0;
+            }
+
+            /*
+             * Copy the current chunk and replace "\r\n" with "\n"
+             * (but not standalone "\r"!).
+             */
+
+            for (copied = 0;
+                     (copied < space) &&
+                         (bufPtr->nextRemoved < bufPtr->nextAdded);
+                     copied++) {
+                curByte = bufPtr->buf[bufPtr->nextRemoved];
+                bufPtr->nextRemoved++;
+                if (curByte == '\r') {
+                    if (chanPtr->flags & INPUT_SAW_CR) {
+                        result[copied] = '\r';
+                    } else {
+                        chanPtr->flags |= INPUT_SAW_CR;
+                        copied--;
+                    }
+                } else if (curByte == '\n') {
+                    chanPtr->flags &= (~(INPUT_SAW_CR));
+                    result[copied] = '\n';
+                } else {
+                    if (chanPtr->flags & INPUT_SAW_CR) {
+                        chanPtr->flags &= (~(INPUT_SAW_CR));
+                        result[copied] = '\r';
+                        bufPtr->nextRemoved--;
+                    } else {
+                        result[copied] = curByte;
+                    }
+                }
+            }
+            break;
+                
+        case TCL_TRANSLATE_AUTO:
+            
+            if (space == 0) {
+                return 0;
+            }
+
+            /*
+             * Loop over the current buffer, converting "\r" and "\r\n"
+             * to "\n".
+             */
+
+            for (copied = 0;
+                     (copied < space) &&
+                         (bufPtr->nextRemoved < bufPtr->nextAdded); ) {
+                curByte = bufPtr->buf[bufPtr->nextRemoved];
+                bufPtr->nextRemoved++;
+                if (curByte == '\r') {
+                    result[copied] = '\n';
+		    copied++;
+                    if (bufPtr->nextRemoved < bufPtr->nextAdded) {
+                        if (bufPtr->buf[bufPtr->nextRemoved] == '\n') {
+                            bufPtr->nextRemoved++;
+                        }
+                        chanPtr->flags &= (~(INPUT_SAW_CR));
+                    } else {
+                        chanPtr->flags |= INPUT_SAW_CR;
+                    }
+                } else {
+                    if (curByte == '\n') {
+                        if (!(chanPtr->flags & INPUT_SAW_CR)) {
+                            result[copied] = '\n';
+			    copied++;
+                        }
+                    } else {
+                        result[copied] = curByte;
+			copied++;
+                    }
+                    chanPtr->flags &= (~(INPUT_SAW_CR));
+                }
+            }
+            break;
+
+        default:
+            panic("unknown eol translation mode");
+    }
+
+    /*
+     * If an in-stream EOF character is set for this channel,, check that
+     * the input we copied so far does not contain the EOF char. If it does,
+     * copy only up to and excluding that character.
+     */
+    
+    if (chanPtr->inEofChar != 0) {
+        for (i = 0; i < copied; i++) {
+            if (result[i] == (char) chanPtr->inEofChar) {
+                break;
+            }
+        }
+        if (i < copied) {
+
+            /*
+             * Set sticky EOF so that no further input is presented
+             * to the caller.
+             */
+            
+            chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+
+            /*
+             * Reset the start of valid data in the input buffer to the
+             * position of the eofChar, so that subsequent reads will
+             * encounter it immediately. First we set it to the position
+             * of the last byte consumed if all result bytes were the
+             * product of one input byte; since it is possible that "\r\n"
+             * contracted to "\n" in the result, we have to search back
+             * from that position until we find the eofChar, because it
+             * is possible that its actual position in the buffer is n
+             * bytes further back (n is the number of "\r\n" sequences
+             * that were contracted to "\n" in the result).
+             */
+                  
+            bufPtr->nextRemoved -= (copied - i);
+            while ((bufPtr->nextRemoved > 0) &&
+                    (bufPtr->buf[bufPtr->nextRemoved] !=
+                            (char) chanPtr->inEofChar)) {
+                bufPtr->nextRemoved--;
+            }
+            copied = i;
+        }
+    }
+
+    /*
+     * If the current buffer is empty recycle it.
+     */
+
+    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+        chanPtr->inQueueHead = bufPtr->nextPtr;
+        if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+            chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+        }
+        RecycleBuffer(chanPtr, bufPtr, 0);
+    }
+
+    /*
+     * Return the number of characters copied into the result buffer.
+     * This may be different from the number of bytes consumed, because
+     * of EOL translations.
+     */
+
+    return copied;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScanBufferForEOL --
+ *
+ *	Scans one buffer for EOL according to the specified EOL
+ *	translation mode. If it sees the input eofChar for the channel
+ *	it stops also.
+ *
+ * Results:
+ *	TRUE if EOL is found, FALSE otherwise. Also sets output parameter
+ *	bytesToEOLPtr to the number of bytes so far to EOL, and crSeenPtr
+ *	to whether a "\r" was seen.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ScanBufferForEOL(chanPtr, bufPtr, translation, eofChar, bytesToEOLPtr,
+                 crSeenPtr)
+    Channel *chanPtr;
+    ChannelBuffer *bufPtr;		/* Buffer to scan for EOL. */
+    Tcl_EolTranslation translation;	/* Translation mode to use. */
+    int eofChar;			/* EOF char to look for. */
+    int *bytesToEOLPtr;			/* Running counter. */
+    int *crSeenPtr;			/* Has "\r" been seen? */
+{
+    char *rPtr;				/* Iterates over input string. */
+    char *sPtr;				/* Where to stop search? */
+    int EOLFound;
+    int bytesToEOL;
+    
+    for (EOLFound = 0, rPtr = bufPtr->buf + bufPtr->nextRemoved,
+             sPtr = bufPtr->buf + bufPtr->nextAdded,
+             bytesToEOL = *bytesToEOLPtr;
+             (!EOLFound) && (rPtr < sPtr);
+             rPtr++) {
+        switch (translation) {
+            case TCL_TRANSLATE_AUTO:
+                if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
+                    chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+                    EOLFound = 1;
+                } else if (*rPtr == '\n') {
+
+		    /*
+                     * CopyAndTranslateBuffer wants to know the length
+                     * of the result, not the input. The input is one
+                     * larger because "\r\n" shrinks to "\n".
+                     */
+
+                    if (!(*crSeenPtr)) {
+                        bytesToEOL++;
+			EOLFound = 1;
+                    } else {
+
+			/*
+			 * This is a lf at the begining of a buffer
+			 * where the previous buffer ended in a cr.
+			 * Consume this lf because we've already emitted
+			 * the newline for this crlf sequence. ALSO, if
+                         * bytesToEOL is 0 (which means that we are at the
+                         * first character of the scan), unset the
+                         * INPUT_SAW_CR flag in the channel, because we
+                         * already handled it; leaving it set would cause
+                         * CopyAndTranslateBuffer to potentially consume
+                         * another lf if one follows the current byte.
+			 */
+
+			bufPtr->nextRemoved++;
+                        *crSeenPtr = 0;
+                        chanPtr->flags &= (~(INPUT_SAW_CR));
+		    }
+                } else if (*rPtr == '\r') {
+                    bytesToEOL++;
+                    EOLFound = 1;
+                } else {
+                    *crSeenPtr = 0;
+                    bytesToEOL++;
+                }
+                break;
+            case TCL_TRANSLATE_LF:
+                if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
+                    chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+                    EOLFound = 1;
+                } else {
+                    if (*rPtr == '\n') {
+                        EOLFound = 1;
+                    }
+                    bytesToEOL++;
+                }
+                break;
+            case TCL_TRANSLATE_CR:
+                if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
+                    chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+                    EOLFound = 1;
+                } else {
+                    if (*rPtr == '\r') {
+                        EOLFound = 1;
+                    }
+                    bytesToEOL++;
+                }
+                break;
+            case TCL_TRANSLATE_CRLF:
+                if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
+                    chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+                    EOLFound = 1;
+                } else if (*rPtr == '\n') {
+
+                    /*
+                     * CopyAndTranslateBuffer wants to know the length
+                     * of the result, not the input. The input is one
+                     * larger because crlf shrinks to lf.
+                     */
+
+                    if (*crSeenPtr) {
+                        EOLFound = 1;
+                    } else {
+                        bytesToEOL++;
+                    }
+                } else {
+                    if (*rPtr == '\r') {
+                        *crSeenPtr = 1;
+                    } else {
+                        *crSeenPtr = 0;
+                    }
+                    bytesToEOL++;
+                }
+                break;
+            default:
+                panic("unknown eol translation mode");
+        }
+    }
+
+    *bytesToEOLPtr = bytesToEOL;
+    return EOLFound;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScanInputForEOL --
+ *
+ *	Scans queued input for chanPtr for an end of line (according to the
+ *	current EOL translation mode) and returns the number of bytes
+ *	upto and including the end of line, or -1 if none was found.
+ *
+ * Results:
+ *	Count of bytes upto and including the end of line if one is present
+ *	or -1 if none was found. Also returns in an output parameter the
+ *	number of bytes queued if no end of line was found.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ScanInputForEOL(chanPtr, bytesQueuedPtr)
+    Channel *chanPtr;	/* Channel for which to scan queued
+                                 * input for end of line. */
+    int *bytesQueuedPtr;	/* Where to store the number of bytes
+                                 * currently queued if no end of line
+                                 * was found. */
+{
+    ChannelBuffer *bufPtr;	/* Iterates over queued buffers. */
+    int bytesToEOL;		/* How many bytes to end of line? */
+    int EOLFound;		/* Did we find an end of line? */
+    int crSeen;			/* Did we see a "\r" in CRLF mode? */
+
+    *bytesQueuedPtr = 0;
+    bytesToEOL = 0;
+    EOLFound = 0;
+    for (bufPtr = chanPtr->inQueueHead,
+             crSeen = (chanPtr->flags & INPUT_SAW_CR) ? 1 : 0;
+            (!EOLFound) && (bufPtr != (ChannelBuffer *) NULL);
+            bufPtr = bufPtr->nextPtr) {
+        EOLFound = ScanBufferForEOL(chanPtr, bufPtr, chanPtr->inputTranslation,
+                chanPtr->inEofChar, &bytesToEOL, &crSeen);
+    }
+
+    if (EOLFound == 0) {
+        *bytesQueuedPtr = bytesToEOL;
+        return -1;
+    }
+    return bytesToEOL;        
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetEOL --
+ *
+ *	Accumulate input into the channel input buffer queue until an
+ *	end of line has been seen.
+ *
+ * Results:
+ *	Number of bytes buffered (at least 1) or -1 on failure.
+ *
+ * Side effects:
+ *	Consumes input from the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetEOL(chanPtr)
+    Channel *chanPtr;	/* Channel to queue input on. */
+{
+    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) {
+            chanPtr->flags &= (~(CHANNEL_BLOCKED));
+            return bytesToEOL;
+        }
+        if (chanPtr->flags & CHANNEL_EOF) {
+	    /*
+	     * Boundary case where cr was at the end of the previous buffer
+	     * and this buffer just has a newline.  At EOF our caller wants
+	     * to see -1 for the line length.
+	     */
+            return (bytesQueued == 0) ? -1 : bytesQueued ;
+        }
+        if (chanPtr->flags & CHANNEL_BLOCKED) {
+            if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+		goto blocked;
+            }
+            chanPtr->flags &= (~(CHANNEL_BLOCKED));
+        }
+	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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Read --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Read(chan, bufPtr, toRead)
+    Tcl_Channel chan;		/* The channel from which to read. */
+    char *bufPtr;		/* Where to store input read. */
+    int toRead;			/* Maximum number of characters to read. */
+{
+    Channel *chanPtr;		/* The real IO channel. */
+    
+    chanPtr = (Channel *) chan;
+
+    /*
+     * 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;
+    }
+
+    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.
+     */
+
+    if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
+        chanPtr->flags &= (~(CHANNEL_EOF));
+    }
+    chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
+    
+    for (copied = 0; copied < toRead; copied += copiedNow) {
+        copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
+                toRead - copied);
+        if (copiedNow == 0) {
+            if (chanPtr->flags & CHANNEL_EOF) {
+		goto done;
+            }
+            if (chanPtr->flags & CHANNEL_BLOCKED) {
+                if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+		    goto done;
+                }
+                chanPtr->flags &= (~(CHANNEL_BLOCKED));
+            }
+            result = GetInput(chanPtr);
+            if (result != 0) {
+                if (result != EAGAIN) {
+		    copied = -1;
+                }
+		goto done;
+            }
+        }
+    }
+
+    chanPtr->flags &= (~(CHANNEL_BLOCKED));
+
+    done:
+    /*
+     * Update the notifier state so we don't block while there is still
+     * data in the buffers.
+     */
+
+    UpdateInterest(chanPtr);
+    return copied;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Gets --
+ *
+ *	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
+ *	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_Gets(chan, lineRead)
+    Tcl_Channel chan;		/* Channel from which to read. */
+    Tcl_DString *lineRead;	/* The characters of the line read
+                                 * (excluding the terminating newline if
+                                 * present) will be appended to this
+                                 * DString. 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) {
+	copiedTotal = -1;
+	goto done;
+    }
+    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);
+
+    done:
+    /*
+     * Update the notifier state so we don't block while there is still
+     * data in the buffers.
+     */
+
+    UpdateInterest(chanPtr);
+    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) {
+	copiedTotal = -1;
+	goto done;
+    }
+
+    (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);
+
+    done:
+    /*
+     * Update the notifier state so we don't block while there is still
+     * data in the buffers.
+     */
+
+    UpdateInterest(chanPtr);
+    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.
+     */
+
+    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 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;
+    }
+    chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
+
+    bufPtr = (ChannelBuffer *) ckalloc((unsigned)
+            (CHANNELBUFFER_HEADER_SIZE + len));
+    for (i = 0; i < len; i++) {
+        bufPtr->buf[i] = str[i];
+    }
+    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;
+    }
+
+    /*
+     * Update the notifier state so we don't block while there is still
+     * data in the buffers.
+     */
+
+    UpdateInterest(chanPtr);
+    return len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Seek --
+ *
+ *	Implements seeking on Tcl Channels. This is a public function
+ *	so that other C facilities may be implemented on top of it.
+ *
+ * Results:
+ *	The new access point or -1 on error. If error, use Tcl_GetErrno()
+ *	to retrieve the POSIX error code for the error that occurred.
+ *
+ * Side effects:
+ *	May flush output on the channel. May discard queued input.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Seek(chan, offset, mode)
+    Tcl_Channel chan;		/* The channel on which to seek. */
+    int offset;			/* Offset to seek to. */
+    int mode;			/* Relative to which location to seek? */
+{
+    Channel *chanPtr;		/* The real IO channel. */
+    ChannelBuffer *bufPtr;
+    int inputBuffered, outputBuffered;
+    int result;			/* Of device driver operations. */
+    int curPos;			/* Position on the device. */
+    int wasAsync;		/* Was the channel nonblocking before the
+                                 * seek operation? If so, must restore to
+                                 * nonblocking mode after the seek. */
+
+    chanPtr = (Channel *) chan;
+
+    /*
+     * Check for unreported error.
+     */
+
+    if (chanPtr->unreportedError != 0) {
+        Tcl_SetErrno(chanPtr->unreportedError);
+        chanPtr->unreportedError = 0;
+        return -1;
+    }
+
+    /*
+     * Disallow seek on channels that are open for neither writing nor
+     * reading (e.g. socket server channels).
+     */
+
+    if (!(chanPtr->flags & (TCL_WRITABLE|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;
+    }
+
+    /*
+     * 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 (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.
+     */
+
+    if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
+        Tcl_SetErrno(EINVAL);
+        return -1;
+    }
+
+    /*
+     * Compute how much input and output is buffered. If both input and
+     * output is buffered, cannot compute the current position.
+     */
+
+    for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
+             bufPtr != (ChannelBuffer *) NULL;
+             bufPtr = bufPtr->nextPtr) {
+        inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    }
+    for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
+             bufPtr != (ChannelBuffer *) NULL;
+             bufPtr = bufPtr->nextPtr) {
+        outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    }
+    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;
+    }
+
+    /*
+     * If we are seeking relative to the current position, compute the
+     * corrected offset taking into account the amount of unread input.
+     */
+
+    if (mode == SEEK_CUR) {
+        offset -= inputBuffered;
+    }
+
+    /*
+     * Discard any queued input - this input should not be read after
+     * the seek.
+     */
+
+    DiscardInputQueued(chanPtr, 0);
+
+    /*
+     * Reset EOF and BLOCKED flags. We invalidate them by moving the
+     * access point. Also clear CR related flags.
+     */
+
+    chanPtr->flags &=
+        (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
+    
+    /*
+     * If the channel is in asynchronous output mode, switch it back
+     * to synchronous mode and cancel any async flush that may be
+     * scheduled. After the flush, the channel will be put back into
+     * asynchronous output mode.
+     */
+
+    wasAsync = 0;
+    if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+        wasAsync = 1;
+        result = 0;
+        if (chanPtr->typePtr->blockModeProc != NULL) {
+            result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
+                    TCL_MODE_BLOCKING);
+        }
+        if (result != 0) {
+            Tcl_SetErrno(result);
+            return -1;
+        }
+        chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
+        if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+            chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
+        }
+    }
+    
+    /*
+     * If the flush fails we cannot recover the original position. In
+     * that case the seek is not attempted because we do not know where
+     * the access position is - instead we return the error. FlushChannel
+     * has already called Tcl_SetErrno() to report the error upwards.
+     * If the flush succeeds we do the seek also.
+     */
+    
+    if (FlushChannel(NULL, chanPtr, 0) != 0) {
+        curPos = -1;
+    } else {
+
+        /*
+         * Now seek to the new position in the channel as requested by the
+         * caller.
+         */
+
+        curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
+                (long) offset, mode, &result);
+        if (curPos == -1) {
+            Tcl_SetErrno(result);
+        }
+    }
+    
+    /*
+     * Restore to nonblocking mode if that was the previous behavior.
+     *
+     * NOTE: Even if there was an async flush active we do not restore
+     * it now because we already flushed all the queued output, above.
+     */
+    
+    if (wasAsync) {
+        chanPtr->flags |= CHANNEL_NONBLOCKING;
+        result = 0;
+        if (chanPtr->typePtr->blockModeProc != NULL) {
+            result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
+                    TCL_MODE_NONBLOCKING);
+        }
+        if (result != 0) {
+            Tcl_SetErrno(result);
+            return -1;
+        }
+    }
+
+    return curPos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Tell --
+ *
+ *	Returns the position of the next character to be read/written on
+ *	this channel.
+ *
+ * Results:
+ *	A nonnegative integer on success, -1 on failure. If failed,
+ *	use Tcl_GetErrno() to retrieve the POSIX error code for the
+ *	error that occurred.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Tell(chan)
+    Tcl_Channel chan;			/* The channel to return pos for. */
+{
+    Channel *chanPtr;			/* The actual channel to tell on. */
+    ChannelBuffer *bufPtr;
+    int inputBuffered, outputBuffered;
+    int result;				/* Of calling device driver. */
+    int curPos;				/* Position on device. */
+
+    chanPtr = (Channel *) chan;
+
+    /*
+     * Check for unreported error.
+     */
+
+    if (chanPtr->unreportedError != 0) {
+        Tcl_SetErrno(chanPtr->unreportedError);
+        chanPtr->unreportedError = 0;
+        return -1;
+    }
+
+    /*
+     * Disallow tell 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 (CheckForDeadChannel(NULL,chanPtr)) return -1;
+
+    /*
+     * Disallow tell on channels that are open for neither
+     * writing nor reading (e.g. socket server channels).
+     */
+
+    if (!(chanPtr->flags & (TCL_WRITABLE|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;
+    }
+
+    /*
+     * Disallow tell on channels whose type does not have a seek procedure
+     * defined. This means that the channel does not support seeking.
+     */
+
+    if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
+        Tcl_SetErrno(EINVAL);
+        return -1;
+    }
+
+    /*
+     * Compute how much input and output is buffered. If both input and
+     * output is buffered, cannot compute the current position.
+     */
+
+    for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
+             bufPtr != (ChannelBuffer *) NULL;
+             bufPtr = bufPtr->nextPtr) {
+        inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    }
+    for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
+             bufPtr != (ChannelBuffer *) NULL;
+             bufPtr = bufPtr->nextPtr) {
+        outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    }
+    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;
+    }
+
+    /*
+     * Get the current position in the device and compute the position
+     * where the next character will be read or written.
+     */
+
+    curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
+            (long) 0, SEEK_CUR, &result);
+    if (curPos == -1) {
+        Tcl_SetErrno(result);
+        return -1;
+    }
+    if (inputBuffered != 0) {
+        return (curPos - inputBuffered);
+    }
+    return (curPos + outputBuffered);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Eof --
+ *
+ *	Returns 1 if the channel is at EOF, 0 otherwise.
+ *
+ * Results:
+ *	1 or 0, always.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Eof(chan)
+    Tcl_Channel chan;			/* Does this channel have EOF? */
+{
+    Channel *chanPtr;		/* The real channel structure. */
+
+    chanPtr = (Channel *) chan;
+    return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
+            ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
+        ? 1 : 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InputBlocked --
+ *
+ *	Returns 1 if input is blocked on this channel, 0 otherwise.
+ *
+ * Results:
+ *	0 or 1, always.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InputBlocked(chan)
+    Tcl_Channel chan;			/* Is this channel blocked? */
+{
+    Channel *chanPtr;		/* The real channel structure. */
+
+    chanPtr = (Channel *) chan;
+    return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InputBuffered --
+ *
+ *	Returns the number of bytes of input currently buffered in the
+ *	internal buffer of a channel.
+ *
+ * Results:
+ *	The number of input bytes buffered, or zero if the channel is not
+ *	open for reading.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InputBuffered(chan)
+    Tcl_Channel chan;			/* The channel to query. */
+{
+    Channel *chanPtr;
+    int bytesBuffered;
+    ChannelBuffer *bufPtr;
+
+    chanPtr = (Channel *) chan;
+    for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
+             bufPtr != (ChannelBuffer *) NULL;
+             bufPtr = bufPtr->nextPtr) {
+        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    }
+    return bytesBuffered;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetChannelBufferSize --
+ *
+ *	Sets the size of buffers to allocate to store input or output
+ *	in the channel. The size must be between 10 bytes and 1 MByte.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the size of buffers subsequently allocated for this channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetChannelBufferSize(chan, sz)
+    Tcl_Channel chan;			/* The channel whose buffer size
+                                         * to set. */
+    int sz;				/* The size to set. */
+{
+    Channel *chanPtr;
+    
+    /*
+     * 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)) {
+        return;
+    }
+
+    chanPtr = (Channel *) chan;
+    chanPtr->bufSize = sz;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelBufferSize --
+ *
+ *	Retrieves the size of buffers to allocate for this channel.
+ *
+ * Results:
+ *	The size.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelBufferSize(chan)
+    Tcl_Channel chan;		/* The channel for which to find the
+                                 * buffer size. */
+{
+    Channel *chanPtr;
+
+    chanPtr = (Channel *) chan;
+    return chanPtr->bufSize;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ *	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:
+ *	A standard Tcl result. Also sets the supplied DString to the
+ *	string value of the option(s) returned.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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). */
+{
+    size_t len;			/* Length of optionName string. */
+    char optionVal[128];	/* Buffer for sprintf. */
+    Channel *chanPtr = (Channel *) chan;
+    int flags;
+
+    /*
+     * 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
+     * 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 (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
+
+    /*
+     * If the optionName is NULL it means that we want a list of all
+     * options and values.
+     */
+    
+    if (optionName == (char *) NULL) {
+        len = 0;
+    } else {
+        len = strlen(optionName);
+    }
+    
+    if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-blocking", len) == 0))) {
+        if (len == 0) {
+            Tcl_DStringAppendElement(dsPtr, "-blocking");
+        }
+        Tcl_DStringAppendElement(dsPtr,
+		(flags & CHANNEL_NONBLOCKING) ? "0" : "1");
+        if (len > 0) {
+            return TCL_OK;
+        }
+    }
+    if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-buffering", len) == 0))) {
+        if (len == 0) {
+            Tcl_DStringAppendElement(dsPtr, "-buffering");
+        }
+        if (flags & CHANNEL_LINEBUFFERED) {
+            Tcl_DStringAppendElement(dsPtr, "line");
+        } else if (flags & CHANNEL_UNBUFFERED) {
+            Tcl_DStringAppendElement(dsPtr, "none");
+        } else {
+            Tcl_DStringAppendElement(dsPtr, "full");
+        }
+        if (len > 0) {
+            return TCL_OK;
+        }
+    }
+    if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-buffersize", len) == 0))) {
+        if (len == 0) {
+            Tcl_DStringAppendElement(dsPtr, "-buffersize");
+        }
+        TclFormatInt(optionVal, chanPtr->bufSize);
+        Tcl_DStringAppendElement(dsPtr, optionVal);
+        if (len > 0) {
+            return TCL_OK;
+        }
+    }
+    if ((len == 0) ||
+            ((len > 1) && (optionName[1] == 'e') &&
+                    (strncmp(optionName, "-eofchar", len) == 0))) {
+        if (len == 0) {
+            Tcl_DStringAppendElement(dsPtr, "-eofchar");
+        }
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+            Tcl_DStringStartSublist(dsPtr);
+        }
+        if (flags & TCL_READABLE) {
+            if (chanPtr->inEofChar == 0) {
+                Tcl_DStringAppendElement(dsPtr, "");
+            } else {
+                char buf[4];
+
+                sprintf(buf, "%c", chanPtr->inEofChar);
+                Tcl_DStringAppendElement(dsPtr, buf);
+            }
+        }
+        if (flags & TCL_WRITABLE) {
+            if (chanPtr->outEofChar == 0) {
+                Tcl_DStringAppendElement(dsPtr, "");
+            } else {
+                char buf[4];
+
+                sprintf(buf, "%c", chanPtr->outEofChar);
+                Tcl_DStringAppendElement(dsPtr, buf);
+            }
+        }
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+            Tcl_DStringEndSublist(dsPtr);
+        }
+        if (len > 0) {
+            return TCL_OK;
+        }
+    }
+    if ((len == 0) ||
+            ((len > 1) && (optionName[1] == 't') &&
+                    (strncmp(optionName, "-translation", len) == 0))) {
+        if (len == 0) {
+            Tcl_DStringAppendElement(dsPtr, "-translation");
+        }
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+            Tcl_DStringStartSublist(dsPtr);
+        }
+        if (flags & TCL_READABLE) {
+            if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+                Tcl_DStringAppendElement(dsPtr, "auto");
+            } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
+                Tcl_DStringAppendElement(dsPtr, "cr");
+            } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+                Tcl_DStringAppendElement(dsPtr, "crlf");
+            } else {
+                Tcl_DStringAppendElement(dsPtr, "lf");
+            }
+        }
+        if (flags & TCL_WRITABLE) {
+            if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+                Tcl_DStringAppendElement(dsPtr, "auto");
+            } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
+                Tcl_DStringAppendElement(dsPtr, "cr");
+            } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+                Tcl_DStringAppendElement(dsPtr, "crlf");
+            } else {
+                Tcl_DStringAppendElement(dsPtr, "lf");
+            }
+        }
+        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+            Tcl_DStringEndSublist(dsPtr);
+        }
+        if (len > 0) {
+            return TCL_OK;
+        }
+    }
+    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,
+		  interp, optionName, dsPtr);
+    } else {
+	/*
+	 * no driver specific options case.
+	 */
+
+        if (len == 0) {
+            return TCL_OK;
+        }
+	return Tcl_BadChannelOption(interp, optionName, NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetChannelOption --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetChannelOption(interp, chan, optionName, newValue)
+    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
+    Tcl_Channel chan;		/* Channel on which to set mode. */
+    char *optionName;		/* Which option to set? */
+    char *newValue;		/* New value for option. */
+{
+    int newMode;		/* New (numeric) mode to sert. */
+    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 (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
+    
+    len = strlen(optionName);
+
+    if ((len > 2) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-blocking", len) == 0)) {
+        if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
+            return TCL_ERROR;
+        }
+        if (newMode) {
+            newMode = TCL_MODE_BLOCKING;
+        } else {
+            newMode = TCL_MODE_NONBLOCKING;
+        }
+	return SetBlockMode(interp, chanPtr, newMode);
+    }
+
+    if ((len > 7) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-buffering", len) == 0)) {
+        len = strlen(newValue);
+        if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
+            chanPtr->flags &=
+                (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
+        } else if ((newValue[0] == 'l') &&
+                (strncmp(newValue, "line", len) == 0)) {
+            chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
+            chanPtr->flags |= CHANNEL_LINEBUFFERED;
+        } else if ((newValue[0] == 'n') &&
+                (strncmp(newValue, "none", len) == 0)) {
+            chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
+            chanPtr->flags |= CHANNEL_UNBUFFERED;
+        } else {
+            if (interp) {
+                Tcl_AppendResult(interp, "bad value for -buffering: ",
+                        "must be one of full, line, or none",
+                        (char *) NULL);
+                return TCL_ERROR;
+            }
+        }
+        return TCL_OK;
+    }
+
+    if ((len > 7) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-buffersize", len) == 0)) {
+        chanPtr->bufSize = atoi(newValue);
+        if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
+            chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+        }
+        return TCL_OK;
+    }
+    
+    if ((len > 1) && (optionName[1] == 'e') &&
+            (strncmp(optionName, "-eofchar", len) == 0)) {
+        if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
+            return TCL_ERROR;
+        }
+        if (argc == 0) {
+            chanPtr->inEofChar = 0;
+            chanPtr->outEofChar = 0;
+        } else if (argc == 1) {
+            if (chanPtr->flags & TCL_WRITABLE) {
+                chanPtr->outEofChar = (int) argv[0][0];
+            }
+            if (chanPtr->flags & TCL_READABLE) {
+                chanPtr->inEofChar = (int) argv[0][0];
+            }
+        } else if (argc != 2) {
+            if (interp) {
+                Tcl_AppendResult(interp,
+                        "bad value for -eofchar: should be a list of one or",
+                        " two elements", (char *) NULL);
+            }
+            ckfree((char *) argv);
+            return TCL_ERROR;
+        } else {
+            if (chanPtr->flags & TCL_READABLE) {
+                chanPtr->inEofChar = (int) argv[0][0];
+            }
+            if (chanPtr->flags & TCL_WRITABLE) {
+                chanPtr->outEofChar = (int) argv[1][0];
+            }
+        }
+        if (argv != (char **) NULL) {
+            ckfree((char *) argv);
+        }
+        return TCL_OK;
+    }
+
+    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) {
+	    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;
+	}
+
+	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(writeMode, "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);
+    }
+    
+    return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupChannelHandlers --
+ *
+ *	Removes channel handlers that refer to the supplied interpreter,
+ *	so that if the actual channel is not closed now, these handlers
+ *	will not run on subsequent events on the channel. This would be
+ *	erroneous, because the interpreter no longer has a reference to
+ *	this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes channel handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanupChannelHandlers(interp, chanPtr)
+    Tcl_Interp *interp;
+    Channel *chanPtr;
+{
+    EventScriptRecord *sPtr, *prevPtr, *nextPtr;
+
+    /*
+     * Remove fileevent records on this channel that refer to the
+     * given interpreter.
+     */
+    
+    for (sPtr = chanPtr->scriptRecordPtr,
+             prevPtr = (EventScriptRecord *) NULL;
+             sPtr != (EventScriptRecord *) NULL;
+             sPtr = nextPtr) {
+        nextPtr = sPtr->nextPtr;
+        if (sPtr->interp == interp) {
+            if (prevPtr == (EventScriptRecord *) NULL) {
+                chanPtr->scriptRecordPtr = nextPtr;
+            } else {
+                prevPtr->nextPtr = nextPtr;
+            }
+
+            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                    ChannelEventScriptInvoker, (ClientData) sPtr);
+
+	    ckfree(sPtr->script);
+            ckfree((char *) sPtr);
+        } else {
+            prevPtr = sPtr;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NotifyChannel --
+ *
+ *	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:
+ *	Whatever the channel handler callback procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    Channel *chanPtr = (Channel *) channel;
+    ChannelHandler *chPtr;
+    NextChannelHandler nh;
+
+    /*
+     * Preserve the channel struct in case the script closes it.
+     */
+     
+    Tcl_Preserve((ClientData) channel);
+
+    /*
+     * 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.
+     */
+
+    if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+	FlushChannel(NULL, chanPtr, 1);
+	mask &= ~TCL_WRITABLE;
+    }
+
+    /*
+     * 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; ) {
+
+        /*
+         * If this channel handler is interested in any of the events that
+         * have occurred on the channel, invoke its procedure.
+         */
+        
+        if ((chPtr->mask & mask) != 0) {
+            nh.nextHandlerPtr = chPtr->nextPtr;
+	    (*(chPtr->proc))(chPtr->clientData, mask);
+            chPtr = nh.nextHandlerPtr;
+        } else {
+            chPtr = chPtr->nextPtr;
+	}
+    }
+
+    /*
+     * Update the notifier interest, since it may have changed after
+     * invoking event handlers.
+     */
+
+    if (chanPtr->typePtr != NULL) {
+	UpdateInterest(chanPtr);
+    }
+
+    Tcl_Release((ClientData) channel);
+
+    nestedHandlerPtr = nh.nestedHandlerPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateInterest --
+ *
+ *	Arrange for the notifier to call us back at appropriate times
+ *	based on the current state of the channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May schedule a timer or driver handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateInterest(chanPtr)
+    Channel *chanPtr;		/* Channel to update. */
+{
+    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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChannelTimerProc --
+ *
+ *	Timer handler scheduled by UpdateInterest to monitor the
+ *	channel buffers until they are empty.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke channel handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChannelTimerProc(clientData)
+    ClientData clientData;
+{
+    Channel *chanPtr = (Channel *) clientData;
+
+    if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
+	    && (chanPtr->interestMask & TCL_READABLE)
+	    && (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);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateChannelHandler --
+ *
+ *	Arrange for a given procedure to be invoked whenever the
+ *	channel indicated by the chanPtr arg becomes readable or
+ *	writable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	From now on, whenever the I/O channel given by chanPtr 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 there is already an event handler for chan, proc
+ *	and clientData, then the mask will be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateChannelHandler(chan, mask, proc, clientData)
+    Tcl_Channel chan;		/* The channel to create the handler for. */
+    int mask;			/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, and TCL_EXCEPTION:
+				 * indicates conditions under which
+				 * proc should be called. Use 0 to
+                                 * disable a registered handler. */
+    Tcl_ChannelProc *proc;	/* Procedure to call for each
+				 * selected event. */
+    ClientData clientData;	/* Arbitrary data to pass to proc. */
+{
+    ChannelHandler *chPtr;
+    Channel *chanPtr;
+
+    chanPtr = (Channel *) chan;
+    
+    /*
+     * Check whether this channel handler is not already registered. If
+     * it is not, create a new record, else reuse existing record (smash
+     * current values).
+     */
+
+    for (chPtr = chanPtr->chPtr;
+             chPtr != (ChannelHandler *) NULL;
+             chPtr = chPtr->nextPtr) {
+        if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
+                (chPtr->clientData == clientData)) {
+            break;
+        }
+    }
+    if (chPtr == (ChannelHandler *) NULL) {
+        chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
+        chPtr->mask = 0;
+        chPtr->proc = proc;
+        chPtr->clientData = clientData;
+        chPtr->chanPtr = chanPtr;
+        chPtr->nextPtr = chanPtr->chPtr;
+        chanPtr->chPtr = chPtr;
+    }
+
+    /*
+     * 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.
+     */
+
+    chPtr->mask = mask;
+
+    /*
+     * Recompute the interest mask for the channel - this call may actually
+     * be disabling an existing handler.
+     */
+    
+    chanPtr->interestMask = 0;
+    for (chPtr = chanPtr->chPtr;
+	 chPtr != (ChannelHandler *) NULL;
+	 chPtr = chPtr->nextPtr) {
+	chanPtr->interestMask |= chPtr->mask;
+    }
+
+    UpdateInterest(chanPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteChannelHandler --
+ *
+ *	Cancel a previously arranged callback arrangement for an IO
+ *	channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If a callback was previously registered for this chan, proc and
+ *	 clientData , it is removed and the callback will no longer be called
+ *	when the channel becomes ready for IO.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteChannelHandler(chan, proc, clientData)
+    Tcl_Channel chan;		/* The channel for which to remove the
+                                 * callback. */
+    Tcl_ChannelProc *proc;	/* The procedure in the callback to delete. */
+    ClientData clientData;	/* The client data in the callback
+                                 * to delete. */
+    
+{
+    ChannelHandler *chPtr, *prevChPtr;
+    Channel *chanPtr;
+    NextChannelHandler *nhPtr;
+
+    chanPtr = (Channel *) chan;
+
+    /*
+     * Find the entry and the previous one in the list.
+     */
+
+    for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
+             chPtr != (ChannelHandler *) NULL;
+             chPtr = chPtr->nextPtr) {
+        if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
+                && (chPtr->proc == proc)) {
+            break;
+        }
+        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
+     * process the next one instead - we are going to delete *this* one.
+     */
+
+    for (nhPtr = nestedHandlerPtr;
+             nhPtr != (NextChannelHandler *) NULL;
+             nhPtr = nhPtr->nestedHandlerPtr) {
+        if (nhPtr->nextHandlerPtr == chPtr) {
+            nhPtr->nextHandlerPtr = chPtr->nextPtr;
+        }
+    }
+
+    /*
+     * Splice it out of the list of channel handlers.
+     */
+    
+    if (prevChPtr == (ChannelHandler *) NULL) {
+        chanPtr->chPtr = chPtr->nextPtr;
+    } else {
+        prevChPtr->nextPtr = chPtr->nextPtr;
+    }
+    ckfree((char *) chPtr);
+
+    /*
+     * Recompute the interest list for the channel, so that infinite loops
+     * will not result if Tcl_DeleteChanelHandler is called inside an event.
+     */
+
+    chanPtr->interestMask = 0;
+    for (chPtr = chanPtr->chPtr;
+             chPtr != (ChannelHandler *) NULL;
+             chPtr = chPtr->nextPtr) {
+        chanPtr->interestMask |= chPtr->mask;
+    }
+
+    UpdateInterest(chanPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteScriptRecord --
+ *
+ *	Delete a script record for this combination of channel, interp
+ *	and mask.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes a script record and cancels a channel event handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteScriptRecord(interp, chanPtr, mask)
+    Tcl_Interp *interp;		/* Interpreter in which script was to be
+                                 * executed. */
+    Channel *chanPtr;		/* The channel for which to delete the
+                                 * script record (if any). */
+    int mask;			/* Events in mask must exactly match mask
+                                 * of script to delete. */
+{
+    EventScriptRecord *esPtr, *prevEsPtr;
+
+    for (esPtr = chanPtr->scriptRecordPtr,
+             prevEsPtr = (EventScriptRecord *) NULL;
+             esPtr != (EventScriptRecord *) NULL;
+             prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
+        if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
+            if (esPtr == chanPtr->scriptRecordPtr) {
+                chanPtr->scriptRecordPtr = esPtr->nextPtr;
+            } else {
+                prevEsPtr->nextPtr = esPtr->nextPtr;
+            }
+
+            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                    ChannelEventScriptInvoker, (ClientData) esPtr);
+            
+	    ckfree(esPtr->script);
+            ckfree((char *) esPtr);
+
+            break;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateScriptRecord --
+ *
+ *	Creates a record to store a script to be executed when a specific
+ *	event fires on a specific channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Causes the script to be stored for later execution.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CreateScriptRecord(interp, chanPtr, mask, script)
+    Tcl_Interp *interp;			/* Interpreter in which to execute
+                                         * the stored script. */
+    Channel *chanPtr;			/* Channel for which script is to
+                                         * be stored. */
+    int mask;				/* Set of events for which script
+                                         * will be invoked. */
+    char *script;			/* A copy of this script is stored
+                                         * in the newly created record. */
+{
+    EventScriptRecord *esPtr;
+
+    for (esPtr = chanPtr->scriptRecordPtr;
+             esPtr != (EventScriptRecord *) NULL;
+             esPtr = esPtr->nextPtr) {
+        if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
+	    ckfree(esPtr->script);
+            esPtr->script = (char *) NULL;
+            break;
+        }
+    }
+    if (esPtr == (EventScriptRecord *) NULL) {
+        esPtr = (EventScriptRecord *) ckalloc((unsigned)
+                sizeof(EventScriptRecord));
+        Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+                ChannelEventScriptInvoker, (ClientData) esPtr);
+        esPtr->nextPtr = chanPtr->scriptRecordPtr;
+        chanPtr->scriptRecordPtr = esPtr;
+    }
+    esPtr->chanPtr = chanPtr;
+    esPtr->interp = interp;
+    esPtr->mask = mask;
+    esPtr->script = ckalloc((unsigned) (strlen(script) + 1));
+    strcpy(esPtr->script, script);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChannelEventScriptInvoker --
+ *
+ *	Invokes a script scheduled by "fileevent" for when the channel
+ *	becomes ready for IO. This function is invoked by the channel
+ *	handler which was created by the Tcl "fileevent" command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Whatever the script does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChannelEventScriptInvoker(clientData, mask)
+    ClientData clientData;	/* The script+interp record. */
+    int mask;			/* Not used. */
+{
+    Tcl_Interp *interp;		/* Interpreter in which to eval the script. */
+    Channel *chanPtr;		/* The channel for which this handler is
+                                 * registered. */
+    char *script;		/* Script to eval. */
+    EventScriptRecord *esPtr;	/* The event script + interpreter to eval it
+                                 * in. */
+    int result;			/* Result of call to eval script. */
+
+    esPtr = (EventScriptRecord *) clientData;
+
+    chanPtr = esPtr->chanPtr;
+    mask = esPtr->mask;
+    interp = esPtr->interp;
+    script = esPtr->script;
+
+    /*
+     * 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) interp);
+    result = Tcl_GlobalEval(interp, script);
+
+    /*
+     * On error, cause a background error and remove the channel handler
+     * and the script record.
+     *
+     * NOTE: Must delete channel handler before causing the background error
+     * because the background error may want to reinstall the handler.
+     */
+    
+    if (result != TCL_OK) {
+	if (chanPtr->typePtr != NULL) {
+	    DeleteScriptRecord(interp, chanPtr, mask);
+	}
+        Tcl_BackgroundError(interp);
+    }
+    Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FileEventCmd --
+ *
+ *	This procedure implements the "fileevent" Tcl command. See the
+ *	user documentation for details on what it does. This command is
+ *	based on the Tk command "fileevent" which in turn is based on work
+ *	contributed by Mark Diekhans.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May create a channel handler for the specified channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_FileEventCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Interpreter in which the channel
+                                         * for which to create the handler
+                                         * is found. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Channel *chanPtr;			/* The channel to create
+                                         * the handler for. */
+    Tcl_Channel chan;			/* The opaque type for the channel. */
+    int c;				/* First char of mode argument. */
+    int mask;				/* Mask for events of interest. */
+    size_t length;			/* Length of mode argument. */
+
+    /*
+     * Parse arguments.
+     */
+
+    if ((argc != 3) && (argc != 4)) {
+	Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
+		" channelId event ?script?", (char *) NULL);
+	return TCL_ERROR;
+    }
+    c = argv[2][0];
+    length = strlen(argv[2]);
+    if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
+        mask = TCL_READABLE;
+    } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
+        mask = TCL_WRITABLE;
+    } else {
+	Tcl_AppendResult(interp, "bad event name \"", argv[2],
+		"\": must be readable or writable", (char *) NULL);
+	return TCL_ERROR;
+    }
+    chan = Tcl_GetChannel(interp, argv[1], NULL);
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+    
+    chanPtr = (Channel *) chan;
+    if ((chanPtr->flags & mask) == 0) {
+        Tcl_AppendResult(interp, "channel is not ",
+                (mask == TCL_READABLE) ? "readable" : "writable",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    /*
+     * If we are supposed to return the script, do so.
+     */
+
+    if (argc == 3) {
+	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;
+    }
+
+    /*
+     * If we are supposed to delete a stored script, do so.
+     */
+
+    if (argv[3][0] == 0) {
+        DeleteScriptRecord(interp, chanPtr, mask);
+        return TCL_OK;
+    }
+
+    /*
+     * Make the script record that will link between the event and the
+     * script to invoke. This also creates a channel event handler which
+     * will evaluate the script in the supplied interpreter.
+     */
+
+    CreateScriptRecord(interp, chanPtr, mask, argv[3]);
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTestChannelCmd --
+ *
+ *	Implements the Tcl "testchannel" debugging command and its
+ *	subcommands. This is part of the testing environment but must be
+ *	in this file instead of tclTest.c because it needs access to the
+ *	fields of struct Channel.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+TclTestChannelCmd(clientData, interp, argc, argv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Interpreter for result. */
+    int argc;			/* Count of additional args. */
+    char **argv;		/* Additional arg strings. */
+{
+    char *cmdName;		/* Sub command. */
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_HashSearch hSearch;	/* Search variable. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    Channel *chanPtr;		/* The actual channel. */
+    Tcl_Channel chan;		/* The opaque type. */
+    size_t len;			/* Length of subcommand string. */
+    int IOQueued;		/* How much IO is queued inside channel? */
+    ChannelBuffer *bufPtr;	/* For iterating over queued IO. */
+    char buf[128];		/* For sprintf. */
+    
+    if (argc < 2) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " subcommand ?additional args..?\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    cmdName = argv[1];
+    len = strlen(cmdName);
+
+    chanPtr = (Channel *) NULL;
+    if (argc > 2) {
+        chan = Tcl_GetChannel(interp, argv[2], NULL);
+        if (chan == (Tcl_Channel) NULL) {
+            return TCL_ERROR;
+        }
+        chanPtr = (Channel *) chan;
+    }
+    
+    if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " info channelName\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+        Tcl_AppendElement(interp, argv[2]);
+        Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
+        if (chanPtr->flags & TCL_READABLE) {
+            Tcl_AppendElement(interp, "read");
+        } else {
+            Tcl_AppendElement(interp, "");
+        }
+        if (chanPtr->flags & TCL_WRITABLE) {
+            Tcl_AppendElement(interp, "write");
+        } else {
+            Tcl_AppendElement(interp, "");
+        }
+        if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+            Tcl_AppendElement(interp, "nonblocking");
+        } else {
+            Tcl_AppendElement(interp, "blocking");
+        }
+        if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+            Tcl_AppendElement(interp, "line");
+        } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
+            Tcl_AppendElement(interp, "none");
+        } else {
+            Tcl_AppendElement(interp, "full");
+        }
+        if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+            Tcl_AppendElement(interp, "async_flush");
+        } else {
+            Tcl_AppendElement(interp, "");
+        }
+        if (chanPtr->flags & CHANNEL_EOF) {
+            Tcl_AppendElement(interp, "eof");
+        } else {
+            Tcl_AppendElement(interp, "");
+        }
+        if (chanPtr->flags & CHANNEL_BLOCKED) {
+            Tcl_AppendElement(interp, "blocked");
+        } else {
+            Tcl_AppendElement(interp, "unblocked");
+        }
+        if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+            Tcl_AppendElement(interp, "auto");
+            if (chanPtr->flags & INPUT_SAW_CR) {
+                Tcl_AppendElement(interp, "saw_cr");
+            } else {
+                Tcl_AppendElement(interp, "");
+            }
+        } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
+            Tcl_AppendElement(interp, "lf");
+            Tcl_AppendElement(interp, "");
+        } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
+            Tcl_AppendElement(interp, "cr");
+            Tcl_AppendElement(interp, "");
+        } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+            Tcl_AppendElement(interp, "crlf");
+            if (chanPtr->flags & INPUT_SAW_CR) {
+                Tcl_AppendElement(interp, "queued_cr");
+            } else {
+                Tcl_AppendElement(interp, "");
+            }
+        }
+        if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+            Tcl_AppendElement(interp, "auto");
+        } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
+            Tcl_AppendElement(interp, "lf");
+        } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
+            Tcl_AppendElement(interp, "cr");
+        } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+            Tcl_AppendElement(interp, "crlf");
+        }
+        for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
+                 bufPtr != (ChannelBuffer *) NULL;
+                 bufPtr = bufPtr->nextPtr) {
+            IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
+        }
+        TclFormatInt(buf, IOQueued);
+        Tcl_AppendElement(interp, buf);
+        
+        IOQueued = 0;
+        if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
+            IOQueued = chanPtr->curOutPtr->nextAdded -
+                chanPtr->curOutPtr->nextRemoved;
+        }
+        for (bufPtr = chanPtr->outQueueHead;
+                 bufPtr != (ChannelBuffer *) NULL;
+                 bufPtr = bufPtr->nextPtr) {
+            IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
+        }
+        TclFormatInt(buf, IOQueued);
+        Tcl_AppendElement(interp, buf);
+        
+        TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
+        Tcl_AppendElement(interp, buf);
+
+        TclFormatInt(buf, chanPtr->refCount);
+        Tcl_AppendElement(interp, buf);
+
+        return TCL_OK;
+    }
+
+    if ((cmdName[0] == 'i') &&
+            (strncmp(cmdName, "inputbuffered", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
+                 bufPtr != (ChannelBuffer *) NULL;
+                 bufPtr = bufPtr->nextPtr) {
+            IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
+        }
+        sprintf(buf, "%d", IOQueued);
+        Tcl_AppendResult(interp, buf, (char *) NULL);
+        return TCL_OK;
+    }
+        
+    if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        if (chanPtr->flags & TCL_READABLE) {
+            Tcl_AppendElement(interp, "read");
+        } else {
+            Tcl_AppendElement(interp, "");
+        }
+        if (chanPtr->flags & TCL_WRITABLE) {
+            Tcl_AppendElement(interp, "write");
+        } else {
+            Tcl_AppendElement(interp, "");
+        }
+        return TCL_OK;
+    }
+    
+    if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
+        return TCL_OK;
+    }
+    
+    if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
+        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+        if (hTblPtr == (Tcl_HashTable *) NULL) {
+            return TCL_OK;
+        }
+        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+                 hPtr != (Tcl_HashEntry *) NULL;
+                 hPtr = Tcl_NextHashEntry(&hSearch)) {
+            Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+        }
+        return TCL_OK;
+    }
+
+    if ((cmdName[0] == 'o') &&
+            (strncmp(cmdName, "outputbuffered", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        IOQueued = 0;
+        if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
+            IOQueued = chanPtr->curOutPtr->nextAdded -
+                chanPtr->curOutPtr->nextRemoved;
+        }
+        for (bufPtr = chanPtr->outQueueHead;
+                 bufPtr != (ChannelBuffer *) NULL;
+                 bufPtr = bufPtr->nextPtr) {
+            IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
+        }
+        sprintf(buf, "%d", IOQueued);
+        Tcl_AppendResult(interp, buf, (char *) NULL);
+        return TCL_OK;
+    }
+        
+    if ((cmdName[0] == 'q') &&
+            (strncmp(cmdName, "queuedcr", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        Tcl_AppendResult(interp,
+                (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
+                (char *) NULL);
+        return TCL_OK;
+    }
+    
+    if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
+        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+        if (hTblPtr == (Tcl_HashTable *) NULL) {
+            return TCL_OK;
+        }
+        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+                 hPtr != (Tcl_HashEntry *) NULL;
+                 hPtr = Tcl_NextHashEntry(&hSearch)) {
+            chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+            if (chanPtr->flags & TCL_READABLE) {
+                Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+            }
+        }
+        return TCL_OK;
+    }
+
+    if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        sprintf(buf, "%d", chanPtr->refCount);
+        Tcl_AppendResult(interp, buf, (char *) NULL);
+        return TCL_OK;
+    }
+    
+    if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
+        return TCL_OK;
+    }
+    
+    if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
+        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+        if (hTblPtr == (Tcl_HashTable *) NULL) {
+            return TCL_OK;
+        }
+        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+                 hPtr != (Tcl_HashEntry *) NULL;
+                 hPtr = Tcl_NextHashEntry(&hSearch)) {
+            chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+            if (chanPtr->flags & TCL_WRITABLE) {
+                Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+            }
+        }
+        return TCL_OK;
+    }
+
+    Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
+            "info, open, readable, or writable",
+            (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTestChannelEventCmd --
+ *
+ *	This procedure implements the "testchannelevent" command. It is
+ *	used to test the Tcl channel event mechanism. It is present in
+ *	this file instead of tclTest.c because it needs access to the
+ *	internal structure of the channel.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates, deletes and returns channel event handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+TclTestChannelEventCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Channel *chanPtr;
+    EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
+    char *cmd;
+    int index, i, mask, len;
+
+    if ((argc < 3) || (argc > 5)) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
+    if (chanPtr == (Channel *) NULL) {
+        return TCL_ERROR;
+    }
+    cmd = argv[2];
+    len = strlen(cmd);
+    if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
+        if (argc != 5) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " channelName add eventSpec script\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+        if (strcmp(argv[3], "readable") == 0) {
+            mask = TCL_READABLE;
+        } else if (strcmp(argv[3], "writable") == 0) {
+            mask = TCL_WRITABLE;
+        } else if (strcmp(argv[3], "none") == 0) {
+            mask = 0;
+	} else {
+            Tcl_AppendResult(interp, "bad event name \"", argv[3],
+                    "\": must be readable, writable, or none", (char *) NULL);
+            return TCL_ERROR;
+        }
+
+        esPtr = (EventScriptRecord *) ckalloc((unsigned)
+                sizeof(EventScriptRecord));
+        esPtr->nextPtr = chanPtr->scriptRecordPtr;
+        chanPtr->scriptRecordPtr = esPtr;
+        
+        esPtr->chanPtr = chanPtr;
+        esPtr->interp = interp;
+        esPtr->mask = mask;
+        esPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
+        strcpy(esPtr->script, argv[4]);
+
+        Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+                ChannelEventScriptInvoker, (ClientData) esPtr);
+        
+        return TCL_OK;
+    }
+
+    if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
+        if (argc != 4) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " channelName delete index\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+        if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+            return TCL_ERROR;
+        }
+        if (index < 0) {
+            Tcl_AppendResult(interp, "bad event index: ", argv[3],
+                    ": must be nonnegative", (char *) NULL);
+            return TCL_ERROR;
+        }
+        for (i = 0, esPtr = chanPtr->scriptRecordPtr;
+                 (i < index) && (esPtr != (EventScriptRecord *) NULL);
+                 i++, esPtr = esPtr->nextPtr) {
+	    /* Empty loop body. */
+        }
+        if (esPtr == (EventScriptRecord *) NULL) {
+            Tcl_AppendResult(interp, "bad event index ", argv[3],
+                    ": out of range", (char *) NULL);
+            return TCL_ERROR;
+        }
+        if (esPtr == chanPtr->scriptRecordPtr) {
+            chanPtr->scriptRecordPtr = esPtr->nextPtr;
+        } else {
+            for (prevEsPtr = chanPtr->scriptRecordPtr;
+                     (prevEsPtr != (EventScriptRecord *) NULL) &&
+                         (prevEsPtr->nextPtr != esPtr);
+                     prevEsPtr = prevEsPtr->nextPtr) {
+                /* Empty loop body. */
+            }
+            if (prevEsPtr == (EventScriptRecord *) NULL) {
+                panic("TclTestChannelEventCmd: damaged event script list");
+            }
+            prevEsPtr->nextPtr = esPtr->nextPtr;
+        }
+        Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                ChannelEventScriptInvoker, (ClientData) esPtr);
+	ckfree(esPtr->script);
+        ckfree((char *) esPtr);
+
+        return TCL_OK;
+    }
+
+    if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " channelName list\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+        for (esPtr = chanPtr->scriptRecordPtr;
+                 esPtr != (EventScriptRecord *) NULL;
+                 esPtr = esPtr->nextPtr) {
+	    char *event;
+	    if (esPtr->mask) {
+		event = ((esPtr->mask == TCL_READABLE)
+			? "readable" : "writable");
+	    } else {
+		event = "none";
+	    }
+            Tcl_AppendElement(interp, event);
+            Tcl_AppendElement(interp, esPtr->script);
+        }
+        return TCL_OK;
+    }
+
+    if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " channelName removeall\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+        for (esPtr = chanPtr->scriptRecordPtr;
+                 esPtr != (EventScriptRecord *) NULL;
+                 esPtr = nextEsPtr) {
+            nextEsPtr = esPtr->nextPtr;
+            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                    ChannelEventScriptInvoker, (ClientData) esPtr);
+	    ckfree(esPtr->script);
+            ckfree((char *) esPtr);
+        }
+        chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+        return TCL_OK;
+    }
+
+    if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
+        if (argc != 5) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " channelName delete index event\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+        if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+            return TCL_ERROR;
+        }
+        if (index < 0) {
+            Tcl_AppendResult(interp, "bad event index: ", argv[3],
+                    ": must be nonnegative", (char *) NULL);
+            return TCL_ERROR;
+        }
+        for (i = 0, esPtr = chanPtr->scriptRecordPtr;
+                 (i < index) && (esPtr != (EventScriptRecord *) NULL);
+                 i++, esPtr = esPtr->nextPtr) {
+	    /* Empty loop body. */
+        }
+        if (esPtr == (EventScriptRecord *) NULL) {
+            Tcl_AppendResult(interp, "bad event index ", argv[3],
+                    ": out of range", (char *) NULL);
+            return TCL_ERROR;
+        }
+
+        if (strcmp(argv[4], "readable") == 0) {
+            mask = TCL_READABLE;
+        } else if (strcmp(argv[4], "writable") == 0) {
+            mask = TCL_WRITABLE;
+        } else if (strcmp(argv[4], "none") == 0) {
+            mask = 0;
+	} else {
+            Tcl_AppendResult(interp, "bad event name \"", argv[4],
+                    "\": must be readable, writable, or none", (char *) NULL);
+            return TCL_ERROR;
+        }
+	esPtr->mask = mask;
+        Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+                ChannelEventScriptInvoker, (ClientData) esPtr);
+	return TCL_OK;
+    }    
+    Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
+            "add, delete, list, set, or removeall", (char *) NULL);
+    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) {
+	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 StopCopy frees csPtr.
+     */
+
+    total = csPtr->total;
+    if (cmdPtr) {
+	/*
+	 * Get a private copy of the command so we can mutate it
+	 * by adding arguments.  Note that StopCopy frees our saved
+	 * reference to the original command obj.
+	 */
+
+	cmdPtr = Tcl_DuplicateObj(cmdPtr);
+	Tcl_IncrRefCount(cmdPtr);
+	StopCopy(csPtr);
+	Tcl_Preserve((ClientData) interp);
+
+	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
+	if (errObj) {
+	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
+	}
+	if (Tcl_GlobalEvalObj(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/tcl/generic/tclIOCmd.c b/tcl/generic/tclIOCmd.c
new file mode 100644
index 00000000000..5e6eb3de36d
--- /dev/null
+++ b/tcl/generic/tclIOCmd.c
@@ -0,0 +1,1571 @@
+/* 
+ * tclIOCmd.c --
+ *
+ *	Contains the definitions of most of the Tcl commands relating to IO.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include	"tclInt.h"
+#include	"tclPort.h"
+
+/*
+ * Return at most this number of bytes in one call to Tcl_Read:
+ */
+
+#define	TCL_READ_CHUNK_SIZE	4096
+
+/*
+ * Callback structure for accept callback in a TCP server.
+ */
+
+typedef struct AcceptCallback {
+    char *script;			/* Script to invoke. */
+    Tcl_Interp *interp;			/* Interpreter in which to run it. */
+} AcceptCallback;
+
+/*
+ * Static functions for this file:
+ */
+
+static void	AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
+	            Tcl_Channel chan, char *address, int port));
+static void	RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
+	            AcceptCallback *acceptCallbackPtr));
+static void	TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
+		    ClientData clientData, Tcl_Interp *interp));
+static void	TcpServerCloseProc _ANSI_ARGS_((ClientData callbackData));
+static void	UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
+		    Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PutsObjCmd --
+ *
+ *	This procedure is invoked to process the "puts" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Produces output on a channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+    int newline;			/* Add a newline at end? */
+    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 ((objc >= 2) && (strcmp(Tcl_GetStringFromObj(objv[1], NULL),
+	    "-nonewline") == 0)) {
+	newline = 0;
+	i++;
+    }
+    if ((i < (objc-3)) || (i >= objc)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
+	return TCL_ERROR;
+    }
+
+    /*
+     * The code below provides backwards compatibility with an old
+     * form of the command that is no longer recommended or documented.
+     */
+
+    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 == (objc-1)) {
+	channelId = "stdout";
+    } else {
+	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_AppendStringsToObj(resultPtr, "channel \"", channelId,
+                "\" wasn't opened for writing", (char *) NULL);
+        Tcl_SetObjResult(interp, resultPtr);
+        return TCL_ERROR;
+    }
+
+    arg = Tcl_GetStringFromObj(objv[i], &length);
+    result = Tcl_Write(chan, arg, length);
+    if (result < 0) {
+        goto error;
+    }
+    if (newline != 0) {
+        result = Tcl_Write(chan, "\n", 1);
+        if (result < 0) {
+            goto error;
+        }
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+error:
+    Tcl_AppendStringsToObj(resultPtr, "error writing \"",
+	    Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
+	    (char *) NULL);
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FlushObjCmd --
+ *
+ *	This procedure is called to process the Tcl "flush" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May cause output to appear on the specified channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+    char *arg;
+    Tcl_Obj *resultPtr;
+    int mode;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+	return TCL_ERROR;
+    }
+    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_AppendStringsToObj(resultPtr, "channel \"",
+		Tcl_GetStringFromObj(objv[1], NULL), 
+                "\" wasn't opened for writing", (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    if (Tcl_Flush(chan) != TCL_OK) {
+	Tcl_AppendStringsToObj(resultPtr, "error flushing \"",
+		Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetsObjCmd --
+ *
+ *	This procedure is called to process the Tcl "gets" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May consume input from channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+    int lineLen;			/* Length of line just read. */
+    int mode;				/* Mode in which channel is opened. */
+    char *arg;
+    Tcl_Obj *resultPtr, *objPtr;
+
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
+	return TCL_ERROR;
+    }
+    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_AppendStringsToObj(resultPtr, "channel \"", arg,
+                "\" wasn't opened for reading", (char *) NULL);
+        Tcl_SetObjResult(interp, resultPtr);
+        return TCL_ERROR;
+    }
+
+    lineLen = Tcl_GetsObj(chan, resultPtr);
+    if (lineLen < 0) {
+        if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
+	    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 (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);
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), lineLen);
+        return TCL_OK;
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ReadObjCmd --
+ *
+ *	This procedure is invoked to process the Tcl "read" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May consume input from channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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? */
+    int toRead;				/* How many bytes to read? */
+    int toReadNow;			/* How many bytes to attempt to
+                                         * read in the current iteration? */
+    int charactersRead;			/* How many characters were read? */
+    int charactersReadNow;		/* How many characters were read
+                                         * in this iteration? */
+    int mode;				/* Mode in which channel is opened. */
+    int bufSize;			/* Channel buffer size; used to decide
+                                         * in what chunk sizes to read from
+                                         * the channel. */
+    char *arg;
+    Tcl_Obj *resultPtr;
+
+    if ((objc != 2) && (objc != 3)) {
+argerror:
+	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(Tcl_GetStringFromObj(objv[1], NULL), "-nonewline") == 0) {
+	newline = 1;
+	i++;
+    }
+
+    if (i == objc) {
+        goto argerror;
+    }
+
+    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) {
+	resultPtr = Tcl_GetObjResult(interp);
+	Tcl_AppendStringsToObj(resultPtr, "channel \"", arg,
+                "\" wasn't opened for reading", (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    i++;	/* Consumed channel name. */
+
+    /*
+     * Compute how many bytes to read, and see whether the final
+     * newline should be dropped.
+     */
+
+    toRead = INT_MAX;
+    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;
+	    }
+	    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);
+
+    /*
+     * 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;
+        }
+
+        /*
+         * 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_GetStringFromObj(resultPtr, NULL)
+		    + charactersRead, toReadNow);
+        if (charactersReadNow < 0) {
+	    Tcl_SetObjLength(resultPtr, 0);
+            Tcl_AppendStringsToObj(resultPtr, "error reading \"",
+		    Tcl_GetChannelName(chan), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+            Tcl_SetObjResult(interp, resultPtr);
+
+            return TCL_ERROR;
+        }
+
+        /*
+         * If we had a short read it means that we have either EOF
+         * or BLOCKED on the channel, so break out.
+         */
+        
+        charactersRead += charactersReadNow;
+
+        /*
+         * Do not call the driver again if we got a short read
+         */
+        
+        if (charactersReadNow < toReadNow) {
+            break;	/* Out of "for" loop. */
+        }
+    }
+    
+    /*
+     * If requested, remove the last newline in the channel if at EOF.
+     */
+    
+    if ((charactersRead > 0) && (newline) &&
+          (Tcl_GetStringFromObj(resultPtr, NULL)[charactersRead-1] == '\n')) {
+	charactersRead--;
+    }
+    Tcl_SetObjLength(resultPtr, charactersRead);
+
+    /*
+     * Now set the object into the interpreter result and release our
+     * hold on it by decrrefing it.
+     */
+
+    Tcl_SetObjResult(interp, resultPtr);
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SeekCmd --
+ *
+ *	This procedure is invoked to process the Tcl "seek" command. See
+ *	the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Moves the position of the access point on the specified channel.
+ *	May flush queued output.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_SeekCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Channel chan;			/* The channel to tell on. */
+    int offset, mode;			/* Where to seek? */
+    int result;				/* Of calling Tcl_Seek. */
+
+    if ((argc != 3) && (argc != 4)) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" channelId offset ?origin?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    chan = Tcl_GetChannel(interp, argv[1], NULL);
+    if (chan == (Tcl_Channel) NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, argv[2], &offset) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    mode = SEEK_SET;
+    if (argc == 4) {
+	size_t length;
+	int c;
+
+	length = strlen(argv[3]);
+	c = argv[3][0];
+	if ((c == 's') && (strncmp(argv[3], "start", length) == 0)) {
+	    mode = SEEK_SET;
+	} else if ((c == 'c') && (strncmp(argv[3], "current", length) == 0)) {
+	    mode = SEEK_CUR;
+	} else if ((c == 'e') && (strncmp(argv[3], "end", length) == 0)) {
+	    mode = SEEK_END;
+	} else {
+	    Tcl_AppendResult(interp, "bad origin \"", argv[3],
+		    "\": should be start, current, or end", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    result = Tcl_Seek(chan, offset, mode);
+    if (result == -1) {
+        Tcl_AppendResult(interp, "error during seek on \"", 
+		Tcl_GetChannelName(chan), "\": ",
+                Tcl_PosixError(interp), (char *) NULL);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TellCmd --
+ *
+ *	This procedure is invoked to process the Tcl "tell" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_TellCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    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],
+		" channelId\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    /*
+     * Try to find a channel with the right name and permissions in
+     * the IO channel table of this interpreter.
+     */
+    
+    chan = Tcl_GetChannel(interp, argv[1], NULL);
+    if (chan == (Tcl_Channel) NULL) {
+	return TCL_ERROR;
+    }
+    TclFormatInt(buf, Tcl_Tell(chan));
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CloseObjCmd --
+ *
+ *	This procedure is invoked to process the Tcl "close" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May discard queued input; may flush queued output.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_CloseObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Channel chan;			/* The channel to close. */
+    int len;				/* Length of error output. */
+    char *arg;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+	return TCL_ERROR;
+    }
+
+    arg = Tcl_GetStringFromObj(objv[1], NULL);
+    chan = Tcl_GetChannel(interp, arg, NULL);
+    if (chan == (Tcl_Channel) NULL) {
+	return TCL_ERROR;
+    }
+
+    if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
+        /*
+         * If there is an error message and it ends with a newline, remove
+         * the newline. This is done for command pipeline channels where the
+         * error output from the subprocesses is stored in interp->result.
+         *
+         * NOTE: This is likely to not have any effect on regular error
+         * messages produced by drivers during the closing of a channel,
+         * because the Tcl convention is that such error messages do not
+         * have a terminating newline.
+         */
+
+        len = strlen(interp->result);
+        if ((len > 0) && (interp->result[len - 1] == '\n')) {
+            interp->result[len - 1] = '\0';
+        }
+        
+        return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FconfigureCmd --
+ *
+ *	This procedure is invoked to process the Tcl "fconfigure" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May modify the behavior of an IO channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_FconfigureCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Channel chan;			/* The channel to set a mode on. */
+    int i;				/* Iterate over arg-value pairs. */
+    Tcl_DString ds;			/* DString to hold result of
+                                         * calling Tcl_GetChannelOption. */
+
+    if ((argc < 2) || (((argc % 2) == 1) && (argc != 3))) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " channelId ?optionName? ?value? ?optionName value?...\"",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    chan = Tcl_GetChannel(interp, argv[1], NULL);
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+    if (argc == 2) {
+        Tcl_DStringInit(&ds);
+        if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
+	    Tcl_DStringFree(&ds);
+	    return TCL_ERROR;
+        }
+        Tcl_DStringResult(interp, &ds);
+        return TCL_OK;
+    }
+    if (argc == 3) {
+        Tcl_DStringInit(&ds);
+        if (Tcl_GetChannelOption(interp, chan, argv[2], &ds) != TCL_OK) {
+            Tcl_DStringFree(&ds);
+            return TCL_ERROR;
+        }
+        Tcl_DStringResult(interp, &ds);
+        return TCL_OK;
+    }
+    for (i = 3; i < argc; i += 2) {
+        if (Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]) != TCL_OK) {
+            return TCL_ERROR;
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EofObjCmd --
+ *
+ *	This procedure is invoked to process the Tcl "eof" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp->result to "0" or "1" depending on whether the
+ *	specified channel has an EOF condition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_EofObjCmd(unused, interp, objc, objv)
+    ClientData unused;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Channel chan;			/* The channel to query for EOF. */
+    int mode;				/* Mode in which channel is opened. */
+    char buf[40];
+    char *arg;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+        return TCL_ERROR;
+    }
+
+    arg = Tcl_GetStringFromObj(objv[1], NULL);
+    chan = Tcl_GetChannel(interp, arg, &mode);
+    if (chan == (Tcl_Channel) NULL) {
+	return TCL_ERROR;
+    }
+
+    TclFormatInt(buf, Tcl_Eof(chan) ? 1 : 0);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ExecCmd --
+ *
+ *	This procedure is invoked to process the "exec" 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_ExecCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+#ifdef MAC_TCL
+    Tcl_AppendResult(interp, "exec not implemented under Mac OS",
+		(char *)NULL);
+    return TCL_ERROR;
+#else /* !MAC_TCL */
+    int keepNewline, firstWord, background, length, result;
+    Tcl_Channel chan;
+    Tcl_DString ds;
+    int readSoFar, readNow, bufSize;
+
+    /*
+     * Check for a leading "-keepnewline" argument.
+     */
+
+    keepNewline = 0;
+    for (firstWord = 1; (firstWord < argc) && (argv[firstWord][0] == '-');
+	  firstWord++) {
+	if (strcmp(argv[firstWord], "-keepnewline") == 0) {
+	    keepNewline = 1;
+	} else if (strcmp(argv[firstWord], "--") == 0) {
+	    firstWord++;
+	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad switch \"", argv[firstWord],
+		    "\": must be -keepnewline or --", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    if (argc <= firstWord) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" ?switches? arg ?arg ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * See if the command is to be run in background.
+     */
+
+    background = 0;
+    if ((argv[argc-1][0] == '&') && (argv[argc-1][1] == 0)) {
+	argc--;
+	argv[argc] = NULL;
+        background = 1;
+    }
+    
+    chan = Tcl_OpenCommandChannel(interp, argc-firstWord,
+            argv+firstWord,
+	    (background ? 0 : TCL_STDOUT | TCL_STDERR));
+
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+
+    if (background) {
+
+        /*
+         * Get the list of PIDs from the pipeline into interp->result and
+         * detach the PIDs (instead of waiting for them).
+         */
+
+        TclGetAndDetachPids(interp, chan);
+        
+        if (Tcl_Close(interp, chan) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        return TCL_OK;
+    }
+
+    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
+#define	EXEC_BUFFER_SIZE 4096
+
+        Tcl_DStringInit(&ds);
+        readSoFar = 0; bufSize = 0;
+        while (1) {
+            bufSize += EXEC_BUFFER_SIZE;
+            Tcl_DStringSetLength(&ds, bufSize);
+            readNow = Tcl_Read(chan, Tcl_DStringValue(&ds) + readSoFar,
+                    EXEC_BUFFER_SIZE);
+            if (readNow < 0) {
+                Tcl_DStringFree(&ds);
+		Tcl_AppendResult(interp,
+			"error reading output from command: ",
+			Tcl_PosixError(interp), (char *) NULL);
+                return TCL_ERROR;
+            }
+            readSoFar += readNow;
+            if (readNow < EXEC_BUFFER_SIZE) {
+                break;	/* Out of "while (1)" loop. */
+            }
+        }
+        Tcl_DStringSetLength(&ds, readSoFar);
+        Tcl_DStringResult(interp, &ds);
+    }
+
+    result = Tcl_Close(interp, chan);
+
+    /*
+     * If the last character of interp->result is a newline, then remove
+     * the newline character (the newline would just confuse things).
+     * Special hack: must replace the old terminating null character
+     * as a signal to Tcl_AppendResult et al. that we've mucked with
+     * the string.
+     */
+    
+    length = strlen(interp->result);
+    if (!keepNewline && (length > 0) &&
+        (interp->result[length-1] == '\n')) {
+        interp->result[length-1] = '\0';
+        interp->result[length] = 'x';
+    }
+
+    return result;
+#endif /* !MAC_TCL */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FblockedObjCmd --
+ *
+ *	This procedure is invoked to process the Tcl "fblocked" command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp->result to "0" or "1" depending on whether the
+ *	a preceding input operation on the channel would have blocked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_FblockedObjCmd(unused, interp, objc, objv)
+    ClientData unused;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Channel chan;			/* The channel to query for blocked. */
+    int mode;				/* Mode in which channel was opened. */
+    char buf[40];
+    char *arg;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+        return TCL_ERROR;
+    }
+
+    arg = Tcl_GetStringFromObj(objv[1], NULL);
+    chan = Tcl_GetChannel(interp, arg, &mode);
+    if (chan == (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;
+    }
+        
+    TclFormatInt(buf, Tcl_InputBlocked(chan) ? 1 : 0);
+    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenCmd --
+ *
+ *	This procedure is invoked to process the "open" 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_OpenCmd(notUsed, interp, argc, argv)
+    ClientData notUsed;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int pipeline, prot;
+    char *modeString;
+    Tcl_Channel chan;
+
+    if ((argc < 2) || (argc > 4)) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" fileName ?access? ?permissions?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    prot = 0666;
+    if (argc == 2) {
+	modeString = "r";
+    } else {
+	modeString = argv[2];
+	if (argc == 4) {
+	    if (Tcl_GetInt(interp, argv[3], &prot) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+    }
+
+    pipeline = 0;
+    if (argv[1][0] == '|') {
+	pipeline = 1;
+    }
+
+    /*
+     * Open the file or create a process pipeline.
+     */
+
+    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;
+
+        if (Tcl_SplitList(interp, argv[1]+1, &cmdArgc, &cmdArgv) != TCL_OK) {
+            return TCL_ERROR;
+        }
+
+        mode = TclGetOpenMode(interp, modeString, &seekFlag);
+        if (mode == -1) {
+	    chan = NULL;
+        } else {
+	    int flags = TCL_STDERR | TCL_ENFORCE_MODE;
+	    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+		case O_RDONLY:
+		    flags |= TCL_STDOUT;
+		    break;
+		case O_WRONLY:
+		    flags |= TCL_STDIN;
+		    break;
+		case O_RDWR:
+		    flags |= (TCL_STDIN | TCL_STDOUT);
+		    break;
+		default:
+		    panic("Tcl_OpenCmd: invalid mode value");
+		    break;
+	    }
+	    chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, flags);
+	}
+        ckfree((char *) cmdArgv);
+#endif
+    }
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+    Tcl_RegisterChannel(interp, chan);
+    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpAcceptCallbacksDeleteProc --
+ *
+ *	Assocdata cleanup routine called when an interpreter is being
+ *	deleted to set the interp field of all the accept callback records
+ *	registered with	the interpreter to NULL. This will prevent the
+ *	interpreter from being used in the future to eval accept scripts.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates memory and sets the interp field of all the accept
+ *	callback records to NULL to prevent this interpreter from being
+ *	used subsequently to eval accept scripts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+TcpAcceptCallbacksDeleteProc(clientData, interp)
+    ClientData clientData;	/* Data which was passed when the assocdata
+                                 * was registered. */
+    Tcl_Interp *interp;		/* Interpreter being deleted - not used. */
+{
+    Tcl_HashTable *hTblPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+    AcceptCallback *acceptCallbackPtr;
+
+    hTblPtr = (Tcl_HashTable *) clientData;
+    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+             hPtr != (Tcl_HashEntry *) NULL;
+             hPtr = Tcl_NextHashEntry(&hSearch)) {
+        acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
+        acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
+    }
+    Tcl_DeleteHashTable(hTblPtr);
+    ckfree((char *) hTblPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegisterTcpServerInterpCleanup --
+ *
+ *	Registers an accept callback record to have its interp
+ *	field set to NULL when the interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When, in the future, the interpreter is deleted, the interp
+ *	field of the accept callback data structure will be set to
+ *	NULL. This will prevent attempts to eval the accept script
+ *	in a deleted interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
+    Tcl_Interp *interp;		/* Interpreter for which we want to be
+                                 * informed of deletion. */
+    AcceptCallback *acceptCallbackPtr;
+    				/* The accept callback record whose
+                                 * interp field we want set to NULL when
+                                 * the interpreter is deleted. */
+{
+    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback
+                                 * records to smash when the interpreter
+                                 * will be deleted. */
+    Tcl_HashEntry *hPtr;	/* Entry for this record. */
+    int new;			/* Is the entry new? */
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
+            "tclTCPAcceptCallbacks",
+            NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
+        (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+                TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
+    }
+    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
+    if (!new) {
+        panic("RegisterTcpServerCleanup: damaged accept record table");
+    }
+    Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnregisterTcpServerInterpCleanupProc --
+ *
+ *	Unregister a previously registered accept callback record. The
+ *	interp field of this record will no longer be set to NULL in
+ *	the future when the interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Prevents the interp field of the accept callback record from
+ *	being set to NULL in the future when the interpreter is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
+    Tcl_Interp *interp;		/* Interpreter in which the accept callback
+                                 * record was registered. */
+    AcceptCallback *acceptCallbackPtr;
+    				/* The record for which to delete the
+                                 * registration. */
+{
+    Tcl_HashTable *hTblPtr;
+    Tcl_HashEntry *hPtr;
+
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
+            "tclTCPAcceptCallbacks", NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        return;
+    }
+    hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return;
+    }
+    Tcl_DeleteHashEntry(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AcceptCallbackProc --
+ *
+ *	This callback is invoked by the TCP channel driver when it
+ *	accepts a new connection from a client on a server socket.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Whatever the script does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AcceptCallbackProc(callbackData, chan, address, port)
+    ClientData callbackData;		/* The data stored when the callback
+                                         * was created in the call to
+                                         * Tcl_OpenTcpServer. */
+    Tcl_Channel chan;			/* Channel for the newly accepted
+                                         * connection. */
+    char *address;			/* Address of client that was
+                                         * accepted. */
+    int port;				/* Port of client that was accepted. */
+{
+    AcceptCallback *acceptCallbackPtr;
+    Tcl_Interp *interp;
+    char *script;
+    char portBuf[10];
+    int result;
+
+    acceptCallbackPtr = (AcceptCallback *) callbackData;
+
+    /*
+     * Check if the callback is still valid; the interpreter may have gone
+     * away, this is signalled by setting the interp field of the callback
+     * data to NULL.
+     */
+    
+    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+
+        script = acceptCallbackPtr->script;
+        interp = acceptCallbackPtr->interp;
+        
+        Tcl_Preserve((ClientData) script);
+        Tcl_Preserve((ClientData) interp);
+
+	TclFormatInt(portBuf, port);
+        Tcl_RegisterChannel(interp, chan);
+
+        /*
+         * Artificially bump the refcount to protect the channel from
+         * being deleted while the script is being evaluated.
+         */
+
+        Tcl_RegisterChannel((Tcl_Interp *) NULL,  chan);
+        
+        result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
+                " ", address, " ", portBuf, (char *) NULL);
+        if (result != TCL_OK) {
+            Tcl_BackgroundError(interp);
+	    Tcl_UnregisterChannel(interp, chan);
+        }
+
+        /*
+         * Decrement the artificially bumped refcount. After this it is
+         * not safe anymore to use "chan", because it may now be deleted.
+         */
+
+        Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
+        
+        Tcl_Release((ClientData) interp);
+        Tcl_Release((ClientData) script);
+    } else {
+
+        /*
+         * The interpreter has been deleted, so there is no useful
+         * way to utilize the client socket - just close it.
+         */
+
+        Tcl_Close((Tcl_Interp *) NULL, chan);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpServerCloseProc --
+ *
+ *	This callback is called when the TCP server channel for which it
+ *	was registered is being closed. It informs the interpreter in
+ *	which the accept script is evaluated (if that interpreter still
+ *	exists) that this channel no longer needs to be informed if the
+ *	interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	In the future, if the interpreter is deleted this channel will
+ *	no longer be informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TcpServerCloseProc(callbackData)
+    ClientData callbackData;	/* The data passed in the call to
+                                 * Tcl_CreateCloseHandler. */
+{
+    AcceptCallback *acceptCallbackPtr;
+    				/* The actual data. */
+
+    acceptCallbackPtr = (AcceptCallback *) callbackData;
+    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+        UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
+                acceptCallbackPtr);
+    }
+    Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
+    ckfree((char *) acceptCallbackPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SocketCmd --
+ *
+ *	This procedure is invoked to process the "socket" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates a socket based channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SocketCmd(notUsed, interp, argc, argv)
+    ClientData notUsed;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int a, server, port;
+    char *arg, *copyScript, *host, *script;
+    char *myaddr = NULL;
+    int myport = 0;
+    int async = 0;
+    Tcl_Channel chan;
+    AcceptCallback *acceptCallbackPtr;
+    
+    server = 0;
+    script = NULL;
+
+    if (TclHasSockets(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    for (a = 1; a < argc; a++) {
+        arg = argv[a];
+	if (arg[0] == '-') {
+	    if (strcmp(arg, "-server") == 0) {
+                if (async == 1) {
+                    Tcl_AppendResult(interp,
+                            "cannot set -async option for server sockets",
+                            (char *) NULL);
+                    return TCL_ERROR;
+                }
+		server = 1;
+		a++;
+		if (a >= argc) {
+		    Tcl_AppendResult(interp,
+			    "no argument given for -server option",
+                            (char *) NULL);
+		    return TCL_ERROR;
+		}
+                script = argv[a];
+            } else if (strcmp(arg, "-myaddr") == 0) {
+		a++;
+                if (a >= argc) {
+		    Tcl_AppendResult(interp,
+			    "no argument given for -myaddr option",
+                            (char *) NULL);
+		    return TCL_ERROR;
+		}
+                myaddr = argv[a];
+            } else if (strcmp(arg, "-myport") == 0) {
+		a++;
+                if (a >= argc) {
+		    Tcl_AppendResult(interp,
+			    "no argument given for -myport option",
+                            (char *) NULL);
+		    return TCL_ERROR;
+		}
+		if (TclSockGetPort(interp, argv[a], "tcp", &myport)
+                    != TCL_OK) {
+		    return TCL_ERROR;
+		}
+            } else if (strcmp(arg, "-async") == 0) {
+                if (server == 1) {
+                    Tcl_AppendResult(interp,
+                            "cannot set -async option for server sockets",
+                            (char *) NULL);
+                    return TCL_ERROR;
+                }
+                async = 1;
+	    } else {
+		Tcl_AppendResult(interp, "bad option \"", arg,
+                        "\", must be -async, -myaddr, -myport, or -server",
+                        (char *) NULL);
+		return TCL_ERROR;
+	    }
+	} else {
+	    break;
+	}
+    }
+    if (server) {
+        host = myaddr;		/* NULL implies INADDR_ANY */
+	if (myport != 0) {
+	    Tcl_AppendResult(interp, "Option -myport is not valid for servers",
+		    NULL);
+	    return TCL_ERROR;
+	}
+    } else if (a < argc) {
+	host = argv[a];
+	a++;
+    } else {
+wrongNumArgs:
+	Tcl_AppendResult(interp, "wrong # args: should be either:\n",
+		argv[0],
+                " ?-myaddr addr? ?-myport myport? ?-async? host port\n",
+		argv[0],
+                " -server command ?-myaddr addr? port",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    if (a == argc-1) {
+	if (TclSockGetPort(interp, argv[a], "tcp", &port) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	goto wrongNumArgs;
+    }
+
+    if (server) {
+        acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
+                sizeof(AcceptCallback));
+        copyScript = ckalloc((unsigned) strlen(script) + 1);
+        strcpy(copyScript, script);
+        acceptCallbackPtr->script = copyScript;
+        acceptCallbackPtr->interp = interp;
+        chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
+                (ClientData) acceptCallbackPtr);
+        if (chan == (Tcl_Channel) NULL) {
+            ckfree(copyScript);
+            ckfree((char *) acceptCallbackPtr);
+            return TCL_ERROR;
+        }
+
+        /*
+         * Register with the interpreter to let us know when the
+         * interpreter is deleted (by having the callback set the
+         * acceptCallbackPtr->interp field to NULL). This is to
+         * avoid trying to eval the script in a deleted interpreter.
+         */
+
+        RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
+        
+        /*
+         * Register a close callback. This callback will inform the
+         * interpreter (if it still exists) that this channel does not
+         * need to be informed when the interpreter is deleted.
+         */
+        
+        Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
+                (ClientData) acceptCallbackPtr);
+    } else {
+        chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
+        if (chan == (Tcl_Channel) NULL) {
+            return TCL_ERROR;
+        }
+    }
+    Tcl_RegisterChannel(interp, chan);            
+    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+    
+    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/tcl/generic/tclIOSock.c b/tcl/generic/tclIOSock.c
new file mode 100644
index 00000000000..c3947804465
--- /dev/null
+++ b/tcl/generic/tclIOSock.c
@@ -0,0 +1,102 @@
+/* 
+ * tclIOSock.c --
+ *
+ *	Common routines used by all socket based channel types.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSockGetPort --
+ *
+ *	Maps from a string, which could be a service name, to a port.
+ *	Used by socket creation code to get port numbers and resolve
+ *	registered service names to port numbers.
+ *
+ * Results:
+ *	A standard Tcl result.  On success, the port number is
+ *	returned in portPtr. On failure, an error message is left in
+ *	interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclSockGetPort(interp, string, proto, portPtr)
+    Tcl_Interp *interp;
+    char *string;		/* Integer or service name */
+    char *proto;		/* "tcp" or "udp", typically */
+    int *portPtr;		/* Return port number */
+{
+    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;
+    }
+    if (*portPtr > 0xFFFF) {
+        Tcl_AppendResult(interp, "couldn't open socket: port number too high",
+                (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSockMinimumBuffers --
+ *
+ *	Ensure minimum buffer sizes (non zero).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets SO_SNDBUF and SO_RCVBUF sizes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclSockMinimumBuffers(sock, size)
+    int sock;			/* Socket file descriptor */
+    int size;			/* Minimum buffer size */
+{
+    int current;
+    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);
+    }
+    len = sizeof(int);
+    getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
+    if (current < size) {
+	len = sizeof(int);
+	setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
+    }
+    return TCL_OK;
+}
diff --git a/tcl/generic/tclIOUtil.c b/tcl/generic/tclIOUtil.c
new file mode 100644
index 00000000000..21268b29cd0
--- /dev/null
+++ b/tcl/generic/tclIOUtil.c
@@ -0,0 +1,872 @@
+/* 
+ * tclIOUtil.c --
+ *
+ *	This file contains a collection of utility procedures that
+ *	are shared by the platform specific IO drivers.
+ *
+ *	Parts of this file are based on code contributed by Karl
+ *	Lehenbauer, Mark Diekhans and Peter da Silva.
+ *
+ * Copyright (c) 1991-1994 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following typedef declarations allow for hooking into the chain
+ * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
+ * 'Tcl_OpenFileChannel(...)'.  Basically for each hookable function
+ * a linked list is defined.
+ */
+
+typedef struct StatProc {
+    TclStatProc_ *proc;		 /* Function to process a 'stat()' call */
+    struct StatProc *nextPtr;    /* The next 'stat()' function to call */
+} StatProc;
+
+typedef struct AccessProc {
+    TclAccessProc_ *proc;	 /* Function to process a 'access()' call */
+    struct AccessProc *nextPtr;  /* The next 'access()' function to call */
+} AccessProc;
+
+typedef struct OpenFileChannelProc {
+    TclOpenFileChannelProc_ *proc;  /* Function to process a
+				     * 'Tcl_OpenFileChannel()' call */
+    struct OpenFileChannelProc *nextPtr;
+				    /* The next 'Tcl_OpenFileChannel()'
+				     * function to call */
+} OpenFileChannelProc;
+
+/*
+ * For each type of hookable function, a static node is declared to
+ * hold the function pointer for the "built-in" routine (e.g.
+ * 'TclpStat(...)') and the respective list is initialized as a pointer
+ * to that node.
+ * 
+ * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that
+ * these statically declared list entry cannot be inadvertently removed.
+ *
+ * This method avoids the need to call any sort of "initialization"
+ * function
+ */
+
+static StatProc defaultStatProc = {
+    &TclpStat, NULL
+};
+static StatProc *statProcList = &defaultStatProc;
+
+static AccessProc defaultAccessProc = {
+    &TclpAccess, NULL
+};
+static AccessProc *accessProcList = &defaultAccessProc;
+
+static OpenFileChannelProc defaultOpenFileChannelProc = {
+    &TclpOpenFileChannel, NULL
+};
+static OpenFileChannelProc *openFileChannelProcList =
+	&defaultOpenFileChannelProc;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetOpenMode --
+ *
+ * Description:
+ *	Computes a POSIX mode mask for opening a file, from a given string,
+ *	and also sets a flag to indicate whether the caller should seek to
+ *	EOF after opening the file.
+ *
+ * Results:
+ *	On success, returns mode to pass to "open". If an error occurs, the
+ *	returns -1 and if interp is not NULL, sets interp->result to an
+ *	error message.
+ *
+ * Side effects:
+ *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller
+ *	to seek to EOF after opening the file.
+ *
+ * Special note:
+ *	This code is based on a prototype implementation contributed
+ *	by Mark Diekhans.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetOpenMode(interp, string, seekFlagPtr)
+    Tcl_Interp *interp;			/* Interpreter to use for error
+					 * reporting - may be NULL. */
+    char *string;			/* Mode string, e.g. "r+" or
+					 * "RDONLY CREAT". */
+    int *seekFlagPtr;			/* Set this to 1 if the caller
+                                         * should seek to EOF during the
+                                         * opening of the file. */
+{
+    int mode, modeArgc, c, i, gotRW;
+    char **modeArgv, *flag;
+#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
+
+    /*
+     * Check for the simpler fopen-like access modes (e.g. "r").  They
+     * are distinguished from the POSIX access modes by the presence
+     * of a lower-case first letter.
+     */
+
+    *seekFlagPtr = 0;
+    mode = 0;
+    if (islower(UCHAR(string[0]))) {
+	switch (string[0]) {
+	    case 'r':
+		mode = O_RDONLY;
+		break;
+	    case 'w':
+		mode = O_WRONLY|O_CREAT|O_TRUNC;
+		break;
+	    case 'a':
+		mode = O_WRONLY|O_CREAT;
+                *seekFlagPtr = 1;
+		break;
+	    default:
+		error:
+                if (interp != (Tcl_Interp *) NULL) {
+                    Tcl_AppendResult(interp,
+                            "illegal access mode \"", string, "\"",
+                            (char *) NULL);
+                }
+		return -1;
+	}
+	if (string[1] == '+') {
+	    mode &= ~(O_RDONLY|O_WRONLY);
+	    mode |= O_RDWR;
+	    if (string[2] != 0) {
+		goto error;
+	    }
+	} else if (string[1] != 0) {
+	    goto error;
+	}
+        return mode;
+    }
+
+    /*
+     * The access modes are specified using a list of POSIX modes
+     * such as O_CREAT.
+     *
+     * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
+     * a NULL interpreter is passed in.
+     */
+
+    if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AddErrorInfo(interp,
+                    "\n    while processing open access modes \"");
+            Tcl_AddErrorInfo(interp, string);
+            Tcl_AddErrorInfo(interp, "\"");
+        }
+        return -1;
+    }
+    
+    gotRW = 0;
+    for (i = 0; i < modeArgc; i++) {
+	flag = modeArgv[i];
+	c = flag[0];
+	if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
+	    mode = (mode & ~RW_MODES) | O_RDONLY;
+	    gotRW = 1;
+	} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
+	    mode = (mode & ~RW_MODES) | O_WRONLY;
+	    gotRW = 1;
+	} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
+	    mode = (mode & ~RW_MODES) | O_RDWR;
+	    gotRW = 1;
+	} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
+	    mode |= O_APPEND;
+            *seekFlagPtr = 1;
+	} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
+	    mode |= O_CREAT;
+	} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
+	    mode |= O_EXCL;
+	} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
+#ifdef O_NOCTTY
+	    mode |= O_NOCTTY;
+#else
+	    if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "access mode \"", flag,
+                        "\" not supported by this system", (char *) NULL);
+            }
+            ckfree((char *) modeArgv);
+	    return -1;
+#endif
+	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
+#if defined(O_NDELAY) || defined(O_NONBLOCK)
+#   ifdef O_NONBLOCK
+	    mode |= O_NONBLOCK;
+#   else
+	    mode |= O_NDELAY;
+#   endif
+#else
+            if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "access mode \"", flag,
+                        "\" not supported by this system", (char *) NULL);
+            }
+            ckfree((char *) modeArgv);
+	    return -1;
+#endif
+	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
+	    mode |= O_TRUNC;
+	} else {
+            if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "invalid access mode \"", flag,
+                        "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
+                        " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
+            }
+	    ckfree((char *) modeArgv);
+	    return -1;
+	}
+    }
+    ckfree((char *) modeArgv);
+    if (!gotRW) {
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "access mode must include either",
+                    " RDONLY, WRONLY, or RDWR", (char *) NULL);
+        }
+	return -1;
+    }
+    return mode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalFile --
+ *
+ *	Read in a file and process the entire file as one gigantic
+ *	Tcl command.
+ *
+ * Results:
+ *	A standard Tcl result, which is either the result of executing
+ *	the file or an error indicating why the file couldn't be read.
+ *
+ * Side effects:
+ *	Depends on the commands in the file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalFile(interp, fileName)
+    Tcl_Interp *interp;		/* Interpreter in which to process file. */
+    char *fileName;		/* Name of file to process.  Tilde-substitution
+				 * will be performed on this name. */
+{
+    int result;
+    struct stat statBuf;
+    char *cmdBuffer = (char *) NULL;
+    char *oldScriptFile;
+    Interp *iPtr = (Interp *) interp;
+    Tcl_DString buffer;
+    char *nativeName;
+    Tcl_Channel chan;
+    Tcl_Obj *cmdObjPtr;
+
+    Tcl_ResetResult(interp);
+    oldScriptFile = iPtr->scriptFile;
+    iPtr->scriptFile = fileName;
+    Tcl_DStringInit(&buffer);
+    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+    if (nativeName == NULL) {
+	goto error;
+    }
+
+    /*
+     * If Tcl_TranslateFileName didn't already copy the file name, do it
+     * here.  This way we don't depend on fileName staying constant
+     * throughout the execution of the script (e.g., what if it happens
+     * to point to a Tcl variable that the script could change?).
+     */
+
+    if (nativeName != Tcl_DStringValue(&buffer)) {
+	Tcl_DStringSetLength(&buffer, 0);
+	Tcl_DStringAppend(&buffer, nativeName, -1);
+	nativeName = Tcl_DStringValue(&buffer);
+    }
+    if (TclStat(nativeName, &statBuf) == -1) {
+        Tcl_SetErrno(errno);
+	Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	goto error;
+    }
+    chan = Tcl_OpenFileChannel(interp, nativeName, "r", 0644);
+    if (chan == (Tcl_Channel) NULL) {
+        Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	goto error;
+    }
+    cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
+    result = Tcl_Read(chan, cmdBuffer, statBuf.st_size);
+    if (result < 0) {
+        Tcl_Close(interp, chan);
+	Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	goto error;
+    }
+    cmdBuffer[result] = 0;
+    if (Tcl_Close(interp, chan) != TCL_OK) {
+        goto error;
+    }
+
+    /*
+     * Transfer the buffer memory allocated above to the object system.
+     * Tcl_EvalObj will own this new string object if needed,
+     * so past the Tcl_EvalObj point, we must not ckfree(cmdBuffer)
+     * but rather use the reference counting mechanism.
+     * (Nb: and we must not thus not use goto error after this point)
+     */
+    cmdObjPtr = Tcl_NewObj();
+    cmdObjPtr->bytes = cmdBuffer;
+    cmdObjPtr->length = result;
+    
+    Tcl_IncrRefCount(cmdObjPtr);
+    result = Tcl_EvalObj(interp, cmdObjPtr);
+    Tcl_DecrRefCount(cmdObjPtr);
+
+    if (result == TCL_RETURN) {
+	result = TclUpdateReturnInfo(iPtr);
+    } else if (result == TCL_ERROR) {
+	char msg[200];
+
+	/*
+	 * Record information telling where the error occurred.
+	 */
+
+	sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
+		interp->errorLine);
+	Tcl_AddErrorInfo(interp, msg);
+    }
+    iPtr->scriptFile = oldScriptFile;
+    Tcl_DStringFree(&buffer);
+    return result;
+
+error:
+    if (cmdBuffer != (char *) NULL) {
+        ckfree(cmdBuffer);
+    }
+    iPtr->scriptFile = oldScriptFile;
+    Tcl_DStringFree(&buffer);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetErrno --
+ *
+ *	Gets the current value of the Tcl error code variable. This is
+ *	currently the global variable "errno" but could in the future
+ *	change to something else.
+ *
+ * Results:
+ *	The value of the Tcl error code variable.
+ *
+ * Side effects:
+ *	None. Note that the value of the Tcl error code variable is
+ *	UNDEFINED if a call to Tcl_SetErrno did not precede this call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetErrno()
+{
+    return errno;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrno --
+ *
+ *	Sets the Tcl error code variable to the supplied value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Modifies the value of the Tcl error code variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetErrno(err)
+    int err;			/* The new value. */
+{
+    errno = err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PosixError --
+ *
+ *	This procedure is typically called after UNIX kernel calls
+ *	return errors.  It stores machine-readable information about
+ *	the error in $errorCode returns an information string for
+ *	the caller's use.
+ *
+ * Results:
+ *	The return value is a human-readable string describing the
+ *	error.
+ *
+ * Side effects:
+ *	The global variable $errorCode is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_PosixError(interp)
+    Tcl_Interp *interp;		/* Interpreter whose $errorCode variable
+				 * is to be changed. */
+{
+    char *id, *msg;
+
+    msg = Tcl_ErrnoMsg(errno);
+    id = Tcl_ErrnoId();
+    Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
+    return msg;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStat --
+ *
+ *	This procedure replaces the library version of stat and lsat.
+ *	The chain of functions that have been "inserted" into the
+ *	'statProcList' will be called in succession until either
+ *	a value of zero is returned, or the entire list is visited.
+ *
+ * Results:
+ *      See stat documentation.
+ *
+ * Side effects:
+ *      See stat documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStat(path, buf)
+    CONST char *path;		/* Path of file to stat (in current CP). */
+    TclStat_ *buf;		/* Filled with results of stat call. */
+{
+    StatProc *statProcPtr = statProcList;
+    int retVal = -1;
+
+    /*
+     * Call each of the "stat" function in succession.  A non-return
+     * value of -1 indicates the particular function has succeeded.
+     */
+
+    while ((retVal == -1) && (statProcPtr != NULL)) {
+	retVal = (*statProcPtr->proc)(path, buf);
+	statProcPtr = statProcPtr->nextPtr;
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccess --
+ *
+ *	This procedure replaces the library version of access.
+ *	The chain of functions that have been "inserted" into the
+ *	'accessProcList' will be called in succession until either
+ *	a value of zero is returned, or the entire list is visited.
+ *
+ * Results:
+ *      See access documentation.
+ *
+ * Side effects:
+ *      See access documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccess(path, mode)
+    CONST char *path;		/* Path of file to access (in current CP). */
+    int mode;                   /* Permission setting. */
+{
+    AccessProc *accessProcPtr = accessProcList;
+    int retVal = -1;
+
+    /*
+     * Call each of the "access" function in succession.  A non-return
+     * value of -1 indicates the particular function has succeeded.
+     */
+
+    while ((retVal == -1) && (accessProcPtr != NULL)) {
+	retVal = (*accessProcPtr->proc)(path, mode);
+	accessProcPtr = accessProcPtr->nextPtr;
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenFileChannel --
+ *
+ *	The chain of functions that have been "inserted" into the
+ *	'openFileChannelProcList' will be called in succession until
+ *	either a valid file channel is returned, or the entire list is
+ *	visited.
+ *
+ * Results:
+ *	The new channel or NULL, if the named file could not be opened.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the
+ *	file system.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+Tcl_Channel
+Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;                     /* Name of file to open. */
+    char *modeString;                   /* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;                    /* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    OpenFileChannelProc *openFileChannelProcPtr = openFileChannelProcList;
+    Tcl_Channel retVal = NULL;
+
+    /*
+     * Call each of the "Tcl_OpenFileChannel" function in succession.
+     * A non-NULL return value indicates the particular function has
+     * succeeded.
+     */
+
+    while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
+	retVal = (*openFileChannelProcPtr->proc)(interp, fileName,
+		modeString, permissions);
+	openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStatInsertProc --
+ *
+ *	Insert the passed procedure pointer at the head of the list of
+ *	functions which are used during a call to 'TclStat(...)'. The
+ *	passed function should be have exactly like 'TclStat' when called
+ *	during that time (see 'TclStat(...)' for more informatin).
+ *	The function will be added even if it already in the list.
+ *
+ * Results:
+ *      Normally TCL_OK; TCL_ERROR if memory for a new node in the list
+ *	could not be allocated.
+ *
+ * Side effects:
+ *      Memory allocataed and modifies the link list for 'TclStat'
+ *	functions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStatInsertProc (proc)
+    TclStatProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	StatProc *newStatProcPtr;
+
+	newStatProcPtr = (StatProc *)Tcl_Alloc(sizeof(StatProc));;
+
+	if (newStatProcPtr != NULL) {
+	    newStatProcPtr->proc = proc;
+	    newStatProcPtr->nextPtr = statProcList;
+	    statProcList = newStatProcPtr;
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStatDeleteProc --
+ *
+ *	Removed the passed function pointer from the list of 'TclStat'
+ *	functions.  Ensures that the built-in stat function is not
+ *	removvable.
+ *
+ * Results:
+ *      TCL_OK if the procedure pointer was successfully removed,
+ *	TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *      Memory is deallocated and the respective list updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStatDeleteProc (proc)
+    TclStatProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    StatProc *tmpStatProcPtr = statProcList;
+    StatProc *prevStatProcPtr = NULL;
+
+    /*
+     * Traverse the 'statProcList' looking for the particular node
+     * whose 'proc' member matches 'proc' and remove that one from
+     * the list.  Ensure that the "default" node cannot be removed.
+     */
+
+    while ((retVal == TCL_ERROR) && (tmpStatProcPtr != &defaultStatProc)) {
+	if (tmpStatProcPtr->proc == proc) {
+	    if (prevStatProcPtr == NULL) {
+		statProcList = tmpStatProcPtr->nextPtr;
+	    } else {
+		prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
+	    }
+
+	    Tcl_Free((char *)tmpStatProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevStatProcPtr = tmpStatProcPtr;
+	    tmpStatProcPtr = tmpStatProcPtr->nextPtr;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccessInsertProc --
+ *
+ *	Insert the passed procedure pointer at the head of the list of
+ *	functions which are used during a call to 'TclAccess(...)'. The
+ *	passed function should be have exactly like 'TclAccess' when
+ *	called during that time (see 'TclAccess(...)' for more informatin).
+ *	The function will be added even if it already in the list.
+ *
+ * Results:
+ *      Normally TCL_OK; TCL_ERROR if memory for a new node in the list
+ *	could not be allocated.
+ *
+ * Side effects:
+ *      Memory allocataed and modifies the link list for 'TclAccess'
+ *	functions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccessInsertProc(proc)
+    TclAccessProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	AccessProc *newAccessProcPtr;
+
+	newAccessProcPtr = (AccessProc *)Tcl_Alloc(sizeof(AccessProc));;
+
+	if (newAccessProcPtr != NULL) {
+	    newAccessProcPtr->proc = proc;
+	    newAccessProcPtr->nextPtr = accessProcList;
+	    accessProcList = newAccessProcPtr;
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccessDeleteProc --
+ *
+ *	Removed the passed function pointer from the list of 'TclAccess'
+ *	functions.  Ensures that the built-in access function is not
+ *	removvable.
+ *
+ * Results:
+ *      TCL_OK if the procedure pointer was successfully removed,
+ *	TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *      Memory is deallocated and the respective list updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccessDeleteProc(proc)
+    TclAccessProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    AccessProc *tmpAccessProcPtr = accessProcList;
+    AccessProc *prevAccessProcPtr = NULL;
+
+    /*
+     * Traverse the 'accessProcList' looking for the particular node
+     * whose 'proc' member matches 'proc' and remove that one from
+     * the list.  Ensure that the "default" node cannot be removed.
+     */
+
+    while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != &defaultAccessProc)) {
+	if (tmpAccessProcPtr->proc == proc) {
+	    if (prevAccessProcPtr == NULL) {
+		accessProcList = tmpAccessProcPtr->nextPtr;
+	    } else {
+		prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
+	    }
+
+	    Tcl_Free((char *)tmpAccessProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevAccessProcPtr = tmpAccessProcPtr;
+	    tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOpenFileChannelInsertProc --
+ *
+ *	Insert the passed procedure pointer at the head of the list of
+ *	functions which are used during a call to
+ *	'Tcl_OpenFileChannel(...)'. The passed function should be have
+ *	exactly like 'Tcl_OpenFileChannel' when called during that time
+ *	(see 'Tcl_OpenFileChannel(...)' for more informatin). The
+ *	function will be added even if it already in the list.
+ *
+ * Results:
+ *      Normally TCL_OK; TCL_ERROR if memory for a new node in the list
+ *	could not be allocated.
+ *
+ * Side effects:
+ *      Memory allocataed and modifies the link list for
+ *	'Tcl_OpenFileChannel' functions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOpenFileChannelInsertProc(proc)
+    TclOpenFileChannelProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	OpenFileChannelProc *newOpenFileChannelProcPtr;
+
+	newOpenFileChannelProcPtr =
+		(OpenFileChannelProc *)Tcl_Alloc(sizeof(OpenFileChannelProc));;
+
+	if (newOpenFileChannelProcPtr != NULL) {
+	    newOpenFileChannelProcPtr->proc = proc;
+	    newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
+	    openFileChannelProcList = newOpenFileChannelProcPtr;
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOpenFileChannelDeleteProc --
+ *
+ *	Removed the passed function pointer from the list of
+ *	'Tcl_OpenFileChannel' functions.  Ensures that the built-in
+ *	open file channel function is not removvable.
+ *
+ * Results:
+ *      TCL_OK if the procedure pointer was successfully removed,
+ *	TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *      Memory is deallocated and the respective list updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOpenFileChannelDeleteProc(proc)
+    TclOpenFileChannelProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
+    OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
+
+    /*
+     * Traverse the 'openFileChannelProcList' looking for the particular
+     * node whose 'proc' member matches 'proc' and remove that one from
+     * the list.  Ensure that the "default" node cannot be removed.
+     */
+
+    while ((retVal == TCL_ERROR) &&
+	    (tmpOpenFileChannelProcPtr != &defaultOpenFileChannelProc)) {
+	if (tmpOpenFileChannelProcPtr->proc == proc) {
+	    if (prevOpenFileChannelProcPtr == NULL) {
+		openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
+	    } else {
+		prevOpenFileChannelProcPtr->nextPtr =
+			tmpOpenFileChannelProcPtr->nextPtr;
+	    }
+
+	    Tcl_Free((char *)tmpOpenFileChannelProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
+	    tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
+	}
+    }
+
+    return (retVal);
+}
diff --git a/tcl/generic/tclIndexObj.c b/tcl/generic/tclIndexObj.c
new file mode 100644
index 00000000000..f88d216e751
--- /dev/null
+++ b/tcl/generic/tclIndexObj.c
@@ -0,0 +1,308 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. The
+					 * message may be NULL. */
+{
+    Tcl_Obj *objPtr;
+    char **tablePtr;
+    int i;
+
+    objPtr = Tcl_GetObjResult(interp);
+    Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+    for (i = 0; i < objc; i++) {
+	/*
+	 * If the object is an index type use the index table which allows
+	 * for the correct error message even if the subcommand was
+	 * abbreviated.  Otherwise, just use the string rep.
+	 */
+	
+	if (objv[i]->typePtr == &tclIndexType) {
+	    tablePtr = ((char **) objv[i]->internalRep.twoPtrValue.ptr1);
+	    Tcl_AppendStringsToObj(objPtr,
+		    tablePtr[(int) objv[i]->internalRep.twoPtrValue.ptr2],
+		    (char *) NULL);
+	} else {
+	    Tcl_AppendStringsToObj(objPtr,
+		    Tcl_GetStringFromObj(objv[i], (int *) NULL),
+		    (char *) NULL);
+	}
+	if (i < (objc - 1)) {
+	    Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+	}
+    }
+    if (message) {
+      Tcl_AppendStringsToObj(objPtr, " ", message, (char *) NULL);
+    }
+    Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+}
diff --git a/tcl/generic/tclInitScript.h b/tcl/generic/tclInitScript.h
new file mode 100644
index 00000000000..975edeab3cf
--- /dev/null
+++ b/tcl/generic/tclInitScript.h
@@ -0,0 +1,182 @@
+/* 
+ * tclInitScript.h --
+ *
+ *	This file contains Unix & Windows common init script
+ *      It is not used on the Mac. (the mac init script is in tclMacInit.c)
+ *	This file should only be included once in the entire set of C
+ *	source files for Tcl (by the respective platform initialization
+ *	C source file, tclUnixInit.c and tclWinInit.c) and thus the
+ *	presence of the routine, TclSetPreInitScript, below, should be
+ *	harmless.
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * In order to find init.tcl during initialization, the following script
+ * is invoked by Tcl_Init().  It looks in several different directories:
+ *
+ *	$tcl_library		- can specify a primary location, if set
+ *				  no other locations will be checked
+ *
+ *	$env(TCL_LIBRARY)	- highest priority so user can always override
+ *				  the search path unless the application has
+ *				  specified an exact directory above
+ *
+ *	$tclDefaultLibrary	- this value is initialized by TclPlatformInit
+ *				  from a static C variable that was set at
+ *				  compile time
+ *
+ *	<executable directory>/../lib/tcl$tcl_version
+ *				- look for a lib/tcl<ver> in a sibling of
+ *				  the bin directory (e.g. install hierarchy)
+ *
+ *	<executable directory>/../../lib/tcl$tcl_version
+ *				- look for a lib/tcl<ver> in a sibling of
+ *				  the bin/arch directory
+ *
+ *	<executable directory>/../library
+ *				- look in build directory
+ *
+ *	<executable directory>/../../library
+ *				- look in build directory from unix/arch
+ *
+ *	<executable directory>/../../tcl$tcl_patchLevel/library
+ *				- look for tcl build directory relative
+ *				  to a parallel build directory (e.g. Tk)
+ *
+ *	<executable directory>/../../../tcl$tcl_patchLevel/library
+ *				- look for tcl build directory relative
+ *				  to a parallel build directory from
+ *				  down inside unix/arch directory
+ *
+ * The first directory on this path that contains a valid init.tcl script
+ * will be set as the value of tcl_library.
+ *
+ * Note that this entire search mechanism can be bypassed by defining an
+ * alternate tclInit procedure before calling Tcl_Init().
+ */
+
+static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
+  proc tclInit {} {\n\
+    global tcl_library tcl_version tcl_patchLevel errorInfo\n\
+    global tcl_pkgPath env tclDefaultLibrary\n\
+    global tcl_platform\n\
+    rename tclInit {}\n\
+    set errors {}\n\
+    set dirs {}\n\
+    if {[info exists tcl_library]} {\n\
+	lappend dirs $tcl_library\n\
+    } else {\n\
+	if {[info exists env(TCL_LIBRARY)]} {\n\
+	    lappend dirs $env(TCL_LIBRARY)\n\
+	}\n\
+        # CYGNUS LOCAL: I've changed this alot.  Basically we only care about two cases,\n\
+        # if we are installed, and if we are in the devo tree...\n\
+        # The next few are for if we are installed:\n\
+	set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
+        lappend dirs [file join $parentDir share tcl$tcl_version]\n\
+	lappend dirs [file join [file dirname $parentDir] share tcl$tcl_version]\n\
+        # NOW, let's try to find it in the build tree...\n\
+        # Rather than play all the games Scriptics does, if we are in the build\n\
+        # tree there will be a tclConfig.sh relative to the executible's directory, and we \n\
+        # can read it and get the source dir from there...\n\
+        #\n\
+        # We duplicate all the directories in the search, one w/o the version and one with.\n\
+        # Most modules use ../../tcl/{unix,win}\n\
+        lappend configDirs [file join [file dirname $parentDir] tcl$tcl_version $tcl_platform(platform)]\n\
+        lappend configDirs [file join [file dirname $parentDir] tcl             $tcl_platform(platform)]\n\
+        # This one gets tclsh...\n\
+        lappend configDirs [info nameofexecutable]\n\
+        # This one is for gdb, and any other app which has its executible in the top directory.\n\
+        lappend configDirs [file join $parentDir tcl$tcl_version $tcl_platform(platform)]\n\
+        lappend configDirs [file join $parentDir tcl             $tcl_platform(platform)]\n\
+        # This last will handle itclsh & itkwish (../../../tcl/{unix,win}):\n\
+        lappend configDirs [file join [file dirname [file dirname $parentDir]] tcl$tcl_version $tcl_platform(platform)]\n\
+        lappend configDirs [file join [file dirname [file dirname $parentDir]] tcl             $tcl_platform(platform)]\n\
+        \n\
+        foreach i $configDirs {\n\
+            set configFile [file join $i tclConfig.sh]\n\
+            if {[file exists $configFile]} {\n\
+                if {![catch {open $configFile r} fileH]} {\n\
+                    set srcDir {}\n\
+                    while {[gets $fileH line] >= 0} {\n\
+                        if {[regexp {^TCL_SRC_DIR='([^']*)'} $line dummy srcDir]} {\n\
+                            break\n\
+                        }\n\
+                    }\n\
+                    close $fileH\n\
+                    if {$srcDir != \"\"} {\n\
+                        lappend dirs [file join $srcDir library]\n\
+                        break\n\
+                    }\n\
+                }\n\
+            }\n\
+        }\n\
+    }\n\
+    # I also moved this from just after TCL_LIBRARY to last.\n\
+    # I only want to use the compiled in library if I am really lost, because\n\
+    # otherwise if I have installed once, but am working in the build directory,\n\
+    # I will always pick up the installed files, which will be very confusing...\n\
+    lappend dirs $tclDefaultLibrary\n\
+    unset tclDefaultLibrary\n\
+    foreach i $dirs {\n\
+	set tcl_library $i\n\
+	set tclfile [file join $i init.tcl]\n\
+	if {[file exists $tclfile]} {\n\
+	    if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
+	        return\n\
+	    } else {\n\
+		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
+	    }\n\
+            set tcl_pkgPath [lreplace $tcl_pkgPath end end]\n\
+	}\n\
+    }\n\
+    set msg \"Can't find a usable init.tcl in the following directories: \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\
+}\n\
+tclInit";
+
+/*
+ * A pointer to a string that holds an initialization script that if non-NULL
+ * is evaluated in Tcl_Init() prior to the the built-in initialization script
+ * above.  This variable can be modified by the procedure below.
+ */
+ 
+static char *          tclPreInitScript = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetPreInitScript --
+ *
+ *	This routine is used to change the value of the internal
+ *	variable, tclPreInitScript.
+ *
+ * Results:
+ *	Returns the current value of tclPreInitScript.
+ *
+ * Side effects:
+ *	Changes the way Tcl_Init() routine behaves.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclSetPreInitScript (string)
+    char *string;		/* Pointer to a script. */
+{
+    char *prevString = tclPreInitScript;
+    tclPreInitScript = string;
+    return(prevString);
+}
diff --git a/tcl/generic/tclInt.h b/tcl/generic/tclInt.h
new file mode 100644
index 00000000000..d4b43489fe4
--- /dev/null
+++ b/tcl/generic/tclInt.h
@@ -0,0 +1,2147 @@
+/*
+ * tclInt.h --
+ *
+ *	Declarations of things used internally by the Tcl interpreter.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLINT
+#define _TCLINT
+
+/*
+ * Common include files needed by most of the Tcl source files are
+ * included here, so that system-dependent personalizations for the
+ * include files only have to be made in once place.  This results
+ * in a few extra includes, but greater modularity.  The order of
+ * the three groups of #includes is important.  For example, stdio.h
+ * is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
+ * needed by stdlib.h in some configurations.
+ */
+
+#include <stdio.h>
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+#ifndef _REGEXP
+#include "tclRegexp.h"
+#endif
+
+#include <ctype.h>
+#ifdef NO_LIMITS_H
+#   include "../compat/limits.h"
+#else
+#   include <limits.h>
+#endif
+#ifdef NO_STDLIB_H
+#   include "../compat/stdlib.h"
+#else
+#   include <stdlib.h>
+#endif
+#ifdef NO_STRING_H
+#include "../compat/string.h"
+#else
+#include <string.h>
+#endif
+#if defined(__STDC__) || defined(HAS_STDARG)
+#   include <stdarg.h>
+#else
+#   include <varargs.h>
+#endif
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * The following procedures allow namespaces to be customized to
+ * support special name resolution rules for commands/variables.
+ * 
+ */
+
+struct Tcl_ResolvedVarInfo;
+
+typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, struct Tcl_ResolvedVarInfo *vinfoPtr));
+
+typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((
+    struct Tcl_ResolvedVarInfo *vinfoPtr));
+
+/*
+ * The following structure encapsulates the routines needed to resolve a
+ * variable reference at runtime.  Any variable specific state will typically
+ * be appended to this structure.
+ */
+
+
+typedef struct Tcl_ResolvedVarInfo {
+    Tcl_ResolveRuntimeVarProc *fetchProc;
+    Tcl_ResolveVarDeleteProc *deleteProc;
+} Tcl_ResolvedVarInfo;
+
+
+
+typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, char* name, int length,
+    Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr));
+
+typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+    int flags, Tcl_Var *rPtr));
+
+typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
+ 	char* name, Tcl_Namespace *context, int flags,
+ 	Tcl_Command *rPtr));
+ 
+typedef struct Tcl_ResolverInfo {
+    Tcl_ResolveCmdProc *cmdResProc;	/* Procedure handling command name
+ 					 * resolution. */
+    Tcl_ResolveVarProc *varResProc;	/* Procedure handling variable name
+ 					 * resolution for variables that
+ 					 * can only be handled at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+ 					/* Procedure handling variable name
+ 					 * resolution at compile time. */
+} Tcl_ResolverInfo;
+
+/*
+ *----------------------------------------------------------------
+ * 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. */
+    int resolverEpoch;		 /* Incremented whenever the name resolution
+				  * rules change for this namespace; this
+				  * invalidates all byte codes compiled in
+				  * the namespace, causing the code to be
+				  * recompiled under the new rules. */
+    Tcl_ResolveCmdProc *cmdResProc;
+				 /* If non-null, this procedure overrides
+				  * the usual command resolution mechanism
+				  * in Tcl.  This procedure is invoked
+				  * within Tcl_FindCommand to resolve all
+				  * command references within the namespace. */
+    Tcl_ResolveVarProc *varResProc;
+				 /* If non-null, this procedure overrides
+				  * the usual variable resolution mechanism
+				  * in Tcl.  This procedure is invoked
+				  * within Tcl_FindNamespaceVar to resolve all
+				  * variable references within the namespace
+				  * at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+				 /* If non-null, this procedure overrides
+				  * the usual variable resolution mechanism
+				  * in Tcl.  This procedure is invoked
+				  * within LookupCompiledLocal to resolve
+				  * variable references within the namespace
+				  * at compile time. */
+} 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
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The following structure defines a variable trace, which is used to
+ * invoke a specific C procedure whenever certain operations are performed
+ * on a variable.
+ */
+
+typedef struct VarTrace {
+    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given
+				 * by flags are performed on variable. */
+    ClientData clientData;	/* Argument to pass to proc. */
+    int flags;			/* What events the trace procedure is
+				 * interested in:  OR-ed combination of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES, and
+				 * TCL_TRACE_UNSETS. */
+    struct VarTrace *nextPtr;	/* Next in list of traces associated with
+				 * a particular variable. */
+} VarTrace;
+
+/*
+ * When a variable trace is active (i.e. its associated procedure is
+ * executing), one of the following structures is linked into a list
+ * associated with the variable's interpreter.  The information in
+ * the structure is needed in order for Tcl to behave reasonably
+ * if traces are deleted while traces are active.
+ */
+
+typedef struct ActiveVarTrace {
+    struct Var *varPtr;		/* Variable that's being traced. */
+    struct ActiveVarTrace *nextPtr;
+				/* Next in list of all active variable
+				 * traces for the interpreter, or NULL
+				 * if no more. */
+    VarTrace *nextTracePtr;	/* Next trace to check after current
+				 * trace procedure returns;  if this
+				 * trace gets deleted, must update pointer
+				 * to avoid using free'd memory. */
+} ActiveVarTrace;
+
+/*
+ * The following structure describes an enumerative search in progress on
+ * an array variable;  this are invoked with options to the "array"
+ * command.
+ */
+
+typedef struct ArraySearch {
+    int id;			/* Integer id used to distinguish among
+				 * multiple concurrent searches for the
+				 * same array. */
+    struct Var *varPtr;		/* Pointer to array variable that's being
+				 * searched. */
+    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
+				 * the Tcl_FirstHashEntry call or from
+				 * an "array anymore" command).  NULL
+				 * means must call Tcl_NextHashEntry
+				 * to get value to return. */
+    struct ArraySearch *nextPtr;/* Next in list of all active searches
+				 * for this variable, or NULL if this is
+				 * the last one. */
+} ArraySearch;
+
+/*
+ * The structure below defines a variable, which associates a string name
+ * 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 {
+    union {
+	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 *linkPtr;	/* If this is a global variable being
+				 * referred to in a procedure, or a variable
+				 * created by "upvar", this field points to
+				 * the referenced variable's Var struct. */
+    } value;
+    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 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, and 1 if the variable is a 
+				 * namespace 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. */
+} Var;
+
+/*
+ * 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_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).
+ * VAR_NAMESPACE_VAR -		1 means that this variable was declared
+ *				as a namespace variable. This flag ensures
+ *				it persists until its namespace is
+ *				destroyed or until the variable is unset;
+ *				it will persist even if it has not been
+ *				initialized and is marked undefined.
+ *				The variable's refCount is incremented to
+ *				reflect the "reference" from its namespace.
+ *
+ * The following additional flags are used with the CompiledLocal type
+ * defined below:
+ *
+ * VAR_ARGUMENT -		1 means that this variable holds a procedure
+ *				argument. 
+ * VAR_TEMPORARY -		1 if the local variable is an anonymous
+ *				temporary variable. Temporaries have a NULL
+ *				name.
+ * VAR_RESOLVED -		1 if name resolution has been done for this
+ *				variable.
+ */
+
+#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
+#define VAR_NAMESPACE_VAR	0x80
+
+#define VAR_ARGUMENT		0x100
+#define VAR_TEMPORARY		0x200
+#define VAR_RESOLVED		0x400	
+
+/*
+ * 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 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));
+ * EXTERN int	TclIsVarTemporary _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarArgument _ANSI_ARGS_((Var *varPtr));
+ * EXTERN int	TclIsVarResolved _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)
+
+#define TclIsVarTemporary(varPtr) \
+    ((varPtr)->flags & VAR_TEMPORARY)
+    
+#define TclIsVarArgument(varPtr) \
+    ((varPtr)->flags & VAR_ARGUMENT)
+    
+#define TclIsVarResolved(varPtr) \
+    ((varPtr)->flags & VAR_RESOLVED)
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to procedures.  These are used primarily
+ * in tclProc.c, tclCompile.c, and tclExecute.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Forward declaration to prevent an error when the forward reference to
+ * Command is encountered in the Proc and ImportRef types declared below.
+ */
+
+struct Command;
+
+/*
+ * 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 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 flags;			/* Flag bits for the local variable. Same as
+				 * the flags for the Var structure above,
+				 * although only VAR_SCALAR, VAR_ARRAY, 
+				 * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and
+				 * VAR_RESOLVED 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. */
+    Tcl_ResolvedVarInfo *resolveInfo;
+				/* Customized variable resolution info
+				 * supplied by the Tcl_ResolveCompiledVarProc
+				 * associated with a namespace. Each variable
+				 * is marked by a unique ClientData tag
+				 * during compilation, and that same tag
+				 * is used to find the variable at runtime. */
+    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 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. */
+    struct Command *cmdPtr;	  /* Points to the Command structure for
+				   * this procedure. This is used to get
+				   * the namespace in which to execute
+				   * the 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;
+
+/*
+ * The structure below defines a command trace.  This is used to allow Tcl
+ * clients to find out whenever a command is about to be executed.
+ */
+
+typedef struct Trace {
+    int level;			/* Only trace commands at nesting level
+				 * less than or equal to this. */
+    Tcl_CmdTraceProc *proc;	/* Procedure to call to trace command. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
+} Trace;
+
+/*
+ * The structure below defines an entry in the assocData hash table which
+ * is associated with an interpreter. The entry contains a pointer to a
+ * function to call when the interpreter is deleted, and a pointer to
+ * a user-defined piece of data.
+ */
+
+typedef struct AssocData {
+    Tcl_InterpDeleteProc *proc;	/* Proc to call when deleting. */
+    ClientData clientData;	/* Value to pass to proc. */
+} AssocData;    
+
+/*
+ * 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 {
+    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 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
+				 * 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).
+ */
+
+typedef struct {
+    char *command;		/* String containing previously-executed
+				 * command. */
+    int bytesAvl;		/* Total # of bytes available at *event (not
+				 * all are necessarily in use now). */
+} HistoryEvent;
+
+/*
+ * 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
+ * beginning of tclHistory.c for information on revisions.
+ */
+
+typedef struct HistoryRev {
+    int firstIndex;		/* Index of the first byte to replace in
+				 * current history event. */
+    int lastIndex;		/* Index of last byte to replace in
+				 * current history event. */
+    int newSize;		/* Number of bytes in newBytes. */
+    char *newBytes;		/* Replacement for the range given by
+				 * firstIndex and lastIndex (malloced). */
+    struct HistoryRev *nextPtr;	/* Next in chain of revisions to apply, or
+				 * NULL for end of list. */
+} HistoryRev;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to expressions.  These are used only in
+ * tclExpr.c.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines a math function (e.g. sin or hypot)
+ * for use in Tcl expressions.
+ */
+
+#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.
+				 * NULL if isBuiltinFunc is 1. */
+    ClientData clientData;	/* Additional argument to pass to the
+				 * function when invoking it. NULL if
+				 * isBuiltinFunc is 1. */
+} MathFunc;
+
+/*
+ *----------------------------------------------------------------
+ * 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.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * 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;
+
+/*
+ * 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 {
+    struct Command *realCmdPtr;	/* "Real" command that this imported command
+                                 * refers to. */
+    struct 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;
+
+/*
+ * 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 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). */
+    Namespace *nsPtr;		/* Points to the namespace containing this
+				 * command. */
+    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). 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;
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to name resolution procedures.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The interpreter keeps a linked list of name resolution schemes.
+ * The scheme for a namespace is consulted first, followed by the
+ * list of schemes in an interpreter, followed by the default
+ * name resolution in Tcl.  Schemes are added/removed from the
+ * interpreter's list by calling Tcl_AddInterpResolver and
+ * Tcl_RemoveInterpResolver.
+ */
+
+typedef struct ResolverScheme {
+    char *name;			/* Name identifying this scheme. */
+    Tcl_ResolveCmdProc *cmdResProc;
+				/* Procedure handling command name
+				 * resolution. */
+    Tcl_ResolveVarProc *varResProc;
+				/* Procedure handling variable name
+				 * resolution for variables that
+				 * can only be handled at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+				/* Procedure handling variable name
+				 * resolution at compile time. */
+
+    struct ResolverScheme *nextPtr;
+				/* Pointer to next record in linked list. */
+} ResolverScheme;
+
+/*
+ *----------------------------------------------------------------
+ * 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
+ * this data structure is in tclBasic.c, but almost every Tcl
+ * source file uses something in here.
+ *----------------------------------------------------------------
+ */
+
+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;               /* 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 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
+				 * type (MathFunc *). */
+
+    /*
+     * Information related to procedures and variables. See tclProc.c
+     * and tclvar.c for usage.
+     */
+
+    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. */
+    int maxNestingDepth;	/* If numLevels exceeds this value then Tcl
+				 * assumes that infinite recursion has
+				 * occurred and it generates an error. */
+    CallFrame *framePtr;	/* Points to top-most in stack of all nested
+				 * procedure invocations.  NULL means there
+				 * 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
+				 * 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. */
+    int returnCode;		/* Completion code to return if current
+				 * 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
+				 * is TCL_ERROR.  Malloc'ed, may be NULL */
+
+    /*
+     * Information used by Tcl_AppendResult to keep track of partial
+     * results.  See Tcl_AppendResult code for details.
+     */
+
+    char *appendResult;		/* Storage space for results generated
+				 * by Tcl_AppendResult.  Malloc-ed.  NULL
+				 * means not yet allocated. */
+    int appendAvl;		/* Total amount of space available at
+				 * partialResult. */
+    int appendUsed;		/* Number of non-null bytes currently
+				 * stored at partialResult. */
+
+    /*
+     * A cache of compiled regular expressions.  See Tcl_RegExpCompile
+     * in tclUtil.c for details.
+     */
+
+#define NUM_REGEXPS 5
+    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
+				 * regular expression patterns.  NULL
+				 * means that this slot isn't used.
+				 * Malloc-ed. */
+    int patLengths[NUM_REGEXPS];/* Number of non-null characters in
+				 * corresponding entry in patterns.
+				 * -1 means entry isn't used. */
+    regexp *regexps[NUM_REGEXPS];
+				/* Compiled forms of above strings.  Also
+				 * malloc-ed, or NULL if not in use yet. */
+
+    /*
+     * Information about packages.  Used only in tclPkg.c.
+     */
+
+    Tcl_HashTable packageTable;	/* Describes all of the packages loaded
+				 * in or available to this interpreter.
+				 * Keys are package names, values are
+				 * (Package *) pointers. */
+    char *packageUnknown;	/* Command to invoke during "package
+				 * require" commands for packages that
+				 * aren't described in packageTable. 
+				 * Malloc'ed, may be NULL. */
+
+    /*
+     * Miscellaneous information:
+     */
+
+    int cmdCount;		/* Total number of times a command procedure
+				 * has been called for this interpreter. */
+    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. */
+    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. */
+    ResolverScheme *resolverPtr;
+				/* Linked list of name resolution schemes
+				 * added to this interpreter.  Schemes
+				 * are added/removed by calling
+				 * Tcl_AddInterpResolver and
+				 * Tcl_RemoveInterpResolver. */
+    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 holding small results. */
+} Interp;
+
+/*
+ * EvalFlag bits for Interp structures:
+ *
+ * TCL_BRACKET_TERM	1 means that the current script is terminated by
+ *			a close bracket rather than the end of the string.
+ * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with
+ *			a code other than TCL_OK or TCL_ERROR;  0 means
+ *			codes other than these should be turned into errors.
+ */
+
+#define TCL_BRACKET_TERM	  1
+#define TCL_ALLOW_EXCEPTIONS	  4
+
+/*
+ * Flag bits for Interp structures:
+ *
+ * DELETED:		Non-zero means the interpreter has been deleted:
+ *			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_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
+ *			"error message log" command).
+ * ERROR_CODE_SET:	Non-zero means that Tcl_SetErrorCode has been
+ *			called to record information for the current
+ *			error.  Zero means Tcl_Eval must clear the
+ *			errorCode variable if an error is returned.
+ * 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.
+ * SAFE_INTERP:         Non zero means that the current interp is a
+ *                      safe interp (ie it has only the safe commands
+ *                      installed, less priviledge than a regular interp).
+ */
+
+#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
+#define SAFE_INTERP              0x80
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to command parsing. These are used in
+ * tclParse.c and its clients.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The following data structure is used by various parsing procedures
+ * to hold information about where to store the results of parsing
+ * (e.g. the substituted contents of a quoted argument, or the result
+ * of a nested command).  At any given time, the space available
+ * for output is fixed, but a procedure may be called to expand the
+ * space available if the current space runs out.
+ */
+
+typedef struct ParseValue {
+    char *buffer;		/* Address of first character in
+				 * output buffer. */
+    char *next;			/* Place to store next character in
+				 * output buffer. */
+    char *end;			/* Address of the last usable character
+				 * in the buffer. */
+    void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed));
+				/* Procedure to call when space runs out;
+				 * it will make more space. */
+    ClientData clientData;	/* Arbitrary information for use of
+				 * expandProc. */
+} 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.  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 unsigned char tclTypeTable[];
+#define CHAR_TYPE(src,last) \
+	(((src)==(last))?TCL_COMMAND_END:(tclTypeTable)[(int)(*(src) + 128)])
+
+/*
+ * 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 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 "$".
+ */
+
+#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
+ * to catch infinite recursion).
+ */
+
+#define MAX_NESTING_DEPTH	1000
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting
+ * it to an unsigned character) so that it can be used safely with
+ * macros such as isspace.
+ */
+
+#define UCHAR(c) ((unsigned char) (c))
+
+/*
+ * 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.
+ */
+
+#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
+
+/*
+ * The following macros are used to specify the runtime platform
+ * setting of the tclPlatform variable.
+ */
+
+typedef enum {
+    TCL_PLATFORM_UNIX,		/* Any Unix-like OS. */
+    TCL_PLATFORM_MAC,		/* MacOS. */
+    TCL_PLATFORM_WINDOWS	/* Any Microsoft Windows OS. */
+} 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;
+    
+/*
+ *----------------------------------------------------------------
+ * Data structures related to hooking 'TclStat(...)' and
+ * 'TclAccess(...)'.
+ *----------------------------------------------------------------
+ */
+
+typedef struct stat TclStat_;
+typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, TclStat_ *buf));
+typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path, int mode));
+typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp,
+	char *fileName, char *modeString,
+	int permissions));
+
+typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int argc, char *argv[]));
+typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
+
+/*
+ *----------------------------------------------------------------
+ * Variables shared among Tcl modules but not used by the outside world.
+ *----------------------------------------------------------------
+ */
+
+extern Tcl_Time			tclBlockTime;
+extern int			tclBlockTimeSet;
+extern char *			tclExecutableName;
+extern Tcl_ChannelType	 	tclFileChannelType;
+extern char *			tclMemDumpFileName;
+extern TclPlatformType		tclPlatform;
+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	tclProcBodyType;
+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;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl modules but not used by the outside
+ * world:
+ *----------------------------------------------------------------
+ */
+
+EXTERN void		panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+EXTERN int		TclAccess _ANSI_ARGS_((CONST char *path,
+			    int mode));
+EXTERN int		TclAccessDeleteProc _ANSI_ARGS_((TclAccessProc_ *proc));
+EXTERN int		TclAccessInsertProc _ANSI_ARGS_((TclAccessProc_ *proc));
+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, Tcl_Pid *pidPtr,
+			    Tcl_Channel errorChan));
+EXTERN void		TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
+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, 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		TclFinalizeEnvironment _ANSI_ARGS_((void));
+EXTERN void		TclFinalizeExecEnv _ANSI_ARGS_((void));
+EXTERN int		TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
+			    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 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_((CONST char *name));
+EXTERN char *		TclGetExtension _ANSI_ARGS_((char *name));
+EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, CallFrame **framePtrPtr));
+EXTERN TclCmdProcType	TclGetInterpProc _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 TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
+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		TclHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclHideUnsafeCommands _ANSI_ARGS_((
+    			    Tcl_Interp *interp));
+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		TclInitCompiledLocals _ANSI_ARGS_((
+			    Tcl_Interp *interp, CallFrame *framePtr,
+			    Namespace *nsPtr));
+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		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_Obj *	TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
+EXTERN int		TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
+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 int		TclOpenFileChannelDeleteProc _ANSI_ARGS_((
+			    TclOpenFileChannelProc_ *proc));
+EXTERN int		TclOpenFileChannelInsertProc _ANSI_ARGS_((
+			    TclOpenFileChannelProc_ *proc));
+EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
+
+/*
+ * On a Mac, we can exit gracefully if the stack gets too small.
+ */
+
+#ifdef MAC_TCL
+EXTERN int		TclpCheckStackSpace _ANSI_ARGS_((void));
+#else
+#define TclpCheckStackSpace() (1)
+#endif
+
+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		TclpFinalize _ANSI_ARGS_((void));
+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 int		TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
+			    int direction));
+EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((char *fname, int mode));
+EXTERN Tcl_Channel	TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *fileName, char *modeString,
+			    int permissions));
+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));
+#ifndef TclpSysAlloc
+EXTERN VOID * 		TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
+#endif
+#ifndef TclpSysFree
+EXTERN void 		TclpSysFree _ANSI_ARGS_((VOID *ptr));
+#endif
+#ifndef TclpSysRealloc
+EXTERN VOID * 		TclpSysRealloc _ANSI_ARGS_((VOID *cp,
+			    unsigned int size));
+#endif
+EXTERN int		TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, char **termPtr, ParseValue *pvPtr));
+EXTERN int		TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int flags, char **termPtr,
+			    ParseValue *pvPtr));
+EXTERN int		TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string, int termChar, int flags,
+			    char **termPtr, ParseValue *pvPtr));
+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, Tcl_Command cmd));
+EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Obj *objPtr));
+EXTERN void		TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
+EXTERN int		TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
+ 			    Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
+ 			    CONST char *description, CONST char *procName));
+EXTERN void		TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
+EXTERN int		TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
+		    	    Tcl_Interp *interp, int argc, char **argv));
+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 char *		TclSetPreInitScript _ANSI_ARGS_((char *string));
+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		TclStat _ANSI_ARGS_((CONST char *path,
+			    TclStat_ *buf));
+EXTERN int		TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc));
+EXTERN int		TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc));
+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 char *		TclWordEnd _ANSI_ARGS_((char *start, char *lastChar,
+			    int nested, int *semiPtr));
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures in the generic core:
+ *----------------------------------------------------------------
+ */
+
+EXTERN int	Tcl_AfterObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+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_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_CdObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ClockObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_CloseObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+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_EofObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+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_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_FblockedObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_FconfigureCmd _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_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_ForeachObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_FormatObjCmd _ANSI_ARGS_((ClientData dummy,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+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_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_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_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_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_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_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,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SetCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+EXTERN int	Tcl_SplitObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_SocketCmd _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_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_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_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_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));
+
+/*
+ *----------------------------------------------------------------
+ * 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 void		Tcl_AddInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
+ 			    char *name, Tcl_ResolveCmdProc *cmdProc,
+ 			    Tcl_ResolveVarProc *varProc,
+ 			    Tcl_ResolveCompiledVarProc *compiledVarProc));
+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 int              Tcl_GetInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *name, Tcl_ResolverInfo *resInfo));
+EXTERN int              Tcl_GetNamespaceResolvers _ANSI_ARGS_((
+			    Tcl_Namespace *namespacePtr,
+			    Tcl_ResolverInfo *resInfo));
+EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Var variable,
+  			    Tcl_Obj *objPtr));
+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)); 
+EXTERN int		Tcl_RemoveInterpResolvers _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *name));
+EXTERN void		Tcl_SetNamespaceResolvers _ANSI_ARGS_((
+			    Tcl_Namespace *namespacePtr,
+			    Tcl_ResolveCmdProc *cmdProc,
+			    Tcl_ResolveVarProc *varProc,
+			    Tcl_ResolveCompiledVarProc *compiledVarProc));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLINT */
+
diff --git a/tcl/generic/tclInterp.c b/tcl/generic/tclInterp.c
new file mode 100644
index 00000000000..b4c0cd5203e
--- /dev/null
+++ b/tcl/generic/tclInterp.c
@@ -0,0 +1,3835 @@
+/* 
+ * tclInterp.c --
+ *
+ *	This file implements the "interp" command which allows creation
+ *	and manipulation of Tcl interpreters from within Tcl scripts.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Counter for how many aliases were created (global)
+ */
+
+static int aliasCounter = 0;
+
+/*
+ *
+ * struct Slave:
+ *
+ * Used by the "interp" command to record and find information about slave
+ * interpreters. Maps from a command name in the master to information about
+ * a slave interpreter, e.g. what aliases are defined in it.
+ */
+
+typedef struct {
+    Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */
+    Tcl_HashEntry *slaveEntry;	/* Hash entry in masters slave table for
+                                 * this slave interpreter. Used to find
+                                 * this record, and used when deleting the
+                                 * slave interpreter to delete it from the
+                                 * masters table. */
+    Tcl_Interp	*slaveInterp;	/* The slave interpreter. */
+    Tcl_Command interpCmd;	/* Interpreter object command. */
+    Tcl_HashTable aliasTable;	/* Table which maps from names of commands
+                                 * in slave interpreter to struct Alias
+                                 * defined below. */
+} Slave;
+
+/*
+ * struct Alias:
+ *
+ * Stores information about an alias. Is stored in the slave interpreter
+ * and used by the source command to find the target command in the master
+ * when the source command is invoked.
+ */
+
+typedef struct {
+    char	*aliasName;	/* Name of alias command. */
+    char	*targetName;	/* Name of target command in master interp. */
+    Tcl_Interp	*targetInterp;	/* Master interpreter. */
+    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
+                                 * alias table. */
+    Tcl_HashEntry *targetEntry;	/* Entry for target command in master.
+                                 * This is used in the master interpreter to
+                                 * map back from the target command to aliases
+                                 * redirecting to it. Random access to this
+                                 * hash table is never required - we are using
+                                 * a hash table only for convenience. */
+    Tcl_Command slaveCmd;	/* Source command in slave interpreter. */
+} Alias;
+
+/*
+ * struct Target:
+ *
+ * Maps from master interpreter commands back to the source commands in slave
+ * interpreters. This is needed because aliases can be created between sibling
+ * interpreters and must be deleted when the target interpreter is deleted. In
+ * case they would not be deleted the source interpreter would be left with a
+ * "dangling pointer". One such record is stored in the Master record of the
+ * master interpreter (in the targetTable hashtable, see below) with the
+ * master for each alias which directs to a command in the master. These
+ * records are used to remove the source command for an from a slave if/when
+ * the master is deleted.
+ */
+
+typedef struct {
+    Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */
+    Tcl_Interp *slaveInterp;	/* Slave Interpreter. */
+} Target;
+
+/*
+ * struct Master:
+ *
+ * This record is used for two purposes: First, slaveTable (a hashtable)
+ * maps from names of commands to slave interpreters. This hashtable is
+ * used to store information about slave interpreters of this interpreter,
+ * to map over all slaves, etc. The second purpose is to store information
+ * about all aliases in slaves (or siblings) which direct to target commands
+ * in this interpreter (using the targetTable hashtable).
+ * 
+ * NB: the flags field in the interp structure, used with SAFE_INTERP
+ * mask denotes whether the interpreter is safe or not. Safe
+ * interpreters have restricted functionality, can only create safe slave
+ * interpreters and can only load safe extensions.
+ */
+
+typedef struct {
+    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters.
+                                 * Maps from command names to Slave records. */
+    Tcl_HashTable targetTable;	/* Hash table for Target Records. Contains
+                                 * all Target records which denote aliases
+                                 * from slaves or sibling interpreters that
+                                 * direct to commands in this interpreter. This
+                                 * table is used to remove dangling pointers
+                                 * from the slave (or sibling) interpreters
+                                 * when this interpreter is deleted. */
+} Master;
+
+/*
+ * Prototypes for local static procedures:
+ */
+
+static int		AliasCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *currentInterp, int objc,
+		            Tcl_Obj *CONST objv[]));
+static void		AliasCmdDeleteProc _ANSI_ARGS_((
+			    ClientData clientData));
+static int		AliasCreationHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
+			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
+			    Master *masterPtr, char *aliasName,
+			    char *targetName, int objc,
+			    Tcl_Obj *CONST objv[]));
+static int		CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static Tcl_Interp	*CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
+		            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,
+			    Master *masterPtr, int objc,
+        		    Tcl_Obj *CONST objv[]));
+static int		DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
+			    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		InterpTransferHelper _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		SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
+		            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 objc,
+			    Tcl_Obj *CONST objv[]));
+static void		SlaveObjectDeleteProc _ANSI_ARGS_((
+			    ClientData clientData));
+static void		SlaveRecordDeleteProc _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPreventAliasLoop --
+ *
+ *	When defining an alias or renaming a command, prevent an alias
+ *	loop from being formed.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	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 TclRenameCommand.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPreventAliasLoop(interp, cmdInterp, cmd)
+    Tcl_Interp *interp;			/* Interp in which to report errors. */
+    Tcl_Interp *cmdInterp;		/* Interp in which the command is
+                                         * being defined. */
+    Tcl_Command cmd;                    /* Tcl command we are attempting
+                                         * to define. */
+{
+    Command *cmdPtr = (Command *) cmd;
+    Alias *aliasPtr, *nextAliasPtr;
+    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 (cmdPtr->objProc != AliasCmd) {
+        return TCL_OK;
+    }
+
+    /*
+     * OK, we are dealing with an alias, so traverse the chain of aliases.
+     * If we encounter the alias we are defining (or renaming to) any in
+     * the chain then we have a loop.
+     */
+
+    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.
+	 */
+
+	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;
+        }
+
+        /*
+	 * 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 (aliasCmdPtr->objProc != AliasCmd) {
+            return TCL_OK;
+        }
+        nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
+    }
+
+    /* NOTREACHED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->flags &= ~SAFE_INTERP;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeSafe --
+ *
+ *	Makes its argument interpreter contain only functionality that is
+ *	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:
+ *	Hides commands in its argument interpreter, and removes settings
+ *	and channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_MakeSafe(interp)
+    Tcl_Interp *interp;		/* Interpreter to be made safe. */
+{
+    Tcl_Channel chan;				/* Channel to remove from
+                                                 * safe interpreter. */
+    Interp *iPtr = (Interp *) interp;
+
+    TclHideUnsafeCommands(interp);
+    
+    iPtr->flags |= SAFE_INTERP;
+
+    /*
+     *  Unsetting variables : (which should not have been set 
+     *  in the first place, but...)
+     */
+
+    /*
+     * No env array in a safe slave.
+     */
+
+    Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
+
+    /* 
+     * Remove unsafe parts of tcl_platform
+     */
+
+    Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
+    Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
+    Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
+
+    /*
+     * Unset path informations variables
+     * (the only one remaining is [info nameofexecutable])
+     */
+
+    Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
+    Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
+    Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
+    
+    /*
+     * 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);
+    if (chan != (Tcl_Channel) NULL) {
+        Tcl_UnregisterChannel(interp, chan);
+    }
+    chan = Tcl_GetStdChannel(TCL_STDOUT);
+    if (chan != (Tcl_Channel) NULL) {
+        Tcl_UnregisterChannel(interp, chan);
+    }
+    chan = Tcl_GetStdChannel(TCL_STDERR);
+    if (chan != (Tcl_Channel) NULL) {
+        Tcl_UnregisterChannel(interp, chan);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetInterp --
+ *
+ *	Helper function to find a slave interpreter given a pathname.
+ *
+ * Results:
+ *	Returns the slave interpreter known by that name in the calling
+ *	interpreter, or NULL if no interpreter known by that name exists. 
+ *
+ * Side effects:
+ *	Assigns to the pointer variable passed in, if not NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Interp *
+GetInterp(interp, masterPtr, path, masterPtrPtr)
+    Tcl_Interp *interp;		/* Interp. to start search from. */
+    Master *masterPtr;		/* Its master record. */
+    char *path;			/* The path (name) of interp. to be found. */
+    Master **masterPtrPtr;	/* (Return) its master record. */
+{
+    Tcl_HashEntry *hPtr;	/* Search element. */
+    Slave *slavePtr;		/* Interim slave record. */
+    char **argv;		/* Split-up path (name) for interp to find. */
+    int argc, i;		/* Loop indices. */
+    Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */
+
+    if (masterPtrPtr != (Master **) NULL) {
+        *masterPtrPtr = masterPtr;
+    }
+    
+    if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
+        return (Tcl_Interp *) NULL;
+    }
+
+    for (searchInterp = interp, i = 0; i < argc; i++) {
+        
+        hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), argv[i]);
+        if (hPtr == (Tcl_HashEntry *) NULL) {
+            ckfree((char *) argv);
+            return (Tcl_Interp *) NULL;
+        }
+        slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+        searchInterp = slavePtr->slaveInterp;
+        if (searchInterp == (Tcl_Interp *) NULL) {
+            ckfree((char *) argv);
+            return (Tcl_Interp *) NULL;
+        }
+        masterPtr = (Master *) Tcl_GetAssocData(searchInterp,
+                "tclMasterRecord", NULL);
+        if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
+        if (masterPtr == (Master *) NULL) {
+            ckfree((char *) argv);
+            return (Tcl_Interp *) NULL;
+        }
+    }
+    ckfree((char *) argv);
+    return searchInterp;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSlave --
+ *
+ *	Helper function to do the actual work of creating a slave interp
+ *	and new object command. Also optionally makes the new slave
+ *	interpreter "safe".
+ *
+ * Results:
+ *	Returns the new Tcl_Interp * if successful or NULL if not. If failed,
+ *	the result of the invoking interpreter contains an error message.
+ *
+ * Side effects:
+ *	Creates a new slave interpreter and a new object command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Interp *
+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"? */
+{
+    Tcl_Interp *slaveInterp;		/* Ptr to slave interpreter. */
+    Tcl_Interp *masterInterp;		/* Ptr to master interp for slave. */
+    Slave *slavePtr;			/* Slave record. */
+    Tcl_HashEntry *hPtr;		/* Entry into interp hashtable. */
+    int new;				/* Indicates whether new entry. */
+    int argc;				/* Count of elements in slavePath. */
+    char **argv;			/* Elements in slavePath. */
+    char *masterPath;			/* Path to its master. */
+
+    if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
+        return (Tcl_Interp *) NULL;
+    }
+
+    if (argc < 2) {
+        masterInterp = interp;
+        if (argc == 1) {
+            slavePath = argv[0];
+        }
+    } else {
+        masterPath = Tcl_Merge(argc-1, argv);
+        masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
+        if (masterInterp == (Tcl_Interp *) NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter named \"", masterPath,
+                    "\" not found", (char *) NULL);
+            ckfree((char *) argv);
+            ckfree((char *) masterPath);
+            return (Tcl_Interp *) NULL;
+        }
+        ckfree((char *) masterPath);
+        slavePath = argv[argc-1];
+        if (!safe) {
+            safe = Tcl_IsSafe(masterInterp);
+        }
+    }
+    hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
+    if (new == 0) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", slavePath,
+                "\" already exists, cannot create", (char *) NULL);
+        ckfree((char *) argv);
+        return (Tcl_Interp *) NULL;
+    }
+    slaveInterp = Tcl_CreateInterp();
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        panic("CreateSlave: out of memory while creating a new interpreter");
+    }
+    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
+    slavePtr->masterInterp = masterInterp;
+    slavePtr->slaveEntry = hPtr;
+    slavePtr->slaveInterp = slaveInterp;
+    slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, slavePath,
+            SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
+    Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
+    (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
+            SlaveRecordDeleteProc, (ClientData) slavePtr);
+    Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
+    Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
+    
+    /*
+     * Inherit the recursion limit.
+     */
+    ((Interp *)slaveInterp)->maxNestingDepth =
+	((Interp *)masterInterp)->maxNestingDepth ;
+
+    if (safe) {
+        if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
+            goto error;
+        }
+    } else {
+        if (Tcl_Init(slaveInterp) == TCL_ERROR) {
+            goto error;
+        }
+    }
+
+    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);
+
+    ckfree((char *) argv);
+    return (Tcl_Interp *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateInterpObject -
+ *
+ *	Helper function to do the actual work of creating a new interpreter
+ *	and an object command. 
+ *
+ * Results:
+ *	A Tcl result.
+ *
+ * Side effects:
+ *	See user documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateInterpObject(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Invoking interpreter. */
+    Master *masterPtr;			/* Master record for same. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* with alias. */
+{
+    int safe;				/* Create a safe interpreter? */
+    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. */
+    int len;				/* Length of option argument. */
+    static int interpCounter = 0;	/* Unique id for created names. */
+
+    moreFlags = 1;
+    slavePath = NULL;
+    safe = Tcl_IsSafe(interp);
+    
+    if ((objc < 2) || (objc > 5)) {
+        Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
+        return TCL_ERROR;
+    }
+    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(string, "--", (size_t) len) == 0) &&
+                       (len > 1)) {
+                moreFlags = 0;
+            } else {
+                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                        "bad option \"", string, "\": should be -safe",
+                        (char *) NULL);
+                return TCL_ERROR;
+            }
+        } else {
+            slavePath = string;
+        }
+    }
+    if (slavePath == (char *) NULL) {
+
+        /*
+         * Create an anonymous interpreter -- we choose its name and
+         * the name of the command. We check that the command name that
+         * we use for the interpreter does not collide with an existing
+         * command in the master interpreter.
+         */
+        
+        while (1) {
+            Tcl_CmdInfo cmdInfo;
+            
+            sprintf(localSlaveName, "interp%d", interpCounter);
+            interpCounter++;
+            if (!(Tcl_GetCommandInfo(interp, localSlaveName, &cmdInfo))) {
+                break;
+            }
+        }
+        slavePath = localSlaveName;
+    }
+    if (CreateSlave(interp, masterPtr, slavePath, safe) != NULL) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(slavePath, -1));
+        return TCL_OK;
+    } else {
+        /*
+         * CreateSlave already set the result if there was an error,
+         * so we do not do it here.
+         */
+        return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteOneInterpObject --
+ *
+ *	Helper function for DeleteInterpObject. It deals with deleting one
+ *	interpreter at a time.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Deletes an interpreter and its interpreter object command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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. */
+{
+    Slave *slavePtr;			/* Interim storage for slave record. */
+    Tcl_Interp *masterInterp;		/* Master of interp. to delete. */
+    Tcl_HashEntry *hPtr;		/* Search element. */
+    int localArgc;			/* Local copy of count of elements in
+                                         * path (name) of interp. to delete. */
+    char **localArgv;			/* Local copy of path. */
+    char *slaveName;			/* Last component in path. */
+    char *masterPath;			/* One-before-last component in path.*/
+
+    if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "bad interpreter path \"", path, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (localArgc < 2) {
+        masterInterp = interp;
+        if (localArgc == 0) {
+            slaveName = "";
+        } else {
+            slaveName = localArgv[0];
+        }
+    } else {
+        masterPath = Tcl_Merge(localArgc-1, localArgv);
+        masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
+        if (masterInterp == (Tcl_Interp *) NULL) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "interpreter named \"", masterPath, "\" not found",
+                    (char *) NULL);
+            ckfree((char *) localArgv);
+            ckfree((char *) masterPath);
+            return TCL_ERROR;
+        }
+        ckfree((char *) masterPath);
+        slaveName = localArgv[localArgc-1];
+    }
+    hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        ckfree((char *) localArgv);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", path, "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+    if (Tcl_DeleteCommandFromToken(masterInterp, slavePtr->interpCmd) != 0) {
+        ckfree((char *) localArgv);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", path, "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    ckfree((char *) localArgv);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteInterpObject --
+ *
+ *	Helper function to do the work of deleting zero or more
+ *	interpreters and their interpreter object commands.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Deletes interpreters and their interpreter object command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteInterpObject(interp, masterPtr, objc, objv)
+    Tcl_Interp *interp;			/* Interpreter start search from. */
+    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 < objc; i++) {
+        if (DeleteOneInterpObject(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[i], &len))
+                != TCL_OK) {
+            return TCL_ERROR;
+        }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AliasCreationHelper --
+ *
+ *	Helper function to do the work to actually create an alias or
+ *	delete an alias.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	An alias command is created and entered into the alias table
+ *	for the slave interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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
+                                         * deleted. */
+    Tcl_Interp *masterInterp;		/* Interp where target cmd will be. */
+    Master *masterPtr;			/* Master record for target interp. */
+    char *aliasName;			/* Name of alias cmd. */
+    char *targetName;			/* Name of target cmd. */
+    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. */
+    Tcl_HashEntry *hPtr;		/* Entry into interp hashtable. */
+    int i;				/* Loop index. */
+    int new;				/* Is it a new hash entry? */
+    Target *targetPtr;			/* Maps from target command in master
+                                         * to source command in slave. */
+    Slave *slavePtr;			/* Maps from source command in slave
+                                         * to target command in master. */
+
+    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
+
+    /*
+     * Slave record should be always present because it is created when
+     * the interpreter is created.
+     */
+    
+    if (slavePtr == (Slave *) NULL) {
+        panic("AliasCreationHelper: could not find slave record");
+    }
+
+    if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
+        if (objc != 0) {
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(curInterp),
+                    "malformed command: should be",
+                    " \"alias ",  aliasName, " {}\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+
+        return DeleteAlias(curInterp, slaveInterp, aliasName);
+    }
+    
+    aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
+    aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
+    aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
+    strcpy(aliasPtr->aliasName, aliasName);
+    strcpy(aliasPtr->targetName, targetName);
+    aliasPtr->targetInterp = masterInterp;
+
+    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]);
+        }
+    }
+
+    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->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;
+    }
+    
+    /*
+     * Make an entry in the alias table. If it already exists delete
+     * the alias command. Then retry.
+     */
+
+    do {
+        hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
+        if (!new) {
+            tmpAliasPtr = (Alias *) Tcl_GetHashValue(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;
+    targetPtr->slaveInterp = slaveInterp;
+
+    do {
+        hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
+                (char *) aliasCounter, &new);
+	aliasCounter++;
+    } while (new == 0);
+
+    Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
+
+    aliasPtr->targetEntry = hPtr;
+
+    /*
+     * 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, 2, objv, "?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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpAliasHelper -
+ *
+ *	Handles the different forms of the "interp alias" command:
+ *	- interp alias slavePath aliasName
+ *		Describes an alias.
+ *	- interp alias slavePath aliasName {}
+ *		Deletes an alias.
+ *	- interp alias slavePath srcCmd masterPath targetCmd args...
+ *		Creates an alias.
+ *
+ * Results:
+ *	A Tcl result.
+ *
+ * Side effects:
+ *	See user documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpAliasHelper(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,		/* Interpreters used when */
+        *masterInterp;			/* creating an alias btn siblings. */
+    Master *masterMasterPtr;		/* Master record for master interp. */
+    int len;
+
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 2, objv,
+                "slavePath slaveCmd masterPath masterCmd ?args ..?");
+        return TCL_ERROR;
+    }
+    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;
+    }
+    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, 2, objv,
+                "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, 2, objv, "?path?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        if (GetInterp(interp, masterPtr,
+                Tcl_GetStringFromObj(objv[2], &len), NULL) ==
+                (Tcl_Interp *) NULL) {
+            objPtr = Tcl_NewIntObj(0);
+        } else {
+            objPtr = Tcl_NewIntObj(1);
+        }
+    } else {
+        objPtr = Tcl_NewIntObj(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, 2, objv, "path arg ?arg ...?");
+        return TCL_ERROR;
+    }
+    slaveInterp = GetInterp(interp, masterPtr,
+            Tcl_GetStringFromObj(objv[2], &len), NULL);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter named \"", Tcl_GetStringFromObj(objv[2], &len),
+                "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    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);
+
+    }
+    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, 2, objv,
+                "path 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;
+    }
+    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, 2, objv,
+                "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, 2, objv, "?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, 2, objv,
+                "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, 2, objv,
+                    "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, 2, objv, "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, 2, objv, "?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;
+        }
+	objPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
+    } else {
+	objPtr = Tcl_NewIntObj(Tcl_IsSafe(interp));
+    }
+    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, 2, objv, "?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, 2, objv, "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, 2, objv, "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, 2, objv,
+                "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) {
+
+            /*
+             * 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 TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DescribeAlias --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DescribeAlias(interp, slaveInterp, aliasName)
+    Tcl_Interp *interp;			/* Interpreter for result & errors. */
+    Tcl_Interp *slaveInterp;		/* Interpreter defining alias. */
+    char *aliasName;			/* Name of alias to describe. */
+{
+    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);
+
+    /*
+     * The slave record should always be present because it is created
+     * by Tcl_CreateInterp.
+     */
+    
+    if (slavePtr == (Slave *) NULL) {
+        panic("DescribeAlias: could not find slave record");
+    }
+    hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return TCL_OK;
+    }
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteAlias --
+ *
+ *	Deletes the given alias from the slave interpreter given.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Deletes the alias from the slave interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteAlias(interp, slaveInterp, aliasName)
+    Tcl_Interp *interp;		/* Interpreter for result and errors. */
+    Tcl_Interp *slaveInterp;	/* Interpreter defining alias. */
+    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. */
+    char *tmpPtr, *namePtr;	/* Local pointers to name of command to
+                                 * be deleted. */
+
+    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
+            NULL);
+    if (slavePtr == (Slave *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    /*
+     * 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_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
+        return TCL_ERROR;
+    }
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * 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
+     * alias from the hash table. The deleteProc will also
+     * delete the target information from the master interpreter
+     * target table.
+     */
+
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetInterpPath --
+ *
+ *	Sets the result of the asking interpreter to a proper Tcl list
+ *	containing the names of interpreters between the asking and
+ *	target interpreters. The target interpreter must be either the
+ *	same as the asking interpreter or one of its slaves (including
+ *	recursively).
+ *
+ * Results:
+ *	TCL_OK if the target interpreter is the same as, or a descendant
+ *	of, the asking interpreter; TCL_ERROR else. This way one can
+ *	distinguish between the case where the asking and target interps
+ *	are the same (an empty list is the result, and TCL_OK is returned)
+ *	and when the target is not a descendant of the asking interpreter
+ *	(in which case the Tcl result is an error message and the function
+ *	returns TCL_ERROR).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetInterpPath(askingInterp, targetInterp)
+    Tcl_Interp *askingInterp;	/* Interpreter to start search from. */
+    Tcl_Interp *targetInterp;	/* Interpreter to find. */
+{
+    Master *masterPtr;		/* Interim storage for Master record. */
+    Slave *slavePtr;		/* Interim storage for Slave record. */
+    
+    if (targetInterp == askingInterp) {
+        return TCL_OK;
+    }
+    if (targetInterp == (Tcl_Interp *) NULL) {
+        return TCL_ERROR;
+    }
+    slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
+            NULL);
+    if (slavePtr == (Slave *) NULL) {
+        return TCL_ERROR;
+    }
+    if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
+
+        /*
+         * The result of askingInterp was set by recursive call.
+         */
+
+        return TCL_ERROR;
+    }
+    masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
+            "tclMasterRecord", NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("Tcl_GetInterpPath: could not find master record");
+    }
+    Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&(masterPtr->slaveTable),
+            slavePtr->slaveEntry));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTarget --
+ *
+ *	Sets the result of the invoking interpreter to a path name for
+ *	the target interpreter of an alias in one of the slaves.
+ *
+ * Results:
+ *	TCL_OK if the target interpreter of the alias is a slave of the
+ *	invoking interpreter, TCL_ERROR else.
+ *
+ * Side effects:
+ *	Sets the result of the invoking interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetTarget(askingInterp, path, aliasName)
+    Tcl_Interp *askingInterp;	/* Interpreter to start search from. */
+    char *path;			/* The path of the interp to find. */
+    char *aliasName;		/* The target of this allias. */
+{
+    Tcl_Interp *slaveInterp;	/* Interim storage for slave. */
+    Slave *slaveSlavePtr;	/* Its Slave record. */
+    Master *masterPtr;		/* Interim storage for Master record. */
+    Tcl_HashEntry *hPtr;	/* Search element. */
+    Alias *aliasPtr;		/* Data describing the alias. */
+
+    Tcl_ResetResult(askingInterp);
+    masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
+            NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("GetTarget: could not find master record");
+    }
+    slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
+    if (slaveInterp == (Tcl_Interp *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
+                "could not find interpreter \"", path, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
+            NULL);
+    if (slaveSlavePtr == (Slave *) NULL) {
+        panic("GetTarget: could not find slave record");
+    }
+    hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
+    if (hPtr == (Tcl_HashEntry *) 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_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
+                "target interpreter for alias \"",
+                aliasName, "\" in path \"", path, "\" is not my descendant",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InterpCmd --
+ *
+ *	This procedure is invoked to process the "interp" 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_InterpObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;		/* Unused. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Master *masterPtr;			/* Master record for current interp. */
+    int result;				/* Local result variable. */
+
+    /*
+     * 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;
+    }
+
+    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("Tcl_InterpCmd: could not find master record");
+    }
+
+    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
+            0, (int *) &index);
+    if (result != TCL_OK) {
+        return result;
+    }
+    
+    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);
+    }
+
+    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, 2, objv,
+                    "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 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.
+     */
+
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, 2, objv, "arg ?arg ...?");
+        return TCL_ERROR;
+    }
+
+    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) {
+
+            /*
+             * An error occurred, so transfer error information from the
+             * destination 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);
+    }
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, 2, objv, "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, 2, objv, "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 (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, 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));
+        }
+    }
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    Tcl_Obj *resultPtr;			/* Local object pointer. */
+
+    if (objc > 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
+    }
+    resultPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
+
+    Tcl_SetObjResult(interp, resultPtr);
+    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, 2, objv,
+                "?-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, 2, objv,
+                    "path ?-global? cmd ?arg ..?");
+            return TCL_ERROR;
+        }
+    }
+    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, "");
+            }
+            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 the slave to the master.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
+        Tcl_ResetResult(slaveInterp);
+    }
+    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, 2, objv, NULL);
+        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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveObjectCmd --
+ *
+ *	Command to manipulate an interpreter, e.g. to send commands to it
+ *	to be evaluated. One such command exists for each slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See user documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveObjectCmd(clientData, interp, objc, objv)
+    ClientData clientData;		/* Slave interpreter. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* The argument vector. */
+{
+    Slave *slavePtr;			/* Slave record. */
+    Tcl_Interp *slaveInterp;		/* Slave interpreter. */
+    int result;				/* Loop counter, status return. */
+    int len;				/* Length of command name. */
+
+    /*
+     * These are all the different subcommands for this command:
+     */
+    
+    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_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "interpreter ", Tcl_GetStringFromObj(objv[0], &len),
+                " has been deleted", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
+            "tclSlaveRecord", NULL);
+    if (slavePtr == (Slave *) NULL) {
+        panic("SlaveObjectCmd: could not find slave record");
+    }
+
+    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
+            0, (int *) &index);
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    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);
+    }
+
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveObjectDeleteProc --
+ *
+ *	Invoked when an object command for a slave interpreter is deleted;
+ *	cleans up all state associated with the slave interpreter and destroys
+ *	the slave interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Cleans up all state associated with the slave interpreter and
+ *	destroys the slave interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SlaveObjectDeleteProc(clientData)
+    ClientData clientData;		/* The SlaveRecord for the command. */
+{
+    Slave *slavePtr;			/* Interim storage for Slave record. */
+    Tcl_Interp *slaveInterp;		/* And for a slave interp. */
+
+    slaveInterp = (Tcl_Interp *) clientData;
+    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",NULL); 
+    if (slavePtr == (Slave *) NULL) {
+        panic("SlaveObjectDeleteProc: could not find slave record");
+    }
+
+    /*
+     * Delete the entry in the slave table in the master interpreter now.
+     * This is to avoid an infinite loop in the Master hash table cleanup in
+     * the master interpreter. This can happen if this slave is being deleted
+     * because the master is being deleted and the slave deletion is deferred
+     * because it is still active.
+     */
+
+    Tcl_DeleteHashEntry(slavePtr->slaveEntry);
+
+    /*
+     * Set to NULL so that when the slave record is cleaned up in the slave
+     * it does not try to delete the command causing all sorts of grief.
+     * See SlaveRecordDeleteProc().
+     */
+
+    slavePtr->interpCmd = NULL;
+
+    /*
+     * Destroy the interpreter - this will cause all the deleteProcs for
+     * all commands (including aliases) to run.
+     *
+     * NOTE: WE ASSUME THAT THE INTERPRETER HAS NOT BEEN DELETED YET!!
+     */
+
+    Tcl_DeleteInterp(slavePtr->slaveInterp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AliasCmd --
+ *
+ *	This is the procedure that services invocations of aliases in a
+ *	slave interpreter. One such command exists for each alias. When
+ *	invoked, this procedure redirects the invocation to the target
+ *	command in the master interpreter as designated by the Alias
+ *	record associated with this command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Causes forwarding of the invocation; all possible side effects
+ *	may occur as a result of invoking the command to which the
+ *	invocation is forwarded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AliasCmd(clientData, interp, objc, objv)
+    ClientData clientData;		/* Alias record. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    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_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, 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;
+
+    /*
+     * 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;
+    }
+
+    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 < 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;
+    }
+
+    /*
+     * 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->numLevels++;
+    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(targetInterp);
+	    if (result == TCL_BREAK) {
+                Tcl_SetObjResult(targetInterp,
+                        Tcl_NewStringObj("invoked \"break\" outside of a loop",
+                                -1));
+	    } else if (result == TCL_CONTINUE) {
+                Tcl_SetObjResult(targetInterp,
+                        Tcl_NewStringObj(
+                            "invoked \"continue\" outside of a loop",
+                            -1));
+	    } else {
+                char buf[128];
+
+                sprintf(buf, "command returned bad code: %d", result);
+                Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
+	    }
+	    result = TCL_ERROR;
+	}
+    }
+
+    /*
+     * Clean up any locally allocated argument vector structure.
+     */
+    
+    if (localObjv != objv) {
+        ckfree((char *) localObjv);
+    }
+    
+    /*
+     * Move the result from the target interpreter to the invoking
+     * interpreter if they are different.
+     *
+     * Note: We cannot use aliasPtr any more because the alias may have
+     * been deleted.
+     */
+
+    if (interp != targetInterp) {
+        if (result == TCL_ERROR) {
+
+            /*
+             * 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);
+            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);
+        }
+
+	/*
+         * Move the result object from one interpreter to the
+         * other.
+         */
+                
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
+        Tcl_ResetResult(targetInterp);
+    }
+    Tcl_Release((ClientData) targetInterp);
+    return result;        
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AliasCmdDeleteProc --
+ *
+ *	Is invoked when an alias command is deleted in a slave. Cleans up
+ *	all storage associated with this alias.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the alias record and its entry in the alias table for
+ *	the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AliasCmdDeleteProc(clientData)
+    ClientData clientData;		/* The alias record for this alias. */
+{
+    Alias *aliasPtr;			/* Alias record for alias to delete. */
+    Target *targetPtr;			/* Record for target of this alias. */
+    int i;				/* Loop counter. */
+
+    aliasPtr = (Alias *) clientData;
+    
+    targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntry);
+    ckfree((char *) targetPtr);
+    Tcl_DeleteHashEntry(aliasPtr->targetEntry);
+
+    ckfree((char *) aliasPtr->targetName);
+    ckfree((char *) aliasPtr->aliasName);
+    for (i = 0; i < aliasPtr->objc; i++) {
+        Tcl_DecrRefCount(aliasPtr->objv[i]);
+    }
+    if (aliasPtr->objv != (Tcl_Obj **) NULL) {
+        ckfree((char *) aliasPtr->objv);
+    }
+
+    Tcl_DeleteHashEntry(aliasPtr->aliasEntry);
+
+    ckfree((char *) aliasPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MasterRecordDeleteProc -
+ *
+ *	Is invoked when an interpreter (which is using the "interp" facility)
+ *	is deleted, and it cleans up the storage associated with the
+ *	"tclMasterRecord" assoc-data entry.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Cleans up storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MasterRecordDeleteProc(clientData, interp)
+    ClientData	clientData;		/* Master record for deleted interp. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
+{
+    Target *targetPtr;			/* Loop variable. */
+    Tcl_HashEntry *hPtr;		/* Search element. */
+    Tcl_HashSearch hSearch;		/* Search record (internal). */
+    Slave *slavePtr;			/* Loop variable. */
+    Master *masterPtr;			/* Interim storage. */
+
+    masterPtr = (Master *) clientData;
+    for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
+         hPtr != NULL;
+         hPtr = Tcl_NextHashEntry(&hSearch)) {
+        slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+        (void) Tcl_DeleteCommandFromToken(interp, slavePtr->interpCmd);
+    }
+    Tcl_DeleteHashTable(&(masterPtr->slaveTable));
+
+    for (hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch);
+         hPtr != NULL;
+         hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
+        targetPtr = (Target *) Tcl_GetHashValue(hPtr);
+        (void) Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
+	        targetPtr->slaveCmd);
+    }
+    Tcl_DeleteHashTable(&(masterPtr->targetTable));
+
+    ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveRecordDeleteProc --
+ *
+ *	Is invoked when an interpreter (which is using the interp facility)
+ *	is deleted, and it cleans up the storage associated with the
+ *	tclSlaveRecord assoc-data entry.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Cleans up storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SlaveRecordDeleteProc(clientData, interp)
+    ClientData	clientData;		/* Slave record for deleted interp. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
+{
+    Slave *slavePtr;			/* Interim storage. */
+    Alias *aliasPtr;
+    Tcl_HashTable *hTblPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+    
+    slavePtr = (Slave *) clientData;
+
+    /*
+     * In every case that we call SetAssocData on "tclSlaveRecord",
+     * slavePtr is not NULL. Otherwise we panic.
+     */
+
+    if (slavePtr == NULL) {
+	panic("SlaveRecordDeleteProc: NULL slavePtr");
+    }
+
+    if (slavePtr->interpCmd != (Tcl_Command) NULL) {
+	Command *cmdPtr = (Command *) slavePtr->interpCmd;
+
+	/*
+	 * The interpCmd has not been deleted in the master yet,  since
+	 * it's callback sets interpCmd to NULL.
+	 *
+	 * Probably Tcl_DeleteInterp() was called on this interpreter directly,
+	 * rather than via "interp delete", or equivalent (deletion of the
+	 * command in the master).
+	 *
+	 * Perform the cleanup done by SlaveObjectDeleteProc() directly,
+	 * and turn off the callback now (since we are about to free slavePtr
+	 * and this interpreter is going away, while the deletion of commands
+	 * in the master may be deferred).
+	 */
+
+	Tcl_DeleteHashEntry(slavePtr->slaveEntry);
+	cmdPtr->clientData = NULL;
+	cmdPtr->deleteProc = NULL;
+	cmdPtr->deleteData = NULL;
+
+        Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
+	        slavePtr->interpCmd);
+    }
+
+    /*
+     * If there are any aliases, delete those now. This removes any
+     * dependency on the order of deletion between commands and the
+     * slave record.
+     */
+
+    hTblPtr = (Tcl_HashTable *) &(slavePtr->aliasTable);
+    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+             hPtr != (Tcl_HashEntry *) NULL;
+             hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
+        aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+
+        /*
+         * The call to Tcl_DeleteCommand will release the storage
+         * occupied by the hash entry and the alias record.
+         */
+
+        Tcl_DeleteCommandFromToken(interp, aliasPtr->slaveCmd);
+    }
+        
+    /*
+     * Finally dispose of the hash table and the slave record.
+     */
+
+    Tcl_DeleteHashTable(hTblPtr);
+    ckfree((char *) slavePtr);    
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInterpInit --
+ *
+ *	Initializes the invoking interpreter for using the "interp"
+ *	facility. This is called from inside Tcl_Init.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adds the "interp" command to an interpreter and initializes several
+ *	records in the associated data of the invoking interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInterpInit(interp)
+    Tcl_Interp *interp;			/* Interpreter to initialize. */
+{
+    Master *masterPtr;			/* Its Master record. */
+    Slave *slavePtr;			/* And its slave record. */
+
+    masterPtr = (Master *) ckalloc((unsigned) sizeof(Master));
+
+    Tcl_InitHashTable(&(masterPtr->slaveTable), TCL_STRING_KEYS);
+    Tcl_InitHashTable(&(masterPtr->targetTable), TCL_ONE_WORD_KEYS);
+
+    (void) Tcl_SetAssocData(interp, "tclMasterRecord", MasterRecordDeleteProc,
+            (ClientData) masterPtr);
+
+    slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
+
+    slavePtr->masterInterp = (Tcl_Interp *) NULL;
+    slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
+    slavePtr->slaveInterp = interp;
+    slavePtr->interpCmd = (Tcl_Command) NULL;
+    Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
+
+    (void) Tcl_SetAssocData(interp, "tclSlaveRecord", SlaveRecordDeleteProc,
+            (ClientData) slavePtr);
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsSafe --
+ *
+ *	Determines whether an interpreter is safe
+ *
+ * Results:
+ *	1 if it is safe, 0 if it is not.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsSafe(interp)
+    Tcl_Interp *interp;		/* Is this interpreter "safe" ? */
+{
+    Interp *iPtr;
+
+    if (interp == (Tcl_Interp *) NULL) {
+        return 0;
+    }
+    iPtr = (Interp *) interp;
+
+    return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateSlave --
+ *
+ *	Creates a slave interpreter. The slavePath argument denotes the
+ *	name of the new slave relative to the current interpreter; the
+ *	slave is a direct descendant of the one-before-last component of
+ *	the path, e.g. it is a descendant of the current interpreter if
+ *	the slavePath argument contains only one component. Optionally makes
+ *	the slave interpreter safe.
+ *
+ * Results:
+ *	Returns the interpreter structure created, or NULL if an error
+ *	occurred.
+ *
+ * Side effects:
+ *	Creates a new interpreter and a new interpreter object command in
+ *	the interpreter indicated by the slavePath argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tcl_CreateSlave(interp, slavePath, isSafe)
+    Tcl_Interp *interp;		/* Interpreter to start search at. */
+    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;
+    }
+    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
+            NULL); 
+    if (masterPtr == (Master *) NULL) {
+        panic("CreatSlave: could not find master record");
+    }
+    return CreateSlave(interp, masterPtr, slavePath, isSafe);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetSlave --
+ *
+ *	Finds a slave interpreter by its path name.
+ *
+ * Results:
+ *	Returns a Tcl_Interp * for the named interpreter or NULL if not
+ *	found.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tcl_GetSlave(interp, slavePath)
+    Tcl_Interp *interp;		/* Interpreter to start search from. */
+    char *slavePath;		/* Path of slave to find. */
+{
+    Master *masterPtr;		/* Interim storage for Master record. */
+
+    if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
+        return NULL;
+    }
+    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
+    if (masterPtr == (Master *) NULL) {
+        panic("Tcl_GetSlave: could not find master record");
+    }
+    return GetInterp(interp, masterPtr, slavePath, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetMaster --
+ *
+ *	Finds the master interpreter of a slave interpreter.
+ *
+ * Results:
+ *	Returns a Tcl_Interp * for the master interpreter or NULL if none.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tcl_GetMaster(interp)
+    Tcl_Interp *interp;		/* Get the master of this interpreter. */
+{
+    Slave *slavePtr;		/* Slave record of this interpreter. */
+
+    if (interp == (Tcl_Interp *) NULL) {
+        return NULL;
+    }
+    slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
+    if (slavePtr == (Slave *) NULL) {
+        return NULL;
+    }
+    return slavePtr->masterInterp;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateAlias --
+ *
+ *	Creates an alias between two interpreters.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates a new alias, manipulates the result field of slaveInterp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
+    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 argc;				/* How many additional arguments? */
+    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) ||
+            (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");
+    }
+    return AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
+            masterPtr, slaveCmd, targetCmd, objc, objv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAlias --
+ *
+ *	Gets information about an alias.
+ *
+ * Results:
+ *	A standard Tcl result. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
+        argvPtr)
+    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 *argcPtr;			/* (Return) count of addnl args. */
+    char ***argvPtr;			/* (Return) additional arguments. */
+{
+    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;
+    }
+    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_AppendResult(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 (argcPtr != (int *) NULL) {
+        *argcPtr = aliasPtr->objc;
+    }
+    if (argvPtr != (char ***) NULL) {
+        *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/tcl/generic/tclLink.c b/tcl/generic/tclLink.c
new file mode 100644
index 00000000000..7addcd2e305
--- /dev/null
+++ b/tcl/generic/tclLink.c
@@ -0,0 +1,423 @@
+/* 
+ * tclLink.c --
+ *
+ *	This file implements linked variables (a C variable that is
+ *	tied to a Tcl variable).  The idea of linked variables was
+ *	first suggested by Andreas Stolcke and this implementation is
+ *	based heavily on a prototype implementation provided by
+ *	him.
+ *
+ * Copyright (c) 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * For each linked variable there is a data structure of the following
+ * type, which describes the link and is the clientData for the trace
+ * set on the Tcl variable.
+ */
+
+typedef struct Link {
+    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
+    char *varName;		/* Name of variable (must be global).  This
+				 * is needed during trace callbacks, since
+				 * the actual variable may be aliased at
+				 * that time via upvar. */
+    char *addr;			/* Location of C variable. */
+    int type;			/* Type of link (TCL_LINK_INT, etc.). */
+    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:
+ */
+
+static char *		LinkTraceProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *name1, char *name2,
+			    int flags));
+static char *		StringValue _ANSI_ARGS_((Link *linkPtr,
+			    char *buffer));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LinkVar --
+ *
+ *	Link a C variable to a Tcl variable so that changes to either
+ *	one causes the other to change.
+ *
+ * Results:
+ *	The return value is TCL_OK if everything went well or TCL_ERROR
+ *	if an error occurred (interp->result is also set after errors).
+ *
+ * Side effects:
+ *	The value at *addr is linked to the Tcl variable "varName",
+ *	using "type" to convert between string values for Tcl and
+ *	binary values for *addr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LinkVar(interp, varName, addr, type)
+    Tcl_Interp *interp;		/* Interpreter in which varName exists. */
+    char *varName;		/* Name of a global variable in interp. */
+    char *addr;			/* Address of a C variable to be linked
+				 * to varName. */
+    int type;			/* Type of C variable: TCL_LINK_INT, etc. 
+				 * Also may have TCL_LINK_READ_ONLY
+				 * OR'ed in. */
+{
+    Link *linkPtr;
+    char buffer[TCL_DOUBLE_SPACE];
+    int code;
+
+    linkPtr = (Link *) ckalloc(sizeof(Link));
+    linkPtr->interp = interp;
+    linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
+    strcpy(linkPtr->varName, varName);
+    linkPtr->addr = addr;
+    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+    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);
+	ckfree((char *) linkPtr);
+	return TCL_ERROR;
+    }
+    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
+	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
+	    (ClientData) linkPtr);
+    if (code != TCL_OK) {
+	ckfree(linkPtr->varName);
+	ckfree((char *) linkPtr);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnlinkVar --
+ *
+ *	Destroy the link between a Tcl variable and a C variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If "varName" was previously linked to a C variable, the link
+ *	is broken to make the variable independent.  If there was no
+ *	previous link for "varName" then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UnlinkVar(interp, varName)
+    Tcl_Interp *interp;		/* Interpreter containing variable to unlink. */
+    char *varName;		/* Global variable in interp to unlink. */
+{
+    Link *linkPtr;
+
+    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+	    LinkTraceProc, (ClientData) NULL);
+    if (linkPtr == NULL) {
+	return;
+    }
+    Tcl_UntraceVar(interp, varName,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    LinkTraceProc, (ClientData) linkPtr);
+    ckfree(linkPtr->varName);
+    ckfree((char *) linkPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpdateLinkedVar --
+ *
+ *	This procedure is invoked after a linked variable has been
+ *	changed by C code.  It updates the Tcl variable so that
+ *	traces on the variable will trigger.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The Tcl variable "varName" is updated from its C value,
+ *	causing traces on the variable to trigger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UpdateLinkedVar(interp, varName)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    char *varName;		/* Name of global variable that is linked. */
+{
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LinkTraceProc --
+ *
+ *	This procedure is invoked when a linked Tcl variable is read,
+ *	written, or unset from Tcl.  It's responsible for keeping the
+ *	C variable in sync with the Tcl variable.
+ *
+ * Results:
+ *	If all goes well, NULL is returned; otherwise an error message
+ *	is returned.
+ *
+ * Side effects:
+ *	The C variable may be updated to make it consistent with the
+ *	Tcl variable, or the Tcl variable may be overwritten to reject
+ *	a modification.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+LinkTraceProc(clientData, interp, name1, name2, flags)
+    ClientData clientData;	/* Contains information about the link. */
+    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
+    char *name1;		/* First part of variable name. */
+    char *name2;		/* Second part of variable name. */
+    int flags;			/* Miscellaneous additional information. */
+{
+    Link *linkPtr = (Link *) clientData;
+    int changed;
+    char buffer[TCL_DOUBLE_SPACE];
+    char *value, **pp;
+    Tcl_DString savedResult;
+
+    /*
+     * If the variable is being unset, then just re-create it (with a
+     * trace) unless the whole interpreter is going away.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	if (flags & TCL_INTERP_DESTROYED) {
+	    ckfree(linkPtr->varName);
+	    ckfree((char *) linkPtr);
+	} else if (flags & TCL_TRACE_DESTROYED) {
+	    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+		    TCL_GLOBAL_ONLY);
+	    Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
+		    |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+		    LinkTraceProc, (ClientData) linkPtr);
+	}
+	return NULL;
+    }
+
+    /*
+     * 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.
+     */
+
+    if (flags & TCL_TRACE_READS) {
+	switch (linkPtr->type) {
+	    case TCL_LINK_INT:
+	    case TCL_LINK_BOOLEAN:
+		changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+		break;
+	    case TCL_LINK_DOUBLE:
+		changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+		break;
+	    case TCL_LINK_STRING:
+		changed = 1;
+		break;
+	    default:
+		return "internal error: bad linked variable type";
+	}
+	if (changed) {
+	    Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+		    TCL_GLOBAL_ONLY);
+	}
+	return NULL;
+    }
+
+    /*
+     * For writes, first make sure that the variable is writable.  Then
+     * convert the Tcl value to C if possible.  If the variable isn't
+     * writable or can't be converted, then restore the varaible's old
+     * value and return an error.  Another tricky thing: we have to save
+     * and restore the interpreter's result, since the variable access
+     * could occur when the result has been partially set.
+     */
+
+    if (linkPtr->flags & LINK_READ_ONLY) {
+	Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+		TCL_GLOBAL_ONLY);
+	return "linked variable is read-only";
+    }
+    value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
+    if (value == NULL) {
+	/*
+	 * This shouldn't ever happen.
+	 */
+	return "internal error: linked variable couldn't be read";
+    }
+    Tcl_DStringInit(&savedResult);
+    Tcl_DStringAppend(&savedResult, interp->result, -1);
+    Tcl_ResetResult(interp);
+    switch (linkPtr->type) {
+	case TCL_LINK_INT:
+	    if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
+		Tcl_DStringResult(interp, &savedResult);
+		Tcl_SetVar(interp, linkPtr->varName,
+			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
+		return "variable must have integer value";
+	    }
+	    *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	    break;
+	case TCL_LINK_DOUBLE:
+	    if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
+		    != TCL_OK) {
+		Tcl_DStringResult(interp, &savedResult);
+		Tcl_SetVar(interp, linkPtr->varName,
+			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
+		return "variable must have real value";
+	    }
+	    *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+	    break;
+	case TCL_LINK_BOOLEAN:
+	    if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
+		    != TCL_OK) {
+		Tcl_DStringResult(interp, &savedResult);
+		Tcl_SetVar(interp, linkPtr->varName,
+			StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
+		return "variable must have boolean value";
+	    }
+	    *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	    break;
+	case TCL_LINK_STRING:
+	    pp = (char **)(linkPtr->addr);
+	    if (*pp != NULL) {
+		ckfree(*pp);
+	    }
+	    *pp = (char *) ckalloc((unsigned) (strlen(value) + 1));
+	    strcpy(*pp, value);
+	    break;
+	default:
+	    return "internal error: bad linked variable type";
+    }
+    Tcl_DStringResult(interp, &savedResult);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringValue --
+ *
+ *	Converts the value of a C variable to a string for use in a
+ *	Tcl variable to which it is linked.
+ *
+ * Results:
+ *	The return value is a pointer
+ to a string that represents
+ *	the value of the C variable given by linkPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+StringValue(linkPtr, buffer)
+    Link *linkPtr;		/* Structure describing linked variable. */
+    char *buffer;		/* Small buffer to use for converting
+				 * values.  Must have TCL_DOUBLE_SPACE
+				 * bytes or more. */
+{
+    char *p;
+
+    switch (linkPtr->type) {
+	case TCL_LINK_INT:
+	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	    TclFormatInt(buffer, linkPtr->lastValue.i);
+	    return buffer;
+	case TCL_LINK_DOUBLE:
+	    linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+	    Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer);
+	    return buffer;
+	case TCL_LINK_BOOLEAN:
+	    linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	    if (linkPtr->lastValue.i != 0) {
+		return "1";
+	    }
+	    return "0";
+	case TCL_LINK_STRING:
+	    p = *(char **)(linkPtr->addr);
+	    if (p == NULL) {
+		return "NULL";
+	    }
+	    return p;
+    }
+
+    /*
+     * This code only gets executed if the link type is unknown
+     * (shouldn't ever happen).
+     */
+
+    return "??";
+}
diff --git a/tcl/generic/tclListObj.c b/tcl/generic/tclListObj.c
new file mode 100644
index 00000000000..c7d9bca44a4
--- /dev/null
+++ b/tcl/generic/tclListObj.c
@@ -0,0 +1,1056 @@
+/* 
+ * tclListObj.c --
+ *
+ *	This file contains procedures that implement the Tcl list object
+ *	type.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+    } else {
+	objPtr->bytes = tclEmptyStringRep;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, numRequired;
+    
+    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;
+    numRequired = numElems + 1 ;
+    
+    /*
+     * If there is no room in the current array of element pointers,
+     * allocate a new, larger array and copy the pointers to it.
+     */
+
+    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;
+    }
+
+    /*
+     * 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 = Tcl_GetStringFromObj(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) {
+	    memcpy((VOID *) s, (VOID *) 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/tcl/generic/tclLoad.c b/tcl/generic/tclLoad.c
new file mode 100644
index 00000000000..3502889a5f7
--- /dev/null
+++ b/tcl/generic/tclLoad.c
@@ -0,0 +1,636 @@
+/* 
+ * tclLoad.c --
+ *
+ *	This file provides the generic portion (those that are the same
+ *	on all platforms) of Tcl's dynamic loading facilities.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * The following structure describes a package that has been loaded
+ * either dynamically (with the "load" command) or statically (as
+ * indicated by a call to Tcl_PackageLoaded).  All such packages
+ * are linked together into a single list for the process.  Packages
+ * are never unloaded, so these structures are never freed.
+ */
+
+typedef struct LoadedPackage {
+    char *fileName;		/* Name of the file from which the
+				 * package was loaded.  An empty string
+				 * means the package is loaded statically.
+				 * Malloc-ed. */
+    char *packageName;		/* Name of package prefix for the package,
+				 * properly capitalized (first letter UC,
+				 * others LC), no "_", as in "Net". 
+				 * Malloc-ed. */
+    Tcl_PackageInitProc *initProc;
+				/* Initialization procedure to call to
+				 * incorporate this package into a trusted
+				 * interpreter. */
+    Tcl_PackageInitProc *safeInitProc;
+				/* Initialization procedure to call to
+				 * incorporate this package into a safe
+				 * interpreter (one that will execute
+				 * untrusted scripts).   NULL means the
+				 * package can't be used in unsafe
+				 * interpreters. */
+    struct LoadedPackage *nextPtr;
+				/* Next in list of all packages loaded into
+				 * this application process.  NULL means
+				 * end of list. */
+} LoadedPackage;
+
+static LoadedPackage *firstPackagePtr = NULL;
+				/* First in list of all packages loaded into
+				 * this process. */
+
+/*
+ * The following structure represents a particular package that has
+ * been incorporated into a particular interpreter (by calling its
+ * initialization procedure).  There is a list of these structures for
+ * each interpreter, with an AssocData value (key "load") for the
+ * interpreter that points to the first package (if any).
+ */
+
+typedef struct InterpPackage {
+    LoadedPackage *pkgPtr;	/* Points to detailed information about
+				 * package. */
+    struct InterpPackage *nextPtr;
+				/* Next package in this interpreter, or
+				 * NULL for end of list. */
+} InterpPackage;
+
+/*
+ * Prototypes for procedures that are private to this file:
+ */
+
+static void		LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp));
+static void		LoadExitProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LoadCmd --
+ *
+ *	This procedure is invoked to process the "load" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LoadCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Interp *target;
+    LoadedPackage *pkgPtr, *defaultPtr;
+    Tcl_DString pkgName, initName, safeInitName, fileName;
+    Tcl_PackageInitProc *initProc, *safeInitProc;
+    InterpPackage *ipFirstPtr, *ipPtr;
+    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],
+		" fileName ?packageName? ?interp?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    fullFileName = Tcl_TranslateFileName(interp, argv[1], &fileName);
+    if (fullFileName == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_DStringInit(&pkgName);
+    Tcl_DStringInit(&initName);
+    Tcl_DStringInit(&safeInitName);
+    if ((argc >= 3) && (argv[2][0] != 0)) {
+	gotPkgName = 1;
+    } else {
+	gotPkgName = 0;
+    }
+    if ((fullFileName[0] == 0) && !gotPkgName) {
+	Tcl_SetResult(interp,
+		"must specify either file name or package name",
+		TCL_STATIC);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Figure out which interpreter we're going to load the package into.
+     */
+
+    target = interp;
+    if (argc == 4) {
+	target = Tcl_GetSlave(interp, argv[3]);
+	if (target == NULL) {
+	    Tcl_AppendResult(interp, "couldn't find slave interpreter named \"",
+		    argv[3], "\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * 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 (!gotPkgName) {
+	    namesMatch = 0;
+	} else {
+	    namesMatch = 1;
+	    for (p1 = argv[2], p2 = pkgPtr->packageName; ; p1++, p2++) {
+		if ((isupper(UCHAR(*p1)) ? tolower(UCHAR(*p1)) : *p1)
+			!= (isupper(UCHAR(*p2)) ? tolower(UCHAR(*p2)) : *p2)) {
+		    namesMatch = 0;
+		    break;
+		}
+		if (*p1 == 0) {
+		    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;
+    }
+
+    /*
+     * 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.
+     */
+
+    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;
+		goto done;
+	    }
+	}
+    }
+
+    if (pkgPtr == NULL) {
+	/*
+	 * The desired file isn't currently loaded, so load it.  It's an
+	 * error if the desired package is a static one.
+	 */
+
+	if (fullFileName[0] == 0) {
+	    Tcl_AppendResult(interp, "package \"", argv[2],
+		    "\" isn't loaded statically", (char *) NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+
+	/*
+	 * Figure out the module name if it wasn't provided explicitly.
+	 */
+
+	if (gotPkgName) {
+	    Tcl_DStringAppend(&pkgName, argv[2], -1);
+	} else {
+	    if (!TclGuessPackageName(fullFileName, &pkgName)) {
+		int pargc;
+		char **pargv, *pkgGuess;
+
+		/*
+		 * 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 and underline
+		 * characters that follow that.
+		 */
+
+		Tcl_SplitPath(fullFileName, &pargc, &pargv);
+		pkgGuess = pargv[pargc-1];
+		if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
+			&& (pkgGuess[2] == 'b')) {
+		    pkgGuess += 3;
+		}
+		for (p = pkgGuess; isalpha(UCHAR(*p)) || (*p == '_'); p++) {
+		    /* Empty loop body. */
+		}
+		if (p == pkgGuess) {
+		    ckfree((char *)pargv);
+		    Tcl_AppendResult(interp,
+			    "couldn't figure out package name for ",
+			    fullFileName, (char *) NULL);
+		    code = TCL_ERROR;
+		    goto done;
+		}
+		Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
+		ckfree((char *)pargv);
+	    }
+	}
+
+	/*
+	 * Fix the capitalization in the package name so that the first
+	 * character is in caps but the others are all lower-case.
+	 */
+    
+	p = Tcl_DStringValue(&pkgName);
+	c = UCHAR(*p);
+	if (c != 0) {
+	    if (islower(c)) {
+		*p = (char) toupper(c);
+	    }
+	    p++;
+	    while (1) {
+		c = UCHAR(*p);
+		if (c == 0) {
+		    break;
+		}
+		if (isupper(c)) {
+		    *p = (char) tolower(c);
+		}
+		p++;
+	    }
+	}
+
+	/*
+	 * Compute the names of the two initialization procedures,
+	 * based on the package name.
+	 */
+    
+	Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringAppend(&initName, "_Init", 5);
+	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
+    
+	/*
+	 * Call platform-specific code to load the package and find the
+	 * two initialization procedures.
+	 */
+    
+	code = TclLoadFile(interp, fullFileName, Tcl_DStringValue(&initName),
+		Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc);
+	if (code != TCL_OK) {
+	    goto done;
+	}
+	if (initProc  == NULL) {
+	    Tcl_AppendResult(interp, "couldn't find procedure ",
+		    Tcl_DStringValue(&initName), (char *) NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+
+	/*
+	 * Create a new record to describe this package.
+	 */
+
+	if (firstPackagePtr == NULL) {
+	    Tcl_CreateExitHandler(LoadExitProc, (ClientData) NULL);
+	}
+	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
+	pkgPtr->fileName = (char *) ckalloc((unsigned)
+		(strlen(fullFileName) + 1));
+	strcpy(pkgPtr->fileName, fullFileName);
+	pkgPtr->packageName = (char *) ckalloc((unsigned)
+		(Tcl_DStringLength(&pkgName) + 1));
+	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
+	pkgPtr->initProc = initProc;
+	pkgPtr->safeInitProc = safeInitProc;
+	pkgPtr->nextPtr = firstPackagePtr;
+	firstPackagePtr = pkgPtr;
+    }
+
+    /*
+     * Invoke the package's initialization procedure (either the
+     * normal one or the safe one, depending on whether or not the
+     * interpreter is safe).
+     */
+
+    if (Tcl_IsSafe(target)) {
+	if (pkgPtr->safeInitProc != NULL) {
+	    code = (*pkgPtr->safeInitProc)(target);
+	} else {
+	    Tcl_AppendResult(interp,
+		    "can't use package in a safe interpreter: ",
+		    "no ", pkgPtr->packageName, "_SafeInit procedure",
+		    (char *) NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+    } else {
+	code = (*pkgPtr->initProc)(target);
+    }
+    if ((code == TCL_ERROR) && (target != interp)) {
+	/*
+	 * 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 target's $errorInfo;  we've already got
+	 * everything we need in target's $errorInfo.
+	 */
+
+	/*
+         * It is (abusively) assumed that errorInfo and errorCode vars exists.
+         * we changed SetVar2 to accept NULL values to avoid crashes. --dl
+	 */
+	Tcl_ResetResult(interp);
+	Tcl_AddErrorInfo(interp, Tcl_GetVar2(target,
+		"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+	Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+		Tcl_GetVar2(target, "errorCode", (char *) NULL,
+		TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
+	Tcl_SetResult(interp, target->result, TCL_VOLATILE);
+    }
+
+    /*
+     * Record the fact that the package has been loaded in the
+     * target interpreter.
+     */
+
+    if (code == TCL_OK) {
+	/*
+	 * Refetch ipFirstPtr: loading the package may have introduced
+	 * additional static packages at the head of the linked list!
+	 */
+
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
+	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+	ipPtr->pkgPtr = pkgPtr;
+	ipPtr->nextPtr = ipFirstPtr;
+	Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
+		(ClientData) ipPtr);
+    }
+
+    done:
+    Tcl_DStringFree(&pkgName);
+    Tcl_DStringFree(&initName);
+    Tcl_DStringFree(&safeInitName);
+    Tcl_DStringFree(&fileName);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StaticPackage --
+ *
+ *	This procedure is invoked to indicate that a particular
+ *	package has been linked statically with an application.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Once this procedure completes, the package becomes loadable
+ *	via the "load" command with an empty file name.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
+    Tcl_Interp *interp;			/* If not NULL, it means that the
+					 * package has already been loaded
+					 * into the given interpreter by
+					 * calling the appropriate init proc. */
+    char *pkgName;			/* Name of package (must be properly
+					 * capitalized: first letter upper
+					 * case, others lower case). */
+    Tcl_PackageInitProc *initProc;	/* Procedure to call to incorporate
+					 * this package into a trusted
+					 * interpreter. */
+    Tcl_PackageInitProc *safeInitProc;	/* Procedure to call to incorporate
+					 * this package into a safe interpreter
+					 * (one that will execute untrusted
+					 * scripts).   NULL means the package
+					 * can't be used in safe
+					 * interpreters. */
+{
+    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);
+    }
+    pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
+    pkgPtr->fileName = (char *) ckalloc((unsigned) 1);
+    pkgPtr->fileName[0] = 0;
+    pkgPtr->packageName = (char *) ckalloc((unsigned)
+	    (strlen(pkgName) + 1));
+    strcpy(pkgPtr->packageName, pkgName);
+    pkgPtr->initProc = initProc;
+    pkgPtr->safeInitProc = safeInitProc;
+    pkgPtr->nextPtr = firstPackagePtr;
+    firstPackagePtr = pkgPtr;
+
+    if (interp != NULL) {
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
+	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+	ipPtr->pkgPtr = pkgPtr;
+	ipPtr->nextPtr = ipFirstPtr;
+	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc,
+		(ClientData) ipPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetLoadedPackages --
+ *
+ *	This procedure returns information about all of the files
+ *	that are loaded (either in a particular intepreter, or
+ *	for all interpreters).
+ *
+ * Results:
+ *	The return value is a standard Tcl completion code.  If
+ *	successful, a list of lists is placed in interp->result.
+ *	Each sublist corresponds to one loaded file;  its first
+ *	element is the name of the file (or an empty string for
+ *	something that's statically loaded) and the second element
+ *	is the name of the package in that file.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetLoadedPackages(interp, targetName)
+    Tcl_Interp *interp;		/* Interpreter in which to return
+				 * information or error message. */
+    char *targetName;		/* Name of target interpreter or NULL.
+				 * If NULL, return info about all interps;
+				 * otherwise, just return info about this
+				 * interpreter. */
+{
+    Tcl_Interp *target;
+    LoadedPackage *pkgPtr;
+    InterpPackage *ipPtr;
+    char *prefix;
+
+    if (targetName == NULL) {
+	/* 
+	 * Return information about all of the available packages.
+	 */
+
+	prefix = "{";
+	for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
+		pkgPtr = pkgPtr->nextPtr) {
+	    Tcl_AppendResult(interp, prefix, (char *) NULL);
+	    Tcl_AppendElement(interp, pkgPtr->fileName);
+	    Tcl_AppendElement(interp, pkgPtr->packageName);
+	    Tcl_AppendResult(interp, "}", (char *) NULL);
+	    prefix = " {";
+	}
+	return TCL_OK;
+    }
+
+    /*
+     * Return information about only the packages that are loaded in
+     * a given interpreter.
+     */
+
+    target = Tcl_GetSlave(interp, targetName);
+    if (target == NULL) {
+	Tcl_AppendResult(interp, "couldn't find slave interpreter named \"",
+		targetName, "\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+	    (Tcl_InterpDeleteProc **) NULL);
+    prefix = "{";
+    for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+	pkgPtr = ipPtr->pkgPtr;
+	Tcl_AppendResult(interp, prefix, (char *) NULL);
+	Tcl_AppendElement(interp, pkgPtr->fileName);
+	Tcl_AppendElement(interp, pkgPtr->packageName);
+	Tcl_AppendResult(interp, "}", (char *) NULL);
+	prefix = " {";
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LoadCleanupProc --
+ *
+ *	This procedure is called to delete all of the InterpPackage
+ *	structures for an interpreter when the interpreter is deleted.
+ *	It gets invoked via the Tcl AssocData mechanism.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Storage for all of the InterpPackage procedures for interp
+ *	get deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LoadCleanupProc(clientData, interp)
+    ClientData clientData;	/* Pointer to first InterpPackage structure
+				 * for interp. */
+    Tcl_Interp *interp;		/* Interpreter that is being deleted. */
+{
+    InterpPackage *ipPtr, *nextPtr;
+
+    ipPtr = (InterpPackage *) clientData;
+    while (ipPtr != NULL) {
+	nextPtr = ipPtr->nextPtr;
+	ckfree((char *) ipPtr);
+	ipPtr = nextPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LoadExitProc --
+ *
+ *	This procedure is invoked just before the application exits.
+ *	It frees all of the LoadedPackage structures.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LoadExitProc(clientData)
+    ClientData clientData;		/* Not used. */
+{
+    LoadedPackage *pkgPtr;
+
+    while (firstPackagePtr != NULL) {
+	pkgPtr = firstPackagePtr;
+	firstPackagePtr = pkgPtr->nextPtr;
+	ckfree(pkgPtr->fileName);
+	ckfree(pkgPtr->packageName);
+	ckfree((char *) pkgPtr);
+    }
+}
diff --git a/tcl/generic/tclLoadNone.c b/tcl/generic/tclLoadNone.c
new file mode 100644
index 00000000000..e9975ee1646
--- /dev/null
+++ b/tcl/generic/tclLoadNone.c
@@ -0,0 +1,82 @@
+/* 
+ * tclLoadNone.c --
+ *
+ *	This procedure provides a version of the TclLoadFile for use
+ *	in systems that don't support dynamic loading; it just returns
+ *	an error.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	This procedure is called to carry out dynamic loading of binary
+ *	code;  it is intended for use only on systems that don't support
+ *	dynamic loading (it returns an error).
+ *
+ * Results:
+ *	The result is TCL_ERROR, and an error message is left in
+ *	interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    Tcl_SetResult(interp,
+	    "dynamic loading is not currently available on this system",
+	    TCL_STATIC);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/generic/tclMain.c b/tcl/generic/tclMain.c
new file mode 100644
index 00000000000..06069debc25
--- /dev/null
+++ b/tcl/generic/tclMain.c
@@ -0,0 +1,343 @@
+/* 
+ * tclMain.c --
+ *
+ *	Main program for Tcl shells and other Tcl-based applications.
+ *
+ * Copyright (c) 1988-1994 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+
+/*
+ * The following code ensures that tclLink.c is linked whenever
+ * Tcl is linked.  Without this code there's no reference to the
+ * code in that file from anywhere in Tcl, so it may not be
+ * linked into the application.
+ */
+
+EXTERN int Tcl_LinkVar();
+int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
+
+/*
+ * Declarations for various library procedures and variables (don't want
+ * to include tclPort.h here, because people might copy this file out of
+ * the Tcl source directory to make their own modified versions).
+ * Note:  "exit" should really be declared here, but there's no way to
+ * declare it without causing conflicts with other definitions elsewher
+ * on some systems, so it's better just to leave it out.
+ */
+
+extern int		isatty _ANSI_ARGS_((int fd));
+extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
+
+static Tcl_Interp *interp;	/* Interpreter for application. */
+
+#ifdef TCL_MEM_DEBUG
+static char dumpFile[100];	/* Records where to dump memory allocation
+				 * information. */
+static int quitFlag = 0;	/* 1 means "checkmem" command was called,
+				 * so the application should quit and dump
+				 * memory allocation information. */
+#endif
+
+/*
+ * Forward references for procedures defined later in this file:
+ */
+
+#ifdef TCL_MEM_DEBUG
+static int		CheckmemCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char *argv[]));
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Main --
+ *
+ *	Main program for tclsh and most other Tcl-based applications.
+ *
+ * Results:
+ *	None. This procedure never returns (it exits the process when
+ *	it's done.
+ *
+ * Side effects:
+ *	This procedure initializes the Tk world and then starts
+ *	interpreting commands;  almost anything could happen, depending
+ *	on the script being interpreted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Main(argc, argv, appInitProc)
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Array of argument strings. */
+    Tcl_AppInitProc *appInitProc;
+				/* Application-specific initialization
+				 * procedure to call after most
+				 * initialization but before starting to
+				 * execute commands. */
+{
+    Tcl_Obj *prompt1NamePtr = NULL;
+    Tcl_Obj *prompt2NamePtr = NULL;
+    Tcl_Obj *resultPtr;
+    Tcl_Obj *commandPtr = NULL;
+    char buffer[1000], *args, *fileName, *bytes;
+    int code, gotPartial, tty, length;
+    int exitCode = 0;
+    Tcl_Channel inChannel, outChannel, errChannel;
+
+    Tcl_FindExecutable(argv[0]);
+    interp = Tcl_CreateInterp();
+#ifdef TCL_MEM_DEBUG
+    Tcl_InitMemory(interp);
+    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+#endif
+
+    /*
+     * Make command-line arguments available in the Tcl variables "argc"
+     * and "argv".  If the first argument doesn't start with a "-" then
+     * strip it off and use it as the name of a script file to process.
+     */
+
+    fileName = NULL;
+    if ((argc > 1) && (argv[1][0] != '-')) {
+	fileName = argv[1];
+	argc--;
+	argv++;
+    }
+    args = Tcl_Merge(argc-1, argv+1);
+    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
+    ckfree(args);
+    TclFormatInt(buffer, argc-1);
+    Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
+	    TCL_GLOBAL_ONLY);
+
+    /*
+     * Set the "tcl_interactive" variable.
+     */
+
+    tty = isatty(0);
+    Tcl_SetVar(interp, "tcl_interactive",
+	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+    
+    /*
+     * Invoke application-specific initialization.
+     */
+
+    if ((*appInitProc)(interp) != TCL_OK) {
+	errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	if (errChannel) {
+	    Tcl_Write(errChannel,
+		    "application-specific initialization failed: ", -1);
+	    Tcl_Write(errChannel, interp->result, -1);
+	    Tcl_Write(errChannel, "\n", 1);
+	}
+    }
+
+    /*
+     * If a script file was specified then just source that file
+     * and quit.
+     */
+
+    if (fileName != NULL) {
+	code = Tcl_EvalFile(interp, fileName);
+	if (code != TCL_OK) {
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	    if (errChannel) {
+		/*
+		 * The following statement guarantees that the errorInfo
+		 * variable is set properly.
+		 */
+
+		Tcl_AddErrorInfo(interp, "");
+		Tcl_Write(errChannel,
+			Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
+		Tcl_Write(errChannel, "\n", 1);
+	    }
+	    exitCode = 1;
+	}
+	goto done;
+    }
+
+    /*
+     * We're running interactively.  Source a user-specific startup
+     * file if the application specified one and if the file exists.
+     */
+
+    Tcl_SourceRCFile(interp);
+
+    /*
+     * Process commands from stdin until there's an end-of-file.  Note
+     * that we need to fetch the standard channels again after every
+     * eval, since they may have been changed.
+     */
+
+    commandPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(commandPtr);
+    prompt1NamePtr = Tcl_NewStringObj("tcl_prompt1", -1);
+    Tcl_IncrRefCount(prompt1NamePtr);
+    prompt2NamePtr = Tcl_NewStringObj("tcl_prompt2", -1);
+    Tcl_IncrRefCount(prompt2NamePtr);
+    
+    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+    gotPartial = 0;
+    while (1) {
+	if (tty) {
+	    Tcl_Obj *promptCmdPtr;
+
+	    promptCmdPtr = Tcl_ObjGetVar2(interp,
+		    (gotPartial? prompt2NamePtr : prompt1NamePtr),
+		    (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+	    if (promptCmdPtr == NULL) {
+                defaultPrompt:
+		if (!gotPartial && outChannel) {
+		    Tcl_Write(outChannel, "% ", 2);
+		}
+	    } else {
+		code = Tcl_EvalObj(interp, promptCmdPtr);
+		inChannel = Tcl_GetStdChannel(TCL_STDIN);
+		outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+		errChannel = Tcl_GetStdChannel(TCL_STDERR);
+		if (code != TCL_OK) {
+		    if (errChannel) {
+			resultPtr = Tcl_GetObjResult(interp);
+			bytes = Tcl_GetStringFromObj(resultPtr, &length);
+			Tcl_Write(errChannel, bytes, length);
+			Tcl_Write(errChannel, "\n", 1);
+		    }
+		    Tcl_AddErrorInfo(interp,
+			    "\n    (script that generates prompt)");
+		    goto defaultPrompt;
+		}
+	    }
+	    if (outChannel) {
+		Tcl_Flush(outChannel);
+	    }
+	}
+	if (!inChannel) {
+	    goto done;
+	}
+        length = Tcl_GetsObj(inChannel, commandPtr);
+	if (length < 0) {
+	    goto done;
+	}
+	if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
+	    goto done;
+	}
+
+        /*
+         * Add the newline removed by Tcl_GetsObj back to the string.
+         */
+
+	Tcl_AppendToObj(commandPtr, "\n", 1);
+	if (!TclObjCommandComplete(commandPtr)) {
+	    gotPartial = 1;
+	    continue;
+	}
+
+	gotPartial = 0;
+	code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
+	inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	Tcl_SetObjLength(commandPtr, 0);
+	if (code != TCL_OK) {
+	    if (errChannel) {
+		resultPtr = Tcl_GetObjResult(interp);
+		bytes = Tcl_GetStringFromObj(resultPtr, &length);
+		Tcl_Write(errChannel, bytes, length);
+		Tcl_Write(errChannel, "\n", 1);
+	    }
+	} else if (tty) {
+	    resultPtr = Tcl_GetObjResult(interp);
+	    bytes = Tcl_GetStringFromObj(resultPtr, &length);
+	    if ((length > 0) && outChannel) {
+		Tcl_Write(outChannel, bytes, length);
+		Tcl_Write(outChannel, "\n", 1);
+	    }
+	}
+#ifdef TCL_MEM_DEBUG
+	if (quitFlag) {
+	    Tcl_DecrRefCount(commandPtr);
+	    Tcl_DecrRefCount(prompt1NamePtr);
+	    Tcl_DecrRefCount(prompt2NamePtr);
+	    Tcl_DeleteInterp(interp);
+	    Tcl_Exit(0);
+	}
+#endif
+    }
+
+    /*
+     * Rather than calling exit, invoke the "exit" command so that
+     * users can replace "exit" with some other command to do additional
+     * cleanup on exit.  The Tcl_Eval call should never return.
+     */
+
+    done:
+    if (commandPtr != NULL) {
+	Tcl_DecrRefCount(commandPtr);
+    }
+    if (prompt1NamePtr != NULL) {
+	Tcl_DecrRefCount(prompt1NamePtr);
+    }
+    if (prompt2NamePtr != NULL) {
+	Tcl_DecrRefCount(prompt2NamePtr);
+    }
+    sprintf(buffer, "exit %d", exitCode);
+    Tcl_Eval(interp, buffer);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckmemCmd --
+ *
+ *	This is the command procedure for the "checkmem" command, which
+ *	causes the application to exit after printing information about
+ *	memory usage to the file passed to this command as its first
+ *	argument.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef TCL_MEM_DEBUG
+
+	/* ARGSUSED */
+static int
+CheckmemCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Interpreter for evaluation. */
+    int argc;				/* Number of arguments. */
+    char *argv[];			/* String values of arguments. */
+{
+    extern char *tclMemDumpFileName;
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" fileName\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    strcpy(dumpFile, argv[1]);
+    tclMemDumpFileName = dumpFile;
+    quitFlag = 1;
+    return TCL_OK;
+}
+#endif
diff --git a/tcl/generic/tclMath.h b/tcl/generic/tclMath.h
new file mode 100644
index 00000000000..a0de8669d61
--- /dev/null
+++ b/tcl/generic/tclMath.h
@@ -0,0 +1,27 @@
+/*
+ * tclMath.h --
+ *
+ *	This file is necessary because of Metrowerks CodeWarrior Pro 1
+ *	on the Macintosh. With 8-byte doubles turned on, the definitions of
+ *	sin, cos, acos, etc., are screwed up.  They are fine as long as
+ *	they are used as function calls, but if the function pointers
+ *	are passed around and used, they will crash hard on the 68K.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLMATH
+#define _TCLMATH
+
+#if defined(MAC_TCL)
+#   include "tclMacMath.h"
+#else
+#   include <math.h>
+#endif
+
+#endif /* _TCLMATH */
diff --git a/tcl/generic/tclNamesp.c b/tcl/generic/tclNamesp.c
new file mode 100644
index 00000000000..97a60029424
--- /dev/null
+++ b/tcl/generic/tclNamesp.c
@@ -0,0 +1,3889 @@
+/*
+ * 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.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+
+/*
+ * Initial sise of stack allocated space for tail list - used when resetting
+ * shadowed command references in the functin: TclResetShadowedCmdRefs.
+ */
+
+#define NUM_TRAIL_ELEMS 5
+
+/*
+ * Count of the number of namespaces created. This value is used as a
+ * unique id for each namespace.
+ */
+
+static long numNsCreated = 0; 
+
+/*
+ * 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;
+    char *simpleName;
+    Tcl_HashEntry *entryPtr;
+    Tcl_DString buffer1, buffer2;
+    int newEntry, result;
+
+    /*
+     * If there is no active namespace, 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;
+        simpleName = "";
+    } else if (*name == '\0') {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
+	return NULL;
+    } else {
+	/*
+	 * Find the parent for the new namespace.
+	 */
+
+	result = TclGetNamespaceForQualName(interp, name,
+		(Namespace *) NULL,
+		/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+		&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
+        if (result != TCL_OK) {
+            return NULL;
+        }
+
+	/*
+	 * If the unqualified name at the end is empty, there were trailing
+	 * "::"s after the namespace's name which we ignore. The new
+	 * namespace was already (recursively) created and is pointed to
+	 * by parentPtr.
+	 */
+
+	if (*simpleName == '\0') {
+	    return (Tcl_Namespace *) parentPtr;
+	}
+
+        /*
+         * Check for a bad namespace name and make sure that the name
+	 * does not already exist in the parent namespace.
+	 */
+
+        if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != 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(simpleName)+1));
+    strcpy(nsPtr->name, simpleName);
+    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;
+    nsPtr->resolverEpoch     = 0;
+    nsPtr->cmdResProc        = NULL;
+    nsPtr->varResProc        = NULL;
+    nsPtr->compiledVarResProc = NULL;
+
+    if (parentPtr != NULL) {
+        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
+	        &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_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.
+     */
+
+    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 be
+ *	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, *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, &dummyPtr,
+	    &dummyPtr, &simplePattern);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if ((exportNsPtr != nsPtr) || (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 = nsPtr->numExportPatterns + 1;
+    if (nsPtr->exportArrayPtr == NULL) {
+	nsPtr->exportArrayPtr = (char **)
+	        ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
+	nsPtr->numExportPatterns = 0;
+	nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
+    } else if (neededElems > nsPtr->maxExportPatterns) {
+	int numNewElems = 2 * nsPtr->maxExportPatterns;
+	size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);
+	size_t newBytes  = numNewElems * sizeof(char *);
+	char **newPtr = (char **) ckalloc((unsigned) newBytes);
+
+	memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,
+	        currBytes);
+	ckfree((char *) nsPtr->exportArrayPtr);
+	nsPtr->exportArrayPtr = (char **) newPtr;
+	nsPtr->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);
+    
+    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
+    nsPtr->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.
+ *
+ *      If matching commands are on the autoload path but haven't been
+ *	loaded yet, this command forces them to be loaded, then creates
+ *	the links to them.
+ *
+ * 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;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    char *simplePattern, *cmdName;
+    register Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+    ImportRef *refPtr;
+    Tcl_Command autoCmd, 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;
+    }
+ 
+    /*
+     * First, invoke the "auto_import" command with the pattern
+     * being imported.  This command is part of the Tcl library.
+     * It looks for imported commands in autoloaded libraries and
+     * loads them in.  That way, they will be found when we try
+     * to create links below.
+     */
+    
+    autoCmd = Tcl_FindCommand(interp, "auto_import",
+ 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+ 
+    if (autoCmd != NULL) {
+	Tcl_Obj *objv[2];
+ 
+	objv[0] = Tcl_NewStringObj("auto_import", -1);
+	Tcl_IncrRefCount(objv[0]);
+	objv[1] = Tcl_NewStringObj(pattern, -1);
+	Tcl_IncrRefCount(objv[1]);
+ 
+	cmdPtr = (Command *) autoCmd;
+	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+		2, objv);
+ 
+	Tcl_DecrRefCount(objv[0]);
+	Tcl_DecrRefCount(objv[1]);
+ 
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_ResetResult(interp);
+    }
+
+    /*
+     * 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,
+	    &dummyPtr, &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, nsPtr->fullName, -1);
+		if (nsPtr != 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) {
+	if (iPtr->varFramePtr != NULL) {
+	    nsPtr = iPtr->varFramePtr->nsPtr;
+	} else {
+	    nsPtr = iPtr->globalNsPtr;
+	}
+    }
+
+    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')
+	        && !((end-start >= 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. */
+{
+    Interp *iPtr = (Interp*)interp;
+
+    ResolverScheme *resPtr;
+    Namespace *nsPtr[2], *cxtNsPtr;
+    char *simpleName;
+    register Tcl_HashEntry *entryPtr;
+    register Command *cmdPtr;
+    register int search;
+    int result;
+    Tcl_Command cmd;
+
+    /*
+     * If this namespace has a command resolver, then give it first
+     * crack at the command resolution.  If the interpreter has any
+     * command resolvers, consult them next.  The command resolver
+     * procedures may return a Tcl_Command value, they may signal
+     * to continue onward, or they may signal an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->cmdResProc) {
+            result = (*cxtNsPtr->cmdResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->cmdResProc) {
+                result = (*resPtr->cmdResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            return cmd;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Command) NULL;
+        }
+    }
+
+    /*
+     * 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. */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
+    Namespace *nsPtr[2], *cxtNsPtr;
+    char *simpleName;
+    Tcl_HashEntry *entryPtr;
+    Var *varPtr;
+    register int search;
+    int result;
+    Tcl_Var var;
+
+    /*
+     * If this namespace has a variable resolver, then give it first
+     * crack at the variable resolution.  It may return a Tcl_Var
+     * value, it may signal to continue onward, or it may signal
+     * an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            return var;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Var) NULL;
+        }
+    }
+
+    /*
+     * 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.
+     */
+
+    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);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 *) interp, objv[1], subCmds,
+	    "option", /*flags*/ 0, (int *) &index);
+    if (result != TCL_OK) {
+	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, 2, objv, "?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, 2, objv, "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, 2, objv, NULL);
+        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, 2, objv, "?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, /* flags */ 0);
+	if (namespacePtr) {
+            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, 2, objv, "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, 2, objv,
+	        "?-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, 2, objv, "?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, 2, objv,
+	        "?-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, 2, objv, "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, 2, objv, "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, 2, objv, "?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, 2, objv, "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 >= name) && (*p == ':')) {
+		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, 2, objv, "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-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, 2, objv,
+	        "?-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/tcl/generic/tclNotify.c b/tcl/generic/tclNotify.c
new file mode 100644
index 00000000000..67bf7bfa4e1
--- /dev/null
+++ b/tcl/generic/tclNotify.c
@@ -0,0 +1,880 @@
+/* 
+ * tclNotify.c --
+ *
+ *	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.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * 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:
+ */
+
+typedef struct EventSource {
+    Tcl_EventSetupProc *setupProc;
+    Tcl_EventCheckProc *checkProc;
+    ClientData clientData;
+    struct EventSource *nextPtr;
+} EventSource;
+
+/*
+ * 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 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. */
+    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;
+
+/*
+ * Declarations for functions used in this file.
+ */
+
+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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierExitHandler --
+ *
+ *	This routine is called during Tcl finalization.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Clears the notifier intialization flag.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierExitHandler(clientData)
+    ClientData clientData;  /* Not used. */
+{
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateEventSource --
+ *
+ *	This procedure is invoked to create a new source of events.
+ *	The source is identified by a procedure that gets invoked
+ *	during Tcl_DoOneEvent to check for events on that source
+ *	and queue them.
+ *
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	SetupProc and checkProc will be invoked each time that Tcl_DoOneEvent
+ *	runs out of things to do.  SetupProc will be invoked before
+ *	Tcl_DoOneEvent calls select or whatever else it uses to wait
+ *	for events.  SetupProc typically calls functions like Tcl_WatchFile
+ *	or Tcl_SetMaxBlockTime to indicate what to wait for.
+ *
+ *	CheckProc is called after select or whatever operation was actually
+ *	used to wait.  It figures out whether anything interesting actually
+ *	happened (e.g. by calling Tcl_FileReady), and then calls
+ *	Tcl_QueueEvent to queue any events that are ready.
+ *
+ *	Each of these procedures is passed two arguments, e.g.
+ *		(*checkProc)(ClientData clientData, int flags));
+ *	ClientData is the same as the clientData argument here, and flags
+ *	is a combination of things like TCL_FILE_EVENTS that indicates
+ *	what events are of interest:  setupProc and checkProc use flags
+ *	to figure out whether their events are relevant or not.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateEventSource(setupProc, checkProc, clientData)
+    Tcl_EventSetupProc *setupProc;	/* Procedure to invoke to figure out
+					 * what to wait for. */
+    Tcl_EventCheckProc *checkProc;	/* Procedure to call after waiting
+					 * to see what happened. */
+    ClientData clientData;		/* One-word argument to pass to
+					 * setupProc and checkProc. */
+{
+    EventSource *sourcePtr;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
+    sourcePtr->setupProc = setupProc;
+    sourcePtr->checkProc = checkProc;
+    sourcePtr->clientData = clientData;
+    sourcePtr->nextPtr = notifier.firstEventSourcePtr;
+    notifier.firstEventSourcePtr = sourcePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteEventSource --
+ *
+ *	This procedure is invoked to delete the source of events
+ *	given by proc and clientData.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The given event source is cancelled, so its procedure will
+ *	never again be called.  If no such source exists, nothing
+ *	happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteEventSource(setupProc, checkProc, clientData)
+    Tcl_EventSetupProc *setupProc;	/* Procedure to invoke to figure out
+					 * what to wait for. */
+    Tcl_EventCheckProc *checkProc;	/* Procedure to call after waiting
+					 * to see what happened. */
+    ClientData clientData;		/* One-word argument to pass to
+					 * setupProc and checkProc. */
+{
+    EventSource *sourcePtr, *prevPtr;
+
+    for (sourcePtr = notifier.firstEventSourcePtr, prevPtr = NULL;
+	    sourcePtr != NULL;
+	    prevPtr = sourcePtr, sourcePtr = sourcePtr->nextPtr) {
+	if ((sourcePtr->setupProc != setupProc)
+		|| (sourcePtr->checkProc != checkProc)
+		|| (sourcePtr->clientData != clientData)) {
+	    continue;
+	}
+	if (prevPtr == NULL) {
+	    notifier.firstEventSourcePtr = sourcePtr->nextPtr;
+	} else {
+	    prevPtr->nextPtr = sourcePtr->nextPtr;
+	}
+	ckfree((char *) sourcePtr);
+	return;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_QueueEvent --
+ *
+ *	Insert an event into the Tk event queue at one of three
+ *	positions: the head, the tail, or before a floating marker.
+ *	Events inserted before the marker will be processed in
+ *	first-in-first-out order, but before any events inserted at
+ *	the tail of the queue.  Events inserted at the head of the
+ *	queue will be processed in last-in-first-out order.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_QueueEvent(evPtr, position)
+    Tcl_Event* evPtr;		/* Event to add to queue.  The storage
+				 * space must have been allocated the caller
+				 * with malloc (ckalloc), and it becomes
+				 * the property of the event queue.  It
+				 * will be freed after the event has been
+				 * handled. */
+    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 (notifier.firstEventPtr == NULL) {
+	    notifier.firstEventPtr = evPtr;
+	} else {
+	    notifier.lastEventPtr->nextPtr = evPtr;
+	}
+	notifier.lastEventPtr = evPtr;
+    } else if (position == TCL_QUEUE_HEAD) {
+	/*
+	 * Push the event on the head of the queue.
+	 */
+
+	evPtr->nextPtr = notifier.firstEventPtr;
+	if (notifier.firstEventPtr == NULL) {
+	    notifier.lastEventPtr = 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 (notifier.markerEventPtr == NULL) {
+	    evPtr->nextPtr = notifier.firstEventPtr;
+	    notifier.firstEventPtr = evPtr;
+	} else {
+	    evPtr->nextPtr = notifier.markerEventPtr->nextPtr;
+	    notifier.markerEventPtr->nextPtr = evPtr;
+	}
+	notifier.markerEventPtr = evPtr;
+	if (evPtr->nextPtr == NULL) {
+	    notifier.lastEventPtr = evPtr;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteEvents --
+ *
+ *	Calls a procedure for each event in the queue and deletes those
+ *	for which the procedure returns 1. Events for which the
+ *	procedure returns 0 are left in the queue.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Potentially removes one or more events from the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteEvents(proc, clientData)
+    Tcl_EventDeleteProc *proc;		/* The procedure to call. */
+    ClientData clientData;    		/* type-specific data. */
+{
+    Tcl_Event *evPtr, *prevPtr, *hold;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    for (prevPtr = (Tcl_Event *) NULL, evPtr = notifier.firstEventPtr;
+             evPtr != (Tcl_Event *) NULL;
+             ) {
+        if ((*proc) (evPtr, clientData) == 1) {
+            if (notifier.firstEventPtr == evPtr) {
+                notifier.firstEventPtr = evPtr->nextPtr;
+                if (evPtr->nextPtr == NULL) {
+                    notifier.lastEventPtr = prevPtr;
+                }
+		if (notifier.markerEventPtr == evPtr) {
+		    notifier.markerEventPtr = prevPtr;
+		}
+            } else {
+                prevPtr->nextPtr = evPtr->nextPtr;
+            }
+            hold = evPtr;
+            evPtr = evPtr->nextPtr;
+            ckfree((char *) hold);
+        } else {
+            prevPtr = evPtr;
+            evPtr = evPtr->nextPtr;
+        }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ServiceEvent --
+ *
+ *	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
+ *	to process.  If no processing occurred, then 0 is returned.
+ *
+ * Side effects:
+ *	Invokes all of the event handlers for the highest priority
+ *	event in the event queue.  May collapse some events into a
+ *	single event or discard stale events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+				 * flags defined elsewhere.  Events not
+				 * matching this will be skipped for processing
+				 * later. */
+{
+    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.
+     */
+    
+    if ((flags & TCL_ALL_EVENTS) == 0) {
+	flags |= TCL_ALL_EVENTS;
+    }
+
+    /*
+     * Loop through all the events in the queue until we find one
+     * that can actually be handled.
+     */
+
+    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
+	 * tricky things here, but stemming from the fact that the event
+	 * code may be re-entered while servicing the event:
+	 *
+	 * 1. Set the "proc" field to NULL.  This is a signal to ourselves
+	 *    that we shouldn't reexecute the handler if the event loop
+	 *    is re-entered.
+	 * 2. When freeing the event, must search the queue again from the
+	 *    front to find it.  This is because the event queue could
+	 *    change almost arbitrarily while handling the event, so we
+	 *    can't depend on pointers found now still being valid when
+	 *    the handler returns.
+	 */
+
+	proc = evPtr->proc;
+	evPtr->proc = NULL;
+	if ((proc != NULL) && (*proc)(evPtr, flags)) {
+	    if (notifier.firstEventPtr == evPtr) {
+		notifier.firstEventPtr = evPtr->nextPtr;
+		if (evPtr->nextPtr == NULL) {
+		    notifier.lastEventPtr = NULL;
+		}
+		if (notifier.markerEventPtr == evPtr) {
+		    notifier.markerEventPtr = NULL;
+		}
+	    } else {
+		for (prevPtr = notifier.firstEventPtr;
+		     prevPtr->nextPtr != evPtr; prevPtr = prevPtr->nextPtr) {
+		    /* Empty loop body. */
+		}
+		prevPtr->nextPtr = evPtr->nextPtr;
+		if (evPtr->nextPtr == NULL) {
+		    notifier.lastEventPtr = prevPtr;
+		}
+		if (notifier.markerEventPtr == evPtr) {
+		    notifier.markerEventPtr = prevPtr;
+		}
+	    }
+	    ckfree((char *) evPtr);
+	    return 1;
+	} else {
+	    /*
+	     * The event wasn't actually handled, so we have to restore
+	     * the proc field to allow the event to be attempted again.
+	     */
+
+	    evPtr->proc = proc;
+	}
+
+	/*
+	 * The handler for this event asked to defer it.  Just go on to
+	 * the next event.
+	 */
+
+	continue;
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ *	how long it may block the next time it blocks.  The timePtr
+ *	argument gives a maximum time;  the actual time may be less if
+ *	some other event source requested a smaller time.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May reduce the length of the next sleep in the notifier.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetMaxBlockTime(timePtr)
+    Tcl_Time *timePtr;		/* Specifies a maximum elapsed time for
+				 * the next blocking operation in the
+				 * event notifier. */
+{
+    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);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DoOneEvent --
+ *
+ *	Process a single event of some sort.  If there's no work to
+ *	do, wait for an event to occur, then process it.
+ *
+ * Results:
+ *	The return value is 1 if the procedure actually found an event
+ *	to process.  If no processing occurred, then 0 is returned (this
+ *	can happen if the TCL_DONT_WAIT flag is set or if there are no
+ *	event handlers to wait for in the set specified by flags).
+ *
+ * Side effects:
+ *	May delay execution of process while waiting for an event,
+ *	unless TCL_DONT_WAIT is set in the flags argument.  Event
+ *	sources are invoked to check for and queue events.  Event
+ *	handlers may produce arbitrary side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DoOneEvent(flags)
+    int flags;			/* Miscellaneous flag values:  may be any
+				 * combination of TCL_DONT_WAIT,
+				 * TCL_WINDOW_EVENTS, TCL_FILE_EVENTS,
+				 * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
+				 * others defined by event sources. */
+{
+    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.
+     */
+    
+    if ((flags & TCL_ALL_EVENTS) == 0) {
+	flags |= TCL_ALL_EVENTS;
+    }
+
+    /*
+     * 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
+     * may be processing events that don't do anything inside of Tcl.
+     */
+
+    while (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).
+	 */
+
+	if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) {
+	    flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+	    goto idleEvents;
+	}
+
+	/*
+	 * Ask Tcl to service a queued event, if there are any.
+	 */
+
+	if (Tcl_ServiceEvent(flags)) {
+	    result = 1;	    
+	    break;
+	}
+
+	/*
+	 * If TCL_DONT_WAIT is set, be sure to poll rather than
+	 * blocking, otherwise reset the block time to infinity.
+	 */
+
+	if (flags & TCL_DONT_WAIT) {
+	    notifier.blockTime.sec = 0;
+	    notifier.blockTime.usec = 0;
+	    notifier.blockTimeSet = 1;
+	} else {
+	    notifier.blockTimeSet = 0;
+	}
+
+	/*
+	 * 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 for a new event or a timeout.  If Tcl_WaitForEvent
+	 * returns -1, we should abort Tcl_DoOneEvent.
+	 */
+
+	result = Tcl_WaitForEvent(timePtr);
+	if (result < 0) {
+	    result = 0;
+	    break;
+	}
+
+	/*
+	 * Check all the event sources for new events.
+	 */
+
+	for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+	     sourcePtr = sourcePtr->nextPtr) {
+	    if (sourcePtr->checkProc) {
+		(sourcePtr->checkProc)(sourcePtr->clientData, flags);
+	    }
+	}
+
+	/*
+	 * 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 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) {
+	    if (TclServiceIdle()) {
+		result = 1;
+		break;
+	    }
+	}
+	if (flags & TCL_DONT_WAIT) {
+	    break;
+	}
+
+	/*
+	 * If Tcl_WaitForEvent has returned 1,
+	 * indicating that one system event has been dispatched
+	 * (and thus that some Tcl code might have been indirectly executed),
+	 * we break out of the loop.
+	 * We do this to give VwaitCmd for instance a chance to check 
+	 * if that system event had the side effect of changing the 
+	 * variable (so the vwait can return and unwind properly).
+	 *
+	 * NB: We will process idle events if any first, because
+	 *     otherwise we might never do the idle events if the notifier
+	 *     always gets system events.
+	 */
+
+	if (result) {
+	    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/tcl/generic/tclObj.c b/tcl/generic/tclObj.c
new file mode 100644
index 00000000000..8f0812c68dc
--- /dev/null
+++ b/tcl/generic/tclObj.c
@@ -0,0 +1,2142 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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);
+    Tcl_RegisterObjType(&tclProcBodyType);
+
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbIncrRefCount --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not
+ *	the memory has been freed before incrementing the ref count.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just increments
+ *	the reference count of the object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's ref count is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DbIncrRefCount(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are adding a reference to. */
+    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. */
+{
+#ifdef TCL_MEM_DEBUG
+    if (objPtr->refCount == 0x61616161) {
+	fprintf(stderr, "file = %s, line = %d\n", file, line);
+	fflush(stderr);
+	panic("Trying to increment refCount of previously disposed object.");
+    }
+#endif
+    ++(objPtr)->refCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbDecrRefCount --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not
+ *	the memory has been freed before incrementing the ref count.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just increments
+ *	the reference count of the object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's ref count is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DbDecrRefCount(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are adding a reference to. */
+    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. */
+{
+#ifdef TCL_MEM_DEBUG
+    if (objPtr->refCount == 0x61616161) {
+	fprintf(stderr, "file = %s, line = %d\n", file, line);
+	fflush(stderr);
+	panic("Trying to decrement refCount of previously disposed object.");
+    }
+#endif
+    if (--(objPtr)->refCount <= 0) {
+	TclFreeObj(objPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbIsShared --
+ *
+ *	This procedure is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not
+ *	the memory has been freed before incrementing the ref count.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this procedure just decrements
+ *	the reference count of the object and throws it away if the count
+ *	is 0 or less.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's ref count is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DbIsShared(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are adding a reference to. */
+    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. */
+{
+#ifdef TCL_MEM_DEBUG
+    if (objPtr->refCount == 0x61616161) {
+	fprintf(stderr, "file = %s, line = %d\n", file, line);
+	fflush(stderr);
+	panic("Trying to check whether previously disposed object is shared.");
+    }
+#endif
+    return ((objPtr)->refCount > 1);
+}
diff --git a/tcl/generic/tclParse.c b/tcl/generic/tclParse.c
new file mode 100644
index 00000000000..c266f19e5e9
--- /dev/null
+++ b/tcl/generic/tclParse.c
@@ -0,0 +1,938 @@
+/* 
+ * tclParse.c --
+ *
+ *	This file contains a collection of procedures that are used
+ *	to parse Tcl commands or parts of commands (like quoted
+ *	strings or nested sub-commands).
+ *
+ * Copyright (c) 1987-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Function prototypes for procedures local to this file:
+ */
+
+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));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclParseQuotes --
+ *
+ *	This procedure parses 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 parse array
+ *	element names within parentheses, or anything else that
+ *	needs all the substitutions that happen in quotes.
+ *
+ * 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 interp->result
+ *	contains a standard error message.  *TermPtr is filled
+ *	in with the address of the character just after the
+ *	last one successfully processed;  this is usually the
+ *	character just after the matching close-quote.  The
+ *	fully-substituted contents of the quotes are stored in
+ *	standard fashion in *pvPtr, null-terminated with
+ *	pvPtr->next pointing to the terminating null character.
+ *
+ * Side effects:
+ *	The buffer space in pvPtr may be enlarged by calling its
+ *	expandProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* Character just after opening double-
+				 * quote. */
+    int termChar;		/* Character that terminates "quoted" string
+				 * (usually double-quote, but sometimes
+				 * right-paren or something else). */
+    int flags;			/* Flags to pass to nested Tcl_Eval calls. */
+    char **termPtr;		/* Store address of terminating character
+				 * here. */
+    ParseValue *pvPtr;		/* Information about where to place
+				 * fully-substituted result of parse. */
+{
+    register char *src, *dst, c;
+    char *lastChar = string + strlen(string);
+
+    src = string;
+    dst = pvPtr->next;
+
+    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;
+	}
+
+	c = *src;
+	src++;
+	if (c == termChar) {
+	    *dst = '\0';
+	    pvPtr->next = dst;
+	    *termPtr = src;
+	    return TCL_OK;
+	} else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
+	    copy:
+	    *dst = c;
+	    dst++;
+	    continue;
+	} else if (c == '$') {
+	    int length;
+	    char *value;
+
+	    value = Tcl_ParseVar(interp, src-1, 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;
+	    continue;
+	} else if (c == '[') {
+	    int result;
+
+	    pvPtr->next = dst;
+	    result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    src = *termPtr;
+	    dst = pvPtr->next;
+	    continue;
+	} else if (c == '\\') {
+	    int numRead;
+
+	    src--;
+	    *dst = Tcl_Backslash(src, &numRead);
+	    dst++;
+	    src += numRead;
+	    continue;
+	} else if (c == '\0') {
+	    char buf[30];
+	    
+	    Tcl_ResetResult(interp);
+	    sprintf(buf, "missing %c", termChar);
+	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    *termPtr = string-1;
+	    return TCL_ERROR;
+	} else {
+	    goto copy;
+	}
+    }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclParseNestedCmd --
+ *
+ *	This procedure parses a nested Tcl command between
+ *	brackets, returning the result of the command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is
+ *	TCL_OK unless there was an error while executing the
+ *	nested command.  If an error occurs then interp->result
+ *	contains a standard error message.  *TermPtr is filled
+ *	in with the address of the character just after the
+ *	last one processed;  this is usually the character just
+ *	after the matching close-bracket, or the null character
+ *	at the end of the string if the close-bracket was missing
+ *	(a missing close bracket is an error).  The result returned
+ *	by the command is stored in standard fashion in *pvPtr,
+ *	null-terminated, with pvPtr->next pointing to the null
+ *	character.
+ *
+ * Side effects:
+ *	The storage space at *pvPtr may be expanded.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* Character just after opening bracket. */
+    int flags;			/* Flags to pass to nested Tcl_Eval. */
+    char **termPtr;		/* Store address of terminating character
+				 * here. */
+    register ParseValue *pvPtr;	/* Information about where to place
+				 * result of command. */
+{
+    int result, length, shortfall;
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->evalFlags = flags | TCL_BRACKET_TERM;
+    result = Tcl_Eval(interp, string);
+    *termPtr = (string + iPtr->termOffset);
+    if (result != TCL_OK) {
+	/*
+	 * The increment below results in slightly cleaner message in
+	 * the errorInfo variable (the close-bracket will appear).
+	 */
+
+	if (**termPtr == ']') {
+	    *termPtr += 1;
+	}
+	return result;
+    }
+    (*termPtr) += 1;
+    length = strlen(iPtr->result);
+    shortfall = length + 1 - (pvPtr->end - pvPtr->next);
+    if (shortfall > 0) {
+	(*pvPtr->expandProc)(pvPtr, shortfall);
+    }
+    strcpy(pvPtr->next, iPtr->result);
+    pvPtr->next += length;
+    
+    Tcl_FreeResult(interp);
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = '\0';
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclParseBraces --
+ *
+ *	This procedure scans the information between matching
+ *	curly braces.
+ *
+ * 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 interp->result contains a
+ *	standard error message.  *TermPtr is filled
+ *	in with the address of the character just after the
+ *	last one successfully processed;  this is usually the
+ *	character just after the matching close-brace.  The
+ *	information between curly braces is stored in standard
+ *	fashion in *pvPtr, null-terminated with pvPtr->next
+ *	pointing to the terminating null character.
+ *
+ * Side effects:
+ *	The storage space at *pvPtr may be expanded.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TclParseBraces(interp, string, termPtr, pvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for nested command
+				 * evaluations and error messages. */
+    char *string;		/* Character just after opening bracket. */
+    char **termPtr;		/* Store address of terminating character
+				 * here. */
+    register ParseValue *pvPtr;	/* Information about where to place
+				 * result of command. */
+{
+    int level;
+    register char *src, *dst, *end;
+    register char c;
+    char *lastChar = string + strlen(string);
+
+    src = string;
+    dst = pvPtr->next;
+    end = pvPtr->end;
+    level = 1;
+
+    /*
+     * Copy the characters one at a time to the result area, stopping
+     * when the matching close-brace is found.
+     */
+
+    while (1) {
+	c = *src;
+	src++;
+	if (dst == end) {
+	    pvPtr->next = dst;
+	    (*pvPtr->expandProc)(pvPtr, 20);
+	    dst = pvPtr->next;
+	    end = pvPtr->end;
+	}
+	*dst = c;
+	dst++;
+	if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
+	    continue;
+	} else if (c == '{') {
+	    level++;
+	} else if (c == '}') {
+	    level--;
+	    if (level == 0) {
+		dst--;			/* Don't copy the last close brace. */
+		break;
+	    }
+	} else if (c == '\\') {
+	    int count;
+
+	    /*
+	     * Must always squish out backslash-newlines, even when in
+	     * braces.  This is needed so that this sequence can appear
+	     * anywhere in a command, such as the middle of an expression.
+	     */
+
+	    if (*src == '\n') {
+		dst[-1] = Tcl_Backslash(src-1, &count);
+		src += count - 1;
+	    } else {
+		(void) Tcl_Backslash(src-1, &count);
+		while (count > 1) {
+                    if (dst == end) {
+                        pvPtr->next = dst;
+                        (*pvPtr->expandProc)(pvPtr, 20);
+                        dst = pvPtr->next;
+                        end = pvPtr->end;
+                    }
+		    *dst = *src;
+		    dst++;
+		    src++;
+		    count--;
+		}
+	    }
+	} else if (c == '\0') {
+	    Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
+	    *termPtr = string-1;
+	    return TCL_ERROR;
+	}
+    }
+
+    *dst = '\0';
+    pvPtr->next = dst;
+    *termPtr = src;
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclExpandParseValue --
+ *
+ *	This procedure is commonly used as the value of the
+ *	expandProc in a ParseValue.  It uses malloc to allocate
+ *	more space for the result of a parse.
+ *
+ * Results:
+ *	The buffer space in *pvPtr is reallocated to something
+ *	larger, and if pvPtr->clientData is non-zero the old
+ *	buffer is freed.  Information is copied from the old
+ *	buffer to the new one.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclExpandParseValue(pvPtr, needed)
+    register ParseValue *pvPtr;		/* Information about buffer that
+					 * must be expanded.  If the clientData
+					 * in the structure is non-zero, it
+					 * means that the current buffer is
+					 * dynamically allocated. */
+    int needed;				/* Minimum amount of additional space
+					 * to allocate. */
+{
+    int newSpace;
+    char *new;
+
+    /*
+     * Either double the size of the buffer or add enough new space
+     * to meet the demand, whichever produces a larger new buffer.
+     */
+
+    newSpace = (pvPtr->end - pvPtr->buffer) + 1;
+    if (newSpace < needed) {
+	newSpace += needed;
+    } else {
+	newSpace += newSpace;
+    }
+    new = (char *) ckalloc((unsigned) newSpace);
+
+    /*
+     * Copy from old buffer to new, free old buffer if needed, and
+     * mark new buffer as malloc-ed.
+     */
+
+    memcpy((VOID *) new, (VOID *) pvPtr->buffer,
+	    (size_t) (pvPtr->next - pvPtr->buffer));
+    pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
+    if (pvPtr->clientData != 0) {
+	ckfree(pvPtr->buffer);
+    }
+    pvPtr->buffer = new;
+    pvPtr->end = new + newSpace - 1;
+    pvPtr->clientData = (ClientData) 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWordEnd --
+ *
+ *	Given a pointer into a Tcl command, find the end of the next
+ *	word of the command.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that's part
+ *	of the word pointed to by "start".  If the word doesn't end
+ *	properly within the string then the return value is the address
+ *	of the null character at the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+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). */
+    int *semiPtr;		/* Set to 1 if word ends with a command-
+				 * terminating semi-colon, zero otherwise.
+				 * If NULL then ignored. */
+{
+    register char *p;
+    int count;
+
+    if (semiPtr != NULL) {
+	*semiPtr = 0;
+    }
+
+    /*
+     * Skip leading white space (backslash-newline must be treated like
+     * white-space, except that it better not be the last thing in the
+     * command).
+     */
+
+    for (p = start; ; p++) {
+	if (isspace(UCHAR(*p))) {
+	    continue;
+	}
+	if ((p[0] == '\\') && (p[1] == '\n')) {
+	    if (p+2 == lastChar) {
+		return p+2;
+	    }
+	    continue;
+	}
+	break;
+    }
+
+    /*
+     * Handle words beginning with a double-quote or a brace.
+     */
+
+    if (*p == '"') {
+	p = QuoteEnd(p+1, lastChar, '"');
+	if (p == lastChar) {
+	    return p;
+	}
+	p++;
+    } else if (*p == '{') {
+	int braces = 1;
+	while (braces != 0) {
+	    p++;
+	    while (*p == '\\') {
+		(void) Tcl_Backslash(p, &count);
+		p += count;
+	    }
+	    if (*p == '}') {
+		braces--;
+	    } else if (*p == '{') {
+		braces++;
+	    } else if (p == lastChar) {
+		return p;
+	    }
+	}
+	p++;
+    }
+
+    /*
+     * Handle words that don't start with a brace or double-quote.
+     * This code is also invoked if the word starts with a brace or
+     * double-quote and there is garbage after the closing brace or
+     * quote.  This is an error as far as Tcl_Eval is concerned, but
+     * for here the garbage is treated as part of the word.
+     */
+
+    while (1) {
+	if (*p == '[') {
+	    p = ScriptEnd(p+1, lastChar, 1);
+	    if (p == lastChar) {
+		return p;
+	    }
+	    p++;
+	} else if (*p == '\\') {
+	    if (p[1] == '\n') {
+		/*
+		 * Backslash-newline:  it maps to a space character
+		 * that is a word separator, so the word ends just before
+		 * the backslash.
+		 */
+
+		return p-1;
+	    }
+	    (void) Tcl_Backslash(p, &count);
+	    p += count;
+	} else if (*p == '$') {
+	    p = VarNameEnd(p, lastChar);
+	    if (p == lastChar) {
+		return p;
+	    }
+	    p++;
+	} else if (*p == ';') {
+	    /*
+	     * Include the semi-colon in the word that is returned.
+	     */
+
+	    if (semiPtr != NULL) {
+		*semiPtr = 1;
+	    }
+	    return p;
+	} else if (isspace(UCHAR(*p))) {
+	    return p-1;
+	} else if ((*p == ']') && nested) {
+	    return p-1;
+	} else if (p == lastChar) {
+	    if (nested) {
+		/*
+		 * Nested commands can't end because of the end of the
+		 * string.
+		 */
+		return p;
+	    }
+	    return p-1;
+	} else {
+	    p++;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QuoteEnd --
+ *
+ *	Given a pointer to a string that obeys the parsing conventions
+ *	for quoted things in Tcl, find the end of that quoted thing.
+ *	The actual thing may be a quoted argument or a parenthesized
+ *	index name.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that is
+ *	part of the quoted string (i.e the character that's equal to
+ *	term).  If the quoted string doesn't terminate properly then
+ *	the return value is a pointer to the null character at the
+ *	end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+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 ')'). */
+{
+    register char *p = string;
+    int count;
+
+    while (*p != term) {
+	if (*p == '\\') {
+	    (void) Tcl_Backslash(p, &count);
+	    p += count;
+	} else if (*p == '[') {
+	    for (p++; *p != ']'; p++) {
+		p = TclWordEnd(p, lastChar, 1, (int *) NULL);
+		if (*p == 0) {
+		    return p;
+		}
+	    }
+	    p++;
+	} else if (*p == '$') {
+	    p = VarNameEnd(p, lastChar);
+	    if (*p == 0) {
+		return p;
+	    }
+	    p++;
+	} else if (p == lastChar) {
+	    return p;
+	} else {
+	    p++;
+	}
+    }
+    return p-1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * VarNameEnd --
+ *
+ *	Given a pointer to a variable reference using $-notation, find
+ *	the end of the variable name spec.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that
+ *	is part of the variable name.  If the variable name doesn't
+ *	terminate properly then the return value is a pointer to the
+ *	null character at the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+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 != lastChar); p++) {
+	    /* Empty loop body. */
+	}
+	return p;
+    }
+    while (isalnum(UCHAR(*p)) || (*p == '_')) {
+	p++;
+    }
+    if ((*p == '(') && (p != string+1)) {
+	return QuoteEnd(p+1, lastChar, ')');
+    }
+    return p-1;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScriptEnd --
+ *
+ *	Given a pointer to the beginning of a Tcl script, find the end of
+ *	the script.
+ *
+ * Results:
+ *	The return value is a pointer to the last character that's part
+ *	of the script pointed to by "p".  If the command doesn't end
+ *	properly within the string then the return value is the address
+ *	of the null character at the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+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
+				 * an unquoted ]). */
+{
+    int commentOK = 1;
+    int length;
+
+    while (1) {
+	while (isspace(UCHAR(*p))) {
+	    if (*p == '\n') {
+		commentOK = 1;
+	    }
+	    p++;
+	}
+	if ((*p == '#') && commentOK) {
+	    do {
+		if (*p == '\\') {
+		    /*
+		     * If the script ends with backslash-newline, then
+		     * this command isn't complete.
+		     */
+
+		    if ((p[1] == '\n') && (p+2 == lastChar)) {
+			return p+2;
+		    }
+		    Tcl_Backslash(p, &length);
+		    p += length;
+		} else {
+		    p++;
+		}
+	    } while ((p != lastChar) && (*p != '\n'));
+	    continue;
+	}
+	p = TclWordEnd(p, lastChar, nested, &commentOK);
+	if (p == lastChar) {
+	    return p;
+	}
+	p++;
+	if (nested) {
+	    if (*p == ']') {
+		return p;
+	    }
+	} else {
+	    if (p == lastChar) {
+		return p-1;
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseVar --
+ *
+ *	Given a string starting with a $ sign, parse off a variable
+ *	name and return its value.
+ *
+ * Results:
+ *	The return value is the contents of the variable given by
+ *	the leading characters of string.  If termPtr isn't NULL,
+ *	*termPtr gets filled in with the address of the character
+ *	just after the last one in the variable specifier.  If the
+ *	variable doesn't exist, then the return value is NULL and
+ *	an error message will be left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ParseVar(interp, string, termPtr)
+    Tcl_Interp *interp;			/* Context for looking up variable. */
+    register char *string;		/* String containing variable name.
+					 * First character must be "$". */
+    char **termPtr;			/* If non-NULL, points to word to fill
+					 * in with character just after last
+					 * one in the variable specifier. */
+
+{
+    char *name1, *name1End, c, *result;
+    register char *name2;
+#define NUM_CHARS 200
+    char copyStorage[NUM_CHARS];
+    ParseValue pv;
+
+    /*
+     * 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, 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,
+     *    underscore, or a "::" namespace separator: in this case,
+     *    there is no variable name, and "$" is returned.
+     */
+
+    name2 = NULL;
+    string++;
+    if (*string == '{') {
+	string++;
+	name1 = string;
+	while (*string != '}') {
+	    if (*string == 0) {
+		Tcl_SetResult(interp, "missing close-brace for variable name",
+			TCL_STATIC);
+		if (termPtr != 0) {
+		    *termPtr = string;
+		}
+		return NULL;
+	    }
+	    string++;
+	}
+	name1End = string;
+	string++;
+    } else {
+	name1 = 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) {
+		*termPtr = string;
+	    }
+	    return "$";
+	}
+	name1End = string;
+	if (*string == '(') {
+	    char *end;
+
+	    /*
+	     * Perform substitutions on the array element name, just as
+	     * is done for quotes.
+	     */
+
+	    pv.buffer = pv.next = copyStorage;
+	    pv.end = copyStorage + NUM_CHARS - 1;
+	    pv.expandProc = TclExpandParseValue;
+	    pv.clientData = (ClientData) NULL;
+	    if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
+		    != TCL_OK) {
+		char msg[200];
+		int length;
+
+		length = string-name1;
+		if (length > 100) {
+		    length = 100;
+		}
+		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
+			length, name1);
+		Tcl_AddErrorInfo(interp, msg);
+		result = NULL;
+		name2 = pv.buffer;
+		if (termPtr != 0) {
+		    *termPtr = end;
+		}
+		goto done;
+	    }
+	    Tcl_ResetResult(interp);
+	    string = end;
+	    name2 = pv.buffer;
+	}
+    }
+    if (termPtr != 0) {
+	*termPtr = string;
+    }
+
+    c = *name1End;
+    *name1End = 0;
+    result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
+    *name1End = c;
+
+    done:
+    if ((name2 != NULL) && (pv.buffer != copyStorage)) {
+	ckfree(pv.buffer);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CommandComplete --
+ *
+ *	Given a partial or complete Tcl command, this procedure
+ *	determines whether the command is complete in the sense
+ *	of having matched braces and quotes and brackets.
+ *
+ * Results:
+ *	1 is returned if the command is complete, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CommandComplete(cmd)
+    char *cmd;			/* Command to check. */
+{
+    char *p;
+
+    if (*cmd == 0) {
+	return 1;
+    }
+    p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
+    return (*p != 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjCommandComplete --
+ *
+ *	Given a partial or complete Tcl command in a Tcl object, this
+ *	procedure determines whether the command is complete in the sense of
+ *	having matched braces and quotes and brackets.
+ *
+ * Results:
+ *	1 is returned if the command is complete, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjCommandComplete(cmdPtr)
+    Tcl_Obj *cmdPtr;			/* Points to object holding command
+					 * to check. */
+{
+    char *cmd, *p;
+    int length;
+
+    cmd = Tcl_GetStringFromObj(cmdPtr, &length);
+    if (length == 0) {
+	return 1;
+    }
+    p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
+    return (*p != 0);
+}
diff --git a/tcl/generic/tclPipe.c b/tcl/generic/tclPipe.c
new file mode 100644
index 00000000000..0e958692db1
--- /dev/null
+++ b/tcl/generic/tclPipe.c
@@ -0,0 +1,1074 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+    int joinError = 0;		/* CYGNUS LOCAL: If non-zero, join stderr
+				 * and stdout.  */
+    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);
+	    }
+
+	    /* CYGNUS LOCAL: On windows we need to handle redirecting
+               stderr to stdout specially.  On Unix it works out
+               because TclpCreateProcess happens to dup stderr to
+               stdout after reopening stdout, but that fails on
+               Windows.  */
+	    joinError = 0;
+	    if (*p == '@'
+		&& strcmp ((p[1] == '\0' ? argv[i + 1] : p + 1),
+			   "stdout") == 0) {
+		joinError = 1;
+		if (p[1] == '\0') {
+		    skip = 2;
+		} else {
+		    skip = 1;
+		}
+	    } else {
+		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) {
+	/* CYGNUS LOCAL: Handle joinError.  */
+	if (joinError) {
+	    errorFile = outputFile;
+	} else 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/tcl/generic/tclPkg.c b/tcl/generic/tclPkg.c
new file mode 100644
index 00000000000..e74356185c4
--- /dev/null
+++ b/tcl/generic/tclPkg.c
@@ -0,0 +1,734 @@
+/* 
+ * tclPkg.c --
+ *
+ *	This file implements package and version control for Tcl via
+ *	the "package" command and a few C APIs.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * Each invocation of the "package ifneeded" command creates a structure
+ * of the following type, which is used to load the package into the
+ * interpreter if it is requested with a "package require" command.
+ */
+
+typedef struct PkgAvail {
+    char *version;		/* Version string; malloc'ed. */
+    char *script;		/* Script to invoke to provide this version
+				 * of the package.  Malloc'ed and protected
+				 * by Tcl_Preserve and Tcl_Release. */
+    struct PkgAvail *nextPtr;	/* Next in list of available versions of
+				 * the same package. */
+} PkgAvail;
+
+/*
+ * For each package that is known in any way to an interpreter, there
+ * is one record of the following type.  These records are stored in
+ * the "packageTable" hash table in the interpreter, keyed by
+ * package name such as "Tk" (no version number).
+ */
+
+typedef struct Package {
+    char *version;		/* Version that has been supplied in this
+				 * interpreter via "package provide"
+				 * (malloc'ed).  NULL means the package doesn't
+				 * exist in this interpreter yet. */
+    PkgAvail *availPtr;		/* First in list of all available versions
+				 * of this package. */
+} Package;
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int		CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *string));
+static int		ComparePkgVersions _ANSI_ARGS_((char *v1, char *v2,
+			    int *satPtr));
+static Package *	FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *name));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PkgProvide --
+ *
+ *	This procedure is invoked to declare that a particular version
+ *	of a particular package is now present in an interpreter.  There
+ *	must not be any other version of this package already
+ *	provided in the interpreter.
+ *
+ * Results:
+ *	Normally returns TCL_OK;  if there is already another version
+ *	of the package loaded then TCL_ERROR is returned and an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	The interpreter remembers that this package is available,
+ *	so that no other version of the package may be provided for
+ *	the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_PkgProvide(interp, name, version)
+    Tcl_Interp *interp;		/* Interpreter in which package is now
+				 * available. */
+    char *name;			/* Name of package. */
+    char *version;		/* Version string for package. */
+{
+    Package *pkgPtr;
+
+    pkgPtr = FindPackage(interp, name);
+    if (pkgPtr->version == NULL) {
+	pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1));
+	strcpy(pkgPtr->version, version);
+	return TCL_OK;
+    }
+    if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
+	return TCL_OK;
+    }
+    Tcl_AppendResult(interp, "conflicting versions provided for package \"",
+	    name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PkgRequire --
+ *
+ *	This procedure is called by code that depends on a particular
+ *	version of a particular package.  If the package is not already
+ *	provided in the interpreter, this procedure invokes a Tcl script
+ *	to provide it.  If the package is already provided, this
+ *	procedure makes sure that the caller's needs don't conflict with
+ *	the version that is present.
+ *
+ * Results:
+ *	If successful, returns the version string for the currently
+ *	provided version of the package, which may be different from
+ *	the "version" argument.  If the caller's requirements
+ *	cannot be met (e.g. the version requested conflicts with
+ *	a currently provided version, or the required version cannot
+ *	be found, or the script to provide the required version
+ *	generates an error), NULL is returned and an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	The script from some previous "package ifneeded" command may
+ *	be invoked to provide the package.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_PkgRequire(interp, name, version, exact)
+    Tcl_Interp *interp;		/* Interpreter in which package is now
+				 * available. */
+    char *name;			/* Name of desired package. */
+    char *version;		/* Version string for desired version;
+				 * NULL means use the latest version
+				 * available. */
+    int exact;			/* Non-zero means that only the particular
+				 * version given is acceptable. Zero means
+				 * use the latest compatible version. */
+{
+    Package *pkgPtr;
+    PkgAvail *availPtr, *bestPtr;
+    char *script;
+    int code, satisfies, result, pass;
+    Tcl_DString command;
+
+    /*
+     * It can take up to three passes to find the package:  one pass to
+     * run the "package unknown" script, one to run the "package ifneeded"
+     * script for a specific version, and a final pass to lookup the
+     * package loaded by the "package ifneeded" script.
+     */
+
+    for (pass = 1; ; pass++) {
+	pkgPtr = FindPackage(interp, name);
+	if (pkgPtr->version != NULL) {
+	    break;
+	}
+
+	/*
+	 * The package isn't yet present.  Search the list of available
+	 * versions and invoke the script for the best available version.
+	 */
+    
+	bestPtr = NULL;
+	for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+		availPtr = availPtr->nextPtr) {
+	    if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,
+		    bestPtr->version, (int *) NULL) <= 0)) {
+		continue;
+	    }
+	    if (version != NULL) {
+		result = ComparePkgVersions(availPtr->version, version,
+			&satisfies);
+		if ((result != 0) && exact) {
+		    continue;
+		}
+		if (!satisfies) {
+		    continue;
+		}
+	    }
+	    bestPtr = availPtr;
+	}
+	if (bestPtr != NULL) {
+	    /*
+	     * We found an ifneeded script for the package.  Be careful while
+	     * executing it:  this could cause reentrancy, so (a) protect the
+	     * script itself from deletion and (b) don't assume that bestPtr
+	     * will still exist when the script completes.
+	     */
+	
+	    script = bestPtr->script;
+	    Tcl_Preserve((ClientData) script);
+	    code = Tcl_GlobalEval(interp, script);
+	    Tcl_Release((ClientData) script);
+	    if (code != TCL_OK) {
+		if (code == TCL_ERROR) {
+		    Tcl_AddErrorInfo(interp,
+			    "\n    (\"package ifneeded\" script)");
+		}
+		return NULL;
+	    }
+	    Tcl_ResetResult(interp);
+	    pkgPtr = FindPackage(interp, name);
+	    break;
+	}
+
+	/*
+	 * Package not in the database.  If there is a "package unknown"
+	 * command, invoke it (but only on the first pass;  after that,
+	 * we should not get here in the first place).
+	 */
+
+	if (pass > 1) {
+	    break;
+	}
+	script = ((Interp *) interp)->packageUnknown;
+	if (script != NULL) {
+	    Tcl_DStringInit(&command);
+	    Tcl_DStringAppend(&command, script, -1);
+	    Tcl_DStringAppendElement(&command, name);
+	    Tcl_DStringAppend(&command, " ", 1);
+	    Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",
+		    -1);
+	    if (exact) {
+		Tcl_DStringAppend(&command, " -exact", 7);
+	    }
+	    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command));
+	    Tcl_DStringFree(&command);
+	    if (code != TCL_OK) {
+		if (code == TCL_ERROR) {
+		    Tcl_AddErrorInfo(interp,
+			    "\n    (\"package unknown\" script)");
+		}
+		return NULL;
+	    }
+	    Tcl_ResetResult(interp);
+	}
+    }
+
+    if (pkgPtr->version == NULL) {
+	Tcl_AppendResult(interp, "can't find package ", name,
+		(char *) NULL);
+	if (version != NULL) {
+	    Tcl_AppendResult(interp, " ", version, (char *) NULL);
+	}
+	return NULL;
+    }
+
+    /*
+     * At this point we now that the package is present.  Make sure that the
+     * provided version meets the current requirement.
+     */
+
+    if (version == NULL) {
+	return pkgPtr->version;
+    }
+    result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
+    if ((satisfies && !exact) || (result == 0)) {
+	return pkgPtr->version;
+    }
+    Tcl_AppendResult(interp, "version conflict for package \"",
+	    name, "\": have ", pkgPtr->version, ", need ", version,
+	    (char *) NULL);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PackageCmd --
+ *
+ *	This procedure is invoked to process the "package" 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_PackageCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Interp *iPtr = (Interp *) interp;
+    size_t length;
+    int c, exact, i, satisfies;
+    PkgAvail *availPtr, *prevPtr;
+    Package *pkgPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_HashTable *tablePtr;
+    char *version;
+    char buf[30];
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option ?arg arg ...?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    c = argv[1][0];
+    length = strlen(argv[1]);
+    if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
+	for (i = 2; i < argc; i++) {
+	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[i]);
+	    if (hPtr == NULL) {
+		return TCL_OK;
+	    }
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    Tcl_DeleteHashEntry(hPtr);
+	    if (pkgPtr->version != NULL) {
+		ckfree(pkgPtr->version);
+	    }
+	    while (pkgPtr->availPtr != NULL) {
+		availPtr = pkgPtr->availPtr;
+		pkgPtr->availPtr = availPtr->nextPtr;
+		ckfree(availPtr->version);
+		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+		ckfree((char *) availPtr);
+	    }
+	    ckfree((char *) pkgPtr);
+	}
+    } else if ((c == 'i') && (strncmp(argv[1], "ifneeded", length) == 0)) {
+	if ((argc != 4) && (argc != 5)) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " ifneeded package version ?script?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (CheckVersion(interp, argv[3]) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (argc == 4) {
+	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
+	    if (hPtr == NULL) {
+		return TCL_OK;
+	    }
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	} else {
+	    pkgPtr = FindPackage(interp, argv[2]);
+	}
+	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
+		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
+	    if (ComparePkgVersions(availPtr->version, argv[3], (int *) NULL)
+		    == 0) {
+		if (argc == 4) {
+		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+		    return TCL_OK;
+		}
+		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+		break;
+	    }
+	}
+	if (argc == 4) {
+	    return TCL_OK;
+	}
+	if (availPtr == NULL) {
+	    availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
+	    availPtr->version = ckalloc((unsigned) (strlen(argv[3]) + 1));
+	    strcpy(availPtr->version, argv[3]);
+	    if (prevPtr == NULL) {
+		availPtr->nextPtr = pkgPtr->availPtr;
+		pkgPtr->availPtr = availPtr;
+	    } else {
+		availPtr->nextPtr = prevPtr->nextPtr;
+		prevPtr->nextPtr = availPtr;
+	    }
+	}
+	availPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
+	strcpy(availPtr->script, argv[4]);
+    } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
+	if (argc != 2) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " names\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	tablePtr = &iPtr->packageTable;
+	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+		hPtr = Tcl_NextHashEntry(&search)) {
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
+	    }
+	}
+    } else if ((c == 'p') && (strncmp(argv[1], "provide", length) == 0)) {
+	if ((argc != 3) && (argc != 4)) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " provide package ?version?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (argc == 3) {
+	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
+	    if (hPtr != NULL) {
+		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+		if (pkgPtr->version != NULL) {
+		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
+		}
+	    }
+	    return TCL_OK;
+	}
+	if (CheckVersion(interp, argv[3]) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	return Tcl_PkgProvide(interp, argv[2], argv[3]);
+    } else if ((c == 'r') && (strncmp(argv[1], "require", length) == 0)) {
+	if (argc < 3) {
+	    requireSyntax:
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " require ?-exact? package ?version?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((argv[2][0] == '-') && (strcmp(argv[2], "-exact") == 0)) {
+	    exact = 1;
+	} else {
+	    exact = 0;
+	}
+	version = NULL;
+	if (argc == (4+exact)) {
+	    version = argv[3+exact];
+	    if (CheckVersion(interp, version) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	} else if ((argc != 3) || exact) {
+	    goto requireSyntax;
+	}
+	version = Tcl_PkgRequire(interp, argv[2+exact], version, exact);
+	if (version == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, version, TCL_VOLATILE);
+    } else if ((c == 'u') && (strncmp(argv[1], "unknown", length) == 0)) {
+	if (argc == 2) {
+	    if (iPtr->packageUnknown != NULL) {
+		Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
+	    }
+	} else if (argc == 3) {
+	    if (iPtr->packageUnknown != NULL) {
+		ckfree(iPtr->packageUnknown);
+	    }
+	    if (argv[2][0] == 0) {
+		iPtr->packageUnknown = NULL;
+	    } else {
+		iPtr->packageUnknown = (char *) ckalloc((unsigned)
+			(strlen(argv[2]) + 1));
+		strcpy(iPtr->packageUnknown, argv[2]);
+	    }
+	} else {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " unknown ?command?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    } else if ((c == 'v') && (strncmp(argv[1], "vcompare", length) == 0)
+	    && (length >= 2)) {
+	if (argc != 4) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " vcompare version1 version2\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((CheckVersion(interp, argv[2]) != TCL_OK)
+		|| (CheckVersion(interp, argv[3]) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
+	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) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " versions package\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
+	if (hPtr != NULL) {
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+		    availPtr = availPtr->nextPtr) {
+		Tcl_AppendElement(interp, availPtr->version);
+	    }
+	}
+    } else if ((c == 'v') && (strncmp(argv[1], "vsatisfies", length) == 0)
+	    && (length >= 2)) {
+	if (argc != 4) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " vsatisfies version1 version2\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if ((CheckVersion(interp, argv[2]) != TCL_OK)
+		|| (CheckVersion(interp, argv[3]) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
+	ComparePkgVersions(argv[2], argv[3], &satisfies);
+	TclFormatInt(buf, satisfies);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": should be forget, ifneeded, names, ",
+		"provide, require, unknown, vcompare, ",
+		"versions, or vsatisfies", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindPackage --
+ *
+ *	This procedure finds the Package record for a particular package
+ *	in a particular interpreter, creating a record if one doesn't
+ *	already exist.
+ *
+ * Results:
+ *	The return value is a pointer to the Package record for the
+ *	package.
+ *
+ * Side effects:
+ *	A new Package record may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Package *
+FindPackage(interp, name)
+    Tcl_Interp *interp;		/* Interpreter to use for package lookup. */
+    char *name;			/* Name of package to fine. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    int new;
+    Package *pkgPtr;
+
+    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
+    if (new) {
+	pkgPtr = (Package *) ckalloc(sizeof(Package));
+	pkgPtr->version = NULL;
+	pkgPtr->availPtr = NULL;
+	Tcl_SetHashValue(hPtr, pkgPtr);
+    } else {
+	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+    }
+    return pkgPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreePackageInfo --
+ *
+ *	This procedure is called during interpreter deletion to
+ *	free all of the package-related information for the
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreePackageInfo(iPtr)
+    Interp *iPtr;		/* Interpereter that is being deleted. */
+{
+    Package *pkgPtr;
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
+    PkgAvail *availPtr;
+
+    for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
+	    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	if (pkgPtr->version != NULL) {
+	    ckfree(pkgPtr->version);
+	}
+	while (pkgPtr->availPtr != NULL) {
+	    availPtr = pkgPtr->availPtr;
+	    pkgPtr->availPtr = availPtr->nextPtr;
+	    ckfree(availPtr->version);
+	    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+	    ckfree((char *) availPtr);
+	}
+	ckfree((char *) pkgPtr);
+    }
+    Tcl_DeleteHashTable(&iPtr->packageTable);
+    if (iPtr->packageUnknown != NULL) {
+	ckfree(iPtr->packageUnknown);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckVersion --
+ *
+ *	This procedure checks to see whether a version number has
+ *	valid syntax.
+ *
+ * Results:
+ *	If string is a properly formed version number the TCL_OK
+ *	is returned.  Otherwise TCL_ERROR is returned and an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckVersion(interp, string)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* Supposedly a version number, which is
+				 * groups of decimal digits separated
+				 * by dots. */
+{
+    char *p = string;
+
+    if (!isdigit(UCHAR(*p))) {
+	goto error;
+    }
+    for (p++; *p != 0; p++) {
+	if (!isdigit(UCHAR(*p)) && (*p != '.')) {
+	    goto error;
+	}
+    }
+    if (p[-1] != '.') {
+	return TCL_OK;
+    }
+
+    error:
+    Tcl_AppendResult(interp, "expected version number but got \"",
+	    string, "\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComparePkgVersions --
+ *
+ *	This procedure compares two version numbers.
+ *
+ * Results:
+ *	The return value is -1 if v1 is less than v2, 0 if the two
+ *	version numbers are the same, and 1 if v1 is greater than v2.
+ *	If *satPtr is non-NULL, the word it points to is filled in
+ *	with 1 if v2 >= v1 and both numbers have the same major number
+ *	or 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComparePkgVersions(v1, v2, satPtr)
+    char *v1, *v2;		/* Versions strings, of form 2.1.3 (any
+				 * number of version numbers). */
+    int *satPtr;		/* If non-null, the word pointed to is
+				 * filled in with a 0/1 value.  1 means
+				 * v1 "satisfies" v2:  v1 is greater than
+				 * or equal to v2 and both version numbers
+				 * have the same major number. */
+{
+    int thisIsMajor, n1, n2;
+
+    /*
+     * Each iteration of the following loop processes one number from
+     * each string, terminated by a ".".  If those numbers don't match
+     * then the comparison is over;  otherwise, we loop back for the
+     * next number.
+     */
+
+    thisIsMajor = 1;
+    while (1) {
+	/*
+	 * Parse one decimal number from the front of each string.
+	 */
+
+	n1 = n2 = 0;
+	while ((*v1 != 0) && (*v1 != '.')) {
+	    n1 = 10*n1 + (*v1 - '0');
+	    v1++;
+	}
+	while ((*v2 != 0) && (*v2 != '.')) {
+	    n2 = 10*n2 + (*v2 - '0');
+	    v2++;
+	}
+
+	/*
+	 * Compare and go on to the next version number if the
+	 * current numbers match.
+	 */
+
+	if (n1 != n2) {
+	    break;
+	}
+	if (*v1 != 0) {
+	    v1++;
+	} else if (*v2 == 0) {
+	    break;
+	}
+	if (*v2 != 0) {
+	    v2++;
+	}
+	thisIsMajor = 0;
+    }
+    if (satPtr != NULL) {
+	*satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor);
+    }
+    if (n1 > n2) {
+	return 1;
+    } else if (n1 == n2) {
+	return 0;
+    } else {
+	return -1;
+    }
+}
diff --git a/tcl/generic/tclPort.h b/tcl/generic/tclPort.h
new file mode 100644
index 00000000000..d6620dc1b69
--- /dev/null
+++ b/tcl/generic/tclPort.h
@@ -0,0 +1,33 @@
+/*
+ * tclPort.h --
+ *
+ *	This header file handles porting issues that occur because
+ *	of differences between systems.  It reads in platform specific
+ *	portability files.
+ *
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLPORT
+#define _TCLPORT
+
+#if defined(__CYGWIN__) && defined(__TCL_UNIX_VARIANT)
+#	include "../unix/tclUnixPort.h"
+#else
+#if defined(__WIN32__) || defined(_WIN32)
+#   include "../win/tclWinPort.h"
+#else
+#   if defined(MAC_TCL)
+#	include "tclMacPort.h"
+#    else
+#	include "../unix/tclUnixPort.h"
+#    endif
+#endif
+#endif
+
+#endif /* _TCLPORT */
diff --git a/tcl/generic/tclPosixStr.c b/tcl/generic/tclPosixStr.c
new file mode 100644
index 00000000000..d2649b56c2c
--- /dev/null
+++ b/tcl/generic/tclPosixStr.c
@@ -0,0 +1,1174 @@
+/* 
+ * tclPosixStr.c --
+ *
+ *	This file contains procedures that generate strings
+ *	corresponding to various POSIX-related codes, such
+ *	as errno and signals.
+ *
+ * Copyright (c) 1991-1994 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ErrnoId --
+ *
+ *	Return a textual identifier for the current errno value.
+ *
+ * Results:
+ *	This procedure returns a machine-readable textual identifier
+ *	that corresponds to the current errno value (e.g. "EPERM").
+ *	The identifier is the same as the #define name in errno.h.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ErrnoId()
+{
+    switch (errno) {
+#ifdef E2BIG
+	case E2BIG: return "E2BIG";
+#endif
+#ifdef EACCES
+	case EACCES: return "EACCES";
+#endif
+#ifdef EADDRINUSE
+	case EADDRINUSE: return "EADDRINUSE";
+#endif
+#ifdef EADDRNOTAVAIL
+	case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
+#endif
+#ifdef EADV
+	case EADV: return "EADV";
+#endif
+#ifdef EAFNOSUPPORT
+	case EAFNOSUPPORT: return "EAFNOSUPPORT";
+#endif
+#ifdef EAGAIN
+	case EAGAIN: return "EAGAIN";
+#endif
+#ifdef EALIGN
+	case EALIGN: return "EALIGN";
+#endif
+#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
+	case EALREADY: return "EALREADY";
+#endif
+#ifdef EBADE
+	case EBADE: return "EBADE";
+#endif
+#ifdef EBADF
+	case EBADF: return "EBADF";
+#endif
+#ifdef EBADFD
+	case EBADFD: return "EBADFD";
+#endif
+#ifdef EBADMSG
+	case EBADMSG: return "EBADMSG";
+#endif
+#ifdef EBADR
+	case EBADR: return "EBADR";
+#endif
+#ifdef EBADRPC
+	case EBADRPC: return "EBADRPC";
+#endif
+#ifdef EBADRQC
+	case EBADRQC: return "EBADRQC";
+#endif
+#ifdef EBADSLT
+	case EBADSLT: return "EBADSLT";
+#endif
+#ifdef EBFONT
+	case EBFONT: return "EBFONT";
+#endif
+#ifdef EBUSY
+	case EBUSY: return "EBUSY";
+#endif
+#ifdef ECHILD
+	case ECHILD: return "ECHILD";
+#endif
+#ifdef ECHRNG
+	case ECHRNG: return "ECHRNG";
+#endif
+#ifdef ECOMM
+	case ECOMM: return "ECOMM";
+#endif
+#ifdef ECONNABORTED
+	case ECONNABORTED: return "ECONNABORTED";
+#endif
+#ifdef ECONNREFUSED
+	case ECONNREFUSED: return "ECONNREFUSED";
+#endif
+#ifdef ECONNRESET
+	case ECONNRESET: return "ECONNRESET";
+#endif
+#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
+	case EDEADLK: return "EDEADLK";
+#endif
+#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
+	case EDEADLOCK: return "EDEADLOCK";
+#endif
+#ifdef EDESTADDRREQ
+	case EDESTADDRREQ: return "EDESTADDRREQ";
+#endif
+#ifdef EDIRTY
+	case EDIRTY: return "EDIRTY";
+#endif
+#ifdef EDOM
+	case EDOM: return "EDOM";
+#endif
+#ifdef EDOTDOT
+	case EDOTDOT: return "EDOTDOT";
+#endif
+#ifdef EDQUOT
+	case EDQUOT: return "EDQUOT";
+#endif
+#ifdef EDUPPKG
+	case EDUPPKG: return "EDUPPKG";
+#endif
+#ifdef EEXIST
+	case EEXIST: return "EEXIST";
+#endif
+#ifdef EFAULT
+	case EFAULT: return "EFAULT";
+#endif
+#ifdef EFBIG
+	case EFBIG: return "EFBIG";
+#endif
+#ifdef EHOSTDOWN
+	case EHOSTDOWN: return "EHOSTDOWN";
+#endif
+#ifdef EHOSTUNREACH
+	case EHOSTUNREACH: return "EHOSTUNREACH";
+#endif
+#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
+	case EIDRM: return "EIDRM";
+#endif
+#ifdef EINIT
+	case EINIT: return "EINIT";
+#endif
+#ifdef EINPROGRESS
+	case EINPROGRESS: return "EINPROGRESS";
+#endif
+#ifdef EINTR
+	case EINTR: return "EINTR";
+#endif
+#ifdef EINVAL
+	case EINVAL: return "EINVAL";
+#endif
+#ifdef EIO
+	case EIO: return "EIO";
+#endif
+#ifdef EISCONN
+	case EISCONN: return "EISCONN";
+#endif
+#ifdef EISDIR
+	case EISDIR: return "EISDIR";
+#endif
+#ifdef EISNAME
+	case EISNAM: return "EISNAM";
+#endif
+#ifdef ELBIN
+	case ELBIN: return "ELBIN";
+#endif
+#ifdef EL2HLT
+	case EL2HLT: return "EL2HLT";
+#endif
+#ifdef EL2NSYNC
+	case EL2NSYNC: return "EL2NSYNC";
+#endif
+#ifdef EL3HLT
+	case EL3HLT: return "EL3HLT";
+#endif
+#ifdef EL3RST
+	case EL3RST: return "EL3RST";
+#endif
+#ifdef ELIBACC
+	case ELIBACC: return "ELIBACC";
+#endif
+#ifdef ELIBBAD
+	case ELIBBAD: return "ELIBBAD";
+#endif
+#ifdef ELIBEXEC
+	case ELIBEXEC: return "ELIBEXEC";
+#endif
+#ifdef ELIBMAX
+	case ELIBMAX: return "ELIBMAX";
+#endif
+#ifdef ELIBSCN
+	case ELIBSCN: return "ELIBSCN";
+#endif
+#ifdef ELNRNG
+	case ELNRNG: return "ELNRNG";
+#endif
+#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
+	case ELOOP: return "ELOOP";
+#endif
+#ifdef EMFILE
+	case EMFILE: return "EMFILE";
+#endif
+#ifdef EMLINK
+	case EMLINK: return "EMLINK";
+#endif
+#ifdef EMSGSIZE
+	case EMSGSIZE: return "EMSGSIZE";
+#endif
+#ifdef EMULTIHOP
+	case EMULTIHOP: return "EMULTIHOP";
+#endif
+#ifdef ENAMETOOLONG
+	case ENAMETOOLONG: return "ENAMETOOLONG";
+#endif
+#ifdef ENAVAIL
+	case ENAVAIL: return "ENAVAIL";
+#endif
+#ifdef ENET
+	case ENET: return "ENET";
+#endif
+#ifdef ENETDOWN
+	case ENETDOWN: return "ENETDOWN";
+#endif
+#ifdef ENETRESET
+	case ENETRESET: return "ENETRESET";
+#endif
+#ifdef ENETUNREACH
+	case ENETUNREACH: return "ENETUNREACH";
+#endif
+#ifdef ENFILE
+	case ENFILE: return "ENFILE";
+#endif
+#ifdef ENOANO
+	case ENOANO: return "ENOANO";
+#endif
+#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
+	case ENOBUFS: return "ENOBUFS";
+#endif
+#ifdef ENOCSI
+	case ENOCSI: return "ENOCSI";
+#endif
+#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
+	case ENODATA: return "ENODATA";
+#endif
+#ifdef ENODEV
+	case ENODEV: return "ENODEV";
+#endif
+#ifdef ENOENT
+	case ENOENT: return "ENOENT";
+#endif
+#ifdef ENOEXEC
+	case ENOEXEC: return "ENOEXEC";
+#endif
+#ifdef ENOLCK
+	case ENOLCK: return "ENOLCK";
+#endif
+#ifdef ENOLINK
+	case ENOLINK: return "ENOLINK";
+#endif
+#ifdef ENOMEM
+	case ENOMEM: return "ENOMEM";
+#endif
+#ifdef ENOMSG
+	case ENOMSG: return "ENOMSG";
+#endif
+#ifdef ENONET
+	case ENONET: return "ENONET";
+#endif
+#ifdef ENOPKG
+	case ENOPKG: return "ENOPKG";
+#endif
+#ifdef ENOPROTOOPT
+	case ENOPROTOOPT: return "ENOPROTOOPT";
+#endif
+#ifdef ENOSPC
+	case ENOSPC: return "ENOSPC";
+#endif
+#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
+	case ENOSR: return "ENOSR";
+#endif
+#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
+	case ENOSTR: return "ENOSTR";
+#endif
+#ifdef ENOSYM
+	case ENOSYM: return "ENOSYM";
+#endif
+#ifdef ENOSYS
+	case ENOSYS: return "ENOSYS";
+#endif
+#ifdef ENOTBLK
+	case ENOTBLK: return "ENOTBLK";
+#endif
+#ifdef ENOTCONN
+	case ENOTCONN: return "ENOTCONN";
+#endif
+#ifdef ENOTDIR
+	case ENOTDIR: return "ENOTDIR";
+#endif
+#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
+	case ENOTEMPTY: return "ENOTEMPTY";
+#endif
+#ifdef ENOTNAM
+	case ENOTNAM: return "ENOTNAM";
+#endif
+#ifdef ENOTSOCK
+	case ENOTSOCK: return "ENOTSOCK";
+#endif
+#ifdef ENOTSUP
+	case ENOTSUP: return "ENOTSUP";
+#endif
+#ifdef ENOTTY
+	case ENOTTY: return "ENOTTY";
+#endif
+#ifdef ENOTUNIQ
+	case ENOTUNIQ: return "ENOTUNIQ";
+#endif
+#ifdef ENXIO
+	case ENXIO: return "ENXIO";
+#endif
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (EOPNOTSUPP != ENOTSUP))
+	case EOPNOTSUPP: return "EOPNOTSUPP";
+#endif
+#ifdef EPERM
+	case EPERM: return "EPERM";
+#endif
+#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
+	case EPFNOSUPPORT: return "EPFNOSUPPORT";
+#endif
+#ifdef EPIPE
+	case EPIPE: return "EPIPE";
+#endif
+#ifdef EPROCLIM
+	case EPROCLIM: return "EPROCLIM";
+#endif
+#ifdef EPROCUNAVAIL
+	case EPROCUNAVAIL: return "EPROCUNAVAIL";
+#endif
+#ifdef EPROGMISMATCH
+	case EPROGMISMATCH: return "EPROGMISMATCH";
+#endif
+#ifdef EPROGUNAVAIL
+	case EPROGUNAVAIL: return "EPROGUNAVAIL";
+#endif
+#ifdef EPROTO
+	case EPROTO: return "EPROTO";
+#endif
+#ifdef EPROTONOSUPPORT
+	case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
+#endif
+#ifdef EPROTOTYPE
+	case EPROTOTYPE: return "EPROTOTYPE";
+#endif
+#ifdef ERANGE
+	case ERANGE: return "ERANGE";
+#endif
+#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
+	case EREFUSED: return "EREFUSED";
+#endif
+#ifdef EREMCHG
+	case EREMCHG: return "EREMCHG";
+#endif
+#ifdef EREMDEV
+	case EREMDEV: return "EREMDEV";
+#endif
+#ifdef EREMOTE
+	case EREMOTE: return "EREMOTE";
+#endif
+#ifdef EREMOTEIO
+	case EREMOTEIO: return "EREMOTEIO";
+#endif
+#ifdef EREMOTERELEASE
+	case EREMOTERELEASE: return "EREMOTERELEASE";
+#endif
+#ifdef EROFS
+	case EROFS: return "EROFS";
+#endif
+#ifdef ERPCMISMATCH
+	case ERPCMISMATCH: return "ERPCMISMATCH";
+#endif
+#ifdef ERREMOTE
+	case ERREMOTE: return "ERREMOTE";
+#endif
+#ifdef ESHUTDOWN
+	case ESHUTDOWN: return "ESHUTDOWN";
+#endif
+#ifdef ESOCKTNOSUPPORT
+	case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
+#endif
+#ifdef ESPIPE
+	case ESPIPE: return "ESPIPE";
+#endif
+#ifdef ESRCH
+	case ESRCH: return "ESRCH";
+#endif
+#ifdef ESRMNT
+	case ESRMNT: return "ESRMNT";
+#endif
+#ifdef ESTALE
+	case ESTALE: return "ESTALE";
+#endif
+#ifdef ESUCCESS
+	case ESUCCESS: return "ESUCCESS";
+#endif
+#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
+	case ETIME: return "ETIME";
+#endif
+#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
+	case ETIMEDOUT: return "ETIMEDOUT";
+#endif
+#ifdef ETOOMANYREFS
+	case ETOOMANYREFS: return "ETOOMANYREFS";
+#endif
+#ifdef ETXTBSY
+	case ETXTBSY: return "ETXTBSY";
+#endif
+#ifdef EUCLEAN
+	case EUCLEAN: return "EUCLEAN";
+#endif
+#ifdef EUNATCH
+	case EUNATCH: return "EUNATCH";
+#endif
+#ifdef EUSERS
+	case EUSERS: return "EUSERS";
+#endif
+#ifdef EVERSION
+	case EVERSION: return "EVERSION";
+#endif
+#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
+	case EWOULDBLOCK: return "EWOULDBLOCK";
+#endif
+#ifdef EXDEV
+	case EXDEV: return "EXDEV";
+#endif
+#ifdef EXFULL
+	case EXFULL: return "EXFULL";
+#endif
+    }
+    return "unknown error";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ErrnoMsg --
+ *
+ *	Return a human-readable message corresponding to a given
+ *	errno value.
+ *
+ * Results:
+ *	The return value is the standard POSIX error message for
+ *	errno.  This procedure is used instead of strerror because
+ *	strerror returns slightly different values on different
+ *	machines (e.g. different capitalizations), which cause
+ *	problems for things such as regression tests.  This procedure
+ *	provides messages for most standard errors, then it calls
+ *	strerror for things it doesn't understand.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ErrnoMsg(err)
+    int err;			/* Error number (such as in errno variable). */
+{
+    switch (err) {
+#ifdef E2BIG
+	case E2BIG: return "argument list too long";
+#endif
+#ifdef EACCES
+	case EACCES: return "permission denied";
+#endif
+#ifdef EADDRINUSE
+	case EADDRINUSE: return "address already in use";
+#endif
+#ifdef EADDRNOTAVAIL
+	case EADDRNOTAVAIL: return "can't assign requested address";
+#endif
+#ifdef EADV
+	case EADV: return "advertise error";
+#endif
+#ifdef EAFNOSUPPORT
+	case EAFNOSUPPORT: return "address family not supported by protocol family";
+#endif
+#ifdef EAGAIN
+	case EAGAIN: return "resource temporarily unavailable";
+#endif
+#ifdef EALIGN
+	case EALIGN: return "EALIGN";
+#endif
+#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
+	case EALREADY: return "operation already in progress";
+#endif
+#ifdef EBADE
+	case EBADE: return "bad exchange descriptor";
+#endif
+#ifdef EBADF
+	case EBADF: return "bad file number";
+#endif
+#ifdef EBADFD
+	case EBADFD: return "file descriptor in bad state";
+#endif
+#ifdef EBADMSG
+	case EBADMSG: return "not a data message";
+#endif
+#ifdef EBADR
+	case EBADR: return "bad request descriptor";
+#endif
+#ifdef EBADRPC
+	case EBADRPC: return "RPC structure is bad";
+#endif
+#ifdef EBADRQC
+	case EBADRQC: return "bad request code";
+#endif
+#ifdef EBADSLT
+	case EBADSLT: return "invalid slot";
+#endif
+#ifdef EBFONT
+	case EBFONT: return "bad font file format";
+#endif
+#ifdef EBUSY
+	case EBUSY: return "file busy";
+#endif
+#ifdef ECHILD
+	case ECHILD: return "no children";
+#endif
+#ifdef ECHRNG
+	case ECHRNG: return "channel number out of range";
+#endif
+#ifdef ECOMM
+	case ECOMM: return "communication error on send";
+#endif
+#ifdef ECONNABORTED
+	case ECONNABORTED: return "software caused connection abort";
+#endif
+#ifdef ECONNREFUSED
+	case ECONNREFUSED: return "connection refused";
+#endif
+#ifdef ECONNRESET
+	case ECONNRESET: return "connection reset by peer";
+#endif
+#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
+	case EDEADLK: return "resource deadlock avoided";
+#endif
+#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
+	case EDEADLOCK: return "resource deadlock avoided";
+#endif
+#ifdef EDESTADDRREQ
+	case EDESTADDRREQ: return "destination address required";
+#endif
+#ifdef EDIRTY
+	case EDIRTY: return "mounting a dirty fs w/o force";
+#endif
+#ifdef EDOM
+	case EDOM: return "math argument out of range";
+#endif
+#ifdef EDOTDOT
+	case EDOTDOT: return "cross mount point";
+#endif
+#ifdef EDQUOT
+	case EDQUOT: return "disk quota exceeded";
+#endif
+#ifdef EDUPPKG
+	case EDUPPKG: return "duplicate package name";
+#endif
+#ifdef EEXIST
+	case EEXIST: return "file already exists";
+#endif
+#ifdef EFAULT
+	case EFAULT: return "bad address in system call argument";
+#endif
+#ifdef EFBIG
+	case EFBIG: return "file too large";
+#endif
+#ifdef EHOSTDOWN
+	case EHOSTDOWN: return "host is down";
+#endif
+#ifdef EHOSTUNREACH
+	case EHOSTUNREACH: return "host is unreachable";
+#endif
+#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
+	case EIDRM: return "identifier removed";
+#endif
+#ifdef EINIT
+	case EINIT: return "initialization error";
+#endif
+#ifdef EINPROGRESS
+	case EINPROGRESS: return "operation now in progress";
+#endif
+#ifdef EINTR
+	case EINTR: return "interrupted system call";
+#endif
+#ifdef EINVAL
+	case EINVAL: return "invalid argument";
+#endif
+#ifdef EIO
+	case EIO: return "I/O error";
+#endif
+#ifdef EISCONN
+	case EISCONN: return "socket is already connected";
+#endif
+#ifdef EISDIR
+	case EISDIR: return "illegal operation on a directory";
+#endif
+#ifdef EISNAME
+	case EISNAM: return "is a name file";
+#endif
+#ifdef ELBIN
+	case ELBIN: return "ELBIN";
+#endif
+#ifdef EL2HLT
+	case EL2HLT: return "level 2 halted";
+#endif
+#ifdef EL2NSYNC
+	case EL2NSYNC: return "level 2 not synchronized";
+#endif
+#ifdef EL3HLT
+	case EL3HLT: return "level 3 halted";
+#endif
+#ifdef EL3RST
+	case EL3RST: return "level 3 reset";
+#endif
+#ifdef ELIBACC
+	case ELIBACC: return "can not access a needed shared library";
+#endif
+#ifdef ELIBBAD
+	case ELIBBAD: return "accessing a corrupted shared library";
+#endif
+#ifdef ELIBEXEC
+	case ELIBEXEC: return "can not exec a shared library directly";
+#endif
+#ifdef ELIBMAX
+	case ELIBMAX: return
+		"attempting to link in more shared libraries than system limit";
+#endif
+#ifdef ELIBSCN
+	case ELIBSCN: return ".lib section in a.out corrupted";
+#endif
+#ifdef ELNRNG
+	case ELNRNG: return "link number out of range";
+#endif
+#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
+	case ELOOP: return "too many levels of symbolic links";
+#endif
+#ifdef EMFILE
+	case EMFILE: return "too many open files";
+#endif
+#ifdef EMLINK
+	case EMLINK: return "too many links";
+#endif
+#ifdef EMSGSIZE
+	case EMSGSIZE: return "message too long";
+#endif
+#ifdef EMULTIHOP
+	case EMULTIHOP: return "multihop attempted";
+#endif
+#ifdef ENAMETOOLONG
+	case ENAMETOOLONG: return "file name too long";
+#endif
+#ifdef ENAVAIL
+	case ENAVAIL: return "not available";
+#endif
+#ifdef ENET
+	case ENET: return "ENET";
+#endif
+#ifdef ENETDOWN
+	case ENETDOWN: return "network is down";
+#endif
+#ifdef ENETRESET
+	case ENETRESET: return "network dropped connection on reset";
+#endif
+#ifdef ENETUNREACH
+	case ENETUNREACH: return "network is unreachable";
+#endif
+#ifdef ENFILE
+	case ENFILE: return "file table overflow";
+#endif
+#ifdef ENOANO
+	case ENOANO: return "anode table overflow";
+#endif
+#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
+	case ENOBUFS: return "no buffer space available";
+#endif
+#ifdef ENOCSI
+	case ENOCSI: return "no CSI structure available";
+#endif
+#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
+	case ENODATA: return "no data available";
+#endif
+#ifdef ENODEV
+	case ENODEV: return "no such device";
+#endif
+#ifdef ENOENT
+	case ENOENT: return "no such file or directory";
+#endif
+#ifdef ENOEXEC
+	case ENOEXEC: return "exec format error";
+#endif
+#ifdef ENOLCK
+	case ENOLCK: return "no locks available";
+#endif
+#ifdef ENOLINK
+	case ENOLINK: return "link has be severed";
+#endif
+#ifdef ENOMEM
+	case ENOMEM: return "not enough memory";
+#endif
+#ifdef ENOMSG
+	case ENOMSG: return "no message of desired type";
+#endif
+#ifdef ENONET
+	case ENONET: return "machine is not on the network";
+#endif
+#ifdef ENOPKG
+	case ENOPKG: return "package not installed";
+#endif
+#ifdef ENOPROTOOPT
+	case ENOPROTOOPT: return "bad proocol option";
+#endif
+#ifdef ENOSPC
+	case ENOSPC: return "no space left on device";
+#endif
+#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
+	case ENOSR: return "out of stream resources";
+#endif
+#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
+	case ENOSTR: return "not a stream device";
+#endif
+#ifdef ENOSYM
+	case ENOSYM: return "unresolved symbol name";
+#endif
+#ifdef ENOSYS
+	case ENOSYS: return "function not implemented";
+#endif
+#ifdef ENOTBLK
+	case ENOTBLK: return "block device required";
+#endif
+#ifdef ENOTCONN
+	case ENOTCONN: return "socket is not connected";
+#endif
+#ifdef ENOTDIR
+	case ENOTDIR: return "not a directory";
+#endif
+#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
+	case ENOTEMPTY: return "directory not empty";
+#endif
+#ifdef ENOTNAM
+	case ENOTNAM: return "not a name file";
+#endif
+#ifdef ENOTSOCK
+	case ENOTSOCK: return "socket operation on non-socket";
+#endif
+#ifdef ENOTSUP
+	case ENOTSUP: return "operation not supported";
+#endif
+#ifdef ENOTTY
+	case ENOTTY: return "inappropriate device for ioctl";
+#endif
+#ifdef ENOTUNIQ
+	case ENOTUNIQ: return "name not unique on network";
+#endif
+#ifdef ENXIO
+	case ENXIO: return "no such device or address";
+#endif
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (EOPNOTSUPP != ENOTSUP))
+	case EOPNOTSUPP: return "operation not supported on socket";
+#endif
+#ifdef EPERM
+	case EPERM: return "not owner";
+#endif
+#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
+	case EPFNOSUPPORT: return "protocol family not supported";
+#endif
+#ifdef EPIPE
+	case EPIPE: return "broken pipe";
+#endif
+#ifdef EPROCLIM
+	case EPROCLIM: return "too many processes";
+#endif
+#ifdef EPROCUNAVAIL
+	case EPROCUNAVAIL: return "bad procedure for program";
+#endif
+#ifdef EPROGMISMATCH
+	case EPROGMISMATCH: return "program version wrong";
+#endif
+#ifdef EPROGUNAVAIL
+	case EPROGUNAVAIL: return "RPC program not available";
+#endif
+#ifdef EPROTO
+	case EPROTO: return "protocol error";
+#endif
+#ifdef EPROTONOSUPPORT
+	case EPROTONOSUPPORT: return "protocol not suppored";
+#endif
+#ifdef EPROTOTYPE
+	case EPROTOTYPE: return "protocol wrong type for socket";
+#endif
+#ifdef ERANGE
+	case ERANGE: return "math result unrepresentable";
+#endif
+#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
+	case EREFUSED: return "EREFUSED";
+#endif
+#ifdef EREMCHG
+	case EREMCHG: return "remote address changed";
+#endif
+#ifdef EREMDEV
+	case EREMDEV: return "remote device";
+#endif
+#ifdef EREMOTE
+	case EREMOTE: return "pathname hit remote file system";
+#endif
+#ifdef EREMOTEIO
+	case EREMOTEIO: return "remote i/o error";
+#endif
+#ifdef EREMOTERELEASE
+	case EREMOTERELEASE: return "EREMOTERELEASE";
+#endif
+#ifdef EROFS
+	case EROFS: return "read-only file system";
+#endif
+#ifdef ERPCMISMATCH
+	case ERPCMISMATCH: return "RPC version is wrong";
+#endif
+#ifdef ERREMOTE
+	case ERREMOTE: return "object is remote";
+#endif
+#ifdef ESHUTDOWN
+	case ESHUTDOWN: return "can't send afer socket shutdown";
+#endif
+#ifdef ESOCKTNOSUPPORT
+	case ESOCKTNOSUPPORT: return "socket type not supported";
+#endif
+#ifdef ESPIPE
+	case ESPIPE: return "invalid seek";
+#endif
+#ifdef ESRCH
+	case ESRCH: return "no such process";
+#endif
+#ifdef ESRMNT
+	case ESRMNT: return "srmount error";
+#endif
+#ifdef ESTALE
+	case ESTALE: return "stale remote file handle";
+#endif
+#ifdef ESUCCESS
+	case ESUCCESS: return "Error 0";
+#endif
+#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
+	case ETIME: return "timer expired";
+#endif
+#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
+	case ETIMEDOUT: return "connection timed out";
+#endif
+#ifdef ETOOMANYREFS
+	case ETOOMANYREFS: return "too many references: can't splice";
+#endif
+#ifdef ETXTBSY
+	case ETXTBSY: return "text file or pseudo-device busy";
+#endif
+#ifdef EUCLEAN
+	case EUCLEAN: return "structure needs cleaning";
+#endif
+#ifdef EUNATCH
+	case EUNATCH: return "protocol driver not attached";
+#endif
+#ifdef EUSERS
+	case EUSERS: return "too many users";
+#endif
+#ifdef EVERSION
+	case EVERSION: return "version mismatch";
+#endif
+#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
+	case EWOULDBLOCK: return "operation would block";
+#endif
+#ifdef EXDEV
+	case EXDEV: return "cross-domain link";
+#endif
+#ifdef EXFULL
+	case EXFULL: return "message tables full";
+#endif
+	default:
+#ifdef NO_STRERROR
+	    return "unknown POSIX error";
+#else
+	    return strerror(errno);
+#endif
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SignalId --
+ *
+ *	Return a textual identifier for a signal number.
+ *
+ * Results:
+ *	This procedure returns a machine-readable textual identifier
+ *	that corresponds to sig.  The identifier is the same as the
+ *	#define name in signal.h.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SignalId(sig)
+    int sig;			/* Number of signal. */
+{
+    switch (sig) {
+#ifdef SIGABRT
+	case SIGABRT: return "SIGABRT";
+#endif
+#ifdef SIGALRM
+	case SIGALRM: return "SIGALRM";
+#endif
+#ifdef SIGBUS
+	case SIGBUS: return "SIGBUS";
+#endif
+#ifdef SIGCHLD
+	case SIGCHLD: return "SIGCHLD";
+#endif
+#if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
+	case SIGCLD: return "SIGCLD";
+#endif
+#ifdef SIGCONT
+	case SIGCONT: return "SIGCONT";
+#endif
+#if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
+	case SIGEMT: return "SIGEMT";
+#endif
+#ifdef SIGFPE
+	case SIGFPE: return "SIGFPE";
+#endif
+#ifdef SIGHUP
+	case SIGHUP: return "SIGHUP";
+#endif
+#ifdef SIGILL
+	case SIGILL: return "SIGILL";
+#endif
+#ifdef SIGINT
+	case SIGINT: return "SIGINT";
+#endif
+#ifdef SIGIO
+	case SIGIO: return "SIGIO";
+#endif
+#if defined(SIGIOT) && (!defined(SIGABRT) || (SIGIOT != SIGABRT))
+	case SIGIOT: return "SIGIOT";
+#endif
+#ifdef SIGKILL
+	case SIGKILL: return "SIGKILL";
+#endif
+#if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
+	case SIGLOST: return "SIGLOST";
+#endif
+#ifdef SIGPIPE
+	case SIGPIPE: return "SIGPIPE";
+#endif
+#if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
+	case SIGPOLL: return "SIGPOLL";
+#endif
+#ifdef SIGPROF
+	case SIGPROF: return "SIGPROF";
+#endif
+#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ))
+	case SIGPWR: return "SIGPWR";
+#endif
+#ifdef SIGQUIT
+	case SIGQUIT: return "SIGQUIT";
+#endif
+#ifdef SIGSEGV
+	case SIGSEGV: return "SIGSEGV";
+#endif
+#ifdef SIGSTOP
+	case SIGSTOP: return "SIGSTOP";
+#endif
+#ifdef SIGSYS
+	case SIGSYS: return "SIGSYS";
+#endif
+#ifdef SIGTERM
+	case SIGTERM: return "SIGTERM";
+#endif
+#ifdef SIGTRAP
+	case SIGTRAP: return "SIGTRAP";
+#endif
+#ifdef SIGTSTP
+	case SIGTSTP: return "SIGTSTP";
+#endif
+#ifdef SIGTTIN
+	case SIGTTIN: return "SIGTTIN";
+#endif
+#ifdef SIGTTOU
+	case SIGTTOU: return "SIGTTOU";
+#endif
+#if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
+	case SIGURG: return "SIGURG";
+#endif
+#if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
+	case SIGUSR1: return "SIGUSR1";
+#endif
+#if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
+	case SIGUSR2: return "SIGUSR2";
+#endif
+#ifdef SIGVTALRM
+	case SIGVTALRM: return "SIGVTALRM";
+#endif
+#ifdef SIGWINCH
+	case SIGWINCH: return "SIGWINCH";
+#endif
+#ifdef SIGXCPU
+	case SIGXCPU: return "SIGXCPU";
+#endif
+#ifdef SIGXFSZ
+	case SIGXFSZ: return "SIGXFSZ";
+#endif
+    }
+    return "unknown signal";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SignalMsg --
+ *
+ *	Return a human-readable message describing a signal.
+ *
+ * Results:
+ *	This procedure returns a string describing sig that should
+ *	make sense to a human.  It may not be easy for a machine
+ *	to parse.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SignalMsg(sig)
+    int sig;			/* Number of signal. */
+{
+    switch (sig) {
+#ifdef SIGABRT
+	case SIGABRT: return "SIGABRT";
+#endif
+#ifdef SIGALRM
+	case SIGALRM: return "alarm clock";
+#endif
+#ifdef SIGBUS
+	case SIGBUS: return "bus error";
+#endif
+#ifdef SIGCHLD
+	case SIGCHLD: return "child status changed";
+#endif
+#if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
+	case SIGCLD: return "child status changed";
+#endif
+#ifdef SIGCONT
+	case SIGCONT: return "continue after stop";
+#endif
+#if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
+	case SIGEMT: return "EMT instruction";
+#endif
+#ifdef SIGFPE
+	case SIGFPE: return "floating-point exception";
+#endif
+#ifdef SIGHUP
+	case SIGHUP: return "hangup";
+#endif
+#ifdef SIGILL
+	case SIGILL: return "illegal instruction";
+#endif
+#ifdef SIGINT
+	case SIGINT: return "interrupt";
+#endif
+#ifdef SIGIO
+	case SIGIO: return "input/output possible on file";
+#endif
+#if defined(SIGIOT) && (!defined(SIGABRT) || (SIGABRT != SIGIOT))
+	case SIGIOT: return "IOT instruction";
+#endif
+#ifdef SIGKILL
+	case SIGKILL: return "kill signal";
+#endif
+#if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
+	case SIGLOST: return "resource lost";
+#endif
+#ifdef SIGPIPE
+	case SIGPIPE: return "write on pipe with no readers";
+#endif
+#if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
+	case SIGPOLL: return "input/output possible on file";
+#endif
+#ifdef SIGPROF
+	case SIGPROF: return "profiling alarm";
+#endif
+#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ))
+	case SIGPWR: return "power-fail restart";
+#endif
+#ifdef SIGQUIT
+	case SIGQUIT: return "quit signal";
+#endif
+#ifdef SIGSEGV
+	case SIGSEGV: return "segmentation violation";
+#endif
+#ifdef SIGSTOP
+	case SIGSTOP: return "stop";
+#endif
+#ifdef SIGSYS
+	case SIGSYS: return "bad argument to system call";
+#endif
+#ifdef SIGTERM
+	case SIGTERM: return "software termination signal";
+#endif
+#ifdef SIGTRAP
+	case SIGTRAP: return "trace trap";
+#endif
+#ifdef SIGTSTP
+	case SIGTSTP: return "stop signal from tty";
+#endif
+#ifdef SIGTTIN
+	case SIGTTIN: return "background tty read";
+#endif
+#ifdef SIGTTOU
+	case SIGTTOU: return "background tty write";
+#endif
+#if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
+	case SIGURG: return "urgent I/O condition";
+#endif
+#if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
+	case SIGUSR1: return "user-defined signal 1";
+#endif
+#if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
+	case SIGUSR2: return "user-defined signal 2";
+#endif
+#ifdef SIGVTALRM
+	case SIGVTALRM: return "virtual time alarm";
+#endif
+#ifdef SIGWINCH
+	case SIGWINCH: return "window changed";
+#endif
+#ifdef SIGXCPU
+	case SIGXCPU: return "exceeded CPU time limit";
+#endif
+#ifdef SIGXFSZ
+	case SIGXFSZ: return "exceeded file size limit";
+#endif
+    }
+    return "unknown signal";
+}
diff --git a/tcl/generic/tclPreserve.c b/tcl/generic/tclPreserve.c
new file mode 100644
index 00000000000..0f813eb7b19
--- /dev/null
+++ b/tcl/generic/tclPreserve.c
@@ -0,0 +1,277 @@
+/* 
+ * tclPreserve.c --
+ *
+ *	This file contains a collection of procedures that are used
+ *	to make sure that widget records and other data structures
+ *	aren't reallocated when there are nested procedures that
+ *	depend on their existence.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * The following data structure is used to keep track of all the
+ * Tcl_Preserve calls that are still in effect.  It grows as needed
+ * to accommodate any number of calls in effect.
+ */
+
+typedef struct {
+    ClientData clientData;	/* Address of preserved block. */
+    int refCount;		/* Number of Tcl_Preserve calls in effect
+				 * for block. */
+    int mustFree;		/* Non-zero means Tcl_EventuallyFree was
+				 * called while a Tcl_Preserve call was in
+				 * effect, so the structure must be freed
+				 * when refCount becomes zero. */
+    Tcl_FreeProc *freeProc;	/* Procedure to call to free. */
+} Reference;
+
+static Reference *refArray;	/* First in array of references. */
+static int spaceAvl = 0;	/* Total number of structures available
+				 * at *firstRefPtr. */
+static int inUse = 0;		/* Count of structures currently in use
+				 * in refArray. */
+#define INITIAL_SIZE 2
+
+/*
+ * Static routines in this file:
+ */
+
+static void	PreserveExitProc _ANSI_ARGS_((ClientData clientData));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PreserveExitProc --
+ *
+ *	Called during exit processing to clean up the reference array.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees the storage of the reference array.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+PreserveExitProc(clientData)
+    ClientData clientData;		/* NULL -Unused. */
+{
+    if (spaceAvl != 0) {
+        ckfree((char *) refArray);
+        refArray = (Reference *) NULL;
+        inUse = 0;
+        spaceAvl = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Preserve --
+ *
+ *	This procedure is used by a procedure to declare its interest
+ *	in a particular block of memory, so that the block will not be
+ *	reallocated until a matching call to Tcl_Release has been made.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Information is retained so that the block of memory will
+ *	not be freed until at least the matching call to Tcl_Release.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Preserve(clientData)
+    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+{
+    Reference *refPtr;
+    int i;
+
+    /*
+     * See if there is already a reference for this pointer.  If so,
+     * just increment its reference count.
+     */
+
+    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
+	if (refPtr->clientData == clientData) {
+	    refPtr->refCount++;
+	    return;
+	}
+    }
+
+    /*
+     * Make a reference array if it doesn't already exist, or make it
+     * bigger if it is full.
+     */
+
+    if (inUse == spaceAvl) {
+	if (spaceAvl == 0) {
+            Tcl_CreateExitHandler((Tcl_ExitProc *) PreserveExitProc,
+                    (ClientData) NULL);
+	    refArray = (Reference *) ckalloc((unsigned)
+		    (INITIAL_SIZE*sizeof(Reference)));
+	    spaceAvl = INITIAL_SIZE;
+	} else {
+	    Reference *new;
+
+	    new = (Reference *) ckalloc((unsigned)
+		    (2*spaceAvl*sizeof(Reference)));
+	    memcpy((VOID *) new, (VOID *) refArray,
+                    spaceAvl*sizeof(Reference));
+	    ckfree((char *) refArray);
+	    refArray = new;
+	    spaceAvl *= 2;
+	}
+    }
+
+    /*
+     * Make a new entry for the new reference.
+     */
+
+    refPtr = &refArray[inUse];
+    refPtr->clientData = clientData;
+    refPtr->refCount = 1;
+    refPtr->mustFree = 0;
+    refPtr->freeProc = TCL_STATIC;
+    inUse += 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Release --
+ *
+ *	This procedure is called to cancel a previous call to
+ *	Tcl_Preserve, thereby allowing a block of memory to be
+ *	freed (if no one else cares about it).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If Tcl_EventuallyFree has been called for clientData, and if
+ *	no other call to Tcl_Preserve is still in effect, the block of
+ *	memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Release(clientData)
+    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+{
+    Reference *refPtr;
+    int mustFree;
+    Tcl_FreeProc *freeProc;
+    int i;
+
+    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
+	if (refPtr->clientData != clientData) {
+	    continue;
+	}
+	refPtr->refCount--;
+	if (refPtr->refCount == 0) {
+
+            /*
+             * Must remove information from the slot before calling freeProc
+             * to avoid reentrancy problems if the freeProc calls Tcl_Preserve
+             * on the same clientData. Copy down the last reference in the
+             * array to overwrite the current slot.
+             */
+
+            freeProc = refPtr->freeProc;
+            mustFree = refPtr->mustFree;
+	    inUse--;
+	    if (i < inUse) {
+		refArray[i] = refArray[inUse];
+	    }
+	    if (mustFree) {
+		if ((freeProc == TCL_DYNAMIC) ||
+                        (freeProc == (Tcl_FreeProc *) free)) {
+		    ckfree((char *) clientData);
+		} else {
+		    (*freeProc)((char *) clientData);
+		}
+	    }
+	}
+	return;
+    }
+
+    /*
+     * Reference not found.  This is a bug in the caller.
+     */
+
+    panic("Tcl_Release couldn't find reference for 0x%x", clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EventuallyFree --
+ *
+ *	Free up a block of memory, unless a call to Tcl_Preserve is in
+ *	effect for that block.  In this case, defer the free until all
+ *	calls to Tcl_Preserve have been undone by matching calls to
+ *	Tcl_Release.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Ptr may be released by calling free().
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_EventuallyFree(clientData, freeProc)
+    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+    Tcl_FreeProc *freeProc;	/* Procedure to actually do free. */
+{
+    Reference *refPtr;
+    int i;
+
+    /*
+     * See if there is a reference for this pointer.  If so, set its
+     * "mustFree" flag (the flag had better not be set already!).
+     */
+
+    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
+	if (refPtr->clientData != clientData) {
+	    continue;
+	}
+	if (refPtr->mustFree) {
+	    panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
+        }
+        refPtr->mustFree = 1;
+	refPtr->freeProc = freeProc;
+        return;
+    }
+
+    /*
+     * No reference for this block.  Free it now.
+     */
+
+    if ((freeProc == TCL_DYNAMIC)
+	    || (freeProc == (Tcl_FreeProc *) free)) {
+	ckfree((char *) clientData);
+    } else {
+	(*freeProc)((char *)clientData);
+    }
+}
diff --git a/tcl/generic/tclProc.c b/tcl/generic/tclProc.c
new file mode 100644
index 00000000000..b956c9670fc
--- /dev/null
+++ b/tcl/generic/tclProc.c
@@ -0,0 +1,1528 @@
+/* 
+ * tclProc.c --
+ *
+ *	This file contains routines that implement Tcl procedures,
+ *	including the "proc" and "uplevel" commands.
+ *
+ * Copyright (c) 1987-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * Prototypes for static functions in this file
+ */
+
+static void	ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
+static void	ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int	ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+		Tcl_Obj *objPtr));
+static void	ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The ProcBodyObjType type
+ */
+
+Tcl_ObjType tclProcBodyType = {
+    "procbody",			/* name for this type */
+    ProcBodyFree,		/* FreeInternalRep procedure */
+    ProcBodyDup,		/* DupInternalRep procedure */
+    ProcBodyUpdateString,	/* UpdateString procedure */
+    ProcBodySetFromAny		/* SetFromAny procedure */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ProcObjCmd --
+ *
+ *	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 object result value.
+ *
+ * Side effects:
+ *	A new procedure gets created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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;
+    Proc *procPtr;
+    char *fullName, *procName;
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
+    Tcl_Command cmd;
+    Tcl_DString ds;
+    int result;
+
+    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;
+    }
+
+    /*
+     *  Create the data structure to represent the procedure.
+     */
+    if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
+        &procPtr) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    /*
+     * Now create a command for the procedure. This will initially 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), TclProcInterpProc,
+	    (ClientData) procPtr, TclProcDeleteProc);
+    cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
+	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
+
+    /*
+     * Now initialize the new procedure's cmdPtr field. This will be used
+     * later when the procedure is called to determine what namespace the
+     * procedure will run in. This will be different than the current
+     * namespace if the proc was renamed into a different namespace.
+     */
+    
+    procPtr->cmdPtr = (Command *) cmd;
+
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateProc --
+ *
+ *	Creates the data associated with a Tcl procedure definition.
+ *	This procedure knows how to handle two types of body objects:
+ *	strings and procbody. Strings are the traditional (and common) value
+ *	for bodies, procbody are values created by extensions that have
+ *	loaded a previously compiled script.
+ *
+ * Results:
+ *	Returns TCL_OK on success, along with a pointer to a Tcl
+ *	procedure definition in procPtrPtr.  This definition should
+ *	be freed by calling TclCleanupProc() when it is no longer
+ *	needed.  Returns TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If anything goes wrong, this procedure returns an error
+ *	message in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
+    Tcl_Interp *interp;         /* interpreter containing proc */
+    Namespace *nsPtr;           /* namespace containing this proc */
+    char *procName;             /* unqualified name of this proc */
+    Tcl_Obj *argsPtr;           /* description of arguments */
+    Tcl_Obj *bodyPtr;           /* command body */
+    Proc **procPtrPtr;          /* returns:  pointer to proc data */
+{
+    Interp *iPtr = (Interp*)interp;
+    char **argArray = NULL;
+
+    register Proc *procPtr;
+    int i, length, result, numArgs;
+    char *args, *bytes, *p;
+    register CompiledLocal *localPtr;
+    Tcl_Obj *defPtr;
+    int precompiled = 0;
+    
+    if (bodyPtr->typePtr == &tclProcBodyType) {
+        /*
+         * Because the body is a TclProProcBody, the actual body is already
+         * compiled, and it is not shared with anyone else, so it's OK not to
+         * unshare it (as a matter of fact, it is bad to unshare it, because
+         * there may be no source code).
+         *
+         * We don't create and initialize a Proc structure for the procedure;
+         * rather, we use what is in the body object. Note that
+         * we initialize its cmdPtr field below after we've created the command
+         * for the procedure. We increment the ref count of the Proc struct
+         * since the command (soon to be created) will be holding a reference
+         * to it.
+         */
+    
+        procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
+        procPtr->iPtr = iPtr;
+        procPtr->refCount++;
+        precompiled = 1;
+    } else {
+        /*
+         * 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.
+         */
+
+        if (Tcl_IsShared(bodyPtr)) {
+            bytes = Tcl_GetStringFromObj(bodyPtr, &length);
+            bodyPtr = Tcl_NewStringObj(bytes, length);
+        }
+
+        /*
+         * Create and initialize a Proc structure for the procedure. Note that
+         * we initialize its cmdPtr field below after we've created the command
+         * for the procedure. 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->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.
+     * If the body is precompiled, processing is limited to checking that
+     * the the parsed argument is consistent with the one stored in the
+     * Proc.
+     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
+     */
+
+    args = Tcl_GetStringFromObj(argsPtr, &length);
+    result = Tcl_SplitList(interp, args, &numArgs, &argArray);
+    if (result != TCL_OK) {
+        goto procError;
+    }
+
+    if (precompiled) {
+        if (numArgs > procPtr->numArgs) {
+            char buf[128];
+            sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
+                    numArgs, procPtr->numArgs);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "procedure \"", procName,
+                    buf, (char *) NULL);
+            goto procError;
+        }
+        localPtr = procPtr->firstLocalPtr;
+    } else {
+        procPtr->numArgs = numArgs;
+        procPtr->numCompiledLocals = numArgs;
+    }
+    for (i = 0;  i < numArgs;  i++) {
+        int fieldCount, nameLength, valueLength;
+        char **fieldValues;
+
+        /*
+         * Now divide the specifier up into name and default.
+         */
+
+        result = Tcl_SplitList(interp, argArray[i], &fieldCount,
+                &fieldValues);
+        if (result != TCL_OK) {
+            goto procError;
+        }
+        if (fieldCount > 2) {
+            ckfree((char *) fieldValues);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "too many fields in argument specifier \"",
+                    argArray[i], "\"", (char *) NULL);
+            goto procError;
+        }
+        if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
+            ckfree((char *) fieldValues);
+            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                    "procedure \"", procName,
+                    "\" has argument with no name", (char *) NULL);
+            goto procError;
+        }
+	
+        nameLength = strlen(fieldValues[0]);
+        if (fieldCount == 2) {
+            valueLength = strlen(fieldValues[1]);
+        } else {
+            valueLength = 0;
+        }
+
+        /*
+         * 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 \"", procName,
+		            "\" has formal parameter \"", fieldValues[0],
+			    "\" that is an array element",
+			    (char *) NULL);
+		    ckfree((char *) fieldValues);
+		    goto procError;
+		}
+	    }
+	    p++;
+	}
+
+        if (precompiled) {
+            /*
+             * compare the parsed argument with the stored one
+             */
+
+            if ((localPtr->nameLength != nameLength)
+                    || (strcmp(localPtr->name, fieldValues[0]))
+                    || (localPtr->frameIndex != i)
+                    || (localPtr->flags != (VAR_SCALAR | VAR_ARGUMENT))
+                    || ((localPtr->defValuePtr == NULL)
+                            && (fieldCount == 2))
+                    || ((localPtr->defValuePtr != NULL)
+                            && (fieldCount != 2))) {
+                char buf[128];
+                sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
+                        i);
+                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                        "procedure \"", procName,
+                        buf, (char *) NULL);
+                ckfree((char *) fieldValues);
+                goto procError;
+            }
+
+            /*
+             * compare the default value if any
+             */
+
+            if (localPtr->defValuePtr != NULL) {
+                int tmpLength;
+                char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
+                        &tmpLength);
+                if ((valueLength != tmpLength)
+                        || (strncmp(fieldValues[1], tmpPtr,
+                                (size_t) tmpLength))) {
+                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                            "procedure \"", procName,
+                            "\": formal parameter \"",
+                            fieldValues[0],
+                            "\" has default value inconsistent with precompiled body",
+                            (char *) NULL);
+                    ckfree((char *) fieldValues);
+                    goto procError;
+                }
+            }
+
+            localPtr = localPtr->nextPtr;
+        } else {
+            /*
+             * 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 {
+                procPtr->lastLocalPtr->nextPtr = localPtr;
+                procPtr->lastLocalPtr = localPtr;
+            }
+            localPtr->nextPtr = NULL;
+            localPtr->nameLength = nameLength;
+            localPtr->frameIndex = i;
+            localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
+            localPtr->resolveInfo = NULL;
+	
+            if (fieldCount == 2) {
+                localPtr->defValuePtr =
+		    Tcl_NewStringObj(fieldValues[1], valueLength);
+                Tcl_IncrRefCount(localPtr->defValuePtr);
+            } else {
+                localPtr->defValuePtr = NULL;
+            }
+            strcpy(localPtr->name, fieldValues[0]);
+	}
+
+        ckfree((char *) fieldValues);
+    }
+
+    /*
+     * Now initialize the new procedure's cmdPtr field. This will be used
+     * later when the procedure is called to determine what namespace the
+     * procedure will run in. This will be different than the current
+     * namespace if the proc was renamed into a different namespace.
+     */
+    
+    *procPtrPtr = procPtr;
+    ckfree((char *) argArray);
+    return TCL_OK;
+
+procError:
+    if (precompiled) {
+        procPtr->refCount--;
+    } else {
+        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 TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetFrame --
+ *
+ *	Given a description of a procedure frame, such as the first
+ *	argument to an "uplevel" or "upvar" command, locate the
+ *	call frame for the appropriate level of procedure.
+ *
+ * Results:
+ *	The return value is -1 if an error occurred in finding the
+ *	frame (in this case an error message is left in interp->result).
+ *	1 is returned if string was either a number or a number preceded
+ *	by "#" and it specified a valid frame.  0 is returned if string
+ *	isn't one of the two things above (in this case, the lookup
+ *	acts as if string were "1").  The variable pointed to by
+ *	framePtrPtr is filled in with the address of the desired frame
+ *	(unless an error occurs, in which case it isn't modified).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetFrame(interp, string, framePtrPtr)
+    Tcl_Interp *interp;		/* Interpreter in which to find frame. */
+    char *string;		/* String describing frame. */
+    CallFrame **framePtrPtr;	/* Store pointer to frame here (or NULL
+				 * if global frame indicated). */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int curLevel, level, result;
+    CallFrame *framePtr;
+
+    /*
+     * Parse string to figure out which level number to go to.
+     */
+
+    result = 1;
+    curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+    if (*string == '#') {
+	if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
+	    return -1;
+	}
+	if (level < 0) {
+	    levelError:
+	    Tcl_AppendResult(interp, "bad level \"", string, "\"",
+		    (char *) NULL);
+	    return -1;
+	}
+    } else if (isdigit(UCHAR(*string))) {
+	if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
+	    return -1;
+	}
+	level = curLevel - level;
+    } else {
+	level = curLevel - 1;
+	result = 0;
+    }
+
+    /*
+     * Figure out which frame to use, and modify the interpreter so
+     * its variables come from that frame.
+     */
+
+    if (level == 0) {
+	framePtr = NULL;
+    } else {
+	for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+		framePtr = framePtr->callerVarPtr) {
+	    if (framePtr->level == level) {
+		break;
+	    }
+	}
+	if (framePtr == NULL) {
+	    goto levelError;
+	}
+    }
+    *framePtrPtr = framePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UplevelObjCmd --
+ *
+ *	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 object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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;
+    char *optLevel;
+    int length, result;
+    CallFrame *savedVarFramePtr, *framePtr;
+
+    if (objc < 2) {
+	uplevelSyntax:
+	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.
+     */
+
+    optLevel = Tcl_GetStringFromObj(objv[1], &length);
+    result = TclGetFrame(interp, optLevel, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    objc -= (result+1);
+    if (objc == 0) {
+	goto uplevelSyntax;
+    }
+    objv += (result+1);
+
+    /*
+     * Modify the interpreter state to execute in the given frame.
+     */
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = framePtr;
+
+    /*
+     * Execute the residual arguments as a command.
+     */
+
+    if (objc == 1) {
+	result = Tcl_EvalObj(interp, objv[0]);
+    } else {
+	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_AddObjErrorInfo(interp, msg, -1);
+    }
+
+    /*
+     * Restore the variable frame, and return.
+     */
+
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFindProc --
+ *
+ *	Given the name of a procedure, return a pointer to the
+ *	record describing the procedure.
+ *
+ * Results:
+ *	NULL is returned if the name doesn't correspond to any
+ *	procedure.  Otherwise the return value is a pointer to
+ *	the procedure's record.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Proc *
+TclFindProc(iPtr, procName)
+    Interp *iPtr;		/* Interpreter in which to look. */
+    char *procName;		/* Name of desired procedure. */
+{
+    Tcl_Command cmd;
+    Tcl_Command origCmd;
+    Command *cmdPtr;
+    
+    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
+            (Tcl_Namespace *) NULL, /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
+        return NULL;
+    }
+    cmdPtr = (Command *) cmd;
+
+    origCmd = TclGetOriginalCommand(cmd);
+    if (origCmd != NULL) {
+	cmdPtr = (Command *) origCmd;
+    }
+    if (cmdPtr->proc != TclProcInterpProc) {
+	return NULL;
+    }
+    return (Proc *) cmdPtr->clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIsProc --
+ *
+ *	Tells whether a command is a Tcl procedure or not.
+ *
+ * Results:
+ *	If the given command is actually a Tcl procedure, the
+ *	return value is the address of the record describing
+ *	the procedure.  Otherwise the return value is 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Proc *
+TclIsProc(cmdPtr)
+    Command *cmdPtr;		/* Command to test. */
+{
+    Tcl_Command origCmd;
+
+    origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
+    if (origCmd != NULL) {
+	cmdPtr = (Command *) origCmd;
+    }
+    if (cmdPtr->proc == TclProcInterpProc) {
+	return (Proc *) cmdPtr->clientData;
+    }
+    return (Proc *) 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcInterpProc --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	Depends on the commands in the procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclProcInterpProc(clientData, interp, argc, argv)
+    ClientData clientData;	/* Record describing procedure to be
+				 * interpreted. */
+    Tcl_Interp *interp;		/* Interpreter in which procedure was
+				 * invoked. */
+    int argc;			/* Count of number of arguments to this
+				 * procedure. */
+    register char **argv;	/* Argument values. */
+{
+    register Tcl_Obj *objPtr;
+    register int i;
+    int 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++) {
+	objv[i] = Tcl_NewStringObj(argv[i], -1);
+	Tcl_IncrRefCount(objv[i]);
+    }
+    objv[argc] = 0;
+
+    /*
+     * Use TclObjInterpProc to actually interpret the procedure.
+     */
+
+    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;
+    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
+    CallFrame frame;
+    register CallFrame *framePtr = &frame;
+    register CompiledLocal *localPtr;
+    char *procName, *bytes;
+    int nameLen, localCt, numArgs, argCt, length, i, result;
+    Var *varPtr;
+
+    /*
+     * 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.  Note that compiling the body might increase
+     * procPtr->numCompiledLocals if new local variables are found
+     * while compiling.
+     */
+    
+    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+	    "body of proc", procName);
+    
+    if (result != TCL_OK) {
+        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. The proc's namespace is
+     * that of its command, which can change if the command is renamed
+     * from one namespace to another.
+     */
+
+    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+            (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1);
+
+    if (result != TCL_OK) {
+        return result;
+    }
+
+    framePtr->objc = objc;
+    framePtr->objv = objv;  /* ref counts for args are incremented below */
+
+    /*
+     * Initialize and resolve compiled variable references.
+     */
+
+    framePtr->procPtr = procPtr;
+    framePtr->numCompiledLocals = localCt;
+    framePtr->compiledLocals = compiledLocals;
+
+    TclInitCompiledLocals(interp, framePtr, nsPtr);
+    
+    /*
+     * 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 (!TclIsVarArgument(localPtr)) {
+	    panic("TclObjInterpProc: local variable %s is not argument but should be",
+		  localPtr->name);
+	    return TCL_ERROR;
+	}
+	if (TclIsVarTemporary(localPtr)) {
+	    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
+	 * it occurs, assign it a list consisting of all the remaining
+	 * actual arguments.
+	 */
+
+	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_ResetResult(interp);
+	    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;
+	}
+	varPtr++;
+	localPtr = localPtr->nextPtr;
+    }
+    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;
+    }
+
+    /*
+     * 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_EvalObj(interp, procPtr->bodyPtr);
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+	TclProcCleanupProc(procPtr);
+    }
+
+    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:
+
+    /*
+     * Pop and free the call frame for this procedure invocation.
+     */
+    
+    Tcl_PopCallFrame(interp);
+    
+    /*
+     * Free the compiledLocals array if malloc'ed storage was used.
+     */
+
+    if (compiledLocals != localStorage) {
+	ckfree((char *) compiledLocals);
+    }
+    return result;
+#undef NUM_LOCALS
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcCompileProc --
+ *
+ *	Called just before a procedure is executed to compile the
+ *	body to byte codes.  If the type of the body is not
+ *	"byte code" or if the compile conditions have changed
+ *	(namespace context, epoch counters, etc.) then the body
+ *	is recompiled.  Otherwise, this procedure does nothing.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May change the internal representation of the body object
+ *	to compiled code.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+int
+TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
+    Tcl_Interp *interp;		/* Interpreter containing procedure. */
+    Proc *procPtr;		/* Data associated with procedure. */
+    Tcl_Obj *bodyPtr;		/* Body of proc. (Usually procPtr->bodyPtr,
+ 				 * but could be any code fragment compiled
+ 				 * in the context of this procedure.) */
+    Namespace *nsPtr;		/* Namespace containing procedure. */
+    CONST char *description;	/* string describing this body of code. */
+    CONST char *procName;	/* Name of this procedure. */
+{
+    Interp *iPtr = (Interp*)interp;
+    int result;
+    Tcl_CallFrame frame;
+    Proc *saveProcPtr;
+    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+ 
+    /*
+     * 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.
+     *
+     * Precompiled procedure bodies, however, are immutable and therefore
+     * they are not recompiled, even if things have changed.
+     */
+ 
+    if (bodyPtr->typePtr == &tclByteCodeType) {
+ 	if ((codePtr->iPtr != iPtr)
+ 	        || (codePtr->compileEpoch != iPtr->compileEpoch)
+ 	        || (codePtr->nsPtr != nsPtr)) {
+            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+                if (codePtr->iPtr != iPtr) {
+                    Tcl_AppendResult(interp,
+                            "a precompiled script jumped interps", NULL);
+                    return TCL_ERROR;
+                }
+	        codePtr->compileEpoch = iPtr->compileEpoch;
+                codePtr->nsPtr = nsPtr;
+            } else {
+                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 = strlen(procName);
+ 	    ellipsis = "";
+ 	    if (numChars > 50) {
+ 		numChars = 50;
+ 		ellipsis = "...";
+ 	    }
+ 	    fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
+ 		    description, numChars, procName, ellipsis);
+ 	}
+ 	
+ 	/*
+ 	 * Plug the current procPtr into the interpreter and coerce
+ 	 * the code body to byte codes.  The interpreter needs to
+ 	 * know which proc it's compiling so that it can access its
+ 	 * list of compiled locals.
+ 	 *
+ 	 * TRICKY NOTE:  Be careful to push a call frame with the
+ 	 *   proper namespace context, so that the byte codes are
+ 	 *   compiled in the appropriate class context.
+ 	 */
+ 
+ 	saveProcPtr = iPtr->compiledProcPtr;
+ 	iPtr->compiledProcPtr = procPtr;
+ 
+ 	result = Tcl_PushCallFrame(interp, &frame,
+		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
+ 
+ 	if (result == TCL_OK) {
+	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+	    Tcl_PopCallFrame(interp);
+	}
+ 
+ 	iPtr->compiledProcPtr = saveProcPtr;
+ 	
+ 	if (result != TCL_OK) {
+ 	    if (result == TCL_ERROR) {
+ 		numChars = strlen(procName);
+ 		ellipsis = "";
+ 		if (numChars > 50) {
+ 		    numChars = 50;
+ 		    ellipsis = "...";
+ 		}
+ 		sprintf(buf, "\n    (compiling %s \"%.*s%s\", line %d)",
+ 			description, numChars, procName, ellipsis,
+ 			interp->errorLine);
+ 		Tcl_AddObjErrorInfo(interp, buf, -1);
+ 	    }
+ 	    return result;
+ 	}
+    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
+	register CompiledLocal *localPtr;
+ 	
+	/*
+	 * The resolver epoch has changed, but we only need to invalidate
+	 * the resolver cache.
+	 */
+
+	for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+	    localPtr = localPtr->nextPtr) {
+	    localPtr->flags &= ~(VAR_RESOLVED);
+	    if (localPtr->resolveInfo) {
+		if (localPtr->resolveInfo->deleteProc) {
+		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+		} else {
+		    ckfree((char*)localPtr->resolveInfo);
+		}
+		localPtr->resolveInfo = NULL;
+	    }
+	}
+    }
+    return TCL_OK;
+}
+ 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcDeleteProc --
+ *
+ *	This procedure is invoked just before a command procedure is
+ *	removed from an interpreter.  Its job is to release all the
+ *	resources allocated to the procedure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets freed, unless the procedure is actively being
+ *	executed.  In this case the cleanup is delayed until the
+ *	last call to the current procedure completes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclProcDeleteProc(clientData)
+    ClientData clientData;		/* Procedure to be deleted. */
+{
+    Proc *procPtr = (Proc *) clientData;
+
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+	TclProcCleanupProc(procPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcCleanupProc --
+ *
+ *	This procedure does all the real work of freeing up a Proc
+ *	structure.  It's called only when the structure's reference
+ *	count becomes zero.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory gets freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclProcCleanupProc(procPtr)
+    register Proc *procPtr;		/* Procedure to be deleted. */
+{
+    register CompiledLocal *localPtr;
+    Tcl_Obj *bodyPtr = procPtr->bodyPtr;
+    Tcl_Obj *defPtr;
+    Tcl_ResolvedVarInfo *resVarInfo;
+
+    if (bodyPtr != NULL) {
+	Tcl_DecrRefCount(bodyPtr);
+    }
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
+	CompiledLocal *nextPtr = localPtr->nextPtr;
+
+        resVarInfo = localPtr->resolveInfo;
+	if (resVarInfo) {
+	    if (resVarInfo->deleteProc) {
+		(*resVarInfo->deleteProc)(resVarInfo);
+	    } else {
+		ckfree((char *) resVarInfo);
+	    }
+        }
+
+	if (localPtr->defValuePtr != NULL) {
+	    defPtr = localPtr->defValuePtr;
+	    Tcl_DecrRefCount(defPtr);
+	}
+	ckfree((char *) localPtr);
+	localPtr = nextPtr;
+    }
+    ckfree((char *) procPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUpdateReturnInfo --
+ *
+ *	This procedure is called when procedures return, and at other
+ *	points where the TCL_RETURN code is used.  It examines fields
+ *	such as iPtr->returnCode and iPtr->errorCode and modifies
+ *	the real return status accordingly.
+ *
+ * Results:
+ *	The return value is the true completion code to use for
+ *	the procedure, instead of TCL_RETURN.
+ *
+ * Side effects:
+ *	The errorInfo and errorCode variables may get modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUpdateReturnInfo(iPtr)
+    Interp *iPtr;		/* Interpreter for which TCL_RETURN
+				 * exception is being processed. */
+{
+    int code;
+
+    code = iPtr->returnCode;
+    iPtr->returnCode = TCL_OK;
+    if (code == TCL_ERROR) {
+	Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode", (char *) NULL,
+		(iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE",
+		TCL_GLOBAL_ONLY);
+	iPtr->flags |= ERROR_CODE_SET;
+	if (iPtr->errorInfo != NULL) {
+	    Tcl_SetVar2((Tcl_Interp *) iPtr, "errorInfo", (char *) NULL,
+		    iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	    iPtr->flags |= ERR_IN_PROGRESS;
+	}
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInterpProc --
+ *
+ *  Returns a pointer to the TclProcInterpProc procedure; this is different
+ *  from the value obtained from the TclProcInterpProc reference on systems
+ *  like Windows where import and export versions of a procedure exported
+ *  by a DLL exist.
+ *
+ * Results:
+ *  Returns the internal address of the TclProcInterpProc procedure.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclCmdProcType
+TclGetInterpProc()
+{
+    return TclProcInterpProc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetObjInterpProc --
+ *
+ *  Returns a pointer to the TclObjInterpProc procedure; this is different
+ *  from the value obtained from the TclObjInterpProc reference on systems
+ *  like Windows where import and export versions of a procedure exported
+ *  by a DLL exist.
+ *
+ * Results:
+ *  Returns the internal address of the TclObjInterpProc procedure.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclObjCmdProcType
+TclGetObjInterpProc()
+{
+    return TclObjInterpProc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewProcBodyObj --
+ *
+ *  Creates a new object, of type "procbody", whose internal
+ *  representation is the given Proc struct.
+ *  The newly created object's reference count is 0.
+ *
+ * Results:
+ *  Returns a pointer to a newly allocated Tcl_Obj, 0 on error.
+ *
+ * Side effects:
+ *  The reference count in the ByteCode attached to the Proc is bumped up
+ *  by one, since the internal rep stores a pointer to it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewProcBodyObj(procPtr)
+    Proc *procPtr;	/* the Proc struct to store as the internal
+                         * representation. */
+{
+    Tcl_Obj *objPtr;
+
+    if (!procPtr) {
+        return (Tcl_Obj *) NULL;
+    }
+    
+    objPtr = Tcl_NewStringObj("", 0);
+
+    if (objPtr) {
+        objPtr->typePtr = &tclProcBodyType;
+        objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+
+        procPtr->refCount++;
+    }
+
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyDup --
+ *
+ *  Tcl_ObjType's Dup function for the proc body object.
+ *  Bumps the reference count on the Proc stored in the internal
+ *  representation.
+ *
+ * Results:
+ *  None.
+ *
+ * Side effects:
+ *  Sets up the object in dupPtr to be a duplicate of the one in srcPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void ProcBodyDup(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;		/* object to copy */
+    Tcl_Obj *dupPtr;		/* target object for the duplication */
+{
+    Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
+    
+    dupPtr->typePtr = &tclProcBodyType;
+    dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+    procPtr->refCount++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyFree --
+ *
+ *  Tcl_ObjType's Free function for the proc body object.
+ *  The reference count on its Proc struct is decreased by 1; if the count
+ *  reaches 0, the proc is freed.
+ *
+ * Results:
+ *  None.
+ *
+ * Side effects:
+ *  If the reference count on the Proc struct reaches 0, the struct is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcBodyFree(objPtr)
+    Tcl_Obj *objPtr;		/* the object to clean up */
+{
+    Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+        TclProcCleanupProc(procPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodySetFromAny --
+ *
+ *  Tcl_ObjType's SetFromAny function for the proc body object.
+ *  Calls panic.
+ *
+ * Results:
+ *  Theoretically returns a TCL result code.
+ *
+ * Side effects:
+ *  Calls panic, since we can't set the value of the object from a string
+ *  representation (or any other internal ones).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcBodySetFromAny(interp, objPtr)
+    Tcl_Interp *interp;			/* current interpreter */
+    Tcl_Obj *objPtr;			/* object pointer */
+{
+    panic("called ProcBodySetFromAny");
+
+    /*
+     * this to keep compilers happy.
+     */
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyUpdateString --
+ *
+ *  Tcl_ObjType's UpdateString function for the proc body object.
+ *  Calls panic.
+ *
+ * Results:
+ *  None.
+ *
+ * Side effects:
+ *  Calls panic, since we this type has no string representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcBodyUpdateString(objPtr)
+    Tcl_Obj *objPtr;		/* the object to update */
+{
+    panic("called ProcBodyUpdateString");
+}
diff --git a/tcl/generic/tclRegexp.h b/tcl/generic/tclRegexp.h
new file mode 100644
index 00000000000..f04c1ac1904
--- /dev/null
+++ b/tcl/generic/tclRegexp.h
@@ -0,0 +1,48 @@
+/*
+ * Definitions etc. for regexp(3) routines.
+ *
+ * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
+ * not the System V one.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _REGEXP
+#define _REGEXP 1
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * NSUBEXP must be at least 10, and no greater than 117 or the parser
+ * will not work properly.
+ */
+
+#define NSUBEXP  20
+
+typedef struct regexp {
+	char *startp[NSUBEXP];
+	char *endp[NSUBEXP];
+	char regstart;		/* Internal use only. */
+	char reganch;		/* Internal use only. */
+	char *regmust;		/* Internal use only. */
+	int regmlen;		/* Internal use only. */
+	char program[1];	/* Unwarranted chumminess with compiler. */
+} regexp;
+
+EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp));
+EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
+EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
+EXTERN void TclRegError _ANSI_ARGS_((char *msg));
+EXTERN char *TclGetRegError _ANSI_ARGS_((void));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* REGEXP */
diff --git a/tcl/generic/tclResolve.c b/tcl/generic/tclResolve.c
new file mode 100644
index 00000000000..7fea4acffea
--- /dev/null
+++ b/tcl/generic/tclResolve.c
@@ -0,0 +1,418 @@
+/*
+ * tclResolve.c --
+ *
+ *      Contains hooks for customized command/variable name resolution
+ *      schemes.  These hooks allow extensions like [incr Tcl] to add
+ *      their own name resolution rules to the Tcl language.  Rules can
+ *      be applied to a particular namespace, to the interpreter as a
+ *      whole, or both.
+ *
+ * Copyright (c) 1998 Lucent Technologies, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * Declarations for procedures local to this file:
+ */
+
+static void		BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddInterpResolvers --
+ *
+ *	Adds a set of command/variable resolution procedures to an
+ *	interpreter.  These procedures are consulted when commands
+ *	are resolved in Tcl_FindCommand, and when variables are
+ *	resolved in TclLookupVar and LookupCompiledLocal.  Each
+ *	namespace may also have its own set of resolution procedures
+ *	which take precedence over those for the interpreter.
+ *
+ *	When a name is resolved, it is handled as follows.  First,
+ *	the name is passed to the resolution procedures for the
+ *	namespace.  If not resolved, the name is passed to each of
+ *	the resolution procedures added to the interpreter.  Finally,
+ *	if still not resolved, the name is handled using the default
+ *	Tcl rules for name resolution.
+ *
+ * Results:
+ *	Returns pointers to the current name resolution procedures
+ *	in the cmdProcPtr, varProcPtr and compiledVarProcPtr
+ *	arguments.
+ *
+ * Side effects:
+ *	If a compiledVarProc is specified, this procedure bumps the
+ *	compileEpoch for the interpreter, forcing all code to be
+ *	recompiled.  If a cmdProc is specified, this procedure bumps
+ *	the cmdRefEpoch in all namespaces, forcing commands to be
+ *	resolved again using the new rules.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
+
+    Tcl_Interp *interp;			/* Interpreter whose name resolution
+					 * rules are being modified. */
+    char *name;				/* Name of this resolution scheme. */
+    Tcl_ResolveCmdProc *cmdProc;	/* New procedure for command
+					 * resolution */
+    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
+					 * at runtime */
+    Tcl_ResolveCompiledVarProc *compiledVarProc;
+					/* Procedure for variable resolution
+					 * at compile time. */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
+
+    /*
+     *  Since we're adding a new name resolution scheme, we must force
+     *  all code to be recompiled to use the new scheme.  If there
+     *  are new compiled variable resolution rules, bump the compiler
+     *  epoch to invalidate compiled code.  If there are new command
+     *  resolution rules, bump the cmdRefEpoch in all namespaces.
+     */
+    if (compiledVarProc) {
+        iPtr->compileEpoch++;
+    }
+    if (cmdProc) {
+        BumpCmdRefEpochs(iPtr->globalNsPtr);
+    }
+
+    /*
+     *  Look for an existing scheme with the given name.  If found,
+     *  then replace its rules.
+     */
+    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
+        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+            resPtr->cmdResProc = cmdProc;
+            resPtr->varResProc = varProc;
+            resPtr->compiledVarResProc = compiledVarProc;
+            return;
+        }
+    }
+
+    /*
+     *  Otherwise, this is a new scheme.  Add it to the FRONT
+     *  of the linked list, so that it overrides existing schemes.
+     */
+    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
+    resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
+    strcpy(resPtr->name, name);
+    resPtr->cmdResProc = cmdProc;
+    resPtr->varResProc = varProc;
+    resPtr->compiledVarResProc = compiledVarProc;
+    resPtr->nextPtr = iPtr->resolverPtr;
+    iPtr->resolverPtr = resPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetInterpResolvers --
+ *
+ *	Looks for a set of command/variable resolution procedures with
+ *	the given name in an interpreter.  These procedures are
+ *	registered by calling Tcl_AddInterpResolvers.
+ *
+ * Results:
+ *	If the name is recognized, this procedure returns non-zero,
+ *	along with pointers to the name resolution procedures in
+ *	the Tcl_ResolverInfo structure.  If the name is not recognized,
+ *	this procedure returns zero.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetInterpResolvers(interp, name, resInfoPtr)
+
+    Tcl_Interp *interp;			/* Interpreter whose name resolution
+					 * rules are being queried. */
+    char *name;                         /* Look for a scheme with this name. */
+    Tcl_ResolverInfo *resInfoPtr;	/* Returns pointers to the procedures,
+					 * if found */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme *resPtr;
+
+    /*
+     *  Look for an existing scheme with the given name.  If found,
+     *  then return pointers to its procedures.
+     */
+    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
+        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+	    resInfoPtr->cmdResProc = resPtr->cmdResProc;
+	    resInfoPtr->varResProc = resPtr->varResProc;
+	    resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
+            return 1;
+        }
+    }
+
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RemoveInterpResolvers --
+ *
+ *	Removes a set of command/variable resolution procedures
+ *	previously added by Tcl_AddInterpResolvers.  The next time
+ *	a command/variable name is resolved, these procedures
+ *	won't be consulted.
+ *
+ * Results:
+ *	Returns non-zero if the name was recognized and the
+ *	resolution scheme was deleted.  Returns zero otherwise.
+ *
+ * Side effects:
+ *	If a scheme with a compiledVarProc was deleted, this procedure
+ *	bumps the compileEpoch for the interpreter, forcing all code
+ *	to be recompiled.  If a scheme with a cmdProc was deleted,
+ *	this procedure bumps the cmdRefEpoch in all namespaces,
+ *	forcing commands to be resolved again using the new rules.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RemoveInterpResolvers(interp, name)
+
+    Tcl_Interp *interp;			/* Interpreter whose name resolution
+					 * rules are being modified. */
+    char *name;                         /* Name of the scheme to be removed. */
+{
+    Interp *iPtr = (Interp*)interp;
+    ResolverScheme **prevPtrPtr, *resPtr;
+
+    /*
+     *  Look for an existing scheme with the given name.
+     */
+    prevPtrPtr = &iPtr->resolverPtr;
+    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
+        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+            break;
+        }
+        prevPtrPtr = &resPtr->nextPtr;
+    }
+
+    /*
+     *  If we found the scheme, delete it.
+     */
+    if (resPtr) {
+        /*
+         *  If we're deleting a scheme with compiled variable resolution
+         *  rules, bump the compiler epoch to invalidate compiled code.
+         *  If we're deleting a scheme with command resolution rules,
+         *  bump the cmdRefEpoch in all namespaces.
+         */
+        if (resPtr->compiledVarResProc) {
+            iPtr->compileEpoch++;
+        }
+        if (resPtr->cmdResProc) {
+            BumpCmdRefEpochs(iPtr->globalNsPtr);
+        }
+
+        *prevPtrPtr = resPtr->nextPtr;
+        ckfree(resPtr->name);
+        ckfree((char *) resPtr);
+
+        return 1;
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BumpCmdRefEpochs --
+ *
+ *	This procedure is used to bump the cmdRefEpoch counters in
+ *	the specified namespace and all of its child namespaces.
+ *	It is used whenever name resolution schemes are added/removed
+ *	from an interpreter, to invalidate all command references.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Bumps the cmdRefEpoch in the specified namespace and its
+ *	children, recursively.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BumpCmdRefEpochs(nsPtr)
+    Namespace *nsPtr;			/* Namespace being modified. */
+{
+    Tcl_HashEntry *entry;
+    Tcl_HashSearch search;
+    Namespace *childNsPtr;
+
+    nsPtr->cmdRefEpoch++;
+
+    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+	    entry != NULL;
+	    entry = Tcl_NextHashEntry(&search)) {
+
+        childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
+        BumpCmdRefEpochs(childNsPtr);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetNamespaceResolvers --
+ *
+ *	Sets the command/variable resolution procedures for a namespace,
+ *	thereby changing the way that command/variable names are
+ *	interpreted.  This allows extension writers to support different
+ *	name resolution schemes, such as those for object-oriented
+ *	packages.
+ *
+ *	Command resolution is handled by a procedure of the following
+ *	type:
+ *
+ *	  typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
+ *		Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ *              int flags, Tcl_Command *rPtr));
+ *          
+ *	Whenever a command is executed or Tcl_FindCommand is invoked
+ *	within the namespace, this procedure is called to resolve the
+ *	command name.  If this procedure is able to resolve the name,
+ *	it should return the status code TCL_OK, along with the
+ *	corresponding Tcl_Command in the rPtr argument.  Otherwise,
+ *	the procedure can return TCL_CONTINUE, and the command will
+ *	be treated under the usual name resolution rules.  Or, it can
+ *	return TCL_ERROR, and the command will be considered invalid.
+ *
+ *	Variable resolution is handled by two procedures.  The first
+ *	is called whenever a variable needs to be resolved at compile
+ *	time:
+ *
+ *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
+ *	        Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ *	        Tcl_ResolvedVarInfo *rPtr));
+ *
+ *      If this procedure is able to resolve the name, it should return
+ *      the status code TCL_OK, along with variable resolution info in
+ *      the rPtr argument; this info will be used to set up compiled
+ *	locals in the call frame at runtime.  The procedure may also
+ *	return TCL_CONTINUE, and the variable will be treated under
+ *	the usual name resolution rules.  Or, it can return TCL_ERROR,
+ *	and the variable will be considered invalid.
+ *
+ *	Another procedure is used whenever a variable needs to be
+ *	resolved at runtime but it is not recognized as a compiled local.
+ *	(For example, the variable may be requested via
+ *	Tcl_FindNamespaceVar.) This procedure has the following type:
+ *
+ *	  typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
+ *	        Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ *	        int flags, Tcl_Var *rPtr));
+ *
+ *	This procedure is quite similar to the compile-time version.
+ *	It returns the same status codes, but if variable resolution
+ *	succeeds, this procedure returns a Tcl_Var directly via the
+ *	rPtr argument.
+ *
+ * Results:
+ *	Nothing.
+ *
+ * Side effects:
+ *	Bumps the command epoch counter for the namespace, invalidating
+ *	all command references in that namespace.  Also bumps the
+ *	resolver epoch counter for the namespace, forcing all code
+ *	in the namespace to be recompiled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
+    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
+					 * are being modified. */
+    Tcl_ResolveCmdProc *cmdProc;	/* Procedure for command resolution */
+    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
+					 * at runtime */
+    Tcl_ResolveCompiledVarProc *compiledVarProc;
+					/* Procedure for variable resolution
+					 * at compile time. */
+{
+    Namespace *nsPtr = (Namespace*)namespacePtr;
+
+    /*
+     *  Plug in the new command resolver, and bump the epoch counters
+     *  so that all code will have to be recompiled and all commands
+     *  will have to be resolved again using the new policy.
+     */
+    nsPtr->cmdResProc = cmdProc;
+    nsPtr->varResProc = varProc;
+    nsPtr->compiledVarResProc = compiledVarProc;
+
+    nsPtr->cmdRefEpoch++;
+    nsPtr->resolverEpoch++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNamespaceResolvers --
+ *
+ *	Returns the current command/variable resolution procedures
+ *	for a namespace.  By default, these procedures are NULL.
+ *	New procedures can be installed by calling
+ *	Tcl_SetNamespaceResolvers, to provide new name resolution
+ *	rules.
+ *
+ * Results:
+ *	Returns non-zero if any name resolution procedures have been
+ *	assigned to this namespace; also returns pointers to the
+ *	procedures in the Tcl_ResolverInfo structure.  Returns zero
+ *	otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
+
+    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
+					 * are being modified. */
+    Tcl_ResolverInfo *resInfoPtr;	/* Returns: pointers for all
+					 * name resolution procedures
+					 * assigned to this namespace. */
+{
+    Namespace *nsPtr = (Namespace*)namespacePtr;
+
+    resInfoPtr->cmdResProc = nsPtr->cmdResProc;
+    resInfoPtr->varResProc = nsPtr->varResProc;
+    resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
+
+    if (nsPtr->cmdResProc != NULL ||
+        nsPtr->varResProc != NULL ||
+        nsPtr->compiledVarResProc != NULL) {
+	return 1;
+    }
+    return 0;
+}
diff --git a/tcl/generic/tclStringObj.c b/tcl/generic/tclStringObj.c
new file mode 100644
index 00000000000..ecc9445f208
--- /dev/null
+++ b/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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 = (bytes? strlen(bytes) : 0);
+    }
+    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 = (bytes? strlen(bytes) : 0);
+    }
+    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/tcl/generic/tclTest.c b/tcl/generic/tclTest.c
new file mode 100644
index 00000000000..49c8fe11296
--- /dev/null
+++ b/tcl/generic/tclTest.c
@@ -0,0 +1,3096 @@
+/* 
+ * tclTest.c --
+ *
+ *	This file contains C command procedures for a bunch of additional
+ *	Tcl commands that are used for testing out Tcl's C interfaces.
+ *	These commands are not normally included in Tcl applications;
+ *	they're only used for testing.
+ *
+ * Copyright (c) 1993-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define TCL_TEST
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Declare external functions used in Windows tests.
+ */
+
+#if defined(__WIN32__)
+extern TclPlatformType *	TclWinGetPlatform _ANSI_ARGS_((void));
+#endif
+
+/*
+ * Dynamic string shared by TestdcallCmd and DelCallbackProc;  used
+ * to collect the results of the various deletion callbacks.
+ */
+
+static Tcl_DString delString;
+static Tcl_Interp *delInterp;
+
+/*
+ * One of the following structures exists for each asynchronous
+ * handler created by the "testasync" command".
+ */
+
+typedef struct TestAsyncHandler {
+    int id;				/* Identifier for this handler. */
+    Tcl_AsyncHandler handler;		/* Tcl's token for the handler. */
+    char *command;			/* Command to invoke when the
+					 * handler is invoked. */
+    struct TestAsyncHandler *nextPtr;	/* Next is list of handlers. */
+} TestAsyncHandler;
+
+static TestAsyncHandler *firstHandler = NULL;
+
+/*
+ * The dynamic string below is used by the "testdstring" command
+ * to test the dynamic string facilities.
+ */
+
+static Tcl_DString dstring;
+
+/*
+ * The command trace below is used by the "testcmdtraceCmd" command
+ * to test the command tracing facilities.
+ */
+
+static Tcl_Trace cmdTrace;
+
+/*
+ * One of the following structures exists for each command created
+ * by TestdelCmd:
+ */
+
+typedef struct DelCmd {
+    Tcl_Interp *interp;		/* Interpreter in which command exists. */
+    char *deleteCmd;		/* Script to execute when command is
+				 * deleted.  Malloc'ed. */
+} DelCmd;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+int			Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+static int		AsyncHandlerProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int code));
+static void		CleanupTestSetassocdataTests _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp));
+static void		CmdDelProc1 _ANSI_ARGS_((ClientData clientData));
+static void		CmdDelProc2 _ANSI_ARGS_((ClientData clientData));
+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 void		CmdTraceDeleteProc _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int level, char *command, Tcl_CmdProc *cmdProc,
+			    ClientData cmdClientData, int argc,
+			    char **argv));
+static void		CmdTraceProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int level, char *command,
+			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
+                            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,
+			    Tcl_Interp *interp, int argc, char **argv));
+static void		DelDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void		ExitProcEven _ANSI_ARGS_((ClientData clientData));
+static void		ExitProcOdd _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		TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestAccessProc1 _ANSI_ARGS_((CONST char *path,
+			   int mode));
+static int		TestAccessProc2 _ANSI_ARGS_((CONST char *path,
+			   int mode));
+static int		TestAccessProc3 _ANSI_ARGS_((CONST char *path,
+			   int mode));
+static int		TestasyncCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+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		TestcmdtraceCmd _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,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+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		TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestexprstringCmd _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		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,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestMathFunc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, Tcl_Value *args,
+			    Tcl_Value *resultPtr));
+static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, Tcl_Value *args,
+			    Tcl_Value *resultPtr));
+static Tcl_Channel	TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *filename, char *modeString, int permissions));
+static Tcl_Channel	TestOpenFileChannelProc2 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *filename, char *modeString, int permissions));
+static Tcl_Channel	TestOpenFileChannelProc3 _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *filename, char *modeString, int permissions));
+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		TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestsetrecursionlimitCmd _ANSI_ARGS_((
+                            ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+static int		TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestStatProc1 _ANSI_ARGS_((CONST char *path,
+			    TclStat_ *buf));
+static int		TestStatProc2 _ANSI_ARGS_((CONST char *path,
+			    TclStat_ *buf));
+static int		TestStatProc3 _ANSI_ARGS_((CONST char *path,
+			    TclStat_ *buf));
+static int		TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+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		TestwordendObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
+
+/*
+ * External (platform specific) initialization routine:
+ */
+
+EXTERN int		TclplatformtestInit _ANSI_ARGS_((
+			    Tcl_Interp *interp));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcltest_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
+Tcltest_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter for application. */
+{
+    Tcl_ValueType t3ArgTypes[2];
+	
+    if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
+        return TCL_ERROR;
+    }
+
+    /*
+     * 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, "testaccessproc", TestaccessprocCmd, (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, "testcmdtrace", TestcmdtraceCmd,
+	    (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,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_DStringInit(&dstring);
+    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    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, "testopenfilechannelproc",
+    	    TestopenfilechannelprocCmd, (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_CreateObjCommand(interp, "testsetrecursionlimit",
+	    TestsetrecursionlimitCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testtranslatefilename",
+            TesttranslatefilenameCmd, (ClientData) 0,
+            (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (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);
+    Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    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.
+     */
+    
+    return TclplatformtestInit(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestasyncCmd --
+ *
+ *	This procedure implements the "testasync" command.  It is used
+ *	to test the asynchronous handler facilities of Tcl.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates, deletes, and invokes handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestasyncCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    TestAsyncHandler *asyncPtr, *prevPtr;
+    int id, code;
+    static int nextId = 1;
+    char buf[30];
+
+    if (argc < 2) {
+	wrongNumArgs:
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "create") == 0) {
+	if (argc != 3) {
+	    goto wrongNumArgs;
+	}
+	asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler));
+	asyncPtr->id = nextId;
+	nextId++;
+	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
+		(ClientData) asyncPtr);
+	asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
+	strcpy(asyncPtr->command, argv[2]);
+	asyncPtr->nextPtr = firstHandler;
+	firstHandler = asyncPtr;
+	sprintf(buf, "%d", asyncPtr->id);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	if (argc == 2) {
+	    while (firstHandler != NULL) {
+		asyncPtr = firstHandler;
+		firstHandler = asyncPtr->nextPtr;
+		Tcl_AsyncDelete(asyncPtr->handler);
+		ckfree(asyncPtr->command);
+		ckfree((char *) asyncPtr);
+	    }
+	    return TCL_OK;
+	}
+	if (argc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL;
+		prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) {
+	    if (asyncPtr->id != id) {
+		continue;
+	    }
+	    if (prevPtr == NULL) {
+		firstHandler = asyncPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = asyncPtr->nextPtr;
+	    }
+	    Tcl_AsyncDelete(asyncPtr->handler);
+	    ckfree(asyncPtr->command);
+	    ckfree((char *) asyncPtr);
+	    break;
+	}
+    } else if (strcmp(argv[1], "mark") == 0) {
+	if (argc != 5) {
+	    goto wrongNumArgs;
+	}
+	if ((Tcl_GetInt(interp, argv[2], &id) != TCL_OK)
+		|| (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
+	for (asyncPtr = firstHandler; asyncPtr != NULL;
+		asyncPtr = asyncPtr->nextPtr) {
+	    if (asyncPtr->id == id) {
+		Tcl_AsyncMark(asyncPtr->handler);
+		break;
+	    }
+	}
+	Tcl_SetResult(interp, argv[3], TCL_VOLATILE);
+	return code;
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be create, delete, int, or mark",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+static int
+AsyncHandlerProc(clientData, interp, code)
+    ClientData clientData;	/* Pointer to TestAsyncHandler structure. */
+    Tcl_Interp *interp;		/* Interpreter in which command was
+				 * executed, or NULL. */
+    int code;			/* Current return code from command. */
+{
+    TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
+    char *listArgv[4];
+    char string[20], *cmd;
+
+    sprintf(string, "%d", code);
+    listArgv[0] = asyncPtr->command;
+    listArgv[1] = interp->result;
+    listArgv[2] = string;
+    listArgv[3] = NULL;
+    cmd = Tcl_Merge(3, listArgv);
+    code = Tcl_Eval(interp, cmd);
+    ckfree(cmd);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcmdinfoCmd --
+ *
+ *	This procedure implements the "testcmdinfo" command.  It is used
+ *	to test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation
+ *	and deletion.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes various commands and modifies their data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestcmdinfoCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_CmdInfo info;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option cmdName\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "create") == 0) {
+	Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original",
+		CmdDelProc1);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	Tcl_DStringInit(&delString);
+	Tcl_DeleteCommand(interp, argv[2]);
+	Tcl_DStringResult(interp, &delString);
+    } else if (strcmp(argv[1], "get") == 0) {
+	if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
+	    Tcl_SetResult(interp, "??", TCL_STATIC);
+	    return TCL_OK;
+	}
+	if (info.proc == CmdProc1) {
+	    Tcl_AppendResult(interp, "CmdProc1", " ",
+		    (char *) info.clientData, (char *) NULL);
+	} else if (info.proc == CmdProc2) {
+	    Tcl_AppendResult(interp, "CmdProc2", " ",
+		    (char *) info.clientData, (char *) NULL);
+	} else {
+	    Tcl_AppendResult(interp, "unknown", (char *) NULL);
+	}
+	if (info.deleteProc == CmdDelProc1) {
+	    Tcl_AppendResult(interp, " CmdDelProc1", " ",
+		    (char *) info.deleteData, (char *) NULL);
+	} else if (info.deleteProc == CmdDelProc2) {
+	    Tcl_AppendResult(interp, " CmdDelProc2", " ",
+		    (char *) info.deleteData, (char *) NULL);
+	} 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) {
+	    Tcl_SetResult(interp, "0", TCL_STATIC);
+	} else {
+	    Tcl_SetResult(interp, "1", TCL_STATIC);
+	}
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be create, delete, get, or modify",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+	/*ARGSUSED*/
+static int
+CmdProc1(clientData, interp, argc, argv)
+    ClientData clientData;		/* String to return. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData,
+	    (char *) NULL);
+    return TCL_OK;
+}
+
+	/*ARGSUSED*/
+static int
+CmdProc2(clientData, interp, argc, argv)
+    ClientData clientData;		/* String to return. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData,
+	    (char *) NULL);
+    return TCL_OK;
+}
+
+static void
+CmdDelProc1(clientData)
+    ClientData clientData;		/* String to save. */
+{
+    Tcl_DStringInit(&delString);
+    Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
+    Tcl_DStringAppend(&delString, (char *) clientData, -1);
+}
+
+static void
+CmdDelProc2(clientData)
+    ClientData clientData;		/* String to save. */
+{
+    Tcl_DStringInit(&delString);
+    Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
+    Tcl_DStringAppend(&delString, (char *) clientData, -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcmdtokenCmd --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	Creates and deletes various commands and modifies their data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestcmdtokenCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Command token;
+    long int l;
+    char buf[30];
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "create") == 0) {
+	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
+		(ClientData) "original", (Tcl_CmdDeleteProc *) NULL);
+	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;
+	}
+
+	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);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcmdtraceCmd --
+ *
+ *	This procedure implements the "testcmdtrace" command. It is used
+ *	to test Tcl_CreateTrace and Tcl_DeleteTrace.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes a command trace, and tests the invocation of
+ *	a procedure by the command trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestcmdtraceCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_DString buffer;
+    int result;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option script\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1], "tracetest") == 0) {
+	Tcl_DStringInit(&buffer);
+	cmdTrace = Tcl_CreateTrace(interp, 50000,
+	        (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
+	result = Tcl_Eval(interp, argv[2]);
+	if (result == TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
+	}
+	Tcl_DeleteTrace(interp, cmdTrace);
+	Tcl_DStringFree(&buffer);
+    } else if (strcmp(argv[1], "deletetest") == 0) {
+	/*
+	 * Create a command trace then eval a script to check whether it is
+	 * called. Note that this trace procedure removes itself as a
+	 * further check of the robustness of the trace proc calling code in
+	 * TclExecuteByteCode.
+	 */
+	
+	cmdTrace = Tcl_CreateTrace(interp, 50000,
+	        (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
+	result = Tcl_Eval(interp, argv[2]);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be tracetest or deletetest", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+static void
+CmdTraceProc(clientData, interp, level, command, cmdProc, cmdClientData,
+        argc, argv)
+    ClientData clientData;	/* Pointer to buffer in which the
+				 * command and arguments are appended.
+				 * Accumulates test result. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int level;			/* Current trace level. */
+    char *command;		/* The command being traced (after
+				 * substitutions). */
+    Tcl_CmdProc *cmdProc;	/* Points to command's command procedure. */
+    ClientData cmdClientData;	/* Client data associated with command
+				 * procedure. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+{
+    Tcl_DString *bufPtr = (Tcl_DString *) clientData;
+    int i;
+
+    Tcl_DStringAppendElement(bufPtr, command);
+
+    Tcl_DStringStartSublist(bufPtr);
+    for (i = 0;  i < argc;  i++) {
+	Tcl_DStringAppendElement(bufPtr, argv[i]);
+    }
+    Tcl_DStringEndSublist(bufPtr);
+}
+
+static void
+CmdTraceDeleteProc(clientData, interp, level, command, cmdProc,
+	cmdClientData, argc, argv)
+    ClientData clientData;	/* Unused. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int level;			/* Current trace level. */
+    char *command;		/* The command being traced (after
+				 * substitutions). */
+    Tcl_CmdProc *cmdProc;	/* Points to command's command procedure. */
+    ClientData cmdClientData;	/* Client data associated with command
+				 * procedure. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+{
+    /*
+     * Remove ourselves to test whether calling Tcl_DeleteTrace within
+     * a trace callback causes the for loop in TclExecuteByteCode that
+     * calls traces to reference freed memory.
+     */
+    
+    Tcl_DeleteTrace(interp, cmdTrace);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ *	to test Tcl_CallWhenDeleted.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestdcallCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int i, id;
+
+    delInterp = Tcl_CreateInterp();
+    Tcl_DStringInit(&delString);
+    for (i = 1; i < argc; i++) {
+	if (Tcl_GetInt(interp, argv[i], &id) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (id < 0) {
+	    Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
+		    (ClientData) (-id));
+	} else {
+	    Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
+		    (ClientData) id);
+	}
+    }
+    Tcl_DeleteInterp(delInterp);
+    Tcl_DStringResult(interp, &delString);
+    return TCL_OK;
+}
+
+/*
+ * The deletion callback used by TestdcallCmd:
+ */
+
+static void
+DelCallbackProc(clientData, interp)
+    ClientData clientData;		/* Numerical value to append to
+					 * delString. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
+{
+    int id = (int) clientData;
+    char buffer[10];
+
+    sprintf(buffer, "%d", id);
+    Tcl_DStringAppendElement(&delString, buffer);
+    if (interp != delInterp) {
+	Tcl_DStringAppendElement(&delString, "bogus interpreter argument!");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdelCmd --
+ *
+ *	This procedure implements the "testdcall" command.  It is used
+ *	to test Tcl_CallWhenDeleted.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestdelCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    DelCmd *dPtr;
+    Tcl_Interp *slave;
+
+    if (argc != 4) {
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	return TCL_ERROR;
+    }
+
+    slave = Tcl_GetSlave(interp, argv[1]);
+    if (slave == NULL) {
+	return TCL_ERROR;
+    }
+
+    dPtr = (DelCmd *) ckalloc(sizeof(DelCmd));
+    dPtr->interp = interp;
+    dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
+    strcpy(dPtr->deleteCmd, argv[3]);
+
+    Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
+	    DelDeleteProc);
+    return TCL_OK;
+}
+
+static int
+DelCmdProc(clientData, interp, argc, argv)
+    ClientData clientData;		/* String result to return. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    DelCmd *dPtr = (DelCmd *) clientData;
+
+    Tcl_AppendResult(interp, dPtr->deleteCmd, (char *) NULL);
+    ckfree(dPtr->deleteCmd);
+    ckfree((char *) dPtr);
+    return TCL_OK;
+}
+
+static void
+DelDeleteProc(clientData)
+    ClientData clientData;		/* String command to evaluate. */
+{
+    DelCmd *dPtr = (DelCmd *) clientData;
+
+    Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
+    Tcl_ResetResult(dPtr->interp);
+    ckfree(dPtr->deleteCmd);
+    ckfree((char *) dPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdelassocdataCmd --
+ *
+ *	This procedure implements the "testdelassocdata" command. It is used
+ *	to test Tcl_DeleteAssocData.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Deletes an association between a key and associated data from an
+ *	interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestdelassocdataCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 2) {
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " data_key\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    Tcl_DeleteAssocData(interp, argv[1]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdstringCmd --
+ *
+ *	This procedure implements the "testdstring" command.  It is used
+ *	to test the dynamic string facilities of Tcl.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates, deletes, and invokes handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestdstringCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int count;
+
+    if (argc < 2) {
+	wrongNumArgs:
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "append") == 0) {
+	if (argc != 4) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetInt(interp, argv[3], &count) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_DStringAppend(&dstring, argv[2], count);
+    } else if (strcmp(argv[1], "element") == 0) {
+	if (argc != 3) {
+	    goto wrongNumArgs;
+	}
+	Tcl_DStringAppendElement(&dstring, argv[2]);
+    } else if (strcmp(argv[1], "end") == 0) {
+	if (argc != 2) {
+	    goto wrongNumArgs;
+	}
+	Tcl_DStringEndSublist(&dstring);
+    } else if (strcmp(argv[1], "free") == 0) {
+	if (argc != 2) {
+	    goto wrongNumArgs;
+	}
+	Tcl_DStringFree(&dstring);
+    } else if (strcmp(argv[1], "get") == 0) {
+	if (argc != 2) {
+	    goto wrongNumArgs;
+	}
+	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) {
+	    Tcl_SetResult(interp, "short", TCL_STATIC);
+	} else if (strcmp(argv[2], "staticlarge") == 0) {
+	    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) {
+	    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);
+	    interp->result += 4;
+	    interp->freeProc = SpecialFree;
+	    strcpy(interp->result, "This is a specially-allocated string");
+	} else {
+	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
+		    "\": must be staticsmall, staticlarge, free, or special",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringGetResult(interp, &dstring);
+    } else if (strcmp(argv[1], "length") == 0) {
+	char buf[30];
+	
+	if (argc != 2) {
+	    goto wrongNumArgs;
+	}
+	sprintf(buf, "%d", Tcl_DStringLength(&dstring));
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    } else if (strcmp(argv[1], "result") == 0) {
+	if (argc != 2) {
+	    goto wrongNumArgs;
+	}
+	Tcl_DStringResult(interp, &dstring);
+    } else if (strcmp(argv[1], "trunc") == 0) {
+	if (argc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_DStringTrunc(&dstring, count);
+    } else if (strcmp(argv[1], "start") == 0) {
+	if (argc != 2) {
+	    goto wrongNumArgs;
+	}
+	Tcl_DStringStartSublist(&dstring);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be append, element, end, free, get, length, ",
+		"result, trunc, or start", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ * The procedure below is used as a special freeProc to test how well
+ * Tcl_DStringGetResult handles freeProc's other than free.
+ */
+
+static void SpecialFree(blockPtr)
+    char *blockPtr;			/* Block to free. */
+{
+    ckfree(blockPtr - 4);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexithandlerCmd --
+ *
+ *	This procedure implements the "testexithandler" command. It is
+ *	used to test Tcl_CreateExitHandler and Tcl_DeleteExitHandler.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexithandlerCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int value;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " create|delete value\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "create") == 0) {
+	Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
+		(ClientData) value);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
+		(ClientData) value);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be create or delete", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+static void
+ExitProcOdd(clientData)
+    ClientData clientData;		/* Integer value to print. */
+{
+    char buf[100];
+
+    sprintf(buf, "odd %d\n", (int) clientData);
+    write(1, buf, strlen(buf));
+}
+
+static void
+ExitProcEven(clientData)
+    ClientData clientData;		/* Integer value to print. */
+{
+    char buf[100];
+
+    sprintf(buf, "even %d\n", (int) clientData);
+    write(1, buf, strlen(buf));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexprlongCmd --
+ *
+ *	This procedure verifies that Tcl_ExprLong does not modify the
+ *	interpreter result if there is no error.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprlongCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexprstringCmd --
+ *
+ *	This procedure tests the basic operation of Tcl_ExprString.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprstringCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 2) {
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " expression\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    return Tcl_ExprString(interp, argv[1]);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetassocdataCmd --
+ *
+ *	This procedure implements the "testgetassocdata" command. It is
+ *	used to test Tcl_GetAssocData.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetassocdataCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    char *res;
+    
+    if (argc != 2) {
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " data_key\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    res = (char *) Tcl_GetAssocData(interp, argv[1], NULL);
+    if (res != NULL) {
+        Tcl_AppendResult(interp, res, NULL);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetplatformCmd --
+ *
+ *	This procedure implements the "testgetplatform" command. It is
+ *	used to retrievel the value of the tclPlatform global variable.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetplatformCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    static char *platformStrings[] = { "unix", "mac", "windows" };
+    TclPlatformType *platform;
+
+#ifdef __WIN32__
+    platform = TclWinGetPlatform();
+#else
+    platform = &tclPlatform;
+#endif
+    
+    if (argc != 1) {
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		(char *) NULL);
+        return TCL_ERROR;
+    }
+
+    Tcl_AppendResult(interp, platformStrings[*platform], NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestinterpdeleteCmd --
+ *
+ *	This procedure tests the code in tclInterp.c that deals with
+ *	interpreter deletion. It deletes a user-specified interpreter
+ *	from the hierarchy, and subsequent code checks integrity.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Deletes one or more interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestinterpdeleteCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_Interp *slaveToDelete;
+
+    if (argc != 2) {
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " path\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (argv[1][0] == '\0') {
+        Tcl_AppendResult(interp, "cannot delete current interpreter",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    slaveToDelete = Tcl_GetSlave(interp, argv[1]);
+    if (slaveToDelete == (Tcl_Interp *) NULL) {
+        Tcl_AppendResult(interp, "could not find interpreter \"",
+                argv[1], "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    Tcl_DeleteInterp(slaveToDelete);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestlinkCmd --
+ *
+ *	This procedure implements the "testlink" command.  It is used
+ *	to test Tcl_LinkVar and related library procedures.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes various variable links, plus returns
+ *	values of the linked variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestlinkCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    static int intVar = 43;
+    static int boolVar = 4;
+    static double realVar = 1.23;
+    static char *stringVar = NULL;
+    static int created = 0;
+    char buffer[TCL_DOUBLE_SPACE];
+    int writable, flag;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option ?arg arg arg?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "create") == 0) {
+	if (created) {
+	    Tcl_UnlinkVar(interp, "int");
+	    Tcl_UnlinkVar(interp, "real");
+	    Tcl_UnlinkVar(interp, "bool");
+	    Tcl_UnlinkVar(interp, "string");
+	}
+	created = 1;
+	if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "int", (char *) &intVar,
+		TCL_LINK_INT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[3], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "real", (char *) &realVar,
+		TCL_LINK_DOUBLE | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[4], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "bool", (char *) &boolVar,
+		TCL_LINK_BOOLEAN | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[5], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "string", (char *) &stringVar,
+		TCL_LINK_STRING | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else if (strcmp(argv[1], "delete") == 0) {
+	Tcl_UnlinkVar(interp, "int");
+	Tcl_UnlinkVar(interp, "real");
+	Tcl_UnlinkVar(interp, "bool");
+	Tcl_UnlinkVar(interp, "string");
+	created = 0;
+    } else if (strcmp(argv[1], "get") == 0) {
+	sprintf(buffer, "%d", intVar);
+	Tcl_AppendElement(interp, buffer);
+	Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
+	Tcl_AppendElement(interp, buffer);
+	sprintf(buffer, "%d", boolVar);
+	Tcl_AppendElement(interp, buffer);
+	Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar);
+    } else if (strcmp(argv[1], "set") == 0) {
+	if (argc != 6) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " ", argv[1],
+		"intValue realValue boolValue stringValue\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (argv[2][0] != 0) {
+	    if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	if (argv[3][0] != 0) {
+	    if (Tcl_GetDouble(interp, argv[3], &realVar) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	if (argv[4][0] != 0) {
+	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	if (argv[5][0] != 0) {
+	    if (stringVar != NULL) {
+		ckfree(stringVar);
+	    }
+	    if (strcmp(argv[5], "-") == 0) {
+		stringVar = NULL;
+	    } else {
+		stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
+		strcpy(stringVar, argv[5]);
+	    }
+	}
+    } else if (strcmp(argv[1], "update") == 0) {
+	if (argc != 6) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " ", argv[1],
+		"intValue realValue boolValue stringValue\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (argv[2][0] != 0) {
+	    if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tcl_UpdateLinkedVar(interp, "int");
+	}
+	if (argv[3][0] != 0) {
+	    if (Tcl_GetDouble(interp, argv[3], &realVar) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tcl_UpdateLinkedVar(interp, "real");
+	}
+	if (argv[4][0] != 0) {
+	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tcl_UpdateLinkedVar(interp, "bool");
+	}
+	if (argv[5][0] != 0) {
+	    if (stringVar != NULL) {
+		ckfree(stringVar);
+	    }
+	    if (strcmp(argv[5], "-") == 0) {
+		stringVar = NULL;
+	    } else {
+		stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
+		strcpy(stringVar, argv[5]);
+	    }
+	    Tcl_UpdateLinkedVar(interp, "string");
+	}
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": should be create, delete, get, set, or update",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestMathFunc --
+ *
+ *	This is a user-defined math procedure to test out math procedures
+ *	with no arguments.
+ *
+ * Results:
+ *	A normal Tcl completion code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestMathFunc(clientData, interp, args, resultPtr)
+    ClientData clientData;		/* Integer value to return. */
+    Tcl_Interp *interp;			/* Not used. */
+    Tcl_Value *args;			/* Not used. */
+    Tcl_Value *resultPtr;		/* Where to store result. */
+{
+    resultPtr->type = TCL_INT;
+    resultPtr->intValue = (int) clientData;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestMathFunc2 --
+ *
+ *	This is a user-defined math procedure to test out math procedures
+ *	that do have arguments, in this case 2.
+ *
+ * Results:
+ *	A normal Tcl completion code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+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. */
+{
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupTestSetassocdataTests --
+ *
+ *	This function is called when an interpreter is deleted to clean
+ *	up any data left over from running the testsetassocdata command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Releases storage.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* ARGSUSED */
+static void
+CleanupTestSetassocdataTests(clientData, interp)
+    ClientData clientData;		/* Data to be released. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
+{
+    ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetassocdataCmd --
+ *
+ *	This procedure implements the "testsetassocdata" command. It is used
+ *	to test Tcl_SetAssocData.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Modifies or creates an association between a key and associated
+ *	data for this interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetassocdataCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    char *buf;
+    char *oldData;
+    Tcl_InterpDeleteProc *procPtr;
+    
+    if (argc != 3) {
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " data_key data_item\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    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);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetplatformCmd --
+ *
+ *	This procedure implements the "testsetplatform" command. It is
+ *	used to change the tclPlatform global variable so all file
+ *	name conversions can be tested on a single platform.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets the tclPlatform global variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetplatformCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    size_t length;
+    TclPlatformType *platform;
+
+#ifdef __WIN32__
+    platform = TclWinGetPlatform();
+#else
+    platform = &tclPlatform;
+#endif
+    
+    if (argc != 2) {
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " platform\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    length = strlen(argv[1]);
+    if (strncmp(argv[1], "unix", length) == 0) {
+	*platform = TCL_PLATFORM_UNIX;
+    } else if (strncmp(argv[1], "mac", length) == 0) {
+	*platform = TCL_PLATFORM_MAC;
+    } else if (strncmp(argv[1], "windows", length) == 0) {
+	*platform = TCL_PLATFORM_WINDOWS;
+    } else {
+        Tcl_AppendResult(interp, "unsupported platform: should be one of ",
+		"unix, mac, or windows", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetrecursionlimitCmd --
+ *
+ *	This procedure implements the "testsetrecursionlimit" command. It is
+ *	used to change the interp recursion limit (to test the effects
+ *      of Tcl_SetRecursionLimit).
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets the interp's recursion limit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetrecursionlimitCmd(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. */
+{
+    int     value;
+
+    if (objc != 2) {
+    	Tcl_WrongNumArgs(interp, 1, objv, "integer");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    value = Tcl_SetRecursionLimit(interp, value);
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
+    return TCL_OK;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TeststaticpkgCmd --
+ *
+ *	This procedure implements the "teststaticpkg" command.
+ *	It is used to test the procedure Tcl_StaticPackage.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	When the packge given by argv[1] is loaded into an interpeter,
+ *	variable "x" in that interpreter is set to "loaded".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TeststaticpkgCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int safe, loaded;
+
+    if (argc != 4) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+		argv[0], " pkgName safe loaded\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
+	    (safe) ? StaticInitProc : NULL);
+    return TCL_OK;
+}
+
+static int
+StaticInitProc(interp)
+    Tcl_Interp *interp;			/* Interpreter in which package
+					 * is supposedly being loaded. */
+{
+    Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TesttranslatefilenameCmd --
+ *
+ *	This procedure implements the "testtranslatefilename" command.
+ *	It is used to test the Tcl_TranslateFileName command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TesttranslatefilenameCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_DString buffer;
+    char *result;
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+		argv[0], " path\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    result = Tcl_TranslateFileName(interp, argv[1], &buffer);
+    if (result == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_AppendResult(interp, result, NULL);
+    Tcl_DStringFree(&buffer);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestupvarCmd --
+ *
+ *	This procedure implements the "testupvar2" command.  It is used
+ *	to test Tcl_UpVar and Tcl_UpVar2.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates or modifies an "upvar" reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestupvarCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    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);
+	return TCL_ERROR;
+    }
+
+    if (argc == 5) {
+	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],
+		flags);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwordendCmd --
+ *
+ *	This procedure implements the "testwordend" command.  It is used
+ *	to test TclWordEnd.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+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. */
+{
+    Tcl_Obj *objPtr;
+    char *string, *end;
+    int length;
+
+    if (objc != 2) {
+    	Tcl_WrongNumArgs(interp, 1, objv, "string");
+	return TCL_ERROR;
+    }
+    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
+ *	used for testing the "fileevent" command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates and deletes interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestfeventCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    static Tcl_Interp *interp2 = NULL;
+    int code;
+    Tcl_Channel chan;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option ?arg arg ...?", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if (strcmp(argv[1], "cmd") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " cmd script", (char *) NULL);
+	    return TCL_ERROR;
+	}
+        if (interp2 != (Tcl_Interp *) NULL) {
+            code = Tcl_GlobalEval(interp2, argv[2]);
+            interp->result = interp2->result;
+            return code;
+        } else {
+            Tcl_AppendResult(interp,
+                    "called \"testfevent code\" before \"testfevent create\"",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else if (strcmp(argv[1], "create") == 0) {
+	if (interp2 != NULL) {
+            Tcl_DeleteInterp(interp2);
+	}
+        interp2 = Tcl_CreateInterp();
+	return TCL_OK;
+    } else if (strcmp(argv[1], "delete") == 0) {
+	if (interp2 != NULL) {
+            Tcl_DeleteInterp(interp2);
+	}
+	interp2 = NULL;
+    } else if (strcmp(argv[1], "share") == 0) {
+        if (interp2 != NULL) {
+            chan = Tcl_GetChannel(interp, argv[2], NULL);
+            if (chan == (Tcl_Channel) NULL) {
+                return TCL_ERROR;
+            }
+            Tcl_RegisterChannel(interp2, chan);
+        }
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestPanicCmd --
+ *
+ *	Calls the panic routine.
+ *
+ * Results:
+ *      Always returns TCL_OK. 
+ *
+ * Side effects:
+ *	May exit application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestPanicCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    char *argString;
+    
+    /*
+     *  Put the arguments into a var args structure
+     *  Append all of the arguments together separated by spaces
+     */
+
+    argString = Tcl_Merge(argc-1, argv+1);
+    panic(argString);
+    ckfree(argString);
+ 
+    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 == argv[1]) || (*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;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TeststatprocCmd  --
+ *
+ *	Implements the "testTclStatProc" cmd that is used to test the
+ *	'TclStatInsertProc' & 'TclStatDeleteProc' C Apis.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TeststatprocCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    TclStatProc_ *proc;
+    int retVal;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[2], "TclpStat") == 0) {
+	proc = TclpStat;
+    } else if (strcmp(argv[2], "TestStatProc1") == 0) {
+	proc = TestStatProc1;
+    } else if (strcmp(argv[2], "TestStatProc2") == 0) {
+	proc = TestStatProc2;
+    } else if (strcmp(argv[2], "TestStatProc3") == 0) {
+	proc = TestStatProc3;
+    } else {
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		"must be TclpStat, ",
+		"TestStatProc1, TestStatProc2, or TestStatProc3",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1], "insert") == 0) {
+	if (proc == TclpStat) {
+	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		   "must be ",
+		   "TestStatProc1, TestStatProc2, or TestStatProc3",
+		   (char *) NULL);
+	    return TCL_ERROR;
+	}
+	retVal = TclStatInsertProc(proc);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	retVal = TclStatDeleteProc(proc);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
+		"must be insert or delete", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (retVal == TCL_ERROR) {
+	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
+		"could not be ", argv[1], "ed", (char *) NULL);
+    }
+
+    return retVal;
+}
+
+/* Be careful in the compares in these tests, since the Macintosh puts a  
+ * leading : in the beginning of non-absolute paths before passing them 
+ * into the file command procedures.
+ */
+ 
+static int
+TestStatProc1(path, buf)
+    CONST char *path;
+    TclStat_ *buf;
+{
+    buf->st_size = 1234;
+    return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestStatProc2(path, buf)
+    CONST char *path;
+    TclStat_ *buf;
+{
+    buf->st_size = 2345;
+    return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestStatProc3(path, buf)
+    CONST char *path;
+    TclStat_ *buf;
+{
+    buf->st_size = 3456;
+    return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestaccessprocCmd  --
+ *
+ *	Implements the "testTclAccessProc" cmd that is used to test the
+ *	'TclAccessInsertProc' & 'TclAccessDeleteProc' C Apis.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestaccessprocCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    TclAccessProc_ *proc;
+    int retVal;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[2], "TclpAccess") == 0) {
+	proc = TclpAccess;
+    } else if (strcmp(argv[2], "TestAccessProc1") == 0) {
+	proc = TestAccessProc1;
+    } else if (strcmp(argv[2], "TestAccessProc2") == 0) {
+	proc = TestAccessProc2;
+    } else if (strcmp(argv[2], "TestAccessProc3") == 0) {
+	proc = TestAccessProc3;
+    } else {
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		"must be TclpAccess, ",
+		"TestAccessProc1, TestAccessProc2, or TestAccessProc3",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1], "insert") == 0) {
+	if (proc == TclpAccess) {
+	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		   "must be ",
+		   "TestAccessProc1, TestAccessProc2, or TestAccessProc3",
+		   (char *) NULL);
+	    return TCL_ERROR;
+	}
+	retVal = TclAccessInsertProc(proc);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	retVal = TclAccessDeleteProc(proc);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
+		"must be insert or delete", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (retVal == TCL_ERROR) {
+	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
+		"could not be ", argv[1], "ed", (char *) NULL);
+    }
+
+    return retVal;
+}
+
+
+static int
+TestAccessProc1(path, mode)
+    CONST char *path;
+    int mode;
+{
+    return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestAccessProc2(path, mode)
+    CONST char *path;
+    int mode;
+{
+    return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestAccessProc3(path, mode)
+    CONST char *path;
+    int mode;
+{
+    return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestopenfilechannelprocCmd  --
+ *
+ *	Implements the "testTclOpenFileChannelProc" cmd that is used to test the
+ *	'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C Apis.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestopenfilechannelprocCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    TclOpenFileChannelProc_ *proc;
+    int retVal;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
+	proc = TclpOpenFileChannel;
+    } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
+	proc = TestOpenFileChannelProc1;
+    } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
+	proc = TestOpenFileChannelProc2;
+    } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) {
+	proc = TestOpenFileChannelProc3;
+    } else {
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		"must be TclpOpenFileChannel, ",
+		"TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
+		"TestOpenFileChannelProc3",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1], "insert") == 0) {
+	if (proc == TclpOpenFileChannel) {
+	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		   "must be ",
+		   "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
+		   "TestOpenFileChannelProc3",
+		   (char *) NULL);
+	    return TCL_ERROR;
+	}
+	retVal = TclOpenFileChannelInsertProc(proc);
+    } else if (strcmp(argv[1], "delete") == 0) {
+	retVal = TclOpenFileChannelDeleteProc(proc);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
+		"must be insert or delete", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (retVal == TCL_ERROR) {
+	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
+		"could not be ", argv[1], "ed", (char *) NULL);
+    }
+
+    return retVal;
+}
+
+
+static Tcl_Channel
+TestOpenFileChannelProc1(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;                     /* Name of file to open. */
+    char *modeString;                   /* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;                    /* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    if (!strcmp("testOpenFileChannel1%.fil", fileName)) {
+	return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
+		modeString, permissions));
+    } else {
+	return (NULL);
+    }
+}
+
+
+static Tcl_Channel
+TestOpenFileChannelProc2(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;                     /* Name of file to open. */
+    char *modeString;                   /* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;                    /* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    if (!strcmp("testOpenFileChannel2%.fil", fileName)) {
+	return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
+		modeString, permissions));
+    } else {
+	return (NULL);
+    }
+}
+
+
+static Tcl_Channel
+TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;                 /* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;                     /* Name of file to open. */
+    char *modeString;                   /* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;                    /* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    if (!strcmp("testOpenFileChannel3%.fil", fileName)) {
+	return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
+		modeString, permissions));
+    } else {
+	return (NULL);
+    }
+}
diff --git a/tcl/generic/tclTestObj.c b/tcl/generic/tclTestObj.c
new file mode 100644
index 00000000000..e8730e035d5
--- /dev/null
+++ b/tcl/generic/tclTestObj.c
@@ -0,0 +1,1105 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 12
+    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);
+	    }
+#if PURIFY
+	    for (int cou = objc - 3; cou < MAX_STRINGS; cou++)
+	    {
+		strings[cou] = NULL;
+	    }
+#else
+	    strings[objc-3] = NULL;
+#endif /* PURIFY */
+
+	    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/tcl/generic/tclTestProcBodyObj.c b/tcl/generic/tclTestProcBodyObj.c
new file mode 100644
index 00000000000..7af58230572
--- /dev/null
+++ b/tcl/generic/tclTestProcBodyObj.c
@@ -0,0 +1,319 @@
+/* 
+ * tclTestProcBodyObj.c --
+ *
+ *	Implements the "procbodytest" package, which contains commands
+ *	to test creation of Tcl procedures whose body argument is a
+ *	Tcl_Obj of type "procbody" rather than a string.
+ *
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * name and version of this package
+ */
+
+static char packageName[] = "procbodytest";
+static char packageVersion[] = "1.0";
+
+/*
+ * Name of the commands exported by this package
+ */
+
+static char procCommand[] = "proc";
+
+/*
+ * this struct describes an entry in the table of command names and command
+ * procs
+ */
+
+typedef struct CmdTable
+{
+    char *cmdName;		/* command name */
+    Tcl_ObjCmdProc *proc;	/* command proc */
+    int exportIt;		/* if 1, export the command */
+} CmdTable;
+
+/*
+ * Declarations for functions defined in this file.
+ */
+
+static int	ProcBodyTestProcObjCmd _ANSI_ARGS_((ClientData dummy,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int	ProcBodyTestInitInternal _ANSI_ARGS_((Tcl_Interp *interp,
+			int isSafe));
+static int	RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp,
+			char *namespace, CONST CmdTable *cmdTablePtr));
+int             Procbodytest_Init _ANSI_ARGS_((Tcl_Interp * interp));
+int             Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
+
+/*
+ * List of commands to create when the package is loaded; must go after the
+ * declarations of the enable command procedure.
+ */
+
+static CONST CmdTable commands[] =
+{
+    { procCommand,	ProcBodyTestProcObjCmd,	1 },
+
+    { 0, 0, 0 }
+};
+
+static CONST CmdTable safeCommands[] =
+{
+    { procCommand,	ProcBodyTestProcObjCmd,	1 },
+
+    { 0, 0, 0 }
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Procbodytest_Init --
+ *
+ *  This procedure initializes the "procbodytest" package.
+ *
+ * Results:
+ *  A standard Tcl result.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Procbodytest_Init(interp)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
+{
+    return ProcBodyTestInitInternal(interp, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Procbodytest_SafeInit --
+ *
+ *  This procedure initializes the "procbodytest" package.
+ *
+ * Results:
+ *  A standard Tcl result.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Procbodytest_SafeInit(interp)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
+{
+    return ProcBodyTestInitInternal(interp, 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegisterCommand --
+ *
+ *  This procedure registers a command in the context of the given namespace.
+ *
+ * Results:
+ *  A standard Tcl result.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int RegisterCommand(interp, namespace, cmdTablePtr)
+    Tcl_Interp* interp;			/* the Tcl interpreter for which the
+                                         * operation is performed */
+    char *namespace;			/* the namespace in which the command
+                                         * is registered */
+    CONST CmdTable *cmdTablePtr;	/* the command to register */
+{
+    char buf[128];
+
+    if (cmdTablePtr->exportIt) {
+        sprintf(buf, "namespace eval %s { namespace export %s }",
+                namespace, cmdTablePtr->cmdName);
+        if (Tcl_Eval(interp, buf) != TCL_OK)
+            return TCL_ERROR;
+    }
+    
+    sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
+    Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyTestInitInternal --
+ *
+ *  This procedure initializes the Loader package.
+ *  The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
+ *
+ * Results:
+ *  A standard Tcl result.
+ *
+ * Side effects:
+ *  None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcBodyTestInitInternal(interp, isSafe)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
+    int isSafe;			/* 1 if this is a safe interpreter */
+{
+    CONST CmdTable *cmdTablePtr;
+
+    cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
+    for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
+        if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
+            return TCL_ERROR;
+        }
+    }
+    
+    return Tcl_PkgProvide(interp, packageName, packageVersion);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcBodyTestProcObjCmd --
+ *
+ *  Implements the "procbodytest::proc" command. Here is the command
+ *  description:
+ *	procbodytest::proc newName argList bodyName
+ *  Looks up a procedure called $bodyName and, if the procedure exists,
+ *  constructs a Tcl_Obj of type "procbody" and calls Tcl_ProcObjCmd.
+ *  Arguments:
+ *    newName		the name of the procedure to be created
+ *    argList		the argument list for the procedure
+ *    bodyName		the name of an existing procedure from which the
+ *			body is to be copied.
+ *  This command can be used to trigger the branches in Tcl_ProcObjCmd that
+ *  construct a proc from a "procbody", for example:
+ *	proc a {x} {return $x}
+ *	a 123
+ *	procbodytest::proc b {x} a
+ *  Note the call to "a 123", which is necessary so that the Proc pointer
+ *  for "a" is filled in by the internal compiler; this is a hack.
+ *
+ * Results:
+ *  Returns a standard Tcl code.
+ *
+ * Side effects:
+ *  A new procedure is created.
+ *  Leaves an error message in the interp's result on error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
+    ClientData dummy;		/* context; not used */
+    Tcl_Interp *interp;		/* the current interpreter */
+    int objc;			/* argument count */
+    Tcl_Obj *CONST objv[];	/* arguments */
+{
+    char *fullName;
+    Tcl_Command procCmd;
+    Command *cmdPtr;
+    Proc *procPtr = (Proc *) NULL;
+    Tcl_Obj *bodyObjPtr;
+    Tcl_Obj *myobjv[5];
+    int result;
+    
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Find the Command pointer to this procedure
+     */
+    
+    fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+    procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL,
+            TCL_LEAVE_ERR_MSG);
+    if (procCmd == NULL) {
+        return TCL_ERROR;
+    }
+
+    cmdPtr = (Command *) procCmd;
+
+    /*
+     * check that this is a procedure and not a builtin command:
+     * If a procedure, cmdPtr->objProc is either 0 or TclObjInterpProc,
+     * and cmdPtr->proc is either 0 or TclProcInterpProc.
+     * Also, the compile proc should be 0, but we don't check for that.
+     */
+
+    if (((cmdPtr->objProc != NULL)
+            && (cmdPtr->objProc != TclGetObjInterpProc()))
+            || ((cmdPtr->proc != NULL)
+                    && (cmdPtr->proc != TclGetInterpProc()))) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"command \"", fullName,
+		"\" is not a Tcl procedure", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * it is a Tcl procedure: the client data is the Proc structure
+     */
+    
+    if (cmdPtr->objProc != NULL) {
+        procPtr = (Proc *) cmdPtr->objClientData;
+    } else if (cmdPtr->proc != NULL) {
+        procPtr = (Proc *) cmdPtr->clientData;
+    }
+
+    if (procPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"procedure \"", fullName,
+		"\" does not have a Proc struct!", (char *) NULL);
+        return TCL_ERROR;
+    }
+        
+    /*
+     * create a new object, initialize our argument vector, call into Tcl
+     */
+
+    bodyObjPtr = TclNewProcBodyObj(procPtr);
+    if (bodyObjPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"failed to create a procbody object for procedure \"",
+                fullName, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    Tcl_IncrRefCount(bodyObjPtr);
+
+    myobjv[0] = objv[0];
+    myobjv[1] = objv[1];
+    myobjv[2] = objv[2];
+    myobjv[3] = bodyObjPtr;
+    myobjv[4] = (Tcl_Obj *) NULL;
+
+    result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
+    Tcl_DecrRefCount(bodyObjPtr);
+
+    return result;
+}
diff --git a/tcl/generic/tclTimer.c b/tcl/generic/tclTimer.c
new file mode 100644
index 00000000000..6e685a8f946
--- /dev/null
+++ b/tcl/generic/tclTimer.c
@@ -0,0 +1,1108 @@
+/* 
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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_AfterObjCmd --
+ *
+ *	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_AfterObjCmd(clientData, interp, objc, objv)
+    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 objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    /*
+     * 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;
+    int length;
+    char *arg;
+    int index, result;
+    static char *subCmds[] = {
+        "cancel", "idle", "info",
+        (char *) NULL};
+    
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	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 = NULL;
+	cmdInfo.clientData = (ClientData) NULL;
+	cmdInfo.objProc = Tcl_AfterObjCmd;
+	cmdInfo.objClientData = (ClientData) assocPtr;
+	cmdInfo.deleteProc = NULL;
+	cmdInfo.deleteData = (ClientData) assocPtr;
+	Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length),
+		&cmdInfo);
+    }
+
+    /*
+     * First lets see if the command was passed a number as the first argument.
+     */
+    
+    arg = Tcl_GetStringFromObj(objv[1], &length);
+    if (isdigit(UCHAR(arg[0]))) {
+	if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (ms < 0) {
+	    ms = 0;
+	}
+	if (objc == 2) {
+	    Tcl_Sleep(ms);
+	    return TCL_OK;
+	}
+	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr->assocPtr = assocPtr;
+	if (objc == 3) {
+	    arg = Tcl_GetStringFromObj(objv[2], &length);
+	    afterPtr->command = (char *) ckalloc((unsigned) (length + 1));
+	    strcpy(afterPtr->command, arg);
+	} else {
+	    Tcl_Obj *objPtr = Tcl_ConcatObj(objc-2, objv+2);
+	    arg = Tcl_GetStringFromObj(objPtr, &length);
+	    afterPtr->command = (char *) ckalloc((unsigned) (length + 1));
+	    strcpy(afterPtr->command, arg);
+	    Tcl_DecrRefCount(objPtr);
+	}
+	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);
+	return TCL_OK;
+    }
+
+    /*
+     * If it's not a number it must be a subcommand.
+     */
+    result = Tcl_GetIndexFromObj(NULL, objv[1], subCmds, "option",
+            0, (int *) &index);
+    if (result != TCL_OK) {
+	Tcl_AppendResult(interp, "bad argument \"", arg,
+		"\": must be cancel, idle, info, or a number",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    switch (index) {
+        case 0:		/* cancel */
+	    {
+		char *arg;
+		Tcl_Obj *objPtr = NULL;
+
+		if (objc < 3) {
+		    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
+		    return TCL_ERROR;
+		}
+		if (objc == 3) {
+		    arg = Tcl_GetStringFromObj(objv[2], &length);
+		} else {
+		    objPtr = Tcl_ConcatObj(objc-2, objv+2);;
+		    arg = Tcl_GetStringFromObj(objPtr, &length);
+		}
+		for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
+		     afterPtr = afterPtr->nextPtr) {
+		    if (strcmp(afterPtr->command, arg) == 0) {
+			break;
+		    }
+		}
+		if (afterPtr == NULL) {
+		    afterPtr = GetAfterEvent(assocPtr, arg);
+		}
+		if (objPtr != NULL) {
+		    Tcl_DecrRefCount(objPtr);
+		}
+		if (afterPtr != NULL) {
+		    if (afterPtr->token != NULL) {
+			Tcl_DeleteTimerHandler(afterPtr->token);
+		    } else {
+			Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+		    }
+		    FreeAfterPtr(afterPtr);
+		}
+		break;
+	    }
+	case 1:		/* idle */
+	    if (objc < 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+		return TCL_ERROR;
+	    }
+	    afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	    afterPtr->assocPtr = assocPtr;
+	    if (objc == 3) {
+		arg = Tcl_GetStringFromObj(objv[2], &length);
+		afterPtr->command = (char *) ckalloc((unsigned) length + 1);
+		strcpy(afterPtr->command, arg);
+	    } else {
+		Tcl_Obj *objPtr = Tcl_ConcatObj(objc-2, objv+2);;
+		arg = Tcl_GetStringFromObj(objPtr, &length);
+		afterPtr->command = (char *) ckalloc((unsigned) (length + 1));
+		strcpy(afterPtr->command, arg);
+		Tcl_DecrRefCount(objPtr);
+	    }
+	    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);
+	    break;
+	case 2:		/* info */
+	    if (objc == 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 (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?id?");
+		return TCL_ERROR;
+	    }
+	    arg = Tcl_GetStringFromObj(objv[2], &length);
+	    afterPtr = GetAfterEvent(assocPtr, arg);
+	    if (afterPtr == NULL) {
+		Tcl_AppendResult(interp, "event \"", arg,
+			"\" doesn't exist", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_AppendElement(interp, afterPtr->command);
+	    Tcl_AppendElement(interp,
+		    (afterPtr->token == NULL) ? "idle" : "timer");
+	    break;
+    }
+    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/tcl/generic/tclUtil.c b/tcl/generic/tclUtil.c
new file mode 100644
index 00000000000..ef60a9d4755
--- /dev/null
+++ b/tcl/generic/tclUtil.c
@@ -0,0 +1,2843 @@
+/* 
+ * tclUtil.c --
+ *
+ *	This file contains utility procedures that are used by many Tcl
+ *	commands.
+ *
+ * Copyright (c) 1987-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.
+ *
+ *  RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following variable holds the full path name of the binary
+ * from which this application was executed, or NULL if it isn't
+ * know.  The value of the variable is set by the procedure
+ * Tcl_FindExecutable.  The storage space is dynamically allocated.
+ */
+ 
+char *tclExecutableName = NULL;
+
+/*
+ * The following values are used in the flags returned by Tcl_ScanElement
+ * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also
+ * defined in tcl.h;  make sure its value doesn't overlap with any of the
+ * values below.
+ *
+ * TCL_DONT_USE_BRACES -	1 means the string mustn't be enclosed in
+ *				braces (e.g. it contains unmatched braces,
+ *				or ends in a backslash character, or user
+ *				just doesn't want braces);  handle all
+ *				special characters by adding backslashes.
+ * USE_BRACES -			1 means the string contains a special
+ *				character that can be handled simply by
+ *				enclosing the entire argument in braces.
+ * BRACES_UNMATCHED -		1 means that braces aren't properly matched
+ *				in the argument.
+ */
+
+#define USE_BRACES		2
+#define BRACES_UNMATCHED	4
+
+/*
+ * The following values determine the precision used when converting
+ * floating-point values to strings.  This information is linked to all
+ * of the tcl_precision variables in all interpreters via the procedure
+ * TclPrecTraceProc.
+ *
+ * NOTE: these variables are not thread-safe.
+ */
+
+static char precisionString[10] = "12";
+				/* The string value of all the tcl_precision
+				 * variables. */
+static char precisionFormat[10] = "%.12g";
+				/* The format string actually used in calls
+				 * to sprintf. */
+
+
+/*
+ * Function prototypes for local procedures in this file:
+ */
+
+static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
+			    int newSpace));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFindElement --
+ *
+ *	Given a pointer into a Tcl list, locate the first (or next)
+ *	element in the list.
+ *
+ * Results:
+ *	The return value is normally TCL_OK, which means that the
+ *	element was successfully located.  If TCL_ERROR is returned
+ *	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 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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. */
+    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 (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
+				 * to indicate that arg was/wasn't
+				 * in braces. */
+{
+    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 = 0;		/* Init. avoids compiler warning. */
+    int numChars;
+    char *p2;
+    
+    /*
+     * Skim off leading white space and check for an opening brace or
+     * 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
+     * be changed back eventually, or all of Tcl should call isascii.
+     */
+
+    limit = (list + listLength);
+    while ((p < limit) && (isspace(UCHAR(*p)))) {
+	p++;
+    }
+    if (p == limit) {		/* no element found */
+	elemStart = limit;
+	goto done;
+    }
+
+    if (*p == '{') {
+	openBraces = 1;
+	p++;
+    } else if (*p == '"') {
+	inQuotes = 1;
+	p++;
+    }
+    elemStart = p;
+    if (bracePtr != 0) {
+	*bracePtr = openBraces;
+    }
+
+    /*
+     * Find element's end (a space, close brace, or the end of the string).
+     */
+
+    while (p < limit) {
+	switch (*p) {
+
+	    /*
+	     * Open brace: don't treat specially unless the element is in
+	     * braces. In this case, keep a nesting count.
+	     */
+
+	    case '{':
+		if (openBraces != 0) {
+		    openBraces++;
+		}
+		break;
+
+	    /*
+	     * Close brace: if element is in braces, keep nesting count and
+	     * quit when the last close brace is seen.
+	     */
+
+	    case '}':
+		if (openBraces > 1) {
+		    openBraces--;
+		} else if (openBraces == 1) {
+		    size = (p - elemStart);
+		    p++;
+		    if ((p >= limit) || isspace(UCHAR(*p))) {
+			goto done;
+		    }
+
+		    /*
+		     * Garbage after the closing brace; return an error.
+		     */
+		    
+		    if (interp != NULL) {
+			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;
+		}
+		break;
+
+	    /*
+	     * Backslash:  skip over everything up to the end of the
+	     * backslash sequence.
+	     */
+
+	    case '\\': {
+		(void) Tcl_Backslash(p, &numChars);
+		p += (numChars - 1);
+		break;
+	    }
+
+	    /*
+	     * Space: ignore if element is in braces or quotes; otherwise
+	     * terminate element.
+	     */
+
+	    case ' ':
+	    case '\f':
+	    case '\n':
+	    case '\r':
+	    case '\t':
+	    case '\v':
+		if ((openBraces == 0) && !inQuotes) {
+		    size = (p - elemStart);
+		    goto done;
+		}
+		break;
+
+	    /*
+	     * Double-quote: if element is in quotes then terminate it.
+	     */
+
+	    case '"':
+		if (inQuotes) {
+		    size = (p - elemStart);
+		    p++;
+		    if ((p >= limit) || isspace(UCHAR(*p))) {
+			goto done;
+		    }
+
+		    /*
+		     * Garbage after the closing quote; return an error.
+		     */
+		    
+		    if (interp != NULL) {
+			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.
+     */
+
+    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;
+	}
+	size = (p - elemStart);
+    }
+
+    done:
+    while ((p < limit) && (isspace(UCHAR(*p)))) {
+	p++;
+    }
+    *elementPtr = elemStart;
+    *nextPtr = p;
+    if (sizePtr != 0) {
+	*sizePtr = size;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCopyAndCollapse --
+ *
+ *	Copy a string and eliminate any backslashes that aren't in braces.
+ *
+ * Results:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCopyAndCollapse(count, src, dst)
+    int count;			/* Number of characters to copy from src. */
+    char *src;			/* Copy from here... */
+    char *dst;			/* ... to here. */
+{
+    char c;
+    int numRead;
+    int newCount = 0;
+
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SplitList --
+ *
+ *	Splits a list up into its constituent fields.
+ *
+ * Results
+ *	The return value is normally TCL_OK, which means that
+ *	the list was successfully split up.  If TCL_ERROR is
+ *	returned, it means that "list" didn't have proper list
+ *	structure;  interp->result will contain a more detailed
+ *	error message.
+ *
+ *	*argvPtr will be filled in with the address of an array
+ *	whose elements point to the elements of list, in order.
+ *	*argcPtr will get filled in with the number of valid elements
+ *	in the array.  A single block of memory is dynamically allocated
+ *	to hold both the argv array and a copy of the list (with
+ *	backslashes and braces removed in the standard way).
+ *	The caller must eventually free this memory by calling free()
+ *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
+ *	if the procedure returns normally.
+ *
+ * Side effects:
+ *	Memory is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SplitList(interp, list, argcPtr, argvPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
+				 * 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 **argv;
+    char *p;
+    int length, size, i, result, elSize, brace;
+    char *element;
+
+    /*
+     * Figure out how much space to allocate.  There must be enough
+     * space for both the array of pointers and also for a copy of
+     * the list.  To estimate the number of pointers needed, count
+     * the number of space characters in the list.
+     */
+
+    for (size = 1, p = list; *p != 0; p++) {
+	if (isspace(UCHAR(*p))) {
+	    size++;
+	}
+    }
+    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++) {
+	char *prevList = list;
+	
+	result = TclFindElement(interp, list, length, &element,
+				&list, &elSize, &brace);
+	length -= (list - prevList);
+	if (result != TCL_OK) {
+	    ckfree((char *) argv);
+	    return result;
+	}
+	if (*element == 0) {
+	    break;
+	}
+	if (i >= size) {
+	    ckfree((char *) argv);
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
+			TCL_STATIC);
+	    }
+	    return TCL_ERROR;
+	}
+	argv[i] = p;
+	if (brace) {
+	    memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
+	    p += elSize;
+	    *p = 0;
+	    p++;
+	} else {
+	    TclCopyAndCollapse(elSize, element, p);
+	    p += elSize+1;
+	}
+    }
+
+    argv[i] = NULL;
+    *argvPtr = argv;
+    *argcPtr = i;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *	The return value is an overestimate of the number of characters
+ *	that will be needed by Tcl_ConvertElement to produce a valid
+ *	list element from string.  The word at *flagPtr is filled in
+ *	with a value needed by Tcl_ConvertElement when doing the actual
+ *	conversion.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ScanElement(string, flagPtr)
+    CONST 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)
+    CONST 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;
+    CONST char *p, *lastChar;
+
+    /*
+     * This procedure and Tcl_ConvertElement together do two things:
+     *
+     * 1. They produce a proper list, one that will yield back the
+     * argument strings when evaluated or when disassembled with
+     * Tcl_SplitList.  This is the most important thing.
+     * 
+     * 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:
+     *
+     * (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.
+     * This happens if the element contains embedded space, or if it
+     * contains characters with special interpretation ($, [, ;, or \),
+     * or if it starts with a brace or double-quote, or if there are
+     * no characters in the element.
+     *
+     * (c) Don't enclose the element in braces, but add backslashes to
+     * prevent special interpretation of special characters.  This is a
+     * last resort used when the argument would normally fall under case
+     * (b) but contains unmatched braces.  It also occurs if the last
+     * character of the argument is a backslash or if the element contains
+     * 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
+     * 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;
+    flags = 0;
+    if (string == NULL) {
+	string = "";
+    }
+    if (length == -1) {
+	length = strlen(string);
+    }
+    lastChar = string + length;
+    p = string;
+    if ((p == lastChar) || (*p == '{') || (*p == '"')) {
+	flags |= USE_BRACES;
+    }
+    for ( ; p != lastChar; p++) {
+	switch (*p) {
+	    case '{':
+		nestingLevel++;
+		break;
+	    case '}':
+		nestingLevel--;
+		if (nestingLevel < 0) {
+		    flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
+		}
+		break;
+	    case '[':
+	    case '$':
+	    case ';':
+	    case ' ':
+	    case '\f':
+	    case '\n':
+	    case '\r':
+	    case '\t':
+	    case '\v':
+		flags |= USE_BRACES;
+		break;
+	    case '\\':
+		if ((p+1 == lastChar) || (p[1] == '\n')) {
+		    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+		} else {
+		    int size;
+
+		    (void) Tcl_Backslash(p, &size);
+		    p += size-1;
+		    flags |= USE_BRACES;
+		}
+		break;
+	}
+    }
+    if (nestingLevel != 0) {
+	flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+    }
+    *flagPtr = flags;
+
+    /*
+     * Allow enough space to backslash every character plus leave
+     * two spaces for braces.
+     */
+
+    return 2*(p-string) + 2;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * 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_ConvertElement(src, dst, flags)
+    CONST char *src;		/* Source information for list element. */
+    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)
+    CONST 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. */
+{
+    char *p = dst;
+    CONST char *lastChar;
+
+    /*
+     * See the comment block at the beginning of the Tcl_ScanElement
+     * code for details of how this works.
+     */
+
+    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 != lastChar; src++, p++) {
+	    *p = *src;
+	}
+	*p = '}';
+	p++;
+    } else {
+	if (*src == '{') {
+	    /*
+	     * Can't have a leading brace unless the whole element is
+	     * enclosed in braces.  Add a backslash before the brace.
+	     * Furthermore, this may destroy the balance between open
+	     * and close braces, so set BRACES_UNMATCHED.
+	     */
+
+	    p[0] = '\\';
+	    p[1] = '{';
+	    p += 2;
+	    src++;
+	    flags |= BRACES_UNMATCHED;
+	}
+	for (; src != lastChar; src++) {
+	    switch (*src) {
+		case ']':
+		case '[':
+		case '$':
+		case ';':
+		case ' ':
+		case '\\':
+		case '"':
+		    *p = '\\';
+		    p++;
+		    break;
+		case '{':
+		case '}':
+		    /*
+		     * It may not seem necessary to backslash braces, but
+		     * it is.  The reason for this is that the resulting
+		     * list element may actually be an element of a sub-list
+		     * enclosed in braces (e.g. if Tcl_DStringStartSublist
+		     * has been invoked), so there may be a brace mismatch
+		     * if the braces aren't backslashed.
+		     */
+
+		    if (flags & BRACES_UNMATCHED) {
+			*p = '\\';
+			p++;
+		    }
+		    break;
+		case '\f':
+		    *p = '\\';
+		    p++;
+		    *p = 'f';
+		    p++;
+		    continue;
+		case '\n':
+		    *p = '\\';
+		    p++;
+		    *p = 'n';
+		    p++;
+		    continue;
+		case '\r':
+		    *p = '\\';
+		    p++;
+		    *p = 'r';
+		    p++;
+		    continue;
+		case '\t':
+		    *p = '\\';
+		    p++;
+		    *p = 't';
+		    p++;
+		    continue;
+		case '\v':
+		    *p = '\\';
+		    p++;
+		    *p = 'v';
+		    p++;
+		    continue;
+	    }
+	    *p = *src;
+	    p++;
+	}
+    }
+    *p = '\0';
+    return p-dst;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Merge --
+ *
+ *	Given a collection of strings, merge them together into a
+ *	single string that has proper Tcl list structured (i.e.
+ *	Tcl_SplitList may be used to retrieve strings equal to the
+ *	original elements, and Tcl_Eval will parse the string back
+ *	into its original elements).
+ *
+ * Results:
+ *	The return value is the address of a dynamically-allocated
+ *	string containing the merged list.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Merge(argc, argv)
+    int argc;			/* How many strings to merge. */
+    char **argv;		/* Array of string values. */
+{
+#   define LOCAL_SIZE 20
+    int localFlags[LOCAL_SIZE], *flagPtr;
+    int numChars;
+    char *result;
+    char *dst;
+    int i;
+
+    /*
+     * Pass 1: estimate space, gather flags.
+     */
+
+    if (argc <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else {
+	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
+    }
+    numChars = 1;
+    for (i = 0; i < argc; i++) {
+	numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
+    }
+
+    /*
+     * Pass two: copy into the result area.
+     */
+
+    result = (char *) ckalloc((unsigned) numChars);
+    dst = result;
+    for (i = 0; i < argc; i++) {
+	numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
+	dst += numChars;
+	*dst = ' ';
+	dst++;
+    }
+    if (dst == result) {
+	*dst = 0;
+    } else {
+	dst[-1] = 0;
+    }
+
+    if (flagPtr != localFlags) {
+	ckfree((char *) flagPtr);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Concat --
+ *
+ *	Concatenate a set of strings into a single large string.
+ *
+ * Results:
+ *	The return value is dynamically-allocated string containing
+ *	a concatenation of all the strings in argv, with spaces between
+ *	the original argv elements.
+ *
+ * Side effects:
+ *	Memory is allocated for the result;  the caller is responsible
+ *	for freeing the memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_Concat(argc, argv)
+    int argc;			/* Number of strings to concatenate. */
+    char **argv;		/* Array of strings to concatenate. */
+{
+    int totalSize, i;
+    char *p;
+    char *result;
+
+    for (totalSize = 1, i = 0; i < argc; i++) {
+	totalSize += strlen(argv[i]) + 1;
+    }
+    result = (char *) ckalloc((unsigned) totalSize);
+    if (argc == 0) {
+	*result = '\0';
+	return result;
+    }
+    for (p = result, i = 0; i < argc; i++) {
+	char *element;
+	int length;
+
+	/*
+	 * Clip white space off the front and back of the string
+	 * to generate a neater result, and ignore any empty
+	 * elements.
+	 */
+
+	element = argv[i];
+	while (isspace(UCHAR(*element))) {
+	    element++;
+	}
+	for (length = strlen(element);
+		(length > 0) && (isspace(UCHAR(element[length-1])))
+		&& ((length < 2) || (element[length-2] != '\\'));
+		length--) {
+	    /* Null loop body. */
+	}
+	if (length == 0) {
+	    continue;
+	}
+	memcpy((VOID *) p, (VOID *) element, (size_t) length);
+	p += length;
+	*p = ' ';
+	p++;
+    }
+    if (p != result) {
+	p[-1] = 0;
+    } else {
+	*p = 0;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    char *p;
+    char *element;
+    char *concatStr;
+    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--;
+	    }
+
+	    /*
+	     * Trim trailing white space.  But, be careful not to trim
+	     * a space character if it is preceded by a backslash: in
+	     * this case it could be significant.
+	     */
+
+	    while ((elemLength > 0)
+		    && isspace(UCHAR(element[elemLength-1]))
+		    && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
+		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.
+ *
+ * Results:
+ *	The return value is 1 if string matches pattern, and
+ *	0 otherwise.  The matching operation permits the following
+ *	special characters in the pattern: *?\[] (see the manual
+ *	entry for details on what these mean).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_StringMatch(string, pattern)
+    char *string;		/* String. */
+    char *pattern;		/* Pattern, which may contain special
+				 * characters. */
+{
+    char c2;
+
+    while (1) {
+	/* See if we're at the end of both the pattern and the string.
+	 * If so, we succeeded.  If we're at the end of the pattern
+	 * but not at the end of the string, we failed.
+	 */
+	
+	if (*pattern == 0) {
+	    if (*string == 0) {
+		return 1;
+	    } else {
+		return 0;
+	    }
+	}
+	if ((*string == 0) && (*pattern != '*')) {
+	    return 0;
+	}
+
+	/* Check for a "*" as the next pattern character.  It matches
+	 * any substring.  We handle this by calling ourselves
+	 * recursively for each postfix of string, until either we
+	 * match or we reach the end of the string.
+	 */
+	
+	if (*pattern == '*') {
+	    pattern += 1;
+	    if (*pattern == 0) {
+		return 1;
+	    }
+	    while (1) {
+		if (Tcl_StringMatch(string, pattern)) {
+		    return 1;
+		}
+		if (*string == 0) {
+		    return 0;
+		}
+		string += 1;
+	    }
+	}
+    
+	/* Check for a "?" as the next pattern character.  It matches
+	 * any single character.
+	 */
+
+	if (*pattern == '?') {
+	    goto thisCharOK;
+	}
+
+	/* Check for a "[" as the next pattern character.  It is followed
+	 * by a list of characters that are acceptable, or by a range
+	 * (two characters separated by "-").
+	 */
+	
+	if (*pattern == '[') {
+	    pattern += 1;
+	    while (1) {
+		if ((*pattern == ']') || (*pattern == 0)) {
+		    return 0;
+		}
+		if (*pattern == *string) {
+		    break;
+		}
+		if (pattern[1] == '-') {
+		    c2 = pattern[2];
+		    if (c2 == 0) {
+			return 0;
+		    }
+		    if ((*pattern <= *string) && (c2 >= *string)) {
+			break;
+		    }
+		    if ((*pattern >= *string) && (c2 <= *string)) {
+			break;
+		    }
+		    pattern += 2;
+		}
+		pattern += 1;
+	    }
+	    while (*pattern != ']') {
+		if (*pattern == 0) {
+		    pattern--;
+		    break;
+		}
+		pattern += 1;
+	    }
+	    goto thisCharOK;
+	}
+    
+	/* If the next pattern character is '/', just strip off the '/'
+	 * so we do exact matching on the character that follows.
+	 */
+	
+	if (*pattern == '\\') {
+	    pattern += 1;
+	    if (*pattern == 0) {
+		return 0;
+	    }
+	}
+
+	/* There's no special character.  Just make sure that the next
+	 * characters of each string match.
+	 */
+	
+	if (*pattern != *string) {
+	    return 0;
+	}
+
+	thisCharOK: pattern += 1;
+	string += 1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetResult --
+ *
+ *	Arrange for "string" to be the Tcl return value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	interp->result is left pointing either to "string" (if "copy" is 0)
+ *	or to a copy of string. Also, the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, the
+				 * result is set to an empty string. */
+    Tcl_FreeProc *freeProc;	/* Gives information about the string:
+				 * TCL_STATIC, TCL_VOLATILE, or the address
+				 * of a Tcl_FreeProc such as free. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int length;
+    Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
+    char *oldResult = iPtr->result;
+
+    if (string == NULL) {
+	iPtr->resultSpace[0] = 0;
+	iPtr->result = iPtr->resultSpace;
+	iPtr->freeProc = 0;
+    } else if (freeProc == TCL_VOLATILE) {
+	length = strlen(string);
+	if (length > TCL_RESULT_SIZE) {
+	    iPtr->result = (char *) ckalloc((unsigned) length+1);
+	    iPtr->freeProc = TCL_DYNAMIC;
+	} else {
+	    iPtr->result = iPtr->resultSpace;
+	    iPtr->freeProc = 0;
+	}
+	strcpy(iPtr->result, string);
+    } else {
+	iPtr->result = string;
+	iPtr->freeProc = freeProc;
+    }
+
+    /*
+     * If the old result was dynamically-allocated, free it up.  Do it
+     * here, rather than at the beginning, in case the new result value
+     * was part of the old result value.
+     */
+
+    if (oldFreeProc != 0) {
+	if ((oldFreeProc == TCL_DYNAMIC)
+		|| (oldFreeProc == (Tcl_FreeProc *) free)) {
+	    ckfree(oldResult);
+	} else {
+	    (*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)
+     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. */
+    Tcl_Obj *objPtr;		/* Tcl object to be returned. If NULL, the
+				 * obj result is made an empty string
+				 * object. */
+{
+    Interp *iPtr = (Interp *) interp;
+    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. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *objResultPtr;
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendResult --
+ *
+ *	Append a variable number of strings onto the interpreter's string
+ *	result.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    va_list argList;
+    Interp *iPtr;
+    char *string;
+    int newSpace;
+
+    /*
+     * 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 *);
+	if (string == NULL) {
+	    break;
+	}
+	newSpace += strlen(string);
+    }
+    va_end(argList);
+
+    /*
+     * If the append buffer isn't already setup and large enough to hold
+     * the new data, set it up.
+     */
+
+    if ((iPtr->result != iPtr->appendResult)
+	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
+	    || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
+       SetupAppendBuffer(iPtr, newSpace);
+    }
+
+    /*
+     * Now go through all the argument strings again, copying them into the
+     * buffer.
+     */
+
+    TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
+	iPtr->appendUsed += strlen(string);
+    }
+    va_end(argList);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendElement --
+ *
+ *	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 " {".
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendElement(interp, string)
+    Tcl_Interp *interp;		/* Interpreter whose result is to be
+				 * extended. */
+    char *string;		/* String to convert to list element and
+				 * add to result. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *dst;
+    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
+     * needed to accommodate the list element.
+     */
+
+    size = Tcl_ScanElement(string, &flags) + 1;
+    if ((iPtr->result != iPtr->appendResult)
+	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
+	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
+       SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
+    }
+
+    /*
+     * Convert the string into a list element and copy it to the
+     * buffer that's forming, with a space separator if needed.
+     */
+
+    dst = iPtr->appendResult + iPtr->appendUsed;
+    if (TclNeedSpace(iPtr->appendResult, dst)) {
+	iPtr->appendUsed++;
+	*dst = ' ';
+	dst++;
+    }
+    iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupAppendBuffer --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetupAppendBuffer(iPtr, newSpace)
+    Interp *iPtr;		/* Interpreter whose result is being set up. */
+    int newSpace;		/* Make sure that at least this many bytes
+				 * of new information may be added. */
+{
+    int totalSpace;
+
+    /*
+     * 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) {
+	/*
+	 * If an oversized buffer was used recently, then free it up
+	 * so we go back to a smaller buffer.  This avoids tying up
+	 * memory forever after a large operation.
+	 */
+
+	if (iPtr->appendAvl > 500) {
+	    ckfree(iPtr->appendResult);
+	    iPtr->appendResult = NULL;
+	    iPtr->appendAvl = 0;
+	}
+	iPtr->appendUsed = strlen(iPtr->result);
+    } else if (iPtr->result[iPtr->appendUsed] != 0) {
+	/*
+	 * Most likely someone has modified a result created by
+	 * Tcl_AppendResult et al. so that it has a different size.
+	 * Just recompute the size.
+	 */
+
+	iPtr->appendUsed = strlen(iPtr->result);
+    }
+    
+    totalSpace = newSpace + iPtr->appendUsed;
+    if (totalSpace >= iPtr->appendAvl) {
+	char *new;
+
+	if (totalSpace < 100) {
+	    totalSpace = 200;
+	} else {
+	    totalSpace *= 2;
+	}
+	new = (char *) ckalloc((unsigned) totalSpace);
+	strcpy(new, iPtr->result);
+	if (iPtr->appendResult != NULL) {
+	    ckfree(iPtr->appendResult);
+	}
+	iPtr->appendResult = new;
+	iPtr->appendAvl = totalSpace;
+    } else if (iPtr->result != iPtr->appendResult) {
+	strcpy(iPtr->appendResult, iPtr->result);
+    }
+    
+    Tcl_FreeResult((Tcl_Interp *) iPtr);
+    iPtr->result = iPtr->appendResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeResult --
+ *
+ *	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)
+    Tcl_Interp *interp;		/* Interpreter for which to free result. */
+{
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ResetResult(interp)
+    Tcl_Interp *interp;		/* Interpreter for which to clear result. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    TclResetObjResult(iPtr);
+    
+    Tcl_FreeResult(interp);
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+    
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorCode --
+ *
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The errorCode global variable is modified to hold all of the
+ *	arguments to this procedure, in a list form with each argument
+ *	becoming one element of the list.  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.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* VARARGS2 */
+void
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    va_list argList;
+    char *string;
+    int flags;
+    Interp *iPtr;
+
+    /*
+     * Scan through the arguments one at a time, appending them to
+     * $errorCode as list elements.
+     */
+
+    iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	(void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
+		(char *) NULL, string, flags);
+	flags |= TCL_APPEND_VALUE;
+    }
+    va_end(argList);
+    iPtr->flags |= ERROR_CODE_SET;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjErrorCode --
+ *
+ *	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:
+ *	None.
+ *
+ * Side effects:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjErrorCode(interp, errorObjPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *errorObjPtr;
+{
+    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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpCompile --
+ *
+ *	Compile a regular expression into a form suitable for fast
+ *	matching.  This procedure retains a small cache of pre-compiled
+ *	regular expressions in the interpreter, in order to avoid
+ *	compilation costs as much as possible.
+ *
+ * Results:
+ *	The return value is a pointer to the compiled form of string,
+ *	suitable for passing to Tcl_RegExpExec.  This compiled form
+ *	is only valid up until the next call to this procedure, so
+ *	don't keep these around for a long time!  If an error occurred
+ *	while compiling the pattern, then NULL is returned and an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	The cache of compiled regexp's in interp will be modified to
+ *	hold information for string, if such information isn't already
+ *	present in the cache.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_RegExp
+Tcl_RegExpCompile(interp, string)
+    Tcl_Interp *interp;			/* For use in error reporting. */
+    char *string;			/* String for which to produce
+					 * compiled regular expression. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int i, length;
+    regexp *result;
+
+    length = strlen(string);
+    for (i = 0; i < NUM_REGEXPS; i++) {
+	if ((length == iPtr->patLengths[i])
+		&& (strcmp(string, iPtr->patterns[i]) == 0)) {
+	    /*
+	     * Move the matched pattern to the first slot in the
+	     * cache and shift the other patterns down one position.
+	     */
+
+	    if (i != 0) {
+		int j;
+		char *cachedString;
+
+		cachedString = iPtr->patterns[i];
+		result = iPtr->regexps[i];
+		for (j = i-1; j >= 0; j--) {
+		    iPtr->patterns[j+1] = iPtr->patterns[j];
+		    iPtr->patLengths[j+1] = iPtr->patLengths[j];
+		    iPtr->regexps[j+1] = iPtr->regexps[j];
+		}
+		iPtr->patterns[0] = cachedString;
+		iPtr->patLengths[0] = length;
+		iPtr->regexps[0] = result;
+	    }
+	    return (Tcl_RegExp) iPtr->regexps[0];
+	}
+    }
+
+    /*
+     * No match in the cache.  Compile the string and add it to the
+     * cache.
+     */
+
+    TclRegError((char *) NULL);
+    result = TclRegComp(string);
+    if (TclGetRegError() != NULL) {
+	Tcl_AppendResult(interp,
+	    "couldn't compile regular expression pattern: ",
+	    TclGetRegError(), (char *) NULL);
+	return NULL;
+    }
+    if (iPtr->patterns[NUM_REGEXPS-1] != NULL) {
+	ckfree(iPtr->patterns[NUM_REGEXPS-1]);
+	ckfree((char *) iPtr->regexps[NUM_REGEXPS-1]);
+    }
+    for (i = NUM_REGEXPS - 2; i >= 0; i--) {
+	iPtr->patterns[i+1] = iPtr->patterns[i];
+	iPtr->patLengths[i+1] = iPtr->patLengths[i];
+	iPtr->regexps[i+1] = iPtr->regexps[i];
+    }
+    iPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
+    strcpy(iPtr->patterns[0], string);
+    iPtr->patLengths[0] = length;
+    iPtr->regexps[0] = result;
+    return (Tcl_RegExp) result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpExec --
+ *
+ *	Execute the regular expression matcher using a compiled form
+ *	of a regular expression and save information about any match
+ *	that is found.
+ *
+ * Results:
+ *	If an error occurs during the matching operation then -1
+ *	is returned and interp->result contains an error message.
+ *	Otherwise the return value is 1 if a matching range is
+ *	found and 0 if there is no matching range.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RegExpExec(interp, re, string, start)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
+    Tcl_RegExp re;		/* Compiled regular expression;  must have
+				 * been returned by previous call to
+				 * Tcl_RegExpCompile. */
+    char *string;		/* String against which to match re. */
+    char *start;		/* If string is part of a larger string,
+				 * this identifies beginning of larger
+				 * string, so that "^" won't match. */
+{
+    int match;
+
+    regexp *regexpPtr = (regexp *) re;
+    TclRegError((char *) NULL);
+    match = TclRegExec(regexpPtr, string, start);
+    if (TclGetRegError() != NULL) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "error while matching regular expression: ",
+		TclGetRegError(), (char *) NULL);
+	return -1;
+    }
+    return match;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpRange --
+ *
+ *	Returns pointers describing the range of a regular expression match,
+ *	or one of the subranges within the match.
+ *
+ * Results:
+ *	The variables at *startPtr and *endPtr are modified to hold the
+ *	addresses of the endpoints of the range given by index.  If the
+ *	specified range doesn't exist then NULLs are returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_RegExpRange(re, index, startPtr, endPtr)
+    Tcl_RegExp re;		/* Compiled regular expression that has
+				 * been passed to Tcl_RegExpExec. */
+    int index;			/* 0 means give the range of the entire
+				 * match, > 0 means give the range of
+				 * a matching subrange.  Must be no greater
+				 * than NSUBEXP. */
+    char **startPtr;		/* Store address of first character in
+				 * (sub-) range here. */
+    char **endPtr;		/* Store address of character just after last
+				 * in (sub-) range here. */
+{
+    regexp *regexpPtr = (regexp *) re;
+
+    if (index >= NSUBEXP) {
+	*startPtr = *endPtr = NULL;
+    } else {
+	*startPtr = regexpPtr->startp[index];
+	*endPtr = regexpPtr->endp[index];
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpMatch --
+ *
+ *	See if a string matches a regular expression.
+ *
+ * Results:
+ *	If an error occurs during the matching operation then -1
+ *	is returned and interp->result contains an error message.
+ *	Otherwise the return value is 1 if "string" matches "pattern"
+ *	and 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RegExpMatch(interp, string, pattern)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *string;		/* String. */
+    char *pattern;		/* Regular expression to match against
+				 * string. */
+{
+    Tcl_RegExp re;
+
+    re = Tcl_RegExpCompile(interp, pattern);
+    if (re == NULL) {
+	return -1;
+    }
+    return Tcl_RegExpExec(interp, re, string, string);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringInit --
+ *
+ *	Initializes a dynamic string, discarding any previous contents
+ *	of the string (Tcl_DStringFree should have been called already
+ *	if the dynamic string was previously in use).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The dynamic string is initialized to be empty.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringInit(dsPtr)
+    Tcl_DString *dsPtr;		/* Pointer to structure for dynamic string. */
+{
+    dsPtr->string = dsPtr->staticSpace;
+    dsPtr->length = 0;
+    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+    dsPtr->staticSpace[0] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringAppend --
+ *
+ *	Append more characters to the current value of a dynamic string.
+ *
+ * Results:
+ *	The return value is a pointer to the dynamic string's new value.
+ *
+ * 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
+ *	gets reallocated if needed to accomodate the string's new size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_DStringAppend(dsPtr, string, length)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    CONST char *string;		/* String to append.  If length is -1 then
+				 * this must be null-terminated. */
+    int length;			/* Number of characters from string to
+				 * append.  If < 0, then append all of string,
+				 * up to null at end. */
+{
+    int newSize;
+    char *newString, *dst;
+    CONST char *end;
+
+    if (length < 0) {
+	length = strlen(string);
+    }
+    newSize = length + dsPtr->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
+     * 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,
+		(size_t) dsPtr->length);
+	if (dsPtr->string != dsPtr->staticSpace) {
+	    ckfree(dsPtr->string);
+	}
+	dsPtr->string = newString;
+    }
+
+    /*
+     * Copy the new string into the buffer at the end of the old
+     * one.
+     */
+
+    for (dst = dsPtr->string + dsPtr->length, end = string+length;
+	    string < end; string++, dst++) {
+	*dst = *string;
+    }
+    *dst = '\0';
+    dsPtr->length += length;
+    return dsPtr->string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringAppendElement --
+ *
+ *	Append a list element to the current value of a dynamic string.
+ *
+ * Results:
+ *	The return value is a pointer to the dynamic string's new value.
+ *
+ * Side effects:
+ *	String is reformatted as a list element and added to the current
+ *	value of the string.  Memory gets reallocated if needed to
+ *	accomodate the string's new size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_DStringAppendElement(dsPtr, string)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    CONST char *string;		/* String to append.  Must be
+				 * null-terminated. */
+{
+    int newSize, flags;
+    char *dst, *newString;
+
+    newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
+
+    /*
+     * 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
+     * will be room to grow before we have to allocate again.
+     * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
+     * to a larger buffer, since there may be embedded NULLs in the
+     * string in some cases.
+     */
+
+    if (newSize >= dsPtr->spaceAvl) {
+	dsPtr->spaceAvl = newSize*2;
+	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+	memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		(size_t) dsPtr->length);
+	if (dsPtr->string != dsPtr->staticSpace) {
+	    ckfree(dsPtr->string);
+	}
+	dsPtr->string = newString;
+    }
+
+    /*
+     * Convert the new string to a list element and copy it into the
+     * buffer at the end, with a space, if needed.
+     */
+
+    dst = dsPtr->string + dsPtr->length;
+    if (TclNeedSpace(dsPtr->string, dst)) {
+	*dst = ' ';
+	dst++;
+	dsPtr->length++;
+    }
+    dsPtr->length += Tcl_ConvertElement(string, dst, flags);
+    return dsPtr->string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringSetLength --
+ *
+ *	Change the length of a dynamic string.  This can cause the
+ *	string to either grow or shrink, depending on the value of
+ *	length.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The length of dsPtr is changed to length and a null byte is
+ *	stored at that position in the string.  If length is larger
+ *	than the space allocated for dsPtr, then a panic occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringSetLength(dsPtr, length)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    int length;			/* New length for dynamic string. */
+{
+    if (length < 0) {
+	length = 0;
+    }
+    if (length >= dsPtr->spaceAvl) {
+	char *newString;
+
+	dsPtr->spaceAvl = length+1;
+	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+
+	/*
+	 * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
+	 * to a larger buffer, since there may be embedded NULLs in the
+	 * string in some cases.
+	 */
+
+	memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		(size_t) dsPtr->length);
+	if (dsPtr->string != dsPtr->staticSpace) {
+	    ckfree(dsPtr->string);
+	}
+	dsPtr->string = newString;
+    }
+    dsPtr->length = length;
+    dsPtr->string[length] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringFree --
+ *
+ *	Frees up any memory allocated for the dynamic string and
+ *	reinitializes the string to an empty state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The previous contents of the dynamic string are lost, and
+ *	the new value is an empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringFree(dsPtr)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+{
+    if (dsPtr->string != dsPtr->staticSpace) {
+	ckfree(dsPtr->string);
+    }
+    dsPtr->string = dsPtr->staticSpace;
+    dsPtr->length = 0;
+    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+    dsPtr->staticSpace[0] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringResult --
+ *
+ *	This procedure moves the value of a dynamic string into an
+ *	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
+ *	string result for interp is freed. dsPtr is reinitialized to
+ *	an empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_ResetResult(interp);
+    
+    if (dsPtr->string != dsPtr->staticSpace) {
+	interp->result = dsPtr->string;
+	interp->freeProc = TCL_DYNAMIC;
+    } else if (dsPtr->length < TCL_RESULT_SIZE) {
+	interp->result = ((Interp *) interp)->resultSpace;
+	strcpy(interp->result, dsPtr->string);
+    } else {
+	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
+    }
+    
+    dsPtr->string = dsPtr->staticSpace;
+    dsPtr->length = 0;
+    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+    dsPtr->staticSpace[0] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringGetResult --
+ *
+ *	This procedure moves an interpreter's result into a dynamic string.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	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. */
+{
+    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)
+		|| (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+	    dsPtr->string = iPtr->result;
+	    dsPtr->spaceAvl = dsPtr->length+1;
+	} else {
+	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
+	    strcpy(dsPtr->string, iPtr->result);
+	    (*iPtr->freeProc)(iPtr->result);
+	}
+	dsPtr->spaceAvl = dsPtr->length+1;
+	iPtr->freeProc = NULL;
+    } else {
+	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
+	    dsPtr->string = dsPtr->staticSpace;
+	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+	} else {
+	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
+	    dsPtr->spaceAvl = dsPtr->length + 1;
+	}
+	strcpy(dsPtr->string, iPtr->result);
+    }
+    
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringStartSublist --
+ *
+ *	This procedure adds the necessary information to a dynamic
+ *	string (e.g. " {" to start a sublist.  Future element
+ *	appends will be in the sublist rather than the main list.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Characters get added to the dynamic string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringStartSublist(dsPtr)
+    Tcl_DString *dsPtr;			/* Dynamic string. */
+{
+    if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
+	Tcl_DStringAppend(dsPtr, " {", -1);
+    } else {
+	Tcl_DStringAppend(dsPtr, "{", -1);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DStringEndSublist --
+ *
+ *	This procedure adds the necessary characters to a dynamic
+ *	string to end a sublist (e.g. "}").  Future element appends
+ *	will be in the enclosing (sub)list rather than the current
+ *	sublist.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DStringEndSublist(dsPtr)
+    Tcl_DString *dsPtr;			/* Dynamic string. */
+{
+    Tcl_DStringAppend(dsPtr, "}", -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PrintDouble --
+ *
+ *	Given a floating-point value, this procedure converts it to
+ *	an ASCII string using.
+ *
+ * Results:
+ *	The ASCII equivalent of "value" is written at "dst".  It is
+ *	written using the current precision, and it is guaranteed to
+ *	contain a decimal point or exponent, so that it looks like
+ *	a floating-point value and not an integer.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_PrintDouble(interp, value, dst)
+    Tcl_Interp *interp;			/* Interpreter whose tcl_precision
+					 * 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. */
+{
+    char *p;
+
+    sprintf(dst, precisionFormat, value);
+
+    /*
+     * If the ASCII result looks like an integer, add ".0" so that it
+     * doesn't look like an integer anymore.  This prevents floating-point
+     * values from being converted to integers unintentionally.
+     */
+
+    for (p = dst; *p != 0; p++) {
+	if ((*p == '.') || (isalpha(UCHAR(*p)))) {
+	    return;
+	}
+    }
+    p[0] = '.';
+    p[1] = '0';
+    p[2] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    char *value, *end;
+    int prec;
+
+    /*
+     * If the variable is unset, then recreate the trace.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+	    Tcl_TraceVar2(interp, name1, name2,
+		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
+		    |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
+	}
+	return (char *) NULL;
+    }
+
+    /*
+     * When the variable is read, reset its value from our shared
+     * value.  This is needed in case the variable was modified in
+     * some other interpreter so that this interpreter's value is
+     * out of date.
+     */
+
+    if (flags & TCL_TRACE_READS) {
+	Tcl_SetVar2(interp, name1, name2, precisionString,
+		flags & TCL_GLOBAL_ONLY);
+	return (char *) NULL;
+    }
+
+    /*
+     * The variable is being written.  Check the new value and disallow
+     * it if it isn't reasonable or if this is a safe interpreter (we
+     * don't want safe interpreters messing up the precision of other
+     * interpreters).
+     */
+
+    if (Tcl_IsSafe(interp)) {
+	Tcl_SetVar2(interp, name1, name2, precisionString,
+		flags & TCL_GLOBAL_ONLY);
+	return "can't modify precision from a safe interpreter";
+    }
+    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)) {
+	Tcl_SetVar2(interp, name1, name2, precisionString,
+		flags & TCL_GLOBAL_ONLY);
+	return "improper value for precision";
+    }
+    TclFormatInt(precisionString, prec);
+    sprintf(precisionFormat, "%%.%dg", prec);
+    return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNeedSpace --
+ *
+ *	This procedure checks to see whether it is appropriate to
+ *	add a space before appending a new list element to an
+ *	existing string.
+ *
+ * Results:
+ *	The return value is 1 if a space is appropriate, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNeedSpace(start, end)
+    char *start;		/* First character in string. */
+    char *end;			/* End of string (place where space will
+				 * be added, if appropriate). */
+{
+    /*
+     * A space is needed unless either
+     * (a) we're at the start of the string, or
+     * (b) the trailing characters of the string consist of one or more
+     *     open curly braces preceded by a space or extending back to
+     *     the beginning of the string.
+     * (c) the trailing characters of the string consist of a space
+     *	   preceded by a character other than backslash.
+     */
+
+    if (end == start) {
+	return 0;
+    }
+    end--;
+    if (*end != '{') {
+	if (isspace(UCHAR(*end)) && ((end == start) || (end[-1] != '\\'))) {
+	    return 0;
+	}
+	return 1;
+    }
+    do {
+	if (end == start) {
+	    return 0;
+	}
+	end--;
+    } while (*end == '{');
+    if (isspace(UCHAR(*end))) {
+	return 0;
+    }
+    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)
+    char *buffer;		/* Points to the storage into which the
+				 * formatted characters are written. */
+    long n;			/* The integer to format. */
+{
+    long intVal;
+    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)
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+     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". */
+     int *indexPtr;		/* Location filled in with an integer
+				 * representing an index. */
+{
+    Interp *iPtr = (Interp *) interp;
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNameOfExecutable --
+ *
+ *	This procedure simply returns a pointer to the internal full
+ *	path name of the executable file as computed by
+ *	Tcl_FindExecutable.  This procedure call is the C API
+ *	equivalent to the "info nameofexecutable" command.
+ *
+ * Results:
+ *	A pointer to the internal string or NULL if the internal full
+ *	path name has not been computed or unknown.
+ *
+ * Side effects:
+ *	The object referenced by "objPtr" might be converted to an
+ *	integer object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+Tcl_GetNameOfExecutable()
+{
+    return (tclExecutableName);
+}
diff --git a/tcl/generic/tclVar.c b/tcl/generic/tclVar.c
new file mode 100644
index 00000000000..e191087e674
--- /dev/null
+++ b/tcl/generic/tclVar.c
@@ -0,0 +1,4620 @@
+/* 
+ * tclVar.c --
+ *
+ *	This file contains routines that implement Tcl variables
+ *	(both scalars and arrays).
+ *
+ *	The implementation of arrays is modelled after an initial
+ *	implementation by Mark Diekhans and Karl Lehenbauer.
+ *
+ * Copyright (c) 1987-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The strings below are used to indicate what went wrong when a
+ * variable access is denied.
+ */
+
+static char *noSuchVar =	"no such variable";
+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";
+static char *badNamespace =	"parent namespace doesn't exist";
+static char *missingName =	"missing variable name";
+
+/*
+ * Forward references to procedures defined later in this file:
+ */
+
+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		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
+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));
+static void		VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *part1, char *part2, char *operation,
+			    char *reason));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupVar --
+ *
+ *	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 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:
+ *	New hashtable entries may be created if createPart1 or createPart2
+ *	are 1.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+				 * TCL_PARSE_PART1 flag bit is set this
+				 * is a full variable name that could
+				 * 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 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
+				 * TCL_LEAVE_ERR_MSG is set in flags. */
+    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
+				 * this is set to NULL. */
+{
+    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. */
+    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, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
+    ResolverScheme *resPtr;
+    Tcl_HashEntry *hPtr;
+    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.
+     */
+
+    elName = part2;
+    if (flags & TCL_PARSE_PART1) {
+	for (p = part1; ; p++) {
+	    if (*p == 0) {
+		elName = NULL;
+		break;
+	    }
+	    if (*p == '(') {
+		openParen = p;
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p == ')') {
+		    closeParen = p;
+		    *openParen = 0;
+		    elName = openParen+1;
+		} else {
+		    openParen = NULL;
+		    elName = NULL;
+		}
+		break;
+	    }
+	}
+    }
+
+    /*
+     * If this namespace has a variable resolver, then give it first
+     * crack at the variable resolution.  It may return a Tcl_Var
+     * value, it may signal to continue onward, or it may signal
+     * an error.
+     */
+    if ((flags & TCL_GLOBAL_ONLY) != 0 || iPtr->varFramePtr == NULL) {
+        cxtNsPtr = iPtr->globalNsPtr;
+    }
+    else {
+        cxtNsPtr = iPtr->varFramePtr->nsPtr;
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
+
+        if (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, part1,
+                (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
+
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, part1,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            varPtr = (Var *) var;
+            goto lookupVarPart2;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Var *) NULL;
+        }
+    }
+
+    /*
+     * 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.
+     */
+
+    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 {			/* 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 (!TclIsVarTemporary(localPtr)) {
+		char *localName = localVarPtr->name;
+		if ((part1[0] == localName[0])
+		        && (part1Len == localPtr->nameLength)
+		        && (strcmp(part1, localName) == 0)) {
+		    varPtr = localVarPtr;
+		    break;
+		}
+	    }
+	    localVarPtr++;
+	    localPtr = localPtr->nextPtr;
+	}
+	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);
+	    }
+	}
+    }
+
+lookupVarPart2:
+    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) {
+        goto done;
+    }
+
+    /*
+     * 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 (TclIsVarUndefined(varPtr) && !TclIsVarArrayElement(varPtr)) {
+	if (!createPart1) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, msg, noSuchVar);
+	    }
+	    varPtr = NULL;
+	    goto done;
+	}
+	TclSetVarArray(varPtr);
+	TclClearVarUndefined(varPtr);
+	varPtr->value.tablePtr =
+	        (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+    } else if (!TclIsVarArray(varPtr)) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, msg, needArray);
+	}
+	varPtr = NULL;
+	goto done;
+    }
+    *arrayPtrPtr = varPtr;
+    if (closeParen != NULL) {
+	*closeParen = 0;
+    }
+    if (createPart2) {
+	hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, elName, &new);
+	if (closeParen != NULL) {
+	    *closeParen = ')';
+	}
+	if (new) {
+	    if (varPtr->searchPtr != NULL) {
+		DeleteSearches(varPtr);
+	    }
+	    varPtr = NewVar();
+	    Tcl_SetHashValue(hPtr, varPtr);
+	    varPtr->hPtr = hPtr;
+	    varPtr->nsPtr = varNsPtr;
+	    TclSetVarArrayElement(varPtr);
+	}
+    } else {
+	hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, elName);
+	if (closeParen != NULL) {
+	    *closeParen = ')';
+	}
+	if (hPtr == NULL) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, msg, noSuchElement);
+	    }
+	    varPtr = NULL;
+	    goto done;
+	}
+    }
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+    done:
+    if (openParen != NULL) {
+        *openParen = '(';
+    }
+    return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVar --
+ *
+ *	Return the value of a Tcl variable as a string.
+ *
+ * Results:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+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,
+				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
+				 * bits. */
+{
+    return Tcl_GetVar2(interp, varName, (char *) NULL,
+		       (flags | TCL_PARSE_PART1));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVar2 --
+ *
+ *	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 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetVar2(interp, part1, part2, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which variable is
+				 * to be looked up. */
+    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_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. */
+{
+    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.
+     */
+
+    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;
+    }
+
+    /*
+     * Invoke any traces that have been set for the variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
+		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_READS);
+	if (msg != NULL) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, "read", msg);
+	    }
+	    goto errorReturn;
+	}
+    }
+
+    /*
+     * 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) {
+	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+	        && !TclIsVarUndefined(arrayPtr)) {
+	    msg = noSuchElement;
+	} else if (TclIsVarArray(varPtr)) {
+	    msg = isArray;
+	} else {
+	    msg = noSuchVar;
+	}
+	VarErrMsg(interp, part1, part2, "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 (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, arrayPtr);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    int new;
+
+#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. Note that we must create the element (but leave
+     * it marked undefined) if it does not already exist. This allows a
+     * trace to create new array elements "on the fly" that did not exist
+     * before. A trace is always passed a variable for the array element. If
+     * the trace does not define the variable, it will be deleted below (at
+     * errorReturn) and an error returned.
+     */
+
+    hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
+    if (new) {
+	if (arrayPtr->searchPtr != NULL) {
+	    DeleteSearches(arrayPtr);
+	}
+	varPtr = NewVar();
+	Tcl_SetHashValue(hPtr, varPtr);
+	varPtr->hPtr = hPtr;
+	varPtr->nsPtr = varFramePtr->nsPtr;
+	TclSetVarArrayElement(varPtr);
+    } else {
+	varPtr = (Var *) Tcl_GetHashValue(hPtr);
+    }
+
+    /*
+     * Invoke any traces that have been set for the element variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+            || ((arrayPtr != NULL) && (arrayPtr->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 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
+ *	defined, then a new global variable by that name is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_SetVar(interp, varName, newValue, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    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_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+{
+    return Tcl_SetVar2(interp, varName, (char *) NULL, newValue,
+		       (flags | TCL_PARSE_PART1));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 = newValue ? strlen(newValue) : 0;
+    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 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_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
+				 * TCL_PARSE_PART1. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Var *varPtr;
+    Var *arrayPtr;
+    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.
+     */
+
+    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 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 (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, "set", danglingUpvar);
+	}
+	return NULL;
+    }
+
+    /*
+     * It's an error to try to set an array variable itself.
+     */
+
+    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, "set", isArray);
+	}
+	return NULL;
+    }
+
+    /*
+     * 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);
+    }
+
+    /*
+     * Invoke any write traces for the variable.
+     */
+
+    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) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		VarErrMsg(interp, part1, part2, "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 (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+
+    /*
+     * 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);
+	}
+	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;
+    }
+
+    /*
+     * 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);
+	}
+	goto errorReturn;
+    } 
+
+    /*
+     * Look up the element.
+     */
+
+    hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
+    if (new) {
+	if (arrayPtr->searchPtr != NULL) {
+	    DeleteSearches(arrayPtr);
+	}
+	varPtr = NewVar();
+	Tcl_SetHashValue(hPtr, varPtr);
+	varPtr->hPtr = hPtr;
+        varPtr->nsPtr = varFramePtr->nsPtr;
+	TclSetVarArrayElement(varPtr);
+    }
+    varPtr = (Var *) Tcl_GetHashValue(hPtr);
+
+    /*
+     * It's an error to try to set an array variable itself.
+     */
+
+    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.
+     */
+
+    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 element variable.
+     */
+
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
+		TCL_TRACE_WRITES);
+	if (msg != NULL) {
+	    if (leaveErrorMsg) {
+		VarErrMsg(interp, arrayName, elem, "set", msg);
+	    }
+	    goto errorReturn;
+	}
+    }
+
+    /*
+     * 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 (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+	return varPtr->value.objPtr;
+    }
+    
+    resultPtr = Tcl_NewObj();
+
+    /*
+     * 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) {
+	if (TclIsVarUndefined(varPtr)) {
+	    CleanupVar(varPtr, NULL); /* note: array isn't in hashtable */
+	}
+    }
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnsetVar --
+ *
+ *	Delete a variable, so that it may not be accessed anymore.
+ *
+ * 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.
+ *
+ * Side effects:
+ *	If varName is defined as a local or global variable in interp,
+ *	it is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnsetVar(interp, varName, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    char *varName;		/* Name of a variable in interp.  May be
+				 * 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, TCL_NAMESPACE_ONLY or
+				 * TCL_LEAVE_ERR_MSG. */
+{
+    return Tcl_UnsetVar2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnsetVar2 --
+ *
+ *	Delete a variable, given a 2-part name.
+ *
+ * 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.
+ *
+ * Side effects:
+ *	If part1 and part2 indicate a local or global variable in interp,
+ *	it is deleted.  If part1 is an array name and part2 is NULL, then
+ *	the whole array is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnsetVar2(interp, part1, part2, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * to be looked up. */
+    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_NAMESPACE_ONLY,
+				 * TCL_LEAVE_ERR_MSG, or
+				 * TCL_PARSE_PART1. */
+{
+    Var dummyVar;
+    Var *varPtr, *dummyVarPtr;
+    Interp *iPtr = (Interp *) interp;
+    Var *arrayPtr;
+    ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
+    int result;
+
+    varPtr = TclLookupVar(interp, part1, part2, flags, "unset",
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL) {
+	return TCL_ERROR;
+    }
+    result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+
+    if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
+	DeleteSearches(arrayPtr);
+    }
+
+    /*
+     * 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
+     * in three steps:
+     * 1. Copy the contents of the variable to a dummy variable
+     *    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;
+    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. 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.
+     */
+
+    if ((dummyVar.tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	varPtr->refCount++;
+	dummyVar.flags &= ~VAR_TRACE_ACTIVE;
+	(void) CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
+		(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;
+		activePtr = activePtr->nextPtr) {
+	    if (activePtr->varPtr == varPtr) {
+		activePtr->nextTracePtr = NULL;
+	    }
+	}
+	varPtr->refCount--;
+    }
+
+    /*
+     * 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).
+     */
+
+    dummyVarPtr = &dummyVar;
+    if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
+	DeleteArray(iPtr, part1, dummyVarPtr,
+	    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+    }
+    if (TclIsVarScalar(dummyVarPtr)
+	    && (dummyVarPtr->value.objPtr != NULL)) {
+	objPtr = dummyVarPtr->value.objPtr;
+	TclDecrRefCount(objPtr);
+	dummyVarPtr->value.objPtr = NULL;
+    }
+
+    /*
+     * If the variable was a namespace variable, decrement its reference
+     * count. We are in the process of destroying its namespace so that
+     * namespace will no longer "refer" to the variable.
+     */
+    
+    if (varPtr->flags & VAR_NAMESPACE_VAR) {
+	varPtr->flags &= ~VAR_NAMESPACE_VAR;
+	varPtr->refCount--;
+    }
+
+    /*
+     * It's an error to unset an undefined variable.
+     */
+	
+    if (result != TCL_OK) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    VarErrMsg(interp, part1, part2, "unset", 
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
+	}
+    }
+
+    /*
+     * 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);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceVar --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a
+ *	procedure to be invoked, which can monitor the operations
+ *	and/or change their actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by varName, such that
+ *	future references to the variable will be intermediated by
+ *	proc.  See the manual entry for complete details on the calling
+ *	sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar(interp, varName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which variable is
+				 * to be traced. */
+    char *varName;		/* Name of variable;  may end with "(index)"
+				 * to signify an array reference. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * 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 | TCL_PARSE_PART1), proc, clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceVar2 --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a
+ *	procedure to be invoked, which can monitor the operations
+ *	and/or change their actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by part1 and part2, such
+ *	that future references to the variable will be intermediated by
+ *	proc.  See the manual entry for complete details on the calling
+ *	sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which variable is
+				 * to be traced. */
+    char *part1;		/* Name of scalar variable or array. */
+    char *part2;		/* Name of element within array;  NULL means
+				 * trace applies to scalar variable or array
+				 * 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,
+				 * 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. */
+{
+    Var *varPtr, *arrayPtr;
+    register VarTrace *tracePtr;
+
+    varPtr = TclLookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG),
+	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+    if (varPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set up trace information.
+     */
+
+    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+    tracePtr->traceProc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->flags = 
+	    flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
+    tracePtr->nextPtr = varPtr->tracePtr;
+    varPtr->tracePtr = tracePtr;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceVar --
+ *
+ *	Remove a previously-created trace for a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the variable given by varName
+ *	with the given flags, proc, and clientData, then that trace
+ *	is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceVar(interp, varName, flags, proc, clientData)
+    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, 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 | TCL_PARSE_PART1), proc, clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceVar2 --
+ *
+ *	Remove a previously-created trace for a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the variable given by part1
+ *	and part2 with the given flags, proc, and clientData, then
+ *	that trace is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
+    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
+				 * as-a-whole. */
+    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,
+				 * TCL_NAMESPACE_ONLY and
+				 * TCL_PARSE_PART1. */
+    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    register VarTrace *tracePtr;
+    VarTrace *prevPtr;
+    Var *varPtr, *arrayPtr;
+    Interp *iPtr = (Interp *) interp;
+    ActiveVarTrace *activePtr;
+
+    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;  ;
+	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	if (tracePtr == NULL) {
+	    return;
+	}
+	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
+		&& (tracePtr->clientData == clientData)) {
+	    break;
+	}
+    }
+
+    /*
+     * The code below makes it possible to delete traces while traces
+     * are active: it makes sure that the deleted trace won't be
+     * processed by CallTraces.
+     */
+
+    for (activePtr = iPtr->activeTracePtr;  activePtr != NULL;
+	    activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    activePtr->nextTracePtr = tracePtr->nextPtr;
+	}
+    }
+    if (prevPtr == NULL) {
+	varPtr->tracePtr = tracePtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = tracePtr->nextPtr;
+    }
+    ckfree((char *) tracePtr);
+
+    /*
+     * If this is the last trace on the variable, and the variable is
+     * unset and unused, then free up the variable.
+     */
+
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, (Var *) NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarTraceInfo --
+ *
+ *	Return the clientData value associated with a trace on a
+ *	variable.  This procedure can also be used to step through
+ *	all of the traces on a particular variable that have the
+ *	same trace procedure.
+ *
+ * Results:
+ *	The return value is the clientData value associated with
+ *	a trace on the given variable.  Information will only be
+ *	returned for a trace with proc as trace procedure.  If
+ *	the clientData argument is NULL then the first such trace is
+ *	returned;  otherwise, the next relevant one after the one
+ *	given by clientData will be returned.  If the variable
+ *	doesn't exist, or if there are no (more) traces for it,
+ *	then NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+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, 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
+				 * return the next trace after that one.
+				 * If NULL, this call will return the
+				 * first trace. */
+{
+    return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
+	    (flags | TCL_PARSE_PART1), proc, prevClientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarTraceInfo2 --
+ *
+ *	Same as Tcl_VarTraceInfo, except takes name in two pieces
+ *	instead of one.
+ *
+ * Results:
+ *	Same as Tcl_VarTraceInfo.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
+    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
+				 * as-a-whole. */
+    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
+				 * return the next trace after that one.
+				 * If NULL, this call will return the
+				 * first trace. */
+{
+    register VarTrace *tracePtr;
+    Var *varPtr, *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;
+    }
+
+    /*
+     * Find the relevant trace, if any, and return its clientData.
+     */
+
+    tracePtr = varPtr->tracePtr;
+    if (prevClientData != NULL) {
+	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	    if ((tracePtr->clientData == prevClientData)
+		    && (tracePtr->traceProc == proc)) {
+		tracePtr = tracePtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	if (tracePtr->traceProc == proc) {
+	    return tracePtr->clientData;
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnsetObjCmd --
+ *
+ *	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 object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    register int i;
+    register char *name;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
+	return TCL_ERROR;
+    }
+    
+    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;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendObjCmd --
+ *
+ *	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 object result value.
+ *
+ * Side effects:
+ *	A variable's value may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+	return TCL_ERROR;
+    }
+
+    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;
+	    }
+	}
+    }
+    
+    Tcl_SetObjResult(interp, varValuePtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LappendObjCmd --
+ *
+ *	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 object result value.
+ *
+ * Side effects:
+ *	A variable's value may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    Tcl_Obj *varValuePtr, *newValuePtr;
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired, createdNewObj, createVar, i, j;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+	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;
+	    }
+	}
+    } 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".
+	 */
+
+	createdNewObj = 0;
+	createVar = 1;
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	        TCL_PARSE_PART1);
+	if (varValuePtr == NULL) {
+	    /*
+	     * We couldn't read the old value: either the var doesn't yet
+	     * exist or it's an array element. If it's new, we will try to
+	     * create it with Tcl_ObjSetVar2 below.
+	     */
+	    
+	    char *name, *p;
+	    int nameBytes, i;
+
+	    name = TclGetStringFromObj(objv[1], &nameBytes);
+	    for (i = 0, p = name;  i < nameBytes;  i++, p++) {
+		if (*p == '(') {
+		    p = (name + nameBytes-1);	
+		    if (*p == ')') { /* last char is ')' => array ref */
+			createVar = 0;
+		    }
+		    break;
+		}
+	    }
+	    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 and we didn't create the variable.
+	 */
+	
+	newValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+		varValuePtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+	if (newValuePtr == NULL) {
+	    if (createdNewObj && !createVar) {
+		Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */
+	    }
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Set the interpreter's object result to refer to the variable's value
+     * object.
+     */
+
+    Tcl_SetObjResult(interp, newValuePtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ArrayObjCmd --
+ *
+ *	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 object.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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. */
+{
+    /*
+     * The list of constants below should match the arrayOptions string array
+     * below.
+     */
+
+    enum {ARRAY_ANYMORE, ARRAY_DONESEARCH,  ARRAY_EXISTS, ARRAY_GET,
+	  ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
+	  ARRAY_STARTSEARCH}; 
+    static char *arrayOptions[] = {"anymore", "donesearch", "exists",
+	    "get", "names", "nextelement", "set", "size", "startsearch", 
+            (char *) NULL};
+
+    Var *varPtr, *arrayPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+    int notArray;
+    char *varName;
+    int index, result;
+
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option", 0, &index)
+	    != TCL_OK) {
+    	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.
+     */
+    
+    varName = TclGetStringFromObj(objv[2], (int *) NULL);
+    varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
+            /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+    notArray = 0;
+    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+	    || TclIsVarUndefined(varPtr)) {
+	notArray = 1;
+    }
+    
+    switch (index) {
+        case ARRAY_ANYMORE: {
+	    ArraySearch *searchPtr;
+	    char *searchId;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, 
+                        "arrayName searchId");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+	    if (searchPtr == NULL) {
+	        return TCL_ERROR;
+	    }
+	    while (1) {
+	        Var *varPtr2;
+
+		if (searchPtr->nextEntry != NULL) {
+		    varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
+		    if (!TclIsVarUndefined(varPtr2)) {
+		        break;
+		    }
+		}
+		searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
+		if (searchPtr->nextEntry == NULL) {
+		    Tcl_SetIntObj(resultPtr, 0);
+		    return TCL_OK;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, 1);
+	    break;
+	}
+        case ARRAY_DONESEARCH: {
+	    ArraySearch *searchPtr, *prevPtr;
+	    char *searchId;
+
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, 
+                        "arrayName searchId");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    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) {
+		    if (prevPtr->nextPtr == searchPtr) {
+		        prevPtr->nextPtr = searchPtr->nextPtr;
+			break;
+		    }
+		}
+	    }
+	    ckfree((char *) searchPtr);
+	    break;
+	}
+        case ARRAY_EXISTS: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	        return TCL_ERROR;
+	    }
+	    Tcl_SetIntObj(resultPtr, !notArray);
+	    break;
+	}
+        case ARRAY_GET: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    char *pattern = NULL;
+	    char *name;
+	    Tcl_Obj *namePtr, *valuePtr;
+	    
+	    if ((objc != 3) && (objc != 4)) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "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 (TclIsVarUndefined(varPtr2)) {
+		    continue;
+		}
+		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+		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 obj */
+		    return result;
+		}
+
+		valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
+	                TCL_LEAVE_ERR_MSG);
+		if (valuePtr == NULL) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    return result;
+		}
+		result = Tcl_ListObjAppendElement(interp, resultPtr,
+			valuePtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    return result;
+		}
+	    }
+	    break;
+	}
+        case ARRAY_NAMES: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    char *pattern = NULL;
+	    char *name;
+	    Tcl_Obj *namePtr;
+	    
+	    if ((objc != 3) && (objc != 4)) {
+  	        Tcl_WrongNumArgs(interp, 2, objv, "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 (TclIsVarUndefined(varPtr2)) {
+		    continue;
+		}
+		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+		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;
+		}
+	    }
+	    break;
+	}
+        case ARRAY_NEXTELEMENT: {
+	    ArraySearch *searchPtr;
+	    char *searchId;
+	    Tcl_HashEntry *hPtr;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, 
+                        "arrayName searchId");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+  	        goto error;
+	    }
+	    searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+	    if (searchPtr == NULL) {
+	        return TCL_ERROR;
+	    }
+	    while (1) {
+	        Var *varPtr2;
+
+		hPtr = searchPtr->nextEntry;
+		if (hPtr == NULL) {
+		    hPtr = Tcl_NextHashEntry(&searchPtr->search);
+		    if (hPtr == NULL) {
+		        return TCL_OK;
+		    }
+		} else {
+		    searchPtr->nextEntry = NULL;
+		}
+		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		if (!TclIsVarUndefined(varPtr2)) {
+		    break;
+		}
+	    }
+	    Tcl_SetStringObj(resultPtr,
+	            Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1);
+	    break;
+	}
+        case ARRAY_SET: {
+	    Tcl_Obj **elemPtrs;
+	    int listLen, i, result;
+	    
+	    if (objc != 4) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
+		return TCL_ERROR;
+	    }
+	    result = Tcl_ListObjGetElements(interp, objv[3], &listLen, 
+                    &elemPtrs);
+	    if (result != TCL_OK) {
+	        return result;
+	    }
+	    if (listLen & 1) {
+	        Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                        "list must have an even number of elements", -1);
+		return TCL_ERROR;
+	    }
+	    if (listLen > 0) {
+		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;
+		    }
+		}
+		return result;
+	    }
+  
+	    /*
+	     * The list is empty make sure we have an array, or create
+	     * one if necessary.
+	     */
+	    
+	    if (varPtr != NULL) {
+		if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+		    /*
+		     * Already an array, done.
+		     */
+		    
+		    return TCL_OK;
+                }
+		if (TclIsVarArrayElement(varPtr) ||
+			!TclIsVarUndefined(varPtr)) {
+		    /*
+		     * Either an array element, or a scalar: lose!
+		     */
+		    
+		    VarErrMsg(interp, varName, (char *)NULL, "array set",
+                            needArray);
+		    return TCL_ERROR;
+                }
+	    } else {
+		/*
+		 * Create variable for new array.
+		 */
+		
+		varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
+			/*createPart1*/ 1, /*createPart2*/ 0,
+			&arrayPtr);
+	    }
+	    TclSetVarArray(varPtr);
+	    TclClearVarUndefined(varPtr);
+	    varPtr->value.tablePtr =
+		(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+          return TCL_OK;
+	}
+        case ARRAY_SIZE: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    int size;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+		return TCL_ERROR;
+	    }
+	    size = 0;
+	    if (!notArray) {
+	        for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, 
+                        &search);
+		        hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+		    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		    if (TclIsVarUndefined(varPtr2)) {
+		        continue;
+		    }
+		    size++;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, size);
+	    break;
+	}
+        case ARRAY_STARTSEARCH: {
+	    ArraySearch *searchPtr;
+
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
+	    if (varPtr->searchPtr == NULL) {
+	        searchPtr->id = 1;
+		Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
+		        (char *) NULL);
+	    } else {
+	        char string[20];
+
+		searchPtr->id = varPtr->searchPtr->id + 1;
+		TclFormatInt(string, searchPtr->id);
+		Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
+		    (char *) NULL);
+	    }
+	    searchPtr->varPtr = varPtr;
+	    searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
+		    &searchPtr->search);
+	    searchPtr->nextPtr = varPtr->searchPtr;
+	    varPtr->searchPtr = searchPtr;
+	    break;
+	}
+    }
+    return TCL_OK;
+
+    error:
+    Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
+	    (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeUpvar --
+ *
+ *	This procedure does all of the work of the "global" and "upvar"
+ *	commands.
+ *
+ * Results:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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. */
+    char *otherP1, *otherP2;	/* Two-part name of variable in framePtr. */
+    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 *varFramePtr;
+    CallFrame *savedFramePtr = NULL;  /* Init. to avoid compiler warning. */
+    Tcl_HashTable *tablePtr;
+    Namespace *nsPtr, *altNsPtr, *dummyNsPtr;
+    char *tail;
+    int new, result;
+
+    /*
+     * 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.
+     */
+
+    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;
+    }
+
+    /*
+     * 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;
+        }
+	
+	/*
+	 * Check that we are not trying to create a namespace var linked to
+	 * a local variable in a procedure. If we allowed this, the local
+	 * variable in the shorter-lived procedure frame could go away
+	 * leaving the namespace var's reference invalid.
+	 */
+
+	if ((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
+                    myName, "\": upvar won't create namespace variable that refers to procedure variable",
+		    (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 (!TclIsVarTemporary(localPtr)) {
+		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) {
+	/*
+	 * 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.
+	 */
+
+	if (varPtr == otherPtr) {
+	    Tcl_SetResult((Tcl_Interp *) iPtr,
+		    "can't upvar from variable to itself", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	if (TclIsVarLink(varPtr)) {
+	    Var *linkPtr = varPtr->value.linkPtr;
+	    if (linkPtr == otherPtr) {
+		return TCL_OK;
+	    }
+	    linkPtr->refCount--;
+	    if (TclIsVarUndefined(linkPtr)) {
+		CleanupVar(linkPtr, (Var *) NULL);
+	    }
+	} else if (!TclIsVarUndefined(varPtr)) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
+		"\" already exists", (char *) NULL);
+	    return TCL_ERROR;
+	} else if (varPtr->tracePtr != NULL) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
+		"\" has traces: can't use for upvar", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    TclSetVarLink(varPtr);
+    TclClearVarUndefined(varPtr);
+    varPtr->value.linkPtr = otherPtr;
+    otherPtr->refCount++;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpVar --
+ *
+ *	This procedure links one variable to another, just like
+ *	the "upvar" command.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs then
+ *	an error message is left in interp->result.
+ *
+ * Side effects:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UpVar(interp, frameName, varName, localName, flags)
+    Tcl_Interp *interp;		/* Command interpreter in which varName is
+				 * 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 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;
+    register char *p;
+
+    result = TclGetFrame(interp, frameName, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Figure out whether varName is an array reference, then call
+     * MakeUpvar to do all the real work.
+     */
+
+    for (p = varName;  *p != '\0';  p++) {
+	if (*p == '(') {
+	    char *openParen = p;
+	    do {
+		p++;
+	    } while (*p != '\0');
+	    p--;
+	    if (*p != ')') {
+		goto scalar;
+	    }
+	    *openParen = '\0';
+	    *p = '\0';
+	    result = MakeUpvar((Interp *) interp, framePtr, varName,
+		    openParen+1, 0, localName, flags);
+	    *openParen = '(';
+	    *p = ')';
+	    return result;
+	}
+    }
+
+    scalar:
+    return MakeUpvar((Interp *) interp, framePtr, varName, (char *) NULL,
+	    0, localName, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpVar2 --
+ *
+ *	This procedure links one variable to another, just like
+ *	the "upvar" command.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs then
+ *	an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The variable in frameName whose name is given by part1 and
+ *	part2 becomes accessible under the name localName, so that
+ *	references to localName are redirected to the other variable
+ *	like a symbolic link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
+    Tcl_Interp *interp;		/* Interpreter containing variables.  Used
+				 * 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 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;
+
+    result = TclGetFrame(interp, frameName, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    return MakeUpvar((Interp *) interp, framePtr, part1, part2, 0,
+	    localName, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVariableFullName --
+ *
+ *	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:
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Tcl_Obj *objPtr;
+    char *varName;
+    register char *tail;
+    int result, i;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If we are not executing inside a Tcl procedure, just return.
+     */
+    
+    if ((iPtr->varFramePtr == NULL)
+	    || !iPtr->varFramePtr->isProcCallFrame) {
+	return 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;
+	}
+
+	/*
+	 * Mark the variable as a namespace variable and increment its 
+	 * reference count so that it will persist until its namespace is
+	 * destroyed or until the variable is unset.
+	 */
+
+	if (!(varPtr->flags & VAR_NAMESPACE_VAR)) {
+	    varPtr->flags |= VAR_NAMESPACE_VAR;
+	    varPtr->refCount++;
+	}
+
+	/*
+	 * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpvarObjCmd --
+ *
+ *	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 object result value.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+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;
+    CallFrame *framePtr;
+    char *frameSpec, *otherVarName, *myVarName;
+    register char *p;
+    int result;
+
+    if (objc < 3) {
+	upvarSyntax:
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?level? otherVar localVar ?otherVar localVar ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Find the call frame containing each of the "other variables" to be
+     * linked to. FAILS IF objv[1]'s STRING REP CONTAINS NULLS.
+     */
+
+    frameSpec = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+    result = TclGetFrame(interp, frameSpec, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    objc -= result+1;
+    if ((objc & 1) != 0) {
+	goto upvarSyntax;
+    }
+    objv += result+1;
+
+    /*
+     * 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 ( ;  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;
+
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p != ')') {
+		    goto scalar;
+		}
+		*openParen = '\0';
+		*p = '\0';
+		result = MakeUpvar(iPtr, framePtr,
+		        otherVarName, openParen+1, /*otherFlags*/ 0,
+			myVarName, /*flags*/ 0);
+		*openParen = '(';
+		*p = ')';
+		goto checkResult;
+	    }
+	}
+	scalar:
+	result = MakeUpvar(iPtr, framePtr, otherVarName, (char *) NULL, 0,
+	        myVarName, /*flags*/ 0);
+
+	checkResult:
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallTraces --
+ *
+ *	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
+ *	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-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
+ *	pointer to a static string describing the error.
+ *
+ * Side effects:
+ *	Almost anything can happen, depending on trace; this procedure
+ *	itself doesn't have any side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 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;
+    char *result, *openParen, *p;
+    Tcl_DString nameCopy;
+    int copiedName;
+
+    /*
+     * If there are already similar trace procedures active for the
+     * variable, don't call them again.
+     */
+
+    if (varPtr->flags & VAR_TRACE_ACTIVE) {
+	return NULL;
+    }
+    varPtr->flags |= VAR_TRACE_ACTIVE;
+    varPtr->refCount++;
+
+    /*
+     * If the variable name hasn't been parsed into array name and
+     * element, do it here.  If there really is an array element,
+     * make a copy of the original name so that NULLs can be
+     * inserted into it to separate the names (can't modify the name
+     * string in place, because the string might get used by the
+     * callbacks we invoke).
+     */
+
+    copiedName = 0;
+    if (flags & TCL_PARSE_PART1) {
+	for (p = part1; ; p++) {
+	    if (*p == 0) {
+		break;
+	    }
+	    if (*p == '(') {
+		openParen = p;
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p == ')') {
+		    Tcl_DStringInit(&nameCopy);
+		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
+		    part2 = Tcl_DStringValue(&nameCopy)
+			    + (openParen + 1 - part1);
+		    part2[-1] = 0;
+		    part1 = Tcl_DStringValue(&nameCopy);
+		    copiedName = 1;
+		}
+		break;
+	    }
+	}
+    }
+    flags &= ~TCL_PARSE_PART1;
+
+    /*
+     * Invoke traces on the array containing the variable, if relevant.
+     */
+
+    result = NULL;
+    active.nextPtr = iPtr->activeTracePtr;
+    iPtr->activeTracePtr = &active;
+    if (arrayPtr != NULL) {
+	arrayPtr->refCount++;
+	active.varPtr = arrayPtr;
+	for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
+		tracePtr = active.nextTracePtr) {
+	    active.nextTracePtr = tracePtr->nextPtr;
+	    if (!(tracePtr->flags & flags)) {
+		continue;
+	    }
+	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+		    (Tcl_Interp *) iPtr, part1, part2, flags);
+	    if (result != NULL) {
+		if (flags & TCL_TRACE_UNSETS) {
+		    result = NULL;
+		} else {
+		    goto done;
+		}
+	    }
+	}
+    }
+
+    /*
+     * Invoke traces on the variable itself.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	flags |= TCL_TRACE_DESTROYED;
+    }
+    active.varPtr = varPtr;
+    for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
+	    tracePtr = active.nextTracePtr) {
+	active.nextTracePtr = tracePtr->nextPtr;
+	if (!(tracePtr->flags & flags)) {
+	    continue;
+	}
+	result = (*tracePtr->traceProc)(tracePtr->clientData,
+		(Tcl_Interp *) iPtr, part1, part2, flags);
+	if (result != NULL) {
+	    if (flags & TCL_TRACE_UNSETS) {
+		result = NULL;
+	    } else {
+		goto done;
+	    }
+	}
+    }
+
+    /*
+     * Restore the variable's flags, remove the record of our active
+     * traces, and then return.
+     */
+
+    done:
+    if (arrayPtr != NULL) {
+	arrayPtr->refCount--;
+    }
+    if (copiedName) {
+	Tcl_DStringFree(&nameCopy);
+    }
+    varPtr->flags &= ~VAR_TRACE_ACTIVE;
+    varPtr->refCount--;
+    iPtr->activeTracePtr = active.nextPtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewVar --
+ *
+ *	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. 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Var *
+NewVar()
+{
+    register Var *varPtr;
+
+    varPtr = (Var *) ckalloc(sizeof(Var));
+    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_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
+    return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseSearchId --
+ *
+ *	This procedure translates from a string to a pointer to an
+ *	active array search (if there is one that matches the string).
+ *
+ * Results:
+ *	The return value is a pointer to the array search indicated
+ *	by string, or NULL if there isn't one.  If NULL is returned,
+ *	interp->result contains an error message.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ArraySearch *
+ParseSearchId(interp, varPtr, varName, string)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    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
+				 * form "search-num-var" where "num" is a
+				 * decimal number and "var" is a variable
+				 * name. */
+{
+    char *end;
+    int id;
+    ArraySearch *searchPtr;
+
+    /*
+     * Parse the id into the three parts separated by dashes.
+     */
+
+    if ((string[0] != 's') || (string[1] != '-')) {
+	syntax:
+	Tcl_AppendResult(interp, "illegal search identifier \"", string,
+		"\"", (char *) NULL);
+	return NULL;
+    }
+    id = strtoul(string+2, &end, 10);
+    if ((end == (string+2)) || (*end != '-')) {
+	goto syntax;
+    }
+    if (strcmp(end+1, varName) != 0) {
+	Tcl_AppendResult(interp, "search identifier \"", string,
+		"\" isn't for variable \"", varName, "\"", (char *) NULL);
+	return NULL;
+    }
+
+    /*
+     * Search through the list of active searches on the interpreter
+     * to see if the desired one exists.
+     */
+
+    for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
+	    searchPtr = searchPtr->nextPtr) {
+	if (searchPtr->id == id) {
+	    return searchPtr;
+	}
+    }
+    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
+	    (char *) NULL);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteSearches --
+ *
+ *	This procedure is called to free up all of the searches
+ *	associated with an array variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is released to the storage allocator.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteSearches(arrayVarPtr)
+    register Var *arrayVarPtr;		/* Variable whose searches are
+					 * to be deleted. */
+{
+    ArraySearch *searchPtr;
+
+    while (arrayVarPtr->searchPtr != NULL) {
+	searchPtr = arrayVarPtr->searchPtr;
+	arrayVarPtr->searchPtr = searchPtr->nextPtr;
+	ckfree((char *) searchPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteVars --
+ *
+ *	This procedure is called to recycle all the storage space
+ *	associated with a table of variables. For this procedure
+ *	to work correctly, it must not be possible for any of the
+ *	variables 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
+TclDeleteVars(iPtr, tablePtr)
+    Interp *iPtr;		/* Interpreter to which variables belong. */
+    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 *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->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;
+	    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 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 if (linkPtr->hPtr->tablePtr != tablePtr) {
+		    Tcl_DeleteHashEntry(linkPtr->hPtr);
+		    ckfree((char *) linkPtr);
+		}
+	    }
+	}
+
+	/*
+	 * 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
+	 * hash entries will be deleted automatically when the whole
+	 * 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_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;
+		ckfree((char *) tracePtr);
+	    }
+	    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+		    activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	}
+	    
+	if (TclIsVarArray(varPtr)) {
+	    DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
+	            flags);
+	    varPtr->value.tablePtr = NULL;
+	}
+	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
+	    objPtr = varPtr->value.objPtr;
+	    TclDecrRefCount(objPtr);
+	    varPtr->value.objPtr = NULL;
+	}
+	varPtr->hPtr = NULL;
+	varPtr->tracePtr = NULL;
+	TclSetVarUndefined(varPtr);
+	TclSetVarScalar(varPtr);
+
+	/*
+	 * If the variable was a namespace variable, decrement its 
+	 * reference count. We are in the process of destroying its
+	 * namespace so that namespace will no longer "refer" to the
+	 * variable.
+	 */
+
+	if (varPtr->flags & VAR_NAMESPACE_VAR) {
+	    varPtr->flags &= ~VAR_NAMESPACE_VAR;
+	    varPtr->refCount--;
+	}
+
+	/*
+	 * Recycle the variable's memory space if there aren't any upvar's
+	 * 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); /* this Var must be VAR_IN_HASHTABLE */
+	}
+    }
+    Tcl_DeleteHashTable(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
+ *	variable.  It's the caller's responsibility to make sure
+ *	that the array is no longer accessible before this procedure
+ *	is called.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	All storage associated with varPtr's array elements is deleted
+ *	(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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteArray(iPtr, arrayName, varPtr, flags)
+    Interp *iPtr;			/* Interpreter containing array. */
+    char *arrayName;			/* Name of array (used for trace
+					 * callbacks). */
+    Var *varPtr;			/* Pointer to variable structure. */
+    int flags;				/* Flags to pass to CallTraces:
+					 * TCL_TRACE_UNSETS and sometimes
+					 * 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)) {
+	elPtr = (Var *) Tcl_GetHashValue(hPtr);
+	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
+	    objPtr = elPtr->value.objPtr;
+	    TclDecrRefCount(objPtr);
+	    elPtr->value.objPtr = NULL;
+	}
+	elPtr->hPtr = NULL;
+	if (elPtr->tracePtr != NULL) {
+	    elPtr->flags &= ~VAR_TRACE_ACTIVE;
+	    (void) CallTraces(iPtr, (Var *) NULL, elPtr, arrayName,
+		    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags);
+	    while (elPtr->tracePtr != NULL) {
+		VarTrace *tracePtr = elPtr->tracePtr;
+		elPtr->tracePtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+	    }
+	    for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+		    activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == elPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	}
+	TclSetVarUndefined(elPtr);
+	TclSetVarScalar(elPtr);
+	if (elPtr->refCount == 0) {
+	    ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
+	}
+    }
+    Tcl_DeleteHashTable(varPtr->value.tablePtr);
+    ckfree((char *) varPtr->value.tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupVar --
+ *
+ *	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 and in a
+ *	hashtable, then its Var structure, and possibly its hash table
+ *	entry, is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanupVar(varPtr, arrayPtr)
+    Var *varPtr;		/* Pointer to variable that may be a
+				 * candidate for being expunged. */
+    Var *arrayPtr;		/* Array that contains the variable, or
+				 * NULL if this variable isn't an array
+				 * element. */
+{
+    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 (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
+		&& (arrayPtr->tracePtr == NULL)
+	        && (arrayPtr->flags & VAR_IN_HASHTABLE)) {
+	    if (arrayPtr->hPtr != NULL) {
+		Tcl_DeleteHashEntry(arrayPtr->hPtr);
+	    }
+	    ckfree((char *) arrayPtr);
+	}
+    }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * VarErrMsg --
+ *
+ *      Generate a reasonable error message describing why a variable
+ *      operation failed.
+ *
+ * Results:
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_ResetResult(interp);
+    Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
+		     (char *) NULL);
+    if (part2 != NULL) {
+        Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
+    }
+    Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
+}
diff --git a/tcl/library/history.tcl b/tcl/library/history.tcl
new file mode 100644
index 00000000000..c200f0d6039
--- /dev/null
+++ b/tcl/library/history.tcl
@@ -0,0 +1,369 @@
+# history.tcl --
+#
+# Implementation of the history command.
+#
+# RCS: @(#) $Id$
+#
+# 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.
+#
+
+# The tcl::history array holds the history list and
+# some additional bookkeeping variables.
+#
+# nextid	the index used for the next history list item.
+# keep		the max size of the history list
+# oldest	the index of the oldest item in the history.
+
+namespace eval tcl {
+    variable history
+    if {![info exists history]} {
+	array set history {
+	    nextid	0
+	    keep	20
+	    oldest	-20
+	}
+    }
+}
+
+# history --
+#
+#	This is the main history command.  See the man page for its interface.
+#	This does argument checking and calls helper procedures in the
+#	history namespace.
+
+proc history {args} {
+    set len [llength $args]
+    if {$len == 0} {
+	return [tcl::HistInfo]
+    }
+    set key [lindex $args 0]
+    set options "add, change, clear, event, info, keep, nextid, or redo"
+    switch -glob -- $key {
+	a* { # history add
+
+	    if {$len > 3} {
+		return -code error "wrong # args: should be \"history add event ?exec?\""
+	    }
+	    if {![string match $key* add]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    if {$len == 3} {
+		set arg [lindex $args 2]
+		if {! ([string match e* $arg] && [string match $arg* exec])} {
+		    return -code error "bad argument \"$arg\": should be \"exec\""
+		}
+	    }
+	    return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
+	}
+	ch* { # history change
+
+	    if {($len > 3) || ($len < 2)} {
+		return -code error "wrong # args: should be \"history change newValue ?event?\""
+	    }
+	    if {![string match $key* change]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    if {$len == 2} {
+		set event 0
+	    } else {
+		set event [lindex $args 2]
+	    }
+
+	    return [tcl::HistChange [lindex $args 1] $event]
+	}
+	cl* { # history clear
+
+	    if {($len > 1)} {
+		return -code error "wrong # args: should be \"history clear\""
+	    }
+	    if {![string match $key* clear]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    return [tcl::HistClear]
+	}
+	e* { # history event
+
+	    if {$len > 2} {
+		return -code error "wrong # args: should be \"history event ?event?\""
+	    }
+	    if {![string match $key* event]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    if {$len == 1} {
+		set event -1
+	    } else {
+		set event [lindex $args 1]
+	    }
+	    return [tcl::HistEvent $event]
+	}
+	i* { # history info
+
+	    if {$len > 2} {
+		return -code error "wrong # args: should be \"history info ?count?\""
+	    }
+	    if {![string match $key* info]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    return [tcl::HistInfo [lindex $args 1]]
+	}
+	k* { # history keep
+
+	    if {$len > 2} {
+		return -code error "wrong # args: should be \"history keep ?count?\""
+	    }
+	    if {$len == 1} {
+		return [tcl::HistKeep]
+	    } else {
+		set limit [lindex $args 1]
+		if {[catch {expr {~$limit}}] || ($limit < 0)} {
+		    return -code error "illegal keep count \"$limit\""
+		}
+		return [tcl::HistKeep $limit]
+	    }
+	}
+	n* { # history nextid
+
+	    if {$len > 1} {
+		return -code error "wrong # args: should be \"history nextid\""
+	    }
+	    if {![string match $key* nextid]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    return [expr {$tcl::history(nextid) + 1}]
+	}
+	r* { # history redo
+
+	    if {$len > 2} {
+		return -code error "wrong # args: should be \"history redo ?event?\""
+	    }
+	    if {![string match $key* redo]} {
+		return -code error "bad option \"$key\": must be $options"
+	    }
+	    return [tcl::HistRedo [lindex $args 1]]
+	}
+	default {
+	    return -code error "bad option \"$key\": must be $options"
+	}
+    }
+}
+
+# tcl::HistAdd --
+#
+#	Add an item to the history, and optionally eval it at the global scope
+#
+# Parameters:
+#	command		the command to add
+#	exec		(optional) a substring of "exec" causes the
+#			command to be evaled.
+# Results:
+# 	If executing, then the results of the command are returned
+#
+# Side Effects:
+#	Adds to the history list
+
+ proc tcl::HistAdd {command {exec {}}} {
+    variable history
+    set i [incr history(nextid)]
+    set history($i) $command
+    set j [incr history(oldest)]
+    if {[info exists history($j)]} {unset history($j)}
+    if {[string match e* $exec]} {
+	return [uplevel #0 $command]
+    } else {
+	return {}
+    }
+}
+
+# tcl::HistKeep --
+#
+#	Set or query the limit on the length of the history list
+#
+# Parameters:
+#	limit	(optional) the length of the history list
+#
+# Results:
+#	If no limit is specified, the current limit is returned
+#
+# Side Effects:
+#	Updates history(keep) if a limit is specified
+
+ proc tcl::HistKeep {{limit {}}} {
+    variable history
+    if {[string length $limit] == 0} {
+	return $history(keep)
+    } else {
+	set oldold $history(oldest)
+	set history(oldest) [expr {$history(nextid) - $limit}]
+	for {} {$oldold <= $history(oldest)} {incr oldold} {
+	    if {[info exists history($oldold)]} {unset history($oldold)}
+	}
+	set history(keep) $limit
+    }
+}
+
+# tcl::HistClear --
+#
+#	Erase the history list
+#
+# Parameters:
+#	none
+#
+# Results:
+#	none
+#
+# Side Effects:
+#	Resets the history array, except for the keep limit
+
+ proc tcl::HistClear {} {
+    variable history
+    set keep $history(keep)
+    unset history
+    array set history [list \
+	nextid	0	\
+	keep	$keep	\
+	oldest	-$keep	\
+    ]
+}
+
+# tcl::HistInfo --
+#
+#	Return a pretty-printed version of the history list
+#
+# Parameters:
+#	num	(optional) the length of the history list to return
+#
+# Results:
+#	A formatted history list
+
+ proc tcl::HistInfo {{num {}}} {
+    variable history
+    if {$num == {}} {
+	set num [expr {$history(keep) + 1}]
+    }
+    set result {}
+    set newline ""
+    for {set i [expr {$history(nextid) - $num + 1}]} \
+	    {$i <= $history(nextid)} {incr i} {
+	if {![info exists history($i)]} {
+	    continue
+	}
+	set cmd [string trimright $history($i) \ \n]
+	regsub -all \n $cmd "\n\t" cmd
+	append result $newline[format "%6d  %s" $i $cmd]
+	set newline \n
+    }
+    return $result
+}
+
+# tcl::HistRedo --
+#
+#	Fetch the previous or specified event, execute it, and then
+#	replace the current history item with that event.
+#
+# Parameters:
+#	event	(optional) index of history item to redo.  Defaults to -1,
+#		which means the previous event.
+#
+# Results:
+#	Those of the command being redone.
+#
+# Side Effects:
+#	Replaces the current history list item with the one being redone.
+
+ proc tcl::HistRedo {{event -1}} {
+    variable history
+    if {[string length $event] == 0} {
+	set event -1
+    }
+    set i [HistIndex $event]
+    if {$i == $history(nextid)} {
+	return -code error "cannot redo the current event"
+    }
+    set cmd $history($i)
+    HistChange $cmd 0
+    uplevel #0 $cmd
+}
+
+# tcl::HistIndex --
+#
+#	Map from an event specifier to an index in the history list.
+#
+# Parameters:
+#	event	index of history item to redo.
+#		If this is a positive number, it is used directly.
+#		If it is a negative number, then it counts back to a previous
+#		event, where -1 is the most recent event.
+#		A string can be matched, either by being the prefix of
+#		a command or by matching a command with string match.
+#
+# Results:
+#	The index into history, or an error if the index didn't match.
+
+ proc tcl::HistIndex {event} {
+    variable history
+    if {[catch {expr {~$event}}]} {
+	for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {
+	    if {[string match $event* $history($i)]} {
+		return $i;
+	    }
+	    if {[string match $event $history($i)]} {
+		return $i;
+	    }
+	}
+	return -code error "no event matches \"$event\""
+    } elseif {$event <= 0} {
+	set i [expr {$history(nextid) + $event}]
+    } else {
+	set i $event
+    }
+    if {$i <= $history(oldest)} {
+	return -code error "event \"$event\" is too far in the past"
+    }
+    if {$i > $history(nextid)} {
+	return -code error "event \"$event\" hasn't occured yet"
+    }
+    return $i
+}
+
+# tcl::HistEvent --
+#
+#	Map from an event specifier to the value in the history list.
+#
+# Parameters:
+#	event	index of history item to redo.  See index for a
+#		description of possible event patterns.
+#
+# Results:
+#	The value from the history list.
+
+ proc tcl::HistEvent {event} {
+    variable history
+    set i [HistIndex $event]
+    if {[info exists history($i)]} {
+	return [string trimright $history($i) \ \n]
+    } else {
+	return "";
+    }
+}
+
+# tcl::HistChange --
+#
+#	Replace a value in the history list.
+#
+# Parameters:
+#	cmd	The new value to put into the history list.
+#	event	(optional) index of history item to redo.  See index for a
+#		description of possible event patterns.  This defaults
+#		to 0, which specifies the current event.
+#
+# Side Effects:
+#	Changes the history list.
+
+ proc tcl::HistChange {cmd {event 0}} {
+    variable history
+    set i [HistIndex $event]
+    set history($i) $cmd
+}
diff --git a/tcl/library/http1.0/http.tcl b/tcl/library/http1.0/http.tcl
new file mode 100644
index 00000000000..f9991509cba
--- /dev/null
+++ b/tcl/library/http1.0/http.tcl
@@ -0,0 +1,379 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+# 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 $srvurl] == 0} {
+	set srvurl /
+    }
+    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]} {
+	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)]} {
+		    fconfigure $state(-channel) -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 {error {}}} {
+    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 {([string length $error] != 0)} {
+	httpFinish $token $error
+    } elseif {[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/tcl/library/http1.0/pkgIndex.tcl b/tcl/library/http1.0/pkgIndex.tcl
new file mode 100644
index 00000000000..ab6170f7f62
--- /dev/null
+++ b/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/tcl/library/init.tcl b/tcl/library/init.tcl
new file mode 100644
index 00000000000..9cb9a1a0cb6
--- /dev/null
+++ b/tcl/library/init.tcl
@@ -0,0 +1,1537 @@
+# init.tcl --
+#
+# Default system startup file for Tcl-based applications.  Defines
+# "unknown" procedure and auto-load facilities.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+if {[info commands package] == ""} {
+    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
+}
+package require -exact Tcl 8.0
+
+# Compute the auto path to use in this interpreter.
+# The values on the path come from several locations:
+#
+# The environment variable TCLLIBPATH
+#
+# tcl_library, which is the directory containing this init.tcl script.
+# tclInitScript.h searches around for the directory containing this
+# init.tcl and defines tcl_library to that location before sourcing it.
+#
+# The parent directory of tcl_library. Adding the parent
+# means that packages in peer directories will be found automatically.
+#
+# tcl_pkgPath, which is set by the platform-specific initialization routines
+#	On UNIX it is compiled in
+#	On Windows it comes from the registry
+#	On Macintosh it is "Tool Command Language" in the Extensions folder
+
+if {![info exists auto_path]} {
+    if {[info exist env(TCLLIBPATH)]} {
+	set auto_path $env(TCLLIBPATH)
+    } else {
+	set auto_path ""
+    }
+}
+foreach __dir [list [info library] [file dirname [info library]]] {
+    if {[lsearch -exact $auto_path $__dir] < 0} {
+	lappend auto_path $__dir
+    }
+}
+if {[info exist tcl_pkgPath]} {
+    foreach __dir $tcl_pkgPath {
+	if {[lsearch -exact $auto_path $__dir] < 0} {
+	    lappend auto_path $__dir
+	}
+    }
+}
+unset __dir
+
+# Windows specific initialization to handle case isses with envars
+
+if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
+    namespace eval tcl {
+	proc envTraceProc {lo n1 n2 op} {
+	    set x $::env($n2)
+	    set ::env($lo) $x
+	    set ::env([string toupper $lo]) $x
+	}
+    }
+    foreach p [array names env] {
+	set u [string toupper $p]
+	if {$u != $p} {
+	    switch -- $u {
+		COMSPEC -
+		PATH {
+		    if {![info exists env($u)]} {
+			set env($u) $env($p)
+		    }
+		    trace variable env($p) w [list tcl::envTraceProc $p]
+		    trace variable env($u) w [list tcl::envTraceProc $p]
+		}
+	    }
+	}
+    }
+    if {[info exists p]} {
+	unset p
+    }
+    if {[info exists u]} {
+	unset u
+    }
+    if {![info exists env(COMSPEC)]} {
+	if {$tcl_platform(os) == {Windows NT}} {
+	    set env(COMSPEC) cmd.exe
+	} else {
+	    set env(COMSPEC) command.com
+	}
+    }
+}
+
+# Setup the unknown package handler
+
+package unknown tclPkgUnknown
+
+# Conditionalize for presence of exec.
+
+if {[info commands exec] == ""} {
+
+    # Some machines, such as the Macintosh, do not have exec. Also, on all
+    # platforms, safe interpreters do not have exec.
+
+    set auto_noexec 1
+}
+set errorCode ""
+set errorInfo ""
+
+# Define a log command (which can be overwitten to log errors
+# differently, specially when stderr is not available)
+
+if {[info commands tclLog] == ""} {
+    proc tclLog {string} {
+	catch {puts stderr $string}
+    }
+}
+
+# unknown --
+# This procedure is called when a Tcl command is invoked that doesn't
+# exist in the interpreter.  It takes the following steps to make the
+# command available:
+#
+#	1. See if the command has the form "namespace inscope ns cmd" and
+#	   if so, concatenate its arguments onto the end and evaluate it.
+#	2. See if the autoload facility can locate the command in a
+#	   Tcl script file.  If so, load it and execute it.
+#	3. If the command was invoked interactively at top-level:
+#	    (a) see if the command exists as an executable UNIX program.
+#		If so, "exec" the command.
+#	    (b) see if the command requests csh-like history substitution
+#		in one of the common forms !!, !<number>, or ^old^new.  If
+#		so, emulate csh's history substitution.
+#	    (c) see if the command is a unique abbreviation for another
+#		command.  If so, invoke the command.
+#
+# Arguments:
+# args -	A list whose elements are the words of the original
+#		command, including the command name.
+
+proc unknown args {
+    global auto_noexec auto_noload env unknown_pending tcl_interactive
+    global errorCode errorInfo
+
+    # If the command word has the form "namespace inscope ns cmd"
+    # then concatenate its arguments onto the end and evaluate it.
+
+    set cmd [lindex $args 0]
+    if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
+        set arglist [lrange $args 1 end]
+	set ret [catch {uplevel $cmd $arglist} result]
+        if {$ret == 0} {
+            return $result
+        } else {
+	    return -code $ret -errorcode $errorCode $result
+        }
+    }
+
+    # Save the values of errorCode and errorInfo variables, since they
+    # may get modified if caught errors occur below.  The variables will
+    # be restored just before re-executing the missing command.
+
+    set savedErrorCode $errorCode
+    set savedErrorInfo $errorInfo
+    set name [lindex $args 0]
+    if {![info exists auto_noload]} {
+	#
+	# Make sure we're not trying to load the same proc twice.
+	#
+	if {[info exists unknown_pending($name)]} {
+	    return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
+	}
+	set unknown_pending($name) pending;
+	set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
+	unset unknown_pending($name);
+	if {$ret != 0} {
+	    return -code $ret -errorcode $errorCode \
+		"error while autoloading \"$name\": $msg"
+	}
+	if {![array size unknown_pending]} {
+	    unset unknown_pending
+	}
+	if {$msg} {
+	    set errorCode $savedErrorCode
+	    set errorInfo $savedErrorInfo
+	    set code [catch {uplevel 1 $args} msg]
+	    if {$code ==  1} {
+		#
+		# Strip the last five lines off the error stack (they're
+		# from the "uplevel" command).
+		#
+
+		set new [split $errorInfo \n]
+		set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
+		return -code error -errorcode $errorCode \
+			-errorinfo $new $msg
+	    } else {
+		return -code $code $msg
+	    }
+	}
+    }
+
+    if {([info level] == 1) && ([info script] == "") \
+	    && [info exists tcl_interactive] && $tcl_interactive} {
+	if {![info exists auto_noexec]} {
+	    set new [auto_execok $name]
+	    if {$new != ""} {
+		set errorCode $savedErrorCode
+		set errorInfo $savedErrorInfo
+		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 == "!!"} {
+	    set newcmd [history event]
+	} elseif {[regexp {^!(.+)$} $name dummy event]} {
+	    set newcmd [history event $event]
+	} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
+	    set newcmd [history event -1]
+	    catch {regsub -all -- $old $newcmd $new newcmd}
+	}
+	if {[info exists newcmd]} {
+	    tclLog $newcmd
+	    history change $newcmd 0
+	    return [uplevel $newcmd]
+	}
+
+	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]]
+	}
+	if {[llength $cmds] != 0} {
+	    if {$name == ""} {
+		return -code error "empty command name \"\""
+	    } else {
+		return -code error \
+			"ambiguous command name \"$name\": [lsort $cmds]"
+	    }
+	}
+    }
+    return -code error "invalid command name \"$name\""
+}
+
+# auto_load --
+# Checks a collection of library directories to see if a procedure
+# is defined in one of them.  If so, it sources the appropriate
+# library file to create the procedure.  Returns 1 if it successfully
+# loaded the procedure, 0 otherwise.
+#
+# Arguments: 
+# cmd -			Name of the command to find and load.
+# namespace (optional)  The namespace where the command is being used - must be
+#                       a canonical namespace as returned [namespace current]
+#                       for instance. If not given, namespace current is used.
+
+proc auto_load {cmd {namespace {}}} {
+    global auto_index auto_oldpath auto_path
+
+    if {[string length $namespace] == 0} {
+	set namespace [uplevel {namespace current}]
+    }
+    set nameList [auto_qualify $cmd $namespace]
+    # workaround non canonical auto_index entries that might be around
+    # from older auto_mkindex versions
+    lappend nameList $cmd
+    foreach name $nameList {
+	if {[info exists auto_index($name)]} {
+	    uplevel #0 $auto_index($name)
+	    return [expr {[info commands $name] != ""}]
+	}
+    }
+    if {![info exists auto_path]} {
+	return 0
+    }
+
+    if {![auto_load_index]} {
+	return 0
+    }
+
+    foreach name $nameList {
+	if {[info exists auto_index($name)]} {
+	    uplevel #0 $auto_index($name)
+	    if {[info commands $name] != ""} {
+		return 1
+	    }
+	}
+    }
+    return 0
+}
+
+# auto_load_index --
+# Loads the contents of tclIndex files on the auto_path directory
+# list.  This is usually invoked within auto_load to load the index
+# of available commands.  Returns 1 if the index is loaded, and 0 if
+# the index is already loaded and up to date.
+#
+# Arguments: 
+# None.
+
+proc auto_load_index {} {
+    global auto_index auto_oldpath auto_path errorInfo errorCode
+
+    if {[info exists auto_oldpath]} {
+	if {$auto_oldpath == $auto_path} {
+	    return 0
+	}
+    }
+    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 {$issafe} {
+	    catch {source [file join $dir tclIndex]}
+	} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
+	    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]]"
+		    }
+		} else {
+		    error \
+		      "[file join $dir tclIndex] isn't a proper Tcl index file"
+		}
+	    } msg]
+	    if {$f != ""} {
+		close $f
+	    }
+	    if {$error} {
+		error $msg $errorInfo $errorCode
+	    }
+	}
+    }
+    return 1
+}
+
+# auto_qualify --
+# compute a fully qualified names list for use in the auto_index array.
+# For historical reasons, commands in the global namespace do not have leading
+# :: in the index key. The list has two elements when the command name is
+# relative (no leading ::) and the namespace is not the global one. Otherwise
+# only one name is returned (and searched in the auto_index).
+#
+# Arguments -
+# cmd		The command name. Can be any name accepted for command
+#               invocations (Like "foo::::bar").
+# namespace	The namespace where the command is being used - must be
+#               a canonical namespace as returned by [namespace current]
+#               for instance.
+
+proc auto_qualify {cmd namespace} {
+
+    # count separators and clean them up
+    # (making sure that foo:::::bar will be treated as foo::bar)
+    set n [regsub -all {::+} $cmd :: cmd]
+
+    # Ignore namespace if the name starts with ::
+    # Handle special case of only leading ::
+
+    # Before each return case we give an example of which category it is
+    # with the following form :
+    # ( inputCmd, inputNameSpace) -> output
+
+    if {[regexp {^::(.*)$} $cmd x tail]} {
+	if {$n > 1} {
+	    # ( ::foo::bar , * ) -> ::foo::bar
+	    return [list $cmd]
+	} else {
+	    # ( ::global , * ) -> global
+	    return [list $tail]
+	}
+    }
+    
+    # Potentially returning 2 elements to try  :
+    # (if the current namespace is not the global one)
+
+    if {$n == 0} {
+	if {[string compare $namespace ::] == 0} {
+	    # ( nocolons , :: ) -> nocolons
+	    return [list $cmd]
+	} else {
+	    # ( nocolons , ::sub ) -> ::sub::nocolons nocolons
+	    return [list ${namespace}::$cmd $cmd]
+	}
+    } else {
+	if {[string compare $namespace ::] == 0} {
+	    #  ( foo::bar , :: ) -> ::foo::bar
+	    return [list ::$cmd]
+	} else {
+	    # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
+	    return [list ${namespace}::$cmd ::$cmd]
+	}
+    }
+}
+
+# auto_import --
+# invoked during "namespace import" to make see if the imported commands
+# reside in an autoloaded library.  If so, the commands are loaded so
+# that they will be available for the import links.  If not, then this
+# procedure does nothing.
+#
+# Arguments -
+# pattern	The pattern of commands being imported (like "foo::*")
+#               a canonical namespace as returned by [namespace current]
+
+proc auto_import {pattern} {
+    global auto_index
+
+    set ns [uplevel namespace current]
+    set patternList [auto_qualify $pattern $ns]
+
+    auto_load_index
+
+    foreach pattern $patternList {
+        foreach name [array names auto_index] {
+            if {[string match $pattern $name] && "" == [info commands $name]} {
+                uplevel #0 $auto_index($name)
+            }
+        }
+    }
+}
+
+if {[string compare $tcl_platform(platform) windows] == 0} {
+
+# auto_execok --
+#
+# 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.
+
+# Windows version.
+#
+# Note that info executable doesn't work under Windows, so we have to
+# look for files with .exe, .com, or .bat extensions.  Also, the path
+# may be in the Path or PATH environment variables, and path
+# components are separated with semicolons, not colons as under Unix.
+#
+proc auto_execok name {
+    global auto_execs env tcl_platform
+
+    if {[info exists auto_execs($name)]} {
+	return $auto_execs($name)
+    }
+    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 ""
+    }
+
+    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;"
+	}
+	append path "$windir/system;$windir;"
+    }
+
+    if {[info exists env(PATH)]} {
+        # CYGNUS LOCAL: in the Cygwin environment, we convert to a
+	# Windows path first.
+        if {[llength [info commands ide_cygwin_path]]} {
+	    append path [ide_cygwin_path posix_to_win32_path_list $env(PATH)]
+	} else {
+	    append path $env(PATH)
+	}
+    }
+
+    foreach dir [split $path {;}] {
+	if {$dir == ""} {
+	    set dir .
+	}
+	foreach ext {{} .com .exe .bat} {
+	    set file [file join $dir ${name}${ext}]
+	    if {[file exists $file] && ![file isdirectory $file]} {
+		return [set auto_execs($name) [list $file]]
+	    }
+	}
+    }
+    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 {
+    global auto_execs env
+
+    if {[info exists auto_execs($name)]} {
+	return $auto_execs($name)
+    }
+    set auto_execs($name) ""
+    if {[llength [file split $name]] != 1} {
+	if {[file executable $name] && ![file isdirectory $name]} {
+	    set auto_execs($name) [list $name]
+	}
+	return $auto_execs($name)
+    }
+    foreach dir [split $env(PATH) :] {
+	if {$dir == ""} {
+	    set dir .
+	}
+	set file [file join $dir $name]
+	if {[file executable $file] && ![file isdirectory $file]} {
+	    set auto_execs($name) [list $file]
+	    return $auto_execs($name)
+	}
+    }
+    return ""
+}
+
+}
+# auto_reset --
+# Destroy all cached information for auto-loading and auto-execution,
+# so that the information gets recomputed the next time it's needed.
+# Also delete any procedures that are listed in the auto-load index
+# except those defined in this file.
+#
+# Arguments: 
+# None.
+
+proc auto_reset {} {
+    global auto_execs auto_index auto_oldpath
+    foreach p [info procs] {
+	if {[info exists auto_index($p)] && ![string match auto_* $p]
+		&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
+			tcl_findLibrary pkg_compareExtension
+			tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
+	    rename $p {}
+	}
+    }
+    catch {unset auto_execs}
+    catch {unset auto_index}
+    catch {unset auto_oldpath}
+}
+
+# tcl_findLibrary
+#	This is a utility for extensions that searches for a library directory
+#	using a canonical searching algorithm. A side effect is to source
+#	the initialization script and set a global library variable.
+# Arguments:
+# 	basename	Prefix of the directory name, (e.g., "tk")
+#	version		Version number of the package, (e.g., "8.0")
+#	patch		Patchlevel of the package, (e.g., "8.0.3")
+#	initScript	Initialization script to source (e.g., tk.tcl)
+#	enVarName	environment variable to honor (e.g., TK_LIBRARY)
+#	varName		Global variable to set when done (e.g., tk_library)
+#       CYGNUS LOCAL:   We have funny things like gdb having different library
+#                       names before & after install (and neither of them is gdb
+#                       or gdb$version... 
+#       srcLibName      The name of the library directory in the build tree (assumed to be 
+#                       under the basename directory.
+#       instLibName     The name of the installed library directory
+#       pkgName         The package name (for cases like Itcl where you have
+#                       several subpackages under one package...
+#       debug_startup   Run the startup proc through debugger_eval?
+
+proc tcl_findLibrary {basename version patch initScript 
+                      enVarName varName {srcLibName {}} {instLibName {}} 
+		      {pkgName {}} {debug_startup 0}} {
+    upvar #0 $varName the_library
+    global env errorInfo
+
+    set dirs {}
+    set errors {}
+
+    # The C application may have hardwired a path, which we honor
+    
+    if {[info exist the_library]} {
+	lappend dirs $the_library
+    } else {
+
+	# Do the canonical search
+
+	# 1. From an environment variable, if it exists
+
+        if {[info exists env($enVarName)]} {
+            lappend dirs $env($enVarName)
+        }
+
+	# 2. Relative to the Tcl library
+        # CYGNUS LOCAL: look in several places relative to the tcl library.
+       
+        if {$srcLibName == ""} {
+	  set srcLibName library
+	}
+	if {$instLibName == ""} {
+	  set instLibName $basename$version
+        }
+
+        set parentDir [file dirname [info library]]
+        set grandParentDir [file dirname $parentDir]
+        # These two are install locations without & with exec_prefix.
+        lappend dirs [file join $parentDir $instLibName]
+        lappend dirs [file join $grandParentDir $instLibName]
+        # The rest are in the build tree:
+        # this is for most things:
+        lappend dirs [file join $grandParentDir $basename $srcLibName]
+        # this is if we ever put version numbers on Tcl & Tk:
+        lappend dirs [file join $grandParentDir $basename$version $srcLibName]
+        # This handles itcl:
+        if {$pkgName != ""} {
+	  lappend dirs [file join $grandParentDir $pkgName $basename $srcLibName]
+	  lappend dirs [file join $grandParentDir $pkgName $basename$version $srcLibName]
+        } 
+	
+	# 3. Various locations relative to the executable
+        #CYGNUS LOCAL - I took all this out.  For Cygnus, it seems more
+        # reasonable to look relative to tcl_library.  This might be anywhere
+        # since the source & build trees are often widely separated, 
+        # but once you've found tcl_library, you've found the source tree,
+        # and everything else is easy...
+    }
+
+    foreach i $dirs {
+        set the_library $i
+        set file [file join $i $initScript]
+
+	# source everything when in a safe interpreter because
+	# we have a source command, but no file exists command
+
+        if {[interp issafe] || [file exists $file]} {
+	    if {$debug_startup} {
+	    
+	      if {![catch {uplevel \#0 debugger_eval [list [list source $file]]} msg]} {
+	            return
+                } else {
+	            append errors "$file: $msg\n$errorInfo\n"
+                }
+	    } else {
+                if {![catch {uplevel \#0 [list source $file]} msg]} {
+	            return
+                } else {
+	            append errors "$file: $msg\n$errorInfo\n"
+                }
+	    }
+	}
+    }
+    set msg "Can't find a usable $initScript in the following directories: \n"
+    append msg "    $dirs\n\n"
+    append msg "$errors\n\n"
+    append msg "This probably means that $basename wasn't installed properly.\n"
+    error $msg
+}
+
+
+# OPTIONAL SUPPORT PROCEDURES
+# In Tcl 8.1 all the code below here has been moved to other files to
+# reduce the size of init.tcl
+
+# ----------------------------------------------------------------------
+# auto_mkindex
+# ----------------------------------------------------------------------
+# The following procedures are used to generate the tclIndex file
+# from Tcl source files.  They use a special safe interpreter to
+# parse Tcl source files, writing out index entries as "proc"
+# commands are encountered.  This implementation won't work in a
+# safe interpreter, since a safe interpreter can't create the
+# special parser and mess with its commands.  If this is a safe
+# interpreter, we simply clip these procs out.
+
+if {! [interp issafe]} {
+
+    # auto_mkindex --
+    # Regenerate a tclIndex file from Tcl source files.  Takes as argument
+    # the name of the directory in which the tclIndex file is to be placed,
+    # followed by any number of glob patterns to use in that directory to
+    # locate all of the relevant files.
+    #
+    # Arguments: 
+    # dir -		Name of the directory in which to create an index.
+    # args -	Any number of additional arguments giving the
+    #		names of files within dir.  If no additional
+    #		are given auto_mkindex will look for *.tcl.
+
+    proc auto_mkindex {dir args} {
+	global errorCode errorInfo
+
+	set oldDir [pwd]
+	cd $dir
+	set dir [pwd]
+
+	append index "# Tcl autoload index file, version 2.0\n"
+	append index "# This file is generated by the \"auto_mkindex\" command\n"
+	append index "# and sourced to set up indexing information for one or\n"
+	append index "# more commands.  Typically each line is a command that\n"
+	append index "# sets an element in the auto_index array, where the\n"
+	append index "# element name is the name of a command and the value is\n"
+	append index "# a script that loads the command.\n\n"
+	if {$args == ""} {
+	    set args *.tcl
+	}
+	foreach file [eval glob $args] {
+	    auto_mkindex_parser::init
+	    if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
+		append index $msg
+	    } else {
+		set code $errorCode
+		set info $errorInfo
+		cd $oldDir
+		error $msg $info $code
+	    }
+	    auto_mkindex_parser::cleanup
+	}
+
+	set fid [open "tclIndex" w]
+	puts $fid $index nonewline
+	close $fid
+	cd $oldDir
+    }
+
+    # Original version of auto_mkindex that just searches the source
+    # code for "proc" at the beginning of the line.
+
+    proc auto_mkindex_old {dir args} {
+	global errorCode errorInfo
+	set oldDir [pwd]
+	cd $dir
+	set dir [pwd]
+	append index "# Tcl autoload index file, version 2.0\n"
+	append index "# This file is generated by the \"auto_mkindex\" command\n"
+	append index "# and sourced to set up indexing information for one or\n"
+	append index "# more commands.  Typically each line is a command that\n"
+	append index "# sets an element in the auto_index array, where the\n"
+	append index "# element name is the name of a command and the value is\n"
+	append index "# a script that loads the command.\n\n"
+	if {$args == ""} {
+	    set args *.tcl
+	}
+	foreach file [eval glob $args] {
+	    set f ""
+	    set error [catch {
+		set f [open $file]
+		while {[gets $f line] >= 0} {
+		    if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
+			set procName [lindex [auto_qualify $procName "::"] 0]
+			append index "set [list auto_index($procName)]"
+			append index " \[list source \[file join \$dir [list $file]\]\]\n"
+		    }
+		}
+		close $f
+	    } msg]
+	    if {$error} {
+		set code $errorCode
+		set info $errorInfo
+		catch {close $f}
+		cd $oldDir
+		error $msg $info $code
+	    }
+	}
+	set f ""
+	set error [catch {
+	    set f [open tclIndex w]
+	    puts $f $index nonewline
+	    close $f
+	    cd $oldDir
+	} msg]
+	if {$error} {
+	    set code $errorCode
+	    set info $errorInfo
+	    catch {close $f}
+	    cd $oldDir
+	    error $msg $info $code
+	}
+    }
+
+    # Create a safe interpreter that can be used to parse Tcl source files
+    # generate a tclIndex file for autoloading.  This interp contains
+    # commands for things that need index entries.  Each time a command
+    # is executed, it writes an entry out to the index file.
+
+    namespace eval auto_mkindex_parser {
+	variable parser ""          ;# parser used to build index
+	variable index ""           ;# maintains index as it is built
+	variable scriptFile ""      ;# name of file being processed
+	variable contextStack ""    ;# stack of namespace scopes
+	variable imports ""         ;# keeps track of all imported cmds
+	variable initCommands ""    ;# list of commands that create aliases
+	proc init {} {
+	    variable parser
+	    variable initCommands
+	    if {![interp issafe]} {
+		set parser [interp create -safe]
+		$parser hide info
+		$parser hide rename
+		$parser hide proc
+		$parser hide namespace
+		$parser hide eval
+		$parser hide puts
+		$parser invokehidden namespace delete ::
+		$parser invokehidden proc unknown {args} {}
+
+		#
+		# We'll need access to the "namespace" command within the
+		# interp.  Put it back, but move it out of the way.
+		#
+		$parser expose namespace
+		$parser invokehidden rename namespace _%@namespace
+		$parser expose eval
+		$parser invokehidden rename eval _%@eval
+
+		# Install all the registered psuedo-command implementations
+
+		foreach cmd $initCommands {
+		    eval $cmd
+		}
+	    }
+	}
+	proc cleanup {} {
+	    variable parser
+	    interp delete $parser
+	    unset parser
+	}
+    }
+
+    # auto_mkindex_parser::mkindex --
+    # Used by the "auto_mkindex" command to create a "tclIndex" file for
+    # the given Tcl source file.  Executes the commands in the file, and
+    # handles things like the "proc" command by adding an entry for the
+    # index file.  Returns a string that represents the index file.
+    #
+    # Arguments: 
+    # file -		Name of Tcl source file to be indexed.
+
+    proc auto_mkindex_parser::mkindex {file} {
+	variable parser
+	variable index
+	variable scriptFile
+	variable contextStack
+	variable imports
+
+	set scriptFile $file
+
+	set fid [open $file]
+	set contents [read $fid]
+	close $fid
+
+	# There is one problem with sourcing files into the safe
+	# interpreter:  references like "$x" will fail since code is not
+	# really being executed and variables do not really exist.
+	# Be careful to escape all naked "$" before evaluating.
+
+	regsub -all {([^\$])\$([^\$])} $contents {\1\\$\2} contents
+
+	set index ""
+	set contextStack ""
+	set imports ""
+
+	$parser eval $contents
+
+	foreach name $imports {
+	    catch {$parser eval [list _%@namespace forget $name]}
+	}
+	return $index
+    }
+
+    # auto_mkindex_parser::hook command
+    # Registers a Tcl command to evaluate when initializing the
+    # slave interpreter used by the mkindex parser.
+    # The command is evaluated in the master interpreter, and can
+    # use the variable auto_mkindex_parser::parser to get to the slave
+
+    proc auto_mkindex_parser::hook {cmd} {
+	variable initCommands
+
+	lappend initCommands $cmd
+    }
+
+    # auto_mkindex_parser::slavehook command
+    # Registers a Tcl command to evaluate when initializing the
+    # slave interpreter used by the mkindex parser.
+    # The command is evaluated in the slave interpreter.
+
+    proc auto_mkindex_parser::slavehook {cmd} {
+	variable initCommands
+
+	lappend initCommands "\$parser eval [list $cmd]"
+    }
+
+    # auto_mkindex_parser::command --
+    # Registers a new command with the "auto_mkindex_parser" interpreter
+    # that parses Tcl files.  These commands are fake versions of things
+    # like the "proc" command.  When you execute them, they simply write
+    # out an entry to a "tclIndex" file for auto-loading.
+    #
+    # This procedure allows extensions to register their own commands
+    # with the auto_mkindex facility.  For example, a package like
+    # [incr Tcl] might register a "class" command so that class definitions
+    # could be added to a "tclIndex" file for auto-loading.
+    #
+    # Arguments:
+    # name -		Name of command recognized in Tcl files.
+    # arglist -		Argument list for command.
+    # body -		Implementation of command to handle indexing.
+
+    proc auto_mkindex_parser::command {name arglist body} {
+	hook [list auto_mkindex_parser::commandInit $name $arglist $body]
+    }
+
+    # auto_mkindex_parser::commandInit --
+    # This does the actual work set up by auto_mkindex_parser::command
+    # This is called when the interpreter used by the parser is created.
+
+    proc auto_mkindex_parser::commandInit {name arglist body} {
+	variable parser
+
+	set ns [namespace qualifiers $name]
+	set tail [namespace tail $name]
+	if {$ns == ""} {
+	    set fakeName "[namespace current]::_%@fake_$tail"
+	} else {
+	    set fakeName "_%@fake_$name"
+	    regsub -all {::} $fakeName "_" fakeName
+	    set fakeName "[namespace current]::$fakeName"
+	}
+	proc $fakeName $arglist $body
+
+	#
+	# YUK!  Tcl won't let us alias fully qualified command names,
+	# so we can't handle names like "::itcl::class".  Instead,
+	# we have to build procs with the fully qualified names, and
+	# have the procs point to the aliases.
+	#
+	if {[regexp {::} $name]} {
+	    set exportCmd [list _%@namespace export [namespace tail $name]]
+	    $parser eval [list _%@namespace eval $ns $exportCmd]
+	    set alias [namespace tail $fakeName]
+	    $parser invokehidden proc $name {args} "_%@eval $alias \$args"
+	    $parser alias $alias $fakeName
+	} else {
+	    $parser alias $name $fakeName
+	}
+	return
+    }
+
+    # auto_mkindex_parser::fullname --
+    # Used by commands like "proc" within the auto_mkindex parser.
+    # Returns the qualified namespace name for the "name" argument.
+    # If the "name" does not start with "::", elements are added from
+    # the current namespace stack to produce a qualified name.  Then,
+    # the name is examined to see whether or not it should really be
+    # qualified.  If the name has more than the leading "::", it is
+    # returned as a fully qualified name.  Otherwise, it is returned
+    # as a simple name.  That way, the Tcl autoloader will recognize
+    # it properly.
+    #
+    # Arguments:
+    # name -		Name that is being added to index.
+
+    proc auto_mkindex_parser::fullname {name} {
+	variable contextStack
+
+	if {![string match ::* $name]} {
+	    foreach ns $contextStack {
+		set name "${ns}::$name"
+		if {[string match ::* $name]} {
+		    break
+		}
+	    }
+	}
+
+	if {[namespace qualifiers $name] == ""} {
+	    return [namespace tail $name]
+	} elseif {![string match ::* $name]} {
+	    return "::$name"
+	}
+	return $name
+    }
+
+    # Register all of the procedures for the auto_mkindex parser that
+    # will build the "tclIndex" file.
+
+    # AUTO MKINDEX:  proc name arglist body
+    # Adds an entry to the auto index list for the given procedure name.
+
+    auto_mkindex_parser::command proc {name args} {
+	variable index
+	variable scriptFile
+	append index "set [list auto_index([fullname $name])]"
+	append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+    }
+
+    # AUTO MKINDEX:  namespace eval name command ?arg arg...?
+    # Adds the namespace name onto the context stack and evaluates the
+    # associated body of commands.
+    #
+    # AUTO MKINDEX:  namespace import ?-force? pattern ?pattern...?
+    # Performs the "import" action in the parser interpreter.  This is
+    # important for any commands contained in a namespace that affect
+    # the index.  For example, a script may say "itcl::class ...",
+    # or it may import "itcl::*" and then say "class ...".  This
+    # procedure does the import operation, but keeps track of imported
+    # patterns so we can remove the imports later.
+
+    auto_mkindex_parser::command namespace {op args} {
+	switch -- $op {
+	    eval {
+		variable parser
+		variable contextStack
+
+		set name [lindex $args 0]
+		set args [lrange $args 1 end]
+
+		set contextStack [linsert $contextStack 0 $name]
+		if {[llength $args] == 1} {
+		    $parser eval [lindex $args 0]
+		} else {
+		    eval $parser eval $args
+		}
+		set contextStack [lrange $contextStack 1 end]
+	    }
+	    import {
+		variable parser
+		variable imports
+		foreach pattern $args {
+		    if {$pattern != "-force"} {
+			lappend imports $pattern
+		    }
+		}
+		catch {$parser eval "_%@namespace import $args"}
+	    }
+	}
+    }
+
+# Close of the if ![interp issafe] block
+}
+
+# pkg_compareExtension --
+#
+#  Used internally by pkg_mkIndex to compare the extension of a file to
+#  a given extension. On Windows, it uses a case-insensitive comparison.
+#
+# Arguments:
+#  fileName	name of a file whose extension is compared
+#  ext		(optional) The extension to compare against; you must
+#		provide the starting dot.
+#		Defaults to [info sharedlibextension]
+#
+# Results:
+#  Returns 1 if the extension matches, 0 otherwise
+
+proc pkg_compareExtension { fileName {ext {}} } {
+    global tcl_platform
+    if {[string length $ext] == 0} {
+	set ext [info sharedlibextension]
+    }
+    if {[string compare $tcl_platform(platform) "windows"] == 0} {
+	return [expr {[string compare \
+		[string tolower [file extension $fileName]] \
+		[string tolower $ext]] == 0}]
+    } else {
+	return [expr {[string compare [file extension $fileName] $ext] == 0}]
+    }
+}
+
+# pkg_mkIndex --
+# This procedure creates a package index in a given directory.  The
+# package index consists of a "pkgIndex.tcl" file whose contents are
+# a Tcl script that sets up package information with "package require"
+# commands.  The commands describe all of the packages defined by the
+# files given as arguments.
+#
+# Arguments:
+# -direct		(optional) If this flag is present, the generated
+#			code in pkgMkIndex.tcl will cause the package to be
+#			loaded when "package require" is executed, rather
+#			than lazily when the first reference to an exported
+#			procedure in the package is made.
+# -verbose		(optional) Verbose output; the name of each file that
+#			was successfully rocessed is printed out. Additionally,
+#			if processing of a file failed a message is printed.
+# -load pat		(optional) Preload any packages whose names match
+#			the pattern.  Used to handle DLLs that depend on
+#			other packages during their Init procedure.
+# dir -			Name of the directory in which to create the index.
+# args -		Any number of additional arguments, each giving
+#			a glob pattern that matches the names of one or
+#			more shared libraries or Tcl script files in
+#			dir.
+
+proc pkg_mkIndex {args} {
+    global errorCode errorInfo
+    set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
+
+    set argCount [llength $args]
+    if {$argCount < 1} {
+	return -code error "wrong # args: should be\n$usage"
+    }
+
+    set more ""
+    set direct 0
+    set doVerbose 0
+    set loadPat ""
+    for {set idx 0} {$idx < $argCount} {incr idx} {
+	set flag [lindex $args $idx]
+	switch -glob -- $flag {
+	    -- {
+		# done with the flags
+		incr idx
+		break
+	    }
+	    -verbose {
+		set doVerbose 1
+	    }
+	    -direct {
+		set direct 1
+		append more " -direct"
+	    }
+	    -load {
+		incr idx
+		set loadPat [lindex $args $idx]
+		append more " -load $loadPat"
+	    }
+	    -* {
+		return -code error "unknown flag $flag: should be\n$usage"
+	    }
+	    default {
+		# done with the flags
+		break
+	    }
+	}
+    }
+
+    set dir [lindex $args $idx]
+    set patternList [lrange $args [expr {$idx + 1}] end]
+    if {[llength $patternList] == 0} {
+	set patternList [list "*.tcl" "*[info sharedlibextension]"]
+    }
+
+    append index "# Tcl package index file, version 1.1\n"
+    append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
+    append index "# and sourced either when an application starts up or\n"
+    append index "# by a \"package unknown\" script.  It invokes the\n"
+    append index "# \"package ifneeded\" command to set up package-related\n"
+    append index "# information so that packages will be loaded automatically\n"
+    append index "# in response to \"package require\" commands.  When this\n"
+    append index "# script is sourced, the variable \$dir must contain the\n"
+    append index "# full path name of this file's directory.\n"
+    set oldDir [pwd]
+    cd $dir
+
+    if {[catch {eval glob $patternList} fileList]} {
+	global errorCode errorInfo
+	cd $oldDir
+	return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
+    }
+    foreach file $fileList {
+	# For each file, figure out what commands and packages it provides.
+	# To do this, create a child interpreter, load the file into the
+	# interpreter, and get a list of the new commands and packages
+	# that are defined.
+
+	if {[string compare $file "pkgIndex.tcl"] == 0} {
+	    continue
+	}
+
+	# Changed back to the original directory before initializing the
+	# slave in case TCL_LIBRARY is a relative path (e.g. in the test
+	# suite). 
+
+	cd $oldDir
+	set c [interp create]
+
+	# Load into the child any packages currently loaded in the parent
+	# interpreter that match the -load pattern.
+
+	foreach pkg [info loaded] {
+	    if {! [string match $loadPat [lindex $pkg 1]]} {
+		continue
+	    }
+	    if {[lindex $pkg 1] == "Tk"} {
+		$c eval {set argv {-geometry +0+0}}
+	    }
+	    if {[catch {
+		load [lindex $pkg 0] [lindex $pkg 1] $c
+	    } err]} {
+		if {$doVerbose} {
+		    tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
+		}
+	    } else {
+		if {$doVerbose} {
+		    tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
+		}
+	    }
+	}
+	cd $dir
+
+	$c eval {
+	    # Stub out the package command so packages can
+	    # require other packages.
+
+	    rename package __package_orig
+	    proc package {what args} {
+		switch -- $what {
+		    require { return ; # ignore transitive requires }
+		    default { eval __package_orig {$what} $args }
+		}
+	    }
+	    proc tclPkgUnknown args {}
+	    package unknown tclPkgUnknown
+
+	    # Stub out the unknown command so package can call
+	    # into each other during their initialilzation.
+
+	    proc unknown {args} {}
+
+	    # Stub out the auto_import mechanism
+
+	    proc auto_import {args} {}
+
+	    # reserve the ::tcl namespace for support procs
+	    # and temporary variables.  This might make it awkward
+	    # to generate a pkgIndex.tcl file for the ::tcl namespace.
+
+	    namespace eval ::tcl {
+		variable file		;# Current file being processed
+		variable direct		;# -direct flag value
+		variable x		;# Loop variable
+		variable debug		;# For debugging
+		variable type		;# "load" or "source", for -direct
+		variable namespaces	;# Existing namespaces (e.g., ::tcl)
+		variable packages	;# Existing packages (e.g., Tcl)
+		variable origCmds	;# Existing commands
+		variable newCmds	;# Newly created commands
+		variable newPkgs {}	;# Newly created packages
+	    }
+	}
+
+	$c eval [list set ::tcl::file $file]
+	$c eval [list set ::tcl::direct $direct]
+	if {[catch {
+	    $c eval {
+		set ::tcl::debug "loading or sourcing"
+
+		# we need to track command defined by each package even in
+		# the -direct case, because they are needed internally by
+		# the "partial pkgIndex.tcl" step above.
+
+		proc ::tcl::GetAllNamespaces {{root ::}} {
+		    set list $root
+		    foreach ns [namespace children $root] {
+			eval lappend list [::tcl::GetAllNamespaces $ns]
+		    }
+		    return $list
+		}
+
+		# initialize the list of existing namespaces, packages, commands
+
+		foreach ::tcl::x [::tcl::GetAllNamespaces] {
+		    set ::tcl::namespaces($::tcl::x) 1
+		}
+		foreach ::tcl::x [package names] {
+		    set ::tcl::packages($::tcl::x) 1
+		}
+		set ::tcl::origCmds [info commands]
+
+		# Try to load the file if it has the shared library
+		# extension, otherwise source it.  It's important not to
+		# try to load files that aren't shared libraries, because
+		# on some systems (like SunOS) the loader will abort the
+		# whole application when it gets an error.
+
+		if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
+		    # The "file join ." command below is necessary.
+		    # Without it, if the file name has no \'s and we're
+		    # on UNIX, the load command will invoke the
+		    # LD_LIBRARY_PATH search mechanism, which could cause
+		    # the wrong file to be used.
+
+		    set ::tcl::debug loading
+		    load [file join . $::tcl::file]
+		    set ::tcl::type load
+		} else {
+		    set ::tcl::debug sourcing
+		    source $::tcl::file
+		    set ::tcl::type source
+		}
+
+		# See what new namespaces appeared, and import commands
+		# from them.  Only exported commands go into the index.
+
+		foreach ::tcl::x [::tcl::GetAllNamespaces] {
+		    if {! [info exists ::tcl::namespaces($::tcl::x)]} {
+			namespace import ${::tcl::x}::*
+		    }
+		}
+
+		# Figure out what commands appeared
+
+		foreach ::tcl::x [info commands] {
+		    set ::tcl::newCmds($::tcl::x) 1
+		}
+		foreach ::tcl::x $::tcl::origCmds {
+		    catch {unset ::tcl::newCmds($::tcl::x)}
+		}
+		foreach ::tcl::x [array names ::tcl::newCmds] {
+		    # reverse engineer which namespace a command comes from
+		    
+		    set ::tcl::abs [namespace origin $::tcl::x]
+
+		    # special case so that global names have no leading
+		    # ::, this is required by the unknown command
+
+		    set ::tcl::abs [auto_qualify $::tcl::abs ::]
+
+		    if {[string compare $::tcl::x $::tcl::abs] != 0} {
+			# Name changed during qualification
+
+			set ::tcl::newCmds($::tcl::abs) 1
+			unset ::tcl::newCmds($::tcl::x)
+		    }
+		}
+
+		# Look through the packages that appeared, and if there is
+		# a version provided, then record it
+
+		foreach ::tcl::x [package names] {
+		    if {([string compare [package provide $::tcl::x] ""] != 0) \
+			    && ![info exists ::tcl::packages($::tcl::x)]} {
+			lappend ::tcl::newPkgs \
+			    [list $::tcl::x [package provide $::tcl::x]]
+		    }
+		}
+	    }
+	} msg] == 1} {
+	    set what [$c eval set ::tcl::debug]
+	    if {$doVerbose} {
+		tclLog "warning: error while $what $file: $msg"
+	    }
+	} else {
+	    set type [$c eval set ::tcl::type]
+	    set cmds [lsort [$c eval array names ::tcl::newCmds]]
+	    set pkgs [$c eval set ::tcl::newPkgs]
+	    if {[llength $pkgs] > 1} {
+		tclLog "warning: \"$file\" provides more than one package ($pkgs)"
+	    }
+	    foreach pkg $pkgs {
+		# cmds is empty/not used in the direct case
+		lappend files($pkg) [list $file $type $cmds]
+	    }
+
+	    if {$doVerbose} {
+		tclLog "processed $file"
+	    }
+	}
+	interp delete $c
+    }
+
+    foreach pkg [lsort [array names files]] {
+	append index "\npackage ifneeded $pkg "
+	if {$direct} {
+	    set cmdList {}
+	    foreach elem $files($pkg) {
+		set file [lindex $elem 0]
+		set type [lindex $elem 1]
+		lappend cmdList "\[list $type \[file join \$dir\
+			[list $file]\]\]"
+	    }
+	    append index [join $cmdList "\\n"]
+	} else {
+	    append index "\[list tclPkgSetup \$dir [lrange $pkg 0 0]\
+		    [lrange $pkg 1 1] [list $files($pkg)]\]"
+	}
+    }
+    set f [open pkgIndex.tcl w]
+    puts $f $index
+    close $f
+    cd $oldDir
+}
+
+# tclPkgSetup --
+# This is a utility procedure use by pkgIndex.tcl files.  It is invoked
+# as part of a "package ifneeded" script.  It calls "package provide"
+# to indicate that a package is available, then sets entries in the
+# auto_index array so that the package's files will be auto-loaded when
+# the commands are used.
+#
+# Arguments:
+# dir -			Directory containing all the files for this package.
+# pkg -			Name of the package (no version number).
+# version -		Version number for the package, such as 2.1.3.
+# files -		List of files that constitute the package.  Each
+#			element is a sub-list with three elements.  The first
+#			is the name of a file relative to $dir, the second is
+#			"load" or "source", indicating whether the file is a
+#			loadable binary or a script to source, and the third
+#			is a list of commands defined by this file.
+
+proc tclPkgSetup {dir pkg version files} {
+    global auto_index
+
+    package provide $pkg $version
+    foreach fileInfo $files {
+	set f [lindex $fileInfo 0]
+	set type [lindex $fileInfo 1]
+	foreach cmd [lindex $fileInfo 2] {
+	    if {$type == "load"} {
+		set auto_index($cmd) [list load [file join $dir $f] $pkg]
+	    } else {
+		set auto_index($cmd) [list source [file join $dir $f]]
+	    } 
+	}
+    }
+}
+
+# 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}
+	    }
+	    catch {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 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.
+# version -		Version of desired package.  Not used.
+# exact -		Either "-exact" or omitted.  Not used.
+
+proc tclPkgUnknown {name version {exact {}}} {
+    global auto_path tcl_platform env
+
+    if {![info exists auto_path]} {
+	return
+    }
+    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
+	# we can't use glob in safe interps, so enclose the following
+	# in a catch statement
+	catch {
+	    foreach file [glob -nocomplain [file join [lindex $auto_path $i] \
+		    * pkgIndex.tcl]] {
+		set dir [file dirname $file]
+		if {[catch {source $file} msg]} {
+		    tclLog "error reading package index file $file: $msg"
+		}
+	    }
+        }
+	set dir [lindex $auto_path $i]
+	set file [file join $dir pkgIndex.tcl]
+	# safe interps usually don't have "file readable", nor stderr channel
+	if {[interp issafe] || [file readable $file]} {
+	    if {[catch {source $file} msg] && ![interp issafe]}  {
+		tclLog "error reading package index file $file: $msg"
+	    }
+	}
+	# On the Macintosh we also look in the resource fork 
+	# of shared libraries
+	# We can't use tclMacPkgSearch in safe interps because it uses glob
+	if {(![interp issafe]) && ($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
+		}
+	    }
+	}
+    }
+}
diff --git a/tcl/library/ldAout.tcl b/tcl/library/ldAout.tcl
new file mode 100644
index 00000000000..d73e37b95ef
--- /dev/null
+++ b/tcl/library/ldAout.tcl
@@ -0,0 +1,240 @@
+# ldAout.tcl --
+#
+#	This "tclldAout" procedure in this script acts as a replacement
+#	for the "ld" command when linking an object file that will be
+#	loaded dynamically into Tcl or Tk using pseudo-static linking.
+#
+# Parameters:
+#	The arguments to the script are the command line options for
+#	an "ld" command.
+#
+# Results:
+#	The "ld" command is parsed, and the "-o" option determines the
+#	module name.  ".a" and ".o" options are accumulated.
+#	The input archives and object files are examined with the "nm"
+#	command to determine whether the modules initialization
+#	entry and safe initialization entry are present.  A trivial
+#	C function that locates the entries is composed, compiled, and
+#	its .o file placed before all others in the command; then
+#	"ld" is executed to bind the objects together.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1995, by General Electric Company. All rights reserved.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# This work was supported in part by the ARPA Manufacturing Automation
+# and Design Engineering (MADE) Initiative through ARPA contract
+# F33615-94-C-4400.
+
+proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
+  global env
+  global argv
+
+  if {$cc==""} {
+    set cc $env(CC)
+  }
+
+  # if only two parameters are supplied there is assumed that the
+  # only shlib_suffix is missing. This parameter is anyway available
+  # as "info sharedlibextension" too, so there is no need to transfer
+  # 3 parameters to the function tclLdAout. For compatibility, this
+  # function now accepts both 2 and 3 parameters.
+
+  if {$shlib_suffix==""} {
+    set shlib_cflags $env(SHLIB_CFLAGS)
+  } else {
+    if {$shlib_cflags=="none"} {
+      set shlib_cflags $shlib_suffix
+    }
+  }
+
+  # seenDotO is nonzero if a .o or .a file has been seen
+
+  set seenDotO 0
+
+  # minusO is nonzero if the last command line argument was "-o".
+
+  set minusO 0
+
+  # head has command line arguments up to but not including the first
+  # .o or .a file. tail has the rest of the arguments.
+
+  set head {}
+  set tail {}
+
+  # nmCommand is the "nm" command that lists global symbols from the
+  # object files.
+
+  set nmCommand {|nm -g}
+
+  # entryProtos is the table of _Init and _SafeInit prototypes found in the
+  # module.
+
+  set entryProtos {}
+
+  # entryPoints is the table of _Init and _SafeInit entries found in the
+  # module.
+
+  set entryPoints {}
+
+  # libraries is the list of -L and -l flags to the linker.
+
+  set libraries {}
+  set libdirs {}
+
+  # Process command line arguments
+
+  foreach a $argv {
+    if {!$minusO && [regexp {\.[ao]$} $a]} {
+      set seenDotO 1
+      lappend nmCommand $a
+    }
+    if {$minusO} {
+      set outputFile $a
+      set minusO 0
+    } elseif {![string compare $a -o]} {
+      set minusO 1
+    }
+    if {[regexp {^-[lL]} $a]} {
+	lappend libraries $a
+	if {[regexp {^-L} $a]} {
+	    lappend libdirs [string range $a 2 end]
+	}
+    } elseif {$seenDotO} {
+	lappend tail $a
+    } else {
+	lappend head $a
+    }
+  }
+  lappend libdirs /lib /usr/lib
+
+  # MIPS -- If there are corresponding G0 libraries, replace the
+  # ordinary ones with the G0 ones.
+
+  set libs {}
+  foreach lib $libraries {
+      if {[regexp {^-l} $lib]} {
+	  set lname [string range $lib 2 end]
+	  foreach dir $libdirs {
+	      if {[file exists [file join $dir lib${lname}_G0.a]]} {
+		  set lname ${lname}_G0
+		  break
+	      }
+	  }
+	  lappend libs -l$lname
+      } else {
+	  lappend libs $lib
+      }
+  }
+  set libraries $libs
+
+  # Extract the module name from the "-o" option
+
+  if {![info exists outputFile]} {
+    error "-o option must be supplied to link a Tcl load module"
+  }
+  set m [file tail $outputFile]
+  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]} {
+    set modName [string range $modName 3 end]
+  }
+  if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
+    set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
+  }
+  set modName "[string toupper [string index $modName 0]][string range $modName 1 end]"
+  
+  # Catalog initialization entry points found in the module
+
+  set f [open $nmCommand r]
+  while {[gets $f l] >= 0} {
+    if {[regexp {T[ 	]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
+      if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
+	set s $symbol
+      }
+      append entryProtos {extern int } $symbol { (); } \n
+      append entryPoints {  } \{ { "} $s {", } $symbol { } \} , \n
+    }
+  }
+  close $f
+
+  if {$entryPoints==""} {
+    error "No entry point found in objects"
+  }
+
+  # Compose a C function that resolves the initialization entry points and
+  # embeds the required libraries in the object code.
+
+  set C {#include <string.h>}
+  append C \n
+  append C {char TclLoadLibraries_} $modName { [] =} \n
+  append C {  "@LIBS: } $libraries {";} \n
+  append C $entryProtos
+  append C {static struct } \{ \n
+  append C {  char * name;} \n
+  append C {  int (*value)();} \n
+  append C \} {dictionary [] = } \{ \n
+  append C $entryPoints
+  append C {  0, 0 } \n \} \; \n
+  append C {typedef struct Tcl_Interp Tcl_Interp;} \n
+  append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
+  append C {Tcl_PackageInitProc *} \n
+  append C TclLoadDictionary_ $modName { (symbol)} \n
+  append C {    char * symbol;} \n
+  append C {{
+    int i;
+    for (i = 0; dictionary [i] . name != 0; ++i) {
+      if (!strcmp (symbol, dictionary [i] . name)) {
+	return dictionary [i].value;
+      }
+    }
+    return 0;
+}} \n
+
+  # Write the C module and compile it
+
+  set cFile tcl$modName.c
+  set f [open $cFile w]
+  puts -nonewline $f $C
+  close $f
+  set ccCommand "$cc -c $shlib_cflags $cFile"
+  puts stderr $ccCommand
+  eval exec $ccCommand
+
+  # Now compose and execute the ld command that packages the module
+
+  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
+
+  exec /bin/rm $cFile [file rootname $cFile].o
+}
diff --git a/tcl/library/license.terms b/tcl/library/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/library/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/library/parray.tcl b/tcl/library/parray.tcl
new file mode 100644
index 00000000000..63c44cc0eb9
--- /dev/null
+++ b/tcl/library/parray.tcl
@@ -0,0 +1,29 @@
+# parray:
+# Print the contents of a global array on stdout.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc parray {a {pattern *}} {
+    upvar 1 $a array
+    if {![array exists array]} {
+	error "\"$a\" isn't an array"
+    }
+    set maxl 0
+    foreach name [lsort [array names array $pattern]] {
+	if {[string length $name] > $maxl} {
+	    set maxl [string length $name]
+	}
+    }
+    set maxl [expr {$maxl + [string length $a] + 2}]
+    foreach name [lsort [array names array $pattern]] {
+	set nameString [format %s(%s) $a $name]
+	puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
+    }
+}
diff --git a/tcl/library/safe.tcl b/tcl/library/safe.tcl
new file mode 100644
index 00000000000..c16c49c5435
--- /dev/null
+++ b/tcl/library/safe.tcl
@@ -0,0 +1,887 @@
+# safe.tcl --
+#
+# This file provide a safe loading/sourcing mechanism for safe interpreters.
+# It implements a virtual path mecanism to hide the real pathnames from the
+# slave. It runs in a master interpreter and sets up data structure and
+# aliases that will be invoked when used from a slave interpreter.
+# 
+# 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.
+#
+# RCS: @(#) $Id$
+
+#
+# The implementation is based on namespaces. These naming conventions
+# are followed:
+# Private procs starts with uppercase.
+# Public  procs are exported and starts with lowercase
+#
+
+# Needed utilities package
+package require opt 0.2;
+
+# Create the safe namespace
+namespace eval ::safe {
+
+    # Exported API:
+    namespace export interpCreate interpInit interpConfigure interpDelete \
+	    interpAddToAccessPath interpFindInAccessPath \
+	    setLogCmd ;
+
+    ####
+    #
+    # Setup the arguments parsing
+    #
+    ####
+
+    # Share the descriptions
+    set temp [::tcl::OptKeyRegister {
+	{-accessPath -list {} "access path for the slave"}
+	{-noStatics "prevent loading of statically linked pkgs"}
+	{-statics true "loading of statically linked pkgs"}
+	{-nestedLoadOk "allow nested loading"}
+	{-nested false "nested loading"}
+	{-deleteHook -script {} "delete hook"}
+    }]
+
+    # create case (slave is optional)
+    ::tcl::OptKeyRegister {
+	{?slave? -name {} "name of the slave (optional)"}
+    } ::safe::interpCreate ;
+    # adding the flags sub programs to the command program
+    # (relying on Opt's internal implementation details)
+    lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp);
+
+    # init and configure (slave is needed)
+    ::tcl::OptKeyRegister {
+	{slave -name {} "name of the slave"}
+    } ::safe::interpIC;
+    # adding the flags sub programs to the command program
+    # (relying on Opt's internal implementation details)
+    lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp);
+    # temp not needed anymore
+    ::tcl::OptKeyDelete $temp;
+
+
+    # Helper function to resolve the dual way of specifying staticsok
+    # (either by -noStatics or -statics 0)
+    proc InterpStatics {} {
+	foreach v {Args statics noStatics} {
+	    upvar $v $v
+	}
+	set flag [::tcl::OptProcArgGiven -noStatics];
+	if {$flag && ($noStatics == $statics) 
+	          && ([::tcl::OptProcArgGiven -statics])} {
+	    return -code error\
+		    "conflicting values given for -statics and -noStatics";
+	}
+	if {$flag} {
+	    return [expr {!$noStatics}];
+	} else {
+	    return $statics
+	}
+    }
+
+    # Helper function to resolve the dual way of specifying nested loading
+    # (either by -nestedLoadOk or -nested 1)
+    proc InterpNested {} {
+	foreach v {Args nested nestedLoadOk} {
+	    upvar $v $v
+	}
+	set flag [::tcl::OptProcArgGiven -nestedLoadOk];
+	# note that the test here is the opposite of the "InterpStatics"
+	# one (it is not -noNested... because of the wanted default value)
+	if {$flag && ($nestedLoadOk != $nested) 
+	          && ([::tcl::OptProcArgGiven -nested])} {
+	    return -code error\
+		    "conflicting values given for -nested and -nestedLoadOk";
+	}
+	if {$flag} {
+	    # another difference with "InterpStatics"
+	    return $nestedLoadOk
+	} else {
+	    return $nested
+	}
+    }
+
+    ####
+    #
+    #  API entry points that needs argument parsing :
+    #
+    ####
+
+
+    # Interface/entry point function and front end for "Create"
+    proc interpCreate {args} {
+	set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
+	InterpCreate $slave $accessPath \
+		[InterpStatics] [InterpNested] $deleteHook;
+    }
+
+    proc interpInit {args} {
+	set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+	if {![::interp exists $slave]} {
+	    return -code error \
+		    "\"$slave\" is not an interpreter";
+	}
+	InterpInit $slave $accessPath \
+		[InterpStatics] [InterpNested] $deleteHook;
+    }
+
+    proc CheckInterp {slave} {
+	if {![IsInterp $slave]} {
+	    return -code error \
+		    "\"$slave\" is not an interpreter managed by ::safe::" ;
+	}
+    }
+
+    # Interface/entry point function and front end for "Configure"
+    # This code is awfully pedestrian because it would need
+    # more coupling and support between the way we store the
+    # configuration values in safe::interp's and the Opt package
+    # Obviously we would like an OptConfigure
+    # to avoid duplicating all this code everywhere. -> TODO
+    # (the app should share or access easily the program/value
+    #  stored by opt)
+    # This is even more complicated by the boolean flags with no values
+    # that we had the bad idea to support for the sake of user simplicity
+    # in create/init but which makes life hard in configure...
+    # So this will be hopefully written and some integrated with opt1.0
+    # (hopefully for tcl8.1 ?)
+    proc interpConfigure {args} {
+	switch [llength $args] {
+	    1 {
+		# If we have exactly 1 argument
+		# the semantic is to return all the current configuration
+		# We still call OptKeyParse though we know that "slave"
+		# is our given argument because it also checks
+		# for the "-help" option.
+		set Args [::tcl::OptKeyParse ::safe::interpIC $args];
+		CheckInterp $slave;
+		set res {}
+		lappend res [list -accessPath [Set [PathListName $slave]]]
+		lappend res [list -statics    [Set [StaticsOkName $slave]]]
+		lappend res [list -nested     [Set [NestedOkName $slave]]]
+		lappend res [list -deleteHook [Set [DeleteHookName $slave]]]
+		join $res
+	    }
+	    2 {
+		# If we have exactly 2 arguments
+		# the semantic is a "configure get"
+		::tcl::Lassign $args slave arg;
+		# get the flag sub program (we 'know' about Opt's internal
+		# representation of data)
+		set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]
+		set hits [::tcl::OptHits desc $arg];
+                if {$hits > 1} {
+                    return -code error [::tcl::OptAmbigous $desc $arg]
+                } elseif {$hits == 0} {
+                    return -code error [::tcl::OptFlagUsage $desc $arg]
+                }
+		CheckInterp $slave;
+		set item [::tcl::OptCurDesc $desc];
+		set name [::tcl::OptName $item];
+		switch -exact -- $name {
+		    -accessPath {
+			return [list -accessPath [Set [PathListName $slave]]]
+		    }
+		    -statics {
+			return [list -statics    [Set [StaticsOkName $slave]]]
+		    }
+		    -nested {
+			return [list -nested     [Set [NestedOkName $slave]]]
+		    }
+		    -deleteHook {
+			return [list -deleteHook [Set [DeleteHookName $slave]]]
+		    }
+		    -noStatics {
+			# it is most probably a set in fact
+			# but we would need then to jump to the set part
+			# and it is not *sure* that it is a set action
+			# that the user want, so force it to use the
+			# unambigous -statics ?value? instead:
+			return -code error\
+				"ambigous query (get or set -noStatics ?)\
+				use -statics instead";
+		    }
+		    -nestedLoadOk {
+			return -code error\
+				"ambigous query (get or set -nestedLoadOk ?)\
+				use -nested instead";
+		    }
+		    default {
+			return -code error "unknown flag $name (bug)";
+		    }
+		}
+	    }
+	    default {
+		# Otherwise we want to parse the arguments like init and create
+		# did
+		set Args [::tcl::OptKeyParse ::safe::interpIC $args];
+		CheckInterp $slave;
+		# Get the current (and not the default) values of
+		# whatever has not been given:
+		if {![::tcl::OptProcArgGiven -accessPath]} {
+		    set doreset 1
+		    set accessPath [Set [PathListName $slave]]
+		} else {
+		    set doreset 0
+		}
+		if {    (![::tcl::OptProcArgGiven -statics]) 
+                     && (![::tcl::OptProcArgGiven -noStatics]) } {
+		    set statics    [Set [StaticsOkName $slave]]
+		} else {
+		    set statics    [InterpStatics]
+		}
+		if {    ([::tcl::OptProcArgGiven -nested]) 
+                     || ([::tcl::OptProcArgGiven -nestedLoadOk]) } {
+		    set nested     [InterpNested]
+		} else {
+		    set nested     [Set [NestedOkName $slave]]
+		}
+		if {![::tcl::OptProcArgGiven -deleteHook]} {
+		    set deleteHook [Set [DeleteHookName $slave]]
+		}
+		# we can now reconfigure :
+		InterpSetConfig $slave $accessPath \
+			$statics $nested $deleteHook;
+		# auto_reset the slave (to completly synch the new access_path)
+		if {$doreset} {
+		    if {[catch {::interp eval $slave {auto_reset}} msg]} {
+			Log $slave "auto_reset failed: $msg";
+		    } else {
+			Log $slave "successful auto_reset" NOTICE;
+		    }
+		}
+	    }
+	}
+    }
+
+
+    ####
+    #
+    #  Functions that actually implements the exported APIs
+    #
+    ####
+
+
+    #
+    # safe::InterpCreate : doing the real job
+    #
+    # This procedure creates a safe slave and initializes it with the
+    # safe base aliases.
+    # NB: slave name must be simple alphanumeric string, no spaces,
+    # no (), no {},...  {because the state array is stored as part of the name}
+    #
+    # Returns the slave name.
+    #
+    # Optional Arguments : 
+    # + slave name : if empty, generated name will be used
+    # + access_path: path list controlling where load/source can occur,
+    #                if empty: the master auto_path will be used.
+    # + staticsok  : flag, if 0 :no static package can be loaded (load {} Xxx)
+    #                      if 1 :static packages are ok.
+    # + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
+    #                      if 1 : multiple levels are ok.
+    
+    # use the full name and no indent so auto_mkIndex can find us
+    proc ::safe::InterpCreate {
+	slave 
+	access_path
+	staticsok
+	nestedok
+	deletehook
+    } {
+	# Create the slave.
+	if {[string compare "" $slave]} {
+	    ::interp create -safe $slave;
+	} else {
+	    # empty argument: generate slave name
+	    set slave [::interp create -safe];
+	}
+	Log $slave "Created" NOTICE;
+
+	# Initialize it. (returns slave name)
+	InterpInit $slave $access_path $staticsok $nestedok $deletehook;
+    }
+
+
+    #
+    # InterpSetConfig (was setAccessPath) :
+    #    Sets up slave virtual auto_path and corresponding structure
+    #    within the master. Also sets the tcl_library in the slave
+    #    to be the first directory in the path.
+    #    Nb: If you change the path after the slave has been initialized
+    #    you probably need to call "auto_reset" in the slave in order that it
+    #    gets the right auto_index() array values.
+
+    proc ::safe::InterpSetConfig {slave access_path staticsok\
+	    nestedok deletehook} {
+
+	# determine and store the access path if empty
+	if {[string match "" $access_path]} {
+	    set access_path [uplevel #0 set auto_path];
+	    # Make sure that tcl_library is in auto_path
+	    # and at the first position (needed by setAccessPath)
+	    set where [lsearch -exact $access_path [info library]];
+	    if {$where == -1} {
+		# not found, add it.
+		set access_path [concat [list [info library]] $access_path];
+		Log $slave "tcl_library was not in auto_path,\
+			added it to slave's access_path" NOTICE;
+	    } elseif {$where != 0} {
+		# not first, move it first
+		set access_path [concat [list [info library]]\
+			[lreplace $access_path $where $where]];
+		Log $slave "tcl_libray was not in first in auto_path,\
+			moved it to front of slave's access_path" NOTICE;
+	    
+	    }
+
+	    # Add 1st level sub dirs (will searched by auto loading from tcl
+	    # code in the slave using glob and thus fail, so we add them
+	    # here so by default it works the same).
+	    set access_path [AddSubDirs $access_path];
+	}
+
+	Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
+		nestedok=$nestedok deletehook=($deletehook)" NOTICE;
+
+	# clear old autopath if it existed
+	set nname [PathNumberName $slave];
+	if {[Exists $nname]} {
+	    set n [Set $nname];
+	    for {set i 0} {$i<$n} {incr i} {
+		Unset [PathToken $i $slave];
+	    }
+	}
+
+	# build new one
+	set slave_auto_path {}
+	set i 0;
+	foreach dir $access_path {
+	    Set [PathToken $i $slave] $dir;
+	    lappend slave_auto_path "\$[PathToken $i]";
+	    incr i;
+	}
+	Set $nname $i;
+	Set [PathListName $slave] $access_path;
+	Set [VirtualPathListName $slave] $slave_auto_path;
+
+	Set [StaticsOkName $slave] $staticsok
+	Set [NestedOkName $slave] $nestedok
+	Set [DeleteHookName $slave] $deletehook
+
+	SyncAccessPath $slave;
+    }
+
+    #
+    #
+    # FindInAccessPath:
+    #    Search for a real directory and returns its virtual Id
+    #    (including the "$")
+proc ::safe::interpFindInAccessPath {slave path} {
+	set access_path [GetAccessPath $slave];
+	set where [lsearch -exact $access_path $path];
+	if {$where == -1} {
+	    return -code error "$path not found in access path $access_path";
+	}
+	return "\$[PathToken $where]";
+    }
+
+    #
+    # addToAccessPath:
+    #    add (if needed) a real directory to access path
+    #    and return its virtual token (including the "$").
+proc ::safe::interpAddToAccessPath {slave path} {
+	# first check if the directory is already in there
+	if {![catch {interpFindInAccessPath $slave $path} res]} {
+	    return $res;
+	}
+	# new one, add it:
+	set nname [PathNumberName $slave];
+	set n [Set $nname];
+	Set [PathToken $n $slave] $path;
+
+	set token "\$[PathToken $n]";
+
+	Lappend [VirtualPathListName $slave] $token;
+	Lappend [PathListName $slave] $path;
+	Set $nname [expr {$n+1}];
+
+	SyncAccessPath $slave;
+
+	return $token;
+    }
+
+    # This procedure applies the initializations to an already existing
+    # interpreter. It is useful when you want to install the safe base
+    # aliases into a preexisting safe interpreter.
+    proc ::safe::InterpInit {
+	slave 
+	access_path
+	staticsok
+	nestedok
+	deletehook
+    } {
+
+	# Configure will generate an access_path when access_path is
+	# empty.
+	InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook;
+
+	# These aliases let the slave load files to define new commands
+
+	# NB we need to add [namespace current], aliases are always
+	# absolute paths.
+	::interp alias $slave source {} [namespace current]::AliasSource $slave
+	::interp alias $slave load {} [namespace current]::AliasLoad $slave
+
+	# This alias lets the slave have access to a subset of the 'file'
+	# command functionality.
+
+	AliasSubset $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 {} [namespace current]::interpDelete $slave
+
+	# The allowed slave variables already have been set
+	# by Tcl_MakeSafe(3)
+
+
+	# Source init.tcl into the slave, to get auto_load and other
+	# procedures defined:
+
+	# We don't try to use the -rsrc on the mac because it would get
+	# confusing if you would want to customize init.tcl
+	# for a given set of safe slaves, on all the platforms
+	# you just need to give a specific access_path and
+	# the mac should be no exception. As there is no
+	# obvious full "safe ressources" design nor implementation
+	# for the mac, safe interps there will just don't
+	# have that ability. (A specific app can still reenable
+	# that using custom aliases if they want to).
+	# It would also make the security analysis and the Safe Tcl security
+	# model platform dependant and thus more error prone.
+
+	if {[catch {::interp eval $slave\
+		{source [file join $tcl_library init.tcl]}}\
+		msg]} {
+	    Log $slave "can't source init.tcl ($msg)";
+	    error "can't source init.tcl into slave $slave ($msg)"
+	}
+
+	return $slave
+    }
+
+
+    # Add (only if needed, avoid duplicates) 1 level of
+    # sub directories to an existing path list.
+    # Also removes non directories from the returned list.
+    proc AddSubDirs {pathList} {
+	set res {}
+	foreach dir $pathList {
+	    if {[file isdirectory $dir]} {
+		# check that we don't have it yet as a children
+		# of a previous dir
+		if {[lsearch -exact $res $dir]<0} {
+		    lappend res $dir;
+		}
+		foreach sub [glob -nocomplain -- [file join $dir *]] {
+		    if {    ([file isdirectory $sub])
+		         && ([lsearch -exact $res $sub]<0) } {
+			# new sub dir, add it !
+	                lappend res $sub;
+	            }
+		}
+	    }
+	}
+	return $res;
+    }
+
+    # This procedure deletes a safe slave managed by Safe Tcl and
+    # cleans up associated state:
+
+proc ::safe::interpDelete {slave} {
+
+        Log $slave "About to delete" NOTICE;
+
+	# If the slave has a cleanup hook registered, call it.
+	# check the existance because we might be called to delete an interp
+	# which has not been registered with us at all
+	set hookname [DeleteHookName $slave];
+	if {[Exists $hookname]} {
+	    set hook [Set $hookname];
+	    if {![::tcl::Lempty $hook]} {
+		# remove the hook now, otherwise if the hook
+		# calls us somehow, we'll loop
+		Unset $hookname;
+		if {[catch {eval $hook [list $slave]} err]} {
+		    Log $slave "Delete hook error ($err)";
+		}
+	    }
+	}
+
+	# Discard the global array of state associated with the slave, and
+	# delete the interpreter.
+
+	set statename [InterpStateName $slave];
+	if {[Exists $statename]} {
+	    Unset $statename;
+	}
+
+	# if we have been called twice, the interp might have been deleted
+	# already
+	if {[::interp exists $slave]} {
+	    ::interp delete $slave;
+	    Log $slave "Deleted" NOTICE;
+	}
+
+	return
+    }
+
+    # Set (or get) the loging mecanism 
+
+proc ::safe::setLogCmd {args} {
+    variable Log;
+    if {[llength $args] == 0} {
+	return $Log;
+    } else {
+	if {[llength $args] == 1} {
+	    set Log [lindex $args 0];
+	} else {
+	    set Log $args
+	}
+    }
+}
+
+    # internal variable
+    variable Log {}
+
+    # ------------------- END OF PUBLIC METHODS ------------
+
+
+    #
+    # sets the slave auto_path to the master recorded value.
+    # also sets tcl_library to the first token of the virtual path.
+    #
+    proc SyncAccessPath {slave} {
+	set slave_auto_path [Set [VirtualPathListName $slave]];
+	::interp eval $slave [list set auto_path $slave_auto_path];
+	Log $slave \
+		"auto_path in $slave has been set to $slave_auto_path"\
+		NOTICE;
+	::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]];
+    }
+
+    # base name for storing all the slave states
+    # the array variable name for slave foo is thus "Sfoo"
+    # and for sub slave {foo bar} "Sfoo bar" (spaces are handled
+    # ok everywhere (or should))
+    # We add the S prefix to avoid that a slave interp called "Log"
+    # would smash our "Log" variable.
+    proc InterpStateName {slave} {
+	return "S$slave";
+    }
+
+    # Check that the given slave is "one of us"
+    proc IsInterp {slave} {
+	expr {    ([Exists [InterpStateName $slave]]) 
+	       && ([::interp exists $slave])}
+    }
+
+    # returns the virtual token for directory number N
+    # if the slave argument is given, 
+    # it will return the corresponding master global variable name
+    proc PathToken {n {slave ""}} {
+	if {[string compare "" $slave]} {
+	    return "[InterpStateName $slave](access_path,$n)";
+	} else {
+	    # We need to have a ":" in the token string so
+	    # [file join] on the mac won't turn it into a relative
+	    # path.
+	    return "p(:$n:)";
+	}
+    }
+    # returns the variable name of the complete path list
+    proc PathListName {slave} {
+	return "[InterpStateName $slave](access_path)";
+    }
+    # returns the variable name of the complete path list
+    proc VirtualPathListName {slave} {
+	return "[InterpStateName $slave](access_path_slave)";
+    }
+    # returns the variable name of the number of items
+    proc PathNumberName {slave} {
+	return "[InterpStateName $slave](access_path,n)";
+    }
+    # returns the staticsok flag var name
+    proc StaticsOkName {slave} {
+	return "[InterpStateName $slave](staticsok)";
+    }
+    # returns the nestedok flag var name
+    proc NestedOkName {slave} {
+	return "[InterpStateName $slave](nestedok)";
+    }
+    # Run some code at the namespace toplevel
+    proc Toplevel {args} {
+	namespace eval [namespace current] $args;
+    }
+    # set/get values
+    proc Set {args} {
+	eval Toplevel set $args;
+    }
+    # lappend on toplevel vars
+    proc Lappend {args} {
+	eval Toplevel lappend $args;
+    }
+    # unset a var/token (currently just an global level eval)
+    proc Unset {args} {
+	eval Toplevel unset $args;
+    }
+    # test existance 
+    proc Exists {varname} {
+	Toplevel info exists $varname;
+    }
+    # short cut for access path getting
+    proc GetAccessPath {slave} {
+	Set [PathListName $slave]
+    }
+    # short cut for statics ok flag getting
+    proc StaticsOk {slave} {
+	Set [StaticsOkName $slave]
+    }
+    # short cut for getting the multiples interps sub loading ok flag
+    proc NestedOk {slave} {
+	Set [NestedOkName $slave]
+    }
+    # interp deletion storing hook name
+    proc DeleteHookName {slave} {
+	return [InterpStateName $slave](cleanupHook)
+    }
+
+    #
+    # translate virtual path into real path
+    #
+    proc TranslatePath {slave path} {
+	# somehow strip the namespaces 'functionality' out (the danger
+	# is that we would strip valid macintosh "../" queries... :
+	if {[regexp {(::)|(\.\.)} $path]} {
+	    error "invalid characters in path $path";
+	}
+	set n [expr {[Set [PathNumberName $slave]]-1}];
+	for {} {$n>=0} {incr n -1} {
+	    # fill the token virtual names with their real value
+	    set [PathToken $n] [Set [PathToken $n $slave]];
+	}
+	# replaces the token by their value
+	subst -nobackslashes -nocommands $path;
+    }
+
+
+    # Log eventually log an error
+    # to enable error logging, set Log to {puts stderr} for instance
+    proc Log {slave msg {type ERROR}} {
+	variable Log;
+	if {[info exists Log] && [llength $Log]} {
+	    eval $Log [list "$type for slave $slave : $msg"];
+	}
+    }
+
+    
+    # file name control (limit access to files/ressources that should be
+    # a valid tcl source file)
+    proc CheckFileName {slave file} {
+	# limit what can be sourced to .tcl
+	# and forbid files with more than 1 dot and
+	# longer than 14 chars
+	set ftail [file tail $file];
+	if {[string length $ftail]>14} {
+	    error "$ftail: filename too long";
+	}
+	if {[regexp {\..*\.} $ftail]} {
+	    error "$ftail: more than one dot is forbidden";
+	}
+	if {[string compare $ftail "tclIndex"] && \
+		[string compare [string tolower [file extension $ftail]]\
+		".tcl"]} {
+	    error "$ftail: must be a *.tcl or tclIndex";
+	}
+
+	if {![file exists $file]} {
+	    # don't tell the file path
+	    error "no such file or directory";
+	}
+
+	if {![file readable $file]} {
+	    # don't tell the file path
+	    error "not readable";
+	}
+
+    }
+
+
+    # AliasSource is the target of the "source" alias in safe interpreters.
+
+    proc AliasSource {slave args} {
+
+	set argc [llength $args];
+	# Allow only "source filename"
+	# (and not mac specific -rsrc for instance - see comment in ::init
+	# for current rationale)
+	if {$argc != 1} {
+	    set msg "wrong # args: should be \"source fileName\""
+	    Log $slave "$msg ($args)";
+	    return -code error $msg;
+	}
+	set file [lindex $args 0]
+	
+	# get the real path from the virtual one.
+	if {[catch {set file [TranslatePath $slave $file]} msg]} {
+	    Log $slave $msg;
+	    return -code error "permission denied"
+	}
+	
+	# check that the path is in the access path of that slave
+	if {[catch {FileInAccessPath $slave $file} msg]} {
+	    Log $slave $msg;
+	    return -code error "permission denied"
+	}
+
+	# do the checks on the filename :
+	if {[catch {CheckFileName $slave $file} msg]} {
+	    Log $slave "$file:$msg";
+	    return -code error $msg;
+	}
+
+	# passed all the tests , lets source it:
+	if {[catch {::interp invokehidden $slave source $file} msg]} {
+	    Log $slave $msg;
+	    return -code error "script error";
+	}
+	return $msg
+    }
+
+    # AliasLoad is the target of the "load" alias in safe interpreters.
+
+    proc AliasLoad {slave file args} {
+
+	set argc [llength $args];
+	if {$argc > 2} {
+	    set msg "load error: too many arguments";
+	    Log $slave "$msg ($argc) {$file $args}";
+	    return -code error $msg;
+	}
+
+	# package name (can be empty if file is not).
+	set package [lindex $args 0];
+
+	# Determine where to load. load use a relative interp path
+	# and {} means self, so we can directly and safely use passed arg.
+	set target [lindex $args 1];
+	if {[string length $target]} {
+	    # we will try to load into a sub sub interp
+	    # check that we want to authorize that.
+	    if {![NestedOk $slave]} {
+		Log $slave "loading to a sub interp (nestedok)\
+			disabled (trying to load $package to $target)";
+		return -code error "permission denied (nested load)";
+	    }
+	    
+	}
+
+	# Determine what kind of load is requested
+	if {[string length $file] == 0} {
+	    # static package loading
+	    if {[string length $package] == 0} {
+		set msg "load error: empty filename and no package name";
+		Log $slave $msg;
+		return -code error $msg;
+	    }
+	    if {![StaticsOk $slave]} {
+		Log $slave "static packages loading disabled\
+			(trying to load $package to $target)";
+		return -code error "permission denied (static package)";
+	    }
+	} else {
+	    # file loading
+
+	    # get the real path from the virtual one.
+	    if {[catch {set file [TranslatePath $slave $file]} msg]} {
+		Log $slave $msg;
+		return -code error "permission denied"
+	    }
+
+	    # check the translated path
+	    if {[catch {FileInAccessPath $slave $file} msg]} {
+		Log $slave $msg;
+		return -code error "permission denied (path)"
+	    }
+	}
+
+	if {[catch {::interp invokehidden\
+		$slave load $file $package $target} msg]} {
+	    Log $slave $msg;
+	    return -code error $msg
+	}
+
+	return $msg
+    }
+
+    # FileInAccessPath raises an error if the file is not found in
+    # the list of directories contained in the (master side recorded) slave's
+    # access path.
+
+    # the security here relies on "file dirname" answering the proper
+    # result.... needs checking ?
+    proc FileInAccessPath {slave file} {
+
+	set access_path [GetAccessPath $slave];
+
+	if {[file isdirectory $file]} {
+	    error "\"$file\": is a directory"
+	}
+	set parent [file dirname $file]
+	if {[lsearch -exact $access_path $parent] == -1} {
+	    error "\"$file\": not in access_path";
+	}
+    }
+
+    # This procedure enables access from a safe interpreter to only a subset of
+    # the subcommands of a command:
+
+    proc Subset {slave command okpat args} {
+	set subcommand [lindex $args 0]
+	if {[regexp $okpat $subcommand]} {
+	    return [eval {$command $subcommand} [lrange $args 1 end]]
+	}
+	set msg "not allowed to invoke subcommand $subcommand of $command";
+	Log $slave $msg;
+	error $msg;
+    }
+
+    # 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: AliasSubset slave alias target subcommand1 subcommand2...
+
+    proc AliasSubset {slave alias target args} {
+	set pat ^(; set sep ""
+	foreach sub $args {
+	    append pat $sep$sub
+	    set sep |
+	}
+	append pat )\$
+	::interp alias $slave $alias {}\
+		[namespace current]::Subset $slave $target $pat
+    }
+
+}
diff --git a/tcl/library/tclIndex b/tcl/library/tclIndex
new file mode 100644
index 00000000000..09a7e64d7e2
--- /dev/null
+++ b/tcl/library/tclIndex
@@ -0,0 +1,23 @@
+# 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(history) [list source [file join $dir history.tcl]]
+set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]
+set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::setLogCmd) [list source [file join $dir safe.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]]
diff --git a/tcl/library/word.tcl b/tcl/library/word.tcl
new file mode 100644
index 00000000000..9bb6fadcdc8
--- /dev/null
+++ b/tcl/library/word.tcl
@@ -0,0 +1,136 @@
+# 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.
+# 
+# RCS: @(#) $Id$
+# 
+# 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.  
+
+# CYGNUS local: Always use Motif-style selection
+#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/tcl/license.terms b/tcl/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/mac/AppleScript.html b/tcl/mac/AppleScript.html
new file mode 100644
index 00000000000..4a73fbb384a
--- /dev/null
+++ b/tcl/mac/AppleScript.html
@@ -0,0 +1,298 @@
+<HTML>
+
+<HEAD>
+
+<TITLE>tclOSAScript -- OSA</TITLE>
+
+</HEAD>
+
+<BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000FF" VLINK="#FF0000" ALINK="#00FF00">
+
+<H2 ALIGN="CENTER">TclAppleScript Extension Command</H2>
+
+<H3>NAME</H3>
+<DL>
+<DT>
+AppleScript - Communicate with the AppleScript OSA component to run
+	AppleScripts from Tcl.
+</DL>
+<H3>SYNOPSIS</H3>
+<DL><DT>
+<B>AppleScript <A NAME="compile">compile</A> </B><I>?-flag value?</I> <I>scriptData1 
+	   ?ScriptData2 ...?</I><I>componentName</I>
+<BR>
+<B>AppleScript <A NAME="decompile">decompile</A></B> <I>scriptName</I>
+<BR>
+<B>AppleScript delete </B><I>scriptName</I>
+<BR>
+<B>AppleScript <A NAME="execute">execute</A> </B><I>?flags value?</I> <I>scriptData1 
+	?scriptData2 ...?</I>
+<BR>
+<B>AppleScript <A NAME="info">info</A> </B><I>what</I>
+<BR>
+<B>AppleScript <A NAME="load">load</A></B> <I>?flag value? fileName</I>
+<BR>
+<B>AppleScript <A NAME="run">run</A></B> <I>?flag value?</I>
+		    <I>scriptName</I>
+<BR>
+<B>AppleScript <A NAME="store">store</A></B> <I>?flag value? scriptName fileName</I>
+<BR>
+</DL>
+
+<H3>DESCRIPTION</H3>
+<DL>
+<DT>
+
+
+This command is used to communicate with the AppleScript OSA component.  
+You can <A HREF="#compile"><B>compile</B></A> scripts, <A 
+HREF="#run"><B>run</B></A> compiled scripts, <A 
+HREF="#execute"><B>execute</B></A> script data (i.e.  compile and run at a 
+blow).  You can get script data from a compiled script (<A 
+HREF="#decompile"><B>decompile</B></A> it), and you can <A 
+HREF="#load"><B>load</B></A> a compiled script from the scpt resource of a 
+file, or <A HREF="store"><B>store</B></A> one to a scpt resource.  You can 
+also get <A HREF="#info"><B>info</B></A> on the currently available scripts 
+and contexts.  It has the general form
+
+<DL>
+<DT>
+<P>
+<I>AppleScript option ?arg arg ...?</I>
+<P>
+</DL>
+The possible sub-commands are:
+<P>
+<DL>
+	<DT>
+	<I>AppleScript</I> <A NAME="compile"><B>compile</A> </B><I>?-flag value?</I> <I>scriptData1 
+	   ?ScriptData2 ...?</I>
+	<BR>
+	
+	<DD>
+        The scriptData 
+	elements are concatenated (with a space between each), and
+	sent to AppleScript
+        for compilation.  There is no limitation on the size of 
+	the scriptData, beyond the available memory of the Wish interpreter.  
+	<P>
+	If the compilation is successful, then the command will return a token 
+	that you can pass to the <A HREF="#run">"run"</A> subcommand.  If the 
+	compilation fails, then the return value will be the error message from 
+	AppleScript, and the pertinent line of code, with an "_" to indicate 
+	the place where it thinks the error occured.
+	<P>
+	The 
+	compilation is controlled by flag value pairs.  The available flags 
+	are:
+	<P>
+	<DL>
+		<DT>
+		<A NAME="first compile switch"><B>-augment Boolean</B></A>
+		<DD>
+		To be used in concert with the <A HREF="#-context">-context</A> flag.  
+		If augment is yes, 
+		then the scriptData augments the handlers and data already in the 
+		script context.  If augment is no, then the scriptData replaces the 
+		data and handlers already in the context.  The default is yes.  
+		<P>		
+		<!-- I'm leaving this flag out for now, since I can't seem to get the
+		     AE manager to obey it.  Even when I hard code the value, applications
+		     still switch to the foreground.  Oh, well...
+		     
+		<DT>
+		<B>-canswitch Boolean  </B>
+		<DD>
+		 If yes, then applications activated by the code in scriptData will 
+		 be allowed to switch to the foreground.  If no, then they will use 
+		 the notification manager to indicate they need attention (this 
+		 usually means they blink the Finder icon, and put a check in the 
+		 application's entry in the Finder menu). 
+		 -->
+		 
+		<DT>
+		<B><A NAME="-context">-context</A> Boolean</B>
+		<DD> 
+		This flag causes the code given in the scriptData to be compiled 
+		into a "context".  In AppleScript, this is the equivalent of creating an Tcl 
+		Namespace.  The command in this case returns the name of the context as 
+		the its result, rather than a compiled script name.
+		<P>
+		You can store data and procedures (aka 
+		handlers) in a script context.  Then later, you can 
+		run other scripts in this context, and they will see all the data and 
+		handlers that were set up with this command.  You do this by passing the
+		name of this context to the -context flag of the run or execute subcommands.
+		<P>
+		Unlike the straight compile command, the code compiled into a 
+		script context is run immediatly, when it is compiled, to set up the context.
+		<DT>
+		<P>
+		<B>-name string</B> 
+		<DD>
+		Use <I>string</I> as the name of the script or script context.  If there is 
+		already a script 
+		of this name, it will be discarded.  The same is true with script 
+		contexts, unless the <I>-augment</I> flag is true.  If no name is provided, then a 
+		unique name will be created for you.
+		<DT>
+		<P>
+		<B>-parent contextName  </B>
+		<DD>
+		This flag is also to be used in conjunction with the <A HREF="#-context">-context</A> flag.  
+		<I>contextName</I> must be the name of a compiled script context.  Then 
+		the new script context will inherit the data and handlers from the 
+		parent context.
+	</DL>
+	<P>
+	<DT>
+	<I>AppleScript</I> <B><A NAME="decompile">decompile</A></B> <I>scriptName</I>
+	<BR>
+	<DD>
+	This decompiles the script data compiled into the script scriptName,
+	and returns the source code. 
+	<P>
+	<DT>
+	<I>AppleScript</I> <B>delete </B><I>scriptName</I>
+	<BR>
+	<DD>
+	This deletes the script data compiled into the script scriptName,
+	and frees up all the resources associated with it. 
+	<P>
+	<DT>
+	<I>AppleScript</I> <B><A NAME="execute">execute</A> </B><I>?flags value?</I> <I>scriptData1 
+	?scriptData2 ...?</I>
+	<BR>
+	<DD>
+	This compiles and runs the script in scriptData (concatenating first), and 
+	returns the results of the script execution.  It is the same as doing 
+	<I>compile</I> and then <I>run</I>, except that the compiled script is 
+	immediately discarded.
+   <P>
+	<DT>
+	<I>AppleScript</I> <B><A NAME="info">info</A> </B><I>what</I>
+	<DD>
+	This gives info on the connection.  The allowed values for "what" are:
+	<P>
+	<DL>
+	    <DT>
+		<P>
+	    <B>contexts </B> <I>?pattern?</I>
+	    <DD>
+	    This gives the list of the script contexts that have been.
+            If <I>pattern</I> is given, it only reports the contexts 
+	    that match this pattern.
+	    <DT>
+	<!--	<P>
+	    <B>language</B>
+	    <DD>
+	    Returns the language of this OSA component
+	    <DT>
+        -->
+		<P>
+	    <B>scripts</B> <I>?pattern?</I>
+	    <DD>
+	    This returns a list of the scripts that have been compiled in the 
+	    current connection.  If <I>pattern</I> is given, it only reports the 
+	    script names that match this pattern.
+	</DL>
+	<P>
+	<DT>
+	<I>AppleScript</I> <B><A NAME="load">load</A></B> <I>?flag value? fileName</I>
+	<DD>
+	This loads compiled script data from a resource of type 'scpt' in the 
+	file fileName, and returns a token for the script data.  As with the 
+	<I>compile</I> command, the script is not actually executed.  Note that all 
+	scripts compiled with Apple's "Script Editor" are stored as script
+	contexts.  However, unlike with the "<I>compile -context</I>" command, the <I>load</I> 
+	command does not run these scripts automatically.  If you want to set up 
+	the handlers contained in the loaded script, you must run it manually. 
+	<P>
+	<I>load</I> takes the following flags:
+	<P>
+	<DL>
+	    <DT>
+	    <B>-rsrcname string</B>
+	    <DD>
+	    load a named resource of type 'scpt' using the rsrcname 
+	    flag.
+	    <DT>
+		<P>
+	    <B>-rsrcid integer</B>
+	    <DD>
+	    load a resource by number with the rsrcid flag.  
+	</DL>
+	<DD>
+	<P>
+	If neither the <I>rsrcname</I> nor the <I>rsrcid</I> flag is provided, then the load 
+	command defaults to -rsrcid = 128.  This is the resource in which 
+	Apple's Script Editor puts the script data when it writes out a 
+	compiled script.
+	<P>
+	<DT>
+	<I>AppleScript</I> <B><A NAME="run">run</A></B> <I>?flag value?</I> <I>scriptName</I>
+	<DD>
+	This runs the script which was previously compiled into <I>scriptName</I>.  If the script  
+	runs successfully, the command returns the return value for this command, 
+	coerced to a text string.  
+	If there is an error in 
+	the script execution, then it returns the error result from the 
+	scripting component.  It accepts the following flag:
+   
+   <DL>
+        <DT>
+		<P>
+		<B>-context contextName</B>
+		<DD> 
+		<I>contextName</I> must be a context created by a previous call to <I>compile</I> with 
+		the -<I>context</I> flag set.  This flag causes the code given in the 
+		<I>scriptData</I> to be run in this "context".  It will see all the data and 
+		handlers that were set up previously.
+   <!-- <DT>
+		<B>-canswitch Boolean  </B>
+		<DD>
+		If yes, then applications activated by the code 
+		in scriptData will be allowed to switch to the foreground.  If no, then 
+		they will use the notification manager to indicate they need attention 
+		(this usually means they blink the Finder icon, and put a check in the 
+		application's entry in the Finder menu). -->		 
+   </DL>
+   <P>
+	<DT>
+	<I>AppleScript </I> <B> <A NAME="store">store</A></B> <I>?flag value? scriptName fileName</I>
+	<DD>
+	This stores a compiled script or script context into a resource of type 'scpt' in the 
+	file fileName.  
+	<P>
+	store takes the following flags:
+	<P>
+	<DL>
+	    <DT>
+	    <B>-rsrcname string</B>
+	    <DD>
+	    store to a named resource of type 'scpt' using the rsrcname 
+	    flag.
+	    <DT>
+		<P>
+	    <B>-rsrcid integer</B>
+	    <DD>
+	    store to a numbered resource with the rsrcid flag.  
+	</DL>
+	<P>
+	<DD>
+	If neither the rsrcname nor the rsrcid flag is provided, then the load 
+	command defaults to -rsrcid = 128.  Apple's Script Editor can read in files written by 
+	tclOSAScript with this setting of the <I>-rsrcid</I> flag.
+</DL>
+</DL>
+<H2>Notes:</H2>
+
+The AppleScript command is a stopgap command to fill the place of exec
+    on the Mac.  It is not a supported command, and will likely change
+    as we broaden it to allow communication with other OSA languages.
+<H2>See Also:</H2>
+
+
+</BODY>
+
+</HTML>
diff --git a/tcl/mac/Background.doc b/tcl/mac/Background.doc
new file mode 100644
index 00000000000..b28e79e16d4
--- /dev/null
+++ b/tcl/mac/Background.doc
@@ -0,0 +1,92 @@
+Notes about the Background Only application template
+====================================================
+
+RCS: @(#) $Id$
+
+We have included sample code and project files for making a Background-Only
+ application (BOA) in Tcl.  This could be used for server processes (like the 
+Tcl Web-Server).  
+
+Files:
+------
+
+* BOA_TclShells.¼    - This is the project file.
+* tclMacBOAAppInit.c - This is the AppInit file for the BOA App.
+* tclMacBOAMain      - This is a replacement for the Tcl_Main for BOA's.
+
+Caveat:
+-------
+
+This is an unsupported addition to MacTcl.  The main feature that will certainly
+change is how we handle AppleEvents.  Currently, all the AppleEvent handling is
+done on the Tk side, which is not really right.  Also, there is no way to 
+register your own AppleEvent handlers, which is obviously something that would be 
+useful in a BOA App.  We will address these issues in Tcl8.1.  If you need to 
+register your own AppleEvent Handlers in the meantime, be aware that your code
+will probably break in Tcl8.1.
+
+I will also improve the basic code here based on feedback that I recieve.  This
+is to be considered a first cut only at writing a BOA in Tcl.
+
+Introduction:
+-------------
+
+This project makes a double-clickable BOA application.  It obviously needs 
+some Tcl code to get it started.  It will look for this code first in a 
+'TEXT' resource in the application shell whose name is "bgScript.tcl".  If 
+it does not find any such resource, it will look for a file called 
+bgScript.tcl in the application's folder.  Otherwise it will quit with an 
+error.
+
+It creates three files in the application folder to store stdin, stdout & 
+stderr.  They are imaginatively called temp.in, temp.out & temp.err.  They 
+will be opened append, so you do not need to erase them after each use of 
+the BOA.
+
+The app does understand the "quit", and the "doScript" AppleEvents, so you can 
+kill it with the former, and instruct it with the latter.  It also has an 
+aete, so you can target it with Apple's "Script Editor".
+
+For more information on Macintosh BOA's, see the Apple TechNote: 1070.
+
+Notifications:
+--------------
+
+BOA's are not supposed to have direct contact with the outside world.  They 
+are, however, allowed to go through the Notification Manager to post 
+alerts.  To this end, I have added a Tcl command called "bgnotify" to the 
+shell, that simply posts a notification through the notification manager.
+
+To use it, say:
+
+bgnotify "Hi, there little buddy"
+
+It will make the system beep, and pop up an annoying message box with the 
+text of the first argument to the command.  While the message is up, Tcl 
+is yielding processor time, but not processing any events.
+
+Errors:
+-------
+
+Usually a Tcl background application will have some startup code, opening 
+up a server socket, or whatever, and at the end of this, will use the 
+vwait command to kick off the event loop.  If an error occurs in the 
+startup code, it will kill the application, and a notification of the error 
+will be posted through the Notification Manager.  
+
+If an error occurs in the event handling code after the 
+vwait, the error message will be written to the file temp.err.  However, 
+if you would like to have these errors post a notification as well, just 
+define a proc called bgerror that takes one argument, the error message, 
+and passes that off to "bgnotify", thusly:
+
+proc bgerror {mssg} {
+	bgnotify "A background error has occured\n $mssg"
+}
+
+Support:
+--------
+
+If you have any questions, contact me at:
+
+jim.ingham@eng.sun.com
diff --git a/tcl/mac/MW_TclAppleScriptHeader.pch b/tcl/mac/MW_TclAppleScriptHeader.pch
new file mode 100644
index 00000000000..afd6cdba1ea
--- /dev/null
+++ b/tcl/mac/MW_TclAppleScriptHeader.pch
@@ -0,0 +1,47 @@
+/*
+ * MW_TclAppleScriptHeader.pch --
+ *
+ *  This file is the source for a pre-compilied header that gets used
+ *  for TclAppleScript.  This make compilies go a bit
+ *  faster.  This file is only intended to be used in the MetroWerks
+ *  CodeWarrior environment.  It essentially acts as a place to set 
+ *  compiler flags.  See MetroWerks documention for more details.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * To use the compilied header you need to set the "Prefix file" in
+ * the "C/C++ Language" preference panel to point to the created
+ * compilied header.  The name of the header depends on the
+ * architecture we are compiling for (see the code below).  For
+ * example, for a 68k app the prefix file should be: MW_TclHeader68K.
+ */
+
+#if __POWERPC__
+#pragma precompile_target "MW_TclAppleScriptHeaderPPC"
+#include "MW_TclHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TclAppleScriptHeaderCFM68K"
+#include "MW_TclHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TclAppleScriptHeader68K"
+#include "MW_TclHeader68K"
+#endif
+
+
+#define TCL_REGISTER_LIBRARY 1
+/*
+ * Place any includes below that will are needed by the majority of the
+ * and is OK to be in any file in the system.  The pragma's are used
+ * to control what functions are exported in the Tcl shared library.
+ */
+
+#pragma export on
+#pragma export off
+
diff --git a/tcl/mac/MW_TclHeader.pch b/tcl/mac/MW_TclHeader.pch
new file mode 100644
index 00000000000..bca9fe42366
--- /dev/null
+++ b/tcl/mac/MW_TclHeader.pch
@@ -0,0 +1,47 @@
+/*
+ * MW_TclHeader.pch --
+ *
+ *  This file is the source for a pre-compilied header that gets used
+ *  for all files in the Tcl projects.  This make compilies go a bit
+ *  faster.  This file is only intended to be used in the MetroWerks
+ *  CodeWarrior environment.  It essentially acts as a place to set 
+ *  compiler flags.  See MetroWerks documention for more details.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * To use the compilied header you need to set the "Prefix file" in
+ * the "C/C++ Language" preference panel to point to the created
+ * compilied header.  The name of the header depends on the
+ * architecture we are compiling for (see the code below).  For
+ * example, for a 68k app the prefix file should be: MW_TclHeader68K.
+ */
+#if __POWERPC__
+#pragma precompile_target "MW_TclHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TclHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TclHeader68K"
+#endif
+
+#include "tclMacCommonPch.h"
+
+/*
+ * Place any includes below that will are needed by the majority of the
+ * and is OK to be in any file in the system.  The pragma's are used
+ * to control what functions are exported in the Tcl shared library.
+ */
+
+#pragma export on
+#include "tcl.h"
+#include "tclMac.h"
+#include "tclInt.h"
+
+#pragma export reset
+
diff --git a/tcl/mac/README b/tcl/mac/README
new file mode 100644
index 00000000000..b8ca40e17c1
--- /dev/null
+++ b/tcl/mac/README
@@ -0,0 +1,195 @@
+Tcl 8.0.3 for Macintosh
+
+by Ray Johnson
+Scriptics Corporation
+rjohnson@scriptics.com
+with major help from
+Jim Ingham
+Cygnus Solutions
+jingham@cygnus.com
+
+RCS: @(#) $Id$
+
+1. Introduction
+---------------
+
+This is the README file for the Macintosh version of the Tcl
+scripting language.  The file consists of information specific
+to the Macintosh version of Tcl.  For more general information
+please read the README file in the main Tcl directory.
+
+2. What's new?
+--------------
+
+The main new feature is the Tcl compilier.  You should certainly
+notice the speed improvements.  Any problems are probably
+generic rather than Mac specific.  If you have questions or
+comments about the compilier feel free to forward them to the
+author of the compilier: Brian Lewis <btlewis@eng.sun.com>.
+Several things were fixed/changed since the a1 release so be
+sure to check this out.
+
+The largest incompatible change on the Mac is the removal of the
+following commands: "rm", "rmdir", "mkdir", "mv" and "cp".  These
+commands were never really supported and their functionality is
+superceded by the file command.
+
+I've also added in a new "AppleScript" command.  This was contributed
+by Jim Ingham who is a new member of the Tcl group.  It's very cool.
+The command isn't actually in the core - you need to do a "package
+require Tclapplescript" to get access to it.  This code is officially
+unsupported and will change in the next release.  However, the core
+functionality is there and is stable enough to use.  Documentation 
+can be found in "AppleScript.html" in the mac subdirectory.
+
+The resource command has also been rewacked.  You can now read and
+write any Mac resource.  Tcl now has the new (and VERY COOL) binary
+command that will allow you to pack and unpack the resources into
+useful Tcl code. We will eventually provide Tcl libraries for
+accessing the most common resources.
+
+See the main Tcl README for other features new to Tcl 8.0.
+
+3. Mac specific features
+------------------------
+
+There are several features or enhancements in Tcl that are unique to 
+the Macintosh version of Tcl.  Here is a list of those features and
+pointers to where you can find more information about the feature.
+
+* The "resource" command allows you manipulate Macintosh resources.
+  A complete man page is available for this command.
+
+* The Mac version of the "source" command has an option to source from
+  a Macintosh resource.  Check the man page from the source command
+  for details.
+
+* The only command NOT available on the Mac is the exec command.
+  However, we include a Mac only package called Tclapplescript that
+  provides access to Mac's AppleScript system.  This command is still
+  under design & construction.  Documentatin can be found in the mac
+  subdirectory in a file called "AppleScript.html".
+
+* The env variable on the Macintosh works rather differently than on
+  Windows or UNIX platforms.  Check out the tclvars man page for
+  details.
+
+* The command "file volumes" returns the available volumes on your
+  Macintosh.  Check out the file command for details.
+
+* The command "file attributes" has the Mac specific options of
+  -creator and -type which allow you to query and set the Macintosh
+  creator and type codes for Mac files.  See file man page for details.
+
+* We have added a template for creating a Background-only Tcl application.
+  So you can use Tcl as a faceless server process.  For more details, see 
+  the file background.doc.
+  
+If you are writing cross platform code but would still like to use
+some of these Mac specific commands, please remember to use the
+tcl_platform variable to special case your code.
+
+4. The Distribution
+-------------------
+
+Macintosh Tcl is distributed in three different forms.  This 
+should make it easier to only download what you need.  The 
+packages are as follows:
+
+mactk8.0.3.sea.hqx
+
+    This distribution is a "binary" only release.  It contains an
+    installer program that will install a 68k, PowerPC, or Fat
+    version of the "Tcl Shell" and "Wish" applications.  In addition,
+    it installs the Tcl & Tk libraries in the Extensions folder inside
+    your System Folder.
+
+mactcltk-full-8.0.3.sea.hqx
+
+    This release contains the full release of Tcl and Tk for the
+    Macintosh plus the More Files packages which Macintosh Tcl and Tk
+    rely on.
+
+mactcl-source-8.0.3.sea.hqx
+
+    This release contains the complete source for Tcl 8.0.  In
+    addition, Metrowerks CodeWarrior libraries and project files
+    are included.  However, you must already have the More Files
+    package to compile this code.
+
+5. Documentation
+----------------
+
+The "html" subdirectory contains reference documentation in
+in the HTML format.  You may also find these pages at:
+
+	http://www.scriptics.com/man/tcl8.0/contents.html
+
+Other documentation and sample Tcl scripts can be found at
+the Tcl archive site: 
+
+	ftp://ftp.neosoft.com/tcl/
+
+and the Tcl resource center:
+
+	http://www.scriptics.com/resource/
+
+The internet news group comp.lang.tcl is also a valuable
+source of information about Tcl.  A mailing list is also
+available (see below).
+
+6. Compiling Tcl
+----------------
+
+In order to compile Macintosh Tcl you must have the 
+following items:
+
+	CodeWarrior Pro 2 or 3
+	Mac Tcl 8.0 (source)
+	More Files 1.4.3
+
+There are two sets of project files included with the package. The ones
+we use for the release are for CodeWarrior Pro 3, and are not compatible
+with CodeWarrior Gold release 11 and earlier. We have included the files
+for earlier versions of CodeWarrior in the folder tcl8.0:mac:CW11 Projects,
+but they are unsupported, and a little out of date.
+
+As of Tcl8.0p2, the code will also build under CW Pro 2.  The only
+change that needs to be made is that float.mac.c should be replaced by
+float.c in the MacTcl MSL project file.
+
+However, there seems to be a bug in the CFM68K Linker in CW Pro 2,
+which renders the CFM68K Version under CW Pro 2 very unstable.  I am
+working with MetroWerks to resolve this issue.  The PPC version is
+fine, as is the Traditional 68K Shell.  But if you need to use the
+CFM68K, then you must stay with CW Pro 1 for now.
+
+The project  files included with the Mac Tcl source should work 
+fine.  The only thing you may need to update are the access paths.
+Unfortunantly, it's somewhat common for the project files to become
+slightly corrupted.  The most common problem is that the "Prefix file"
+found in the "C/C++ Preference" panel is incorrect.  This should be
+set to MW_TclHeaderPPC, MW_TclHeader68K or MW_TclHeaderCFM68K.
+
+To build the fat version of TclShell, open the project file "TclShells.¼",
+select the "TclShell" target, and build. All of the associated binaries will
+be built automoatically. There are also targets for building static 68K
+and Power PC builds, for building a CFM 68K build, and for building a
+shared library Power PC only build.
+
+Special notes:
+
+* There is a small bug in More Files 1.4.3.  Also you should not use
+  MoreFiles 1.4.4 - 1.4.6.  Look in the file named morefiles.doc for
+  more details.
+
+* You may not have the libmoto library which will cause a compile 
+  error.  You don't REALLY need it - it can be removed.  Look at the
+  file libmoto.doc for more details.
+
+* Check out the file bugs.doc for information about known bugs.
+
+If you have comments or Bug reports send them to:
+Jim Ingham
+jingham@cygnus.com
+
diff --git a/tcl/mac/bugs.doc b/tcl/mac/bugs.doc
new file mode 100644
index 00000000000..114e0d9ab47
--- /dev/null
+++ b/tcl/mac/bugs.doc
@@ -0,0 +1,32 @@
+Known bug list for Tcl 8.0 for Macintosh
+
+by Ray Johnson
+Sun Microsystems Laboratories
+rjohnson@eng.sun.com
+
+RCS: @(#) $Id$
+
+This was a new feature as of Tcl7.6b1 and as such I'll started with
+a clean slate.  I currently know of no reproducable bugs.  I often
+get vague reports - but nothing I've been able to confirm.  Let
+me know what bugs you find!
+
+The Macintosh version of Tcl passes most all tests in the Tcl
+test suite.  Slower Macs may fail some tests in event.test whose
+timing constraints are too tight.  If other tests fail please report
+them.
+
+Ray
+
+Known bugs in the current release.
+
+* With the socket code you can't use the "localhost" host name.  This
+  is actually a known bug in Apple's MacTcp stack.  However, you can
+  use [info hostname] whereever you would have used "localhost" to 
+  achive the same effect.
+
+* Most socket bugs have been fixed.  We do have a couple of test cases
+  that will hang the Mac, however, and we are still working on them.
+  If you find additional test cases that show crashes please let us
+  know!
+
diff --git a/tcl/mac/libmoto.doc b/tcl/mac/libmoto.doc
new file mode 100644
index 00000000000..ba84ba29ec5
--- /dev/null
+++ b/tcl/mac/libmoto.doc
@@ -0,0 +1,39 @@
+Notes about the use of libmoto
+------------------------------
+
+RCS: @(#) $Id$
+
+First of all, libmoto is not required!  If you don't have it, you
+can simply remove the library reference from the project file and
+everything should compile just fine.
+
+The libmoto library replaces certain functions in the MathLib and
+ANSI libraries.  Motorola has optimized the functions in the library
+to run very fast on the PowerPC.  As I said above, you don't need
+this library, but it does make things faster.
+
+Obtaining Libmoto:
+
+	For more information about Libmoto and how to doanload
+	it, visit the following URL:
+
+    http://www.mot.com/SPS/PowerPC/library/fact_sheet/libmoto.html
+
+	You will need to register for the library.  However, the
+	library is free and you can use it in any commercial product
+	you might have.
+
+Installing Libmoto:
+
+	Just follow the instructions provided by the Motorola 
+	README file.  You need to make sure that the Libmoto
+	library is before the ANSI and MathLib libraries in
+	link order.  Also, you will get several warnings stateing
+	that certain functions have already been defined in 
+	Libmoto.  (These can safely be ignored.)
+
+Finally, you can thank Kate Stewart of Motorola for twisting my
+arm at the Tcl/Tk Conference to provide some support for Libmoto.
+
+Ray Johnson
+
diff --git a/tcl/mac/license.terms b/tcl/mac/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/mac/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/mac/morefiles.doc b/tcl/mac/morefiles.doc
new file mode 100644
index 00000000000..88329c503a2
--- /dev/null
+++ b/tcl/mac/morefiles.doc
@@ -0,0 +1,74 @@
+Notes about MoreFiles, dnr.c & other non-Tcl source files
+---------------------------------------------------------
+
+RCS: @(#) $Id$
+
+The Macintosh distribution uses several source files that don't
+actually ship with Tcl.  This sometimes causes problems or confusion
+to developers.  This document should help clear up a few things.
+
+dnr.c
+-----
+
+We have found a way to work around some bugs in dnr.c that 
+Apple has never fixed even though we sent in numerous bug reports.
+The file tclMacDNR.c simply set's some #pragma's and the includes
+the Apple dnr.c file.  This should work the problems that many of
+you have reported with dnr.c.
+
+More Files
+----------
+
+Macintosh Tcl/Tk also uses Jim Luther's very useful package called
+More Files.  More Files fixes many of the broken or underfunctional
+parts of the file system.
+
+More Files can be found on the MetroWerks CD and Developer CD from
+Apple.  You can also down load the latest version from:
+
+	ftp://members.aol.com/JumpLong/
+
+The package can also be found at the home of Tcl/Tk for the mac:
+
+	ftp://ftp.sunlabs.com/pub/tcl/mac/
+
+I used to just link the More Files library in the Tcl projects.  
+However, this caused problems when libraries wern't matched correctly.
+I'm now including the files in the Tcl project directly.  This
+solves the problem of missmatched libraries - but may not always
+compile.
+
+If you get a compiliation error in MoreFiles you need to contact
+Jim Luther.  His email address:
+
+	JumpLong@aol.com
+
+The version of More Files that we use with Tcl/Tk is 1.4.3.  Early
+version may work as well..
+
+Unfortunantly, there is one bug in his library (in 1.4.3).  The bug is
+in the function FSpGetFullPath found in the file FullPath.c.  After
+the call to PBGetCatInfoSync you need to change the line:
+
+    if ( result == noErr )
+
+	to:
+
+    if ( (result == noErr) || (result == fnfErr) )
+
+
+The latest version of More Files is 1.4.6.  Unfortunantly, this
+version has a bug that keeps it from working with shared libraries
+right out of the box.  If you want to use 1.4.6 you can but you will
+need to make the following fix:
+
+	In the file "Opimization.h" in the More Files package you
+	need to remove the line "#pragma internal on".  And in the
+	file "OptimazationEnd.h" you need to remove the line
+	"#pragma internal reset".
+
+Note: the version of MoreFile downloaded from the Sun Tcl/Tk site
+will have the fix included.  (If you want you can send email to
+Jim Luther suggesting that he use Tcl for regression testing!)
+
+Ray Johnson
diff --git a/tcl/mac/porting.notes b/tcl/mac/porting.notes
new file mode 100644
index 00000000000..c15beb14245
--- /dev/null
+++ b/tcl/mac/porting.notes
@@ -0,0 +1,23 @@
+Porting Notes
+-------------
+
+RCS: @(#) $Id$
+
+Currently, the Macintosh version Tcl only compilies with the
+CodeWarrior C compilier from MetroWerks.  It should be straight
+forward to port the Tcl source to MPW.
+
+Tcl on the Mac no longer requires the use of GUSI.  It should now
+be easier to port Tcl/Tk to other compiliers such as Symantic C
+and MPW C.
+
+If you attempt to port Tcl to other Macintosh compiliers please
+let me know.  I would be glad to help with advice and encouragement.
+If your efforts are succesfull I wold also be interested in puting
+those changes into the core distribution.  Furthermore, please feel
+free to send me any notes you might make about your porting
+experience so I may include them in this file for others to reference.
+
+Ray Johnson
+ray.johnson@eng.sun.com
+
diff --git a/tcl/mac/tclMac.h b/tcl/mac/tclMac.h
new file mode 100644
index 00000000000..3f121c5ca61
--- /dev/null
+++ b/tcl/mac/tclMac.h
@@ -0,0 +1,101 @@
+/*
+ * tclMac.h --
+ *
+ *	Declarations of Macintosh specific public variables and procedures.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLMAC
+#define _TCLMAC
+
+#ifndef _TCL
+#   include "tcl.h"
+#endif
+#include <Types.h>
+#include <Files.h>
+#include <Events.h>
+
+/*
+ * "export" is a MetroWerks specific pragma.  It flags the linker that  
+ * any symbols that are defined when this pragma is on will be exported 
+ * to shared libraries that link with this library.
+ */
+ 
+#pragma export on
+
+typedef int (*Tcl_MacConvertEventPtr) _ANSI_ARGS_((EventRecord *eventPtr));
+
+/*
+ * This is needed by the shells to handle Macintosh events.
+ */
+ 
+EXTERN void  Tcl_MacSetEventProc _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr));
+
+/*
+ * These routines are useful for handling using scripts from resources 
+ * in the application shell
+ */
+ 
+EXTERN char *	Tcl_MacConvertTextResource _ANSI_ARGS_((Handle resource));
+EXTERN int 	Tcl_MacEvalResource _ANSI_ARGS_((Tcl_Interp *interp,
+		    char *resourceName, int resourceNumber, char *fileName));
+EXTERN Handle	Tcl_MacFindResource _ANSI_ARGS_((Tcl_Interp *interp,
+		    long resourceType, char *resourceName,
+		    int resourceNumber, char *resFileRef, int * releaseIt));
+
+/* These routines support the new OSType object type (i.e. the packed 4
+ * character type and creator codes).
+ */
+ 								  
+EXTERN int		Tcl_GetOSTypeFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, OSType *osTypePtr));
+EXTERN void		Tcl_SetOSTypeObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
+			    OSType osType));
+EXTERN Tcl_Obj *	Tcl_NewOSTypeObj _ANSI_ARGS_((OSType osType));
+
+
+
+/*
+ * The following routines are utility functions in Tcl.  They are exported
+ * here because they are needed in Tk.  They are not officially supported,
+ * however.  The first set are from the MoreFiles package.
+ */
+
+EXTERN pascal	OSErr	FSpGetDirectoryID(const FSSpec *spec,
+			    long *theDirID, Boolean *isDirectory);
+EXTERN pascal	short	FSpOpenResFileCompat(const FSSpec *spec,
+			    SignedByte permission);
+EXTERN pascal	void	FSpCreateResFileCompat(const FSSpec *spec,
+			    OSType creator, OSType fileType,
+			    ScriptCode scriptTag);
+/* 
+ * Like the MoreFiles routines these fix problems in the standard
+ * Mac calls.  These routines is from tclMacUtils.h.
+ */
+
+EXTERN int 	FSpLocationFromPath _ANSI_ARGS_((int length, CONST char *path,
+		    FSSpecPtr theSpec));
+EXTERN OSErr 	FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec,
+		    int *length, Handle *fullPath));
+
+/*
+ * These are not in MSL 2.1.2, so we need to export them from the
+ * Tcl shared library.  They are found in the compat directory
+ * except the panic routine which is found in tclMacPanic.h.
+ */
+ 
+EXTERN int	strncasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2, size_t n));
+EXTERN int	strcasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2));
+EXTERN void	panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+
+#pragma export reset
+
+#endif /* _TCLMAC */
diff --git a/tcl/mac/tclMacAETE.r b/tcl/mac/tclMacAETE.r
new file mode 100644
index 00000000000..2090ff6adb8
--- /dev/null
+++ b/tcl/mac/tclMacAETE.r
@@ -0,0 +1,58 @@
+/*
+ * tclMacAETE.r --
+ *
+ *	This file creates the Apple Event Terminology resources 
+ *	for use Tcl and Tk.  It is not used in the Simple Tcl shell
+ *      since SIOUX does not support AppleEvents.  An example of its
+ *      use in Tcl is the TclBGOnly project.  And it is used in all the
+ *      Tk Shells.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define SystemSevenOrLater 1
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+/*
+ * The following resources defines the Apple Events that Tk can be
+ * sent from Apple Script.
+ */
+
+resource 'aete' (0, "Wish Suite") {
+    0x01, 0x00, english, roman,
+    {
+	"Required Suite", 
+	"Events that every application should support", 
+	'reqd', 1, 1,
+	{},
+	{},
+	{},
+	{},
+
+	"Wish Suite", "Events for the Wish application", 'WIsH', 1, 1,
+	{
+	    "do script", "Execute a Tcl script", 'misc', 'dosc',
+	    'TEXT', "Result", replyOptional, singleItem,
+	    notEnumerated, reserved, reserved, reserved, reserved,
+	    reserved, reserved, reserved, reserved, reserved,
+	    reserved, reserved, reserved, reserved, 
+	    'TEXT', "Script to execute", directParamRequired,
+	    singleItem, notEnumerated, changesState, reserved,
+	    reserved, reserved, reserved, reserved, reserved,
+	    reserved, reserved, reserved, reserved, reserved,
+	    reserved, 
+	    {},
+	},
+	{},
+	{},
+	{},
+    }
+};
diff --git a/tcl/mac/tclMacAlloc.c b/tcl/mac/tclMacAlloc.c
new file mode 100644
index 00000000000..71b6fb4effd
--- /dev/null
+++ b/tcl/mac/tclMacAlloc.c
@@ -0,0 +1,348 @@
+/*
+ * tclMacAlloc.c --
+ *
+ *	This is a very fast storage allocator.  It allocates blocks of a
+ *	small number of different sizes, and keeps free lists of each size.
+ *	Blocks that don't exactly fit are passed up to the next larger size.
+ *	Blocks over a certain size are directly allocated by calling NewPtr.
+ *
+ * Copyright (c) 1983 Regents of the University of California.
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson
+ *.
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclMacInt.h"
+#include "tclInt.h"
+#include <Memory.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+/*
+ * Flags that are used by ConfigureMemory to define how the allocator
+ * should work.  They can be or'd together.
+ */
+#define MEMORY_ALL_SYS 1	/* All memory should come from the system
+heap. */
+
+/*
+ * Amount of space to leave in the application heap for the Toolbox to work.
+ */
+
+#define TOOLBOX_SPACE (32 * 1024)
+
+static int memoryFlags = 0;
+static Handle toolGuardHandle = NULL;
+				/* This handle must be around so that we don't
+				 * have NewGWorld failures. This handle is
+				 * purgeable. Before we allocate any blocks,
+				 * we see if this handle is still around.
+				 * If it is not, then we try to get it again.
+				 * If we can get it, we lock it and try
+				 * to do the normal allocation, unlocking on
+				 * the way out. If we can't, we go to the
+				 * system heap directly. */
+
+
+/*
+ * The following typedef and variable are used to keep track of memory
+ * blocks that are allocated directly from the System Heap.  These chunks
+ * of memory must always be freed - even if we crash.
+ */
+
+typedef struct listEl {
+    Handle		memoryHandle;
+    struct listEl *	next;
+} ListEl;
+
+ListEl * systemMemory = NULL;
+ListEl * appMemory = NULL;
+
+/*
+ * Prototypes for functions used only in this file.
+ */
+
+static pascal void	CleanUpExitProc _ANSI_ARGS_((void));
+void 			ConfigureMemory _ANSI_ARGS_((int flags));
+void			FreeAllMemory _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpSysRealloc --
+ *
+ *	This function reallocates a chunk of system memory.  If the
+ *	chunk is already big enough to hold the new block, then no
+ *	allocation happens.
+ *
+ * Results:
+ *	Returns a pointer to the newly allocated block.
+ *
+ * Side effects:
+ *	May copy the contents of the original block to the new block
+ *	and deallocate the original block.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclpSysRealloc(
+    VOID *oldPtr,		/* Original block */
+    unsigned int size)		/* New size of block. */
+{
+    Handle hand;
+    void *newPtr;
+    int maxsize;
+
+    hand = * (Handle *) ((Ptr) oldPtr - sizeof(Handle));
+    maxsize = GetHandleSize(hand) - sizeof(Handle);
+    if (maxsize < size) {
+	newPtr = TclpSysAlloc(size, 1);
+	memcpy(newPtr, oldPtr, maxsize);
+	TclpSysFree(oldPtr);
+    } else {
+	newPtr = oldPtr;
+    }
+    return newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpSysAlloc --
+ *
+ *	Allocate a new block of memory free from the System.
+ *
+ * Results:
+ *	Returns a pointer to a new block of memory.
+ *
+ * Side effects:
+ *	May obtain memory from app or sys space.  Info is added to
+ *	overhead lists etc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclpSysAlloc(
+    long size,		/* Size of block to allocate. */
+    int isBin)		/* Is this a bin allocation? */
+{
+    Handle hand = NULL;
+    ListEl * newMemoryRecord;
+
+    if (!(memoryFlags & MEMORY_ALL_SYS)) {
+
+    	/*
+    	 * If the guard handle has been purged, throw it away and try
+    	 * to allocate it again.
+    	 */
+
+    	if ((toolGuardHandle != NULL) && (*toolGuardHandle == NULL)) {
+    	    DisposeHandle(toolGuardHandle);
+    	    toolGuardHandle = NULL;
+    	}
+
+    	/*
+    	 * If we have never allocated the guard handle, or it was purged
+    	 * and thrown away, then try to allocate it again.
+    	 */
+
+    	if (toolGuardHandle == NULL) {
+    	    toolGuardHandle = NewHandle(TOOLBOX_SPACE);
+    	    if (toolGuardHandle != NULL) {
+    	    	HPurge(toolGuardHandle);
+    	    }
+    	}
+
+	/*
+	 * If we got the handle, lock it and do our allocation.
+	 */
+
+    	if (toolGuardHandle != NULL) {
+    	    HLock(toolGuardHandle);
+	    hand = NewHandle(size + sizeof(Handle));
+	    HUnlock(toolGuardHandle);
+	}
+    }
+    if (hand != NULL) {
+	newMemoryRecord = (ListEl *) NewPtr(sizeof(ListEl));
+	if (newMemoryRecord == NULL) {
+	    DisposeHandle(hand);
+	    return NULL;
+	}
+	newMemoryRecord->memoryHandle = hand;
+	newMemoryRecord->next = appMemory;
+	appMemory = newMemoryRecord;
+    } else {
+	/*
+	 * Ran out of memory in application space.  Lets try to get
+	 * more memory from system.  Otherwise, we return NULL to
+	 * denote failure.
+	 */
+	isBin = 0;
+	hand = NewHandleSys(size + sizeof(Handle));
+	if (hand == NULL) {
+	    return NULL;
+	}
+	if (systemMemory == NULL) {
+	    /*
+	     * This is the first time we've attempted to allocate memory
+	     * directly from the system heap.  We need to now install the
+	     * exit handle to ensure the memory is cleaned up.
+	     */
+	    TclMacInstallExitToShellPatch(CleanUpExitProc);
+	}
+	newMemoryRecord = (ListEl *) NewPtrSys(sizeof(ListEl));
+	if (newMemoryRecord == NULL) {
+	    DisposeHandle(hand);
+	    return NULL;
+	}
+	newMemoryRecord->memoryHandle = hand;
+	newMemoryRecord->next = systemMemory;
+	systemMemory = newMemoryRecord;
+    }
+    if (isBin) {
+	HLockHi(hand);
+    } else {
+	HLock(hand);
+    }
+    (** (Handle **) hand) = hand;
+
+    return (*hand + sizeof(Handle));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpSysFree --
+ *
+ *	Free memory that we allocated back to the system.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpSysFree(
+    void * ptr)		/* Free this system memory. */
+{
+    Handle hand;
+    OSErr err;
+
+    hand = * (Handle *) ((Ptr) ptr - sizeof(Handle));
+    DisposeHandle(hand);
+    *hand = NULL;
+    err = MemError();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanUpExitProc --
+ *
+ *	This procedure is invoked as an exit handler when ExitToShell
+ *	is called.  It removes any memory that was allocated directly
+ *	from the system heap.  This must be called when the application
+ *	quits or the memory will never be freed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May free memory in the system heap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal void
+CleanUpExitProc()
+{
+    ListEl * memRecord;
+
+    while (systemMemory != NULL) {
+	memRecord = systemMemory;
+	systemMemory = memRecord->next;
+        if (*(memRecord->memoryHandle) != NULL) {
+            DisposeHandle(memRecord->memoryHandle);
+        }
+	DisposePtr((void *) memRecord);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeAllMemory --
+ *
+ *	This procedure frees all memory blocks allocated by the memory
+ *	sub-system.  Make sure you don't have any code that references
+ *	any malloced data!
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees all memory allocated by TclpAlloc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FreeAllMemory()
+{
+    ListEl * memRecord;
+
+    while (systemMemory != NULL) {
+	memRecord = systemMemory;
+	systemMemory = memRecord->next;
+	if (*(memRecord->memoryHandle) != NULL) {
+            DisposeHandle(memRecord->memoryHandle);
+        }
+	DisposePtr((void *) memRecord);
+    }
+    while (appMemory != NULL) {
+	memRecord = appMemory;
+	appMemory = memRecord->next;
+	if (*(memRecord->memoryHandle) != NULL) {
+            DisposeHandle(memRecord->memoryHandle);
+        }
+	DisposePtr((void *) memRecord);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMemory --
+ *
+ *	This procedure sets certain flags in this file that control
+ *	how memory is allocated and managed.  This call must be made
+ *	before any call to TclpAlloc is made.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Certain state will be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConfigureMemory(
+    int flags)		/* Flags that control memory alloc scheme. */
+{
+    memoryFlags = flags;
+}
diff --git a/tcl/mac/tclMacAppInit.c b/tcl/mac/tclMacAppInit.c
new file mode 100644
index 00000000000..05cdc416da6
--- /dev/null
+++ b/tcl/mac/tclMacAppInit.c
@@ -0,0 +1,212 @@
+/* 
+ * tclMacAppInit.c --
+ *
+ *	Provides a version of the Tcl_AppInit procedure for the example shell.
+ *
+ * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+
+#if defined(THINK_C)
+#   include <console.h>
+#elif defined(__MWERKS__)
+#   include <SIOUX.h>
+short InstallConsole _ANSI_ARGS_((short fd));
+#endif
+
+#ifdef TCL_TEST
+EXTERN int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int		MacintoshInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	Main program for tclsh.  This file can be used as a prototype
+ *	for other applications using the Tcl library.
+ *
+ * Results:
+ *	None. This procedure never returns (it exits the process when
+ *	it's done.
+ *
+ * Side effects:
+ *	This procedure initializes the Macintosh world and then 
+ *	calls Tcl_Main.  Tcl_Main will never return except to exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+main(
+    int argc,				/* Number of arguments. */
+    char **argv)			/* Array of argument strings. */
+{
+    char *newArgv[2];
+    
+    if (MacintoshInit()  != TCL_OK) {
+	Tcl_Exit(1);
+    }
+
+    argc = 1;
+    newArgv[0] = "tclsh";
+    newArgv[1] = NULL;
+    Tcl_Main(argc, newArgv, Tcl_AppInit);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ *	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
+Tcl_AppInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    if (Tcl_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+#ifdef TCL_TEST
+    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;
+    }
+    if (Procbodytest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
+            Procbodytest_SafeInit);
+#endif /* TCL_TEST */
+
+    /*
+     * Call the init procedures for included packages.  Each call should
+     * look like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module.
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if
+     * they weren't already created by the init procedures called above.
+     * Each call would loo like this:
+     *
+     * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
+     */
+
+    /*
+     * Specify a user-specific startup script to invoke if the application
+     * is run interactively.  On the Mac we can specifiy either a TEXT resource
+     * which contains the script or the more UNIX like file location
+     * may also used.  (I highly recommend using the resource method.)
+     */
+
+    Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
+    /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacintoshInit --
+ *
+ *	This procedure calls initalization routines to set up a simple
+ *	console on a Macintosh.  This is necessary as the Mac doesn't
+ *	have a stdout & stderr by default.
+ *
+ * Results:
+ *	Returns TCL_OK if everything went fine.  If it didn't the 
+ *	application should probably fail.
+ *
+ * Side effects:
+ *	Inits the appropiate console package.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MacintoshInit()
+{
+#if GENERATING68K && !GENERATINGCFM
+    SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
+#endif
+    MaxApplZone();
+
+#if defined(THINK_C)
+
+    /* Set options for Think C console package */
+    /* The console package calls the Mac init calls */
+    console_options.pause_atexit = 0;
+    console_options.title = "\pTcl Interpreter";
+		
+#elif defined(__MWERKS__)
+
+    /* Set options for CodeWarrior SIOUX package */
+    SIOUXSettings.autocloseonquit = true;
+    SIOUXSettings.showstatusline = true;
+    SIOUXSettings.asktosaveonclose = false;
+    InstallConsole(0);
+    SIOUXSetTitle("\pTcl Interpreter");
+		
+#elif defined(applec)
+
+    /* Init packages used by MPW SIOW package */
+    InitGraf((Ptr)&qd.thePort);
+    InitFonts();
+    InitWindows();
+    InitMenus();
+    TEInit();
+    InitDialogs(nil);
+    InitCursor();
+		
+#endif
+
+    Tcl_MacSetEventProc((Tcl_MacConvertEventPtr) SIOUXHandleOneEvent);
+    
+    /* No problems with initialization */
+    return TCL_OK;
+}
diff --git a/tcl/mac/tclMacApplication.r b/tcl/mac/tclMacApplication.r
new file mode 100644
index 00000000000..10e2aa39053
--- /dev/null
+++ b/tcl/mac/tclMacApplication.r
@@ -0,0 +1,75 @@
+/* 
+ * tclMacApplication.r --
+ *
+ *	This file creates resources for use Tcl Shell application.
+ *	It should be viewed as an example of how to create a new
+ *	Tcl application using the shared Tcl libraries.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+
+#if (TCL_RELEASE_LEVEL == 0)
+#   define RELEASE_LEVEL alpha
+#elif (TCL_RELEASE_LEVEL == 1)
+#   define RELEASE_LEVEL beta
+#elif (TCL_RELEASE_LEVEL == 2)
+#   define RELEASE_LEVEL final
+#endif
+
+#if (TCL_RELEASE_LEVEL == 2)
+#   define MINOR_VERSION (TCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+#else
+#   define MINOR_VERSION TCL_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+	TCL_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	TCL_PATCH_LEVEL,
+	TCL_PATCH_LEVEL ", by Ray Johnson © Sun Microsystems"
+};
+
+resource 'vers' (2) {
+	TCL_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	TCL_PATCH_LEVEL,
+	"Tcl Shell " TCL_PATCH_LEVEL " © 1996"
+};
+
+#define TCL_APP_CREATOR 'Tcl '
+
+type TCL_APP_CREATOR as 'STR ';
+resource TCL_APP_CREATOR (0, purgeable) {
+	"Tcl Shell " TCL_PATCH_LEVEL " © 1996"
+};
+
+/*
+ * The 'kind' resource works with a 'BNDL' in Macintosh Easy Open
+ * to affect the text the Finder displays in the "kind" column and
+ * file info dialog.  This information will be applied to all files
+ * with the listed creator and type.
+ */
+
+resource 'kind' (128, "Tcl kind", purgeable) {
+	TCL_APP_CREATOR,
+	0, /* region = USA */
+	{
+		'APPL', "Tcl Shell",
+	}
+};
diff --git a/tcl/mac/tclMacBOAAppInit.c b/tcl/mac/tclMacBOAAppInit.c
new file mode 100644
index 00000000000..9ec795b45db
--- /dev/null
+++ b/tcl/mac/tclMacBOAAppInit.c
@@ -0,0 +1,257 @@
+/* 
+ * tclMacBOAAppInit.c --
+ *
+ *	Provides a version of the Tcl_AppInit procedure for a 
+ *      Macintosh Background Only Application.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+#include <Fonts.h>
+#include <Windows.h>
+#include <Dialogs.h>
+#include <Menus.h>
+#include <Aliases.h>
+#include <LowMem.h>
+
+#include <AppleEvents.h>
+#include <SegLoad.h>
+#include <ToolUtils.h>
+
+#if defined(THINK_C)
+#   include <console.h>
+#elif defined(__MWERKS__)
+#   include <SIOUX.h>
+short InstallConsole _ANSI_ARGS_((short fd));
+#endif
+
+void TkMacInitAppleEvents(Tcl_Interp *interp);
+int HandleHighLevelEvents(EventRecord *eventPtr);	
+
+#ifdef TCL_TEST
+EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int		MacintoshInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	Main program for tclsh.  This file can be used as a prototype
+ *	for other applications using the Tcl library.
+ *
+ * Results:
+ *	None. This procedure never returns (it exits the process when
+ *	it's done.
+ *
+ * Side effects:
+ *	This procedure initializes the Macintosh world and then 
+ *	calls Tcl_Main.  Tcl_Main will never return except to exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+main(
+    int argc,				/* Number of arguments. */
+    char **argv)			/* Array of argument strings. */
+{
+    char *newArgv[3];
+    
+    if (MacintoshInit()  != TCL_OK) {
+	Tcl_Exit(1);
+    }
+
+    argc = 2;
+    newArgv[0] = "tclsh";
+    newArgv[1] = "bgScript.tcl";
+    newArgv[2] = NULL;
+    Tcl_Main(argc, newArgv, Tcl_AppInit);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ *	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
+Tcl_AppInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    Tcl_Channel tempChan;
+    
+    if (Tcl_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+#ifdef TCL_TEST
+    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 */
+
+    /*
+     * Call the init procedures for included packages.  Each call should
+     * look like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module.
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if
+     * they weren't already created by the init procedures called above.
+     * Each call would loo like this:
+     *
+     * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
+     */
+
+    /*
+     * Specify a user-specific startup script to invoke if the application
+     * is run interactively.  On the Mac we can specifiy either a TEXT resource
+     * which contains the script or the more UNIX like file location
+     * may also used.  (I highly recommend using the resource method.)
+     */
+
+    Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
+
+    /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
+
+    /*
+     * We have to support at least the quit Apple Event. 
+     */
+    
+    TkMacInitAppleEvents(interp);
+    
+    /* 
+     * Open a file channel to put stderr, stdin, stdout... 
+     */
+    
+    tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
+    Tcl_SetStdChannel(tempChan,TCL_STDIN);
+    Tcl_RegisterChannel(interp, tempChan);
+    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
+
+    tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
+    Tcl_SetStdChannel(tempChan,TCL_STDOUT);
+    Tcl_RegisterChannel(interp, tempChan);
+    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
+
+    tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
+    Tcl_SetStdChannel(tempChan,TCL_STDERR);
+    Tcl_RegisterChannel(interp, tempChan);
+    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
+   
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacintoshInit --
+ *
+ *	This procedure calls initalization routines to set up a simple
+ *	console on a Macintosh.  This is necessary as the Mac doesn't
+ *	have a stdout & stderr by default.
+ *
+ * Results:
+ *	Returns TCL_OK if everything went fine.  If it didn't the 
+ *	application should probably fail.
+ *
+ * Side effects:
+ *	Inits the appropiate console package.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MacintoshInit()
+{
+    THz theZone = GetZone();
+    SysEnvRec   sys;
+
+    
+    /*
+     * There is a bug in systems earlier that 7.5.5, where a second BOA will
+     * get a corrupted heap.  This is the fix from TechNote 1070
+     */
+     
+    SysEnvirons(1, &sys);
+
+    if (sys.systemVersion < 0x0755)
+    {
+        if ( LMGetHeapEnd() != theZone->bkLim) {
+            LMSetHeapEnd(theZone->bkLim);
+        }
+    }
+    
+#if GENERATING68K && !GENERATINGCFM
+    SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
+#endif
+    MaxApplZone();
+
+    InitGraf((Ptr)&qd.thePort);
+    		    
+    /* No problems with initialization */
+    Tcl_MacSetEventProc(HandleHighLevelEvents);
+
+    return TCL_OK;
+}
+
+int
+HandleHighLevelEvents(
+    EventRecord *eventPtr)
+{
+    int eventFound = false;
+    
+    if (eventPtr->what == kHighLevelEvent) {
+	AEProcessAppleEvent(eventPtr);
+        eventFound = true;
+    } else if (eventPtr->what == nullEvent) {
+        eventFound = true;
+    }
+    return eventFound;    
+}
diff --git a/tcl/mac/tclMacBOAMain.c b/tcl/mac/tclMacBOAMain.c
new file mode 100644
index 00000000000..c08a39dba9e
--- /dev/null
+++ b/tcl/mac/tclMacBOAMain.c
@@ -0,0 +1,360 @@
+/* 
+ * tclMacBGMain.c --
+ *
+ *	Main program for Macintosh Background Only Application shells.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclMacInt.h"
+#include <Resources.h>
+#include <Notification.h>
+#include <Strings.h>
+
+/*
+ * This variable is used to get out of the modal loop of the
+ * notification manager.
+ */
+
+int NotificationIsDone = 0;
+
+/*
+ * The following code ensures that tclLink.c is linked whenever
+ * Tcl is linked.  Without this code there's no reference to the
+ * code in that file from anywhere in Tcl, so it may not be
+ * linked into the application.
+ */
+
+EXTERN int Tcl_LinkVar();
+int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
+
+/*
+ * Declarations for various library procedures and variables (don't want
+ * to include tclPort.h here, because people might copy this file out of
+ * the Tcl source directory to make their own modified versions).
+ * Note:  "exit" should really be declared here, but there's no way to
+ * declare it without causing conflicts with other definitions elsewher
+ * on some systems, so it's better just to leave it out.
+ */
+
+extern int		isatty _ANSI_ARGS_((int fd));
+extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
+
+static Tcl_Interp *interp;	/* Interpreter for application. */
+
+#ifdef TCL_MEM_DEBUG
+static char dumpFile[100];	/* Records where to dump memory allocation
+				 * information. */
+static int quitFlag = 0;	/* 1 means "checkmem" command was called,
+				 * so the application should quit and dump
+				 * memory allocation information. */
+#endif
+
+/*
+ * Forward references for procedures defined later in this file:
+ */
+
+#ifdef TCL_MEM_DEBUG
+static int		CheckmemCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char *argv[]));
+#endif
+void TclMacDoNotification(char *mssg);
+void TclMacNotificationResponse(NMRecPtr nmRec); 
+int Tcl_MacBGNotifyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Main --
+ *
+ *	Main program for tclsh and most other Tcl-based applications.
+ *
+ * Results:
+ *	None. This procedure never returns (it exits the process when
+ *	it's done.
+ *
+ * Side effects:
+ *	This procedure initializes the Tk world and then starts
+ *	interpreting commands;  almost anything could happen, depending
+ *	on the script being interpreted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Main(argc, argv, appInitProc)
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Array of argument strings. */
+    Tcl_AppInitProc *appInitProc;
+				/* Application-specific initialization
+				 * procedure to call after most
+				 * initialization but before starting to
+				 * execute commands. */
+{
+    Tcl_Obj *prompt1NamePtr = NULL;
+    Tcl_Obj *prompt2NamePtr = NULL;
+    Tcl_Obj *commandPtr = NULL;
+    char buffer[1000], *args, *fileName;
+    int code, tty;
+    int exitCode = 0;
+
+    Tcl_FindExecutable(argv[0]);
+    interp = Tcl_CreateInterp();
+#ifdef TCL_MEM_DEBUG
+    Tcl_InitMemory(interp);
+    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+#endif
+
+    /*
+     * Make command-line arguments available in the Tcl variables "argc"
+     * and "argv".  If the first argument doesn't start with a "-" then
+     * strip it off and use it as the name of a script file to process.
+     */
+
+    fileName = NULL;
+    if ((argc > 1) && (argv[1][0] != '-')) {
+	fileName = argv[1];
+	argc--;
+	argv++;
+    }
+    args = Tcl_Merge(argc-1, argv+1);
+    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
+    ckfree(args);
+    TclFormatInt(buffer, argc-1);
+    Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
+	    TCL_GLOBAL_ONLY);
+
+    /*
+     * Set the "tcl_interactive" variable.
+     */
+
+    tty = isatty(0);
+    Tcl_SetVar(interp, "tcl_interactive",
+	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+    
+    /*
+     * Invoke application-specific initialization.
+     */
+
+    if ((*appInitProc)(interp) != TCL_OK) {
+	    Tcl_DString errStr;
+	    Tcl_DStringInit(&errStr);
+	    Tcl_DStringAppend(&errStr,
+		    "application-specific initialization failed: \n", -1);
+	    Tcl_DStringAppend(&errStr, interp->result, -1);
+	    Tcl_DStringAppend(&errStr, "\n", 1);
+	    TclMacDoNotification(Tcl_DStringValue(&errStr));
+	    goto done;
+    }
+
+    /*
+     * Install the BGNotify command:
+     */
+    
+    if ( Tcl_CreateObjCommand(interp, "bgnotify", Tcl_MacBGNotifyObjCmd, NULL,
+             (Tcl_CmdDeleteProc *) NULL) == NULL) {
+        goto done;
+    }
+    
+    /*
+     * If a script file was specified then just source that file
+     * and quit.  In this Mac BG Application version, we will try the
+     * resource fork first, then the file system second...
+     */
+
+    if (fileName != NULL) {
+        Str255 resName;
+        Handle resource;
+        
+        strcpy((char *) resName + 1, fileName);
+        resName[0] = strlen(fileName);
+        resource = GetNamedResource('TEXT',resName);
+        if (resource != NULL) {
+            code = Tcl_MacEvalResource(interp, fileName, -1, NULL);
+        } else {
+            code = Tcl_EvalFile(interp, fileName);
+        }
+        
+	if (code != TCL_OK) {
+            Tcl_DString errStr;
+            
+            Tcl_DStringInit(&errStr);
+            Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);
+            Tcl_DStringAppend(&errStr, fileName, -1);
+            Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);
+            Tcl_DStringAppend(&errStr, interp->result, -1);
+                        
+            TclMacDoNotification(Tcl_DStringValue(&errStr));
+                        
+        }
+	goto done;
+    }
+
+
+    /*
+     * Rather than calling exit, invoke the "exit" command so that
+     * users can replace "exit" with some other command to do additional
+     * cleanup on exit.  The Tcl_Eval call should never return.
+     */
+
+    done:
+    if (commandPtr != NULL) {
+	Tcl_DecrRefCount(commandPtr);
+    }
+    if (prompt1NamePtr != NULL) {
+	Tcl_DecrRefCount(prompt1NamePtr);
+    }
+    if (prompt2NamePtr != NULL) {
+	Tcl_DecrRefCount(prompt2NamePtr);
+    }
+    sprintf(buffer, "exit %d", exitCode);
+    Tcl_Eval(interp, buffer);
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TclMacDoNotification --
+ *
+ *	This posts an error message using the Notification manager.
+ *
+ * Results:
+ *	Post a Notification Manager dialog.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+void 
+TclMacDoNotification(mssg)
+    char *mssg;
+{
+    NMRec errorNot;
+    EventRecord *theEvent = NULL;
+    OSErr err;
+    char *ptr;
+    
+    errorNot.qType = nmType;
+    errorNot.nmMark = 0;
+    errorNot.nmIcon = 0;
+    errorNot.nmSound = (Handle) -1;
+
+    for ( ptr = mssg; *ptr != '\0'; ptr++) {
+        if (*ptr == '\n') {
+            *ptr = '\r';
+        }
+    }
+        
+    c2pstr(mssg);
+    errorNot.nmStr = (StringPtr) mssg;
+
+    errorNot.nmResp = NewNMProc(TclMacNotificationResponse);
+    errorNot.nmRefCon = SetCurrentA5();
+    
+    NotificationIsDone = 0;
+    
+    /*
+     * Cycle while waiting for the user to click on the
+     * notification box.  Don't take any events off the event queue,
+     * since we want Tcl to do this but we want to block till the notification
+     * has been handled...
+     */
+    
+    err = NMInstall(&errorNot);
+    if (err == noErr) { 
+        while (!NotificationIsDone) {
+            WaitNextEvent(0, theEvent, 20, NULL);
+        }
+        NMRemove(&errorNot);
+    }
+    	
+    p2cstr((unsigned char *) mssg);
+}
+
+void 
+TclMacNotificationResponse(nmRec) 
+    NMRecPtr nmRec;
+{
+    int curA5;
+    
+    curA5 = SetCurrentA5();
+    SetA5(nmRec->nmRefCon);
+    
+    NotificationIsDone = 1;
+    
+    SetA5(curA5);
+    
+}
+
+int 
+Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;
+    Tcl_Interp *interp;
+    int objc;
+    Tcl_Obj **objv;	
+{
+    Tcl_Obj *resultPtr;
+    
+    resultPtr = Tcl_GetObjResult(interp);
+    
+    if ( objc != 2 ) {
+        Tcl_WrongNumArgs(interp, 1, objv, "message");
+        return TCL_ERROR;
+    }
+    
+    TclMacDoNotification(Tcl_GetStringFromObj(objv[1], (int *) NULL));
+    return TCL_OK;
+           
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckmemCmd --
+ *
+ *	This is the command procedure for the "checkmem" command, which
+ *	causes the application to exit after printing information about
+ *	memory usage to the file passed to this command as its first
+ *	argument.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef TCL_MEM_DEBUG
+
+	/* ARGSUSED */
+static int
+CheckmemCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Interpreter for evaluation. */
+    int argc;				/* Number of arguments. */
+    char *argv[];			/* String values of arguments. */
+{
+    extern char *tclMemDumpFileName;
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" fileName\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    strcpy(dumpFile, argv[1]);
+    tclMemDumpFileName = dumpFile;
+    quitFlag = 1;
+    return TCL_OK;
+}
+#endif
diff --git a/tcl/mac/tclMacChan.c b/tcl/mac/tclMacChan.c
new file mode 100644
index 00000000000..ffb91c73d94
--- /dev/null
+++ b/tcl/mac/tclMacChan.c
@@ -0,0 +1,1356 @@
+/* 
+ * tclMacChan.c
+ *
+ *	Channel drivers for Macintosh channels for the
+ *	console fds.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMacInt.h"
+#include <Aliases.h>
+#include <Errors.h>
+#include <Files.h>
+#include <Gestalt.h>
+#include <Processes.h>
+#include <Strings.h>
+#include <FSpCompat.h>
+#include <MoreFiles.h>
+#include <MoreFilesExtras.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * The following are flags returned by GetOpenMode.  They
+ * are or'd together to determine how opening and handling
+ * a file should occur.
+ */
+
+#define TCL_RDONLY		(1<<0)
+#define TCL_WRONLY		(1<<1)
+#define TCL_RDWR		(1<<2)
+#define TCL_CREAT		(1<<3)
+#define TCL_TRUNC		(1<<4)
+#define TCL_APPEND		(1<<5)
+#define TCL_ALWAYS_APPEND	(1<<6)
+#define TCL_EXCL		(1<<7)
+#define TCL_NOCTTY		(1<<8)
+#define TCL_NONBLOCK		(1<<9)
+#define TCL_RW_MODES 		(TCL_RDONLY|TCL_WRONLY|TCL_RDWR)
+
+/*
+ * This structure describes per-instance state of a 
+ * macintosh file based channel.
+ */
+
+typedef struct FileState {
+    short fileRef;		/* Macintosh file reference number. */
+    Tcl_Channel fileChan;	/* Pointer to the channel for this file. */
+    int watchMask;		/* OR'ed set of flags indicating which events
+    				 * are being watched. */
+    int appendMode;		/* Flag to tell if in O_APPEND mode or not. */
+    int volumeRef;		/* Flag to tell if in O_APPEND mode or not. */
+    int pending;		/* 1 if message is pending on queue. */
+    struct FileState *nextPtr;	/* Pointer to next registered file. */
+} FileState;
+
+/*
+ * The following pointer refers to the head of the list of files managed
+ * that are being watched for file events.
+ */
+
+static FileState *firstFilePtr;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file events are generated.
+ */
+
+typedef struct FileEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    FileState *infoPtr;		/* Pointer to file info structure.  Note
+				 * that we still have to verify that the
+				 * file exists before dereferencing this
+				 * pointer. */
+} FileEvent;
+
+
+/*
+ * Static routines for this file:
+ */
+
+static int		CommonGetHandle _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static void		CommonWatch _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+static int		FileBlockMode _ANSI_ARGS_((ClientData instanceData,
+			    int mode));
+static void		FileChannelExitHandler _ANSI_ARGS_((
+		            ClientData clientData));
+static void		FileCheckProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		FileClose _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp));
+static int		FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+			    int flags));
+static void		FileInit _ANSI_ARGS_((void));
+static int		FileInput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toRead, int *errorCode));
+static int		FileOutput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toWrite, int *errorCode));
+static int		FileSeek _ANSI_ARGS_((ClientData instanceData,
+			    long offset, int mode, int *errorCode));
+static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *string));
+static Tcl_Channel	OpenFileChannel _ANSI_ARGS_((char *fileName, int mode, 
+			    int permissions, int *errorCodePtr));
+static int		StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
+			    int mode));
+static int		StdIOClose _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp));
+static int		StdIOInput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toRead, int *errorCode));
+static int		StdIOOutput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toWrite, int *errorCode));
+static int		StdIOSeek _ANSI_ARGS_((ClientData instanceData,
+			    long offset, int mode, int *errorCode));
+static int		StdReady _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+    "file",			/* Type name. */
+    StdIOBlockMode,		/* Set blocking/nonblocking mode.*/
+    StdIOClose,			/* Close proc. */
+    StdIOInput,			/* Input proc. */
+    StdIOOutput,		/* Output proc. */
+    StdIOSeek,			/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    CommonWatch,		/* Initialize notifier. */
+    CommonGetHandle		/* Get OS handles out of channel. */
+};
+
+/*
+ * This variable describes the channel type structure for file based IO.
+ */
+
+static Tcl_ChannelType fileChannelType = {
+    "file",			/* Type name. */
+    FileBlockMode,		/* Set blocking or
+                                 * non-blocking mode.*/
+    FileClose,			/* Close proc. */
+    FileInput,			/* Input proc. */
+    FileOutput,			/* Output proc. */
+    FileSeek,			/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    CommonWatch,		/* Initialize notifier. */
+    CommonGetHandle		/* Get OS handles out of channel. */
+};
+
+
+/*
+ * Hack to allow Mac Tk to override the TclGetStdChannels function.
+ */
+ 
+typedef void (*TclGetStdChannelsProc) _ANSI_ARGS_((Tcl_Channel *stdinPtr,
+	Tcl_Channel *stdoutPtr, Tcl_Channel *stderrPtr));
+	
+TclGetStdChannelsProc getStdChannelsProc = NULL;
+
+/*
+ * Static variables to hold channels for stdin, stdout and stderr.
+ */
+
+static Tcl_Channel stdinChannel = NULL;
+static Tcl_Channel stdoutChannel = NULL;
+static Tcl_Channel stderrChannel = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInit --
+ *
+ *	This function initializes the file channel event source.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileInit()
+{
+    initialized = 1;
+    firstFilePtr = NULL;
+    Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+    Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileChannelExitHandler --
+ *
+ *	This function is called to cleanup the channel driver before
+ *	Tcl is unloaded.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Destroys the communication window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileChannelExitHandler(
+    ClientData clientData)	/* Old window proc */
+{
+    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSetupProc --
+ *
+ *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ *	for an event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FileSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    FileState *infoPtr;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Check to see if there is a ready file.  If so, poll.
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->watchMask) {
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCheckProc --
+ *
+ *	This procedure is called by Tcl_DoOneEvent to check the file
+ *	event source for events. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    FileEvent *evPtr;
+    FileState *infoPtr;
+    int sentMsg = 0;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Queue events for any ready files that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->watchMask && !infoPtr->pending) {
+	    infoPtr->pending = 1;
+	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
+	    evPtr->header.proc = FileEventProc;
+	    evPtr->infoPtr = infoPtr;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * FileEventProc --
+ *
+ *	This function is invoked by Tcl_ServiceEvent when a file event
+ *	reaches the front of the event queue.  This procedure invokes
+ *	Tcl_NotifyChannel on the file.
+ *
+ * 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 notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    FileEvent *fileEvPtr = (FileEvent *)evPtr;
+    FileState *infoPtr;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Search through the list of watched files for the one whose handle
+     * matches the event.  We do this rather than simply dereferencing
+     * the handle in the event so that files can be deleted while the
+     * event is in the queue.
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (fileEvPtr->infoPtr == infoPtr) {
+	    infoPtr->pending = 0;
+	    Tcl_NotifyChannel(infoPtr->fileChan, infoPtr->watchMask);
+	    break;
+	}
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOBlockMode --
+ *
+ *	Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOBlockMode(
+    ClientData instanceData,		/* Unused. */
+    int mode)				/* The mode to set. */
+{
+    /*
+     * Do not allow putting stdin, stdout or stderr into nonblocking mode.
+     */
+    
+    if (mode == TCL_MODE_NONBLOCKING) {
+	return EFAULT;
+    }
+    
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOClose --
+ *
+ *	Closes the IO channel.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the physical channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOClose(
+    ClientData instanceData,	/* Unused. */
+    Tcl_Interp *interp)		/* Unused. */
+{
+    int fd, errorCode = 0;
+
+    /*
+     * Invalidate the stdio cache if necessary.  Note that we assume that
+     * the stdio file and channel pointers will become invalid at the same
+     * time.
+     */
+
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    if (fd == 0) {
+	fd = 0;
+	stdinChannel = NULL;
+    } else if (fd == 1) {
+	stdoutChannel = NULL;
+    } else if (fd == 2) {
+	stderrChannel = NULL;
+    } else {
+	panic("recieved invalid std file");
+    }
+
+    if (close(fd) < 0) {
+	errorCode = errno;
+    }
+
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommonGetHandle --
+ *
+ *	Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ *	a file based channel.
+ *
+ * Results:
+ *	The appropriate handle or NULL if not present. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CommonGetHandle(
+    ClientData instanceData,		/* The file state. */
+    int direction,			/* Which handle to retrieve? */
+    ClientData *handlePtr)
+{
+    if ((direction == TCL_READABLE) || (direction == TCL_WRITABLE)) {
+	*handlePtr = (ClientData) ((FileState*)instanceData)->fileRef;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOInput --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+StdIOInput(
+    ClientData instanceData,		/* Unused. */
+    char *buf,				/* Where to store data read. */
+    int bufSize,			/* How much space is available
+                                         * in the buffer? */
+    int *errorCode)			/* Where to store error code. */
+{
+    int fd;
+    int bytesRead;			/* How many bytes were read? */
+
+    *errorCode = 0;
+    errno = 0;
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    bytesRead = read(fd, buf, (size_t) bufSize);
+    if (bytesRead > -1) {
+        return bytesRead;
+    }
+    *errorCode = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOOutput--
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOOutput(
+    ClientData instanceData,		/* Unused. */
+    char *buf,				/* The data buffer. */
+    int toWrite,			/* How many bytes to write? */
+    int *errorCode)			/* Where to store error code. */
+{
+    int written;
+    int fd;
+
+    *errorCode = 0;
+    errno = 0;
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    written = write(fd, buf, (size_t) toWrite);
+    if (written > -1) {
+        return written;
+    }
+    *errorCode = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOSeek --
+ *
+ *	Seeks on an IO channel. Returns the new position.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. If failed, it
+ *	also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOSeek(
+    ClientData instanceData,			/* Unused. */
+    long offset,				/* Offset to seek to. */
+    int mode,					/* Relative to where
+                                                 * should we seek? */
+    int *errorCodePtr)				/* To store error code. */
+{
+    int newLoc;
+    int fd;
+
+    *errorCodePtr = 0;
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    newLoc = lseek(fd, offset, mode);
+    if (newLoc > -1) {
+        return newLoc;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PidObjCmd --
+ *
+ *      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_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. */
+{
+    ProcessSerialNumber psn;
+    char buf[20]; 
+    Tcl_Channel chan;
+    Tcl_Obj *resultPtr;
+
+    if (objc > 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
+        return TCL_ERROR;
+    }
+    if (objc == 1) {
+        resultPtr = Tcl_GetObjResult(interp);
+	GetCurrentProcess(&psn);
+	sprintf(buf, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
+        Tcl_SetStringObj(resultPtr, buf, -1);
+    } else {
+        chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+                NULL);
+        if (chan == (Tcl_Channel) NULL) {
+            return TCL_ERROR;
+        } 
+	/*
+	 * We can't create pipelines on the Mac so
+	 * this will always return an empty list.
+	 */
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetDefaultStdChannel --
+ *
+ *	Constructs a channel for the specified standard OS handle.
+ *
+ * Results:
+ *	Returns the specified default standard channel, or NULL.
+ *
+ * Side effects:
+ *	May cause the creation of a standard channel and the underlying
+ *	file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclGetDefaultStdChannel(
+    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    Tcl_Channel channel = NULL;
+    int fd = 0;			/* Initializations needed to prevent */
+    int mode = 0;		/* compiler warning (used before set). */
+    char *bufMode = NULL;
+    char channelName[20];
+    int channelPermissions;
+    FileState *fileState;
+
+    /*
+     * If the channels were not created yet, create them now and
+     * store them in the static variables.
+     */
+
+    switch (type) {
+	case TCL_STDIN:
+	    fd = 0;
+	    channelPermissions = TCL_READABLE;
+	    bufMode = "line";
+	    break;
+	case TCL_STDOUT:
+	    fd = 1;
+	    channelPermissions = TCL_WRITABLE;
+	    bufMode = "line";
+	    break;
+	case TCL_STDERR:
+	    fd = 2;
+	    channelPermissions = TCL_WRITABLE;
+	    bufMode = "none";
+	    break;
+	default:
+	    panic("TclGetDefaultStdChannel: Unexpected channel type");
+	    break;
+    }
+
+    sprintf(channelName, "console%d", (int) fd);
+    fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
+    channel = Tcl_CreateChannel(&consoleChannelType, channelName,
+	    (ClientData) fileState, channelPermissions);
+    fileState->fileChan = channel;
+    fileState->fileRef = fd;
+
+    /*
+     * Set up the normal channel options for stdio handles.
+     */
+
+    Tcl_SetChannelOption(NULL, channel, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
+    
+    return channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFileChannel --
+ *
+ *	Open an File based channel on Unix systems.
+ *
+ * Results:
+ *	The new channel or NULL. If NULL, the output argument
+ *	errorCodePtr is set to a POSIX error.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the
+ *	file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpOpenFileChannel(
+    Tcl_Interp *interp,			/* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName,			/* Name of file to open. */
+    char *modeString,			/* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions)			/* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    Tcl_Channel chan;
+    int mode;
+    char *nativeName;
+    Tcl_DString buffer;
+    int errorCode;
+    
+    mode = GetOpenMode(interp, modeString);
+    if (mode == -1) {
+	return NULL;
+    }
+
+    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+    if (nativeName == NULL) {
+	return NULL;
+    }
+
+    chan = OpenFileChannel(nativeName, mode, permissions, &errorCode);
+    Tcl_DStringFree(&buffer);
+
+    if (chan == NULL) {
+	Tcl_SetErrno(errorCode);
+	if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+                    Tcl_PosixError(interp), (char *) NULL);
+        }
+	return NULL;
+    }
+    
+    return chan;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenFileChannel--
+ *
+ *	Opens a Macintosh file and creates a Tcl channel to control it.
+ *
+ * Results:
+ *	A Tcl channel.
+ *
+ * Side effects:
+ *	Will open a Macintosh file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+OpenFileChannel(
+    char *fileName,			/* Name of file to open. */
+    int mode,				/* Mode for opening file. */
+    int permissions,			/* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    int channelPermissions;
+    Tcl_Channel chan;
+    char macPermision;
+    FSSpec fileSpec;
+    OSErr err;
+    short fileRef;
+    FileState *fileState;
+    char channelName[64];
+    
+    /*
+     * Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
+     * writes on a file.  This isn't common on a mac but is common with 
+     * Windows and UNIX and the feature is used by Tcl.
+     */
+
+    switch (mode & (TCL_RDONLY | TCL_WRONLY | TCL_RDWR)) {
+	case TCL_RDWR:
+	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+	    macPermision = fsRdWrShPerm;
+	    break;
+	case TCL_WRONLY:
+	    /*
+	     * Mac's fsRdPerm permission actually defaults to fsRdWrPerm because
+	     * the Mac OS doesn't realy support write only access.  We explicitly
+	     * set the permission fsRdWrShPerm so that we can have shared write
+	     * access.
+	     */
+	    channelPermissions = TCL_WRITABLE;
+	    macPermision = fsRdWrShPerm;
+	    break;
+	case TCL_RDONLY:
+	default:
+	    channelPermissions = TCL_READABLE;
+	    macPermision = fsRdPerm;
+	    break;
+    }
+     
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    if ((err != noErr) && (err != fnfErr)) {
+	*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	Tcl_SetErrno(errno);
+	return NULL;
+    }
+
+    if ((err == fnfErr) && (mode & TCL_CREAT)) {
+	err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, 'MPW ', 'TEXT');
+	if (err != noErr) {
+	    *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	    Tcl_SetErrno(errno);
+	    return NULL;
+	}
+    } else if ((mode & TCL_CREAT) && (mode & TCL_EXCL)) {
+        *errorCodePtr = errno = EEXIST;
+	Tcl_SetErrno(errno);
+        return NULL;
+    }
+
+    err = HOpenDF(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, macPermision, &fileRef);
+    if (err != noErr) {
+	*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	Tcl_SetErrno(errno);
+	return NULL;
+    }
+
+    if (mode & TCL_TRUNC) {
+	SetEOF(fileRef, 0);
+    }
+    
+    sprintf(channelName, "file%d", (int) fileRef);
+    fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
+    chan = Tcl_CreateChannel(&fileChannelType, channelName, 
+	(ClientData) fileState, channelPermissions);
+    if (chan == (Tcl_Channel) NULL) {
+	*errorCodePtr = errno = EFAULT;
+	Tcl_SetErrno(errno);
+	FSClose(fileRef);
+	ckfree((char *) fileState);
+        return NULL;
+    }
+
+    fileState->fileChan = chan;
+    fileState->volumeRef = fileSpec.vRefNum;
+    fileState->fileRef = fileRef;
+    fileState->pending = 0;
+    fileState->watchMask = 0;
+    if (mode & TCL_ALWAYS_APPEND) {
+	fileState->appendMode = true;
+    } else {
+	fileState->appendMode = false;
+    }
+        
+    if ((mode & TCL_ALWAYS_APPEND) || (mode & TCL_APPEND)) {
+        if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
+	    *errorCodePtr = errno = EFAULT;
+	    Tcl_SetErrno(errno);
+            Tcl_Close(NULL, chan);
+            FSClose(fileRef);
+            ckfree((char *) fileState);
+            return NULL;
+        }
+    }
+    
+    return chan;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockMode --
+ *
+ *	Set blocking or non-blocking mode on channel.  Macintosh files
+ *	can never really be set to blocking or non-blocking modes.
+ *	However, we don't generate an error - we just return success.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileBlockMode(
+    ClientData instanceData,		/* Unused. */
+    int mode)				/* The mode to set. */
+{
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileClose --
+ *
+ *	Closes the IO channel.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the physical channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileClose(
+    ClientData instanceData,	/* Unused. */
+    Tcl_Interp *interp)		/* Unused. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    int errorCode = 0;
+    OSErr err;
+
+    err = FSClose(fileState->fileRef);
+    FlushVol(NULL, fileState->volumeRef);
+    if (err != noErr) {
+	errorCode = errno = TclMacOSErrorToPosixError(err);
+	panic("error during file close");
+    }
+
+    ckfree((char *) fileState);
+    Tcl_SetErrno(errorCode);
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInput --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+FileInput(
+    ClientData instanceData,	/* Unused. */
+    char *buffer,				/* Where to store data read. */
+    int bufSize,				/* How much space is available
+                                 * in the buffer? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    OSErr err;
+    long length = bufSize;
+
+    *errorCodePtr = 0;
+    errno = 0;
+    err = FSRead(fileState->fileRef, &length, buffer);
+    if ((err == noErr) || (err == eofErr)) {
+	return length;
+    } else {
+	switch (err) {
+	    case ioErr:
+		*errorCodePtr = errno = EIO;
+	    case afpAccessDenied:
+		*errorCodePtr = errno = EACCES;
+	    default:
+		*errorCodePtr = errno = EINVAL;
+	}
+        return -1;	
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileOutput--
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileOutput(
+    ClientData instanceData,		/* Unused. */
+    char *buffer,			/* The data buffer. */
+    int toWrite,			/* How many bytes to write? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    long length = toWrite;
+    OSErr err;
+
+    *errorCodePtr = 0;
+    errno = 0;
+    
+    if (fileState->appendMode == true) {
+	FileSeek(instanceData, 0, SEEK_END, errorCodePtr);
+	*errorCodePtr = 0;
+    }
+    
+    err = FSWrite(fileState->fileRef, &length, buffer);
+    if (err == noErr) {
+	err = FlushFile(fileState->fileRef);
+    } else {
+	*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	return -1;
+    }
+    return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeek --
+ *
+ *	Seeks on an IO channel. Returns the new position.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. If failed, it
+ *	also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileSeek(
+    ClientData instanceData,	/* Unused. */
+    long offset,				/* Offset to seek to. */
+    int mode,					/* Relative to where
+                                 * should we seek? */
+    int *errorCodePtr)			/* To store error code. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    IOParam pb;
+    OSErr err;
+
+    *errorCodePtr = 0;
+    pb.ioCompletion = NULL;
+    pb.ioRefNum = fileState->fileRef;
+    if (mode == SEEK_SET) {
+	pb.ioPosMode = fsFromStart;
+    } else if (mode == SEEK_END) {
+	pb.ioPosMode = fsFromLEOF;
+    } else if (mode == SEEK_CUR) {
+	err = PBGetFPosSync((ParmBlkPtr) &pb);
+	if (pb.ioResult == noErr) {
+	    if (offset == 0) {
+		return pb.ioPosOffset;
+	    }
+	    offset += pb.ioPosOffset;
+	}
+	pb.ioPosMode = fsFromStart;
+    }
+    pb.ioPosOffset = offset;
+    err = PBSetFPosSync((ParmBlkPtr) &pb);
+    if (pb.ioResult == noErr){
+	return pb.ioPosOffset;
+    } else if (pb.ioResult == eofErr) {
+	long currentEOF, newEOF;
+	long buffer, i, length;
+	
+	err = PBGetEOFSync((ParmBlkPtr) &pb);
+	currentEOF = (long) pb.ioMisc;
+	if (mode == SEEK_SET) {
+	    newEOF = offset;
+	} else if (mode == SEEK_END) {
+	    newEOF = offset + currentEOF;
+	} else if (mode == SEEK_CUR) {
+	    err = PBGetFPosSync((ParmBlkPtr) &pb);
+	    newEOF = offset + pb.ioPosOffset;
+	}
+	
+	/*
+	 * Write 0's to the new EOF.
+	 */
+	pb.ioPosOffset = 0;
+	pb.ioPosMode = fsFromLEOF;
+	err = PBGetFPosSync((ParmBlkPtr) &pb);
+	length = 1;
+	buffer = 0;
+	for (i = 0; i < (newEOF - currentEOF); i++) {
+	    err = FSWrite(fileState->fileRef, &length, &buffer);
+	}
+	err = PBGetFPosSync((ParmBlkPtr) &pb);
+	if (pb.ioResult == noErr){
+	    return pb.ioPosOffset;
+	}
+    }
+    *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommonWatch --
+ *
+ *	Initialize the notifier to watch handles from this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CommonWatch(
+    ClientData instanceData,		/* The file state. */
+    int mask)				/* Events of interest; an OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+    FileState **nextPtrPtr, *ptr;
+    FileState *infoPtr = (FileState *) instanceData;
+    int oldMask = infoPtr->watchMask;
+
+    if (!initialized) {
+	FileInit();
+    }
+
+    infoPtr->watchMask = mask;
+    if (infoPtr->watchMask) {
+	if (!oldMask) {
+	    infoPtr->nextPtr = firstFilePtr;
+	    firstFilePtr = infoPtr;
+	}
+    } else {
+	if (oldMask) {
+	    /*
+	     * Remove the file from the list of watched files.
+	     */
+
+	    for (nextPtrPtr = &firstFilePtr, ptr = *nextPtrPtr;
+		 ptr != NULL;
+		 nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+		if (infoPtr == ptr) {
+		    *nextPtrPtr = ptr->nextPtr;
+		    break;
+		}
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOpenMode --
+ *
+ * Description:
+ *	Computes a POSIX mode mask from a given string and also sets
+ *	a flag to indicate whether the caller should seek to EOF during
+ *	opening of the file.
+ *
+ * Results:
+ *	On success, returns mode to pass to "open". If an error occurs, the
+ *	returns -1 and if interp is not NULL, sets interp->result to an
+ *	error message.
+ *
+ * Side effects:
+ *	Sets the integer referenced by seekFlagPtr to 1 if the caller
+ *	should seek to EOF during opening the file.
+ *
+ * Special note:
+ *	This code is based on a prototype implementation contributed
+ *	by Mark Diekhans.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetOpenMode(
+    Tcl_Interp *interp,			/* Interpreter to use for error
+					 * reporting - may be NULL. */
+    char *string)			/* Mode string, e.g. "r+" or
+					 * "RDONLY CREAT". */
+{
+    int mode, modeArgc, c, i, gotRW;
+    char **modeArgv, *flag;
+
+    /*
+     * Check for the simpler fopen-like access modes (e.g. "r").  They
+     * are distinguished from the POSIX access modes by the presence
+     * of a lower-case first letter.
+     */
+
+    mode = 0;
+    if (islower(UCHAR(string[0]))) {
+	switch (string[0]) {
+	    case 'r':
+		mode = TCL_RDONLY;
+		break;
+	    case 'w':
+		mode = TCL_WRONLY|TCL_CREAT|TCL_TRUNC;
+		break;
+	    case 'a':
+		mode = TCL_WRONLY|TCL_CREAT|TCL_APPEND;
+		break;
+	    default:
+		error:
+                if (interp != (Tcl_Interp *) NULL) {
+                    Tcl_AppendResult(interp,
+                            "illegal access mode \"", string, "\"",
+                            (char *) NULL);
+                }
+		return -1;
+	}
+	if (string[1] == '+') {
+	    mode &= ~(TCL_RDONLY|TCL_WRONLY);
+	    mode |= TCL_RDWR;
+	    if (string[2] != 0) {
+		goto error;
+	    }
+	} else if (string[1] != 0) {
+	    goto error;
+	}
+        return mode;
+    }
+
+    /*
+     * The access modes are specified using a list of POSIX modes
+     * such as TCL_CREAT.
+     */
+
+    if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AddErrorInfo(interp,
+                    "\n    while processing open access modes \"");
+            Tcl_AddErrorInfo(interp, string);
+            Tcl_AddErrorInfo(interp, "\"");
+        }
+        return -1;
+    }
+    
+    gotRW = 0;
+    for (i = 0; i < modeArgc; i++) {
+	flag = modeArgv[i];
+	c = flag[0];
+	if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
+	    mode = (mode & ~TCL_RW_MODES) | TCL_RDONLY;
+	    gotRW = 1;
+	} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
+	    mode = (mode & ~TCL_RW_MODES) | TCL_WRONLY;
+	    gotRW = 1;
+	} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
+	    mode = (mode & ~TCL_RW_MODES) | TCL_RDWR;
+	    gotRW = 1;
+	} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
+	    mode |= TCL_ALWAYS_APPEND;
+	} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
+	    mode |= TCL_CREAT;
+	} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
+	    mode |= TCL_EXCL;
+	} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
+	    mode |= TCL_NOCTTY;
+	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
+	    mode |= TCL_NONBLOCK;
+	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
+	    mode |= TCL_TRUNC;
+	} else {
+            if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "invalid access mode \"", flag,
+                        "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
+                        " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
+            }
+	    ckfree((char *) modeArgv);
+	    return -1;
+	}
+    }
+    ckfree((char *) modeArgv);
+    if (!gotRW) {
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "access mode must include either",
+                    " RDONLY, WRONLY, or RDWR", (char *) NULL);
+        }
+	return -1;
+    }
+    return mode;
+}
diff --git a/tcl/mac/tclMacCommonPch.h b/tcl/mac/tclMacCommonPch.h
new file mode 100644
index 00000000000..5f599ddabb0
--- /dev/null
+++ b/tcl/mac/tclMacCommonPch.h
@@ -0,0 +1,88 @@
+/*
+ * tclMacCommonPch.h --
+ *
+ * 	Macintosh Tcl must be compiled with certain compiler options to
+ *	ensure that it will work correctly. The following pragmas are
+ *	used to ensure that those options are set correctly. An error
+ * 	will occur at compile time if they are not set correctly.
+ *
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#if !__option(enumsalwaysint)
+#error Tcl requires the Metrowerks setting "Enums always ints".
+#endif
+
+
+#if !defined(__POWERPC__)
+#if !__option(far_data)
+#error Tcl requires the Metrowerks setting "Far data".
+#endif
+#endif
+
+
+#if !defined(__POWERPC__)
+#if !__option(fourbyteints)
+#error Tcl requires the Metrowerks setting "4 byte ints".
+#endif
+#endif
+
+
+#if !defined(__POWERPC__)
+#if !__option(IEEEdoubles)
+#error Tcl requires the Metrowerks setting "8 byte doubles".
+#endif
+#endif
+
+
+/*
+* The define is used most everywhere to tell Tcl (or any Tcl
+* extensions) that we are compiling for the Macintosh platform.
+*/
+
+
+#define MAC_TCL
+
+
+/*
+* The following defines control the behavior of the Macintosh
+* Universial Headers.
+*/
+
+
+#define SystemSevenOrLater 1
+#define STRICT_CONTROLS 1
+#define STRICT_WINDOWS 1
+
+
+/*
+* Define the following symbol if you want
+* comprehensive debugging turned on.
+*/
+
+
+/* #define TCL_DEBUG */
+
+
+#ifdef TCL_DEBUG
+# define TCL_MEM_DEBUG
+# define TCL_TEST
+#endif
+
+
+
+/*
+* For a while, we will continue to use the old routine names, so that
+* people with older versions of CodeWarrior will still be able to compile
+* the source (albeit they will have to update the project files themselves).
+*
+* At some point, we will convert over to the new routine names.
+*/
+
+
+#define OLDROUTINENAMES 1
diff --git a/tcl/mac/tclMacDNR.c b/tcl/mac/tclMacDNR.c
new file mode 100644
index 00000000000..1425bd224c4
--- /dev/null
+++ b/tcl/mac/tclMacDNR.c
@@ -0,0 +1,23 @@
+/* 
+ * tclMacDNR.c
+ *
+ *	This file actually just includes the file "dnr.c" provided by
+ *	Apple Computer and redistributed by MetroWerks (and other compiler
+ *	vendors.)  Unfortunantly, despite various bug reports, dnr.c uses
+ *	C++ style comments and will not compile under the "ANSI Strict"
+ *	mode that the rest of Tcl compiles under.  Furthermore, the Apple
+ *	license prohibits me from redistributing a corrected version of
+ *	dnr.c.  This file uses a pragma to turn off the Strict ANSI option
+ *	and then includes the dnr.c file.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#pragma ANSI_strict off
+#include <dnr.c>
+#pragma ANSI_strict reset
diff --git a/tcl/mac/tclMacEnv.c b/tcl/mac/tclMacEnv.c
new file mode 100644
index 00000000000..30c159a33e8
--- /dev/null
+++ b/tcl/mac/tclMacEnv.c
@@ -0,0 +1,536 @@
+/* 
+ * tclMacEnv.c --
+ *
+ *	Implements the "environment" on a Macintosh.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Gestalt.h>
+#include <Folders.h>
+#include <TextUtils.h>
+#include <Resources.h>
+#include <string.h>
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclMacInt.h"
+#include "tclPort.h"
+
+#define kMaxEnvStringSize 	255
+#define kMaxEnvVarSize 		100
+#define kLoginnameTag 		"LOGIN="
+#define kUsernameTag 		"USER="
+#define kDefaultDirTag 		"HOME="
+
+/* 
+ * The following specifies a text file where additional environment variables 
+ * can be set.  The file must reside in the preferences folder.  If the file 
+ * doesn't exist NO error will occur.  Commet out the difinition if you do 
+ * NOT want to use an environment variables file. 
+ */
+#define kPrefsFile	 		"Tcl Environment Variables"
+
+/* 
+ * The following specifies the Name of a 'STR#' resource in the application 
+ * where additional environment variables may be set.  If the resource doesn't
+ * exist no errors will occur.  Commet it out if you don't want it.
+ */
+#define REZ_ENV "\pTcl Environment Variables"
+
+/* Globals */
+char **environ = NULL;
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+static char ** RezRCVariables _ANSI_ARGS_((void));
+static char ** FileRCVariables _ANSI_ARGS_((void));
+static char ** PathVariables _ANSI_ARGS_((void));
+static char ** SystemVariables _ANSI_ARGS_((void));
+static char * MakeFolderEnvVar _ANSI_ARGS_((char * prefixTag,
+	long whichFolder));
+static char * GetUserName _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RezRCVariables --
+ *
+ *  Creates environment variables from the applications resource fork.
+ *  The function looks for the 'STR#' resource with the name defined
+ *  in the #define REZ_ENV.  If the define is not defined this code
+ *  will not be included.  If the resource doesn't exist or no strings
+ *  reside in the resource nothing will happen.
+ *
+ * Results:
+ *	ptr to value on success, NULL if error.
+ *
+ * Side effects:
+ *	Memory is allocated and returned to the caller.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef REZ_ENV
+static char ** 
+RezRCVariables()
+{
+    Handle envStrs = NULL;
+    char** rezEnv = NULL;
+    short int numStrs;
+
+    envStrs = GetNamedResource('STR#', REZ_ENV);
+    if (envStrs == NULL) return NULL;
+    numStrs = *((short *) (*envStrs));
+	
+    rezEnv = (char **) ckalloc((numStrs + 1) * sizeof(char *));
+
+    if (envStrs != NULL) {
+	ResType	theType;
+	Str255 theName;
+	short theID, index = 1;
+	int i = 0;
+	char* string;
+	
+	GetResInfo(envStrs, &theID, &theType, theName);
+	for(;;) {
+	    GetIndString(theName, theID, index++);
+	    if (theName[0] == '\0') break;
+	    string = (char *) ckalloc(theName[0] + 2);
+	    strncpy(string, (char *) theName + 1, theName[0]);
+	    string[theName[0]] = '\0';
+	    rezEnv[i++] = string;
+	}
+	ReleaseResource(envStrs);
+		
+	rezEnv[i] = NULL;
+	return rezEnv;
+    }
+	
+    return NULL;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileRCVariables --
+ *
+ *  Creates environment variables from a file in the system preferences
+ *  folder.  The function looks for a file in the preferences folder 
+ *  a name defined in the #define kPrefsFile.  If the define is not 
+ *  defined this code will not be included.  If the resource doesn't exist or
+ *  no strings reside in the resource nothing will happen.
+ *
+ * Results:
+ *	ptr to value on success, NULL if error.
+ *
+ * Side effects:
+ *	Memory is allocated and returned to the caller.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef kPrefsFile
+static char ** 
+FileRCVariables()
+{
+    char *prefsFolder = NULL;
+    char *tempPtr = NULL;
+    char **fileEnv = NULL;
+    FILE *thePrefsFile = NULL;
+    int	i;
+    FSSpec prefDir;
+    OSErr err;
+    Handle theString = NULL;
+    Tcl_Channel chan;
+    int size;
+    Tcl_DString lineRead;
+	
+    err = FSpFindFolder(kOnSystemDisk, kPreferencesFolderType, 
+	    kDontCreateFolder, &prefDir);
+    if (err != noErr) {
+	return NULL;
+    }
+    err = FSpPathFromLocation(&prefDir, &size, &theString);
+    if (err != noErr) {
+	return NULL;
+    }
+    (void) Munger(theString, size, NULL, 0, kPrefsFile, strlen(kPrefsFile));
+
+    HLock(theString);
+    chan = Tcl_OpenFileChannel(NULL, *theString, "r", 0);
+    HUnlock(theString);
+    DisposeHandle(theString);
+    if (chan == NULL) {
+	return NULL;
+    }
+
+    /*
+     * We found a env file.  Let start parsing it.
+     */
+    fileEnv = (char **) ckalloc((kMaxEnvVarSize + 1) * sizeof(char *));
+
+    i = 0;
+    Tcl_DStringInit(&lineRead);
+    while (Tcl_Gets(chan, &lineRead) != -1) {
+	/*
+	 * First strip off new line char
+	 */
+	if (lineRead.string[lineRead.length-1] == '\n') {
+	    lineRead.string[lineRead.length-1] = '\0';
+	}
+	if (lineRead.string[0] == '\0' || lineRead.string[0] == '#') {
+	    /*
+	     * skip empty lines or commented lines
+	     */
+	    Tcl_DStringSetLength(&lineRead, 0);
+	    continue;
+	}
+		
+	tempPtr = (char *) ckalloc(lineRead.length + 1);
+	strcpy(tempPtr, lineRead.string);
+	fileEnv[i++] = tempPtr;
+	Tcl_DStringSetLength(&lineRead, 0);
+    }
+	
+    fileEnv[i] = NULL;
+    Tcl_Close(NULL, chan);
+    Tcl_DStringFree(&lineRead);
+	
+    return fileEnv;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeFolderEnvVar --
+ *
+ *	This function creates "environment" variable by taking a prefix and
+ *	appending a folder path to a directory.  The directory is specified
+ *	by a integer value acceptable by the FindFolder function.
+ *
+ * Results:
+ *	The function returns an *allocated* string.  If the folder doesn't
+ *	exist the return string is still allocated and just contains the
+ *	given prefix.
+ *
+ * Side effects:
+ *	Memory is allocated and returned to the caller.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char * 
+MakeFolderEnvVar(
+    char * prefixTag,		/* Prefix added before result. */
+    long whichFolder)		/* Constant for FSpFindFolder. */
+{
+    char * thePath = NULL;
+    char * result = NULL;
+    OSErr theErr = noErr;
+    Handle theString = NULL;
+    FSSpec theFolder;
+    int size;
+    Tcl_DString pathStr;
+    Tcl_DString tagPathStr;
+    
+    Tcl_DStringInit(&pathStr);
+    theErr = FSpFindFolder(kOnSystemDisk, whichFolder, 
+	    kDontCreateFolder, &theFolder);
+    if (theErr == noErr) {
+	theErr = FSpPathFromLocation(&theFolder, &size, &theString);
+		
+	HLock(theString);
+	tclPlatform = TCL_PLATFORM_MAC;
+	Tcl_DStringAppend(&pathStr, *theString, -1);
+	HUnlock(theString);
+	DisposeHandle(theString);
+		
+	Tcl_DStringInit(&tagPathStr);
+	Tcl_DStringAppend(&tagPathStr, prefixTag, strlen(prefixTag));
+	Tcl_DStringAppend(&tagPathStr, pathStr.string, pathStr.length);
+	Tcl_DStringFree(&pathStr);
+	
+	/*
+	 * Make sure the path ends with a ':'
+	 */
+	if (tagPathStr.string[tagPathStr.length - 1] != ':') {
+	    Tcl_DStringAppend(&tagPathStr, ":", 1);
+	}
+
+	/*
+	 * Don't free tagPathStr - rather make sure it's allocated
+	 * and return it as the result.
+	 */
+	if (tagPathStr.string == tagPathStr.staticSpace) {
+	    result = (char *) ckalloc(tagPathStr.length + 1);
+	    strcpy(result, tagPathStr.string);
+	} else {
+	    result = tagPathStr.string;
+	}
+    } else {
+	result = (char *) ckalloc(strlen(prefixTag) + 1);
+	strcpy(result, prefixTag);
+    }
+	
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathVariables --
+ *
+ *  Creates environment variables from the system call FSpFindFolder.
+ *  The function generates environment variables for many of the 
+ *  commonly used paths on the Macintosh.
+ *
+ * Results:
+ *	ptr to value on success, NULL if error.
+ *
+ * Side effects:
+ *	Memory is allocated and returned to the caller.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char ** 
+PathVariables()
+{
+    int i = 0;
+    char **sysEnv;
+    char *thePath = NULL;
+    
+    sysEnv = (char **) ckalloc((12) * sizeof(char *));
+
+    sysEnv[i++] = MakeFolderEnvVar("PREF_FOLDER=", kPreferencesFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("SYS_FOLDER=", kSystemFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("TEMP=", kTemporaryFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("APPLE_M_FOLDER=", kAppleMenuFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("CP_FOLDER=", kControlPanelFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("DESK_FOLDER=", kDesktopFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("EXT_FOLDER=", kExtensionFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("PRINT_MON_FOLDER=",
+	    kPrintMonitorDocsFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("SHARED_TRASH_FOLDER=",
+	    kWhereToEmptyTrashFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("TRASH_FOLDER=", kTrashFolderType);
+    sysEnv[i++] = MakeFolderEnvVar("START_UP_FOLDER=", kStartupFolderType);
+    sysEnv[i++] = NULL;
+	
+    return sysEnv;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SystemVariables --
+ *
+ *  Creates environment variables from various Mac system calls.
+ *
+ * Results:
+ *	ptr to value on success, NULL if error.
+ *
+ * Side effects:
+ *	Memory is allocated and returned to the caller.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char ** 
+SystemVariables()
+{
+    int i = 0;
+    char ** sysEnv;
+    char * thePath = NULL;
+    Handle theString = NULL;
+    FSSpec currentDir;
+    int size;
+    
+    sysEnv = (char **) ckalloc((4) * sizeof(char *));
+
+    /*
+     * Get user name from chooser.  It will be assigned to both
+     * the USER and LOGIN environment variables.
+     */
+    thePath = GetUserName();
+    if (thePath != NULL) {
+	sysEnv[i] = (char *) ckalloc(strlen(kLoginnameTag) + strlen(thePath) + 1);
+	strcpy(sysEnv[i], kLoginnameTag);
+	strcpy(sysEnv[i]+strlen(kLoginnameTag), thePath);
+	i++;
+	sysEnv[i] = (char *) ckalloc(strlen(kUsernameTag) + strlen(thePath) + 1);
+	strcpy(sysEnv[i], kUsernameTag);
+	strcpy(sysEnv[i]+strlen(kUsernameTag), thePath);
+	i++;
+    }
+
+    /*
+     * Get 'home' directory
+     */
+#ifdef kDefaultDirTag
+    FSpGetDefaultDir(&currentDir);
+    FSpPathFromLocation(&currentDir, &size, &theString);
+    HLock(theString);
+    sysEnv[i] = (char *) ckalloc(strlen(kDefaultDirTag) + size + 4);
+    strcpy(sysEnv[i], kDefaultDirTag);
+    strncpy(sysEnv[i]+strlen(kDefaultDirTag) , *theString, size);
+    if (sysEnv[i][strlen(kDefaultDirTag) + size - 1] != ':') {
+	sysEnv[i][strlen(kDefaultDirTag) + size] = ':';
+	sysEnv[i][strlen(kDefaultDirTag) + size + 1] = '\0';
+    } else {
+	sysEnv[i][strlen(kDefaultDirTag) + size] = '\0';
+    }
+    HUnlock(theString);
+    DisposeHandle(theString);
+    i++;
+#endif
+
+    sysEnv[i++] = NULL;
+    return sysEnv;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacCreateEnv --
+ *
+ *	This function allocates and populates the global "environ"
+ *	variable.  Entries are in traditional Unix format but variables
+ *	are, hopefully, a bit more relevant for the Macintosh.
+ *
+ * Results:
+ *	The number of elements in the newly created environ array.
+ *
+ * Side effects:
+ *	Memory is allocated and pointed too by the environ variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacCreateEnv()
+{
+    char ** sysEnv = NULL;
+    char ** pathEnv = NULL;
+    char ** fileEnv = NULL;
+    char ** rezEnv = NULL;
+    int count = 0;
+    int i, j;
+
+    sysEnv = SystemVariables();
+    if (sysEnv != NULL) {
+	for (i = 0; sysEnv[i] != NULL; count++, i++) {
+	    /* Empty Loop */
+	}
+    }
+
+    pathEnv = PathVariables();
+    if (pathEnv != NULL) {
+	for (i = 0; pathEnv[i] != NULL; count++, i++) {
+	    /* Empty Loop */
+	}
+    }
+
+#ifdef kPrefsFile
+    fileEnv = FileRCVariables();
+    if (fileEnv != NULL) {
+	for (i = 0; fileEnv[i] != NULL; count++, i++) {
+	    /* Empty Loop */
+	}
+    }
+#endif
+
+#ifdef REZ_ENV
+    rezEnv = RezRCVariables();
+    if (rezEnv != NULL) {
+	for (i = 0; rezEnv[i] != NULL; count++, i++) {
+	    /* Empty Loop */
+	}
+    }
+#endif
+
+    /*
+     * Create environ variable
+     */
+    environ = (char **) ckalloc((count + 1) * sizeof(char *));
+    j = 0;
+	
+    if (sysEnv != NULL) {
+	for (i = 0; sysEnv[i] != NULL;)
+	    environ[j++] = sysEnv[i++];
+	ckfree((char *) sysEnv);
+    }
+
+    if (pathEnv != NULL) {
+	for (i = 0; pathEnv[i] != NULL;)
+	    environ[j++] = pathEnv[i++];
+	ckfree((char *) pathEnv);
+    }
+
+#ifdef kPrefsFile
+    if (fileEnv != NULL) {
+	for (i = 0; fileEnv[i] != NULL;)
+	    environ[j++] = fileEnv[i++];
+	ckfree((char *) fileEnv);
+    }
+#endif
+
+#ifdef REZ_ENV
+    if (rezEnv != NULL) {
+	for (i = 0; rezEnv[i] != NULL;)
+	    environ[j++] = rezEnv[i++];
+	ckfree((char *) rezEnv);
+    }
+#endif
+
+    environ[j] = NULL;
+    return j;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetUserName --
+ *
+ *	Get the user login name.
+ *
+ * Results:
+ *  ptr to static string, NULL if error.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetUserName()
+{
+    static char buf[33];
+    short refnum;
+    Handle h;
+	
+    refnum = CurResFile();
+    UseResFile(0);
+    h = GetResource('STR ', -16096);
+    UseResFile(refnum);
+    if (h == NULL) {
+	return NULL;
+    }
+    
+    HLock(h);
+    strncpy(buf, (*h)+1, **h);
+    buf[**h] = '\0';
+    HUnlock(h);
+    ReleaseResource(h);
+    return(buf[0] ? buf : NULL);
+}
diff --git a/tcl/mac/tclMacExit.c b/tcl/mac/tclMacExit.c
new file mode 100644
index 00000000000..ef1b9d38435
--- /dev/null
+++ b/tcl/mac/tclMacExit.c
@@ -0,0 +1,333 @@
+/* 
+ * tclMacExit.c --
+ *
+ *	This file contains routines that deal with cleaning up various state
+ *	when Tcl/Tk applications quit.  Unfortunantly, not all state is cleaned
+ *	up by the process when an application quites or crashes.  Also you
+ *	need to do different things depending on wether you are running as
+ *	68k code, PowerPC, or a code resource.  The Exit handler code was 
+ *	adapted from code posted on alt.sources.mac by Dave Nebinger.
+ *
+ * Copyright (c) 1995 Dave Nebinger.
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclMacInt.h"
+#include <SegLoad.h>
+#include <Traps.h>
+#include <Processes.h>
+
+/*
+ * Various typedefs and defines needed to patch ExitToShell.
+ */
+ 
+enum {
+        uppExitToShellProcInfo = kPascalStackBased
+};
+
+#if GENERATINGCFM
+typedef UniversalProcPtr ExitToShellUPP;
+
+#define CallExitToShellProc(userRoutine)        \
+        CallUniversalProc((UniversalProcPtr)(userRoutine),uppExitToShellProcInfo)
+#define NewExitToShellProc(userRoutine) \
+        (ExitToShellUPP)NewRoutineDescriptor((ProcPtr)(userRoutine), \
+		uppExitToShellProcInfo, GetCurrentArchitecture())
+
+#else
+typedef ExitToShellProcPtr ExitToShellUPP;
+
+#define CallExitToShellProc(userRoutine)        \
+        (*(userRoutine))()
+#define NewExitToShellProc(userRoutine) \
+        (ExitToShellUPP)(userRoutine)
+#endif
+
+#define DisposeExitToShellProc(userRoutine) \
+        DisposeRoutineDescriptor(userRoutine)
+
+#if defined(powerc)||defined(__powerc)
+#pragma options align=mac68k
+#endif
+struct ExitToShellUPPList{
+        struct ExitToShellUPPList* nextProc;
+        ExitToShellUPP userProc;
+};
+#if defined(powerc)||defined(__powerc)
+#pragma options align=reset
+#endif
+
+typedef struct ExitToShellDataStruct ExitToShellDataRec,* ExitToShellDataPtr,** ExitToShellDataHdl;
+
+typedef struct ExitToShellUPPList ExitToShellUPPList,* ExitToShellUPPListPtr,** ExitToShellUPPHdl;
+
+#if defined(powerc)||defined(__powerc)
+#pragma options align=mac68k
+#endif
+struct ExitToShellDataStruct{
+    unsigned long a5;
+    ExitToShellUPPList* userProcs;
+    ExitToShellUPP oldProc;
+};
+#if defined(powerc)||defined(__powerc)
+#pragma options align=reset
+#endif
+
+/*
+ * Static globals used within this file.
+ */
+static ExitToShellDataPtr gExitToShellData = (ExitToShellDataPtr) NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPlatformExit --
+ *
+ *	This procedure implements the Macintosh specific exit routine.
+ *	We explicitly callthe ExitHandler function to do various clean
+ *	up.  
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	We exit the process.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPlatformExit(
+    int status)		/* Ignored. */
+{
+    TclMacExitHandler();
+
+/* 
+ * If we are using the Metrowerks Standard Library, then we will call its exit so that it
+ * will get a chance to clean up temp files, and so forth.  It always calls the standard 
+ * ExitToShell, so the Tcl handlers will also get called.
+ *   
+ * If you have another exit, make sure that it does not patch ExitToShell, and does
+ * call it.  If so, it will probably work as well.
+ *
+ */
+ 
+#ifdef __MSL__    
+    exit(status);
+#else
+    ExitToShell();
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacExitHandler --
+ *
+ *	This procedure is invoked after Tcl at the last possible moment
+ *	to clean up any state Tcl has left around that may cause other
+ *	applications to crash.  For example, this function can be used
+ *	as the termination routine for CFM applications.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Various cleanup occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclMacExitHandler()
+{
+    ExitToShellUPPListPtr curProc;
+
+    /*
+     * Loop through all installed Exit handlers
+     * and call them.  Always make sure we are in
+     * a clean state in case we are recursivly called.
+     */
+    if ((gExitToShellData) != NULL && (gExitToShellData->userProcs != NULL)){
+    
+	/*
+	 * Call the installed exit to shell routines.
+	 */
+	curProc = gExitToShellData->userProcs;
+	do {
+	    gExitToShellData->userProcs = curProc->nextProc;
+	    CallExitToShellProc(curProc->userProc);
+	    DisposeExitToShellProc(curProc->userProc);
+	    DisposePtr((Ptr) curProc);
+	    curProc = gExitToShellData->userProcs;
+	} while (curProc != (ExitToShellUPPListPtr) NULL);
+    }
+
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacInstallExitToShellPatch --
+ *
+ *	This procedure installs a way to clean up state at the latest
+ *	possible moment before we exit.  These are things that must
+ *	be cleaned up or the system will crash.  The exact way in which
+ *	this is implemented depends on the architecture in which we are
+ *	running.  For 68k applications we patch the ExitToShell call.
+ *	For PowerPC applications we just create a list of procs to call.
+ *	The function ExitHandler should be installed in the Code 
+ *	Fragments terminiation routine.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Installs the new routine.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSErr 
+TclMacInstallExitToShellPatch(
+    ExitToShellProcPtr newProc)		/* Function pointer. */
+{
+    ExitToShellUPP exitHandler;
+    ExitToShellUPPListPtr listPtr;
+
+    if (gExitToShellData == (ExitToShellDataPtr) NULL){
+	TclMacInitExitToShell(true);
+    }
+
+    /*
+     * Add the passed in function pointer to the list of functions
+     * to be called when ExitToShell is called.
+     */
+    exitHandler = NewExitToShellProc(newProc);
+    listPtr = (ExitToShellUPPListPtr) NewPtrClear(sizeof(ExitToShellUPPList));
+    listPtr->userProc = exitHandler;
+    listPtr->nextProc = gExitToShellData->userProcs;
+    gExitToShellData->userProcs = listPtr;
+
+    return noErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExitToShellPatchRoutine --
+ *
+ *	This procedure is invoked when someone calls ExitToShell for
+ *	this application.  This function performs some last miniute
+ *	clean up and then calls the real ExitToShell routine.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Various cleanup occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal void
+ExitToShellPatchRoutine()
+{
+    ExitToShellUPP oldETS;
+    long oldA5;
+
+    /*
+     * Set up our A5 world.  This allows us to have
+     * access to our global variables in the 68k world.
+     */
+    oldA5 = SetCurrentA5();
+    SetA5(gExitToShellData->a5);
+
+    /*
+     * Call the function that invokes all
+     * of the handlers.
+     */
+    TclMacExitHandler();
+
+    /*
+     * Call the origional ExitToShell routine.
+     */
+    oldETS = gExitToShellData->oldProc;
+    DisposePtr((Ptr) gExitToShellData);
+    SetA5(oldA5);
+    CallExitToShellProc(oldETS);
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacInitExitToShell --
+ *
+ *	This procedure initializes the ExitToShell clean up machanism.
+ *	Generally, this is handled automatically when users make a call
+ *	to InstallExitToShellPatch.  However, it can be called 
+ *	explicitly at startup time to turn off the patching mechanism.
+ *	This can be used by code resources which could be removed from
+ *	the application before ExitToShell is called.
+ *
+ *	Note, if we are running from CFM code we never install the
+ *	patch.  Instead, the function ExitHandler should be installed
+ *	as the terminiation routine for the code fragment.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates global state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void 
+TclMacInitExitToShell(
+    int usePatch)	/* True if on 68k. */
+{
+    if (gExitToShellData == (ExitToShellDataPtr) NULL){
+#if GENERATINGCFM
+	gExitToShellData = (ExitToShellDataPtr)
+	  NewPtr(sizeof(ExitToShellDataRec));
+	gExitToShellData->a5 = SetCurrentA5();
+	gExitToShellData->userProcs = (ExitToShellUPPList*) NULL;
+#else
+	ExitToShellUPP oldExitToShell, newExitToShellPatch;
+	short exitToShellTrap;
+	
+	/*
+	 * Initialize patch mechanism.
+	 */
+	 
+	gExitToShellData = (ExitToShellDataPtr) NewPtr(sizeof(ExitToShellDataRec));
+	gExitToShellData->a5 = SetCurrentA5();
+	gExitToShellData->userProcs = (ExitToShellUPPList*) NULL;
+
+	/*
+	 * Save state needed to call origional ExitToShell routine.  Install
+	 * the new ExitToShell code in it's place.
+	 */
+	if (usePatch) {
+	    exitToShellTrap = _ExitToShell & 0x3ff;
+	    newExitToShellPatch = NewExitToShellProc(ExitToShellPatchRoutine);
+	    oldExitToShell = (ExitToShellUPP)
+	      NGetTrapAddress(exitToShellTrap, ToolTrap);
+	    NSetTrapAddress((UniversalProcPtr) newExitToShellPatch,
+		    exitToShellTrap, ToolTrap);
+	    gExitToShellData->oldProc = oldExitToShell;
+	}
+#endif
+    }
+}
diff --git a/tcl/mac/tclMacFCmd.c b/tcl/mac/tclMacFCmd.c
new file mode 100644
index 00000000000..21f725dc451
--- /dev/null
+++ b/tcl/mac/tclMacFCmd.c
@@ -0,0 +1,1408 @@
+/* 
+ * tclMacFCmd.c --
+ *
+ * Implements the Macintosh specific portions of the 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+#include "tclPort.h"
+#include <FSpCompat.h>
+#include <MoreFilesExtras.h>
+#include <Strings.h>
+#include <Errors.h>
+#include <FileCopy.h>
+#include <DirectoryCopy.h>
+#include <Script.h>
+#include <string.h>
+#include <Finder.h>
+
+/*
+ * Callback for the file attributes code.
+ */
+
+static int		GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **readOnlyPtrPtr));
+static int		SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+static int		SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *readOnlyPtr));
+
+/*
+ * These are indeces into the tclpFileAttrsStrings table below.
+ */
+
+#define MAC_CREATOR_ATTRIBUTE	0
+#define MAC_HIDDEN_ATTRIBUTE	1
+#define MAC_READONLY_ATTRIBUTE	2
+#define MAC_TYPE_ATTRIBUTE	3
+
+/*
+ * Global variables for the file attributes code.
+ */
+
+char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
+	"-type", (char *) NULL};
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+	{GetFileFinderAttributes, SetFileFinderAttributes},
+	{GetFileFinderAttributes, SetFileFinderAttributes},
+	{GetFileReadOnly, SetFileReadOnly},
+	{GetFileFinderAttributes, SetFileFinderAttributes}};
+
+
+/*
+ * Prototypes for procedure only used in this file
+ */
+
+static pascal Boolean 	CopyErrHandler _ANSI_ARGS_((OSErr error, 
+			    short failedOperation,
+			    short srcVRefNum, long srcDirID,
+			    StringPtr srcName, short dstVRefNum,
+			    long dstDirID,StringPtr dstName));
+OSErr			FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr, 
+			    Boolean *lockedPtr));
+static OSErr		GenerateUniqueName _ANSI_ARGS_((short vRefNum, 
+			    long dirID1, long dirID2, Str31 uniqueName));
+static OSErr		GetFileSpecs _ANSI_ARGS_((char *path, FSSpec *pathSpecPtr,
+			    FSSpec *dirSpecPtr,	Boolean *pathExistsPtr,	
+			    Boolean *pathIsDirectoryPtr));
+static OSErr		MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr, 
+			    const FSSpec *dstSpecPtr, StringPtr copyName));
+static int		Pstrequal _ANSI_ARGS_((ConstStr255Param stringA, 
+			    ConstStr255Param stringB));
+                 
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.  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( 
+    char *src,    		/* Pathname of file or dir to be renamed. */
+    char *dst)     		/* New pathname for file or directory. */
+{
+    FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
+    OSErr err; 
+    long srcID, dummy;
+    Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
+
+    err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
+    if (err == noErr) {
+	FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
+    }
+    if (err == noErr) {
+        err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists, 
+        	&dstIsDirectory);
+    }
+    if (err == noErr) {
+	if (dstExists == 0) {
+            err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
+            goto end;
+        }
+        err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
+        if (dstLocked) {
+            FSpRstFLockCompat(&dstFileSpec);
+        }
+    }
+    if (err == noErr) {
+        if (srcIsDirectory) {
+	    if (dstIsDirectory) {
+		/*
+		 * The following call will remove an empty directory.  If it
+		 * fails, it's because it wasn't empty.
+		 */
+		 
+                if (TclpRemoveDirectory(dst, 0, NULL) != TCL_OK) {
+                    return TCL_ERROR;
+                }
+                
+                /*
+		 * Now that that empty directory is gone, we can try
+		 * renaming src.  If that fails, we'll put this empty
+		 * directory back, for completeness.
+		 */
+
+		err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
+                if (err != noErr) {
+		    FSpDirCreateCompat(&dstFileSpec, smSystemScript, &dummy);
+		    if (dstLocked) {
+		        FSpSetFLockCompat(&dstFileSpec);
+		    }
+		}
+	    } else {
+	        errno = ENOTDIR;
+	        return TCL_ERROR;
+	    }
+	} else {   
+	    if (dstIsDirectory) {
+		errno = EISDIR;
+		return TCL_ERROR;
+	    } else {                                
+		/*
+		 * Overwrite existing file by:
+		 * 
+		 * 1. Rename existing file to temp name.
+		 * 2. Rename old file to new name.
+		 * 3. If success, delete temp file.  If failure,
+		 *    put temp file back to old name.
+		 */
+
+	        Str31 tmpName;
+	        FSSpec tmpFileSpec;
+
+	        err = GenerateUniqueName(dstFileSpec.vRefNum, 
+	        	dstFileSpec.parID, dstFileSpec.parID, tmpName);
+	        if (err == noErr) {
+	            err = FSpRenameCompat(&dstFileSpec, tmpName);
+	        }
+	        if (err == noErr) {
+	            err = FSMakeFSSpecCompat(dstFileSpec.vRefNum,
+	            	    dstFileSpec.parID, tmpName, &tmpFileSpec);
+	        }
+	        if (err == noErr) {
+	            err = MoveRename(&srcFileSpec, &dstDirSpec, 
+	            	    dstFileSpec.name);
+	        }
+	        if (err == noErr) {
+		    FSpDeleteCompat(&tmpFileSpec);
+		} else {
+		    FSpDeleteCompat(&dstFileSpec);
+		    FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
+	            if (dstLocked) {
+	            	FSpSetFLockCompat(&dstFileSpec);
+	            }
+	        }
+	    }
+   	}
+    }    
+
+    end:    
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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(
+    char *src,			/* Pathname of file to be copied. */
+    char *dst)			/* Pathname of file to copy to. */
+{
+    OSErr err, dstErr;
+    Boolean dstExists, dstIsDirectory, dstLocked;
+    FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
+    Str31 tmpName;
+	
+    err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
+    if (err == noErr) {
+        err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
+        	&dstIsDirectory);
+    }
+    if (dstExists) {
+        if (dstIsDirectory) {
+            errno = EISDIR;
+            return TCL_ERROR;
+        }
+        err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
+        if (dstLocked) {
+            FSpRstFLockCompat(&dstFileSpec);
+        }
+        
+        /*
+         * Backup dest file.
+         */
+         
+        dstErr = GenerateUniqueName(dstFileSpec.vRefNum, dstFileSpec.parID, 
+    	        dstFileSpec.parID, tmpName);
+        if (dstErr == noErr) {
+            dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
+        }   
+    }
+    if (err == noErr) {
+    	err = FSpFileCopy(&srcFileSpec, &dstDirSpec, 
+    		(StringPtr) dstFileSpec.name, NULL, 0, true);
+    }
+    if ((dstExists != false) && (dstErr == noErr)) {
+        FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
+        	tmpName, &tmpFileSpec);
+	if (err == noErr) {
+	    /* 
+	     * Delete backup file. 
+	     */
+	     
+	    FSpDeleteCompat(&tmpFileSpec);
+	} else {
+	
+	    /* 
+	     * Restore backup file.
+	     */
+	     
+	    FSpDeleteCompat(&dstFileSpec);
+	    FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
+	    if (dstLocked) {
+	        FSpSetFLockCompat(&dstFileSpec);
+	    }
+	}
+    }
+    
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	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( 
+    char *path)			/* Pathname of file to be removed. */
+{
+    OSErr err;
+    FSSpec fileSpec;
+    Boolean isDirectory;
+    long dirID;
+	
+    err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+    if (err == noErr) {
+	/*
+     	 * Since FSpDeleteCompat will delete an empty directory, make sure
+     	 * that this isn't a directory first.
+         */
+        
+        FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+	if (isDirectory == true) {
+            errno = EISDIR;
+            return TCL_ERROR;
+        }
+    }
+    err = FSpDeleteCompat(&fileSpec);
+    if (err == fLckdErr) {
+    	FSpRstFLockCompat(&fileSpec);
+    	err = FSpDeleteCompat(&fileSpec);
+    	if (err != noErr) {
+    	    FSpSetFLockCompat(&fileSpec);
+    	}
+    }
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	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(
+    char *path)			/* Pathname of directory to create. */
+{
+    OSErr err;
+    FSSpec dirSpec;
+    long outDirID;
+	
+    err = FSpLocationFromPath(strlen(path), path, &dirSpec);
+    if (err == noErr) {
+        err = dupFNErr;		/* EEXIST. */
+    } else if (err == fnfErr) {
+        err = FSpDirCreateCompat(&dirSpec, smSystemScript, &outDirID);
+    } 
+    
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	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(
+    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. */
+{
+    OSErr err, saveErr;
+    long srcID, tmpDirID;
+    FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpDirSpec, tmpFileSpec;
+    Boolean srcIsDirectory, srcLocked;
+    Boolean dstIsDirectory, dstExists;
+    Str31 tmpName;
+
+    err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
+    if (err == noErr) {
+    	err = FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
+    }
+    if (err == noErr) {
+        if (srcIsDirectory == false) {
+            err = afpObjectTypeErr;	/* ENOTDIR. */
+        }
+    }
+    if (err == noErr) {
+        err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
+        	&dstIsDirectory);
+    }
+    if (dstExists) {
+        if (dstIsDirectory == false) {
+            err = afpObjectTypeErr;	/* ENOTDIR. */
+        } else {
+            err = dupFNErr;		/* EEXIST. */
+        }
+    }
+    if (err != noErr) {
+        goto done;
+    }        
+    if ((srcFileSpec.vRefNum == dstFileSpec.vRefNum) &&
+    	    (srcFileSpec.parID == dstFileSpec.parID) &&
+            (Pstrequal(srcFileSpec.name, dstFileSpec.name) != 0)) {
+        /*
+         * Copying on top of self.  No-op.
+         */
+                    
+        goto done;
+    }
+
+    /*
+     * This algorthm will work making a copy of the source directory in
+     * the current directory with a new name, in a new directory with the
+     * same name, and in a new directory with a new name:
+     *
+     * 1. Make dstDir/tmpDir.
+     * 2. Copy srcDir/src to dstDir/tmpDir/src
+     * 3. Rename dstDir/tmpDir/src to dstDir/tmpDir/dst (if necessary).
+     * 4. CatMove dstDir/tmpDir/dst to dstDir/dst.
+     * 5. Remove dstDir/tmpDir.
+     */
+                
+    err = FSpGetFLockCompat(&srcFileSpec, &srcLocked);
+    if (srcLocked) {
+        FSpRstFLockCompat(&srcFileSpec);
+    }
+    if (err == noErr) {
+        err = GenerateUniqueName(dstFileSpec.vRefNum, dstFileSpec.parID, 
+    	        dstFileSpec.parID, tmpName);
+    }
+    if (err == noErr) {
+        FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
+        	tmpName, &tmpDirSpec);
+        err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
+    }
+    if (err == noErr) {
+	err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, 0, true,
+	    	CopyErrHandler);
+    }
+    
+    /* 
+     * Even if the Copy failed, Rename/Move whatever did get copied to the
+     * appropriate final destination, if possible.  
+     */
+     
+    saveErr = err;
+    err = noErr;
+    if (Pstrequal(srcFileSpec.name, dstFileSpec.name) == 0) {
+        err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID, 
+        	srcFileSpec.name, &tmpFileSpec);
+        if (err == noErr) {
+            err = FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
+        }
+    }
+    if (err == noErr) {
+        err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
+        	dstFileSpec.name, &tmpFileSpec);
+    }
+    if (err == noErr) {
+        err = FSpCatMoveCompat(&tmpFileSpec, &dstDirSpec);
+    }
+    if (err == noErr) {
+        if (srcLocked) {
+            FSpSetFLockCompat(&dstFileSpec);
+        }
+    }
+    
+    FSpDeleteCompat(&tmpDirSpec);
+    
+    if (saveErr != noErr) {
+        err = saveErr;
+    }
+    
+    done:
+    if (err != noErr) {
+        errno = TclMacOSErrorToPosixError(err);
+        if (errorPtr != NULL) {
+            Tcl_DStringAppend(errorPtr, dst, -1);
+        }
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyErrHandler --
+ *
+ *      This procedure is called from the MoreFiles procedure 
+ *      FSpDirectoryCopy whenever an error occurs.
+ *
+ * Results:
+ *      False if the condition should not be considered an error, true
+ *      otherwise.
+ *
+ * Side effects:
+ *      Since FSpDirectoryCopy() is called only after removing any 
+ *      existing target directories, there shouldn't be any errors.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static pascal Boolean 
+CopyErrHandler(
+    OSErr error,		/* Error that occured */
+    short failedOperation,	/* operation that caused the error */
+    short srcVRefNum,		/* volume ref number of source */
+    long srcDirID,		/* directory id of source */
+    StringPtr srcName,		/* name of source */
+    short dstVRefNum,		/* volume ref number of dst */
+    long dstDirID,		/* directory id of dst */
+    StringPtr dstName)		/* name of dst directory */
+{
+    return true;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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(
+    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. */
+{				 
+    OSErr err;
+    FSSpec fileSpec;
+    long dirID;
+    int locked;
+    Boolean isDirectory;
+    CInfoPBRec pb;
+    Str255 fileName;
+
+    locked = 0;
+    err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+    if (err != noErr) {
+        goto done;
+    }   
+
+    /*
+     * Since FSpDeleteCompat will delete a file, make sure this isn't
+     * a file first.
+     */
+         
+    isDirectory = 1;
+    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    if (isDirectory == 0) {
+        errno = ENOTDIR;
+        return TCL_ERROR;
+    }
+    
+    err = FSpDeleteCompat(&fileSpec);
+    if (err == fLckdErr) {
+        locked = 1;
+    	FSpRstFLockCompat(&fileSpec);
+    	err = FSpDeleteCompat(&fileSpec);
+    }
+    if (err == noErr) {
+	return TCL_OK;
+    }
+    if (err != fBsyErr) {
+        goto done;
+    }
+     
+    if (recursive == 0) {
+	/*
+	 * fBsyErr means one of three things: file busy, directory not empty, 
+	 * or working directory control block open.  Determine if directory
+	 * is empty. If directory is not empty, return EEXIST.
+	 */
+
+	pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+	pb.hFileInfo.ioDirID = dirID;
+	pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
+	pb.hFileInfo.ioFDirIndex = 1;
+	if (PBGetCatInfoSync(&pb) == noErr) {
+	    err = dupFNErr;	/* EEXIST */
+	    goto done;
+	}
+    }
+	
+    /*
+     * DeleteDirectory removes a directory and all its contents, including
+     * any locked files.  There is no interface to get the name of the 
+     * file that caused the error, if an error occurs deleting this tree,
+     * unless we rewrite DeleteDirectory ourselves.
+     */
+	 
+    err = DeleteDirectory(fileSpec.vRefNum, dirID, NULL);
+
+    done:
+    if (err != noErr) {
+	if (errorPtr != NULL) {
+	    Tcl_DStringAppend(errorPtr, path, -1);
+	}
+        if (locked) {
+            FSpSetFLockCompat(&fileSpec);
+        }
+    	errno = TclMacOSErrorToPosixError(err);
+    	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------------------
+ *
+ * MoveRename --
+ *
+ *	Helper function for TclpRenameFile.  Renames a file or directory
+ *	into the same directory or another directory.  The target name
+ * 	must not already exist in the destination directory.
+ *
+ *	Don't use FSpMoveRenameCompat because it doesn't work with
+ *	directories or with locked files. 
+ *
+ * Results:
+ *	Returns a mac error indicating the cause of the failure.
+ *
+ * Side effects:
+ *	Creates a temp file in the target directory to handle a rename
+ *	between directories.
+ *
+ *--------------------------------------------------------------------------
+ */
+  
+static OSErr		
+MoveRename(
+    const FSSpec *srcFileSpecPtr,   /* Source object. */
+    const FSSpec *dstDirSpecPtr,    /* Destination directory. */
+    StringPtr copyName)		    /* New name for object in destination 
+    				     * directory. */
+{
+    OSErr err;
+    long srcID, dstID;
+    Boolean srcIsDir, dstIsDir;
+    Str31 tmpName;
+    FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
+    Boolean locked;
+    
+    if (srcFileSpecPtr->parID == 1) {
+        /*
+         * Trying to rename a volume.
+         */
+          
+        return badMovErr;
+    }
+    if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
+	/*
+	 * Renaming across volumes.
+	 */
+	 
+        return diffVolErr;
+    }
+    err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
+    if (locked) {
+        FSpRstFLockCompat(srcFileSpecPtr);
+    }
+    if (err == noErr) {
+	err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
+    }
+    if (err == noErr) {
+        if (srcFileSpecPtr->parID == dstID) {
+            /*
+             * Renaming object within directory. 
+             */
+            
+            err = FSpRenameCompat(srcFileSpecPtr, copyName);
+            goto done; 
+        }
+        if (Pstrequal(srcFileSpecPtr->name, copyName)) {
+	    /*
+	     * Moving object to another directory (under same name). 
+	     */
+	 
+	    err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
+	    goto done; 
+        } 
+        err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
+    } 
+    if (err == noErr) {
+        /*
+         * Fullblown: rename source object to temp name, move temp to
+         * dest directory, and rename temp to target.
+         */
+          
+        err = GenerateUniqueName(srcFileSpecPtr->vRefNum, 
+       		srcFileSpecPtr->parID, dstID, tmpName);
+        FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
+         	tmpName, &tmpSrcFileSpec);
+        FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
+         	&tmpDstFileSpec);
+    }
+    if (err == noErr) {
+        err = FSpRenameCompat(srcFileSpecPtr, tmpName);
+    }
+    if (err == noErr) {
+        err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
+        if (err == noErr) {
+            err = FSpRenameCompat(&tmpDstFileSpec, copyName);
+            if (err == noErr) {
+                goto done;
+            }
+            FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
+             	    NULL, &srcDirSpec);
+            FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
+        }                 
+        FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
+    }
+    
+    done:
+    if (locked != false) {
+    	if (err == noErr) {
+	    FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, 
+	    	    dstID, copyName, &dstFileSpec);
+            FSpSetFLockCompat(&dstFileSpec);
+        } else {
+            FSpSetFLockCompat(srcFileSpecPtr);
+        }
+    }
+    return err;
+}     
+			    
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetFileSpecs --
+ *
+ * 	Generate a filename that is not in either of the two specified
+ *	directories (on the same volume). 
+ *
+ * Results:
+ *	Standard macintosh error.  On success, uniqueName is filled with 
+ *	the name of the temporary file.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */ 
+ 
+static OSErr
+GenerateUniqueName(
+    short vRefNum,		/* Volume on which the following directories
+    				 * are located. */		
+    long dirID1,		/* ID of first directory. */
+    long dirID2,		/* ID of second directory.  May be the same
+    				 * as the first. */
+    Str31 uniqueName)		/* Filled with filename for a file that is
+    				 * not located in either of the above two
+    				 * directories. */
+{
+    OSErr err;
+    long i;
+    CInfoPBRec pb;
+    static unsigned char hexStr[16] = "0123456789ABCDEF";
+    static long startSeed = 248923489;
+    
+    pb.hFileInfo.ioVRefNum = vRefNum;
+    pb.hFileInfo.ioFDirIndex = 0;
+    pb.hFileInfo.ioNamePtr = uniqueName;
+
+    while (1) {
+        startSeed++;		
+	pb.hFileInfo.ioNamePtr[0] = 8;
+	for (i = 1; i <= 8; i++) {
+	    pb.hFileInfo.ioNamePtr[i] = hexStr[((startSeed >> ((8-i)*4)) & 0xf)];
+	}
+	pb.hFileInfo.ioDirID = dirID1;
+	err = PBGetCatInfoSync(&pb);
+	if (err == fnfErr) {
+	    if (dirID1 != dirID2) {
+		pb.hFileInfo.ioDirID = dirID2;
+		err = PBGetCatInfoSync(&pb);
+	    }
+	    if (err == fnfErr) {
+	        return noErr;
+	    }
+	}
+	if (err == noErr) {
+	    continue;
+	} 
+	return err;
+    }
+} 
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetFileSpecs --
+ *
+ *	Gets FSSpecs for the specified path and its parent directory.
+ *
+ * Results:
+ *	The return value is noErr if there was no error getting FSSpecs,
+ *	otherwise it is an error describing the problem.  Fills buffers 
+ *	with information, as above.  
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static OSErr
+GetFileSpecs(
+    char *path,			/* The path to query. */
+    FSSpec *pathSpecPtr,	/* Filled with information about path. */
+    FSSpec *dirSpecPtr,		/* Filled with information about path's
+    				 * parent directory. */
+    Boolean *pathExistsPtr,	/* Set to true if path actually exists, 
+    				 * false if it doesn't or there was an 
+    				 * error reading the specified path. */
+    Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
+    				 * otherwise false. */
+{
+    char *dirName;
+    OSErr err;
+    int argc;
+    char **argv;
+    long d;
+    Tcl_DString buffer;
+        
+    *pathExistsPtr = false;
+    *pathIsDirectoryPtr = false;
+    
+    Tcl_DStringInit(&buffer);
+    Tcl_SplitPath(path, &argc, &argv);
+    if (argc == 1) {
+        dirName = ":";
+    } else {
+        dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
+    }
+    err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
+    Tcl_DStringFree(&buffer);
+    ckfree((char *) argv);
+
+    if (err == noErr) {
+        err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
+        if (err == noErr) {
+            *pathExistsPtr = true;
+            err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
+        } else if (err == fnfErr) {
+            err = noErr;
+        }
+    }
+    return err;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FSpGetFLockCompat --
+ *
+ *	Determines if there exists a software lock on the specified
+ *	file.  The software lock could prevent the file from being 
+ *	renamed or moved.
+ *
+ * Results:
+ *	Standard macintosh error code.  
+ *
+ * Side effects:
+ *	None.
+ *
+ *
+ *-------------------------------------------------------------------------
+ */
+ 
+OSErr
+FSpGetFLockCompat(
+    const FSSpec *specPtr,	/* File to query. */
+    Boolean *lockedPtr)		/* Set to true if file is locked, false
+    				 * if it isn't or there was an error reading
+    				 * specified file. */
+{
+    CInfoPBRec pb;
+    OSErr err;
+    
+    pb.hFileInfo.ioVRefNum = specPtr->vRefNum;
+    pb.hFileInfo.ioDirID = specPtr->parID;
+    pb.hFileInfo.ioNamePtr = (StringPtr) specPtr->name;
+    pb.hFileInfo.ioFDirIndex = 0;
+    
+    err = PBGetCatInfoSync(&pb);
+    if ((err == noErr) && (pb.hFileInfo.ioFlAttrib & 0x01)) {
+        *lockedPtr = true;
+    } else {
+        *lockedPtr = false;
+    }
+    return err;
+}
+    
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pstrequal --
+ *
+ *      Pascal string compare. 
+ *
+ * Results:
+ *      Returns 1 if strings equal, 0 otherwise.
+ *
+ * Side effects:
+ *      None.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int 
+Pstrequal (
+    ConstStr255Param stringA,	/* Pascal string A */
+    ConstStr255Param stringB)   /* Pascal string B */
+{
+    int i, len;
+    
+    len = *stringA;
+    for (i = 0; i <= len; i++) {
+        if (*stringA++ != *stringB++) {
+            return 0;
+        }
+    }
+    return 1;
+}
+    
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileFinderAttributes --
+ *
+ *	Returns a Tcl_Obj containing the value of a file attribute
+ *	which is part of the FInfo record. Which attribute is controlled
+ *	by objIndex.
+ *
+ * Results:
+ *      Returns a standard TCL error. If the return value is TCL_OK,
+ *	the new creator or file type object is put into attributePtrPtr.
+ *	The object will have ref count 0. If there is an error,
+ *	attributePtrPtr is not touched.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileFinderAttributes(
+    Tcl_Interp *interp,		/* The interp to report errors with. */
+    int objIndex,		/* The index of the attribute option. */
+    char *fileName,		/* The name of the file. */
+    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
+{
+    OSErr err;
+    FSSpec fileSpec;
+    FInfo finfo;
+    
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    
+    if (err == noErr) {
+    	err = FSpGetFInfo(&fileSpec, &finfo);
+    }
+    
+    if (err == noErr) {
+    	switch (objIndex) {
+    	    case MAC_CREATOR_ATTRIBUTE:
+    	    	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator);
+    	    	break;
+    	    case MAC_HIDDEN_ATTRIBUTE:
+    	    	*attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags
+    	    		& kIsInvisible);
+    	    	break;
+    	    case MAC_TYPE_ATTRIBUTE:
+    	    	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
+    	    	break;
+    	}
+    } else if (err == fnfErr) {
+    	long dirID;
+    	Boolean isDirectory = 0;
+    	
+    	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    	if ((err == noErr) && isDirectory) {
+    	    if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
+    	    	*attributePtrPtr = Tcl_NewBooleanObj(0);
+    	    } else {
+    	    	*attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
+    	    }
+    	}
+    }
+    
+    if (err != noErr) {
+    	errno = TclMacOSErrorToPosixError(err);
+    	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+    		"couldn't get attributes for file \"", fileName, "\": ",
+    		Tcl_PosixError(interp), (char *) NULL);
+    	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileReadOnly --
+ *
+ *	Returns a Tcl_Obj containing a Boolean value indicating whether
+ *	or not the file is read-only. The object will have ref count 0.
+ *	This procedure just checks the Finder attributes; it does not
+ *	check AppleShare sharing attributes.
+ *
+ * Results:
+ *      Returns a standard TCL error. If the return value is TCL_OK,
+ *	the new creator type object is put into readOnlyPtrPtr.
+ *	If there is an error, readOnlyPtrPtr is not touched.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileReadOnly(
+    Tcl_Interp *interp,		/* The interp to report errors with. */
+    int objIndex,		/* The index of the attribute. */
+    char *fileName,		/* The name of the file. */
+    Tcl_Obj **readOnlyPtrPtr)	/* A pointer to return the object with. */
+{
+    OSErr err;
+    FSSpec fileSpec;
+    CInfoPBRec paramBlock;
+    
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    
+    if (err == noErr) {
+    	if (err == noErr) {
+    	    paramBlock.hFileInfo.ioCompletion = NULL;
+    	    paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
+    	    paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+    	    paramBlock.hFileInfo.ioFDirIndex = 0;
+    	    paramBlock.hFileInfo.ioDirID = fileSpec.parID;
+    	    err = PBGetCatInfo(&paramBlock, 0);
+    	    if (err == noErr) {
+    	    
+    	    	/*
+    	    	 * For some unknown reason, the Mac does not give
+    	    	 * symbols for the bits in the ioFlAttrib field.
+    	    	 * 1 -> locked.
+    	    	 */
+    	    
+    	    	*readOnlyPtrPtr = Tcl_NewBooleanObj(
+    	    		paramBlock.hFileInfo.ioFlAttrib & 1);
+    	    }
+    	}
+    }
+    if (err != noErr) {
+    	errno = TclMacOSErrorToPosixError(err);
+    	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+    		"couldn't get attributes for file \"", fileName, "\": ",
+    		Tcl_PosixError(interp), (char *) NULL);
+    	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFileFinderAttributes --
+ *
+ *	Sets the file to the creator or file type given by attributePtr.
+ *	objIndex determines whether the creator or file type is set.
+ *
+ * Results:
+ *	Returns a standard TCL error.
+ *
+ * Side effects:
+ *      The file's attribute is set.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetFileFinderAttributes(
+    Tcl_Interp *interp,		/* The interp to report errors with. */
+    int objIndex,		/* The index of the attribute. */
+    char *fileName,		/* The name of the file. */
+    Tcl_Obj *attributePtr)	/* The command line object. */
+{
+    OSErr err;
+    FSSpec fileSpec;
+    FInfo finfo;
+    
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    
+    if (err == noErr) {
+    	err = FSpGetFInfo(&fileSpec, &finfo);
+    }
+    
+    if (err == noErr) {
+    	switch (objIndex) {
+    	    case MAC_CREATOR_ATTRIBUTE:
+    	    	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
+    	    		&finfo.fdCreator) != TCL_OK) {
+    	    	    return TCL_ERROR;
+    	    	}
+    	    	break;
+    	    case MAC_HIDDEN_ATTRIBUTE: {
+    	    	int hidden;
+    	    	
+    	    	if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
+    	    		!= TCL_OK) {
+    	    	    return TCL_ERROR;
+    	    	}
+    	    	if (hidden) {
+    	    	    finfo.fdFlags |= kIsInvisible;
+    	    	} else {
+    	    	    finfo.fdFlags &= ~kIsInvisible;
+    	    	}
+    	    	break;
+    	    }
+    	    case MAC_TYPE_ATTRIBUTE:
+    	    	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
+    	    		&finfo.fdType) != TCL_OK) {
+    	    	    return TCL_ERROR;
+    	    	}
+    	    	break;
+    	}
+    	err = FSpSetFInfo(&fileSpec, &finfo);
+    } else if (err == fnfErr) {
+    	long dirID;
+    	Boolean isDirectory = 0;
+    	
+    	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    	if ((err == noErr) && isDirectory) {
+    	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+    	    Tcl_AppendStringsToObj(resultPtr, "cannot set ",
+    	    	    tclpFileAttrStrings[objIndex], ": \"",
+    	    	    fileName, "\" is a directory", (char *) NULL);
+    	    return TCL_ERROR;
+    	}
+    }
+    
+    if (err != noErr) {
+    	errno = TclMacOSErrorToPosixError(err);
+    	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+    		"couldn't set attributes for file \"", fileName, "\": ",
+    		Tcl_PosixError(interp), (char *) NULL);
+    	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFileReadOnly --
+ *
+ *	Sets the file to be read-only according to the Boolean value
+ *	given by hiddenPtr.
+ *
+ * Results:
+ *	Returns a standard TCL error.
+ *
+ * Side effects:
+ *      The file's attribute is set.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetFileReadOnly(
+    Tcl_Interp *interp,		/* The interp to report errors with. */
+    int objIndex,		/* The index of the attribute. */
+    char *fileName,		/* The name of the file. */
+    Tcl_Obj *readOnlyPtr)	/* The command line object. */
+{
+    OSErr err;
+    FSSpec fileSpec;
+    HParamBlockRec paramBlock;
+    int hidden;
+    
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    
+    if (err == noErr) {
+    	if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
+    	    return TCL_ERROR;
+    	}
+    
+    	paramBlock.fileParam.ioCompletion = NULL;
+    	paramBlock.fileParam.ioNamePtr = fileSpec.name;
+    	paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
+    	paramBlock.fileParam.ioDirID = fileSpec.parID;
+    	if (hidden) {
+    	    err = PBHSetFLock(&paramBlock, 0);
+    	} else {
+    	    err = PBHRstFLock(&paramBlock, 0);
+    	}
+    }
+    
+    if (err == fnfErr) {
+    	long dirID;
+    	Boolean isDirectory = 0;
+    	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    	if ((err == noErr) && isDirectory) {
+    	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+    	    	    "cannot set a directory to read-only when File Sharing is turned off",
+    	    	    (char *) NULL);
+    	    return TCL_ERROR;
+    	} else {
+    	    err = fnfErr;
+    	}
+    }
+    
+    if (err != noErr) {
+    	errno = TclMacOSErrorToPosixError(err);
+    	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+    		"couldn't set attributes for file \"", fileName, "\": ",
+    		Tcl_PosixError(interp), (char *) NULL);
+    	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpListVolumes --
+ *
+ *	Lists the currently mounted volumes
+ *
+ * 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( 
+		Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
+{
+    HParamBlockRec pb;
+    Str255 name;
+    OSErr theError = noErr;
+    Tcl_Obj *resultPtr, *elemPtr;
+    short volIndex = 1;
+
+    resultPtr = Tcl_NewObj();
+        
+    /*
+     * We use two facts:
+     * 1) The Mac volumes are enumerated by the ioVolIndex parameter of
+     * the HParamBlockRec.  They run through the integers contiguously, 
+     * starting at 1.  
+     * 2) PBHGetVInfoSync returns an error when you ask for a volume index
+     * that does not exist.
+     * 
+     */
+        
+    while ( 1 ) {
+        pb.volumeParam.ioNamePtr = (StringPtr) & name;
+        pb.volumeParam.ioVolIndex = volIndex;
+                
+        theError = PBHGetVInfoSync(&pb);
+
+        if ( theError != noErr ) {
+            break;
+        }
+                
+        elemPtr = Tcl_NewStringObj((char *) name + 1, (int) name[0]);
+        Tcl_AppendToObj(elemPtr, ":", 1);
+        Tcl_ListObjAppendElement(interp, resultPtr, elemPtr);
+                
+        volIndex++;             
+    }
+        
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;      
+}
+
diff --git a/tcl/mac/tclMacFile.c b/tcl/mac/tclMacFile.c
new file mode 100644
index 00000000000..60a602eb5c9
--- /dev/null
+++ b/tcl/mac/tclMacFile.c
@@ -0,0 +1,840 @@
+/* 
+ * tclMacFile.c --
+ *
+ *      This file implements the channel drivers for Macintosh
+ *	files.  It also comtains Macintosh version of other Tcl
+ *	functions that deal with the file system.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Note: This code eventually needs to support async I/O.  In doing this
+ * we will need to keep track of all current async I/O.  If exit to shell
+ * is called - we shouldn't exit until all asyc I/O completes.
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMacInt.h"
+#include <Aliases.h>
+#include <Errors.h>
+#include <Processes.h>
+#include <Strings.h>
+#include <Types.h>
+#include <MoreFiles.h>
+#include <MoreFilesExtras.h>
+#include <FSpCompat.h>
+
+/*
+ * Static variables used by the TclpStat function.
+ */
+static int initalized = false;
+static long gmt_offset;
+
+/*
+ * The variable below caches the name of the current working directory
+ * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
+ * NULL means the cache needs to be refreshed.
+ */
+
+static char *currentDir =  NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChdir --
+ *
+ *	Change the current working directory.
+ *
+ * Results:
+ *	The result is a standard Tcl result.  If an error occurs and 
+ *	interp isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The working directory for this application is changed.  Also
+ *	the cache maintained used by TclGetCwd is deallocated and
+ *	set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChdir(
+    Tcl_Interp *interp,		/* If non NULL, used for error reporting. */
+    char *dirName)		/* Path to new working directory. */
+{
+    FSSpec spec;
+    OSErr err;
+    Boolean isFolder;
+    long dirID;
+
+    if (currentDir != NULL) {
+	ckfree(currentDir);
+	currentDir = NULL;
+    }
+
+    err = FSpLocationFromPath(strlen(dirName), dirName, &spec);
+    if (err != noErr) {
+	errno = ENOENT;
+	goto chdirError;
+    }
+    
+    err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
+    if (err != noErr) {
+	errno = ENOENT;
+	goto chdirError;
+    }
+
+    if (isFolder != true) {
+	errno = ENOTDIR;
+	goto chdirError;
+    }
+
+    err = FSpSetDefaultDir(&spec);
+    if (err != noErr) {
+	switch (err) {
+	    case afpAccessDenied:
+		errno = EACCES;
+		break;
+	    default:
+		errno = ENOENT;
+	}
+	goto chdirError;
+    }
+
+    return TCL_OK;
+    chdirError:
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "couldn't change working directory to \"",
+		dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCwd --
+ *
+ *	Return the path name of the current working directory.
+ *
+ * Results:
+ *	The result is the full path name of the current working
+ *	directory, or NULL if an error occurred while figuring it
+ *	out.  If an error occurs and interp isn't NULL, an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	The path name is cached to avoid having to recompute it
+ *	on future calls;  if it is already cached, the cached
+ *	value is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetCwd(
+    Tcl_Interp *interp)		/* If non NULL, used for error reporting. */
+{
+    FSSpec theSpec;
+    int length;
+    Handle pathHandle = NULL;
+    
+    if (currentDir == NULL) {
+	if (FSpGetDefaultDir(&theSpec) != noErr) {
+	    if (interp != NULL) {
+		interp->result = "error getting working directory name";
+	    }
+	    return NULL;
+	}
+	if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
+	    if (interp != NULL) {
+		interp->result = "error getting working directory name";
+	    }
+	    return NULL;
+	}
+	HLock(pathHandle);
+	currentDir = (char *) ckalloc((unsigned) (length + 1));
+	strcpy(currentDir, *pathHandle);
+	HUnlock(pathHandle);
+	DisposeHandle(pathHandle);	
+    }
+    return currentDir;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ *	Fakes a call to wait pid.
+ *
+ * Results:
+ *	Always returns -1.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Pid
+Tcl_WaitPid(
+    Tcl_Pid pid,
+    int *statPtr,
+    int options)
+{
+    return (Tcl_Pid) -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindExecutable --
+ *
+ *	This procedure computes the absolute path name of the current
+ *	application, given its argv[0] value.  However, this
+ *	implementation doesn't use of need the argv[0] value.  NULL
+ *	may be passed in its place.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The variable tclExecutableName gets filled in with the file
+ *	name for the application, if we figured it out.  If we couldn't
+ *	figure it out, Tcl_FindExecutable is set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FindExecutable(
+    char *argv0)		/* The value of the application's argv[0]. */
+{
+    ProcessSerialNumber psn;
+    ProcessInfoRec info;
+    Str63 appName;
+    FSSpec fileSpec;
+    int pathLength;
+    Handle pathName = NULL;
+    OSErr err;
+    
+    GetCurrentProcess(&psn);
+    info.processInfoLength = sizeof(ProcessInfoRec);
+    info.processName = appName;
+    info.processAppSpec = &fileSpec;
+    GetProcessInformation(&psn, &info);
+
+    if (tclExecutableName != NULL) {
+	ckfree(tclExecutableName);
+	tclExecutableName = NULL;
+    }
+    
+    err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
+
+    tclExecutableName = (char *) ckalloc((unsigned) pathLength + 1);
+    HLock(pathName);
+    strcpy(tclExecutableName, *pathName);
+    HUnlock(pathName);
+    DisposeHandle(pathName);	
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetUserHome --
+ *
+ *	This function takes the passed in user name and finds the
+ *	corresponding home directory specified in the password file.
+ *
+ * Results:
+ *	On a Macintosh we always return a NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetUserHome(
+    char *name,			/* User name to use to find home directory. */
+    Tcl_DString *bufferPtr)	/* May be used to hold result.  Must not hold
+				 * anything at the time of the call, and need
+				 * not even be initialized. */
+{
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMatchFiles --
+ *
+ *	This routine is used by the globbing code to search a
+ *	directory for all files which match a given pattern.
+ *
+ * Results: 
+ *	If the tail argument is NULL, then the matching files are
+ *	added to the interp->result.  Otherwise, TclDoGlob is called
+ *	recursively for each matching subdirectory.  The return value
+ *	is a standard Tcl result indicating whether an error occurred
+ *	in globbing.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------- */
+
+int
+TclMatchFiles(
+    Tcl_Interp *interp,		/* Interpreter to receive results. */
+    char *separators,		/* Directory separators to pass to TclDoGlob. */
+    Tcl_DString *dirPtr,	/* Contains path to directory to search. */
+    char *pattern,		/* Pattern to match against. */
+    char *tail)			/* Pointer to end of pattern.  Tail must
+				 * point to a location in pattern. */
+{
+    char *dirName, *patternEnd = tail;
+    char savedChar;
+    int result = TCL_OK;
+    int baseLength = Tcl_DStringLength(dirPtr);
+    CInfoPBRec pb;
+    OSErr err;
+    FSSpec dirSpec;
+    Boolean isDirectory;
+    long dirID;
+    short itemIndex;
+    Str255 fileName;
+    
+
+    /*
+     * Make sure that the directory part of the name really is a
+     * directory.
+     */
+
+    dirName = dirPtr->string;
+    FSpLocationFromPath(strlen(dirName), dirName, &dirSpec);
+    err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
+    if ((err != noErr) || !isDirectory) {
+	return TCL_OK;
+    }
+
+    /*
+     * Now open the directory for reading and iterate over the contents.
+     */
+
+    pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
+    pb.hFileInfo.ioDirID = dirID;
+    pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
+    pb.hFileInfo.ioFDirIndex = itemIndex = 1;
+    
+    /*
+     * Clean up the end of the pattern and the tail pointer.  Leave
+     * the tail pointing to the first character after the path separator
+     * following the pattern, or NULL.  Also, ensure that the pattern
+     * is null-terminated.
+     */
+
+    if (*tail == '\\') {
+	tail++;
+    }
+    if (*tail == '\0') {
+	tail = NULL;
+    } else {
+	tail++;
+    }
+    savedChar = *patternEnd;
+    *patternEnd = '\0';
+
+    while (1) {
+	pb.hFileInfo.ioFDirIndex = itemIndex;
+	pb.hFileInfo.ioDirID = dirID;
+	err = PBGetCatInfoSync(&pb);
+	if (err != noErr) {
+	    break;
+	}
+
+	/*
+	 * Now check to see if the file matches.  If there are more
+	 * characters to be processed, then ensure matching files are
+	 * directories before calling TclDoGlob. Otherwise, just add
+	 * the file to the result.
+	 */
+
+	p2cstr(fileName);
+	if (Tcl_StringMatch((char *) fileName, pattern)) {
+	    Tcl_DStringSetLength(dirPtr, baseLength);
+	    Tcl_DStringAppend(dirPtr, (char *) fileName, -1);
+	    if (tail == NULL) {
+		if ((dirPtr->length > 1) &&
+			(strchr(dirPtr->string+1, ':') == NULL)) {
+		    Tcl_AppendElement(interp, dirPtr->string+1);
+		} else {
+		    Tcl_AppendElement(interp, dirPtr->string);
+		}
+	    } else if ((pb.hFileInfo.ioFlAttrib & ioDirMask) != 0) {
+		Tcl_DStringAppend(dirPtr, ":", 1);
+		result = TclDoGlob(interp, separators, dirPtr, tail);
+		if (result != TCL_OK) {
+		    break;
+		}
+	    }
+	}
+	
+	itemIndex++;
+    }
+    *patternEnd = savedChar;
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpStat --
+ *
+ *	This function replaces the library version of stat.  The stat
+ *	function provided by most Mac compiliers is rather broken and
+ *	incomplete.
+ *
+ * Results:
+ *	See stat documentation.
+ *
+ * Side effects:
+ *	See stat documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpStat(
+    CONST char *path,
+    struct stat *buf)
+{
+    HFileInfo fpb;
+    HVolumeParam vpb;
+    OSErr err;
+    FSSpec fileSpec;
+    Boolean isDirectory;
+    long dirID;
+    
+    err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	return -1;
+    }
+    
+    /*
+     * Fill the fpb & vpb struct up with info about file or directory.
+     */
+     
+    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
+    vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
+    if (isDirectory) {
+	fpb.ioDirID = fileSpec.parID;
+    } else {
+	fpb.ioDirID = dirID;
+    }
+
+    fpb.ioFDirIndex = 0;
+    err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
+    if (err == noErr) {
+	vpb.ioVolIndex = 0;
+	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
+	if (err == noErr && buf != NULL) {
+	    /* 
+	     * Files are always readable by everyone.
+	     */
+	     
+	    buf->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
+
+	    /* 
+	     * Use the Volume Info & File Info to fill out stat buf.
+	     */
+	    if (fpb.ioFlAttrib & 0x10) {
+		buf->st_mode |= S_IFDIR;
+		buf->st_nlink = 2;
+	    } else {
+		buf->st_nlink = 1;
+		if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
+		    buf->st_mode |= S_IFLNK;
+		} else {
+		    buf->st_mode |= S_IFREG;
+		}
+	    }
+	    if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
+	    	/*
+	    	 * Directories and applications are executable by everyone.
+	    	 */
+	    	 
+	    	buf->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
+	    }
+	    if ((fpb.ioFlAttrib & 0x01) == 0){
+	    	/* 
+	    	 * If not locked, then everyone has write acces.
+	    	 */
+	    	 
+	        buf->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
+	    }
+	    buf->st_ino = fpb.ioDirID;
+	    buf->st_dev = fpb.ioVRefNum;
+	    buf->st_uid = -1;
+	    buf->st_gid = -1;
+	    buf->st_rdev = 0;
+	    buf->st_size = fpb.ioFlLgLen;
+	    buf->st_blksize = vpb.ioVAlBlkSiz;
+	    buf->st_blocks = (buf->st_size + buf->st_blksize - 1)
+		/ buf->st_blksize;
+
+	    /*
+	     * The times returned by the Mac file system are in the
+	     * local time zone.  We convert them to GMT so that the
+	     * epoch starts from GMT.  This is also consistant with
+	     * what is returned from "clock seconds".
+	     */
+	    if (initalized == false) {
+		MachineLocation loc;
+    
+		ReadLocation(&loc);
+		gmt_offset = loc.u.gmtDelta & 0x00ffffff;
+		if (gmt_offset & 0x00800000) {
+		    gmt_offset = gmt_offset | 0xff000000;
+		}
+		initalized = true;
+	    }
+	    buf->st_atime = buf->st_mtime = fpb.ioFlMdDat - gmt_offset;
+	    buf->st_ctime = fpb.ioFlCrDat - gmt_offset;
+
+	}
+    }
+
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+    }
+    
+    return (err == noErr ? 0 : -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacReadlink --
+ *
+ *	This function replaces the library version of readlink.
+ *
+ * Results:
+ *	See readlink documentation.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacReadlink(
+    char *path,
+    char *buf,
+    int size)
+{
+    HFileInfo fpb;
+    OSErr err;
+    FSSpec fileSpec;
+    Boolean isDirectory;
+    Boolean wasAlias;
+    long dirID;
+    char fileName[256];
+    char *end;
+    Handle theString = NULL;
+    int pathSize;
+
+    /*
+     * Remove ending colons if they exist.
+     */
+    while ((strlen(path) != 0) && (path[strlen(path) - 1] == ':')) {
+	path[strlen(path) - 1] = NULL;
+    }
+
+    if (strchr(path, ':') == NULL) {
+	strcpy(fileName, path);
+	path = NULL;
+    } else {
+	end = strrchr(path, ':') + 1;
+	strcpy(fileName, end);
+	*end = NULL;
+    }
+    c2pstr(fileName);
+    
+    /*
+     * Create the file spec for the directory of the file
+     * we want to look at.
+     */
+    if (path != NULL) {
+	err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+	if (err != noErr) {
+	    errno = EINVAL;
+	    return -1;
+	}
+    } else {
+	FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
+    }
+    
+    /*
+     * Fill the fpb struct up with info about file or directory.
+     */
+    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    fpb.ioVRefNum = fileSpec.vRefNum;
+    fpb.ioDirID = dirID;
+    fpb.ioNamePtr = (StringPtr) fileName;
+
+    fpb.ioFDirIndex = 0;
+    err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	return -1;
+    } else {
+	if (fpb.ioFlAttrib & 0x10) {
+	    errno = EINVAL;
+	    return -1;
+	} else {
+	    if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
+		/*
+		 * The file is a link!
+		 */
+	    } else {
+		errno = EINVAL;
+		return -1;
+	    }
+	}
+    }
+    
+    /*
+     * If we are here it's really a link - now find out
+     * where it points to.
+     */
+    err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, &fileSpec);
+    if (err == noErr) {
+	err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
+    }
+    if ((err == fnfErr) || wasAlias) {
+	err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
+	if ((err != noErr) || (pathSize > size)) {
+	    DisposeHandle(theString);
+	    errno = ENAMETOOLONG;
+	    return -1;
+	}
+    } else {
+    	errno = EINVAL;
+	return -1;
+    }
+
+    strncpy(buf, *theString, pathSize);
+    DisposeHandle(theString);
+    
+    return pathSize;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpAccess --
+ *
+ *	This function replaces the library version of access.  The
+ *	access function provided by most Mac compiliers is rather 
+ *	broken or incomplete.
+ *
+ * Results:
+ *	See access documentation.
+ *
+ * Side effects:
+ *	See access documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpAccess(
+    const char *path,
+    int mode)
+{
+    HFileInfo fpb;
+    HVolumeParam vpb;
+    OSErr err;
+    FSSpec fileSpec;
+    Boolean isDirectory;
+    long dirID;
+    int full_mode = 0;
+
+    err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	return -1;
+    }
+    
+    /*
+     * Fill the fpb & vpb struct up with info about file or directory.
+     */
+    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+    vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
+    vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
+    if (isDirectory) {
+	fpb.ioDirID = fileSpec.parID;
+    } else {
+	fpb.ioDirID = dirID;
+    }
+
+    fpb.ioFDirIndex = 0;
+    err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
+    if (err == noErr) {
+	vpb.ioVolIndex = 0;
+	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
+	if (err == noErr) {
+	    /* 
+	     * Use the Volume Info & File Info to determine
+	     * access information.  If we have got this far
+	     * we know the directory is searchable or the file
+	     * exists.  (We have F_OK)
+	     */
+
+	    /*
+	     * Check to see if the volume is hardware or
+	     * software locked.  If so we arn't W_OK.
+	     */
+	    if (mode & W_OK) {
+		if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
+		    errno = EROFS;
+		    return -1;
+		}
+		if (fpb.ioFlAttrib & 0x01) {
+		    errno = EACCES;
+		    return -1;
+		}
+	    }
+	    
+	    /*
+	     * Directories are always searchable and executable.  But only 
+	     * files of type 'APPL' are executable.
+	     */
+	    if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
+	    	&& (fpb.ioFlFndrInfo.fdType != 'APPL')) {
+		return -1;
+	    }
+	}
+    }
+
+    if (err != noErr) {
+	errno = TclMacOSErrorToPosixError(err);
+	return -1;
+    }
+    
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacFOpenHack --
+ *
+ *	This function replaces fopen.  It supports paths with alises.
+ *	Note, remember to undefine the fopen macro!
+ *
+ * Results:
+ *	See fopen documentation.
+ *
+ * Side effects:
+ *	See fopen documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef fopen
+FILE *
+TclMacFOpenHack(
+    const char *path,
+    const char *mode)
+{
+    OSErr err;
+    FSSpec fileSpec;
+    Handle pathString = NULL;
+    int size;
+    FILE * f;
+    
+    err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
+    if ((err != noErr) && (err != fnfErr)) {
+	return NULL;
+    }
+    err = FSpPathFromLocation(&fileSpec, &size, &pathString);
+    if ((err != noErr) && (err != fnfErr)) {
+	return NULL;
+    }
+    
+    HLock(pathString);
+    f = fopen(*pathString, mode);
+    HUnlock(pathString);
+    DisposeHandle(pathString);
+    return f;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacOSErrorToPosixError --
+ *
+ *	Given a Macintosh OSErr return the appropiate POSIX error.
+ *
+ * Results:
+ *	A Posix error.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacOSErrorToPosixError(
+    int error)	/* A Macintosh error. */
+{
+    switch (error) {
+	case noErr:
+	    return 0;
+	case bdNamErr:
+	    return ENAMETOOLONG;
+	case afpObjectTypeErr:
+	    return ENOTDIR;
+	case fnfErr:
+	case dirNFErr:
+	    return ENOENT;
+	case dupFNErr:
+	    return EEXIST;
+	case dirFulErr:
+	case dskFulErr:
+	    return ENOSPC;
+	case fBsyErr:
+	    return EBUSY;
+	case tmfoErr:
+	    return ENFILE;
+	case fLckdErr:
+	case permErr:
+	case afpAccessDenied:
+	    return EACCES;
+	case wPrErr:
+	case vLckdErr:
+	    return EROFS;
+	case badMovErr:
+	    return EINVAL;
+	case diffVolErr:
+	    return EXDEV;
+	default:
+	    return EINVAL;
+    }
+}
diff --git a/tcl/mac/tclMacInit.c b/tcl/mac/tclMacInit.c
new file mode 100644
index 00000000000..218ca12a156
--- /dev/null
+++ b/tcl/mac/tclMacInit.c
@@ -0,0 +1,284 @@
+/*
+ * tclMacInit.c --
+ *
+ *	Contains the Mac-specific interpreter initialization functions.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Files.h>
+#include <Gestalt.h>
+#include <TextUtils.h>
+#include <Resources.h>
+#include <Strings.h>
+#include "tclInt.h"
+#include "tclMacInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPlatformInit --
+ *
+ *	Performs Mac-specific interpreter initialization related to the
+ *      tcl_platform and tcl_library variables.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets "tcl_library" & "tcl_platfrom" Tcl variable
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPlatformInit(
+    Tcl_Interp *interp)		/* Tcl interpreter to initialize. */
+{
+    char *libDir;
+    Tcl_DString path, libPath;
+    long int gestaltResult;
+    int minor, major;
+    char versStr[10];
+
+    /*
+     * Set runtime C variable that tells cross platform C functions
+     * what platform they are running on.  This can change at
+     * runtime for testing purposes.
+     */
+    tclPlatform = TCL_PLATFORM_MAC;
+    
+    /*
+     * Define the tcl_platfrom variable.
+     */
+    Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
+	    TCL_GLOBAL_ONLY);
+    Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
+    Gestalt(gestaltSystemVersion, &gestaltResult);
+    major = (gestaltResult & 0x0000FF00) >> 8;
+    minor = (gestaltResult & 0x000000F0) >> 4;
+    sprintf(versStr, "%d.%d", major, minor);
+    Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
+#if GENERATINGPOWERPC
+    Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
+#else
+    Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
+#endif
+
+    /*
+     * The tcl_library path can be found in one of two places.  As an element
+     * in the env array.  Or the default which is to a folder in side the
+     * Extensions folder of your system.
+     */
+     
+    Tcl_DStringInit(&path);
+    libDir = Tcl_GetVar2(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY);
+    if (libDir != NULL) {
+	Tcl_SetVar(interp, "tcl_library", libDir, TCL_GLOBAL_ONLY);
+    } else {
+	libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
+	if (libDir != NULL) {
+	    Tcl_JoinPath(1, &libDir, &path);
+	    
+	    Tcl_DStringInit(&libPath);
+	    Tcl_DStringAppend(&libPath, ":Tool Command Language:tcl", -1);
+	    Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
+	    Tcl_JoinPath(1, &libPath.string, &path);
+	    Tcl_DStringFree(&libPath);
+	    Tcl_SetVar(interp, "tcl_library", path.string, TCL_GLOBAL_ONLY);
+	} else {
+	    Tcl_SetVar(interp, "tcl_library", "no library", TCL_GLOBAL_ONLY);
+	}
+    }
+    
+    /*
+     * Now create the tcl_pkgPath variable.
+     */
+    Tcl_DStringSetLength(&path, 0);
+    libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
+    if (libDir != NULL) {
+	Tcl_JoinPath(1, &libDir, &path);
+	libDir = ":Tool Command Language:";
+	Tcl_JoinPath(1, &libDir, &path);
+	Tcl_SetVar(interp, "tcl_pkgPath", path.string,
+		TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
+    } else {
+	Tcl_SetVar(interp, "tcl_pkgPath", "no extension folder",
+		TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
+    }
+    Tcl_DStringFree(&path);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCheckStackSpace --
+ *
+ *	On a 68K Mac, we can detect if we are about to blow the stack.
+ *	Called before an evaluation can happen when nesting depth is
+ *	checked.
+ *
+ * Results:
+ *	1 if there is enough stack space to continue; 0 if not.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCheckStackSpace()
+{
+    return StackSpace() > TCL_MAC_STACK_THRESHOLD;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Init --
+ *
+ *	This procedure is typically invoked by Tcl_AppInit procedures
+ *	to perform additional initialization for a Tcl interpreter,
+ *	such as sourcing the "init.tcl" script.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code and sets interp->result
+ *	if there is an error.
+ *
+ * Side effects:
+ *	Depends on what's in the init.tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Init(
+    Tcl_Interp *interp)		/* Interpreter to initialize. */
+{
+    static char initCmd[] =
+	"if {[catch {source -rsrc Init}] != 0} {\n\
+	if [file exists [info library]:init.tcl] {\n\
+	    source [info library]:init.tcl\n\
+	} else {\n\
+	    set msg \"can't find Init resource or [info library]:init.tcl;\"\n\
+	    append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
+	    append msg \"TCL_LIBRARY environment variable?\"\n\
+	    error $msg\n\
+	}\n}\n\
+        if {[catch {source -rsrc History}] != 0} {\n\
+	if [file exists [info library]:history.tcl] {\n\
+	    source [info library]:history.tcl\n\
+	} else {\n\
+	    set msg \"can't find History resource or [info library]:history.tcl;\"\n\
+	    append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
+	    append msg \"TCL_LIBRARY environment variable?\"\n\
+	    error $msg\n\
+	}\n}\n\
+        if {[catch {source -rsrc Word}] != 0} {\n\
+	if [file exists [info library]:word.tcl] {\n\
+	    source [info library]:word.tcl\n\
+	} else {\n\
+	    set msg \"can't find Word resource or [info library]:word.tcl;\"\n\
+	    append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
+	    append msg \"TCL_LIBRARY environment variable?\"\n\
+	    error $msg\n\
+	}\n}";
+
+    /*
+     * For Macintosh applications the Init function may be contained in
+     * the application resources.  If it exists we use it - otherwise we
+     * look in the tcl_library directory.  Ditto for the history command.
+     */
+    
+    return Tcl_Eval(interp, initCmd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SourceRCFile --
+ *
+ *	This procedure is typically invoked by Tcl_Main or Tk_Main
+ *	procedure to source an application specific rc file into the
+ *	interpreter at startup time.  This will either source a file
+ *	in the "tcl_rcFileName" variable or a TEXT resource in the
+ *	"tcl_rcRsrcName" variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on what's in the rc script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SourceRCFile(
+    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
+{
+    Tcl_DString temp;
+    char *fileName;
+    Tcl_Channel errChannel;
+    Handle h;
+
+    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);
+    }
+
+    fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
+
+    if (fileName != NULL) {
+	c2pstr(fileName);
+	h = GetNamedResource('TEXT', (StringPtr) fileName);
+	p2cstr((StringPtr) fileName);
+	if (h != NULL) {
+	    if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
+		errChannel = Tcl_GetStdChannel(TCL_STDERR);
+		if (errChannel) {
+		    Tcl_Write(errChannel, interp->result, -1);
+		    Tcl_Write(errChannel, "\n", 1);
+		}
+	    }
+	    Tcl_ResetResult(interp);
+	    ReleaseResource(h);
+	}
+    }
+}
diff --git a/tcl/mac/tclMacInt.h b/tcl/mac/tclMacInt.h
new file mode 100644
index 00000000000..303b1d93060
--- /dev/null
+++ b/tcl/mac/tclMacInt.h
@@ -0,0 +1,79 @@
+/*
+ * tclMacInt.h --
+ *
+ *	Declarations of Macintosh specific shared variables and procedures.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLMACINT
+#define _TCLMACINT
+
+#ifndef _TCL
+#   include "tcl.h"
+#endif
+#ifndef _TCLMAC
+#   include "tclMac.h"
+#endif
+
+#include <Events.h>
+#include <Files.h>
+
+#pragma export on
+
+/*
+ * Defines to control stack behavior
+ */
+
+#define TCL_MAC_68K_STACK_GROWTH (256*1024)
+#define TCL_MAC_STACK_THRESHOLD 16384
+
+/*
+ * This flag is passed to TclMacRegisterResourceFork
+ * by a file (usually a library) whose resource fork
+ * should not be closed by the resource command.
+ */
+ 
+#define TCL_RESOURCE_DONT_CLOSE  2
+
+/*
+ * Typedefs used by Macintosh parts of Tcl.
+ */
+typedef pascal void (*ExitToShellProcPtr)(void);
+
+/*
+ * Prototypes for functions found in the tclMacUtil.c compatability library.
+ */
+
+EXTERN int 	FSpGetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
+EXTERN int 	FSpSetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
+EXTERN OSErr 	FSpFindFolder _ANSI_ARGS_((short vRefNum, OSType folderType,
+		    Boolean createFolder, FSSpec *spec));
+EXTERN void	GetGlobalMouse _ANSI_ARGS_((Point *mouse));
+
+/*
+ * Prototypes of Mac only internal functions.
+ */
+
+EXTERN void	TclCreateMacEventSource _ANSI_ARGS_((void));
+EXTERN int	TclMacConsoleInit _ANSI_ARGS_((void));
+EXTERN void	TclMacExitHandler _ANSI_ARGS_((void));
+EXTERN void	TclMacInitExitToShell _ANSI_ARGS_((int usePatch));
+EXTERN OSErr	TclMacInstallExitToShellPatch _ANSI_ARGS_((
+		    ExitToShellProcPtr newProc));
+EXTERN int	TclMacOSErrorToPosixError _ANSI_ARGS_((int error));
+EXTERN void	TclMacRemoveTimer _ANSI_ARGS_((void *timerToken));
+EXTERN void *	TclMacStartTimer _ANSI_ARGS_((long ms));
+EXTERN int	TclMacTimerExpired _ANSI_ARGS_((void *timerToken));
+EXTERN int	TclMacRegisterResourceFork _ANSI_ARGS_((short fileRef, Tcl_Obj *tokenPtr,
+                    int insert));	
+EXTERN short	TclMacUnRegisterResourceFork _ANSI_ARGS_((char *tokenPtr, Tcl_Obj *resultPtr));	
+		    
+#pragma export reset
+
+#endif /* _TCLMACINT */
diff --git a/tcl/mac/tclMacInterupt.c b/tcl/mac/tclMacInterupt.c
new file mode 100644
index 00000000000..d0ea2865cf5
--- /dev/null
+++ b/tcl/mac/tclMacInterupt.c
@@ -0,0 +1,289 @@
+/* 
+ * tclMacInterupt.c --
+ *
+ *	This file contains routines that deal with the Macintosh's low level
+ *	time manager.  This code provides a better resolution timer than what
+ *	can be provided by WaitNextEvent.  
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclMacInt.h"
+#include <LowMem.h>
+#include <Processes.h>
+#include <Timer.h>
+
+/*
+ * Data structure for timer tasks.
+ */
+typedef struct TMInfo {
+    TMTask		tmTask;
+    ProcessSerialNumber	psn;
+    Point 		lastPoint;
+    Point 		newPoint;
+    long 		currentA5;
+    long 		ourA5;
+    int			installed;
+} TMInfo;
+
+/*
+ * Globals used within this file.
+ */
+ 
+static TimerUPP sleepTimerProc = NULL;
+static int interuptsInited = false;
+static ProcessSerialNumber applicationPSN;
+#define MAX_TIMER_ARRAY_SIZE 16
+static TMInfo timerInfoArray[MAX_TIMER_ARRAY_SIZE];
+static int topTimerElement = 0;
+
+/*
+ * Prototypes for procedures that are referenced only in this file:
+ */
+
+#if !GENERATINGCFM
+static TMInfo * 	GetTMInfo(void) ONEWORDINLINE(0x2E89); /* MOVE.L A1,(SP) */
+#endif
+static void		SleepTimerProc _ANSI_ARGS_((void));
+static pascal void	CleanUpExitProc _ANSI_ARGS_((void));
+static void		InitInteruptSystem _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitInteruptSystem --
+ *
+ *	Does various initialization for the functions used in this 
+ *	file.  Sets up Universial Pricedure Pointers, installs a trap
+ *	patch for ExitToShell, etc.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Various initialization.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+InitInteruptSystem()
+{
+    int i;
+    
+    sleepTimerProc = NewTimerProc(SleepTimerProc);
+    GetCurrentProcess(&applicationPSN);
+    for (i = 0; i < MAX_TIMER_ARRAY_SIZE; i++) {
+	timerInfoArray[i].installed = false;
+    }
+    
+    /*
+     * Install the ExitToShell patch.  We use this patch instead
+     * of the Tcl exit mechanism because we need to ensure that
+     * these routines are cleaned up even if we crash or are forced
+     * to quit.  There are some circumstances when the Tcl exit
+     * handlers may not fire.
+     */
+     
+    TclMacInstallExitToShellPatch(CleanUpExitProc);
+    interuptsInited = true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacStartTimer --
+ *
+ *	Install a Time Manager task to wake our process up in the
+ *	future.  The process should get a NULL event after ms 
+ *	milliseconds.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Schedules our process to wake up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void *
+TclMacStartTimer(
+    long ms)		/* Milliseconds. */
+{
+    TMInfo *timerInfoPtr;
+    
+    if (!interuptsInited) {
+	InitInteruptSystem();
+    }
+    
+    /*
+     * Obtain a pointer for the timer.  We only allocate up
+     * to MAX_TIMER_ARRAY_SIZE timers.  If we are past that
+     * max we return NULL.
+     */
+    if (topTimerElement < MAX_TIMER_ARRAY_SIZE) {
+	timerInfoPtr = &timerInfoArray[topTimerElement];
+	topTimerElement++;
+    } else {
+	return NULL;
+    }
+    
+    /*
+     * Install timer to wake process in ms milliseconds.
+     */
+    timerInfoPtr->tmTask.tmAddr = sleepTimerProc;
+    timerInfoPtr->tmTask.tmWakeUp = 0;
+    timerInfoPtr->tmTask.tmReserved = 0;
+    timerInfoPtr->psn = applicationPSN;
+    timerInfoPtr->installed = true;
+
+    InsTime((QElemPtr) timerInfoPtr);
+    PrimeTime((QElemPtr) timerInfoPtr, (long) ms);
+
+    return (void *) timerInfoPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacRemoveTimer --
+ *
+ *	Remove the timer event from the Time Manager.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A scheduled timer would be removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclMacRemoveTimer(
+    void * timerToken)		/* Token got from start timer. */
+{
+    TMInfo *timerInfoPtr = (TMInfo *) timerToken;
+    
+    if (timerInfoPtr == NULL) {
+	return;
+    }
+    
+    RmvTime((QElemPtr) timerInfoPtr);
+    timerInfoPtr->installed = false;
+    topTimerElement--;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacTimerExpired --
+ *
+ *	Check to see if the installed timer has expired.
+ *
+ * Results:
+ *	True if timer has expired, false otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacTimerExpired(
+    void * timerToken)		/* Our token again. */
+{
+    TMInfo *timerInfoPtr = (TMInfo *) timerToken;
+    
+    if ((timerInfoPtr == NULL) || 
+	!(timerInfoPtr->tmTask.qType & kTMTaskActive)) {
+	return true;
+    } else {
+	return false;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SleepTimerProc --
+ *
+ *	Time proc is called by the is a callback routine placed in the 
+ *	system by Tcl_Sleep.  The routine is called at interupt time
+ *	and threrfor can not move or allocate memory.  This call will
+ *	schedule our process to wake up the next time the process gets
+ *	around to consider running it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Schedules our process to wake up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SleepTimerProc()
+{
+    /*
+     * In CFM code we can access our code directly.  In 68k code that
+     * isn't based on CFM we must do a glorious hack.  The function 
+     * GetTMInfo is an inline assembler call that moves the pointer 
+     * at A1 to the top of the stack.  The Time Manager keeps the TMTask
+     * info record there before calling this call back.  In order for
+     * this to work the infoPtr argument must be the *last* item on the
+     * stack.  If we "piggyback" our data to the TMTask info record we 
+     * can get access to the information we need.  While this is really 
+     * ugly - it's the way Apple recomends it be done - go figure...
+     */
+    
+#if GENERATINGCFM
+    WakeUpProcess(&applicationPSN);
+#else
+    TMInfo * infoPtr;
+    
+    infoPtr = GetTMInfo();
+    WakeUpProcess(&infoPtr->psn);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanUpExitProc --
+ *
+ *	This procedure is invoked as an exit handler when ExitToShell
+ *	is called.  It removes the system level timer handler if it 
+ *	is installed.  This must be called or the Mac OS will more than 
+ *	likely crash.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal void
+CleanUpExitProc()
+{
+    int i;
+    
+    for (i = 0; i < MAX_TIMER_ARRAY_SIZE; i++) {
+	if (timerInfoArray[i].installed) {
+	    RmvTime((QElemPtr) &timerInfoArray[i]);
+	    timerInfoArray[i].installed = false;
+	}
+    }
+}
diff --git a/tcl/mac/tclMacLibrary.c b/tcl/mac/tclMacLibrary.c
new file mode 100644
index 00000000000..e3668f5efe6
--- /dev/null
+++ b/tcl/mac/tclMacLibrary.c
@@ -0,0 +1,241 @@
+/*
+ * tclMacLibrary.c --
+ *
+ *	This file should be included in Tcl extensions that want to 
+ *	automatically oepn their resource forks when the code is linked. 
+ *	These routines should not be exported but should be compiled 
+ *	locally by each fragment.  Many thanks to Jay Lieske
+ *	<lieske@princeton.edu> who provide an initial version of this
+ *	file.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Here is another place that we are using the old routine names...
+ */
+ 
+#define OLDROUTINENAMES 1
+
+#include <CodeFragments.h>
+#include <Errors.h>
+#include <Resources.h>
+#include <Strings.h>
+#include "tclMacInt.h"
+
+/*
+ * These function are not currently defined in any header file.  The
+ * only place they should be used is in the Initialization and
+ * Termination entry points for a code fragment.  The prototypes
+ * are included here to avoid compile errors.
+ */
+
+OSErr TclMacInitializeFragment _ANSI_ARGS_((
+			struct CFragInitBlock* initBlkPtr));
+void TclMacTerminateFragment _ANSI_ARGS_((void));
+
+/*
+ * Static functions in this file.
+ */
+
+static OSErr OpenLibraryResource _ANSI_ARGS_((
+			struct CFragInitBlock* initBlkPtr));
+static void CloseLibraryResource _ANSI_ARGS_((void));
+
+/* 
+ * The refnum of the opened resource fork.
+ */
+static short ourResFile = kResFileNotOpened;
+
+/*
+ * This is the resource token for the our resource file.
+ * It stores the name we registered with the resource facility.
+ * We only need to use this if we are actually registering ourselves.
+ */
+  
+#ifdef TCL_REGISTER_LIBRARY
+static Tcl_Obj *ourResToken;
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacInitializeFragment --
+ *
+ *	Called by MacOS CFM when the shared library is loaded. All this
+ *	function really does is give Tcl a chance to open and register
+ *	the resource fork of the library. 
+ *
+ * Results:
+ *	MacOS error code if loading should be canceled.
+ *
+ * Side effects:
+ *	Opens the resource fork of the shared library file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSErr
+TclMacInitializeFragment(
+    struct CFragInitBlock* initBlkPtr)		/* Pointer to our library. */
+{
+    OSErr err = noErr;
+
+#ifdef __MWERKS__
+    {
+    	extern OSErr __initialize( CFragInitBlock* initBlkPtr);
+    	err = __initialize((CFragInitBlock *) initBlkPtr);
+    }
+#endif
+    if (err == noErr)
+    	err = OpenLibraryResource( initBlkPtr);
+    return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacTerminateFragment --
+ *
+ *	Called by MacOS CFM when the shared library is unloaded.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The resource fork of the code fragment is closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void 
+TclMacTerminateFragment()
+{
+    CloseLibraryResource();
+
+#ifdef __MWERKS__
+    {
+    	extern void __terminate(void);
+    	__terminate();
+    }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenLibraryResource --
+ *
+ *	This routine can be called by a MacOS fragment's initialiation 
+ *	function to open the resource fork of the file.  
+ *	Call it with the same data passed to the initialization function. 
+ *	If the fragment loading should fail if the resource fork can't 
+ *	be opened, then the initialization function can pass on this 
+ *	return value.
+ *
+ *      If you #define TCL_REGISTER_RESOURCE before compiling this resource, 
+ *	then your library will register its open resource fork with the
+ *      resource command.
+ *
+ * Results:
+ *	It returns noErr on success and a MacOS error code on failure.
+ *
+ * Side effects:
+ *	The resource fork of the code fragment is opened read-only and 
+ *	is installed at the head of the resource chain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSErr 
+OpenLibraryResource(
+    struct CFragInitBlock* initBlkPtr)
+{
+    /*
+     * The 3.0 version of the Universal headers changed CFragInitBlock
+     * to an opaque pointer type.  CFragSystem7InitBlock is now the
+     * real pointer.
+     */
+     
+#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
+    struct CFragInitBlock *realInitBlkPtr = initBlkPtr;
+#else 
+    CFragSystem7InitBlock *realInitBlkPtr = (CFragSystem7InitBlock *) initBlkPtr;
+#endif
+    FSSpec* fileSpec = NULL;
+    OSErr err = noErr;
+    
+
+    if (realInitBlkPtr->fragLocator.where == kOnDiskFlat) {
+    	fileSpec = realInitBlkPtr->fragLocator.u.onDisk.fileSpec;
+    } else if (realInitBlkPtr->fragLocator.where == kOnDiskSegmented) {
+    	fileSpec = realInitBlkPtr->fragLocator.u.inSegs.fileSpec;
+    } else {
+    	err = resFNotFound;
+    }
+
+    /*
+     * Open the resource fork for this library in read-only mode.  
+     * This will make it the current res file, ahead of the 
+     * application's own resources.
+     */
+    
+    if (fileSpec != NULL) {
+	ourResFile = FSpOpenResFile(fileSpec, fsRdPerm);
+	if (ourResFile == kResFileNotOpened) {
+	    err = ResError();
+	} else {
+#ifdef TCL_REGISTER_LIBRARY
+	    ourResToken = Tcl_NewObj();
+	    Tcl_IncrRefCount(ourResToken);
+	    p2cstr(realInitBlkPtr->libName);
+	    Tcl_SetStringObj(ourResToken, (char *) realInitBlkPtr->libName, -1);
+	    c2pstr((char *) realInitBlkPtr->libName);
+	    TclMacRegisterResourceFork(ourResFile, ourResToken,
+	            TCL_RESOURCE_DONT_CLOSE);
+#endif
+            SetResFileAttrs(ourResFile, mapReadOnly);
+	}
+    }
+    
+    return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseLibraryResource --
+ *
+ *	This routine should be called by a MacOS fragment's termination 
+ *	function to close the resource fork of the file 
+ *	that was opened with OpenLibraryResource.  
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The resource fork of the code fragment is closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CloseLibraryResource()
+{
+    if (ourResFile != kResFileNotOpened) {
+#ifdef TCL_REGISTER_LIBRARY
+        int length;
+        TclMacUnRegisterResourceFork(
+	        Tcl_GetStringFromObj(ourResToken, &length),
+                NULL);
+        Tcl_DecrRefCount(ourResToken);
+#endif
+	CloseResFile(ourResFile);
+	ourResFile = kResFileNotOpened;
+    }
+}
diff --git a/tcl/mac/tclMacLibrary.r b/tcl/mac/tclMacLibrary.r
new file mode 100644
index 00000000000..8da1a8119e1
--- /dev/null
+++ b/tcl/mac/tclMacLibrary.r
@@ -0,0 +1,223 @@
+/* 
+ * tclMacLibrary.r --
+ *
+ *	This file creates resources used by the Tcl shared library.
+ *	Many thanks go to "Jay Lieske, Jr." <lieske@princeton.edu> who
+ *	wrote the initial version of this file.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+
+#if (TCL_RELEASE_LEVEL == 0)
+#   define RELEASE_LEVEL alpha
+#elif (TCL_RELEASE_LEVEL == 1)
+#   define RELEASE_LEVEL beta
+#elif (TCL_RELEASE_LEVEL == 2)
+#   define RELEASE_LEVEL final
+#endif
+
+#if (TCL_RELEASE_LEVEL == 2)
+#   define MINOR_VERSION (TCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+#else
+#   define MINOR_VERSION TCL_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+	TCL_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	TCL_PATCH_LEVEL,
+	TCL_PATCH_LEVEL ", by Ray Johnson © Sun Microsystems"
+};
+
+resource 'vers' (2) {
+	TCL_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	TCL_PATCH_LEVEL,
+	"Tcl Library " TCL_PATCH_LEVEL " © 1996"
+};
+
+/*
+ * Currently the creator for all Tcl/Tk libraries and extensions
+ * should be 'TclL'.  This will allow those extension and libraries
+ * to use the common icon for Tcl extensions.  However, this signature
+ * still needs to be approved by the signature police at Apple and may
+ * change.
+ */
+#define TCL_CREATOR 'TclL'
+#define TCL_LIBRARY_RESOURCES 2000
+
+/*
+ * The 'BNDL' resource is the primary link between a file's
+ * creator/type and its icon.  This resource acts for all Tcl shared
+ * libraries; other libraries will not need one and ought to use
+ * custom icons rather than new file types for a different appearance.
+ */
+
+resource 'BNDL' (TCL_LIBRARY_RESOURCES, "Tcl bundle", purgeable) 
+{
+	TCL_CREATOR,
+	0,
+	{	/* array TypeArray: 2 elements */
+		/* [1] */
+		'FREF',
+		{	/* array IDArray: 1 elements */
+			/* [1] */
+			0, TCL_LIBRARY_RESOURCES
+		},
+		/* [2] */
+		'ICN#',
+		{	/* array IDArray: 1 elements */
+			/* [1] */
+			0, TCL_LIBRARY_RESOURCES
+		}
+	}
+};
+
+resource 'FREF' (TCL_LIBRARY_RESOURCES, purgeable) 
+{
+	'shlb', 0, ""
+};
+
+type TCL_CREATOR as 'STR ';
+resource TCL_CREATOR (0, purgeable) {
+	"Tcl Library " TCL_PATCH_LEVEL " © 1996"
+};
+
+/*
+ * The 'kind' resource works with a 'BNDL' in Macintosh Easy Open
+ * to affect the text the Finder displays in the "kind" column and
+ * file info dialog.  This information will be applied to all files
+ * with the listed creator and type.
+ */
+
+resource 'kind' (TCL_LIBRARY_RESOURCES, "Tcl kind", purgeable) {
+	TCL_CREATOR,
+	0, /* region = USA */
+	{
+		'shlb', "Tcl Library"
+	}
+};
+
+
+/*
+ * The -16397 string will be displayed by Finder when a user
+ * tries to open the shared library. The string should
+ * give the user a little detail about the library's capabilities
+ * and enough information to install the library in the correct location.  
+ * A similar string should be placed in all shared libraries.
+ */
+resource 'STR ' (-16397, purgeable) {
+	"Tcl Library\n\n"
+	"This is the core library needed to run Tool Command Language programs. "
+	"To work properly, it should be placed in the ÔTool Command LanguageÕ folder "
+	"within the Extensions folder."
+};
+
+/* 
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application.  The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl".  This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * require some predetermined file structure - all needed Tcl "files"
+ * are located within the application.  To source a file for the
+ * resource fork the source command has been modified to support
+ * sourcing from resources.  In the below case "source -rsrc {Init}"
+ * will load the TEXT resource named "Init".
+ */
+
+read 'TEXT' (TCL_LIBRARY_RESOURCES, "Init", purgeable) "::library:init.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "History", purgeable) "::library:history.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "Word", purgeable,preload) "::library:word.tcl";
+
+/*
+ * The following are icons for the shared library.
+ */
+
+data 'icl4' (2000, "Tcl Shared Library", purgeable) {
+	$"0FFF FFFF FFFF FFFF FFFF FFFF FFFF 0000"
+	$"F000 0000 0000 0000 0000 0000 000C F000"
+	$"F0CC CFFF CCCC CCC6 66CC CCCC CCCC F000"
+	$"F0CC CFFF FFFF FF66 F6CC CCCC CCCC F000"
+	$"F0CC CFFF 2000 0D66 6CCC CCCC CCCC F000"
+	$"F0CC CFFF 0202 056F 6E5C CCCC CCCC F000"
+	$"F0CC CFFF 2020 C666 F66F CCCC CCCC F000"
+	$"F0CC CFFF 0200 B66F 666B FCCC CCCC F000"
+	$"F0FC CFFF B020 55F6 6F52 BFCC CCCC F000"
+	$"FF0F 0CCC FB02 5665 66D0 2FCC CCCC F0F0"
+	$"F00F 0CCC CFB0 BF55 F6CF FFCC CCCC FFCF"
+	$"000F 0CCC CCFB 06C9 66CC CCCC CCCC F0CF"
+	$"000F 0CCC CCCF 56C6 6CCC CCCC CCCC CCCF"
+	$"000F 0CCC CCCC 6FC6 FCCC CCCC CCCC CCCF"
+	$"000F 0CCC CCCC 65C5 65CC CCCC CCCC CCCF"
+	$"000F 0CCC CCCC 55D6 57CC CCCC CCCC CCCF"
+	$"000F 0CCC CCCC 65CF 6CCC CCCC CCCC CCCF"
+	$"000F 0CCC CCCC 5AC6 6CFF CCCC CCCC CCCF"
+	$"000F 0CCC CCCC 65C5 6CF0 FCCC CCCC CCCF"
+	$"000F 0CCC CCCC CECF CCF0 0FCC CCCC CCCF"
+	$"000F 0CCC CCCC C5C6 CCCF 20FC CCCC FCCF"
+	$"F00F 0CCC CCCF FFD5 CCCC F20F CCCC FFCF"
+	$"FF0F 0CCC CCCF 20CF CCCC F020 FCCC F0F0"
+	$"F0F0 CCCC CCCF B2C2 FFFF 0002 0FFC F000"
+	$"F00C CCCC CCCC FBC0 2000 0020 2FFC F000"
+	$"F0CC CCCC CCCC CFCB 0202 0202 0FFC F000"
+	$"F0CC CCCC CCCC CCCF B020 2020 2FFC F000"
+	$"F0CC CCCC CCCC CCDC FBBB BBBB BFFC F000"
+	$"F0CC CCCC CCCC CCCC CFFF FFFF FFFC F000"
+	$"F0CC CCCC CCCC CCCC CCCC CCCC CFFC F000"
+	$"FCCC CCCC CCCC CCCC CCCC CCCC CCCC F000"
+	$"0FFF FFFF FFFF FFFF FFFF FFFF FFFF 0000"
+};
+
+data 'ICN#' (2000, "Tcl Shared Library", purgeable) {
+	$"7FFF FFF0 8000 0008 8701 C008 87FF C008"
+	$"8703 8008 8707 E008 8707 F008 870F F808"
+	$"A78F EC08 D0CF C40A 906F DC0D 1035 C009"
+	$"101D 8001 100D 8001 100D C001 100D C001"
+	$"100D 8001 100D B001 100D A801 1005 2401"
+	$"1005 1209 901D 090D D011 088A A018 F068"
+	$"800C 0068 8005 0068 8001 8068 8000 FFE8"
+	$"8000 7FE8 8000 0068 8000 0008 7FFF FFF0"
+	$"7FFF FFF0 FFFF FFF8 FFFF FFF8 FFFF FFF8"
+	$"FFFF FFF8 FFFF FFF8 FFFF FFF8 FFFF FFF8"
+	$"FFFF FFF8 DFFF FFFA 9FFF FFFF 1FFF FFFF"
+	$"1FFF FFFF 1FFF FFFF 1FFF FFFF 1FFF FFFF"
+	$"1FFF FFFF 1FFF FFFF 1FFF FFFF 1FFF FFFF"
+	$"1FFF FFFF 9FFF FFFF DFFF FFFA FFFF FFF8"
+	$"FFFF FFF8 FFFF FFF8 FFFF FFF8 FFFF FFF8"
+	$"FFFF FFF8 FFFF FFF8 FFFF FFF8 7FFF FFF0"
+};
+
+data 'ics#' (2000, "Tcl Shared Library", purgeable) {
+	$"FFFE B582 BB82 B3C2 BFA2 43C3 4381 4381"
+	$"4381 4763 4392 856E 838E 81AE 811E FFFE"
+	$"FFFE FFFE FFFE FFFE FFFE FFFF 7FFF 7FFF"
+	$"7FFF 7FFF 7FFF FFFE FFFE FFFE FFFE FFFE"
+};
+
+data 'ics4' (2000, "Tcl Shared Library", purgeable) {
+	$"FFFF FFFF FFFF FFF0 FCFF DED5 6CCC CCF0"
+	$"FCFF C0D6 ECCC CCF0 FCFF 2056 65DC CCF0"
+	$"FDFE D256 6DAC CCFF FFCC DDDE 5DDC CCEF"
+	$"0FCC CD67 5CCC CCCF 0FCC CC5D 6CCC CCCF"
+	$"0FCC CC5D 5CCC CCCF 0FCC CCD5 5CCC CCCF"
+	$"FFCC CFFD CCFF CCFF FCCC CF2D DF20 FCFC"
+	$"FCCC CCFD D202 FEF0 FCCC CC0D 2020 FEF0"
+	$"FCCC CCCD FBBB FEF0 FFFF FFFF FFFF FFE0"
+};
+
diff --git a/tcl/mac/tclMacLoad.c b/tcl/mac/tclMacLoad.c
new file mode 100644
index 00000000000..551096b0137
--- /dev/null
+++ b/tcl/mac/tclMacLoad.c
@@ -0,0 +1,245 @@
+/*
+ * tclMacLoad.c --
+ *
+ *	This procedure provides a version of the TclLoadFile for use
+ *	on the Macintosh.  This procedure will only work with systems 
+ *	that use the Code Fragment Manager.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <CodeFragments.h>
+#include <Errors.h>
+#include <Resources.h>
+#include <Strings.h>
+#include <FSpCompat.h>
+
+/*
+ * Seems that the 3.0.1 Universal headers leave this define out.  So we
+ * define it here...
+ */
+ 
+#ifndef fragNoErr
+    #define fragNoErr noErr
+#endif
+
+#include "tclPort.h"
+#include "tclInt.h"
+#include "tclMacInt.h"
+
+#if GENERATINGPOWERPC
+    #define OUR_ARCH_TYPE kPowerPCCFragArch
+#else
+    #define OUR_ARCH_TYPE kMotorola68KCFragArch
+#endif
+
+/*
+ * The following data structure defines the structure of a code fragment
+ * resource.  We can cast the resource to be of this type to access
+ * any fields we need to see.
+ */
+struct CfrgHeader {
+    long 	res1;
+    long 	res2;
+    long 	version;
+    long 	res3;
+    long 	res4;
+    long 	filler1;
+    long 	filler2;
+    long 	itemCount;
+    char	arrayStart;	/* Array of externalItems begins here. */
+};
+typedef struct CfrgHeader CfrgHeader, *CfrgHeaderPtr, **CfrgHeaderPtrHand;
+
+/*
+ * The below structure defines a cfrag item within the cfrag resource.
+ */
+struct CfrgItem {
+    OSType 	archType;
+    long 	updateLevel;
+    long	currVersion;
+    long	oldDefVersion;
+    long	appStackSize;
+    short	appSubFolder;
+    char	usage;
+    char	location;
+    long	codeOffset;
+    long	codeLength;
+    long	res1;
+    long	res2;
+    short	itemSize;
+    Str255	name;		/* This is actually variable sized. */
+};
+typedef struct CfrgItem CfrgItem;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	This procedure is called to carry out dynamic loading of binary
+ *	code for the Macintosh.  This implementation is based on the
+ *	Code Fragment Manager & will not work on other systems.
+ *
+ * Results:
+ *	The result is TCL_ERROR, and an error message is left in
+ *	interp->result.
+ *
+ * Side effects:
+ *	New binary code is loaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    char *fileName,		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, char *sym2,	/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr,
+    Tcl_PackageInitProc **proc2Ptr)
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    CFragConnectionID connID;
+    Ptr dummy;
+    OSErr err;
+    CFragSymbolClass symClass;
+    FSSpec fileSpec;
+    short fragFileRef, saveFileRef;
+    Handle fragResource;
+    UInt32 offset = 0;
+    UInt32 length = kCFragGoesToEOF;
+    char packageName[255];
+    Str255 errName;
+    
+    /*
+     * First thing we must do is infer the package name from the sym1
+     * variable.  This is kind of dumb since the caller actually knows
+     * this value, it just doesn't give it to us.
+     */
+    strcpy(packageName, sym1);
+    *packageName = (char) tolower(*packageName);
+    packageName[strlen(packageName) - 5] = NULL;
+    
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    if (err != noErr) {
+	interp->result = "could not locate shared library";
+	return TCL_ERROR;
+    }
+    
+    /*
+     * See if this fragment has a 'cfrg' resource.  It will tell us were
+     * to look for the fragment in the file.  If it doesn't exist we will
+     * assume we have a ppc frag using the whole data fork.  If it does
+     * exist we find the frag that matches the one we are looking for and
+     * get the offset and size from the resource.
+     */
+    saveFileRef = CurResFile();
+    SetResLoad(false);
+    fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
+    SetResLoad(true);
+    if (fragFileRef != -1) {
+	UseResFile(fragFileRef);
+	fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
+	HLock(fragResource);
+	if (ResError() == noErr) {
+	    CfrgItem* srcItem;
+	    long itemCount, index;
+	    Ptr itemStart;
+
+	    itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
+	    itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
+	    for (index = 0; index < itemCount;
+		 index++, itemStart += srcItem->itemSize) {
+		srcItem = (CfrgItem*)itemStart;
+		if (srcItem->archType != OUR_ARCH_TYPE) continue;
+		if (!strncasecmp(packageName, (char *) srcItem->name + 1,
+			srcItem->name[0])) {
+		    offset = srcItem->codeOffset;
+		    length = srcItem->codeLength;
+		}
+	    }
+	}
+	/*
+	 * Close the resource file.  If the extension wants to reopen the
+	 * resource fork it should use the tclMacLibrary.c file during it's
+	 * construction.
+	 */
+	HUnlock(fragResource);
+	ReleaseResource(fragResource);
+	CloseResFile(fragFileRef);
+	UseResFile(saveFileRef);
+    }
+
+    /*
+     * Now we can attempt to load the fragement using the offset & length
+     * obtained from the resource.  We don't worry about the main entry point
+     * as we are going to search for specific entry points passed to us.
+     */
+    
+    c2pstr(packageName);
+    err = GetDiskFragment(&fileSpec, offset, length, (StringPtr) packageName,
+	    kLoadCFrag, &connID, &dummy, errName);
+    if (err != fragNoErr) {
+	p2cstr(errName);
+	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+	    "\": ", errName, (char *) NULL);
+	return TCL_ERROR;
+    }
+    
+    c2pstr(sym1);
+    err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
+    p2cstr((StringPtr) sym1);
+    if (err != fragNoErr || symClass == kDataCFragSymbol) {
+	interp->result =
+	    "could not find Initialization routine in library";
+	return TCL_ERROR;
+    }
+
+    c2pstr(sym2);
+    err = FindSymbol(connID, (StringPtr) sym2, (Ptr *) proc2Ptr, &symClass);
+    p2cstr((StringPtr) sym2);
+    if (err != fragNoErr || symClass == kDataCFragSymbol) {
+	*proc2Ptr = NULL;
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(
+    char *fileName,		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr)	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/mac/tclMacMSLPrefix.h b/tcl/mac/tclMacMSLPrefix.h
new file mode 100644
index 00000000000..56af9b22c3a
--- /dev/null
+++ b/tcl/mac/tclMacMSLPrefix.h
@@ -0,0 +1,24 @@
+/*
+ * tclMacMSLPrefix.h --
+ *
+ *  A wrapper for the MSL ansi_prefix.mac.h file.  This just turns export on
+ *  after including the MSL prefix file, so we can export symbols from the MSL
+ *  and through the Tcl shared libraries
+ *  
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <ansi_prefix.mac.h>
+/*
+ * "export" is a MetroWerks specific pragma.  It flags the linker that  
+ * any symbols that are defined when this pragma is on will be exported 
+ * to shared libraries that link with this library.
+ */
+ 
+#pragma export on
diff --git a/tcl/mac/tclMacMath.h b/tcl/mac/tclMacMath.h
new file mode 100644
index 00000000000..cedefb7f078
--- /dev/null
+++ b/tcl/mac/tclMacMath.h
@@ -0,0 +1,145 @@
+/*
+ * tclMacMath.h --
+ *
+ *	This file is necessary because of Metrowerks CodeWarrior Pro 1
+ *	on the Macintosh. With 8-byte doubles turned on, the definitions of
+ *	sin, cos, acos, etc., are screwed up.  They are fine as long as
+ *	they are used as function calls, but if the function pointers
+ *	are passed around and used, they will crash hard on the 68K.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLMACMATH
+#define _TCLMACMATH
+
+#include <math.h>
+
+#if defined(__MWERKS__) && !defined(__POWERPC__)
+#if __option(IEEEdoubles)
+
+#   ifdef cos
+#	undef cos
+#	define cos cosd
+#   endif
+
+#   ifdef sin
+#	undef sin
+#	define sin sind
+#   endif
+
+#   ifdef tan
+#	undef tan
+#	define tan tand
+#   endif
+
+#   ifdef acos
+#	undef acos
+#	define acos acosd
+#   endif
+
+#   ifdef asin
+#	undef asin
+#	define asin asind
+#   endif
+
+#   ifdef atan
+#	undef atan
+#	define atan atand
+#   endif
+
+#   ifdef cosh
+#	undef cosh
+#	define cosh coshd
+#   endif
+
+#   ifdef sinh
+#	undef sinh
+#	define sinh sinhd
+#   endif
+
+#   ifdef tanh
+#	undef tanh
+#	define tanh tanhd
+#   endif
+
+#   ifdef exp
+#	undef exp
+#	define exp expd
+#   endif
+
+#   ifdef ldexp
+#	undef ldexp
+#	define ldexp ldexpd
+#   endif
+
+#   ifdef log
+#	undef log
+#	define log logd
+#   endif
+
+#   ifdef log10
+#	undef log10
+#	define log10 log10d
+#   endif
+
+#   ifdef fabs
+#	undef fabs
+#	define fabs fabsd
+#   endif
+
+#   ifdef sqrt
+#	undef sqrt
+#	define sqrt sqrtd
+#   endif
+
+#   ifdef fmod
+#	undef fmod
+#	define fmod fmodd
+#   endif
+
+#   ifdef atan2
+#	undef atan2
+#	define atan2 atan2d
+#   endif
+
+#   ifdef frexp
+#	undef frexp
+#	define frexp frexpd
+#   endif
+
+#   ifdef modf
+#	undef modf
+#	define modf modfd
+#   endif
+
+#   ifdef pow
+#	undef pow
+#	define pow powd
+#   endif
+
+#   ifdef ceil
+#	undef ceil
+#	define ceil ceild
+#   endif
+
+#   ifdef floor
+#	undef floor
+#	define floor floord
+#   endif
+#endif
+#endif
+
+#if (defined(THINK_C) || defined(__MWERKS__))
+#pragma export on
+double		hypotd(double x, double y);
+#define hypot hypotd
+#pragma export reset
+#endif
+
+#endif /* _TCLMACMATH */
diff --git a/tcl/mac/tclMacNotify.c b/tcl/mac/tclMacNotify.c
new file mode 100644
index 00000000000..db221d72d11
--- /dev/null
+++ b/tcl/mac/tclMacNotify.c
@@ -0,0 +1,416 @@
+/* 
+ * tclMacNotify.c --
+ *
+ *	This file contains Macintosh-specific procedures for the notifier,
+ *	which is the lowest-level part of the Tcl event loop.  This file
+ *	works together with ../generic/tclNotify.c.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+#include <signal.h>
+#include <Events.h>
+#include <LowMem.h>
+#include <Processes.h>
+#include <Timer.h>
+
+
+/* 
+ * This is necessary to work around a bug in Apple's Universal header files
+ * for the CFM68K libraries.
+ */
+
+#ifdef __CFM68K__
+#undef GetEventQueue
+extern pascal QHdrPtr GetEventQueue(void)
+ THREEWORDINLINE(0x2EBC, 0x0000, 0x014A);
+#pragma import list GetEventQueue
+#define GetEvQHdr() GetEventQueue()
+#endif
+
+/*
+ * The follwing static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * The following structure contains the state information for the
+ * notifier module.
+ */
+
+static struct {
+    int timerActive;		/* 1 if timer is running. */
+    Tcl_Time timer;		/* Time when next timer event is expected. */
+    int flags;			/* OR'ed set of flags defined below. */
+    Point lastMousePosition;	/* Last known mouse location. */
+    RgnHandle utilityRgn;	/* Region used as the mouse region for
+				 * WaitNextEvent and the update region when
+				 * checking for events. */   
+    Tcl_MacConvertEventPtr eventProcPtr;
+				/* This pointer holds the address of the
+				 * function that will handle all incoming
+				 * Macintosh events. */
+} notifier;
+
+/*
+ * The following defines are used in the flags field of the notifier struct.
+ */
+
+#define NOTIFY_IDLE	(1<<1)	/* Tcl_ServiceIdle should be called. */
+#define NOTIFY_TIMER	(1<<2)	/* Tcl_ServiceTimer should be called. */
+
+/*
+ * Prototypes for procedures that are referenced only in this file:
+ */
+
+static int		HandleMacEvents _ANSI_ARGS_((void));
+static void		InitNotifier _ANSI_ARGS_((void));
+static void		NotifierExitHandler _ANSI_ARGS_((
+			    ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ *	Initializes the notifier structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new exit handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitNotifier(void)
+{
+    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:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierExitHandler(
+    ClientData clientData)	/* Not used. */
+{
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleMacEvents --
+ *
+ *	This function checks for events from the Macintosh event queue.
+ *
+ * Results:
+ *	Returns 1 if event found, 0 otherwise.
+ *
+ * Side effects:
+ *	Pulls events off of the Mac event queue and then calls
+ *	convertEventProc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HandleMacEvents(void)
+{
+    EventRecord theEvent;
+    int eventFound = 0, needsUpdate = 0;
+    Point currentMouse;
+    WindowRef windowRef;
+    Rect mouseRect;
+
+    /*
+     * Check for mouse moved events.  These events aren't placed on the
+     * system event queue unless we call WaitNextEvent.
+     */
+
+    GetGlobalMouse(&currentMouse);
+    if ((notifier.eventProcPtr != NULL) &&
+	    !EqualPt(currentMouse, notifier.lastMousePosition)) {
+	notifier.lastMousePosition = currentMouse;
+	theEvent.what = nullEvent;
+	if ((*notifier.eventProcPtr)(&theEvent) == true) {
+	    eventFound = 1;
+	}
+    }
+
+    /*
+     * Check for update events.  Since update events aren't generated
+     * until we call GetNextEvent, we may need to force a call to
+     * GetNextEvent, even if the queue is empty.
+     */
+
+    for (windowRef = FrontWindow(); windowRef != NULL;
+	    windowRef = GetNextWindow(windowRef)) {
+	GetWindowUpdateRgn(windowRef, notifier.utilityRgn);
+	if (!EmptyRgn(notifier.utilityRgn)) {
+	    needsUpdate = 1;
+	    break;
+	}
+    }
+    
+    /*
+     * Process events from the OS event queue.
+     */
+
+    while (needsUpdate || (GetEvQHdr()->qHead != NULL)) {
+	GetGlobalMouse(&currentMouse);
+	SetRect(&mouseRect, currentMouse.h, currentMouse.v,
+		currentMouse.h + 1, currentMouse.v + 1);
+	RectRgn(notifier.utilityRgn, &mouseRect);
+	
+	WaitNextEvent(everyEvent, &theEvent, 5, notifier.utilityRgn);
+	needsUpdate = 0;
+	if ((notifier.eventProcPtr != NULL)
+		&& ((*notifier.eventProcPtr)(&theEvent) == true)) {
+	    eventFound = 1;
+	}
+    }
+    
+    return eventFound;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ *	This procedure sets the current notifier timer value.  The
+ *	notifier will ensure that Tcl_ServiceAll() is called after
+ *	the specified interval, even if no events have occurred.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Replaces any previous timer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimer(
+    Tcl_Time *timePtr)		/* New value for interval timer. */
+{
+    if (!timePtr) {
+	notifier.timerActive = 0;
+    } else {
+	/*
+	 * Compute when the timer should fire.
+	 */
+	
+	TclpGetTime(&notifier.timer);
+	notifier.timer.sec += timePtr->sec;
+	notifier.timer.usec += timePtr->usec;
+	if (notifier.timer.usec >= 1000000) {
+	    notifier.timer.usec -= 1000000;
+	    notifier.timer.sec += 1;
+	}
+	notifier.timerActive = 1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ *	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 the event queue without blocking.
+ *
+ * Results:
+ *	Always returns 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+    Tcl_Time *timePtr)		/* Maximum block time. */
+{
+    int found;
+    EventRecord macEvent;
+    long sleepTime = 5;
+    long ms;
+    Point currentMouse;
+    void * timerToken;
+    Rect mouseRect;
+
+    /*
+     * Compute the next timeout value.
+     */
+
+    if (!timePtr) {
+	ms = INT_MAX;
+    } else {
+	ms = (timePtr->sec * 1000) + (timePtr->usec / 1000);
+    }
+    timerToken = TclMacStartTimer((long) ms);
+   
+    /*
+     * Poll the Mac event sources.  This loop repeats until something
+     * happens: a timeout, a socket event, mouse motion, or some other
+     * window event.  Note that we don't call WaitNextEvent if another
+     * event is found to avoid context switches.  This effectively gives
+     * events coming in via WaitNextEvent a slightly lower priority.
+     */
+
+    found = 0;
+    if (notifier.utilityRgn == NULL) {
+	notifier.utilityRgn = NewRgn();
+    }
+
+    while (!found) {
+	/*
+	 * Check for generated and queued events.
+	 */
+
+	if (HandleMacEvents()) {
+	    found = 1;
+	}
+
+	/*
+	 * Check for time out.
+	 */
+
+	if (!found && TclMacTimerExpired(timerToken)) {
+	    found = 1;
+	}
+
+	/*
+	 * Check for window events.  We may receive a NULL event for
+	 * various reasons. 1) the timer has expired, 2) a mouse moved
+	 * event is occuring or 3) the os is giving us time for idle
+	 * events.  Note that we aren't sharing the processor very
+	 * well here.  We really ought to do a better job of calling
+	 * WaitNextEvent for time slicing purposes.
+	 */
+
+	if (!found) {
+	    /*
+	     * Set up mouse region so we will wake if the mouse is moved.
+	     * We do this by defining the smallest possible region around
+	     * the current mouse position.
+	     */
+
+	    GetGlobalMouse(&currentMouse);
+	    SetRect(&mouseRect, currentMouse.h, currentMouse.v,
+		    currentMouse.h + 1, currentMouse.v + 1);
+	    RectRgn(notifier.utilityRgn, &mouseRect);
+	
+	    WaitNextEvent(everyEvent, &macEvent, sleepTime,
+		    notifier.utilityRgn);
+
+	    if (notifier.eventProcPtr != NULL) {
+		if ((*notifier.eventProcPtr)(&macEvent) == true) {
+		    found = 1;
+		}
+	    }
+	}
+    }
+    TclMacRemoveTimer(timerToken);
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Sleep --
+ *
+ *	Delay execution for the specified number of milliseconds.  This
+ *	is not a very good call to make.  It will block the system -
+ *	you will not even be able to switch applications.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Sleep(
+    int ms)			/* Number of milliseconds to sleep. */
+{
+    EventRecord dummy;
+    void *timerToken;
+    
+    if (ms <= 0) {
+	return;
+    }
+    
+    timerToken = TclMacStartTimer((long) ms);
+    while (1) {
+	WaitNextEvent(0, &dummy, (ms / 16.66) + 1, NULL);
+	
+	if (TclMacTimerExpired(timerToken)) {
+	    break;
+	}
+    }
+    TclMacRemoveTimer(timerToken);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MacSetEventProc --
+ *
+ *	This function sets the event handling procedure for the 
+ *	application.  This function will be passed all incoming Mac
+ *	events.  This function usually controls the console or some
+ *	other entity like Tk.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Changes the event handling function.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MacSetEventProc(
+    Tcl_MacConvertEventPtr procPtr)
+{
+    notifier.eventProcPtr = procPtr;
+}
diff --git a/tcl/mac/tclMacOSA.c b/tcl/mac/tclMacOSA.c
new file mode 100644
index 00000000000..169d578bcd3
--- /dev/null
+++ b/tcl/mac/tclMacOSA.c
@@ -0,0 +1,2937 @@
+/* 
+ * tclMacOSA.c --
+ *
+ *	This contains the initialization routines, and the implementation of
+ *	the OSA and Component commands.  These commands allow you to connect
+ *	with the AppleScript or any other OSA component to compile and execute
+ *	scripts.
+ *
+ * Copyright (c) 1996 Lucent Technologies and Jim Ingham
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define MAC_TCL
+
+#include <Aliases.h>
+#include <string.h>
+#include <AppleEvents.h>
+#include <AppleScript.h>
+#include <OSA.h>
+#include <OSAGeneric.h>
+#include <Script.h>
+
+#include <FullPath.h>
+#include <components.h>
+
+#include <resources.h>
+#include <FSpCompat.h>
+/* 
+ * The following two Includes are from the More Files package.
+ */
+#include <MoreFiles.h>
+#include <FullPath.h>
+
+#include "tcl.h"
+#include "tclInt.h"
+
+/*
+ * I need this only for the call to FspGetFullPath,
+ * I'm really not poking my nose where it does not belong!
+ */
+#include "tclMacInt.h"
+
+/*
+ * Data structures used by the OSA code.
+ */
+typedef struct tclOSAScript {
+    OSAID scriptID;
+    OSType languageID;
+    long modeFlags;
+} tclOSAScript;
+
+typedef struct tclOSAContext {
+	OSAID contextID;
+} tclOSAContext;
+
+typedef struct tclOSAComponent {
+	char *theName;
+	ComponentInstance theComponent; /* The OSA Component represented */
+	long componentFlags;
+	OSType languageID;
+	char *languageName;
+	Tcl_HashTable contextTable;    /* Hash Table linking the context names & ID's */
+	Tcl_HashTable scriptTable;
+	Tcl_Interp *theInterp;
+	OSAActiveUPP defActiveProc;
+	long defRefCon;
+} tclOSAComponent;
+
+/*
+ * Prototypes for static procedures. 
+ */
+
+static pascal OSErr	TclOSAActiveProc _ANSI_ARGS_((long refCon));
+static int		TclOSACompileCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		 	    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp,
+			    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    tclOSAComponent *OSAComponent, int argc,
+			    char **argv));
+static int 		tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp,
+			    tclOSAComponent *OSAComponent, int argc, char
+			    **argv));
+static void		GetRawDataFromDescriptor _ANSI_ARGS_((AEDesc *theDesc,
+			    Ptr destPtr, Size destMaxSize, Size *actSize));
+static OSErr 		GetCStringFromDescriptor _ANSI_ARGS_((
+			    AEDesc *sourceDesc, char *resultStr,
+			    Size resultMaxSize,Size *resultSize));
+static int 		Tcl_OSAComponentCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv)); 
+static void 		getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable,
+			    char *pattern, Tcl_DString *theResult));
+static int 		ASCIICompareProc _ANSI_ARGS_((const void *first,
+			    const void *second));
+static int 		Tcl_OSACmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv)); 
+static void 		tclOSAClose _ANSI_ARGS_((ClientData clientData));
+static void 		tclOSACloseAll _ANSI_ARGS_((ClientData clientData));
+static tclOSAComponent *tclOSAMakeNewComponent _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *cmdName, char *languageName,
+			    OSType scriptSubtype, long componentFlags));  
+static int 		prepareScriptData _ANSI_ARGS_((int argc, char **argv,
+			    Tcl_DString *scrptData ,AEDesc *scrptDesc)); 
+static void 		tclOSAResultFromID _ANSI_ARGS_((Tcl_Interp *interp,
+			    ComponentInstance theComponent, OSAID resultID));
+static void 		tclOSAASError _ANSI_ARGS_((Tcl_Interp * interp,
+			    ComponentInstance theComponent, char *scriptSource));
+static int 		tclOSAGetContextID _ANSI_ARGS_((tclOSAComponent *theComponent, 
+			    char *contextName, OSAID *theContext));
+static void 		tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
+			    char *contextName, const OSAID theContext));						
+static int 		tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
+			    char *contextName, OSAID *theContext));						
+static int 		tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent,
+			    char *contextName)); 
+static int 		tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp, 
+			    tclOSAComponent *theComponent, char *resourceName, 
+			    int resourceNumber, char *fileName,OSAID *resultID));
+static int 		tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp, 
+			    tclOSAComponent *theComponent, char *resourceName, 
+			    int resourceNumber, char *fileName,char *scriptName));
+static int 		tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent,
+			    char *scriptName, long modeFlags, OSAID scriptID)); 		
+static int 		tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent,
+			    char *scriptName, OSAID *scriptID)); 
+static tclOSAScript *	tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent,
+			    char *scriptName)); 
+static int 		tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent,
+			    char *scriptName,char *errMsg));
+
+/*
+ * "export" is a MetroWerks specific pragma.  It flags the linker that  
+ * any symbols that are defined when this pragma is on will be exported 
+ * to shared libraries that link with this library.
+ */
+ 
+
+#pragma export on
+int Tclapplescript_Init( Tcl_Interp *interp );
+#pragma export reset
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tclapplescript_Init --
+ *
+ *	Initializes the the OSA command which opens connections to
+ *	OSA components, creates the AppleScript command, which opens an 
+ *	instance of the AppleScript component,and constructs the table of
+ *	available languages.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side Effects:
+ *	Opens one connection to the AppleScript component, if 
+ *	available.  Also builds up a table of available OSA languages,
+ *	and creates the OSA command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int 
+Tclapplescript_Init(
+    Tcl_Interp *interp)		/* Tcl interpreter. */
+{
+    char *errMsg = NULL;
+    OSErr myErr = noErr;
+    Boolean gotAppleScript = false;
+    Boolean GotOneOSALanguage = false;
+    ComponentDescription compDescr = {
+	kOSAComponentType,
+	(OSType) 0,
+	(OSType) 0,
+	(long) 0,
+	(long) 0
+    }, *foundComp;
+    Component curComponent = (Component) 0;
+    ComponentInstance curOpenComponent;
+    Tcl_HashTable *ComponentTable;
+    Tcl_HashTable *LanguagesTable;
+    Tcl_HashEntry *hashEntry;
+    int newPtr;
+    AEDesc componentName = { typeNull, NULL };
+    char nameStr[32];			
+    Size nameLen;
+    long appleScriptFlags;
+	
+    /* 
+     * Here We Will Get The Available Osa Languages, Since They Can Only Be 
+     * Registered At Startup...  If You Dynamically Load Components, This
+     * Will Fail, But This Is Not A Common Thing To Do.
+     */
+	 
+    LanguagesTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	
+    if (LanguagesTable == NULL) {
+	panic("Memory Error Allocating Languages Hash Table");
+    }
+	
+    Tcl_SetAssocData(interp, "OSAScript_LangTable", NULL, LanguagesTable);
+    Tcl_InitHashTable(LanguagesTable, TCL_STRING_KEYS);
+	
+			
+    while ((curComponent = FindNextComponent(curComponent, &compDescr)) != 0) {
+	int nbytes = sizeof(ComponentDescription);
+	foundComp = (ComponentDescription *)
+	    ckalloc(sizeof(ComponentDescription));
+	myErr = GetComponentInfo(curComponent, foundComp, NULL, NULL, NULL);
+	if (foundComp->componentSubType ==
+		kOSAGenericScriptingComponentSubtype) {
+	    /* Skip the generic component */
+	    ckfree((char *) foundComp);
+	} else {
+	    GotOneOSALanguage = true;
+
+	    /*
+	     * This is gross: looks like I have to open the component just  
+	     * to get its name!!! GetComponentInfo is supposed to return
+	     * the name, but AppleScript always returns an empty string.
+	     */
+		 	
+	    curOpenComponent = OpenComponent(curComponent);
+	    if (curOpenComponent == NULL) {
+		Tcl_AppendResult(interp,"Error opening component",
+			(char *) NULL);
+		return TCL_ERROR;
+	    }
+			 
+	    myErr = OSAScriptingComponentName(curOpenComponent,&componentName);
+	    if (myErr == noErr) {
+		myErr = GetCStringFromDescriptor(&componentName,
+			nameStr, 31, &nameLen);
+		AEDisposeDesc(&componentName);
+	    }
+	    CloseComponent(curOpenComponent);
+
+	    if (myErr == noErr) {
+		hashEntry = Tcl_CreateHashEntry(LanguagesTable,
+			nameStr, &newPtr);
+		Tcl_SetHashValue(hashEntry, (ClientData) foundComp);
+	    } else {
+		Tcl_AppendResult(interp,"Error getting componentName.",
+			(char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    /*
+	     * Make sure AppleScript is loaded, otherwise we will
+	     * not bother to make the AppleScript command.
+	     */
+	    if (foundComp->componentSubType == kAppleScriptSubtype) {
+		appleScriptFlags = foundComp->componentFlags;
+		gotAppleScript = true;
+	    }			
+	}
+    }				
+
+    /*
+     * Create the OSA command.
+     */
+	
+    if (!GotOneOSALanguage) {
+	Tcl_AppendResult(interp,"Could not find any OSA languages",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    /*
+     * Create the Component Assoc Data & put it in the interpreter.
+     */
+	
+    ComponentTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	
+    if (ComponentTable == NULL) {
+	panic("Memory Error Allocating Hash Table");
+    }
+	
+    Tcl_SetAssocData(interp, "OSAScript_CompTable", NULL, ComponentTable);
+			
+    Tcl_InitHashTable(ComponentTable, TCL_STRING_KEYS);
+
+    /*
+     * The OSA command is not currently supported.	 
+    Tcl_CreateCommand(interp, "OSA", Tcl_OSACmd, (ClientData) NULL,
+	    (Tcl_CmdDeleteProc *) NULL);
+     */
+     
+    /* 
+     * Open up one AppleScript component, with a default context
+     * and tie it to the AppleScript command.
+     * If the user just wants single-threaded AppleScript execution
+     * this should be enough.
+     *
+     */
+	 
+    if (gotAppleScript) {
+	if (tclOSAMakeNewComponent(interp, "AppleScript",
+		"AppleScript English", kAppleScriptSubtype,
+		appleScriptFlags) == NULL ) {
+	    return TCL_ERROR;
+	}
+    }
+
+    return Tcl_PkgProvide(interp, "OSAConnect", "1.0");
+}
+
+/*
+ *---------------------------------------------------------------------- 
+ *
+ * Tcl_OSACmd --
+ *
+ *	This is the command that provides the interface to the OSA
+ *	component manager.  The subcommands are: close: close a component, 
+ *	info: get info on components open, and open: get a new connection
+ *	with the Scripting Component
+ *
+ * Results:
+ *  	A standard Tcl result.
+ *
+ * Side effects:
+ *  	Depends on the subcommand, see the user documentation
+ *	for more details.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+int 
+Tcl_OSACmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int argc,
+    char **argv)
+{
+    static unsigned short componentCmdIndex = 0;
+    char autoName[32];
+    char c;
+    int length;
+    Tcl_HashTable *ComponentTable = NULL;
+	
+
+    if (argc == 1) {
+	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		argv[0], " option\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    c = *argv[1];
+    length = strlen(argv[1]);
+	
+    /*
+     * Query out the Component Table, since most of these commands use it...
+     */
+	
+    ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
+	    "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
+	
+    if (ComponentTable == NULL) {
+	Tcl_AppendResult(interp, "Error, could not get the Component Table",
+		" from the Associated data.", (char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    if (c == 'c' && strncmp(argv[1],"close",length) == 0) {
+	Tcl_HashEntry *hashEntry;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		    argv[0], " ",argv[1], " componentName\"",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+		
+	if ((hashEntry = Tcl_FindHashEntry(ComponentTable,argv[2])) == NULL) {
+	    Tcl_AppendResult(interp, "Component \"", argv[2], "\" not found",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	} else {
+	    Tcl_DeleteCommand(interp,argv[2]);
+	    return TCL_OK;
+	}
+    } else if (c == 'o' && strncmp(argv[1],"open",length) == 0) {
+	/*
+	 * Default language is AppleScript.
+	 */
+	OSType scriptSubtype = kAppleScriptSubtype;
+	char *languageName = "AppleScript English";
+	char *errMsg = NULL;
+	ComponentDescription *theCD;
+
+	argv += 2;
+	argc -= 2;
+		 
+	while (argc > 0 ) {
+	    if (*argv[0] == '-') {
+		c = *(argv[0] + 1);
+		if (c == 'l' && strcmp(argv[0] + 1, "language") == 0) {
+		    if (argc == 1) {
+			Tcl_AppendResult(interp,
+				"Error - no language provided for the -language switch",
+				(char *) NULL);
+			return TCL_ERROR;
+		    } else {
+			Tcl_HashEntry *hashEntry;
+			Tcl_HashSearch search;
+			Boolean gotIt = false;
+			Tcl_HashTable *LanguagesTable;
+						
+			/*
+			 * Look up the language in the languages table
+			 * Do a simple strstr match, so AppleScript
+			 * will match "AppleScript English"...
+			 */
+						
+			LanguagesTable = Tcl_GetAssocData(interp,
+				"OSAScript_LangTable",
+				(Tcl_InterpDeleteProc **) NULL);
+							
+			for (hashEntry =
+				 Tcl_FirstHashEntry(LanguagesTable, &search);
+			     hashEntry != NULL;
+			     hashEntry = Tcl_NextHashEntry(&search)) {
+			    languageName = Tcl_GetHashKey(LanguagesTable,
+				    hashEntry);
+			    if (strstr(languageName,argv[1]) != NULL) {
+				theCD = (ComponentDescription *)
+				    Tcl_GetHashValue(hashEntry);
+				gotIt = true;
+				break;
+			    }
+			}
+			if (!gotIt) {
+			    Tcl_AppendResult(interp,
+				    "Error, could not find the language \"",
+				    argv[1],
+				    "\" in the list of known languages.",
+				    (char *) NULL);
+			    return TCL_ERROR;
+			}
+		    }
+		}
+		argc -= 2;
+		argv += 2;				
+	    } else {
+		Tcl_AppendResult(interp, "Expected a flag, but got ",
+			argv[0], (char *) NULL);
+		return TCL_ERROR;
+	    }
+	}
+			
+	sprintf(autoName, "OSAComponent%-d", componentCmdIndex++);
+	if (tclOSAMakeNewComponent(interp, autoName, languageName,
+		theCD->componentSubType, theCD->componentFlags) == NULL ) {
+	    return TCL_ERROR;
+	} else {
+	    Tcl_SetResult(interp,autoName,TCL_VOLATILE);
+	    return TCL_OK;	
+	}
+		
+    } else if (c == 'i' && strncmp(argv[1],"info",length) == 0) {
+	if (argc == 2) {
+	    Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		    argv[0], " ", argv[1], " what\"",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+		 	
+	c = *argv[2];
+	length = strlen(argv[2]);
+		
+	if (c == 'c' && strncmp(argv[2], "components", length) == 0) {
+	    Tcl_DString theResult;
+			
+	    Tcl_DStringInit(&theResult);
+			
+	    if (argc == 3) {
+		getSortedHashKeys(ComponentTable,(char *) NULL, &theResult);
+	    } else if (argc == 4) {
+		getSortedHashKeys(ComponentTable, argv[3], &theResult);
+	    } else {
+		Tcl_AppendResult(interp, "Error: wrong # of arguments",
+			", should be \"", argv[0], " ", argv[1], " ",
+			argv[2], " ?pattern?\".", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_DStringResult(interp, &theResult);
+	    return TCL_OK;			
+	} else if (c == 'l' && strncmp(argv[2],"languages",length) == 0) {
+	    Tcl_DString theResult;
+	    Tcl_HashTable *LanguagesTable;
+			
+	    Tcl_DStringInit(&theResult);
+	    LanguagesTable = Tcl_GetAssocData(interp,
+		    "OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL);
+							
+	    if (argc == 3) {
+		getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult);
+	    } else if (argc == 4) {
+		getSortedHashKeys(LanguagesTable, argv[3], &theResult);
+	    } else {
+		Tcl_AppendResult(interp, "Error: wrong # of arguments",
+			", should be \"", argv[0], " ", argv[1], " ",
+			argv[2], " ?pattern?\".", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_DStringResult(interp,&theResult);
+	    return TCL_OK;			
+	} else {
+	    Tcl_AppendResult(interp, "Unknown option: ", argv[2],
+		    " for OSA info, should be one of",
+		    " \"components\" or \"languages\"",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+    } else {
+	Tcl_AppendResult(interp, "Unknown option: ", argv[1],
+		", should be one of \"open\", \"close\" or \"info\".",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/* 
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OSAComponentCmd --
+ *
+ *	This is the command that provides the interface with an OSA
+ *	component.  The sub commands are:
+ *	- compile ? -context context? scriptData
+ *		compiles the script data, returns the ScriptID
+ *	- decompile ? -context context? scriptData
+ *		decompiles the script data, source code
+ *	- execute ?-context context? scriptData
+ *		compiles and runs script data
+ *	- info what: get component info
+ *	- load ?-flags values? fileName
+ *		loads & compiles script data from fileName
+ *	- run scriptId ?options?
+ *		executes the compiled script 
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side Effects:
+ *	Depends on the subcommand, see the user documentation
+ *	for more details.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+int 
+Tcl_OSAComponentCmd(
+    ClientData clientData,
+    Tcl_Interp *interp, 
+    int argc,
+    char **argv)
+{
+    int length;
+    char c;
+	
+    tclOSAComponent *OSAComponent = (tclOSAComponent *) clientData;
+	
+    if (argc == 1) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option ?arg ...?\"",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    c = *argv[1];
+    length = strlen(argv[1]);
+    if (c == 'c' && strncmp(argv[1], "compile", length) == 0) {
+	return TclOSACompileCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 'l' && strncmp(argv[1], "load", length) == 0) {
+	return tclOSALoadCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) {
+	return tclOSAExecuteCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 'i' && strncmp(argv[1], "info", length) == 0) {
+	return tclOSAInfoCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) {
+	return tclOSADecompileCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) {
+	return tclOSADeleteCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 'r' && strncmp(argv[1], "run", length) == 0) {
+	return tclOSARunCmd(interp, OSAComponent, argc, argv);
+    } else if (c == 's' && strncmp(argv[1], "store", length) == 0) {
+	return tclOSAStoreCmd(interp, OSAComponent, argc, argv);
+    } else {
+	Tcl_AppendResult(interp,"bad option \"", argv[1],
+		"\": should be compile, decompile, delete, ",
+		 "execute, info, load, run or store",
+		 (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+ 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOSACompileCmd --
+ *
+ *	This is the compile subcommand for the component command.
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side Effects:
+ *  	Compiles the script data either into a script or a script
+ *	context.  Adds the script to the component's script or context
+ *	table.  Sets interp's result to the name of the new script or
+ *	context.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int 
+TclOSACompileCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc,
+    char **argv)
+{
+    int  tclError = TCL_OK;
+    int augment = 1;
+    int makeContext = 0;
+    char c;
+    char autoName[16];
+    char buffer[32];
+    char *resultName;
+    Boolean makeNewContext = false;
+    Tcl_DString scrptData;
+    AEDesc scrptDesc = { typeNull, NULL };
+    long modeFlags = kOSAModeCanInteract;
+    OSAID resultID = kOSANullScript;
+    OSAID contextID = kOSANullScript;
+    OSAID parentID = kOSANullScript;
+    OSAError osaErr = noErr;
+	
+    if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) {
+	Tcl_AppendResult(interp,
+		"OSA component does not support compiling",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /* 
+     * This signals that we should make up a name, which is the
+     * default behavior:
+     */
+	 
+    autoName[0] = '\0';
+    resultName = NULL;
+	
+    if (argc == 2) {
+	numArgs:
+	Tcl_AppendResult(interp,
+		"wrong # args: should be \"", argv[0], " ", argv[1],
+		" ?options? code\"",(char *) NULL);
+	return TCL_ERROR;
+    } 
+
+    argv += 2;
+    argc -= 2;
+
+    /*
+     * Do the argument parsing.
+     */
+	
+    while (argc > 0) {
+		
+	if (*argv[0] == '-') {
+	    c = *(argv[0] + 1);
+			
+	    /*
+	     * "--" is the only switch that has no value, stops processing
+	     */
+			
+	    if (c == '-' && *(argv[0] + 2) == '\0') {
+		argv += 1;
+		argc--;
+		break;
+	    }
+			
+	    /*
+	     * So we can check here a switch with no value.
+	     */
+			
+	    if (argc == 1)  {
+		Tcl_AppendResult(interp,
+			"no value given for switch: ",
+			argv[0], (char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
+		if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) {
+		/*
+		 * Augment the current context which implies making a context.
+		 */
+
+		if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		makeContext = 1;
+	    } else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
+		resultName = argv[1];
+	    } else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
+		/*
+		 * Since this implies we are compiling into a context, 
+		 * set makeContext here
+		 */
+		if (tclOSAGetContextID(OSAComponent,
+			argv[1], &parentID) != TCL_OK) {
+		    Tcl_AppendResult(interp, "context not found \"",
+			    argv[1], "\"", (char *) NULL);
+		    return TCL_ERROR;
+		}
+		makeContext = 1;
+	    } else {
+		Tcl_AppendResult(interp, "bad option \"", argv[0],
+			"\": should be -augment, -context, -name or -parent",
+			 (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    argv += 2;
+	    argc -= 2;
+			
+	} else {
+	    break;
+	}
+    }
+
+    /*
+     * Make sure we have some data left...
+     */
+    if (argc == 0) {
+	goto numArgs;
+    }
+	
+    /* 
+     * Now if we are making a context, see if it is a new one... 
+     * There are three options here:
+     * 1) There was no name provided, so we autoName it
+     * 2) There was a name, then check and see if it already exists
+     *  a) If yes, then makeNewContext is false
+     *  b) Otherwise we are making a new context
+     */
+
+    if (makeContext) {
+	modeFlags |= kOSAModeCompileIntoContext;
+	if (resultName == NULL) {
+	    /*
+	     * Auto name the new context.
+	     */
+	    resultName = autoName;
+	    resultID = kOSANullScript;
+	    makeNewContext = true;
+	} else if (tclOSAGetContextID(OSAComponent,
+		resultName, &resultID) == TCL_OK) {
+	    makeNewContext = false;
+	} else { 
+	    makeNewContext = true;
+	    resultID = kOSANullScript;
+	}
+		
+	/*
+	 * Deal with the augment now...
+	 */
+	if (augment && !makeNewContext) {
+	    modeFlags |= kOSAModeAugmentContext;
+	}
+    }
+	
+    /*
+     * Ok, now we have the options, so we can compile the script data.
+     */
+			
+    if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
+	Tcl_DStringResult(interp, &scrptData);
+	AEDisposeDesc(&scrptDesc);
+	return TCL_ERROR;
+    }
+
+    /* 
+     * If we want to use a parent context, we have to make the context 
+     * by hand. Note, parentID is only specified when you make a new context. 
+     */
+	
+    if (parentID != kOSANullScript && makeNewContext) {
+	AEDesc contextDesc = { typeNull, NULL };
+
+	osaErr = OSAMakeContext(OSAComponent->theComponent,
+		&contextDesc, parentID, &resultID);
+	modeFlags |= kOSAModeAugmentContext;
+    }
+	
+    osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
+	    modeFlags, &resultID);								
+    if (osaErr == noErr) {
+	 
+	if (makeContext) {
+	    /* 
+	     * For the compiled context to be active, you need to run 
+	     * the code that is in the context.
+	     */
+	    OSAID activateID;
+
+	    osaErr = OSAExecute(OSAComponent->theComponent, resultID,
+		    resultID, kOSAModeCanInteract, &activateID);
+	    OSADispose(OSAComponent->theComponent, activateID);
+
+	    if (osaErr == noErr) {
+		if (makeNewContext) {
+		    /*
+		     * If we have compiled into a context, 
+		     * this is added to the context table 
+		     */
+					 
+		    tclOSAAddContext(OSAComponent, resultName, resultID);
+		}
+				
+		Tcl_SetResult(interp, resultName, TCL_VOLATILE);
+		tclError = TCL_OK;
+	    }
+	} else {
+	    /*
+	     * For a script, we return the script name.
+	     */
+	    tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID);
+	    Tcl_SetResult(interp, resultName, TCL_VOLATILE);
+	    tclError = TCL_OK;	
+	}
+    }
+	
+    /* 
+     * This catches the error either from the original compile, 
+     * or from the execute in case makeContext == true
+     */
+	 						
+    if (osaErr == errOSAScriptError) {
+	OSADispose(OSAComponent->theComponent, resultID);
+	tclOSAASError(interp, OSAComponent->theComponent,
+		Tcl_DStringValue(&scrptData));
+	tclError = TCL_ERROR;
+    } else if (osaErr != noErr)  {
+	sprintf(buffer, "Error #%-6d compiling script", osaErr);
+	Tcl_AppendResult(interp, buffer, (char *) NULL);
+	tclError = TCL_ERROR;		
+    } 
+
+    Tcl_DStringFree(&scrptData);
+    AEDisposeDesc(&scrptDesc);
+	
+    return tclError;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSADecompileCmd --
+ *
+ * 	This implements the Decompile subcommand of the component command
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side Effects:
+ *  	Decompiles the script, and sets interp's result to the
+ *	decompiled script data.
+ *
+ *----------------------------------------------------------------------
+ */
+ 		
+static int 
+tclOSADecompileCmd(
+    Tcl_Interp * interp,
+    tclOSAComponent *OSAComponent,
+    int argc, 
+    char **argv)
+{
+    AEDesc resultingSourceData = { typeChar, NULL };
+    OSAID scriptID;
+    Boolean isContext;
+    long result;
+    OSErr sysErr = noErr;
+ 		
+    if (argc == 2) {
+	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		argv[0], " ",argv[1], " scriptName \"", (char *) NULL );
+	return TCL_ERROR;
+    }
+ 	
+    if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) {
+	Tcl_AppendResult(interp,
+		"Error, this component does not support get source",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+ 	
+    if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) {
+	isContext = false;
+    } else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID)
+	    == TCL_OK ) {
+	isContext = true;
+    } else { 
+	Tcl_AppendResult(interp, "Could not find script \"",
+		argv[2], "\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    OSAGetScriptInfo(OSAComponent->theComponent, scriptID,
+	    kOSACanGetSource, &result);
+						
+    sysErr = OSAGetSource(OSAComponent->theComponent, 
+	    scriptID, typeChar, &resultingSourceData);
+	
+    if (sysErr == noErr) {
+	Tcl_DString theResult;
+	Tcl_DStringInit(&theResult);
+
+	Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle,
+		GetHandleSize(resultingSourceData.dataHandle));
+	Tcl_DStringResult(interp, &theResult);
+	AEDisposeDesc(&resultingSourceData);
+	return TCL_OK;
+    } else {
+	Tcl_AppendResult(interp, "Error getting source data", (char *) NULL);
+	AEDisposeDesc(&resultingSourceData);
+	return TCL_ERROR;
+    }
+}			
+	 	
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSADeleteCmd --
+ *
+ *	This implements the Delete subcommand of the Component command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side Effects:
+ *  	Deletes a script from the script list of the given component.
+ *	Removes all references to the script, and frees the memory
+ *	associated with it.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int 
+tclOSADeleteCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc,
+    char **argv)
+{
+    char c,*errMsg = NULL;
+    int length;
+ 	
+    if (argc < 4) {
+	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		argv[0], " ", argv[1], " what scriptName", (char *) NULL);
+	return TCL_ERROR;
+    }
+ 	
+    c = *argv[2];
+    length = strlen(argv[2]);
+    if (c == 'c' && strncmp(argv[2], "context", length) == 0) {
+	if (strcmp(argv[3], "global") == 0) {
+	    Tcl_AppendResult(interp, "You cannot delete the global context",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	} else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) {
+	    Tcl_AppendResult(interp, "Error deleting script \"", argv[2],
+		    "\": ", errMsg, (char *) NULL);
+	    ckfree(errMsg);
+	    return TCL_ERROR;
+	}
+    } else if (c == 's' && strncmp(argv[2], "script", length) == 0) {
+	if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) {
+	    Tcl_AppendResult(interp, "Error deleting script \"", argv[3],
+		    "\": ", errMsg, (char *) NULL);
+	    ckfree(errMsg);
+	    return TCL_ERROR;
+	}
+    } else {
+	Tcl_AppendResult(interp,"Unknown value ", argv[2],
+		" should be one of ",
+		"\"context\" or \"script\".",
+		(char *) NULL );
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------- 
+ *
+ * tclOSAExecuteCmd --
+ *
+ *	This implements the execute subcommand of the component command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Executes the given script data, and sets interp's result to
+ *	the OSA component's return value.
+ *
+ *---------------------------------------------------------------------- 
+ */
+ 
+static int 
+tclOSAExecuteCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc,
+    char **argv)
+{
+    int tclError = TCL_OK, resID = 128;
+    char c,buffer[32],
+	*contextName = NULL,*scriptName = NULL, *resName = NULL;
+    Boolean makeNewContext = false,makeContext = false;
+    AEDesc scrptDesc = { typeNull, NULL };
+    long modeFlags = kOSAModeCanInteract;
+    OSAID resultID = kOSANullScript,
+	contextID = kOSANullScript,
+	parentID = kOSANullScript;
+    Tcl_DString scrptData;
+    OSAError osaErr = noErr;
+    OSErr  sysErr = noErr;
+
+    if (argc == 2) {
+	Tcl_AppendResult(interp,
+		"Error, no script data for \"", argv[0],
+		" run\"", (char *) NULL);
+	return TCL_ERROR;
+    } 
+
+    argv += 2;
+    argc -= 2;
+
+    /*
+     * Set the context to the global context by default.
+     * Then parse the argument list for switches
+     */
+    tclOSAGetContextID(OSAComponent, "global", &contextID);
+	
+    while (argc > 0) {
+		
+	if (*argv[0] == '-') {
+	    c = *(argv[0] + 1);
+
+	    /*
+	     * "--" is the only switch that has no value.
+	     */
+			
+	    if (c == '-' && *(argv[0] + 2) == '\0') {
+		argv += 1;
+		argc--;
+		break;
+	    }
+			
+	    /*
+	     * So we can check here for a switch with no value.
+	     */
+			
+	    if (argc == 1)  {
+		Tcl_AppendResult(interp,
+			"Error, no value given for switch ",
+			argv[0], (char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
+		if (tclOSAGetContextID(OSAComponent,
+			argv[1], &contextID) == TCL_OK) {
+		} else {
+		    Tcl_AppendResult(interp, "Script context \"",
+			    argv[1], "\" not found", (char *) NULL);
+		    return TCL_ERROR;
+		}
+	    } else { 
+		Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
+			" should be \"-context\"", (char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    argv += 2;
+	    argc -= 2;
+	} else {
+	    break;
+	}
+    }
+	
+    if (argc == 0) {
+	Tcl_AppendResult(interp, "Error, no script data", (char *) NULL);
+	return TCL_ERROR;
+    }
+		
+    if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
+	Tcl_DStringResult(interp, &scrptData);
+	AEDisposeDesc(&scrptDesc);
+	return TCL_ERROR;
+    }
+    /*
+     * Now try to compile and run, but check to make sure the
+     * component supports the one shot deal
+     */
+    if (OSAComponent->componentFlags && kOSASupportsConvenience) {
+	osaErr = OSACompileExecute(OSAComponent->theComponent,
+		&scrptDesc, contextID, modeFlags, &resultID);
+    } else {
+	/*
+	 * If not, we have to do this ourselves
+	 */
+	if (OSAComponent->componentFlags && kOSASupportsCompiling) {
+	    OSAID compiledID = kOSANullScript;
+	    osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
+		    modeFlags, &compiledID);
+	    if (osaErr == noErr) {
+		osaErr = OSAExecute(OSAComponent->theComponent, compiledID,
+			contextID, modeFlags, &resultID);
+	    }
+	    OSADispose(OSAComponent->theComponent, compiledID);
+	} else {
+	    /*
+	     * The scripting component had better be able to load text data...
+	     */
+	    OSAID loadedID = kOSANullScript;
+			
+	    scrptDesc.descriptorType = OSAComponent->languageID;
+	    osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc,
+		    modeFlags, &loadedID);
+	    if (osaErr == noErr) {
+		OSAExecute(OSAComponent->theComponent, loadedID,
+			contextID, modeFlags, &resultID);
+	    }
+	    OSADispose(OSAComponent->theComponent, loadedID);
+	}
+    }
+    if (osaErr == errOSAScriptError) {
+	tclOSAASError(interp, OSAComponent->theComponent,
+		Tcl_DStringValue(&scrptData));
+	tclError = TCL_ERROR;
+    } else if (osaErr != noErr) {
+	sprintf(buffer, "Error #%-6d compiling script", osaErr);
+	Tcl_AppendResult(interp, buffer, (char *) NULL);
+	tclError = TCL_ERROR;		
+    } else  {
+	tclOSAResultFromID(interp, OSAComponent->theComponent, resultID);
+	osaErr = OSADispose(OSAComponent->theComponent, resultID);
+	tclError = TCL_OK;
+    } 
+
+    Tcl_DStringFree(&scrptData);
+    AEDisposeDesc(&scrptDesc);	
+
+    return tclError;	
+} 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAInfoCmd --
+ *
+ * This implements the Info subcommand of the component command
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Info on scripts and contexts.  See the user documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+static int 
+tclOSAInfoCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc, 
+    char **argv)
+{
+    char c;
+    int length;
+    Tcl_DString theResult;
+	
+    if (argc == 2) {
+	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		argv[0], " ", argv[1], " what \"", (char *) NULL );
+	return TCL_ERROR;
+    }
+ 	
+    c = *argv[2];
+    length = strlen(argv[2]);
+    if (c == 's' && strncmp(argv[2], "scripts", length) == 0) {
+	Tcl_DStringInit(&theResult);
+	if (argc == 3) {
+	    getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL,
+		    &theResult);
+	} else if (argc == 4) {
+	    getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult);
+	} else {
+	    Tcl_AppendResult(interp, "Error: wrong # of arguments,",
+		    " should be \"", argv[0], " ", argv[1], " ",
+		    argv[2], " ?pattern?", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringResult(interp, &theResult);
+	return TCL_OK;			
+    } else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) {
+	Tcl_DStringInit(&theResult);		
+	if (argc == 3) {
+	    getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL,
+		   &theResult);
+	} else if (argc == 4) {
+	    getSortedHashKeys(&OSAComponent->contextTable,
+		    argv[3], &theResult);
+	} else {
+	    Tcl_AppendResult(interp, "Error: wrong # of arguments for ,",
+		    " should be \"", argv[0], " ", argv[1], " ",
+		    argv[2], " ?pattern?", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringResult(interp, &theResult);
+	return TCL_OK;			
+    } else if (c == 'l' && strncmp(argv[2], "language", length) == 0) {
+	Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC);
+	return TCL_OK;
+    } else {
+	Tcl_AppendResult(interp, "Unknown argument \"", argv[2],
+		"\" for \"", argv[0], " info \", should be one of ",
+		"\"scripts\" \"language\", or \"contexts\"",
+		(char *) NULL);
+	return TCL_ERROR;
+    } 
+}
+		
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSALoadCmd --
+ *
+ *	This is the load subcommand for the Component Command
+ *
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Loads script data from the given file, creates a new context
+ *	for it, and sets interp's result to the name of the new context.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int 
+tclOSALoadCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc,
+    char **argv)
+{
+    int tclError = TCL_OK, resID = 128;
+    char c, autoName[24],
+	*contextName = NULL, *scriptName = NULL, *resName = NULL;
+    Boolean makeNewContext = false, makeContext = false;
+    AEDesc scrptDesc = { typeNull, NULL };
+    long modeFlags = kOSAModeCanInteract;
+    OSAID resultID = kOSANullScript,
+	contextID = kOSANullScript,
+	parentID = kOSANullScript;
+    OSAError osaErr = noErr;
+    OSErr  sysErr = noErr;
+    long scptInfo;
+	
+    autoName[0] = '\0';
+    scriptName = autoName;
+    contextName = autoName;
+	
+    if (argc == 2) {
+	Tcl_AppendResult(interp,
+		"Error, no data for \"", argv[0], " ", argv[1],
+		"\"", (char *) NULL);
+	return TCL_ERROR;
+    } 
+
+    argv += 2;
+    argc -= 2;
+
+    /*
+     * Do the argument parsing.
+     */
+	
+    while (argc > 0) {
+		
+	if (*argv[0] == '-') {
+	    c = *(argv[0] + 1);
+			
+	    /*
+	     * "--" is the only switch that has no value.
+	     */
+			
+	    if (c == '-' && *(argv[0] + 2) == '\0') {
+		argv += 1;
+		argc--;
+		break;
+	    }
+			
+	    /*
+	     * So we can check here a switch with no value.
+	     */
+			
+	    if (argc == 1)  {
+		Tcl_AppendResult(interp, "Error, no value given for switch ",
+			argv[0], (char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
+		resName = argv[1];
+	    } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
+		if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
+		    Tcl_AppendResult(interp,
+			    "Error getting resource ID", (char *) NULL);
+		    return TCL_ERROR;
+		}
+	    } else {
+		Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
+			" should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
+			(char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    argv += 2;
+	    argc -= 2;
+	} else {
+	    break;
+	}
+    }
+    /*
+     * Ok, now we have the options, so we can load the resource,
+     */
+    if (argc == 0) {
+	Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    if (tclOSALoad(interp, OSAComponent, resName, resID,
+	    argv[0], &resultID) != TCL_OK) {
+	Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
+	return TCL_ERROR;
+    }
+	 
+    /*
+     *  Now find out whether we have a script, or a script context.
+     */
+	 
+    OSAGetScriptInfo(OSAComponent->theComponent, resultID,
+	    kOSAScriptIsTypeScriptContext, &scptInfo);
+    
+    if (scptInfo) {
+	autoName[0] = '\0';
+	tclOSAAddContext(OSAComponent, autoName, resultID);
+		
+	Tcl_SetResult(interp, autoName, TCL_VOLATILE);
+    } else {
+	/*
+	 * For a script, we return the script name
+	 */
+	autoName[0] = '\0';
+	tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID);
+	Tcl_SetResult(interp, autoName, TCL_VOLATILE);
+    }		 	
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSARunCmd --
+ *
+ *	This implements the run subcommand of the component command
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Runs the given compiled script, and returns the OSA
+ *	component's result.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int 
+tclOSARunCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc,
+    char **argv)
+{
+    int tclError = TCL_OK,
+	resID = 128;
+    char c, *contextName = NULL,
+	*scriptName = NULL, 
+	*resName = NULL;
+    AEDesc scrptDesc = { typeNull, NULL };
+    long modeFlags = kOSAModeCanInteract;
+    OSAID resultID = kOSANullScript,
+	contextID = kOSANullScript,
+	parentID = kOSANullScript;
+    OSAError osaErr = noErr;
+    OSErr sysErr = noErr;
+    char *componentName = argv[0];
+    OSAID scriptID;
+	
+    if (argc == 2) {
+	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
+		argv[0], " ", argv[1], " scriptName", (char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    /*
+     * Set the context to the global context for this component,
+     * as a default
+     */
+    if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) {
+	Tcl_AppendResult(interp,
+		"Could not find the global context for component ",
+		OSAComponent->theName, (char *) NULL );
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now parse the argument list for switches
+     */
+    argv += 2;
+    argc -= 2;
+	
+    while (argc > 0) {
+	if (*argv[0] == '-') {
+	    c = *(argv[0] + 1);
+	    /*
+	     * "--" is the only switch that has no value
+	     */
+	    if (c == '-' && *(argv[0] + 2) == '\0') {
+		argv += 1;
+		argc--;
+		break;
+	    }
+			
+	    /*
+	     * So we can check here for a switch with no value.
+	     */
+	    if (argc == 1)  {
+		Tcl_AppendResult(interp, "Error, no value given for switch ",
+			argv[0], (char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
+		if (argc == 1) {
+		    Tcl_AppendResult(interp,
+			    "Error - no context provided for the -context switch",
+			    (char *) NULL);
+		    return TCL_ERROR;
+		} else if (tclOSAGetContextID(OSAComponent,
+			argv[1], &contextID) == TCL_OK) {
+		} else {
+		    Tcl_AppendResult(interp, "Script context \"", argv[1],
+			    "\" not found", (char *) NULL);
+		    return TCL_ERROR;
+		} 
+	    } else {
+		Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
+			" for ", componentName,
+			" should be \"-context\"", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    argv += 2;
+	    argc -= 2;
+	} else {
+	    break;
+	}
+    }
+	
+    if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
+	if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
+	    Tcl_AppendResult(interp, "Could not find script \"",
+		    argv[2], "\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+	
+    sysErr = OSAExecute(OSAComponent->theComponent,
+	    scriptID, contextID, modeFlags, &resultID);
+							
+    if (sysErr == errOSAScriptError) {
+	tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL);
+	tclError = TCL_ERROR;
+    } else if (sysErr != noErr) {
+	char buffer[32];
+	sprintf(buffer, "Error #%6.6d encountered in run", sysErr);
+	Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+	tclError = TCL_ERROR;
+    } else {
+	tclOSAResultFromID(interp, OSAComponent->theComponent, resultID );
+    }
+    OSADispose(OSAComponent->theComponent, resultID);
+
+    return tclError;		
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAStoreCmd --
+ *
+ *	This implements the store subcommand of the component command
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Runs the given compiled script, and returns the OSA
+ *	component's result.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int 
+tclOSAStoreCmd(
+    Tcl_Interp *interp,
+    tclOSAComponent *OSAComponent,
+    int argc,
+    char **argv)
+{
+    int tclError = TCL_OK, resID = 128;
+    char c, *contextName = NULL, *scriptName = NULL, *resName = NULL;
+    Boolean makeNewContext = false, makeContext = false;
+    AEDesc scrptDesc = { typeNull, NULL };
+    long modeFlags = kOSAModeCanInteract;
+    OSAID resultID = kOSANullScript,
+	contextID = kOSANullScript,
+	parentID = kOSANullScript;
+    OSAError osaErr = noErr;
+    OSErr  sysErr = noErr;
+		
+    if (argc == 2) {
+	Tcl_AppendResult(interp, "Error, no data for \"", argv[0],
+		" ",argv[1], "\"", (char *) NULL);
+	return TCL_ERROR;
+    } 
+
+    argv += 2;
+    argc -= 2;
+
+    /*
+     * Do the argument parsing
+     */
+	
+    while (argc > 0) {
+	if (*argv[0] == '-') {
+	    c = *(argv[0] + 1);
+			
+	    /*
+	     * "--" is the only switch that has no value
+	     */
+	    if (c == '-' && *(argv[0] + 2) == '\0') {
+		argv += 1;
+		argc--;
+		break;
+	    }
+			
+	    /*
+	     * So we can check here a switch with no value.
+	     */
+	    if (argc == 1)  {
+		Tcl_AppendResult(interp,
+			"Error, no value given for switch ",
+			argv[0], (char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
+		resName = argv[1];
+	    } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
+		if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
+		    Tcl_AppendResult(interp,
+			    "Error getting resource ID", (char *) NULL);
+		    return TCL_ERROR;
+		}
+	    } else {
+		Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
+			" should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
+			(char *) NULL);
+		return TCL_ERROR;
+	    }
+			
+	    argv += 2;
+	    argc -= 2;
+	} else {
+	    break;
+	}
+    }
+    /*
+     * Ok, now we have the options, so we can load the resource,
+     */
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ",
+		argv[0], " ", argv[1], "?option flag? scriptName fileName",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+	
+    if (tclOSAStore(interp, OSAComponent, resName, resID,
+	    argv[0], argv[1]) != TCL_OK) {
+	Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
+	return TCL_ERROR;
+    } else {
+	Tcl_ResetResult(interp);
+	tclError = TCL_OK;
+    }
+    
+    return tclError;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAMakeNewComponent --
+ *
+ *	Makes a command cmdName to represent a new connection to the
+ *	OSA component with componentSubType scriptSubtype.
+ *
+ * Results: 
+ *	Returns the tclOSAComponent structure for the connection.
+ *
+ * Side Effects: 
+ *	Adds a new element to the component table.  If there is an
+ *	error, then the result of the Tcl interpreter interp is set
+ *	to an appropriate error message.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+tclOSAComponent *
+tclOSAMakeNewComponent(
+    Tcl_Interp *interp,
+    char *cmdName,
+    char *languageName, 
+    OSType scriptSubtype,
+    long componentFlags) 
+{
+    char buffer[32];
+    AEDesc resultingName = {typeNull, NULL};
+    AEDesc nullDesc = {typeNull, NULL };
+    OSAID globalContext;
+    char global[] = "global";
+    int nbytes;
+    ComponentDescription requestedComponent = {
+	kOSAComponentType,
+	(OSType) 0,
+	(OSType) 0,
+	(long int) 0,
+	(long int) 0
+    };
+    Tcl_HashTable *ComponentTable;
+    Component foundComponent = NULL;
+    OSAActiveUPP myActiveProcUPP;
+			
+    tclOSAComponent *newComponent;
+    Tcl_HashEntry *hashEntry;
+    int newPtr;
+	
+    requestedComponent.componentSubType = scriptSubtype;
+    nbytes = sizeof(tclOSAComponent);
+    newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent));
+    if (newComponent == NULL) {
+	goto CleanUp;
+    }
+	
+    foundComponent = FindNextComponent(0, &requestedComponent);
+    if (foundComponent == 0) {
+	Tcl_AppendResult(interp,
+		"Could not find component of requested type", (char *) NULL);
+	goto CleanUp;
+    } 
+	
+    newComponent->theComponent = OpenComponent(foundComponent); 
+	
+    if (newComponent->theComponent == NULL) {
+	Tcl_AppendResult(interp,
+		"Could not open component of the requested type",
+		(char *) NULL);
+	goto CleanUp;
+    }
+							
+    newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1);
+    strcpy(newComponent->languageName,languageName);
+	
+    newComponent->componentFlags = componentFlags;
+	
+    newComponent->theInterp = interp;
+	
+    Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
+		
+    if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
+	sprintf(buffer, "%-6.6d", globalContext);
+	Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
+		" context.", (char *) NULL);
+	goto CleanUp;
+    }
+    
+    newComponent->languageID = scriptSubtype;
+	
+    newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 );
+    strcpy(newComponent->theName, cmdName);
+
+    Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd,
+	    (ClientData) newComponent, tclOSAClose);
+					
+    /*
+     * Register the new component with the component table
+     */ 
+
+    ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
+	    "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
+	
+    if (ComponentTable == NULL) {
+	Tcl_AppendResult(interp, "Error, could not get the Component Table",
+		" from the Associated data.", (char *) NULL);
+	return (tclOSAComponent *) NULL;
+    }
+	
+    hashEntry = Tcl_CreateHashEntry(ComponentTable,
+	    newComponent->theName, &newPtr);	
+    Tcl_SetHashValue(hashEntry, (ClientData) newComponent);
+
+    /*
+     * Set the active proc to call Tcl_DoOneEvent() while idle
+     */
+    if (OSAGetActiveProc(newComponent->theComponent,
+	    &newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) {
+    	/* TODO -- clean up here... */
+    }
+
+    myActiveProcUPP = NewOSAActiveProc(TclOSAActiveProc);
+    OSASetActiveProc(newComponent->theComponent,
+	    myActiveProcUPP, (long) newComponent);
+    return newComponent;
+	
+    CleanUp:
+	
+    ckfree((char *) newComponent);
+    return (tclOSAComponent *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAClose --
+ *
+ *	This procedure closes the connection to an OSA component, and 
+ *	deletes all the script and context data associated with it.
+ *	It is the command deletion callback for the component's command.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Closes the connection, and releases all the script data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void 
+tclOSAClose(
+    ClientData clientData) 
+{
+    tclOSAComponent *theComponent = (tclOSAComponent *) clientData;
+    Tcl_HashEntry *hashEntry;
+    Tcl_HashSearch search;
+    tclOSAScript *theScript;
+    Tcl_HashTable *ComponentTable;
+	
+    /* 
+     * Delete the context and script tables 
+     * the memory for the language name, and
+     * the hash entry.
+     */
+	
+    for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search);
+	 hashEntry != NULL;
+	 hashEntry = Tcl_NextHashEntry(&search)) {
+
+	theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
+	OSADispose(theComponent->theComponent, theScript->scriptID);	
+	ckfree((char *) theScript);
+	Tcl_DeleteHashEntry(hashEntry);
+    }
+	
+    for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search);
+	 hashEntry != NULL;
+	 hashEntry = Tcl_NextHashEntry(&search)) {
+
+	Tcl_DeleteHashEntry(hashEntry);
+    }
+	
+    ckfree(theComponent->languageName);
+    ckfree(theComponent->theName);
+	
+    /*
+     * Finally close the component
+     */
+	
+    CloseComponent(theComponent->theComponent);
+	
+    ComponentTable = (Tcl_HashTable *)
+	Tcl_GetAssocData(theComponent->theInterp,
+		"OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
+	
+    if (ComponentTable == NULL) {
+	panic("Error, could not get the Component Table from the Associated data.");
+    }
+	
+    hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName);
+    if (hashEntry != NULL) {
+	Tcl_DeleteHashEntry(hashEntry);
+    }
+    
+    ckfree((char *) theComponent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAGetContextID  --
+ *
+ *	This returns the context ID, given the component name.
+ *
+ * Results:
+ *	A context ID
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int 
+tclOSAGetContextID(
+    tclOSAComponent *theComponent, 
+    char *contextName, 
+    OSAID *theContext)
+{
+    Tcl_HashEntry *hashEntry;
+    tclOSAContext *contextStruct;
+	
+    if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable,
+	    contextName)) == NULL ) {			
+	return TCL_ERROR;
+    } else {
+	contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
+	*theContext = contextStruct->contextID;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAAddContext  --
+ *
+ *	This adds the context ID, with the name contextName.  If the
+ *	name is passed in as a NULL string, space is malloc'ed for the
+ *	string and a new name is made up, if the string is empty, you
+ *	must have allocated enough space ( 24 characters is fine) for
+ *	the name, which is made up and passed out.
+ *
+ * Results:
+ *	Nothing
+ *
+ * Side effects:
+ *	Adds the script context to the component's context table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void 
+tclOSAAddContext(
+    tclOSAComponent *theComponent, 
+    char *contextName,
+    const OSAID theContext)
+{
+    static unsigned short contextIndex = 0;
+    tclOSAContext *contextStruct;
+    Tcl_HashEntry *hashEntry;
+    int newPtr;
+
+    if (contextName == NULL) {
+	contextName = ckalloc(24 * sizeof(char));
+	sprintf(contextName, "OSAContext%d", contextIndex++);
+    } else if (*contextName == '\0') {
+	sprintf(contextName, "OSAContext%d", contextIndex++);
+    }
+	
+    hashEntry = Tcl_CreateHashEntry(&theComponent->contextTable,
+	    contextName, &newPtr);	
+
+    contextStruct = (tclOSAContext *) ckalloc(sizeof(tclOSAContext));
+    contextStruct->contextID = theContext;
+    Tcl_SetHashValue(hashEntry,(ClientData) contextStruct);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSADeleteContext  --
+ *
+ *	This deletes the context struct, with the name contextName.  
+ *
+ * Results:
+ *	A normal Tcl result
+ *
+ * Side effects:
+ *	Removes the script context to the component's context table,
+ *	and deletes the data associated with it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int 
+tclOSADeleteContext(
+    tclOSAComponent *theComponent,
+    char *contextName) 
+{
+    Tcl_HashEntry *hashEntry;
+    tclOSAContext *contextStruct;
+	
+    hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, contextName);
+    if (hashEntry == NULL) {
+	return TCL_ERROR;
+    }	
+    /*
+     * Dispose of the script context data
+     */
+    contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
+    OSADispose(theComponent->theComponent,contextStruct->contextID);
+    /*
+     * Then the hash entry
+     */
+    ckfree((char *) contextStruct);
+    Tcl_DeleteHashEntry(hashEntry);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAMakeContext  --
+ *
+ *	This makes the context with name contextName, and returns the ID.
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side effects:
+ *	Makes a new context, adds it to the context table, and returns 
+ *	the new contextID in the variable theContext.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int 
+tclOSAMakeContext(
+    tclOSAComponent *theComponent, 
+    char *contextName,
+    OSAID *theContext)
+{
+    AEDesc contextNameDesc = {typeNull, NULL};
+    OSAError osaErr = noErr;
+
+    AECreateDesc(typeChar, contextName, strlen(contextName), &contextNameDesc);
+    osaErr = OSAMakeContext(theComponent->theComponent, &contextNameDesc,
+	    kOSANullScript, theContext);
+								
+    AEDisposeDesc(&contextNameDesc);
+	
+    if (osaErr == noErr) {
+	tclOSAAddContext(theComponent, contextName, *theContext);
+    } else {
+	*theContext = (OSAID) osaErr;
+	return TCL_ERROR;
+    }
+	
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAStore --
+ *
+ *	This stores a script resource from the file named in fileName.
+ *
+ *	Most of this routine is caged from the Tcl Source, from the
+ *	Tcl_MacSourceCmd routine.  This is good, since it ensures this
+ *	follows the same convention for looking up files as Tcl.
+ *
+ * Returns
+ *	A standard Tcl result.
+ *
+ * Side Effects:
+ *	The given script data is stored in the file fileName.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+int
+tclOSAStore(
+    Tcl_Interp *interp,
+    tclOSAComponent *theComponent,
+    char *resourceName,
+    int resourceNumber, 
+    char *scriptName,
+    char *fileName)
+{
+    Handle resHandle;
+    Str255 rezName;
+    int result = TCL_OK;
+    short saveRef, fileRef = -1;
+    char idStr[64];
+    FSSpec fileSpec;
+    Tcl_DString buffer;
+    char *nativeName;
+    OSErr myErr = noErr;
+    OSAID scriptID;
+    Size scriptSize;
+    AEDesc scriptData;
+
+    /*
+     * First extract the script data
+     */
+	
+    if (tclOSAGetScriptID(theComponent, scriptName, &scriptID) != TCL_OK ) {
+	if (tclOSAGetContextID(theComponent, scriptName, &scriptID)
+		!= TCL_OK) {
+	    Tcl_AppendResult(interp, "Error getting script ",
+		    scriptName, (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+	
+    myErr = OSAStore(theComponent->theComponent, scriptID,
+	    typeOSAGenericStorage, kOSAModeNull, &scriptData);
+    if (myErr != noErr) {
+	sprintf(idStr, "%d", myErr);
+	Tcl_AppendResult(interp, "Error #", idStr,
+		" storing script ", scriptName, (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now try to open the output file
+     */
+	
+    saveRef = CurResFile();
+	
+    if (fileName != NULL) {
+	OSErr err;
+		
+	Tcl_DStringInit(&buffer);	
+	nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+	if (nativeName == NULL) {
+	    return TCL_ERROR;
+	}
+	err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
+		
+	Tcl_DStringFree(&buffer);
+	if ((err != noErr) && (err != fnfErr)) {
+	    Tcl_AppendResult(interp,
+		    "Error getting a location for the file: \"", 
+		    fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+		
+	FSpCreateResFileCompat(&fileSpec,
+		'WiSH', 'osas', smSystemScript);	
+	myErr = ResError();
+	
+	if ((myErr != noErr) && (myErr != dupFNErr)) {
+	    sprintf(idStr, "%d", myErr);
+	    Tcl_AppendResult(interp, "Error #", idStr,
+		    " creating new resource file ", fileName, (char *) NULL);
+	    result = TCL_ERROR;
+	    goto rezEvalCleanUp;
+	}
+		
+	fileRef = FSpOpenResFileCompat(&fileSpec, fsRdWrPerm);
+	if (fileRef == -1) {
+	    Tcl_AppendResult(interp, "Error reading the file: \"", 
+		    fileName, "\".", NULL);
+	    result = TCL_ERROR;
+	    goto rezEvalCleanUp;
+	}
+	UseResFile(fileRef);
+    } else {
+	/*
+	 * The default behavior will search through all open resource files.
+	 * This may not be the behavior you desire.  If you want the behavior
+	 * of this call to *only* search the application resource fork, you
+	 * must call UseResFile at this point to set it to the application
+	 * file.  This means you must have already obtained the application's 
+	 * fileRef when the application started up.
+	 */
+    }
+	
+    /*
+     * Load the resource by name 
+     */
+    if (resourceName != NULL) {
+	strcpy((char *) rezName + 1, resourceName);
+	rezName[0] = strlen(resourceName);
+	resHandle = Get1NamedResource('scpt', rezName);
+	myErr = ResError();
+	if (resHandle == NULL) {
+	    /*
+	     * These signify either the resource or the resource
+	     * type were not found
+	     */
+	    if (myErr == resNotFound || myErr == noErr) {
+		short uniqueID;
+		while ((uniqueID = Unique1ID('scpt') ) < 128) {}
+		AddResource(scriptData.dataHandle, 'scpt', uniqueID, rezName);
+		WriteResource(resHandle);
+		result = TCL_OK;
+		goto rezEvalCleanUp;
+	    } else {
+		/*
+		 * This means there was some other error, for now
+		 * I just bag out.
+		 */
+		sprintf(idStr, "%d", myErr);
+		Tcl_AppendResult(interp, "Error #", idStr,
+			" opening scpt resource named ", resourceName,
+			" in file ", fileName, (char *) NULL);
+		result = TCL_ERROR;
+		goto rezEvalCleanUp;
+	    }
+	}
+	/*
+	 * Or ID
+	 */ 
+    } else {
+	resHandle = Get1Resource('scpt', resourceNumber);
+	rezName[0] = 0;
+	rezName[1] = '\0';
+	myErr = ResError();
+	if (resHandle == NULL) {
+	    /*
+	     * These signify either the resource or the resource
+	     * type were not found
+	     */
+	    if (myErr == resNotFound || myErr == noErr) {
+		AddResource(scriptData.dataHandle, 'scpt',
+			resourceNumber, rezName);
+		WriteResource(resHandle);
+		result = TCL_OK;
+		goto rezEvalCleanUp;
+	    } else {
+		/*
+		 * This means there was some other error, for now
+		 * I just bag out */
+		sprintf(idStr, "%d", myErr);
+		Tcl_AppendResult(interp, "Error #", idStr,
+			" opening scpt resource named ", resourceName,
+			" in file ", fileName,(char *) NULL);
+		result = TCL_ERROR;
+		goto rezEvalCleanUp;
+	    }
+	} 
+    }
+	
+    /* 
+     * We get to here if the resource exists 
+     * we just copy into it... 
+     */
+	 
+    scriptSize = GetHandleSize(scriptData.dataHandle);
+    SetHandleSize(resHandle, scriptSize);
+    HLock(scriptData.dataHandle);
+    HLock(resHandle);
+    BlockMove(*scriptData.dataHandle, *resHandle,scriptSize);
+    HUnlock(scriptData.dataHandle);
+    HUnlock(resHandle);
+    ChangedResource(resHandle);
+    WriteResource(resHandle);
+    result = TCL_OK;
+    goto rezEvalCleanUp;
+			
+    rezEvalError:
+    sprintf(idStr, "ID=%d", resourceNumber);
+    Tcl_AppendResult(interp, "The resource \"",
+	    (resourceName != NULL ? resourceName : idStr),
+	    "\" could not be loaded from ",
+	    (fileName != NULL ? fileName : "application"),
+	    ".", NULL);
+
+    rezEvalCleanUp:
+    if (fileRef != -1) {
+	CloseResFile(fileRef);
+    }
+
+    UseResFile(saveRef);
+	
+    return result;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * tclOSALoad --
+ *
+ *	This loads a script resource from the file named in fileName.
+ *	Most of this routine is caged from the Tcl Source, from the
+ *	Tcl_MacSourceCmd routine.  This is good, since it ensures this
+ *	follows the same convention for looking up files as Tcl.
+ *
+ * Returns
+ *	A standard Tcl result.
+ *
+ * Side Effects:
+ *	A new script element is created from the data in the file.
+ *	The script ID is passed out in the variable resultID.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+int
+tclOSALoad(
+    Tcl_Interp *interp,
+    tclOSAComponent *theComponent,
+    char *resourceName,
+    int resourceNumber, 
+    char *fileName,
+    OSAID *resultID)
+{
+    Handle sourceData;
+    Str255 rezName;
+    int result = TCL_OK;
+    short saveRef, fileRef = -1;
+    char idStr[64];
+    FSSpec fileSpec;
+    Tcl_DString buffer;
+    char *nativeName;
+
+    saveRef = CurResFile();
+	
+    if (fileName != NULL) {
+	OSErr err;
+		
+	Tcl_DStringInit(&buffer);	
+	nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+	if (nativeName == NULL) {
+	    return TCL_ERROR;
+	}
+	err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
+	Tcl_DStringFree(&buffer);
+	if (err != noErr) {
+	    Tcl_AppendResult(interp, "Error finding the file: \"", 
+		    fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+			
+	fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
+	if (fileRef == -1) {
+	    Tcl_AppendResult(interp, "Error reading the file: \"", 
+		    fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+	UseResFile(fileRef);
+    } else {
+	/*
+	 * The default behavior will search through all open resource files.
+	 * This may not be the behavior you desire.  If you want the behavior
+	 * of this call to *only* search the application resource fork, you
+	 * must call UseResFile at this point to set it to the application
+	 * file.  This means you must have already obtained the application's 
+	 * fileRef when the application started up.
+	 */
+    }
+	
+    /*
+     * Load the resource by name or ID
+     */
+    if (resourceName != NULL) {
+	strcpy((char *) rezName + 1, resourceName);
+	rezName[0] = strlen(resourceName);
+	sourceData = GetNamedResource('scpt', rezName);
+    } else {
+	sourceData = GetResource('scpt', (short) resourceNumber);
+    }
+	
+    if (sourceData == NULL) {
+	result = TCL_ERROR;
+    } else {
+	AEDesc scriptDesc;
+	OSAError osaErr;
+		
+	scriptDesc.descriptorType = typeOSAGenericStorage;
+	scriptDesc.dataHandle = sourceData;
+		
+	osaErr = OSALoad(theComponent->theComponent, &scriptDesc,
+		kOSAModeNull, resultID);
+		
+	ReleaseResource(sourceData);
+		
+	if (osaErr != noErr) {
+	    result = TCL_ERROR;
+	    goto rezEvalError;
+	}
+			
+	goto rezEvalCleanUp;
+    }
+	
+    rezEvalError:
+    sprintf(idStr, "ID=%d", resourceNumber);
+    Tcl_AppendResult(interp, "The resource \"",
+	    (resourceName != NULL ? resourceName : idStr),
+	    "\" could not be loaded from ",
+	    (fileName != NULL ? fileName : "application"),
+	    ".", NULL);
+
+    rezEvalCleanUp:
+    if (fileRef != -1) {
+	CloseResFile(fileRef);
+    }
+
+    UseResFile(saveRef);
+	
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAGetScriptID  --
+ *
+ *	This returns the context ID, gibven the component name.
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side effects:
+ *	Passes out the script ID in the variable scriptID.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int 
+tclOSAGetScriptID(
+    tclOSAComponent *theComponent,
+    char *scriptName,
+    OSAID *scriptID) 
+{
+    tclOSAScript *theScript;
+	
+    theScript = tclOSAGetScript(theComponent, scriptName);
+    if (theScript == NULL) {
+	return TCL_ERROR;
+    }
+	
+    *scriptID = theScript->scriptID;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAAddScript  --
+ *
+ *	This adds a script to theComponent's script table, with the
+ *	given name & ID.
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side effects:
+ *	Adds an element to the component's script table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int 
+tclOSAAddScript(
+    tclOSAComponent *theComponent,
+    char *scriptName,
+    long modeFlags,
+    OSAID scriptID) 
+{
+    Tcl_HashEntry *hashEntry;
+    int newPtr;
+    static int scriptIndex = 0;
+    tclOSAScript *theScript;
+	
+    if (*scriptName == '\0') {
+	sprintf(scriptName, "OSAScript%d", scriptIndex++);
+    }
+	
+    hashEntry = Tcl_CreateHashEntry(&theComponent->scriptTable,
+	    scriptName, &newPtr);
+    if (newPtr == 0) {
+	theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
+	OSADispose(theComponent->theComponent, theScript->scriptID);
+    } else {		
+	theScript = (tclOSAScript *) ckalloc(sizeof(tclOSAScript));
+	if (theScript == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+		
+    theScript->scriptID = scriptID;
+    theScript->languageID = theComponent->languageID;
+    theScript->modeFlags = modeFlags;
+	
+    Tcl_SetHashValue(hashEntry,(ClientData) theScript);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAGetScriptID  --
+ *
+ *	This returns the script structure, given the component and script name.
+ *
+ * Results:
+ *	A pointer to the script structure.
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static tclOSAScript *
+tclOSAGetScript(
+    tclOSAComponent *theComponent,
+    char *scriptName)
+{
+    Tcl_HashEntry *hashEntry;
+	
+    hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
+    if (hashEntry == NULL) {
+	return NULL;
+    }
+	
+    return (tclOSAScript *) Tcl_GetHashValue(hashEntry);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSADeleteScript  --
+ *
+ *	This deletes the script given by scriptName.
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side effects:
+ *	Deletes the script from the script table, and frees up the
+ *	resources associated with it.  If there is an error, then
+ *	space for the error message is malloc'ed, and passed out in
+ *	the variable errMsg.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+tclOSADeleteScript(
+    tclOSAComponent *theComponent,
+    char *scriptName,
+    char *errMsg) 
+{
+    Tcl_HashEntry *hashEntry;
+    tclOSAScript *scriptPtr;
+
+    hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
+    if (hashEntry == NULL) {
+	errMsg = ckalloc(17);
+	strcpy(errMsg,"Script not found");
+	return TCL_ERROR;
+    }
+	
+    scriptPtr = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
+    OSADispose(theComponent->theComponent, scriptPtr->scriptID);
+    ckfree((char *) scriptPtr);
+    Tcl_DeleteHashEntry(hashEntry);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOSAActiveProc --
+ *
+ *	This is passed to each component.  It is run periodically
+ *	during script compilation and script execution.  It in turn
+ *	calls Tcl_DoOneEvent to process the event queue.  We also call
+ *	the default Active proc which will let the user cancel the script
+ *	by hitting Command-.
+ * 
+ * Results:
+ *	A standard MacOS system error
+ *
+ * Side effects:
+ *	Any Tcl code may run while calling Tcl_DoOneEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static pascal OSErr 
+TclOSAActiveProc(
+    long refCon)
+{
+    tclOSAComponent *theComponent = (tclOSAComponent *) refCon;
+	
+    Tcl_DoOneEvent(TCL_DONT_WAIT);
+    CallOSAActiveProc(theComponent->defActiveProc, theComponent->defRefCon);
+	
+    return noErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ASCIICompareProc --
+ *
+ *	Trivial ascii compare for use with qsort.	
+ *
+ * Results:
+ *	strcmp of the two input strings
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+static int 
+ASCIICompareProc(const void *first,const void *second)
+{
+    int order;
+    
+    char *firstString = *((char **) first);
+    char *secondString = *((char **) second);
+
+    order = strcmp(firstString, secondString);
+	
+    return order;
+}
+
+#define REALLOC_INCR 30
+/*
+ *----------------------------------------------------------------------
+ *
+ * getSortedHashKeys --
+ *
+ *	returns an alphabetically sorted list of the keys of the hash
+ *	theTable which match the string "pattern" in the DString
+ *	theResult. pattern == NULL matches all.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	ReInitializes the DString theResult, then copies the names of
+ *	the matching keys into the string as list elements.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static void 
+getSortedHashKeys(
+    Tcl_HashTable *theTable,
+    char *pattern,
+    Tcl_DString *theResult)
+{
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
+    Boolean compare = true;
+    char *keyPtr;
+    static char **resultArgv = NULL;
+    static int totSize = 0;
+    int totElem = 0, i;
+	
+    if (pattern == NULL || *pattern == '\0' || 
+	    (*pattern == '*' && *(pattern + 1) == '\0')) {
+	compare = false;
+    }
+	
+    for (hPtr = Tcl_FirstHashEntry(theTable,&search), totElem = 0;
+	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+			
+	keyPtr = (char *) Tcl_GetHashKey(theTable, hPtr);
+	if (!compare || Tcl_StringMatch(keyPtr, pattern)) {
+	    totElem++;		
+	    if (totElem >= totSize) {
+		totSize += REALLOC_INCR;
+		resultArgv = (char **) ckrealloc((char *) resultArgv,
+			totSize * sizeof(char *));
+	    }
+	    resultArgv[totElem - 1] = keyPtr;
+	} 
+    }
+		
+    Tcl_DStringInit(theResult);
+    if (totElem == 1) {
+	Tcl_DStringAppendElement(theResult, resultArgv[0]);
+    } else if (totElem > 1) {
+	qsort((VOID *) resultArgv, (size_t) totElem, sizeof (char *),
+		ASCIICompareProc);
+
+	for (i = 0; i < totElem; i++) {
+	    Tcl_DStringAppendElement(theResult, resultArgv[i]);
+	}
+    }	
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * prepareScriptData --
+ *
+ *	Massages the input data in the argv array, concating the 
+ *	elements, with a " " between each, and replacing \n with \r,
+ *	and \\n with "  ".  Puts the result in the the DString scrptData,
+ *	and copies the result to the AEdesc scrptDesc.
+ *
+ * Results:
+ *	Standard Tcl result
+ *
+ * Side effects:
+ *	Creates a new Handle (with AECreateDesc) for the script data.
+ *	Stores the script in scrptData, or the error message if there
+ *	is an error creating the descriptor.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int
+prepareScriptData(
+    int argc,
+    char **argv,
+    Tcl_DString *scrptData,
+    AEDesc *scrptDesc) 
+{
+    char * ptr;
+    int i;
+    char buffer[7];
+    OSErr sysErr = noErr;
+		
+    Tcl_DStringInit(scrptData);
+	
+    for (i = 0; i < argc; i++) {
+	Tcl_DStringAppend(scrptData, argv[i], -1);
+	Tcl_DStringAppend(scrptData, " ", 1);
+    }
+
+    /*
+     * First replace the \n's with \r's in the script argument
+     * Also replace "\\n" with "  ".
+     */
+	 
+    for (ptr = scrptData->string; *ptr != '\0'; ptr++) {
+	if (*ptr == '\n') {
+	    *ptr = '\r';
+	} else if (*ptr == '\\') {
+	    if (*(ptr + 1) == '\n') {
+		*ptr = ' ';
+		*(ptr + 1) = ' ';
+	    }
+	}
+    }
+ 	
+    sysErr = AECreateDesc(typeChar, Tcl_DStringValue(scrptData),
+	    Tcl_DStringLength(scrptData), scrptDesc);
+						
+    if (sysErr != noErr) {
+	sprintf(buffer, "%6d", sysErr);
+	Tcl_DStringFree(scrptData);
+	Tcl_DStringAppend(scrptData, "Error #", 7);
+	Tcl_DStringAppend(scrptData, buffer, -1);
+	Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33);
+	return TCL_ERROR;					
+    }
+	
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAResultFromID --
+ *
+ *	Gets a human readable version of the result from the script ID
+ *	and returns it in the result of the interpreter interp
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Sets the result of interp to the human readable version of resultID.
+ *  
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+void 
+tclOSAResultFromID(
+    Tcl_Interp *interp,
+    ComponentInstance theComponent,
+    OSAID resultID )
+{
+    OSErr myErr = noErr;
+    AEDesc resultDesc;
+    Tcl_DString resultStr;
+	
+    Tcl_DStringInit(&resultStr);
+	
+    myErr = OSADisplay(theComponent, resultID, typeChar,
+	    kOSAModeNull, &resultDesc);
+    Tcl_DStringAppend(&resultStr, (char *) *resultDesc.dataHandle,
+	    GetHandleSize(resultDesc.dataHandle));
+    Tcl_DStringResult(interp,&resultStr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclOSAASError --
+ *
+ *	Gets the error message from the AppleScript component, and adds
+ *	it to interp's result. If the script data is known, will point
+ *	out the offending bit of code.  This MUST BE A NULL TERMINATED
+ *	C-STRING, not a typeChar.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Sets the result of interp to error, plus the relevant portion
+ *	of the script.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+void 
+tclOSAASError(
+    Tcl_Interp * interp,
+    ComponentInstance theComponent,
+    char *scriptData )
+{
+    OSErr myErr = noErr;
+    AEDesc errResult,errLimits;
+    Tcl_DString errStr;
+    DescType returnType;
+    Size returnSize;
+    short srcStart,srcEnd;
+    char buffer[16];
+	
+    Tcl_DStringInit(&errStr);
+    Tcl_DStringAppend(&errStr, "An AppleScript error was encountered.\n", -1); 
+	
+    OSAScriptError(theComponent, kOSAErrorNumber,
+	    typeShortInteger, &errResult);
+	
+    sprintf(buffer, "Error #%-6.6d\n", (short int) **errResult.dataHandle);
+
+    AEDisposeDesc(&errResult);
+	
+    Tcl_DStringAppend(&errStr,buffer, 15);
+	
+    OSAScriptError(theComponent, kOSAErrorMessage, typeChar, &errResult);
+    Tcl_DStringAppend(&errStr, (char *) *errResult.dataHandle,
+	    GetHandleSize(errResult.dataHandle));
+    AEDisposeDesc(&errResult);
+	
+    if (scriptData != NULL) {
+	int lowerB, upperB;
+		
+	myErr = OSAScriptError(theComponent, kOSAErrorRange,
+		typeOSAErrorRange, &errResult);
+		
+	myErr = AECoerceDesc(&errResult, typeAERecord, &errLimits);
+	myErr = AEGetKeyPtr(&errLimits, keyOSASourceStart,
+		typeShortInteger, &returnType, &srcStart,
+		sizeof(short int), &returnSize);
+	myErr = AEGetKeyPtr(&errLimits, keyOSASourceEnd, typeShortInteger,
+		&returnType, &srcEnd, sizeof(short int), &returnSize);
+	AEDisposeDesc(&errResult);
+	AEDisposeDesc(&errLimits);
+
+	Tcl_DStringAppend(&errStr, "\nThe offending bit of code was:\n\t", -1);
+	/*
+	 * Get the full line on which the error occured:
+	 */
+	for (lowerB = srcStart; lowerB > 0; lowerB--) {
+	    if (*(scriptData + lowerB ) == '\r') {
+		lowerB++;
+		break;
+	    }
+	}
+		
+	for (upperB = srcEnd; *(scriptData + upperB) != '\0'; upperB++) {
+	    if (*(scriptData + upperB) == '\r') {
+		break;
+	    }
+	}
+
+	Tcl_DStringAppend(&errStr, scriptData+lowerB, srcStart - lowerB);
+	Tcl_DStringAppend(&errStr, "_", 1);
+	Tcl_DStringAppend(&errStr, scriptData+srcStart, upperB - srcStart);
+    }
+	
+    Tcl_DStringResult(interp,&errStr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetRawDataFromDescriptor --
+ *
+ *	Get the data from a descriptor.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static void
+GetRawDataFromDescriptor(
+    AEDesc *theDesc,
+    Ptr destPtr,
+    Size destMaxSize,
+    Size *actSize)
+  {
+      Size copySize;
+
+      if (theDesc->dataHandle) {
+	  HLock((Handle)theDesc->dataHandle);
+	  *actSize = GetHandleSize((Handle)theDesc->dataHandle);
+	  copySize = *actSize < destMaxSize ? *actSize : destMaxSize;
+	  BlockMove(*theDesc->dataHandle, destPtr, copySize);
+	  HUnlock((Handle)theDesc->dataHandle);
+      } else {
+	  *actSize = 0;
+      }
+      
+  }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetRawDataFromDescriptor --
+ *
+ *	Get the data from a descriptor.  Assume it's a C string.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static OSErr
+GetCStringFromDescriptor(
+    AEDesc *sourceDesc,
+    char *resultStr,
+    Size resultMaxSize,
+    Size *resultSize)
+{
+    OSErr err;
+    AEDesc resultDesc;
+
+    resultDesc.dataHandle = nil;
+				
+    err = AECoerceDesc(sourceDesc, typeChar, &resultDesc);
+		
+    if (!err) {
+	GetRawDataFromDescriptor(&resultDesc, (Ptr) resultStr,
+		resultMaxSize - 1, resultSize);
+	resultStr[*resultSize] = 0;
+    } else {
+	err = errAECoercionFail;
+    }
+			
+    if (resultDesc.dataHandle) {
+	AEDisposeDesc(&resultDesc);
+    }
+    
+    return err;
+}
diff --git a/tcl/mac/tclMacOSA.exp b/tcl/mac/tclMacOSA.exp
new file mode 100644
index 00000000000..4cde51227f0
--- /dev/null
+++ b/tcl/mac/tclMacOSA.exp
@@ -0,0 +1 @@
+Tclapplescript_Init
diff --git a/tcl/mac/tclMacOSA.r b/tcl/mac/tclMacOSA.r
new file mode 100644
index 00000000000..82938bf07ab
--- /dev/null
+++ b/tcl/mac/tclMacOSA.r
@@ -0,0 +1,76 @@
+/*
+ * tkMacOSA.r --
+ *
+ *	This file creates resources used by the AppleScript package.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define SCRIPT_MAJOR_VERSION 1		/* Major number */
+#define SCRIPT_MINOR_VERSION  0		/* Minor number */
+#define SCRIPT_RELEASE_SERIAL  2	/* Really minor number! */
+#define RELEASE_LEVEL alpha		/* alpha, beta, or final */
+#define SCRIPT_VERSION "1.0"
+#define SCRIPT_PATCH_LEVEL "1.0a2"
+#define FINAL 0				/* Change to 1 if final version. */
+
+#if FINAL
+#   define MINOR_VERSION (SCRIPT_MINOR_VERSION * 16) + SCRIPT_RELEASE_SERIAL
+#else
+#   define MINOR_VERSION SCRIPT_MINOR_VERSION * 16
+#endif
+
+#define RELEASE_CODE 0x00
+
+resource 'vers' (1) {
+	SCRIPT_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	SCRIPT_PATCH_LEVEL,
+	SCRIPT_PATCH_LEVEL ", by Jim Ingham & Ray Johnson © Sun Microsystems"
+};
+
+resource 'vers' (2) {
+	SCRIPT_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	SCRIPT_PATCH_LEVEL,
+	"Tclapplescript " SCRIPT_PATCH_LEVEL " © 1996-1997"
+};
+
+/*
+ * The -16397 string will be displayed by Finder when a user
+ * tries to open the shared library. The string should
+ * give the user a little detail about the library's capabilities
+ * and enough information to install the library in the correct location.  
+ * A similar string should be placed in all shared libraries.
+ */
+resource 'STR ' (-16397, purgeable) {
+	"TclAppleScript Library\n\n"
+	"This library provides the ability to run AppleScript "
+	" commands from Tcl/Tk programs.  To work properly, it "
+	"should be placed in the ÔTool Command LanguageÕ folder "
+	"within the Extensions folder."
+};
+
+
+/* 
+ * We now load the Tk library into the resource fork of the library.
+ */
+
+data 'TEXT' (4000,"pkgIndex",purgeable, preload) {
+	"# Tcl package index file, version 1.0\n"
+	"package ifneeded Tclapplescript 1.0 [list tclPkgSetup $dir Tclapplescript 1.0 {{Tclapplescript" 
+	".shlb load AppleScript}}]\n"
+};
diff --git a/tcl/mac/tclMacPanic.c b/tcl/mac/tclMacPanic.c
new file mode 100644
index 00000000000..f059f4aee6b
--- /dev/null
+++ b/tcl/mac/tclMacPanic.c
@@ -0,0 +1,235 @@
+/* 
+ * tclMacPanic.c --
+ *
+ *	Source code for the "panic" library procedure used in "Simple Shell";
+ *	other Mac applications will probably override this with a more robust
+ *	application-specific panic procedure.
+ *
+ * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+
+#include <Events.h>
+#include <Controls.h>
+#include <Windows.h>
+#include <TextEdit.h>
+#include <Fonts.h>
+#include <Dialogs.h>
+#include <Icons.h>
+#include <Sound.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "tclInt.h"
+
+/*
+ * constants for panic dialog
+ */
+#define PANICHEIGHT 150				/* Height of dialog */
+#define PANICWIDTH 350				/* Width of dialog */
+#define PANIC_BUTTON_RECT {125, 260, 145, 335}	/* Rect for button. */
+#define PANIC_ICON_RECT   {10, 20, 42, 52}	/* Rect for icon. */
+#define PANIC_TEXT_RECT   {10, 65, 140, 330}	/* Rect for text. */
+#define	ENTERCODE  (0x03)
+#define	RETURNCODE (0x0D)
+
+/*
+ * The panicProc variable contains a pointer to an application
+ * specific panic procedure.
+ */
+
+void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetPanicProc --
+ *
+ *	Replace the default panic behavior with the specified functiion.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the panicProc variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetPanicProc(proc)
+    void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
+{
+    panicProc = proc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacPanic --
+ *
+ *	Displays panic info..
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the panicProc variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MacPanic(
+    char *msg)		/* Text to show in panic dialog. */
+{
+    WindowRef macWinPtr, foundWinPtr;
+    Rect macRect;
+    Rect buttonRect = PANIC_BUTTON_RECT;
+    Rect iconRect = PANIC_ICON_RECT;
+    Rect textRect = PANIC_TEXT_RECT;
+    ControlHandle okButtonHandle;
+    EventRecord event;
+    Handle stopIconHandle;
+    int	part;
+    Boolean done = false;
+            
+
+    /*
+     * Put up an alert without using the Resource Manager (there may 
+     * be no resources to load). Use the Window and Control Managers instead.
+     * We want the window centered on the main monitor. The following 
+     * should be tested with multiple monitors. Look and see if there is a way
+     * not using qd.screenBits.
+     */
+ 
+    macRect.top = (qd.screenBits.bounds.top + qd.screenBits.bounds.bottom)
+	/ 2 - (PANICHEIGHT / 2);
+    macRect.bottom = (qd.screenBits.bounds.top + qd.screenBits.bounds.bottom)
+	/ 2 + (PANICHEIGHT / 2);
+    macRect.left = (qd.screenBits.bounds.left + qd.screenBits.bounds.right)
+	/ 2 - (PANICWIDTH / 2);
+    macRect.right = (qd.screenBits.bounds.left + qd.screenBits.bounds.right)
+	/ 2 + (PANICWIDTH / 2);
+    
+    macWinPtr = NewWindow(NULL, &macRect, "\p", true, dBoxProc, (WindowRef) -1,
+            false, 0);
+    if (macWinPtr == NULL) {
+	goto exitNow;
+    }
+    
+    okButtonHandle = NewControl(macWinPtr, &buttonRect, "\pOK", true,
+	    0, 0, 1, pushButProc, 0);
+    if (okButtonHandle == NULL) {
+	CloseWindow(macWinPtr);
+	goto exitNow;
+    }
+    
+    SelectWindow(macWinPtr);
+    SetCursor(&qd.arrow);
+    stopIconHandle = GetIcon(kStopIcon);
+            
+    while (!done) {
+	if (WaitNextEvent(mDownMask | keyDownMask | updateMask,
+		&event, 0, NULL)) {
+	    switch(event.what) {
+		case mouseDown:
+		    part = FindWindow(event.where, &foundWinPtr);
+    
+		    if ((foundWinPtr != macWinPtr) || (part != inContent)) {
+		    	SysBeep(1);
+		    } else {
+		    	SetPortWindowPort(macWinPtr);
+		    	GlobalToLocal(&event.where);
+		    	part = FindControl(event.where, macWinPtr,
+				&okButtonHandle);
+    	
+			if ((inButton == part) && 
+				(TrackControl(okButtonHandle,
+					event.where, NULL))) {
+			    done = true;
+			}
+		    }
+		    break;
+		case keyDown:
+		    switch (event.message & charCodeMask) {
+			case ENTERCODE:
+			case RETURNCODE:
+			    HiliteControl(okButtonHandle, 1);
+			    HiliteControl(okButtonHandle, 0);
+			    done = true;
+		    }
+		    break;
+		case updateEvt:   
+		    SetPortWindowPort(macWinPtr);
+		    TextFont(systemFont);
+		    
+		    BeginUpdate(macWinPtr);
+		    if (stopIconHandle != NULL) {
+			PlotIcon(&iconRect, stopIconHandle);
+		    }
+		    TextBox(msg, strlen(msg), &textRect, teFlushDefault);
+		    DrawControls(macWinPtr);
+		    EndUpdate(macWinPtr);
+	    }
+	}
+    }
+
+    CloseWindow(macWinPtr);
+
+  exitNow:
+#ifdef TCL_DEBUG
+    Debugger();
+#else
+    abort();
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * panic --
+ *
+ *	Print an error message and kill the process.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The process dies, entering the debugger if possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#pragma ignore_oldstyle on
+void
+panic(char * format, ...)
+{
+    va_list varg;
+    char errorText[256];
+	
+    if (panicProc != NULL) {
+	va_start(varg, format);
+	
+	(void) (*panicProc)(format, varg);
+	
+	va_end(varg);
+    } else {
+	va_start(varg, format);
+	
+	vsprintf(errorText, format, varg);
+	
+	va_end(varg);
+	
+	MacPanic(errorText);
+    }
+
+}
+#pragma ignore_oldstyle reset
diff --git a/tcl/mac/tclMacPort.h b/tcl/mac/tclMacPort.h
new file mode 100644
index 00000000000..bad2646141b
--- /dev/null
+++ b/tcl/mac/tclMacPort.h
@@ -0,0 +1,268 @@
+/*
+ * tclMacPort.h --
+ *
+ *	This header file handles porting issues that occur because of
+ *	differences between the Mac and Unix. It should be the only
+ *	file that contains #ifdefs to handle different flavors of OS.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _MACPORT
+#define _MACPORT
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+
+#include "tclErrno.h"
+#include <float.h>
+
+/* Includes */
+#ifdef THINK_C
+	/*
+	 * The Symantic C code has not been tested
+	 * and probably will not work.
+	 */
+#   include <pascal.h>
+#   include <posix.h>
+#   include <string.h>
+#   include <fcntl.h>
+#   include <pwd.h>
+#   include <sys/param.h>
+#   include <sys/types.h>
+#   include <sys/stat.h>
+#   include <unistd.h>
+#elif defined(__MWERKS__)
+#   include <time.h>
+#   include <unistd.h>
+/*
+ * The following definitions are usually found if fcntl.h.
+ * However, MetroWerks has screwed that file up a couple of times
+ * and all we need are the defines.
+ */
+#define O_RDWR	  0x0		/* open the file in read/write mode */
+#define O_RDONLY  0x1		/* open the file in read only mode */
+#define O_WRONLY  0x2		/* open the file in write only mode */
+#define O_APPEND  0x0100	/* open the file in append mode */
+#define O_CREAT	  0x0200	/* create the file if it doesn't exist */
+#define O_EXCL	  0x0400	/* if the file exists don't create it again */
+#define O_TRUNC	  0x0800	/* truncate the file after opening it */
+
+/*
+ * MetroWerks stat.h file is rather weak.  The defines
+ * after the include are needed to fill in the missing
+ * defines.
+ */
+#   include <stat.h>
+#   ifndef S_IFIFO
+#	define   S_IFIFO	0x0100
+#   endif
+#   ifndef S_IFBLK
+#	define   S_IFBLK	0x0600
+#   endif
+#   ifndef S_ISLNK
+#	define   S_ISLNK(m)	(((m)&(S_IFMT)) == (S_IFLNK))
+#   endif
+#   ifndef S_ISSOCK
+#	define   S_ISSOCK(m)	(((m)&(S_IFMT)) == (S_IFSOCK))
+#   endif
+#   ifndef S_IRWXU
+#	define	S_IRWXU	00007		/* read, write, execute: owner */
+#   	define	S_IRUSR	00004		/* read permission: owner */
+#   	define	S_IWUSR	00002		/* write permission: owner */
+#   	define	S_IXUSR	00001		/* execute permission: owner */
+#   	define	S_IRWXG	00007		/* read, write, execute: group */
+#   	define	S_IRGRP	00004		/* read permission: group */
+#   	define	S_IWGRP	00002		/* write permission: group */
+#   	define	S_IXGRP	00001		/* execute permission: group */
+#   	define	S_IRWXO	00007		/* read, write, execute: other */
+#   	define	S_IROTH	00004		/* read permission: other */
+#   	define	S_IWOTH	00002		/* write permission: other */
+#   	define	S_IXOTH	00001		/* execute permission: other */
+#   endif
+
+#   define isatty(arg) 1
+
+/* 
+ * Defines used by access function.  This function is provided
+ * by Mac Tcl as the function TclpAccess.
+ */
+ 
+#   define	F_OK		0	/* test for existence of file */
+#   define	X_OK		0x01	/* test for execute or search permission */
+#   define	W_OK		0x02	/* test for write permission */
+#   define	R_OK		0x04	/* test for read permission */
+
+#endif
+
+/*
+ * waitpid doesn't work on a Mac - the following makes
+ * Tcl compile without errors.  These would normally
+ * be defined in sys/wait.h on UNIX systems.
+ */
+
+#define WNOHANG 1
+#define WIFSTOPPED(stat) (1)
+#define WIFSIGNALED(stat) (1)
+#define WIFEXITED(stat) (1)
+#define WIFSTOPSIG(stat) (1)
+#define WIFTERMSIG(stat) (1)
+#define WIFEXITSTATUS(stat) (1)
+#define WEXITSTATUS(stat) (1)
+#define WTERMSIG(status) (1)
+#define WSTOPSIG(status) (1)
+
+/*
+ * Define "NBBY" (number of bits per byte) if it's not already defined.
+ */
+
+#ifndef NBBY
+#   define NBBY 8
+#endif
+
+/*
+ * These functions always return dummy values on Mac.
+ */
+#ifndef geteuid
+#   define geteuid() 1
+#endif
+#ifndef getpid
+#   define getpid() -1
+#endif
+
+#define NO_SYS_ERRLIST
+#define WAIT_STATUS_TYPE int
+
+/*
+ * Make sure that MAXPATHLEN is defined.
+ */
+
+#ifndef MAXPATHLEN
+#   ifdef PATH_MAX
+#       define MAXPATHLEN PATH_MAX
+#   else
+#       define MAXPATHLEN 2048
+#   endif
+#endif
+
+/*
+ * The following functions are declared in tclInt.h but don't do anything
+ * on Macintosh systems.
+ */
+
+#define TclSetSystemEnv(a,b)
+
+/*
+ * Many signals are not supported on the Mac and are thus not defined in
+ * <signal.h>.  They are defined here so that Tcl will compile with less
+ * modification.
+  */
+
+#ifndef SIGQUIT
+#define SIGQUIT 300
+#endif
+
+#ifndef SIGPIPE
+#define SIGPIPE 13
+#endif
+
+#ifndef SIGHUP
+#define SIGHUP  100
+#endif
+
+extern char **environ;
+
+/*
+ * Prototypes needed for compatability
+ */
+
+EXTERN int 	TclMacCreateEnv _ANSI_ARGS_((void));
+EXTERN int	strncasecmp _ANSI_ARGS_((CONST char *s1,
+			    CONST char *s2, size_t n));
+
+/*
+ * The following declarations belong in tclInt.h, but depend on platform
+ * specific types (e.g. struct tm).
+ */
+
+EXTERN struct tm *	TclpGetDate _ANSI_ARGS_((const time_t *tp,
+			    int useGMT));
+EXTERN size_t		TclStrftime _ANSI_ARGS_((char *s, size_t maxsize,
+			    const char *format, const struct tm *t));
+
+#define tzset()
+#define TclpGetPid(pid)	    ((unsigned long) (pid))
+
+/*
+ * The following defines replace the Macintosh version of the POSIX
+ * functions "stat" and "access".  The various compilier vendors
+ * don't implement this function well nor consistantly.
+ */
+#define lstat(path, bufPtr) TclStat(path, bufPtr)
+
+EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((const char *path,
+	const char *mode));
+#define fopen(path, mode) TclMacFOpenHack(path, mode)
+EXTERN int TclMacReadlink _ANSI_ARGS_((char *path, char *buf, int size));
+#define readlink(fileName, buffer, size) TclMacReadlink(fileName, buffer, size)
+#ifdef TCL_TEST
+#define chmod(path, mode) TclMacChmod(path, mode)
+EXTERN int	TclMacChmod(char *path, int mode);
+#endif
+
+/*
+ * Defines for Tcl internal commands that aren't really needed on
+ * the Macintosh.  They all act as no-ops.
+ */
+#define TclCreateCommandChannel(out, in, err, num, pidPtr)	NULL
+#define TclClosePipeFile(x)
+
+/*
+ * These definitions force putenv & company to use the version
+ * supplied with Tcl.
+ */
+#ifndef putenv
+#   define unsetenv	TclUnsetEnv
+#   define putenv	Tcl_PutEnv
+#   define setenv	TclSetEnv
+void	TclSetEnv(CONST char *name, CONST char *value);
+int	Tcl_PutEnv(CONST char *string);
+void	TclUnsetEnv(CONST char *name);
+#endif
+
+/*
+ * The default platform eol translation on Mac is TCL_TRANSLATE_CR:
+ */
+
+#define	TCL_PLATFORM_TRANSLATION	TCL_TRANSLATE_CR
+
+/*
+ * Declare dynamic loading extension macro.
+ */
+
+#define TCL_SHLIB_EXT ".shlb"
+
+/*
+ * TclpFinalize is a noop on the Mac.
+ */
+
+#define TclpFinalize()
+
+/*
+ * The following define should really be in tclInt.h, but tclInt.h does
+ * not include tclPort.h, which includes the "struct stat" definition.
+ */
+
+EXTERN int              TclpSameFile _ANSI_ARGS_((char *file1, char *file2,
+			    struct stat *sourceStatBufPtr, 
+		            struct stat *destStatBufPtr)) ;
+EXTERN int TclpStat _ANSI_ARGS_ ((CONST char *path, struct stat *buf));
+EXTERN int TclpAccess _ANSI_ARGS_ ((CONST char *path, int mode));
+
+#endif /* _MACPORT */
diff --git a/tcl/mac/tclMacProjects.sea.hqx b/tcl/mac/tclMacProjects.sea.hqx
new file mode 100644
index 00000000000..fc875e758ca
--- /dev/null
+++ b/tcl/mac/tclMacProjects.sea.hqx
@@ -0,0 +1,1704 @@
+(This file must be converted with BinHex 4.0)
+:#d&bBfKTGQ8ZFf9K!%&38%aKGA0d)!#3!q8B!!"Cp2Kc8dP8)3!&!!$P'(*-BA8
+#G`#3!aChG`d0$%eKBe4ME#"08d`ZZ5q,G!FhpA)!N!J(0rGdP-!!N"3S[!#3"2q
+3"%e08(*$9dP&!3#[Pi&PXQjr5J!!!4i!!8q,!*!$D3!!*mhGH6DA!*!'kiF4!!L
+bdAJqT3$Ldi`fC,5RjQK+Ai"mIT)55NR(rQ!RhrRB-b[h[pkGBp2c!SVId'RY!kK
+haCaq&5hRD[I2dCBfR+[G08GE9QZZGR51GREPZCSq4k[%Fl9EXc9lIc+GAH0VibK
+8hm)N!!!'!-@fALIKK'IN@0H46AMN9V)pXQQE-(*dNf14,@(N0YNqj@YA4i[+P&!
+VE8XiS4a2m8RI`RHfm8mlVhfQC(YN5lEI5lBIfIENYT&Y!`R[*2YBPdFff8GZ(qX
+kb5Dhb6E*mFJQYmmRqmQ@r$l#*EI2A-JqFJXrXLR3i39D"fa32Z%6XkF%J0`Q)dj
+3`$YbQj,$A`-fm"VDh%BjXN'1l$I,mlMP*H9RIV%Qk@BCjE%VIER@8AleZTaRpRk
+pGTfK3,*`XJICQ3-lqr3@,ff3!&j[HFN@lH+,rR*HZRMN&V)cXT!!@`6!!JJBh`1
+XEjfGYCld2Cjq(q'I4hiK#ePBjbd!2)!m4hk($q)i-XDX-XCEElc5cidhq)3aDcm
+2RbZpJSHRGaVL@VMG6j*kR"3V56`A"PR(ej*bBXE6ZGQXpXc58Y[a4dYddUE*hAl
+jcCZ-fA%62qAMQK0@Pq1Q(m5[C"JakmeDljl#hXilHh3Q[&h@)[$H2TPQI[*Q9dD
+-1Fl[MqH2T4$Mia3N2m$@`LZ,AjY"C6qi)24VBC,fcckIJ)[)LDMNl+aDGlGC+qq
+U05drf1R2K#rQAbhrZR5amCcri1TLQS@08Z5RDCJqipr[[2PQ,AST2Bf%R'(iI[6
+DSAid+6ErRIAA2NQN50KFfHJ#Bi[*4TXC@hHm5,X1fIb'fHGe5m-MBj2b'rCk2Hd
+&KeS*Q*RDq5LJ-8$U('H,*T[aqcE#q!PM6V2fJifl'RFpe-$c)*lDT[c@iQl+Hm-
+aCq2CKPYP((q%1#AfV@C0RY1jYPQFLh#[B9c-kPl()J$EY%hfT3!rKA8Te!2f&"S
+lCJda@GZaDT4-KNU"GE5JS%NIC9L#qq5m$#l![r[SQ$VG(2LRB[J958BVjkAl`UZ
+(HLbe)*-#`kT([T(RE,k`9l`qN!!5*j)C*02`,)K!%jUU)j8NR+i[2%-8fUYEl#G
+P'9J1NjQ`12SUF5QHG6MV+j@4['Ua`C(c*i+Gp4T*lVCUTG6Yf'JRDqdRS*ZUa1,
+#'HDf9Aej`HBEEd*8)P(2%EfBdlY8`pRBUr$T!N%1,-8(`jp[pkNk[i,E)e'1Z4A
+h30Nq`9i9fd2N5T)q13q5E6)jNYL@ic&%YLBmKXTfDCG!Z!Yi$*IYcDSKYMr&Bk4
+X(m'M4VB[iM&+YZrJ-GVD)UcT'0Q!mV'bJAVMC$Z,8#qfRAK-N!$Y@M`dr#[E,AK
+-NZfGH&"2E04JLQarKdHYE0r$BkUJPekD*KXqp#!fqQ#'E#r'BkCX&q-a5lDVm0#
+GV@`hib&S'[dk(R0NS`CcCD-'mf4l')rj25"E)"XeVC-0$&JS@b-HLf6EJFGLfAj
+1@)%0JBEH`IDAH#b9l@ra@#EEJhK3@b#&a&I)4YiVC52@+YR1`D0H0PM9DYPq#3q
+B%VEIaJ1fKHepH-#fX(fH3#UfIm,M&'[V4qaC,a[pZ8%fmJ&$XCf,"cA("Q8r9ED
+Em0JSfarJFCTX(m+$2XAf*@%QYZrLFBDep5FQ[N3fH[j-fDJ[@)GY#ajJ$MEb2PZ
+fAm9MNfarMJGpJBdDEjB0E#-q8!`ZEj80A+#Hf+J[,"2EGY)'XEdD$m9SYHehm6K
+I0[VT!YQqJ-H&XP(ALkaY)2(pCE*49c!+'re$MYM!ljI,GMdHB!JfHZJ5fHl!!ic
+&pJpi%"2E[iYh3#AJ!*I*"QDp3MCk6%KE94d2EQb[`q0bfFMePE+"LiL-f"3MGb6
+F9$f*aejVUbBQL6T@6GaTNBhHZ&+fUr(B,a[i*r*10IY'Z&meq`DXaUE8!iFae4P
+%$S-+J!fmKYGJ!e2J&pMSJ9I*pKSm`&YXB"lm#p[(m2J&fEk""lfXMUC8emN'2a'
+pBc!a%Ic%4Mq6&cEUp9VCi&Ad+EEhi%%IB32,Ej!!$3ai[E80)3Dm36Eib4YP!fp
+ZP)fq"6qaN31F"4Ymm8fbI3D2AjEYfhM!+p8C5Z`%!l(4pp3('hJ+rm*'Rlp&0R*
+lUfarKXH[bABA(VmZfcrMm6CV'dDmT(qa`DQdMU"XF)2INJfXSHq`8G2INHhGH)#
+Cf$k(aqr*"XrlI@XE6Ni,rQ#Merp30MM$(mN'I[faE265RmMf$McH,YZRmB$IBB0
+2`hR9'8%HHDYXF%9k#KXmKrMB`&ri+6E`iPfb8@YUL!hFSPq`hBX([Bm0[JM[8'F
+NHr%[C+0AhLXE(!RHK`eF)4GXB0clCD0A2b!EHAj3YNrLFCYXF%6iP$Sej1JIPJd
+qI,YXB"JBMJf1m9(C`%h`%"Yim9Hb8IH2brBT21!Df1#&GeVE+'SLIbdEf)pfJ3f
+q5Rf``E[q4MEi!,PJ!fr!&QcN5TpL``G-`rBY2$iV'kS8@+(1D(*3F"8E["G1K`h
+qGVGXF)alC+1ZF!TXB!(k"MEU#2I%"UHKIl(p*ajIYVBaj%rS!0MJm&q4$@lj9GR
+J2(m['cMh0GR!NB1bd4Y`0'ciN!![YKrJFCqeMD8Z!ar"KUE`6GRJ[ImS'jKk[fa
+`%[S4'pK+[f#Mjaq3!)fDJJrBISJ('+M111Sii$NfG)TrNBdHJNGJ!iIJb0M!qRq
+9$Ib#bf#M0m!kE260[eREH'T!i$NfG!eiR+hMH0*b4LF-6e(AjA5Vd)jhKU3MUmZ
+"b%*J!@`)+f!+dB8%393KU""Pb!-%&@)+)3@F)'836`JRB!M"K&K#+#'5%%L))i3
+DdJKCK#4##!!c3!c`!V3JHK!m#"H%$U))5B(33H3!3)JN`!V)!kS313JFa!h#"P'
+$S%(-)'5!-J3-iJAKJQK"X##HN!!Vb!L!$+'#,%#@%%dJ-SJNL#m3$83(a"&%%F3
+Ca"H!'M%%-SIiJHL"f!&T4Ga!e%$-J$!JAL"D)&BJiL"8)#iJ6%#L)3)3!)!I`)H
+-3F)JAj!!,XJFC!h5"GQ#C%(f)#+3!$G)#'3,NJ@jJS"!TL!+N!!R5"0N#C)%%B)
+83BBJ3C!!3`J3a!F#!qQ"l#$))6BM-N-X4*!!eQ)d!M2N%m%'d4Sd4F!&X&&d%$m
+3%b"8#,L3!((%&i4ea2*JDJ9K!k%GF4jK'V+*%)hBM&L(i!ba4M4!-%HmJG3M8N!
+@%DNJFJMV%"r%@3Ja`Le%#m%Ai4ELLT!!#HSM##1B)DJLc#,)3YJ4B"%N%&83KK!
+)%3d39"'p%%-JTBLR#(U)1j!!484V4%l%63JGBLBL+@3F-4-4%r%5%48LLd#(D)N
+)J8L*1)NSL9#!#),iL1L)f)M!KVL)1)AB#L&&L%&!&1(`IiiD*UNYp9F`PE&qDh@
+i@#U1e+F52eNdfjVeK@*e[Y@+-4QhB`U[lH&#2HX2M"p&FF$hhV3q19f2`T6'rI9
+XPQme2,DI85j*3cm*k(,*r24dQ%c@BpKf"R'Mi6GV01hbfdllQQNFK66ZmCRC6L5
+c1r#Mb55FUF2CGcZ`f!Va[V5HB)M5LpfF*%fqUB2Ri9ZmQ0VD%V0%Pd@aRlAGX'e
+[q0RXj%`d(l)"P*HUkik)'HkC5V1NhTbKUEPKApZRjjX"mpK66`1EDJ[L,jP1kG5
+#DG$YlFj)'Eed@j!!c)&T'+j-d8MU[Grf3'[J0qR@@TpTqK%0IYUH`8Y6f3l%84i
+2be9jS'[6X,N,KJ2e"LZQRe,ERFdXNNd00[SP[kTC6l0DehK0fj3+I9@@0[dmRrS
+1-03"%4cFYF-0BN%YX@)$LlZ[@E`JM&UQ[,eBHPpT`iEF8aNhq5MV&EPeFlM(i,d
+qECL*dZMQc3Gcf$4db&aIAL`HcVPT4pI"kB`qLEdHeUe"p(6)V*06(4lG0S&bk[G
+T86cP4qa@E@i+Qr-GibCfD(250QqV0f[aERUR8PUqkF,q9M*h+(GmVMLFZA)arB+
+jUE,pN!$ClaJa5XGJ6A8&j[T@+rKD0lHJb,S69"`6JQUdKYPFSpA2iZJ+RPeP+)A
+YHhH'L4b8Xqr3-*pQFD0iBELi1djUU4N)JM"08CB$XkNCpc%MGU"B$E--L04U0J0
+4DmYqUj9E0mcASeTaD#&,r03-KP2c-c0K8V3a(9[NKVM43Nb9TMDV@HLp0T'Y&D5
+i0ic-m&KaY!8BfVd(85J8-p1RKFhFePK255Vf6$'&9"8aU@lahM*Al@'0C+A!*jN
+leIDc`TE1+Y8+Q2aX'MDAfB-HEk#2324cXhS1)@eGrY)@S(dd2QZ,aZHf!"fKQ)Z
+fH,5Pc9+*YJiCD'[$IeX(pYX%jiZ,)hjcCKlMZXR'@j)AX"B9E%lm$,c)1E2E6%Z
+,!l8D@*1DPEiLEbC&Qf`PFT@Pk2Lk+"U0,lULqrL$PZJYrU!P@SSrD)PqiJpDSS[
+iJjES'rkJ*6U(2fL*PZ%2@U+VbD#PeXpNd&*VC$*SUI9''E68qU!-@QV06`BYYCi
+RJjCD#j0"5kf&bD#PeVCNd&*VE$*SkI`$YqKD,R1@38ZA2M*Sk9+$NN&,PjU6$&U
+kl!-CY(5T(mQJTFXqN!""5jFDN!!-@VV8EQ63dQAYCG$5TBiSJjBZG8-CY(5T$mU
+JT8Yp9JBYAHUZ-QMT8Nq938ZAZUN-@VV83'A3dUA1+B1@,[Y$"LeGkS3bD1P5rj0
+"5jFkT!aDZZ`2'E5-%"G%,Bq`*fA3-X)qN8(,#21A3FX)p6FCY)a34j0"b`La33B
+Y)p5lC0!b3Ue,"LdMe,9Nd$*#E*!!3FX)G@JCY)a3FjC"b`LeBKQdM,$f-QJCS9i
+UJjB4ePJ',528MQA3-X*K%"QdM",[C0!b5Kb438Xpp#U$PP(@83BYpG#V$&T'UHr
+*S'@8[5k$PRS!9JBYSp5"CG!b5VeG"LfMe-YPd$*+69X',D28TfA38Jr'bU"PP,U
+[$&T'1AJSJjBaiV)-@XD)F6*S'51Qb+#P(TL93FXBHd!',@2-@3BYBp3LCG!b4Je
+F"Lhe)+d-@XDSBFZJCBbc!M*S'D2q,i1@-HVi-QJCSai[JjBaeP8',@2X84QdM&'
+EPN(,'(9j'E5-XFBbD"PRM@A3-YiEY06$Z6*S'5GZbU"PR"JRJjCaiSMSTA(fX`a
+DaYPM-QJCCpePd$,1@XLJCCbaC0!bc[N!'E5-8r1A3FXiHd)',H2%E1(JFFj,b+"
+PR$-0-QJCjeb#$&V'LFdbD'PC106)c$F%QM1i3+q!Vf!q234ZJC9JMGkb33(9l@[
+jB!cm$pi(e[MD0pb2ISAh`IIJA(!*Ab1(hp(6F"6`bZMkp$BF$PccYA1`&qi"A`-
+2`8H`'Gb'!i#Ti!#mcX`b#%jVM)DMJ-rJ1Y`#6JG'`crm'BHm4Jp[!F2-[!+m"Lb
+$,i!Ti'jqVJ"--M-0rM`$H!fRJE["fH"Nm#li'$`-rZ9VrZ!4Q!9@J9&JNjPI%5l
+9Hla0&`lh&E'P)BBlMTZ"+E@B`cNHpd$F9ELVF3r#24Mh%0a$F3r$24ch50`eZ*P
+1()el$1kaZ-IK(Spl!Zk*Z#IKCYI2&0beZ+ILRSCl1ZiCZ'ILRSAl*0bcFFr"24I
+h20ccF5r!ABGl)Hj&Z"Hh9i#SHbRZCELAiek"HbAZ9EMVFDr'[3EhfRc0LDmdr'5
+KKM&B$pCQH%FKkG!YrLjIqhMUpY6&0j,RJZ&+FF[!4F58Ril,T5[kb()89C9dESF
+#k65H+Te1hRd,mZYBcC3l[ZJM0HmkfBEb"D4(XNY'iH@,@FH1ALeP!GJ[pIbK6D"
+')K'SmlrpB"ZBbI31K-0E$f-jb%i@J-@dPdhf$59cL@U+&bUNRR%A"rVEcm@"([G
+hFD$2!e`F+2C!&`IdUR*aS1R9,Jj8IT!!L`2&(qcL)!%-FA%JDd0G(+5%B5i1k$I
+Fa8'+'1(L`%K'ZMK)'68Z$P,(D"F(+@5-Li0F-YE&38)Cjq)JTBahFC!!@bDi1%J
+b%edFC*Y*,Jlbc@3A"fPRLSZ$r&2ViL!$6A9aN!#+TVNib%R6A4bNTKNZ$P,86"F
+(@@U@Li0dGC+,Jl`efm9"!T[MiL#6cA9aN!$3jVNi@QElF4`Nb38Z$Y*HRBZ$Y,I
+3a8(k@q6L)!qZHb&1-U!R)ClLiL$eVRGaN!"I0lJi5-)0,Jjbl#iA"lPfYiZ$*(Z
+jLi1FqdSA"eRe#KF(qAL2Li1F[YI&3CVHjq,S(9!rMS1FIk@,Jibqhm9"jQjp28i
+LRR)h#ckYLR(3ppKiQP3DeB*Lp6TcAh-1Ba460'jPD6XE!3S",TbeVlN6@Q"0Hf6
+8cRE3qY'eH3rBelambp,5SpTePca26YrBcNlhFQjQ-[ba5(mGNKQ$p-FIcGLM2r+
+)2Kq--CSe61@e5Ik)S6pDL*k*9SN1DFB,dIh3p0$Vd1+#G8TQMC+r2ZRiBH$`b#b
+5r33dl!1$F)R8'$N8flRHGGi*"@eSeFIMZFG2"&MR,hD`",6#-!aQeQT[M9iF8kI
+PR2l4irYk*i9kb,ZpYMD"6+`a++@S5kkKRNiK-IqUIQlJ[(rpUm1c*`9ZHAJ$"8b
+@XQMcZI2`UG'U!hFVUDmrX1V4"pYVLjdKc,TL9fI034pJAGeXd9"lmG8N)P1'hTV
+[rVJ(i"k)Z`Th0Hj"Z!IM(S*l+1jKZ)IMVX%p#[GSh'0`Mm8p$[Gih"0`6m3p#IG
+Nh&0`eq+HLRXDlZQiCq#HLAX@lT0`cmBp"rGFh20`cmHp!(FGlS@i&q&HM(X*lU@
+iPq&HMRX&lT@i9q'ZaldDpaVFDh'r+2mRK)(BS0'aQZURMCeZEJX#8!KFf!6J-[2
+r"6ShfIYLp6QfKi&UD@0r[C&pjX6a@b+GbrQ5ack!kdpdVFRD'1d8h0j#)FXNfVR
+q[!6,%GNNQ2!i&F[RpKedf"JhXjkjDEK5l5cJblTjUrGNDer@epr&Ph,EAlUieEU
+Nq+a,4hlLQGL6Ph,G-9-2LL@r9Fch9#4A"HC$q*X61eb,&3S+QPjcQ(4M98BqL`E
+X0FaQS0C5EZCfa&bPVYPdeV29abYA1CcDXa82Ij0MdM(B$CRd6'q*6''$f3LCG-X
+YAFbijXTN&M'QUT(C+"NiGV5j,(&-9GTEYYQ4JhKf*'&f8QDm#L8efcE66QbXc(U
+dpk,CBTPd5qqc6,TYLHH6)+ckdb&5DCiqdN,Y93[fHDBJ1lhCddF%lA8QGXHQdBm
+0SYiDR+"-'Xl8ET`@V-I*HVfdI'LTDcZf'1F-["M2A!@0FkD)DGF--KR2G+F%MTN
+@$lcp,Jrm%QfG,RJ@[YTpNq#6pK83-ciC0Q%mdafBFq`X6'GlGR5jFFm"DBGc9cR
+6F"Si&Y[0J'VJTh%ejj3[G3CGM@F'B)eR`,Z-EjTk"BljFKN#PPeVR%2%`$m0LS&
+cJ)Z"I`BD!qmd1JE1"L$c[ZQQc3H3!%E)ZalUK3aBGVNR!#ERlN&Qi*C'cF$C!'H
+REhHTI2J-r0S40)J3J'M"re#C$C6QIAXD-`@SH9F`YG1[d!9TC!fFdq!D1'Ia0A!
+h%*[h,G3`VA4N&FPflKN%b2$2`$[(3B-!@4iDZ'HiD1#GjU0jj`a*bNG)l[TZpbd
+f4CDIG[NR59h1AhKUi*IKUS&hQUpf1KmU@)+h"SiGh$8)NH1[K3$&FUGjE0kjYdd
+c+pREI6@RlA6XESF-Y`fm-r`fm!iiEZ#IjVPjjqj5&Q"BYZQ(31b(k)CLhlm%aRk
+)3h$X"qJ'C0qr!-R'[E[E6Bcf*M(HBCXFJZC-K$aD*5,Ni0Rhl!CShlm!d@Rh8[%
+kB0Thl3&U2dJ*UV-K`[)Ai0UiPeZi#l+0GaDddkl&"ZN'EYqr'lTprb*iqa%+m'h
+FLi8Y3RJII)I3h3IE2C!!(F*e#DV,-&f%k")mpd*c,bah3A))ab8S$Q'i!-%9q1f
+$hMlB,8&Z'@k,8&Z!f4,%K[!D3QX[V*BJY3LRh9$D*dQ&JP5I(08M4S959%Q)+XY
+344'U*%(e#P#pmP1Aq"4+6bAK+C5G#U*64A,U%jckj+D5f&5@QST#8d&Q+SP-SF3
+8#NbpmP**A#T+5b9K#GIJ6d3#2%cmHNK(5UFZ"+(pJBiZ`P$+6G2@I'iqmSHjNAr
+q[cqb)GTr!b3E)29A)&R2cTm%b9DTV`+%k+N!!ESUJ+IPkcG&@''KRYe,Y0ADLd5
+FF)QfL4-Zd6Ca`LAD*Nki40[%#CGSQcMK%Qd6*ebLEH+%5l40R(#*YSN6,Y%fFF)
+PfLC1Z%6Ea!QAD*Xii4*Y%bGFSQhLK%Zd6Ca`1ED*%bl(0R(#jGJQ6VJFfm3*Pf1
+E11&bE"-RA)jYiS6,X8fFF$QfL4-ZacCa`ZAB*Nki(0[%#CGMQcMKFQ`6*eb1EH+
+%bl&0R(!jYSN6,XFfFF,Pf#C1Z"cEa!QABjXiiA*X%bGFMQhLK-Za6Ca`1ED*%bl
+(0R%1,mG@F3i[aeCa$Lr(9R%1,mG@F3i[aeCa@-CA@BkYiV#`Vl)F@m9KU9pP1ED
++`q+rbR*X&BIPJ*APf#S1#`3Vbl&9(*B-9TCMUcJX)U`XaeCa@&CB@BkYiV$dZV)
+F@m9KkA9P1ECHKfA,A)jp*%i%2a6LrmkZpHA8p*9'"iIkLRf$!q-$H'iD,ShV*jc
+X2FFG`N,1D#kplRMZhf&X-mIrNaVZSH8``fDZjQ4R@Z53!*,D2+PqrUTa[lRb`D+
+jl)%ce[%h'bF@GTQhcpBLrNl4RGAaXG24Djm[$fhGe[l6&krr)MFmh[l"UhX+0ca
+jD'PKj2SPrAb8lH"deG4HF[6I*VZQS%%bqII#H[d9Z*l*fY)+JrTd2G![F&Pc$Mq
+aj0SGh'U1T"pTUffRJ@`N"kSM%NHFrrKGhf-C@c,mR111T0Eq&8V[9aKYCiL4`J2
+q38RK35F(Bh,CeX2"V"eiS"I#&r&!r56TeALV@9EI`hU'"dSCbr-$MbRZ$PF`krp
+Z2&$m325$0"iSUr@-%"6`3%mZG1cmY`%G5m61Ic[)(q&CEIjEB-5cIpYVMLAL[`9
+X,,mKmN)#B4*--BRFcdpE9drf4m9Y,-F+0rfT6m5Fa"pCb[`DHrD-YlqTG2c`Mm$
+V@bhpA[,a2*V+)rSpkH,*rUYpjfQUM1LhT8rNXDfNhk)qAYI0eE%A-R`UMke$%q2
+p8l-Q501r'ZqTQMRjTrTYD(ALTqDfp-rVbh'['XdeVXL"Ac)0,`rjqHMZNrl[rF,
+amZMp3kSRmZJYb"0jp!UT2mQM*j((mfKHX(RiXVCllYlpEH%pkPf'(d0qrCDI'Hq
+admlGqi@ehYl#Jl"rYah2[DU64ql[MCqU"cX)G4jp1R2bKrf,KIAb82Z8,3&jl$a
+@fA*Gq3XY2im3L4l2BlpK(fkjqSGj2jkrk9j[r+fGC8(Z$Q`"GVbYhYBl)UqmRcr
+Tl-$r[a(R6M2ZhIGZrXkjPdHVQAd&Tle0`di1e)RXXMKpAQPdQFF3Bq0V61E510!
+[HIrIS5$ldq3eeR!NMpECD2PAZG6HjJSrDmhQ9`M)Je1(*RQZVJ`+#1-ZbUrf$mC
+p5&0lQR%Aml!'-1kccpZbr#0L6CAYbr@`I$$hNJ,k*(1[j('8Z9Ib1-VF(mRM#(-
+[jk'Cq`qZaDd`1hS,GQGkc"h5*mcpR%rdQ2X@f$9IpcShNFGMc,e3MfHCHl'`6c(
+hFKj(QAXKM@HBHcQ2,(0IGmUrQIZkG8mcpqBCFa5R(55LIj+JNlNIc((DqX'iPfr
+LlpGhR+FCpk%m1*B!aUeq[1$NMFAHAa4Ncq!h'00jQlJbYSKiMc'Q5Kj(QFiMH4a
+K1Z8m@N`F4$GIC`ThVcHR6(d(EYZphE#2HZI0X&hIC35UdC6$aP%JAY[02mlp,rr
+@0lYj+'CK#FMM+,-Se28CCP(1S`q%94lk"b$#'&iHcDRCX1%PCN%5cDR!8pQ"Xd!
+"5#"R+3p$i6"RmMKiDAZSYIc,LLR&aQ[BEL6I0cAh5KjR6mdYje'G8kV5e1+3!&`
+lfrcHNlbVYVjFqBjM+Tr3cU`!H64%D@Vk!rjHhD%m9#2UBGj3jG@DPa@J(PUVXJ,
+Ni@Y9B4k2De@lXNCNAQB%DVArkpjcJ4K!cBjE$M1#flNShF[MFRC4X4k2pTPS",Y
+E4rX9MD$)lEdmQ%4h1,"rSZqe4Q!&k&HY%9J"mY")VZ(-q@pGG4lX-cM4(`2,,`k
+Zb4P4'YP@"4PURRkcm[`HUeE")9@P22,UG3l*8F'Y!(PSp9UeBZ[42!,e1Xm94I[
+Sc51VVKAc8%cD%T!!Kk+ZPS!mVNL2e82pMN[QcaFcH55i[G*LE!(e8&U-(5!2"@G
+K(Q8m5qDK0)*MH548jedQr3qq*ZV4BLM'K2f49Td2p3FDNb8J$k8a(H[AV-CN!mM
+M3'VqefI9[4r1l!aB*8E`X(IJkYqE`Td6jT5(VZaiMrliRBFU4ME+cX-pF%dq6a2
+j`$[)fj1-`"+3!)GL"*D!2"55f`,bD&NKS+kl6+[eCKl*Z3q&9-Ibb#,9mhP`k[a
+AmH28Ja1*NNXbMdXHk15aEb@!2+Tl[kA8LAMpFp@`kIlE9hePmYaFKCViI[jQKRF
+Q2[c5PM)96aFU0M54G94$+d!H@U@c!Z6KUh4K(RQ9,TR(kGb5j+YL2I9!&5[@`mY
+$Ue"@J,VU5C86HI!H1MEVYp+iY[JL(aTVNH(ZXeF+3!BE3"i*&DU84hjV3G#*#4A
+Urr0!PlB#e09$2"Y!(MlL+4,c11*4fNl%fiQ*Pe)pmY2LAANS4Q8*b%0aB%Y!(SS
+$f`,bD&NKS+l-8*j!mJ5A2PD20*FqPNH@5pX!mYLIUf)pc%ZY#G"!hG0RVDrQ)GX
+'H[,3f`E8U&1B4hlE3*!!KjjVS2&2i,eQP&D!2$5Mp"Uff"mG@`+#ZZVC4bY!(Kb
+YcKkV+a0FCmA0jc82rlMPFQ8&J!e`HMkL[&9Z`XT[H`h#NeHKJQ0MfQY`r&L@pKU
+dY)lY%LMA0D8ep*bmbY[C(qa(1(%X)2X4#J$bc(k%dSj+1m"qK2*iK-a(@!%kb"l
+!h#d9c03+J*af"D4kp*5A3eT!0"f,bhE)m&J)Y"Kld(E)BmHbY"hbF5fQ+a%EJ4E
+6'd2Q2RU1I@[,C(RPPA2b'`bZY0RR53CAbH-SJk[NFC6"2C,(%3CAcZ-ajPA)ieR
+Q95c)8mbVR-G4jP9)iaRQ9FRM-HE9PBLPB*GAk35l[,U2(B!4k$bX%VZmbUZmR,H
+Y2+%Y0SaHHh46B3)C+MrQSAH#@3(b1'-ZQHl(r9aGB4D@%ie5laBlhKr*h@,(qp8
+HS1RSh@)Rm)1*c3[UV@90jp'kfLFd(BlX+(ZqVMU2[RqZ1Cb(prGpr"0622qE-[k
+rSVlKVh6frfbp*r@hGI*hECDm[qqcqIchMV8$$a429hp"C-(lqclEfpr@*IlTU65
+TDcdpUApkkTQYXjLF&ek+rr38!3&6rebK2q[,UHNVM3i1p4Al"JI'"r$F0&`DleY
+CT3'X-"KJL6Qf1"5`ija4RXA+a,paH*F"8'@ddH$T#rN%TURq`86GQr'hA*`Yj[M
+m[CArcUA1ZG"c15meaqA[E8,B!hTITII9HVITICij-AqIRrrGSC,IaHp#[5p5[Lq
+6r@,PZehj[ecjlP$qPqLpdkc1hjFUEV2LAQC1b0q[@,%KA`i4L%UQH*%4dBP)PN5
+X`Pf0QqiBM(X)lU'i'EdBMRX%lT'iDpLKkKk0H`cZXEM(U9FRi*k)Ha,ZbELRi'C
+'BLVZDELRijk"HbEZ@EL4R'IMRS0l,QjQcpJM[`"h(Hk&Z0QDZaMh%Y`RifEreM,
+Fc$1Y`,d5pbVFr%V9kK8#m)GZLBk0MSiIG)UH2lDY2ErPRM5`Y6TFj$S'rEH(9'I
+Mm-J3!VYk4r51kKh61kjh2lhlkce!li&k9qPGVIFJ[3IV286[SAS2dhZihLIV29,
+['VfAkMe+lp&kMp&lV0lMp"k[p`5p*qSp5Hr*HNr4ZeE[UAT2dhZkhM2dRURh,,e
+2dRZChX[eAU(h5VeAk9f[pfUpeqLp9ZmApGSeFL,qZHqDpSrA!Ad5C,EHFr5HUrF
+m[HIV[D#A626iCVLl1MbkEB)i+J(Up&kSpb+p&qZp*2q$60@9r6plcGkPTDIqIaP
+rl$,(aU-i@QI1QAmM,Gf6CNHQr[TI3VUVr,+ML6AhN5BV[lf(r@*Ia'-fr(BIpKZ
+,H!18Ar42AEpDq296IXC[&[`LbXriZH6#JeS*rLTJf$hlZThXN[-ZXRiANA0l#S$
+MFG[m'GC[d51`H8U#ipf1a`$VYraq&Nlm2S$(9ZZhE!Jf6eP`#Z6qbkhIYGq&c9-
+@R!,(%qZXhhANqjl#i"6B&j,IlG3$2+A#+HcUqPhf-'bH%Z%82XBDH(lVYm*'[[L
+pTZ[h[Xr"K[k!h`eih'Mp6[deHm,cLd+,F+qaIUYr"`Gd#XU&hM$HqYh)(PGaG(q
+IcQEfr&b1*+*EU$2b*mJMS[jJf4Cp4c[Fa+EGNkA%Ja5+,[Jf5M#JNHAcbbQrfHK
+MjrmD@43IpS[GbaUSH1"%bQr9pq#lY*(0(-'$YAp'cHFh@LRLTIcFFk#A42C@4Y)
+-f9"MrBmG+SF[GA()j(%+kZXL[aC1A+EbM[qa9eI"$XiZi'+LVNNrpi0rkH@4LKG
+lXPIAP0p'kM6I8aqNr2T4Rr(kX[&GRi40rc@-Bcjb+f&1qcAXfJB(CHHmq3l%p2#
+[i4aU3qq`IQrl%DDeGeQrhq"HeRGD[rASEhH0pIX[%[Yh+Hpc#-UHhrd2`DEk9rI
+"hF3Hcqrlh'%26K)2h"aLrDiP[Vl(qTd'rFTGEHZhj$0`i*p)L%IpepKi0a22`%c
+mhYl0irf6X)(KkV`BHTIl@qYh0c&'e9R(ibherSmI`+Chk5XGiZ)1lMCF6La8Z-&
+T3diaLrF00r+rdm"cmU"Q(SifRNiXqk$m90mi8pD[rMH`h@EpjRmIMj8fM`p49m0
+1hJm68cfrYh`CYJm,4p([2"aYf(m!0QT&2j'6p0-[FREp)pC[hKr`q)601dTqm&(
+VGcVqm-K9AcCp'JiIXhi[BIeZYAl[TTC(hF"TaFq%pc4mD3YX(lGq"k#I403hhq!
+'K$Z%dp4TK[AlqMpKZe0qF"fTdkA8EF"RH#'Fi"EVpa$c9Vb!dm!qPMl6Iqh`5G8
+EIL*i0Tjk*rL[cN&J9G@PeQrG&A$iP29l!2m9*AM@H#CVICIeqmleA6alp4JF2Uf
+m`9h"XlZSNhj'HD1AHRh61%4-qDcmeREUfPLN$[SjqCh@aD(EN!#6m`[VerMh$Ti
+er)UB"6G8C`llh-1caJTj&6K*(Q#cj2&$lK5iarUp!AU[i&RMKmLT[U"ic)e,Ael
+2H&m8(UKi2TkpPcJ0Ie(R6F"4(mmZqbSFlK9ZS60lH0C`"@[`CG9*e8r`V#&NIm!
+0b3rq)(M@6!lb&H%@HV$JfDhXkDqU6X6`m+aa)hXH(--2AL(pY**mpf[@lie2G2#
+X)HC#"$J&&&AKV1"Cid@2`3(1Umj0l"r"XeZ)@h"cm&ApRjD2CpIZKZdqblIU`+Y
+m2,Z$I8`2JP[AGI(X"R+8EmU2AT%kE3'(FiLhkQ`JMJLHlHFZJ2Z&+aGfmHbf'f'
+$$kUm&i224baIGcj+A2Q@p6XCZRpdSr9l,E@("p3Im"!2rjcEVSEY34Y[aBHlH@a
+McceNr9C"'IIcH"8A+JKA(IQTEKkhN!$M+IkVH3Np1UL"R4**$NNHDpLApcEm)rY
+$h,-'m2$kUASGGbKm@hJ!rRNk4p9kiK#p#Fm!(ppUrAC3d)A,U"6@SjrFNkhIIC`
+lJ&XTP`hJCj*IeFAA`30q4*m4@r*lN!!jJ,(Uh-bHp[+VANh1iqd3Gd[S0mQ[fN2
+0R-ITpM-!!!d39'0XBA"`E'9cBh*TF(3ZZ6IeFJ#3#!Fhph4)A`#3%4B!!%*P!*!
+%rj!%68e3FN0A588"!+rBraHbERkj!*!&!3fp!*!''6N!!%21!*!''hF1q&l+kA@
+CJmc,V[2AlIADK2)hYqGQ$6`jc5YD9%k2kcABGXEfbYE`c&EZ1QL[(cq[K9YXiBY
+N)6YqhX*RjAHmLbrR`-@*REFmAcMjaF[cbmk"NFA)BVSS@FjMC,[`4Drc&Ni@RTd
+6J3lJa1H9$6JGj&RQ*CmXI$R#"d8'ZqF,f`+`"CJ!122kBZPd`V+XN!"P"@CE!FZ
+a!S%YPMAT12KF%JJ'S'UT6VFi+k+C6$bG#6GQdZFjX9cHei`LcE&%Y+dYi@4MQAK
+EERjeHcDA6SE2G$CFN!$1Y'5lh+YL-5HE$6G'FfZlICZMQ9BR&fjbFVPiUVAE[6D
+HF-)4H23kRpiH6l5%DpER-Y&Zha2RR4PQPbjf8VfZLq,CD$EV*&FRR%b[IhdmYDl
+IdfhhVKBiY[USSj!!FE)0&HX1V,f"'+RH1PEA4T!!@CGAhG*`3eXZRSaIf*22NZM
+jdA"$HkkY[EX3bR@J5-ThHD6,,4+0065&)`ik%8fDFK*G!4UMf9Jd-9KGFGpHhXE
+'kZfY50IK9U4rIb[5Xl'QYXqY[rK`VFSQq`Zme,P`Hh@EeYE(9qp%1"fM"(-k`!M
+@k4M$J+FMP&"2"aL#2Xqre(4HN!#qc[2FqrY-qQ8B$JXK"N"$3[3#ShBYSD-1-!5
+4[[p`#I["8[Z1)UD1-J+E(6&fY-%3J(VqB`dp#+@HH`qHqVkP6LNKU`j3JPI9iZY
+fiUX%+3'X4"K"@!Nb$,%5SS5a%Q%)C2d!TDEdSr4eTHrIhhTZi``$E8H-!BKaBr4
+#VIL@X&BL$)&Y)F#13[E$V6L2iUf%'3(FBT!!NABBJP`r`+lf(J4Ghlm(G3[1`be
+6`Pf*8!*H"0q*ZSa3JPbkMq!Y)`b$,Ie,5%[h)CKe[8Y0k)ESkd$AZEr$9(F-3kX
+AB!")9)"H8+9M#9(T2J5RHHqKX[8$+6e(8C3a4L$8Me!Uqa"iZYilQhB30PhR(Xc
+-H`lf43NYkGi"PC*&@+&AI6cEchXA1D[E@eZG6&M$B&q-fZE'%M&H2qp%B&r-!4D
+N8i6C353IbG9PYJ2*L[YiYZb%N939U!rN5Gra*(AYM`rA4e1Yl9'!dBk*f"b&*@'
+!LC1*-UQq+#H-M&$QKUYD@Z+-$ZJLp+)fr8fbUb`5D,3Z%QD`-1)rAKQfeDkb--T
+S64KMX#"dlUY'Reb-Gj0P6IQ*C8eel6ABQD$8@Z9+Ai`h+2'mj3R6JJ54qHY,rYM
+eX-)X$YibU-[`[JZQ@CC93ArD6j9kRLE9A-#SlpP'8lHf9dq+U[3"D(Le$@mjE1T
+4jNR5(j2!dFj`SLe1*PZjYUpH2AeN&re95[RDUV6lfX,D'qmqH#IMRB*h+Yj*H#[
+`PZ1GL0I@qDM#k65#36U%3Y6JE3@Q&e'N-VXfXIUPAC*k&90PY+KqmFVBZRJ,'GL
++TXCUeA("2)U-5U(,9#p1)4fZ6T!!E@BV,ibhG38mTkia[+4UHC9d9L&2!J*,`R)
+VD$!h3*K43M`dJ)TQQH$Lca[`(NS$'i9b'0ih&KcHK2I)JX2KH'F6KmSdC"&M*q*
+9X#Y)k[BN8CTj-MCc0K68&NQqA%q%R#MPdrAd)mcGb6cHJXUUH!1b0pk`KMp3V!i
+%,0%2)48HYG#`T3L-,P5HEJ5XJb)V9J&rU`MI63Uq0IQ3!-(9)1Dp#+`GTE0G#2(
+`a#YU0eXTi[PNMdUKljBeeP@fCC`emI8$r5bDQj!!UarLPq4N`4C9-EIh)4IiMAk
+eB"(PXfiV3ElTBp@p(Li44K51d8BBB4r6YJ$+*,'49HiMYRHVbQVECLK6a(B$&%@
+YBIXLP'PLqbFSqiU0,6pGfi)(3pP2E'q&-N0XEi-b8f`NmrZ,l9)SB,R+pM%S"iM
+Y5e!1&0[G8&iRlFRq%6`,%4S2%PXY&1C1'cNVqiZfhb*qLHf2"&*TBpmSD)AYai+
+XE$hfJd*Bf,Ka5B#PV3R+Qm@@%TbPlA)AEf'l%FS4B[X@J9PXpd-j5Y[+f$0(Lqe
+%+-H)MAeI+EB,S4`VYSp!B4eSq`+8im9f&j3jBRX8bJQ#LHb6Z@)l4H'lYN@K-&r
+DIJ2+5@*MImm6fpHJX'GTBdr-elCbiJ)aLMEQaVaSDiCbUYMDSC`QYJp#)Fl3pZG
+3&SVYZe!)aE3p"Z9dEDYJ2eH,M6NX%Y[ESG5)l4)Sl((D2J'&8ahD[JlP$,'aCRA
+D0S&iY%4Xl!h&)f"VK&)[0Q*H4'c%el2%pLG3'X6f(5L-5GY2SCbYE41*@8[&a[i
+K2Y#f!JVlJMEf"$'@YJp!@5ifjXFiY(dEbNUar4X8iL6KQVK*6+#0Z-"HS)heHSI
+BeN%j9fc%dAH+lD039SRYUe!`59+f(d%K$T!!!T!!!mL%C"*a+LBfjYFLY[1J1'*
+l,j3eB[X$++eL)dl,M'J518&FE!p"BAa5$1)qDd8EmB2EcE5aGNQaXEq*Ul4G$b8
+Y0Q+5d,Tpf0rX@9)9mTb-f)L2-L#Fc&k50HM*R!Db"fQl$XVjB[X+&()VfKk!)Y4
+Y#ZZd3@c%5Z)`EHbIAa2EEd+j5'bIK,*4E(m*KIN1#5T@&Ue-Bj[L[f8"T+Ua%IJ
+9f,35FmrAK2RNMFX#9`3Q"+A1VJ5-!&PfbXJXp*9Tf35p5S*&P9re92rNljGXrm@
+*BFFF&Y6GaPZ'Gfqm%r(ZKEFFE`AHbALRiTf#PfbFk-XT!DF$R!T`'X"%1%8J5R)
++)1aI64Q)r'5jC(9Nq@6hc)2-P+b*l*hXJfK)PNkQ3eE1@K*"LC`X2j'5E*%XNHc
+3CCYN3f5&C(*%&aIab6L*pQ5$l&fb2l)qXMfb2,)lXMUb1E)iXMHb0V)eXK)L-KN
+#8CNS443QqT*jNA'4DC&KNEQ4QC&KN3f3!&'4fC&4N!#p%8r)V-LSb+6)3XLFb*L
+)p'4)C%CN4'4#C%"N2Q3mC)*N)'3HC"c%($)-6KXiCA!(GQ6KR%DimcT1%6M0)$[
+La),-L0-%GeV(U3&C'+F%R!j`+N$@abN!f3eC2pNqQ5ba8pK8e`d%UcDHbA)6VMA
+TT(,@I%dhX(S5VNZfT61j-1GTNFB9"I2Td83LR8k&ch!5E9CN49M[NkP!+l!iSpD
+XD-9UNS@0Td,Sq4ld2VAZdVGTdV2YBH9L#H`E)'!QQYP3'40l3e09KbeMqI0"CPH
+AbMQC0G'B3f-%Ui&+EkS2,fe2BDR03@U9LqVVPBZUKrK9q['iHPFER6dh[QTHba(
+D%G%L+b38('3'fC@%GP-4rHjL0I-G*%ET)&VelTHeXVUK0Yp'bXrV+TUjLU#D)3l
+kFk[9eKElQ$5(04qqal#`#551ELSk`N%j-L,XZJRT1Drb1!C9q`dS@lHc9&2jD`p
+Y%hI2@1cF2Vp#,Y*PfU@cdECRRXm,P8bQFqPH&2%#MKHN0eDi+GfHL6P@diCXcNP
+LYdlDM@&dC`b-T#[EBQY4e[`'SpMmr8lYi1m1GUfh&TGC1eGALiZU(@ZTA3Yah[T
+EcdCPaaTKBAZeHeI9VeaK$l9ckl4cae4!X@0rY,"ZfEeFkEH$ZcKC@*2X@)VXh6(
+Vf5McpmGHf"BcQBUl9F*jMMYciTc"h5VK$-,G+Z%-`GdUi3c'h5VKh-6G+Z&Fa0d
+UiDc#hAELr%@f5Y6XaCdV[3q[E*9B[iGAYNUXcq19V4,V0UN2K90[f5UarK'[E*9
+Bpq'9V4+,@`fb94*JA@5V*-!FC+XN`&Q,E*8%1&q5VC)!jc5b94,Jh%Df5J+F-XY
+@5H"++,*9%[J`&*P*"MiY[82Ec9"NUb4`1a6C+JQ`IV*9%[J"&0NU#@!2eGdU#A$
+$3EC+JUbIE*8%@8IC+JNbVQb9"$RMNDf5)'GRXP85j-a+YNU#R&A*9NQ3!(dT@b9
+"eP@f5S+FG-Y@5I"@+,*9%Z3NAEC+JY`HNDf5)1XR@bA"ak()9NQ)[5GE*5(@3VC
++3Ub0E*@%L"Qb94,LV%ff5N+FLmP@5BJ6C0NU#E(RC+XNa#d#f5S*h34&YNT#h$+
+5VC,3R9"NUb6%,5#C9SHib5"E*5(LK'b9f-3if5UaL3Zb9@+c$f@Va'B2b&D*c4a
+NUm6QV&'f5Qc1$Q@Va1EX6lC+E-lkC+[%j[a4YNTXEKR*9SPp,46C+V%r$N@f5Qa
+LS@b9f1a,f5Uali!L@bAfhd#4V4,l(LLb9@,r$)TXPA!Xl'k9'#+%Y@20h$PXedb
+AH%L-)bmKGf![%[H)DF3lBL%aKeK'E#-QN!!2N!#MX2F,-f&L"c'!q%$1`riPAf"
+2XLq)mqa[BJqaL,K!l#'@%3q)NF3)mJ4hcNfH3!j%AN#F*LFJTT(c%2X,-fMf-RZ
+BA)(p5`j!A#GA)Zkife(%5hH'5b'1NKm4FmQ0L,IN6Z36K6NmF9@ial1LeS+4Mj`
+&a!k"5rQ8j,Fhe*idqQ`m$[YZQKGRC0qBlYXJBhADNd')ifik8kqi+AAaVGZfA5H
+EIX8J4MK4qfmGkrfm(J*q$YbiFYZfacP,-VF*Vp"iqjSD&iiQ,Q#9N!"EjZBfiEj
+Y&emi#VK`eECYGh''E@U6iVdVL"(Q,T-"3&DYbZDL'F2$&IX!G[(cjp(qVikQKf*
+b)i%E"ZlQ9Zm0+rGL!+GRl[D@+8"qH69"hbj3YF*U"bp&"'4Gb1!Q"!01J0@k&a$
+"+)F(i'TBbr+hmG@'ZA&9HLq['&E%#$FM8"+dbXj+Tq4HhB!%)T&'!`"$j#4#hEH
+ANbCp-NhIDGXY2%I&'c4QJ$bU'cERVdCY&p`VBQ&ha+K1C-I1UcbGaj,c-QXUmEj
+D9kj-4eC8bfErl[jBfV48VJAXcU1jCQ9cjHVqXpQZG0cF'K#9apTFmYAQChqS2-i
+EkFDRqeAPX4-lH50X9(LplcAm)!+I%fq6b`flkpU5MXQ0b0epRmPQj)EQlM`SPH$
+d`bMlG&e9(NpG6h`jMqi,9ehb1[-%diP%kZ8'b*!!G0l%kkpmBrdB`Mb6Kc'!S65
+F[Q3AFKD2qr@*SB,Tl-61MX1%1r)i5QlL[*E(5%&Hb'-(!2pR(U0)rQ`Hc[U4JSb
+,CUDlqcA26(G@ShL$XP520Tc)-`6NJ30rreYA(P*amaK'SKIbD0["6NIVQXr$#-$
+F94jC4birriqB*aMhdhq&k,amfLICA,XK)!p+*CVNeEVb1&&K-kC2bXd6c0e3`8b
+0!-KT9N#UTkAl5'QAQ$pQ1LMY319IR1N-j@%fQ6Sr2iXCl)kACM&MH6`hLaR,ilP
+Cc+imRTh&M1CKATM&$06M&l1BSF+q1)XCcH1j@Fa!'Ur-BXEbH(i@djq)L@!@-a*
+$lSh[%"iM(mfeqf$j8f,mQ1N-!Y&,-jd5iTX#CMVjUlcQ'F%pLp(I944q6k&I,K+
+Yr!X$3Qd#rMmVM$&Iq$'$(&RTq%51ZN9JIT0)8eh0028aL44qG9#c[Lf4cVamND)
+18b''aA4SC*ICB#C"-(hpe5d$$&(Flr$UKN8eKiF2Ae69A!@eXDkk@@lNQe*NJQ8
+I-23$MQFNrl8aBi$XqM51&U-!H0PGphX$Z,`qVGJAaeI+K`E-+B,bBiqR,S@[Ed3
+6q)0(E5DU[rhb[2aUG+,cEhBbbAJUQ[Y&qUU0c6AM6(f3!#p-f&2Ir(RPUhGl%JM
+c+28"3hbc)[mPL'!('Fr6I-3KjCJe(SHXli$a1$aH'Xl(i9IrqZ[$!kE(M1I$JkL
+9!eqJq(8r$VRAp2&mq*@,+D0IT8!FI[&Ll%X9L-0[B*`d(SFEHe-0bPqd)&["F6P
+Sr#r-"!2G8@,L`Ia@rNdU(M1f!B1,"e"$"VSMeF3$IA'PUEf0Dq,cjA1e*M@8m2&
+!mi1)NmZN,h!bkl,KTP`de4,0Y-Jhj$E-jfIcm%pUDZPN-TfDhpLq1K'2KHY5X84
+lLf-'J`dI$qcr`!1`##-C'"6aS%c2NqC(X(2$l`"Q`mGAcUdm`E3f8I$aS-+JFGV
+%,,HhES`jFf1+qI1Yqp(V!`GqeHPGcHU"M-,IV%d)[ld0B4DME[S8XUC4[Rr068$
+q,8rrHpCSpJFJ-EakBi&eG,qLr&qL8RreaN*&lkIAc#p(-e4hEjFp#)3,A[P[#C@
+q6@%mPEl2AjY9C!mVjPY#Z$44["&I[+fH2lN!,ei'mQkV$mAK[aEf'ir$S`dcaZ2
+`L[2-m6M2h*a((0kF2f,dPMbmH(2qZ2'mH50ql*Bmi["'r0JYHF3KI4Ul*Drq&M&
+q5ajaH1Yq6[j@pN!Gm`kQea[a%rIi(fl%llA([A!MIS*hFE#d2@XmPH,&`4dVEkB
+5fF1+Z6M)(ILCh5ZIa@paQ`Gq[[h[8[`9'prq-i)p8[K$@djprJNJZ-KC%dmjf9&
+kBa`4!m`IfS``rkJca)JT$JA-1$*$cYIZf5F`TqfbCk,!UE"IL[GNqDMP+HU+['@
+G+Kq42%ff4KDSZr)mpU)cU4,pG0'V*FiLp@F'bkS4[eV*Bl(kdi*PRB'2Q&,Uj11
+L5d3r8q)Y&Ee*p'E4PiPH,h@+L2dXbDp"kYBSG6TEe80rSp5'UI#CdZh#e6Z4dUS
+-Fc*2G$N,%PVDd0"FF!SYAVT-E5R40V9T3cER*19@DpcKYPT&E9ep$GV*&Ve-p,e
+%,aGGa8&(+$Ydecl46c"i)"DG*,X0B4b'$6HY6@"eYcVG`RehP4T#lLdT646GY8m
+@IB+I8Q!IT0639"A1TYXcXA`@U(9)G,GJdd5I+Rlf9GFZA"FJXMcjB2P9Pfd5YaR
+8bkqkeK,lrU,2XZkqqqk1efe`hHXGd#'IF$A0L(QQ)i`mq'&3i@R'QElhHp9NLj0
+@B$EE1CR0G9iVf2r[q&%$q(AHG3NIcCk(AkVS0`ej@,2K&brk(BTi&C*Ik&l2ldM
+ifCYdIJ@rbNqM*[4$IJ@ria#[c%VQe*dC[iZRFDLc#AkF1aAm[X9L*A2CVRJ23TQ
++H+b6llFIIi!c+CP,T)Yqqe+4ZKEUm4Ef`G(*YQbRhdNVd6Ieb9aVCehhCAmFf*C
+aePKP%rL$(Xj')3XI44mFTrcXMEcLm(VY9h-NmTLNidhNVcS1dRjRRSL2rYbMr6D
+H!SH$TAi(S'cPfQr$!h!i42,Q2CeC1VrE@%bj,EM[19!QkRMRrLYXEa#rmk"-e[%
+HrN-fX2Bl#(J3f%[(1r4q1"`QmGC$18AlRI-jf0iSIRrXjE(ahE#p5IZGqP(NFCH
+1G`b[+,aCiRfCrDIpCR-N*m[`dlp*80"jE,QF[DMpVN6HGTh%Z`B14dLmak(B%Zp
+k!Shim5[3UlAIeLGKNdXK#jRh21ehaqGK3eqVIU+bMrDl(,eP(50eBMhfdhQI`VT
+@5RlX,Ge2pKFq"GZafQr"a9"Zer&D2d)JdhkVdHF"kF[h%T11ehkaZ9"Zd2&QmIG
+#Fb5rUr*p8$E[2YK1d(jaB%03qQE10q$!q*!!((SPMjFq5C["Sb-ZA[Tq-jH`'33
+[#hkAqRMTqqhl)i@,'Lm,m6lKiGaK934+lEF"pCLm5GIlcqJ!(+0Fqb82jaC%#+$
+DlhG45aIRbRQMLKm6Chpmcm1j-lm+"hj@R(NM$aIRV[NGf14Bq(6q%PrkmZU(B6Y
+CiRhA`kF(ELH'DEm%IV6NiP`VHq48LII2HCbc(eS+ffR#NhKr3qG4GNJ0'ell*G'
+l,XiGr'hfPX6Mp4eGEr[qRm2'(U%Im8j`lJPZ(-JG,1G22Ca,I4%1FRPN1RQ#aVQ
+bi&r"*RHU$L(HDC`VUb+RB8fBhiFpR,[r*l$*2CMpPq9aVQcZ"f&E,(iAH6LArQ[
+BcK$m)(m3hV#F[9HRr9UfjR(1rKalRRJ#53'V"1I+cQ'Gj"VHqrM6*m'jeHq%6Hk
+3!"h#AK5F+rppf)J*M(G,(ZIXcF6@Xl6I66Il11GrffNKqmI&1Gr[B1"(RKIkIQf
+dZ6MRqbQkG,6JA#(Hp$c1fCrP&q-EY0mYU)IJA0PbrU*+PJkq!V`@R,0rb0c2eRj
+I"eki1"Fp(`l%&XLPYq9ac[i1b8L6j%dH)MMhCI)cfFcBr`S2jcE6Khh0IRV)`kF
+31GYblAFCHYV&ZAUHdPQKr6D60`ZIHpIlB31I96K%A*FmPP`*fpZdhjBEmMKRhdc
+q4ej*2flM#+krp4lBhLlp4hiQrAd4qqBG8PIJNH#FrI&9F$KAH!B[K`[19A$Z4+a
+JIV-m2[FCBKYMXYkE2CblILCXFQajjSFm2[F2c%h1)@mK(p)iChqIh%2Zk@cjE3r
+RbXL2jDE2jCGiI#j`,B&2qef"qVPmlK[-3BiaELA[e6KRIrq(X-NPp+hNDS,h(q)
+'NpcEh2UBKh0r5kiLCh%Hq3cb@pKBRmeCpL1F6mLFC3Ea[M'ClH*R-c"Ab2[jZ$@
+GJ$B9m`cb%(r1F3qfRB)9+QrV8k`Cj`#3!(Z"dk%jfZmka,$NZ[b9l%10IpB0ej%
+iDErl`'IF2+iQRXPPUKq$*lKjh)*CJLAcS`H*!C,(9[*TiLcpd&YZ(US[j@VC3mM
+9c@-pq40M3Kkqdm[MlmR9C*kej31UhVL*jp9DaIXA+0p,4V[Z&[lX#E5&QXHmCp[
+2,i1$A0rkk4h%@TeIJM-)qDEm)j`0A+2pPY`)Qpc(HK3i(CLUrGj2IXpHJ$`'2UR
+cXka,L*FAD,r(f5H5hb6dZX@j#[h)Db@rGH!@eJEYp`6`hFe[lar!3Bk*23RFFI0
+Ep$8iX,mJfiK9NYqGR(q3!0r4MhdJqGe)6Vj4Z3@SZrPP1%rL(-2kI`!!$3j8Bfa
+-D@*bBA*TCA-ZZA3(0r9b!*!)"cIhG)rF!*!3+,`!!([+!*!%rj!%68e3FN0A588
+"!+qqEj+bElZd!*!&!NT8!*!'128!!#Hf!*!'dPd'q)ZeF"X)Me#qb,Djk-)A[Li
+mb@CGAT5lr9`BBG[)`Qj6lYP(,bAdZXeZHE)F&mr@NhQb@bI,kP%HlBSXXReNRf3
+jRr#&lL2lA)jIPr(,4C2`KC0pV#2l[&`'I0&EMLaNGi6AXHAj`PU14rLLNH9iZQK
+TC%pFq'*2XF)VeHUDq6Ze@!5!E,+3!0pNNadC,@5`N!$EV3YClA23p6EXl,aSPf1
+EfGY)ZclDfmQG0HJm-hZhjb#rJI[LqCf$aFY,FcPGH'CqRJdb2kqccXp*[,0hmHb
+XmcX[MbbHbdQ@LAPN)C[F3QB,"m!##,M9Ep$PGq,Ca)VYmp`@Lr",XMqbG6-#`"E
+m!HI8UpaXeS)JQ"F%i4P"iB*D82LTp`6"Mhi5Qbq'KC!!Tr[90L[aKUMGVMEEa9+
+lZ68ZTaeE5mSAcfXKmVI)l`A"Lpm5"#I0kZp5$DP[Hq!Fh@h[Ck1+CBlLhr@hliZ
+5Jp)H!KPAq5L*qTZ6caAkE*Fkpb([jH&dH'cKXRejF58C6S6"c-bXi6-cS6j8rGf
+6lpeA"F&2cqKA*Nj`l0($c8C8EMkAUe4`4R"FH&GKCqIGR%`Rq(LiYl"JhMR"1D6
+Ki5"iH$MirlPj*$KZI@PeIkXGEkP129mA6TE0l+F+Rj4&JMGPLI9I+YPqI*k'A#Z
+TANPH@QK,e35-0R#L#kX3KkfMTlaDEe)M9SF1NUrkU&@RAf-k%kj9C""jVZ@X)I2
+K*['X`P'&&I01k6DKK0@m*0*)rF#R9rkGc,KmH--PkmUe9A&8LGZPdX#ccE[`*9e
+j[0S4cVSN5D2XXEQA`r3APRr@aDr+2ql,[q5(j@-0qGaT,YF,prYc++TGAcJmq81
+5,N$6[Xb3!'5Q*('cS$[ij*,M"1h`MX,TKDrN,AG6UrbKSHVQGY6H[Y5f'4A$eD3
+Fc"QZV$C'"iS$cAUV@S[Eqd`[Ah)"KZI'Jh(M5EZ&eFDfTpfCT8PJ0kG56C[lAFe
+Y0[ElD)b5FP3lN!!'X99lQ3h9aRLbchCqG'RdE0!Qhh1QdRDdhfIYC*)fkm@,iqe
+[D,BVqfeVbZ8i5BUP+*hBEjLCV0BUcd46YH6LCiX%ZlTU%L9*A0rm4%SahP&"Q,8
+NXrDFJE211P!FVQPVEG5Z(#DJI&8dUY5ENi9GHl)`hT%Xc"TAV(c+TU8D'`H@*hA
++DN0FffHi*0ja)+r,S[CiR"E(iM4p-V&cm9Ba(,9DQ@A9NQd(ZPaJ@1KbJ@R3jBT
+fN[DLQ8PaB#GG,M$4A5kARN+Aff'EVH6!0YIP@[)YI5N`,ADj`$EAj3,$A*F,$)-
+Z9l6,0BkLmBi+#VTF,Q2j,YGXfPSEdZ9b9H&hZD*GHl,m,PFdSmXefE48Bp$P!X0
+FP`X-LedZecebABlqThBK5bF`EalQXTBlTVQXEA'FbaRk$6jR&h4c,riGdeV41$H
+5C)hp@6"VNad'XaC08ee6j[e",'[E-YGPMCX'ZkaPdf5AY5b1GMR$TR%TCpe56XA
+TcNYFmhKAX'dV*Rr!m`UN-1(P$-1F&@DmR*dCm[*'VG9C(21bPNecAYDbCG$c@N1
+Z"jVLeeB,UmRq'E0qY$M55U[ekSl(4dRG64C2TLefr%ef+iEhf64%jC'aiR"-6PV
+5f"4M[QAj3HB0*FUX8A1B3HI24GNd"dU3!%ef+XE!TLA%"Ir4,(2'KIR3Yf`H@(c
+MiPcZQaB'5pmb2eN@$![6@X%k1ki9l,cC,%KiFETXX[A(bm$@c*Hq6D&!IFYmK4B
+0@a2M&Dp[Y,pkQaF*cFCYkFc2aJA$X0abdh("cKf2LdBYU5i-b,jPB8,f,CXf0lj
+YIR96-'a*9c$4+U-TrB[lNiRD8pd`X-de`m#`f!X$fh`V$#acR6!`$"TKd5jAQ%9
+M5A64V$A2q5EBE*TY'MP6Y`8'*VN1'"J'$E$*VL8PT[d&0XhG,l!Z0VmGYUeT$&T
+IdDkp`2c'9c5MlcACl-K`VZX&KVQQ&aJ@HPjJ'V5mSYf12"8DAY[XecEhYFpm1qH
+pYPQ[GFi,Clb@qDjeYYXeeqfDkBVcA0XXecV(YFe`6I2ElYQYI@jVRpPDjl9`9QZ
+CdjTQY0EjV'df#rFfCVe3&fqH("q2fdAA(A+fFpH9RPlediVQ6*9MLQeM3dfQZ2B
+SKK6BHL%9Gr&0)H8@,5eTm[TA,Nqj)A&(S[`aXMP6[R'3!+V#k0QD+j2-FF@KU$%
+q'G%e@P%2il-q8%%M@0Z1&%61HX)"$-M%i[)++eIP6A8AqTb+29G#,9%(pXe4"pC
+qe)&CDp5j'YZ9l+b$YQaRc3[TcYVYc,GIKfd*pafdC0`hckAFYfZ0h!,j2BRm#[+
+Vb+H3!+13!+14P8L&%ibm!MN514Bj$MNH14`*-m,*b'R)3FLr3Uj"RSXFLPb,2!m
+j'$N%13%j%6N*@B@FM*b#""(C(cN9@Bdm#9Q"I!`j!$N3q3hN0j&rKral*%`0kj%
+EN!#J@5p!ASMFK,`BZ4Pj2[,cb0FK[i#Ne3,@[34j+I)b*($VEFMA)m(Tr`(b#Z3
+EN9FL!EqZ3ek09"`(N8mKhibm"[N%mUq4Ad*q'3QLZacC&GN0f3RC'GNGf32C%eQ
+'r#35!'drC!,j+H3Cb$14DH4VN!#[4B,e6#&l)AXMqb!K@6JHf4GTX1JR)%p%'T!
+!p+H4-$!!P[iDmQq3!(q,r$Tb2R)"FL'b!AN+XKkj#,NBfBJ%V[eC*&MUdj!!GFM
+2)Fp#RSfFJeb02!GCJm`J6d8Z35j&,N-Z4kj!cN914kj%VN,13-j%2SkFKB3eiA6
+N@j&rK(`EmZh)kj!!Ed(q-I)Gb"Z3!0FLra$j6Z50b$p"+SD1b(Z40b(r$(Nc%Jc
+Y,FMh)'p&[KGj'r*kj1h)1j!!ld2HLE`2qAlNrFJ2),FMld8qJ(`3q4$b,Z3pb!m
+L&@BfFM2b3mJ2)ap&IJ6jjmLr3(i8q6(Naj&rLI`%mZl$h9G9r!&ZLIhI,,kD8SQ
+DGRCZI"+ZrHYiXXTQ$JYDM48JbYcR!IY0K0D"!1dXRrf"Rd#A-41-RHBV#HBGcf*
+S0$[9bPT9Xe664ar1p@+,3YAk84Yf!6kiNI)d(hbDhN1)E4B`BATX"9P'!NHZSmJ
+BXJ5C3+D43j!!TFM"b*l)l[YTB,a3)L(@E"8)9)q$lj6E%XZ1Q3IeB2dLYiSE!9'
+fNSU!"0MT-rJ1Fd'm6*5MG`AP!K,8eV68hp+rSkTY4qilIA@TZ'Ejkc@9ac-f%&1
+p,N@,i9A*4R9`bMUF@,pL24)+3eQK!dile)-#6[bk1@@RA@++Ac3dZ,'mV9S49Q(
+P'2`[B8VGr-I*C0$6GReXFI`+f2QCM[(6`YK4+Rk*Cq[QF*8A8X0kUC0f2lTCjJ,
+8kk69ci4MQrP-F5(,Kq1dhAa$h0k@&$-)cp,64SYRKSYhh4!ZhV*Xr8KaG09%F(T
+a6+r-SP-[$-+e,(m'h0ehkTTJ[,KH#lAphfM0*&hUD8Y,aPb,Q-(U+IV5HMV1UM1
+fGmjb&N[)k0Re9S,2['A0ec3R03k"HSlZeHU29DVq-Srb'2C-6Z1Iah,Ee6Z$lBp
+SUSU%CehA&pkq9J[BcfYULK3qI'f`r3YIlJ6*bR1+Xha5UlYXPZQXN3A1mJBY09N
+QkZmUHSjcRl1m8#XqeS@Z6dDeRXjbQaCS,"(e0eZVZ9*RZ9AV0eD,VLA,Ymmjbkp
+S8FV#8Ap[BVhTR1JXTfTeb"T5Ifr@i[,McR+ePRXX*pfDB4@Xjm0)i@50ND`UpAF
+05pDSjI0*,4&CB1V[1Ufcch'@Rp4DPc@TDkN@P-FGl5bRDd&)KHM[0ZAMmRUD'-Q
+Jppe1bhFHS!Fd@GCS(6QfRYDdiXjEXX`eI50RUGIT8MIId'UAeE,lXEJIj#blD!R
++`YRpU!E*fSeDql1#GMpmh'"9b'+CHSY5fB`UlTKRHIPk,KSBZ@M&SZ+LLjD[@mk
+cFIA!1QdT,#UI0BB*,'hE2)9`flA0krMX!pZqClIi&S*[0i1CTD*,-+!T&&-DY!Y
+J(DeAZ)prE4hp`&Il`0Fii"*!mLJ)L3eKFH95ZfP2TP31li*8+qj!NJ4)%9H#`&N
+P**IYi!XfbQBck4Sb40SQf$PPSfF0B(aYaJdaP)-c!hF@B)pB5l#!!+I%+JEm'Z-
+f1$I`DH$1k+kX)9KRJ'd#e`5Q#D`5Z3,ra+U#IJ#Q#``8q#c`91#j'2["Fl%bB$8
+"$JVX(0JZPM)X2eMMJ+8#8d@(!'m&9JiF&ZXU&KNX&F$%XFaK23l1La)!'dCGJ!P
+J08'r!U-(GJj-(GJmF(KJkeKUJ-d$5mED"r`HNa2,"mC+Jp0M,3+1N!!2E"ki0E"
+Ei,*BN!#!Vf*""1i3l"Bi-R"Ze$'B16#*,*0B9,(1B&N$2K$F'2JhX'+XUX#J8EN
+X3`c@$!`D',-!G`Ifcf$Z`2#"A@64"PD4Y4Pi4A#4B#)0pT'G!)XCF*-'6fP`PQ!
+X@ES%q%V`H@!$'3V!")+LB99'Kf2*#kk3!*(&B1h!"`EB3jCP!Hi3$1%Zr#Ai6B1
+p"1m'MJ,-RX(UdEI"j)(RI+@EfS'JA2D3!'r"B3C8jT,SBIXi([EB,mcSDm12QHJ
+L$5T+[Ri1)&%!V0J%jMpE&1`L`e"ELkb$*rQChJZb*DGfKMaB0L6I+cjImI[EH&r
+eqe)FrU$#acE#S,qBkJd)K-f"391cqG#!528aNl"4i'1$SpH0kQ0lC$#k)0EC0[$
+"Y'$fDB"rf$S32Qqp,&8kYKTX)Y!a$3RZdY''K@d%1MBqJU9c&,IHTbSG@aXf&1K
+J4'"6J3jf"cB@k(l#Jmd&U5ChE$R3XA&KXi11lB8q28(Tf#*4&qMB','Y3FIQLBd
+01MCEE'l3XC9MJi-1"JIL3JFN5U"68G8G@ae+M(MBmU"M5m1Q"adE26Bqk0KQXIP
+"ar6)"JJG'b8f3HMBZJP+*+EFbm3D%m-&'b*drm@$64(P6)fa-8*($'b1d,'CBB1
+%MXdG@b4da-e@#4hE-$C,k0LBX@&#"d#,(+,MDJHf3qKqD2f%eN%IB9Z%MVbc08,
+(eSMY%6Vk$ATdE1$B*+&M8mG'#4fE41S8(4Y3YN[SU$Qf61LS1EC0Y#RkQQb,%kT
+E2@NV(6PLXiQ1Z0PXSQ26+-cr#@dkfA#LBl2(4K)Gfe@fP1KJ"@&$LHjT(Q`"d9(
+Ve$,YN6l#&K%GF3X)1+QiNHMBAV+04-H'Nqd#1VDZ-S8Q"@S6)&a5,"`#I8Xqa%2
+!EVVp#V`YT4iNJ,D8kNdJE#R&,k#eP1T-B'STp6B"TU@dr48S@NUX&!)q5iR94@"
+J+H9EJ&qTEr)3U&GDrCGY-cTk%aYKG032ffCdf0$Id,%*&Ta,@YY"CJede"Rj33I
+,Kf`0drIcN!!YEPUpMHdf)`Cc!KYSG23eDKNGY8TpS5-fYX2Sb$FEBA6NQqdi1VE
+VE*V4`@3M0`k8UXjNpk*('1B4G-`!E)(4dEq%L+P-Y5eERc,PLbdd1ME@E+24XB9
+R)ik1MDN!bm[%T-0@(pfrmf"VVlj1QV9N*p4*X`6EIh6d1rSN1QUEh+)Mem5,MQf
+cX'eddVDIV6XkQ%ES1HJ!!i)132HI22#T[XkDrCJld0&Ak)hSk-ZJ$0$4GpKdSk0
+Qf(LMime'("hEGZB)G$#EX29(aia)lD2l%3rQ1r9edD`'@J!GFi-'PLSGI4md!6V
+k)fJ(G05r4ZmV(EPQiik11Q0,M`k%!h-%1KKhQ1238Grd!I@9D`E'*cVQ"[Sr1ZU
+ERSb1Z%&1S+1[J*C!4he5AqL)RlNB(A'$QN!(q`qc'cTepBK')D!$A-YXTEkZkQH
+J%Y!ae`Rl5eI91LJ&G24ZN!!+k1KCS"238EFJ3Y#44j!!)HM!*B%333H6%6d@hAG
+iN!!IG!VkUlIhkZZQq4c8#6Vk((-Z1ZBpqL3kjKpQ-A6-!#lf+A+#mJ'V$6Tk!(-
+%1R)0b`dkpJ6-0HLB,HK&k1KjX0qJqamHp!VeG9G0i"-GXc'X11MS3mbrk*L4Q%R
+4dGm"Qk+Ma`NqUEYU$*BTG0M$%)81GLJBLp$p0`rBLY6A3c-0-`JkCQRQ2R6dH1S
+)(I-'GBf1hJ1V%cVb$G3C(A(5Fp"4pmbYk+KlHVlkHQS(!BX@1[S0-`JkqMSeJSj
+C"9Jf1RSPc%cSU&9Q3h6%3$p(ada-EYAA5d-Lq`&dl!MS[HLBAGQCS'01BjDh&Aa
+fN!#c18TBB2RFTbdZP2R#3lD@Jbr!b(Pm(AlpU@@$TJhe#6bYUjp2@fTV+3#&TT1
+PUZhYXpH`UZdk)+KeDl(i-"Ja0hXI4Z,rKRmXQ'iDfh%jip4H&eH+MSKXLmEr#YB
+6NBahH*h6066EX8M@YjbGNA#[6SX[afj6-%GK9YNU6`4TZBErQPUY@Hi[QlCf)QT
+dP(-DPhCdG@Y(1lUj!r9+VP5KCTAeM64Z6lE5VX'kA$PRUUYFe%bV@lChe)VDHPf
+HKL9adTaXPr2!PME,fcV+CG9kEVQm8Ch+P9ZVYBjbB605QME(ir&8beR9*0XE&Q8
+Q5QB$cP3E9*LVUpd@j394LdE#9LQ[@G94e3pe9!drDbTGR*)AP(1Q@QfRVBY5XmY
+@e*a,iiE9`TbTZ$`jkm!V,HTU865Ek(QaH6XP5LC-SflCf$LEY[T'*CiDfEae9U[
++8&*H2c,lpSUMIU36*QXMSpQ5GL+3!0V4KE611J,Cf'*4"G@EGGSBY42,9q1fF90
+XMT1iIHQXfHECdQTX*Y@TXG3U4#N81ABf%!TF,,fNVBKNXTlZGTkk@f@P@3iZUY)
+9UB,DCN[CS'L-DQR,Y6pdPp4)cPB96VBlLUiZ6VDPcGE`Z),,'VYh##L,,@Ql8Bk
+5Z&aAiRfkmTCqV2hV3d1+[9FUDP'cS8))b-FMY)Q0lG4G*U)Y+XTL%Kp5T("d$p5
+mrXVH$9YabDa[TNfkZCLX`i(d5,aAdZY-rh0GH[e3p*VP2dXc+3(TFUTC1lDk10!
+[8e+cP*kaUU296H@mU"a,f8!eD4HmPN`fZ)9JEHDPBB0T89E2"8TUkqYCXT9*j(A
+UXaXEP-j&QNdUh1N&@#UPA$D!9Kd6%(&R"N3f$SbXA$NAJcT3)&$VF!hKMKmZK)d
+0T3hle#CJ88V!D2fJ8"08GM[F-$E8V3qdq4Val1Z'KM+Y9)-a@CT@"MUZLl@c"[E
+hMB`3@p,*c9PrfPCm21$6-S0#c'SJ8JfLi-NcbRX,k1G0EYhV&Y`-"b@%,bm3E8,
+VmNe-+S1UGk0TbV!%+FPC2*D&)fh%YDdiircU*8XUChDMFJf$'T'8N8k6,r(ZTM5
+SeVR9GU)6*-k[-fa&PMViIQ[+#a&9M'@Geq[aIS[2C@aZ0*HcVG[fG9Qr6Mif9j!
+!ZP@e&*,R3MHH(H@AV9aQ@CP6eBKbAPBHUQ%8d3#ZJAm@4I'+Lrca&S@E,I+R@Z3
+ZY#JHXe!iU+*`4i9hh8,ZF)VJ6)QQkb6m,*TE*))6*(+A4a3233RZ1fQk6m@rm53
+EMI3X999X(Ll+aY@@Q`qDccc`,cZ`%4jcX(9d[((-kUb,''3rZd%3qBE2(d5Ri39
+L"`a#2rAIr,00h`%'h9`m+KeJB$dqCK5'E8$c-5X23c+#CQX-5@"l#EKePq0&Xe*
+`SS%"hXIHXj6HY-IqEI5Yd0j549!FI2P0AGZhE-A'G4RFB&mFh[S[plANp*8ih!m
+iVml(jU"C2ZQKCF'mbYjJiH#Q`TkC6iISR4-KP[$)FlGG1F[c84(XZ+`[Q0IA@E"
+Jqc,FXMcEDM9Z',#09T0rfa'@bma2S1(02!dEJDPi805'+3H@%c1l`ZKKQ(,-(4j
+mS0)0lJViS@(+J@("6&N-`F+8SpN%K#P(SrH&+8HMh`e##,5j-19SG,GKRIm"8TK
+b)Q,"-8`jj-X`j@"[Q(*JGa#Q(%G--F+8i`L*,N`jMTJmK#R(%91*-19SYKjKbR(
+%h#&-1BlQ-'(+FF45)8`jMYJLK#R(%@Z$-18ibVGd8%FX"X+8iiJe3*Kb(#(cK5R
+(%G*GQ()FSGQ&+FF43iN`j6L2m"#Q(1Fa(M)p4P@6`T369Fd)8dj8H45QR+Mm#P0
+1928Y6$P4)E5%+5FUYKGKbSQ+D8@BFU*#dJY66P3X*-+8%pA'3jKbSQ,L%+DFU0J
+aK#P(-``*8dj8M!A#P"-9Di-`j86&RL"-19'a'mJJ%&90#&019+KqBFV4M%6#P"2
+p1JpKbY'Y6$$M-I8JBFU*U8F)8dj-G5K-16(P9'DPQ')6TTbB@!5%+5FQ4K"KbSQ
+*m8@BFQ,U"m+8%a-VJc$Pa,6m%DDFQ*JeK#NR*YB*BFU*UFm*8dj-Y5j-1E&ri#&
+6D%`X8m+8%eGp#e01A,N8TTbiHT-`jF69#i3T*kkk%UDFZ()N6$Pa-H-)8djF[8f
+BFZ,+T6$Pa-@d)N`jFE'C#&01A1`K`T36&aZ%-1A%aC3K6$PaeDi`jF6&"#&-1A%
+aFmMN'[p((X)Q%"FlK6$PD(BPBFSTd9`K6$NPQJH%+DG%r95BFNV8Tf5Z,P(Y#P0
+1LHT0Q(*+P%GKbLQ4Af(++4',M6$PP)KP4*Kb5M5[#&01L4K2C2G5)TB3BFST%G1
+'M+iPBUb3!#ehbAdmK-@K4(eDQ(*+a+)N6$N*p@CKbNQS[`X%-U&q*a$ZK1TCQ()
+5UKpKbNNS6Q(+5DK'K5NRSGfL-18Na+iL6$N*c9A#P*03Ma'QR-6RH!K66N+-4m+
+8Ne4I%DDFT'B5BFV4E%r#P*08Ea@QR+6kPc$P*09hK#NRU9S9TTbNDN#BFT,+K6$
+P*$8R#9018Q`I`T56&11*-18Na6!L6$P*eCB`j56&V#0-1FPrib&-15R0Im+8Np,
+F)d`j+G@C-1@N0-m)8dj+mi!`jD686i8T*kAH*%`j+I8#BFT*UDk%+5HPh!P66NU
+qK#NR*BBDBFT*LIP&Q(*5ADDFP(U'-1@N2XY$Q(*5$r-3TTc8[r)3TTbdHVm`jD6
+9#i8T*khH,d`jDI9qBFT*Dqi5TTbdFLa-1@RP@*KbdZVG`T569Ym8TTbdqTd`jD6
+9Ai3T*khD%kDFY2)P6$PTq4@Q(+[&"dYUlR0Q"h1VcfH*Z+E',RGkJq`PSk!%"AU
+r,UU"Y*[EMK`%mUFI2Fd-mErkG1KZr-[LGKeJrGE[Kqpp!IQ44d&rFdjkj%2jV+Y
+I3%0JDIRXFD4(0Y46b3TV@li%,!@+Vm,Z8T`fK0YEc"PAhHGBXi3PSLNA&SEXH*r
+U$kc'PKFkR'(jI'LXRHZ(9V,LS"qRk`I8ij,F6ki$"Aj!4+lbmB#+210J2%&q3+Z
+GkH-'qEMjN!!I[bj!3QleIN$([2'J(d%-D6mJ%&IkH&Jj[b2hdhBVQ2)$H[*LPBd
+kjZ#C3r&BF*J5h#[*)USh,[AJBSm5*%HcUF2K)XHS'5YCLLa$GN*f3CBMZb+l)EX
+MHb"l)RXKHb2l))p$(SrXLc`"H5+b(j*VqNp#9L!()!FL6dB13Jj'$N%143j$$NH
+13)j%MN+14PBLab$()XFKab-R)#FL*b'VN!#6N913!&14eFKTb1R)'FLCb&R)fFJ
+DC!CCLka$cN-Z3#j%0Y"kD$pcN!$eb2R)"FJS8Y%*kr1m5T!!A&H3!%5QN!"TC#Q
+b$0N*f4PCMZb+l)EXMZb"l)RXKHb0l)-m$RNmXLrb"15*b(l)rXL6N!!9b!()JFL
+6NB13!)143j!!3j($N!$$N513!#14Sj!!Sj'9b$()XFKab2()#FL*b%R)+Z4Nj"6
+N9'3eFKTb1R)'FLCb&R)fXJETRIhKUkac'"Sl,+GfPQM1c[,Ciq!PlXk8[56[e#h
+0hrhBc-ae3UER2N-6BhRl$Kr&fIETrC0&i-Sd6$9m`,G3kXJPYfap&f`59pKY'TD
+fMe9`X5pF3&qSRCQjbaJi,'hI)X2r"(eK`beETf#Ek[m$EN$,f2GkKJA$HQIk`K[
+F[2#%-I"BfEjdF03*6p'TrqpR(lLYj[NE0kd#3"pc"Bm0K(A&h)ZqLeXD*+Hj0a%
+q3(22H[(1pH+GL5fhUVIFb`JPPER[rCIh-TUlj)0l'AIGYQMZ@S46XAM6)TXeFlm
+k)&Zi%)8$dEE`c9dpY%+!3RN2Y[F3H`qepc"l$lIh#(Z2Y2FSHiqfGk@papKlV,h
+(fAZm[5IBHk+p*pQlbYk6l6h&hP2YA@h[DICH1$LkI[ENhrK,$YdPSRU+q*YZlaR
+fRQR[@IDHEHmDHfIXA@[["IDZkmDG1[(J84@UeH&1p6RcMRAGTR888[ES#Y8Dm3%
+)f2G41KplIBb&a+$X5qbGk2ST@l$[@![*Yh+LkeS&VZY9kBeGGh[h02[,l+hVAle
+ehDVhTIBHdaPRh+YDFeKXZEhDK[DeF[cCAmJLAKh+pAH8"X3+3)9QXk%"X@IFlQ@
+A`jG,Gp"G`3UeDE-)I*CB@NVrY#!lbfH2i`e`cdf$ALPh-YV1ceaiSElGm(%V38a
+UmE!0H6Pb("+-hhVN"Z4'j#ENaFM0b#h)VFK,N!"e5&!(Fj(cN!#R)1Z4mj%,N!!
+,N3h)4FM&b%ENUFJPb+A)CFMPb"A)PFK9b013!+FMcd#HLA`0mVA)Xj!!Cb0A)mp
+"VN'HLeb,2!pj2[)#j$VNkj!!&b+jjRNmFJ*b)R)5XJSj'6N&149CMCb'R)kFLCb
+&R)fX3@D3!&&N$$N'14Cj+A))FL5r6HjqEECVllEGr#ef#FTl$#GlUcAHpaUHqME
+V'JrEqa&lImMH(lEhlABKbKf'chqIfGeTllXXhZfQ[p[L[FIL[pIL[FrLIlqpllF
+,9MjJIKm`[`rDe5S2@EbZYBhLeL#b'mebaTNFd(-k5jH1Zl2hV'e$0fe"FfHb4pI
+pB(h8ZkdA&2T"R&R"@HS@mNXR@cVQVYTZCV5T03M6$a6BK$Xj9$r`lSKDQND05Y5
+Zc%*mUl2cqI4,GBhUdZ6Q'ZG8eMI+YFP+h$1XCjKqS2B(*IrC$p4PQ$DcHF(["mR
+[c3H+['"pXcGC@r$l3HUlrD$j2%M,@&I`qd(Dl4HTpY9TllB9Spm25PdrU1j`fP5
+mU[rmr[0kVA8'[aq8'6i&l!hi&*NAMUNAm#QfZAf#I3k2)22L)IbDMD`Cj2Z"BVk
+cc1%48YRq1HEiil,m#0Df[K"mXQp-pTc$)mMmD*($)b4keI&Pj2T"PX(HRYB4r(l
+!C6Yf1Ei-Q4GrL8qaN9(Ur!D[C%IM9dVe`1I,f2H"BeVG[k0UemIEDll69jH+DjD
+rIVPNHAIkRKpG'KA(6KXYRKNZhR9$Z(M,X[8MaG&9%m(Ta6'p-SY1[6!)eh+Iqi#
+lqdjG%i`AerrJZLYed8aMP*5MQZjNh1PMfBU0krTECEY3[cf1fR-'cMVVU6"DF[T
++(1l(cEdk(jZ$C[QNKjB&mbTlJi@$Q`TlCMiGSRG1C-[TA9Qbl8SlMce@$(CFeKI
+-kqXF"BRYbmFpP'HEMmB0!k16ME4DImUrY3LYjal%SdiFhAqRV,+#*c[TrG!P8Yi
+2I0TTl`I1S&,["rlZ-Zq(fDQ6p`0LY,2h!cpi&qm(VZpbliICVk[h!`pk0qq(QdK
+kH$rF6G,6qq&fJPlH$rHAp2CqZ0'NMrI$(5I(H6rFHR+mpm-p+(fp(fj'1F(liDk
+8%ldIENrTjre`RdTrl`H@rC1m(qjFUI"qZ)9PJ2I$[5`$[4pZDMRCqq(ZPN(H$j2
+RB1q(qef'H$rFq$,8qq%1Q'(H$lI#$2GqZ#GQK2I$c6%M[4rZNKRPrA#lc'M[KrY
+Q+VdIEU!Cire`*meBliGEDXCj2paE-plli5DE#Gi2GpY-p(kil@D5pm2p0eAH$cI
+L62CqZ#0RL[I$V6P6[4rZdDRfIVKCCjVh`edldldIEYqCiIe`(mp-liI&d#c[KcY
+lCRXrh1*6Fq4HE'A&[6iC(`mhrG4k2pcp8qIpF"[3(1q(qi(QHMrF'$62qf&[H)V
+h`ke#pGl22*l[1Z6(9h"3q%hHMcT42[*4lkH"CrFMIVb%C6(JHlpM'!3rpVKEDQ`
+iAbmEjHeap`FGDd&-6KD+TXNPG1Uj#pQG46)T2dT%KMYq4,($$mKZ$`%HqJ(Cl5(
+!3cpjC(IS"f5hKa32rB$XpK$JS4q3!0dH!McdNdGfKhj!GRY)mG!2b'i2!4lk!GR
+Y)F"$2ebmk5(!3cmJZcd%H1J(C,H(!!rpJ1cf%1#K(j!!h4i#22564hE([Z8RMq`
+1rH54hD'I2,)lp*0(GSGqmXMZd%mHf4hkb51l3cpjC(IS*irX$[hNNGfKRcbb1r5
+64hD(I[,)lY"2(YNGqXNMZd-rH@4hk#H2l!lpj*(GSCmmXM[dNdGfKhlbb1l36al
+C(IS"fHdKYN-r),Xp"(MS*irX$[hNNGfKRcbb1r564hD(IN"fHiMYd!r)EJm"([V
+*)lY$2hPNGqJRMq`1rB$XpT!!f+%IN!$G(J)mp!1bfd1!Khlbb1l36alC(IV*)lY
+$2hPNGqJRMqb1ImX2b'i2`4ck!GRY)F"$2b#l234ik!GNYiF!$rf!l2B3i+'I2,)
+lp!1bfd1+Khj!GRX)m0!2PqVZ3RCR2q@RRZFZC(IJCcl2AFMZ`!p)m9h)lUE['"!
+"f@d,L-+lDb24HqkZ$GB*e[Zl0UaeGk!Hdf$FY@&!Q5jM5JkMUC3f'ZBKqda&@(R
+kKi@L+1`e2Ff'q`RIfT!!`G(e*6-TRFqUHAdcED+,VP`pY!+@XK*l*lTqbKC`!dd
+@bi4MF6*BEl@E''PkBpIGhMh0rM*l$l(h@(YIDQpBCQE2Imr@,`CAA68c+j2[[QT
+k6Tq6jffj1d[0GqqrreNC$Bl2lkT4ZG[`p&deICHA5VTmi-Kh0V+QeDVe"SLMBAK
+)[#0l2e@'&D[V3TH&jr%dP)C@pJL)Bq@!H%XX!(PG-MCk--,$FHJVHmkC#-T*XMJ
+)(hYVX'"0fR'3!,Sadf@L@UhCE(!dqd@G#iqF+kr1G-lBRQQpG4aVRSqhiqSI,ik
+4iR#b!X5a,b'rL'2IB8X[a,%hN!"$FDbGDJ@lEp[Tk[@$$dc-2,SXP,lRIA!ZE,X
+T')eh"$r"E*)DV'3eqY3RqV"r10apqkE`LKH*YmQ0BqqY4mrQ!i)q(FHqmRMKqU6
+9QS5X!((mpSSPpmYHRk6Lf01*AVKLUD-qU0LpRijM5c$aA*p@DDK*kN(@U)eTX8q
+['KKjBBl"apc[6$,R0XZ64q,Sq*Jr0LIYld`02ipMbd4Yma%rM5Z1C&A&XA@b4d!
+FI*88bDYjC9FJ%hI9NSYlPNcF+V0Y2PkFZ--iV!%6pq,AVE%VXm*2RBae)"q@MmQ
+p2DX[6Zi(iRKZFMm3ah16ql0ar(abliLMBh,RNmRGHG[#66d!*[HGqAKjFJm6HhK
+bliMMZFPpCaJ[6HiGF9J%*[HeirpEppD2LEYUbEB$2PkFZ0[Mi,-%60`VUihccLe
+1,ERJi-5Gr[l%T1,BfaQHRjJ1a2(FT20X($qIG$VLH,k6licMT8lH%FIqTUIL8(A
+rl'4H@DXHlPEq4Q*hKDJi0QlHqP`FLcG[I5'1p2!K')CmUH(KJ9AIDhrYhmmkAUf
+Va'IMZ1Mj@9(&F9'8*',Xf!4)ZjMFE%@I'frT%C!!ek-c3hD@hMq6(iUMSh2ZVl0
+XI@`pA'BrqmUbda4hpjJZfICaGH-1YNVY@kL@cpY#26hGf6jD!H+SV59*3)Y4$D3
+p$YAVb@[NZ6fjhKTD!I+KYhe@J$M-YQp2()HfI4HNp9T`FmR&FGeZV+m,ldAIqaF
+AKp0hYB,6`KYERlTjChM0Dp4-e"d"j3hXV`T[V0`66Mq)2iRMGDUL-"m(kdbf,1Y
+DhkjA9Lbk%Hf1JpXU)cT"mfMGkbf,&D"HpCE&#K!(Rp[1&"rmlr+Uie$P%IPKI5a
+U0Z,$)i-c2&ckVh-VQcki3MY'MmJ*[5H3!!qe)qrmpQl+r8b0lIRd$'-&L'2qe[D
+@IZ5VH@8UY9GJ&[Gm,E03mI0QSGrAKcF,rEjH$fkF$kbEeDGRSD2pJ`jmHVAe!J,
+RB&lY%jYV2TQTMZ49al(rkYQ$FA4![#)Rphl$H1hj$NdkGL@-ep(2XS6afY3k2*e
+fj29jV0M"b6f,&6[k@8#`BMXEb%YBXIC1E3[!LVQ6Hd2F(Mqi&%hfRTMF,4@6U4@
+JFpS91YA"Vi-Sa`+bdl'i-1AXq5`%ZaJl%&21dFqba*4cD"I6&SL0B"HcciF`lZc
+pl&Z-1ah`rdKIV`Vmrh-6R(f$4q$jb@YR(#p2AQ&#$NpH(A&B*rJ4$NeHEB(B"AJ
+@h$Jd+fEl4a#+[pdG#RElX30-"$S1U`6[J`@0LI0KKp#ZcYJEpCGUI8h29S6r4ql
+iF[CHmh-CGXh#Y&mFXf2C(+p692UG6*c+pLRNTX)jEbb'ApbMbb3Y8dbF,q`&BH*
+Xlp1Y6*b&2QdTCq+d+8cZGL#8pTl*RFm`-[l6[BYl!%cZGLNQcU0eIdc,`-5jkDY
+Vf5UeEk&D2Qm,GAkaXhfd!X6K-h'fap(+1&MBLZQYS48J(hVEC`@))m[%Z6Z13pX
+qc6khF$TRiSc1,fa%VjJiSbImr'lZKTldQ61'2PNSlRN!PiU*Xq[RXIp-iG9rmE(
+##@r@KF!qqebBMi0ejM0aYXI4bX4CL-0RiMb5$lePX3,8Upkb@!(Li"2@Z#0jeA'
+i6*a(iMK'Y'(LG,mS8ThQ'IN4*!`a#@35Q8DQN!#Pb$*N*b36D'GN&f3jNVEB$GN
+Gf32C%pN,f4[C"kN`hj%I3rC&RS!m%GN2f4pj%K+8e!$N316*b%()`FJKb+()iFK
+Kb"&)ZY-Sj'JNpi&@)X'3!)p$MNGbCpSNj!3N'Cq-R)+FLZ4)jZR)'FLCb&R)'L6
+`4,D9dj!!A%0+2f&E11GrD[ehRkNpkSlk#fU[THiDHKV8(R9(r49VMlUMrS,DSqC
+-rEA8([99V$pUMaUNrS+kSmI-3aV'%HU5rN5ISMr4TqU4mj(J-L`!fqrrqq`dYrG
+f'KdC@6GRP1VH$HXX,,9M(65qVPD0+kbh9eILYZBc4hHr+[G1eePd2Z#(LR9PS4,
+drE$+AKmPUpiaHmIYVBq89Hq%[C2f6YNlE@ppMkakPpQlNldEl0h&hZAflQV[E[E
+@H9#0+0V08qci`EJ4YcR&hFf9[Re@qHTKlhRfeVI2URF[HrHfGapl(fI[iqhGepi
+Rf2Y%HrHcGhplRf6[#RX2X2G!HjpXld(feMIDUVHq[9DpKpTlQ,f(fhZ%[8dq4pP
+lY,dVl6h'h[U'@r8HCqrapTjJliRfRQ6[+RY2Y[F8HdqeGl@pTpPlBEIQiLrTA%%
+q+L2i@Cd@AdlpXCda06lGhM2X2G2HXq`pfpiepXlBZpEH#qaGeidlGH,BK%Ed0Fe
++6-"UZE"aXPh19Jbk0DRja,aMAEITifN0jSaldql86'1pZ,hArj,[ISG@-mpp+JU
+JkT-+EN*5Yf5hM8V+$pZ3!#V[Kqh,C1m(0T)ThJp!ZkRH$k`AeGi2@-YThJrEZZR
+HccUH-l`IYN!c[4mB4@Cj2d``XldId!SehXm'RKR[KlCAkrh3iHZmRiYjc[&qf-[
+2pAlSY21m(jD)ThJrE%RV[Cp,HEkpibHK48MfbcUPUk[R1cTqNPU@Y-Cc1FphjAl
+DifC-ZHQ)Rf`LP$PAbHpeFQb)i-I1Fr'q%al&0+QH"lb"5T!!Vfhqp'[23T&RZmc
+('P-pParD6cLhG[b`N!"BFG#2dr8$UZ5+JhZ-UlYaJc3j`qmlf&*HkIf!8VR+q`(
+*N["l%G!Z5Eqh!4'6mRj!cD5p(j!!0DAH$qLE-Zm(K%iRl`F86fI["k42&qm(0&#
+jp`0LU+[h!kUSQrF$kUL(p`-bUDIh!hUTPrF$`UQhp`-+USrh!dVU11m(*0AahJp
+SUllH$iLX%l`I8&XRHMmJZ2Tj2k#mqRXr)-&1mRj!Le9i2b$V"RJrLhJ1p(i@mcc
+Cq`(Q-FMl1CARB1pR#FmKhXp5RN1p(l"G`lbIj6b(HcmVH)l`IPEb(1RpV1)jb[X
+jMHGSlqGdRTAHcaNmahJrCr)FkrfmKZFilqHe2-Gl2fIaR1$p3-N`dIZaT10lP"m
+)EVVr(b3""f5eq*L`b*fD[FTkdL#5l(9I,eZaf'P3I(D@calA"e`qV(GR1-9)F(A
+'V"8*hTHaE%@#paY3pEdCUe3Nq)"eMGXcaUe)F%h'1"8*VM@l1qepPm@chI4h@cc
+h@(ch@Mch@Ac[YrIp'F0A*2KYmrZ!qAd`BrZ+""qaH*rr9"5PDdI@,KpHdEpLid(
+5-T!!DQjBkL([jH&dH'cKXUkABcb[U``YmeFCfXqB1-FkK2Em[,'PEXadV3MrQkl
+1G-lBRQQp,8claDGZfcR(kq4)RfIL92AV-R%kZcr4Krh$iHlE0i9A[%LAr9LQQ$K
+r`HHPQ6MEqh3V%fHK6e[+Q6KY#T1l(3LP[@Gbjj2*hARE`Ndp!#ChZa36jp'k2kC
+PB1*FhEL$V9,l&UVPmlC36dphYSp@J$Km*Xlf1&SC"`YE-EdeY!,N3frlV!"aC*N
+iGmGaD0ZRfHFH+H9-R-lPiEhS&41R-heA+eJDhV4peFdl`fYHSfDLQ$M,'pKI&Gl
+8Z#HFIK"r!IYFQ)q$GHBcFEE(dFV%@BM$Cq)mNJqpCE%#e+[HXPJ"iZ!6eVJMHG9
+aZ%bF4q)i4V4KiS`Fm`h"XYFRkH265HBDlZkm#V[#4V!#Ic(CF4@hrcRRmKL'(9G
+rqpq+Yd",)r(&pZCfkri8eJRX9(b"h45ZCBr*6X8Af*9Fak1deBDT)AVVlbYJLC[
+Ve3FjZiGeDDLFMHhm8Zj[`#2Sj1aXjjGjh1MXVKBd8Di4MEk8ahaR0qVA&E"VPlL
+CaeKRYrM[C#"fhmrpaEk%cVeb0&,iGbA4YEYbS3V-YBZT!MXlZqfkc0fpKM4bpQG
+*JF5a6IfPe1VbD4ipR9hRMk!VXcMSGhfGh52##,YAR%BqrNk1f,l$f9hr3FAUfLA
+Tk-jmCpIicaKdX6Li[[diCeIr*qM+cBlH,AAcJ(``pQ"hTAblGJqp%PdhCcH)klk
+GSkdZKf,3hHVe34l6RGd8jDq(aI(f2)j2UAp4)qSEr%ELq,DcZdYRR[Db1+EQGA#
+(iZ2@9HbiAPrb9+EYEKqcqcFHRh0fN4pAMPflSI39ar*pVbie2plC$9-IZmrCI8H
+e4"qJrZKRPCQGm`ek@14NCcIZ6'UmNr2ArCm`)%Ee,D*I*XcZKlq*36rA$Z,8mi5
+hQlrq@##*Mm9(46e0e&rp1fjrr%H8iKhe00[%qhEAIJMeLI@dTYcjGL@k'VmVrZL
+l[PhXYr,kq0Dpk%ib1fT4qZ9`m5m)5M(fPlQrDbj(0m$X[T2hbmrV)[@"cQkQDNA
+keKTb(hQCXi[IN[I,Y(V'),1MRiQraekPJKFlkNrkj6A#f!ba[)l+qqAM!Ve5qm5
+YkYMdbqmTjQ(QMlU3!$karMI3U6V9GFBi+IhbIX8k`YPpNILkl(4f0k[hbH3liG9
+j[la)[Cim%0qEmhjjSAc4!iR[PVaZUPAhP@C(r8QIqqiDG'1FhF3,mhljePp4VEK
+f)c5h5,qm6A-*08)Fe*2%mB6Q@2U5qMBc2dQrG,kZbpNR1,[KUNqTJmIr3!&,(*r
+TpS2(d+Nmmc@SrU9IhX*X&l&*F4P-BUCIIRX8JmR1VNTa5,qm3GGe6E(mcHcdbqJ
+08*&&e,I9Yj8k-2hb(lk#3E@cZqbpHEpFShPVQK[2TY%A6Ep-d[-Le![I$-h-9eQ
+rp%k$GrlI"lVpdV1,A(jRYerkGX19Ap-[I6Y(IF6-Lmb)-bb[2mRljIhb3CkTTbr
+Pr[3HFCDcQkaeX26,kkp(4be6*Rkrr23JZKV,KkTMdrpkUjm*FLEeehRrHi0@"l,
+RL'Vl*2hebr)Rb*DSHV$%edeV$$Q9Gbhpcr6,1c3Eb3BjqS@m6b39!cNKhp54p-Y
+rr"Gd`[Vd6IT"ceh@Aj8ZXYVCV@(q0[ebLZUBANFFc"#QAbj(*rLjiBT(kZB+HRR
+%N!",`q92qYbYbJAcRIUZZ$E[Pl5Yb&UEQqPVdLq[&6IaBS[l+hNFCkYAbYVPM4r
+1jmX0QQY20Ar-0e)(kj3,HKhji#ejqUaf"%ZGhD@lmRjCU4`XFhCA[6R[Pb[NQjb
+6aRr1qf9Ap8TbcVM"[#VpmM(90R1FqUjRjf(kj51rJm%UCrF@,K`crA+FpJG)&I)
+'kYMdbbI8NpL(%$il$c0IqLIh[iPql$aJrG+h'ri,QU@NArTfSqLMfAlTfphiHr5
+SFq[Tq12l'kKGSQIA@`RqI$[RHZEDH&!D5P,f*I6@-jcK*&eR*RZM))jEbDXc6Gc
+-20jFkhb3!0k@YI2lpcP[9em8Zb#[l!ZNEZl46(LQc6%hj[9ArrISk!Q%4&h%RGd
+PkYR8"I9+McR(fAf9R8IN%UX2qV%EAq`8l9f%&Q+%qV%EAqbiGk!6iSDijQq*lfZ
+D$f3A@+9pJF4hmeqTX8TmAq[%PjMr'$UjHQf&pJjZI)NpUJq"MFC[l-5Aq"R0N!$
+#fA,e9Chi%Mpj!cT""Ur9r(Hfp3R[-QIReLXSHp-RI,[Yk*aG9QHHAH5eQZp0Rr$
+Y(QC'G-kh[Z,E6G+FimiCQ6Xe%lSlE1H8YhEQM-b[DTk3!(hLrFcKd[mb-qUjlZl
+6fFem)rd[Fj[f@-+EF`eab&b5ZIjK$'52ZC`q*(0*l5Y[3bHBQj'DPpaqRhRSAHK
+N[eQ9lldb[kEG'AP8hhZS'jP,-Tp6h3XUi1T[GZD5fT-e6l!cB5iN[a)(kiQ)l9[
+[T"r)A*+j8ce!GY8c0#Y,[Vq[2LHVk9'DNpbkchcd(R5bDrm2jNkCmfSAD*p"Me*
+IbIXkrD$fYCVjf48`"c$2ZrdJmk"fPTGEAf&qFqI4c'HdCpeQF6rDQ8FcIkCC5f"
+2LpJlb[a8frpqG(*ap5MfHDDH(U)@)p,6epR[Z206CNCaA1(XYM0cbra8qc,0a1a
+[eAHhqUJl2pAfDhDN(TNrf-ZiG9"lK[S%HalehB-2QCmbZc4RU,P-ckRXBGdj2[2
+RUJPfHZUEUGlTjURfaCTVfI23CPArNcQqpK9rV)BLF91hETePVY'-IUh0(qb'hIM
+UEP,2)Qrd&HC20lkk0fRq82-Xhk1DVGhik[j32CJH3MpM2b&er(AeD2EHc$(89Q8
+pH@)1@j29JGMjrA@NjX"5jLVkNZp['[0Rp*JX[XKbl@)rjH+H60h%cR9f%lA,B(G
+%(16HlG14,kPhX2p4hiHBUd`Ffp8$Q"29p`ccLBPMYRCEHQKApF%X+h&FS9apeX8
+G[6+2idRYHqM2bLl1AXI%FIhY@$aZGFNF*A&d9[mM2l4kVN#81,CU"rB&CjIqQcb
+1(kPf[qMLZ&BcQBlMbTR(Y)YKGU!pXT2V9!Gpkp@-VPIfYPq[4dmJT1pJhR,F2UC
+ESYdp[BZkB6Hfc0PpG!mkCR2Q(ZE22h9f3l3rrV,,dphd9kI2fAe#ZAM5fBeRab$
+aG6rU85cBEc"AX8Z3!2Jdf[UVcPpRj8$LqaI0Z*TM,a+H4efDq'lA(-"Fb@M'2#h
+jZd'pK$d`m9(6%Ymbc8,-T-V9*1de*Ei'cCI8S,+V)KmQ[KqSCp%EPFQ(U6Z6[j6
+Q''T"Q6a+hC[iIUbFXU2'MVf8a2F0p6"9[pKpK(R!a$G-ZrY[bHcr!3#3"!d,9'0
+X8fKPE'ac,VN(,iYd"cIeFJ#3#!Fhph4RU`#3%%*P!!#br`#3"2q3"%e08(*$9dP
+&!3#[[Qr$XQjqU3#3"3+2k!#3"ME&!!$,f`#3"N,c"J$&pZPQ#lY0MNBf)j[X6V)
+pr-)@[M$V1PFQcb0XBB4YYT!!BlBbmp[VXI8@DXHp&R)l,Tjk-TAGqXEa(m[I,XC
+DMYdQE$PG'+&NaaG1ET%X6pKf)F[aLhAZf&9Nkj&0EXF)f`hi3KEM#peN18,j3ME
+K&f(,bA)a[RJ5RSX$Zl`Sd1'9DNh+kqMaK3dfff3P#eR)-l,*M*2C3REijI"pjcI
+SE##hYkGC0V"&4eiMYjf[CHr#VR0VNlaFH+a"TjhjRBdk,r-beLfmJGIR`1[bmfh
+U,ClAjGQ)E"Fl,hkG9lbhJEhAahY[1A,,HpPj'3I'!JLimTX`E9E8LZjM84jE@(B
+,)fcKbr%"h3#-!!5-"ajj$3UZ@eC+c92+@+i5pcbT%VYH91VY,m2Q&dE#`+rrfYb
+L[GRb2-Iec*cREVF,3F2@NI*USPV`cU"Dj(IM"j4kKqLpHeK$mXi066fe@b8Qh)[
+a9Ep$aB9M-hri)ET8k$J-Xr[K)i%INIlhN!$A@L[TeLm9lVjKU[9(r`mhKSd&L3m
+f[D6(`mf&lHFZ5%SqTD%9[Zm2dmklI``Z-II8pIUA4k(X-mC262`UbPAIB+CVrX[
+,!bq*NUf2#8!18kd1JGV,S*!!M$""eB6PSbANc8YS@kX[qeYEI3Qei,U-@l8+lU8
+-Cp9bp42'UF6HaRqj"",U9iar0%ER,9FVN!#'kj6ked`X4Ch'Q+h*b@(2b!R$qS&
+FEl,QfGZFAImC$hm*Y8J`S#QcqDlq3VR(YSUfPmZPjRa'VeDTYVa6UC9Y%kjEPm2
+YGY-ZcR(m8QFZPeCUiA'!`%pd'%HGM!QSLK89X`pHS'f#h%&`CL1TQiM6Z"f`CjR
+a+H2Ca(HEf"09qLD6C#9(V(,F,+K&*`"L18"HRR4S43MeN!!+l!)+UXRP82p8FA)
++fhYI$eA[iVe2iV[2f3aTLmSP)-bA3EiGD4Cff$LZpp56Sh[Rrpcf'TK2!LaU0$b
+0K15r'GE0Pf[45*F!)IA8@b%RkaVcEN4N,c3(XKIihT*Di3mePC%LQ5CGT0D-iaI
+8P1Q46V8[CDEF5XdTfpkdmEQV9X,d4,[EVTkhR1e8GlcUdMDY#NQBlaHXmPbSDLe
+pVd91GFLIYYkrk!6ZM-ZCER8QaPR@6QXZI+f"rAF&RM86Ae[G$pb+qAjlpcfZ9jb
+ahUp3X(hIc&P"DFCdHYdT&eq,DIG9ljmY(LaR1,lPqhCPm*95`,a5@aKf*,GY4HV
+GljiV,GqiXl,D0Q339V&@jK)5fP1(C@rU-+qN$X1jA4XZ@(98kpa8Tep"b5fbbp1
+QKpTljM*pQ180fB'CYi2JI+TR`Q0VaUV93YZPT6Q!M#d,q"ME4["B-Y3b+0RCI1I
+M,f"MZh&3`,'a)Q0XBi!aYSKaXC*jKE$BYSL+XA%-LV&PM)QaC35**F-B9NV@lH8
+8i@%qFANiA'lE88`+K[N##E'`C0L6Xa!*5hB!BGQS8Td4$-D@-3V'PN83c%0$M)&
+L-DpNPkIa,l!UB&pJ&q&HE+3*MfeXAR1a&V#ZD"L8CQ#S'"IS$Ei&fKME5KP9'!V
+XLTJ@'-Ci&PM&@"CB46J@'m9i%&X@5b2#VPabmVK9X#XAKZ*9,ZNK9X9'(AN*-5U
+f!Crb"UAULR!TX)Sa+E!UiP'ZM'-XfRh9MMP#PMFYS&,H1)+QXU8QZfaS%ea)3J'
+T+YC"9HDY&E2b4JDimLBaHRA8J+*2hVL)BhRV'-cbTM'Lj8dM@#YEaKK50Ur89S4
+bKIcPSDlGZ,1b&23+Y4)LApQb0h8K"TB0!F,P9Kh9'N&LhM6'aEaT%4`,H"%MT-8
+$BcAEm@Gk*JIeQGPDi&5F2HFD)`CP$UN(063KPeXHNCQfQQ-9XRNcBb-jlH3cMV6
+FD0"!biB5Cfa8$M-J"h')HDkRiH@0*,6!S"a@[UcLf*E$X3Dih&+Lc&Z93rAKU4H
+T5`jLX#jC&a'Lj#!2%LAc'1p,eK(N9iaMk+ai825Xf&US,"G&([ill3-'8,Eh58$
+*,LlYNR98h4h'h3Qcj9mbI"!"LMbbbd&2ZL0k8c&qS%a$NP1aKHGd'(D93maf5YB
+ai5PC&`Kmb6lLm"AMVP3@fNh6Zep[q9M6BY2(fLh[@9M68JI0'KCE4GDZd#b+c)T
+YQFJfejL*V0V6@fSDj5fMYP&J'651V%@4EeQl!Z1+cCBR)q4LeU4#mUcamQCJ`E3
+pIB8q9f6@99,jAPGNTGfZf+5Ff',(bpVe6L2-X!IV3d1fCfSd+9M2l-qp1Yi!L1f
+rUf#M'"GA#8dPpPf-+cE1K9@D2#K&&4$QBN5"B5kDZ+GELL42LS[Kj+ec-CAlF+A
+!5KKIM+e-Ki2`+[bJ&''qqRBadeCeU'i"UcUR5+D%b0-+k$R*XaK)`AlUh+60VQC
+R%8e"m5LS"YC+$[*&fKjml+!FHf`HKKlE95)2#VSpkX#i((&J'NBEf&3LcCGjHlK
+j$q@BmrCKi(R$5[3P&'K23-P*13FP&f%D5VD96$J@APeVk,$r-A(XccSRpQij0qZ
+j2Tj!f6lF+(%k"kV!I6#0QTri$hFb5-KE3'BJ0i*XJ4`(@3rC"$N5FL,NPT!!Nm*
+4cRM39`C!%j!!5FJ8j&M)@XJdC!Db#E)4XJ&b&()`Y-bLkaehPapBiFmCEq#&30i
+F+r`jS@ZA%r4Be5,Tm-02TVh(6NcH,bhG![)8$pq,hHciKmPl5G-fN!#YN!!Cb%Q
+3!&Y"ELef@d#f30C$6Y"6[(%J$S48Z9$H%b$P%-#$H'Bm$6LQkG9@CYYTDA+28jY
+aH(4[cYcBH8FR9'k'V4DjUIHFc4TH*-M@0q8Hm4kK8*Y#MSGXKC`)kqp#hJRj2FM
+[3ji-Z3$b&-K6)9m!q8*)GL1G"VN)mL6),d21Kc`(mRM)[i0m1H3bb"-J,i9N3[m
+ib1G$XVU!fMXG%Zi"i3BS6Q3*LM`,mQc)Bb#I"hNcj,'3!(m#q32)Zb$[K[`Kj+X
+KVi#m%[)eN!#A3li+mV@3!+q$P'e%hUp$hJ,j5XL[3,iHmJf3!'q%I"-N62*Ub$G
+$[JAbcb(I#[Nf50Nbi(dFmKf3!+q!I#INZb#r#RN0j,XKEi@m$I*VN!"r,pM"hSp
+4N!#M)9P4`$U!-C!!Bb(C4Y!!qAR)6&LcE'c`e#R)mb"I"#PG!BqFqha)0Q`)HTR
+p)H-J0iCNaG+QN!$M#8pDhCY"ELl)!Q*mJCJL%Ri$F0d1qAA)Ed"q%h*lb"dJGi5
+8I36HcC!!ci$F'A)Ab#Q3!$#lQb#hKR`Qj$D3!(m0H3(N5b#hKE`3NRl!*-LY)+G
+#lJUj'q6ZN!"l31i*#5ke31i&13eb!Q3Vj"FK`CmY)6m)q5()$d0H#rPHb!p!bUi
+%laMN4b$I!rPqb)p#AJpj!q6()$m1+Bc61`(j5FJE)6m&q@R)cd"q&K)@qMl)1b#
+r"IPYb1p!cS,mBdKKV9i'mN$)Jb!2KM`%FLlN!C!!I`-*Q$mAFJENhd*H"(Naj2k
+3!#q$[!35$M%GmMQ3!)G#cS-m$2*`b#-JCd,Z$ANNj&'3!-q#I$ENPb$KX'E0K(2
+KfGaCl+DqE@f6Br*)cC)rDS)k!5I!"2!$,N$1`3rb6Hl*,6NQlq!hq!p()2p`#(!
+5c!$(`!GiJH8%e"4e"1q!Fm!Ai!j`"I!6RJ"'J8&J)*J*6i'[J%p`&c#&'UDZUA&
+`'#bMeX")X)SkT+BY6S&0e,DY3fS6c!,r`$8`%9`&hm"-m"lX"CI"Gc!26)A$`)R
+!AS[VB#ki$Tl``!3`'`i!YS1rB$jF!D`%Km!GX"8H!HF#-q&*CTq3!1)pH!5'`MR
+J"Q!4q!9rJRI"cq"3F#a`$Ni"0i0$`22J+A!4Z!Qm#li"*i'l`IRJ#Dk$4l4ZQZH
+-fDr8er+eM4lEhY@@,cp"blA5Q''dU[6+a4DhI2hfL5ZKQe6Sq`$+p@3HTQ%M2lD
+PRI2mC+5Vqdc`!MB`#9ma'jM3,pBP*ac1Mq2db9E@S'lYcXI(3#&HZfJHkGZ10%T
+Nmc4Sj*GkPE)@"Z)@@"d&iPYHak1DU(V+hmV-Upe#,@DR`*B`9madLM`D$T0CQ5+
+hZ3*1b6FEl+`QqEIT&'UXM00X#AZhm6RMqiNA*VG#PQ[6!I3F%6-+DjKNrdj"H42
+KSFqq"PbLaliE9T6U!'EdZ!`HQHBQh,T@--jf13f&iG(fSc89'0KqCf!3aJahY3b
+8(TDr1pM[YeRmSlGQAG0$J`[ak#[kl02[rpPZ%[dhqS)mHTZf9mkm!*!!cQ-'`*!
+!@(Rdp1N4mZJ[@cj0,jPH*Bpj"rTX2(V)p-ji2iDNEmIl0dMUK2554rTUk1MadEG
+$4bm926VkI[32dG&A*2rSk*25Sd0(rj8q+6TkS[3FdG%(TBH)MTiT[84dc$I33d4
+($jeidG%6TiH)MPc50d6(c!Ip8R6hiSHH)lTIi)FH,H9*,ZQISL-Ap(l4d8HP$iZ
+1hU-L6**SS00K5IBJkCHLSip*cY(4lk3[LJlQTVh'*(X+p&(48D2dQ0(4rkI(M)j
+FdS0'ap`*r@"dc,'3!"0dpq'([LfkAq1(qJ*H`!M`""ee52mA(IQP$ic1pRl4d5Z
+L0ib1ALVpB(6dR1NKSk2[M%pdB!apCR6-M5KV66&RfYp2FBl%ah9[(QGDk*qMqeI
+mk0"3$A'0IM3kkTEk3NHq`!Gdp(VT%k-$KHNES`-RX%9(rjNH1$TQBV6h9F0C'2V
+Mk-!rq[VSQ+fJGik113GkrZLB(G(qG3ea!KU!lTHN!lk1)8M$"Y#"PBB9L!jXJK5
+J!`ZB*8"(AF%0d*&(`a&%4jrE%!M4dBG'Mikj"2V8k*MhSFq0MPa5QqM!#@B1d)(
+Ip-(4-Dm$Ad!(CS0,PNS`Qi!1(+FrMSimd6G(4jdcji#12&&Ik-J&q8%((Y"64dG
+RJMN%G1!Ch!3GH)BIG-`6-Gq!MPN@jL,3-@F$6U*MYNLE1@RLK(,%02E5QlN)G,r
+"MmjbCXKKG*!!180ZS#3h3mb&,k!$"jP43!IZ`*A38I2D--b`CTKG3%IZ`""da+P
+GP`cR4-"`G-a)JB(Sb$'fk*MAS@E4-DZM(CS-jfQB,8&(MZ%[k*K"Bai&(68+Gd2
+h(rKK2N9HP[b0149di$IeKBiFqaYKh6F[#4`2eZ@lAPjcHbUl[U[GE&rIfGq*hlQ
+pUAiKY+k84l2AhrdL5f6@Ka"dHQN(eDa2GfmTl(#+h0&bC"iMX!pMc*UH@$be80M
+$VEN9&c$RA0F+KHdMGA5Ya'A,H&qVf,9LjKq'f"Z2Q0D1Zqr[JMdqXp(6Ua0E54r
+pQ`3LT+Hc1[1P6)Pb3TK,lE!PP'19XApS(8EmBB1"GeH!K38,UPE`4[JZQcNc9mb
+NKi[LqJEA4%Bd+mi$TVKf'Sff00h`TeL10C!!@1LDQqN$fSHQE9JV48MId23,V@X
+DKUC4L!&XG!ehK9(0[q$$0I0Xa5#E-REJZIIBhJlIC+'ejTIfQ6FC(8FI-6UfV4h
+)QRdp*A@MQHIIp2BEeLKM%cB#62amf`dEp48'LQ%'1#Em[6#)j%KLc@22U!-($Sc
+,a*Q(YkTRRhef8Pk&HF0)rrl$KmrjH%5fjl6LUaLlqd(Hq*R2a#6%DCml)ZrJ3jH
+YN`!IIKHlBkkADiIGad`-ZqXUdI`VBd8IHVLIf'TV$rIJS2(Ck[eb1iVm'lBDkJ0
+Ce&IYqZdVE,8DFlXqHRejU1DU+jDUA6'ZeA'XcGqkq,Vb2qL[2HiZ2f[VCRA09Z1
+`A)2HRHhf-APT*hpTipR*AkEPE010#6!lqFYNTChmCD1@lHqcjFT1r[i88[ZIM'l
+BbGm%*epemMI"6V01rLBiCDK6'@Dk9LGr%p`dTT1r#@kSdXRI"+IBG2)h`HeNG[,
+h[r#MNlp*jPJRIj1FAYA*hb3R-RAb0mP*3Chm6A)56LGrcI5V6[iQZ3&,*hq6h'U
+QNlp*l&QdNlmTeSC1rUBirD'6[bP1,qVNEiVp6Thm6A'#8#Gr8j`-eFRI&,HHkH4
+[LYZcG2)ha8ea1[QEiJ5LNZXDeV"1rYB`,cVj@m1DeXRI'MCIGI+hKK101[PV*P*
+emVH'FH[NE`dhGZRNE`fhGZRNEmhAmD16[l@X@jhmV@A-1[PEbdPFRIbYjD5T6[l
+@XQZYNlqeh!URNlqeh25QNlqeh##QNlqeh*bQNlqe,q"(*hr6a"'Gr%fc(R6bedb
+*kZ4[QTeRR@*)XljemMI0+8QGr%ec@je1rUBjUDf6[fPZAY2*hc4cS*1rCJ*8*hr
+6[%T-*hmca#DGr-f`$R6b0m2iGI)h`rV6,S#Ck06*h``R,(AbedaZkZ4[KY[BG2)
+h`iP8RIc0X#qRNlqCV`P@!lpJJ%lqCSN"1[QECGhUj'q@HGI*hbcrGI)hbbPBRIc
+0%[pdmMI,cA`kqCXPrZRNEjEiTj1rfHIaSj1rGF4iRIbY)bEUj'mGke`RIqZB#jh
+mVH1NV%lqeR&b9#GrkaLh6[l@F@T94ilUZ192*hrVL%-kq9Y2,U'6[rA%4*hmV@H
+qGI+hR[(Vj'mp*fYemVHHf`TemVHH,&mRIqZCBjhmV@p1rYCr$cmkqGY!2U#6[`h
+%1jhmE@$0ki4'!r1SNlm0R-69bGm'EMl8b9rfYGV*h`ELM8lq0Tc&Mdlq0T+ck44
+1)q2@bGp'BV&1rMB5&h6bYj'jeXRI4Q+-pYXEZEG(*hmE'EG1rMCb3k01rMCb`k0
+1rMCq!cmkq6Z#I%`RIdH3!&ISj1m)BU91rSiJAX!Td*%l0N1LSkDC8NE(TN$`(af
+E!*NN4mH8-CXPjBdN0i2hSD1fQ1T("fkaF4)GY3H'Sm-AYBb1$BCXS%6(T$qE*p(
+GJamQeH8eNG1bU3%G(!cX43G2S%E3JB28+6VUM4bLBe-P'b[4XH%326Sf'V,"%Ke
+6i@bbP$H+I*+0PZMJ5r!GG1!lR!XG'!5R4NHG-*f1$Pl#GJ"dE!0Jmb8klRaMdPi
+HTcDCMBhS`(if,D+METJ!4dHXa))1V'6M)cT`!Dk"MRU!Ak0M#`GeK)lYL0S"'me
+0S'b%42FVr-!,j)dKhmBR1MJC@`c3`FHBVNF(pS2Rk-JhQb24N31`#"fe"$kJ``B
+qL!lXCjX!1MJ(facNM5ARCY-N1R*22D+$Zm+GdF(CG!rb@2)6qKAS`'+fIk)$,pM
+FLBlDJ!1L!crJAqMBD-(@6(R0l*A3Id!(2kFfdGPYNZM!BcCpS)0,X#N$(AM(GP9
+de$CF!adaJ-2Sk*d3Zlb0b+[BRS!1h'AV+6Si*02lk1!ce!Jkm"SHJ3jFB2XS1[*
+#I`BGI3Xf5XJc,4%i2MU`N!$Y+ZMJVq!c1R!GI%-(4k)AJ3iFeeQ4FF310JLJ)ip
+X0N%(lS)EmMCQ2iKH$6TU&'k&$Ki,ld"(I1#EJqM&"aH`-E`e2%[!blLia@CafF)
+&%-GlPVGEC6D,DS%GALpJ$9ZaZEbecrEGZSI$-,`JA'QqAkh@@h@#C)(k`faI0'+
+C8k)jC(!lP!ZG`3V#hE(S0R4HEaA6a5q`#ME#p2+pfB%Y55a[hT(D16Jp`r`IQHU
+V9h'!a8QKfAkEmVeQUZ&&8V3$G4+3!)CZNl6Me!%ZAUi3(L1a`#kDHMiMGje"P'J
+[5R)dc,&MV9#LQcf6(8Qr9"i29LTJS9-)lb#3!(K&'k9UcQE4STcVfDmN`-EDZXc
+%`3EQXJ*[BYZlc)pX0hA+J8N9IX4P,P08JEJa9@#ZbM!D[jiNKU"`CPV,EhG@V#V
+HP'UBDCQ*ZV9KE3bRR6[i6UaDHbXee`Y-k,ee9VRXZP8NFf'0Z1%IeB'P+29'$E4
+b#)DRMm6`YU5b'cC-a#!RCN6U1'DlkRjD!kjD8Aej(kC!`Vb)hX[N0NqUE@C8UCP
+"'dC[M1HPJ5a"*4`hAJQq(5Jc)jd1YIR+bYPEE3(*a+))$@+LqJ,HGB5[[U+)3rH
+NTAKTJkd68bDqmAE6QI#YJS!LZ-UG35)PThi-l&'-2QBZ$kqpH[d3b*,a$cF3FiP
+haa1d$FL'U(1f2KK!@N*rIT%%,XJ2Pjp%,N!p[&SX*eX"23"(Bd1,Q(JdD6@`9dJ
+B%4D0L`84N!!#Je3q*KIa18qVr("%)HHb,,6pJZI8!Pd3S8%ZjXL,$65d-INiGFC
+6P+@mTDQZNNQ"em$XTRH$Yq9Z1SQaGhUhCJ8Ri)+,a@8lk3Ie3CqFle6i2c$GYG1
+Z"U(H"(4)[K-kSk#ilF8Ti3NXUSX1jbQF*j1r5DC`L%cqqTMij*M5C55&%h[bam$
+NcL5*,hq*,QXTRG-5CY3HcK*Gba+Ib",IaG*qN!"4G'T8kELSm*bSiK&"hSAl2FV
+RHS6AH951m9$1,V'GX-iYlYEFhIhpp2l)M"a6@eKM,9VYc[Z(5XK3d8Srp+EV@Rk
+BYkK[qD'Iha$jX51**6r-(ME1q['DITK&(0Q+KaQLdE0q,QVk-4G&2*K(jKLI14G
+hU'#QCZq@(fBHRphb``cNl-K2ac)A[Fdb2CI(8-(Xj'9ArH3+`!bFPUG30eJ4r*M
+RLVRdSDm#)*[f'KRQc(+q(&#E5A6dd@iQiHR'Kf!cbC2E4b+pIB1E5BVqUh'[bdq
+8Mbkr$m8p[*eP4Gfi!qT[R4rhJHbV`ICDlF33Ebc@l0)'*m6pA3k!Plff&G1YmU4
+h-Q*U,V2dbKH"Xi[&`A!4H2'jRcSA%fq6M6$K6V@qcS8EJ$dAp#Xk&i2GKZ,r1[E
+FVZq+HcMIrjF2pd(FkrDCpG9NPlrU,VCL21f[&)GEEJ1SZ6a(pRrPjUALYPD`09h
+mX&IZ`*BIGMd0c(2TlZaM@hl-*50GFh1K(hE8lGIb`rcDISejLmkj0,&L4pUc@Rk
+BAfZ)$r$MMVRL5SBJ4jhEPl(Q4HFPZJ'D0bZ2$$#Y)VI!!`JDql*C@BhR[h4hhm$
+i9@L*"G&+(*PXRGQElS,2C[P2bRp+rQZDRT0YjeESj"c@bRm8DQV4j)SGQ4G9*aR
+jVq-r0dcUIk2B@6p0mMpDl%Ia(hcRR`XUq4Iifd,daTri-I(*Ie-c'69K$bqhTb+
+AZK(L2G2dPPNiX5G(dUS4Q65,VaD*I),%B$-h9M,8dSbPIJPM#GIRq-Y[0!(3+Id
+IM`@A6V1$)DA$EMI+r'mU!Rl5FGU#8q"5-$EGTX,q-IH'X[-l)8Y+(@q22S3"%2"
+JfK!hV5`Sa,B"!m48jiqj)d6`i$3V[Jd,#RK3bd[5p1EVHI8DYmj0Ncf!,M@!X(J
+JI*%E%)Yi%23&h@Q)%1)"ppF)(Z5QdZB&f,NkhbZ1GebRKAXQTkecUR&Qk'$aJ*Z
+Q9q'"q9YFUEM9eERk)0VTVEh93VPHM!NM%5%HC+lKJE"+*aNBj2%JUrZ,,*@H(m5
+hY4K$2+M6H$!YihSfPq%Z0@p0hTkm,@i0'8)mU1HN8QRKXR2ejHpHF,)mCpb-)T2
+FmLXh%KYeprjLmF1G(J2lPF82HiklpN3%`BNIpN3mUq@(IF2Gqjp$2a`YdVhA1I6
+$(6VGqjT$2qc2f(3f(VfAa[KKImE!2JkaBRp'erlXb!rhPR6YiilmF"Y5ejlYb!p
+h)hAYG5ljbHh2H'#8hL'r0pN*fdZ-VmPaXcaRA#r4%E,Aei&`8k[Bd)a,d9BNCjb
+0J15Ze64NKJN3f33j%T*6[TVPkJSAa8fd5E@`l5Vp(ar@`["M05a,`G`!FFc*T1A
+'ZjjA1'QTmZENdR,lhA!F4kENYVbRmhTS[Qmf`M9a(0DeT6mj@&)&hqp3aRIfU88
+E)b6-(JjemBe2&K$Hm,&3PmL2KVHjQ6Mk6m5*ci2UI(iFcj!!@`Ar%-F$#ANiMJI
+@42mqMK@"$-9adUkD'RPLVklADdqAaVkpeU#q'HHD0Hjq,$bfUJ@%*0XGhY'A'$R
+H"[[VM*%6@if$E`Y[-c4ak09mMqI$R"K2(!q84q%5V0km,X'G4Sk!114-VbIbbJ*
+@'dFI%Jh&dGmPT9bVcm5a9*8ZiE6Hef@!fTS@FCVMZkUaPJld@[lNIM1pDr$r(rc
+M$0q,!6JXL6M-f9,pVh"R@19a`*3E)!kH1A,YLFHD6'AFiFe2KHIqB0cPkfMe2F+
+iHq*`"M$Z3pCYP#XqHelKkV6+Fh``pqkX2X,F"q*BaG`(iPM&h&I'm6[QASfMbYa
+jbY`6qjGXM3&JlThjH)bjpb4f$A1[aV'+ZAH'm5KcVmE4cp`PMJ(blM2hNiEqYqk
+G(ibEfq3Ula('h4d(ca(!Z)pdUVHpepbeDZ8Xikll%@151&BJ`d1-D5#198aRC4b
+rBcV91"j#mXii(NAbDKcpS#Ga50f[C1EQ9X$H&hBNHLY%iPJm+,I*GMbjZ'iJMVV
+-$kB`XjP-5Ll6IIVp&[(N0$iUF@8F#kp`4BQ$+qjcpr&e9[5*YPb$1jcABFi3F1P
+q6Mi84a8jqqXXU)mc,jICEep$H1K*,mD-$,Z2mkZI49HTZ`[9rR*GU,Z('pe(*d!
+FE@AI9i!B!C!!lMJ%kmQVGkP2EVU'6S"mQ'kI%b!1fqhVLf1SfhGb8#QVBlKEK$L
+@iEEBa)H0Tk%IGhH(-AbUTJiE4ljir0KHip$l##Cb'h96&IB[0BjmBEdar&aiLkb
+*ia4@88mq"ZY-Zb`,DKIVP4D,!D,H1,K8aZ0"0m0eElSX6S"k09d@*d!F2"r1j!E
+V*r*UiT!!m["qA"m(Ze@jalNVJA-bZ4L!V3"XdUp5$fpar-6N3e[frSZp+IrC'ZY
+lKX-i!H+BYGhEPS4m-Uq`8RI&c',IDqG#aCIM3NrA4ii,29f[lS"C-F1&K[%$"$l
+DUIe`!QF`Vqk*cM921G96H69ap0m304K(GF6,HfImfiaAhaYL1QkP'DrKjeLDm9T
+5Zma1UhPe%8ajbkcBm(1!c)Te!XLMXf,G51d+Q"@,,PHZ[%cm"(0h9$"6*`"bZK@
+3!'V`$Hc*FhrdG"`ZQh,kRS1J&q-'fT3cr"a,Qh+'HM%GJ6J*0ZkXH,TaCm9cEfh
+FUBlrHfea&I2rUaLFHf12`%2-Uc11ajKA6d,@-+pU(-k*r3K$c+XM%,I!RJ8r$R1
+*A[FM#,PZa#F&[AlF!)c!a1'8f2Z`!BjbJeaZALREQ&GbbFfRe-E1cDHNiqAQ'EQ
+"I81)B9l*FBB(DqH9A'4JN!$(!kIqcF6qCPmhkjf6FYlN[**GMQZjFC,RMVYcNYP
+90mfVKCLIG#rG64RF4ZNC@!q*j+b3!+01aL$N*X()9CI%#NI"F[-jAejcHbUl[U[
+GE&rIfGq*hlQpUIlfH*8##2Sk[EH@1%qIR-rQL,f&A4j(RR-G,IrCakXIqS45Gpi
+eib3GaiB,j5Hp,KG-pmJ-5SeTF-I@jDN0'I44Y[Y4#1*iYQi*0Kb2"fJ%KSdq6`d
+B`mD#a!HR2+5q`MqUeaP3`6)KP(q*m#Tmempc1e`"(C5a!q%Fk0c4e!ZXXV2RbL&
+YICAbC,NF&k$VZD"U"@q%EmM3@-d#@N-DX,4d5ke@Q+3"f&Q89`4f-66q+km4%Xj
+I"pN!#CK6NM!mU$ilbRMd"*+3!1k&k3rLRhreTM!Ac12#Y9QGGh450M8Rqmh0H21
+@pTNh'4e((c%kYUdGb*Tp259eSjRRhr6f'pBSBp-*TAlkmfdhE&4$jN"@!iFI9p,
+X15UD@a0V(RZ')k&',Iq*-`p[RG!(XUL[f[AEYqGd)1CfII6kmP$099FX9EYLA+[
+M@*ZrGI&ejAr3Ah[FAAl@eXhUQZf*`jPfVIQKiBAIjQ9l(Z"[j3V-Rlm8kK)2(6c
+%I`I6$8Sll9NlFIY[N[VS@R06[rkej[2p(5EXrAUpEc4X0lV!VM8[ih6P@[-#6V[
+0Vc9h)M"h0p!PMhh-hID0h3(-h5eeVIP`h@r3-PaVIYfbTp"9kZj#YEpF&qVU3ih
+ZSa-JM[+ejZ8i+PGT&lTLTQ[S"-L(kIBj!H))VMA[M@1SffFZP*ip(&eVRTbIf!+
+pA'ZHA2b"%I9mBZAqPp-R%qESDEL8Dme(RBApja)VlpfA@(aI4b-1Fk&d6ci'kka
+mVANjMXUejS8ibYHDVmq(kE)i!HV9G&QF!((`mYHDVmqVL51qeRap("Z)0YHD1qB
+fF3ClJZjmHlKTf%'eLE-&+pTeVj2BhXTk6DkieiaIfm4Ca'NAr#E1TjLl#fN6TcI
+1h"0IIVSM"S#jZl3fF3l8r3BY`bE1Rhhb5f#Vrlea-0H&f[*SSr[S")MMm8fFaDk
+Bk4Sk!I*KZRe1J$KXYkm[MU&ZhmT0R([FHQ%6jal,cfrLl-R(B*dp[SQc'-IMQcL
+,FCJZLa1JANfAa3N3"frG*XjLANdFrl1*XaM("U,0*NkZH8f&IfQXKKN4(hF,YKa
+0HMrR0JdH6"ZbUlER&',EJ)($lX!$qDh4H(#D&Gq'"38mU-8Qjm4U2D!bVeiMejc
+@BeY&fr2Me!$#iS(`aF4j2*!!GXBCPZIB-@U)%1*"mM`HL0De4K&#2%KT2-KGFMd
+[X+T&bbYL3!+@F0lU6$jYTPD[FkTaCZ"Jm8$kcCRraJ2cYlK5FDZVFrA"XP-`HkZ
+&FVdB%dBU3cc)AX-$iC&1-M$)id'GlMHIJ2@Gmi2iYTCcL!Ie'JqQC9c2hS#&VN[
+0@j1h*fq,@d1'%!mDS+UPLGLBcHEQ-DALUIE(Gacq9D@'BJ*fF$LlhYL%aSF)&hC
+qI2ZZIU9+[a[VKJXEcAX&&`l3Z$#6BplZYYF+%LR3%12#&1,#r@0RAYqcl%4ldd%
+@-Y1id!CF1(aXl-@IMA&$"Aph!VM!lS6'rkY3l%j`b-h+Tf2RCZ9Aldj`Smh+Cf2
+RCZ9eGi*$EPDq2YbZiUCj5DcQ&D`dRr2P0EHRXZZlfXhfpChpRILGfj[UEipA+3!
+R$!BiBTkJ3-)`hJ6#*,m$hX+G!DXTeZ#'EQ&Za*p*k#`)2ZA6NIKd``qKelAm-1'
+HEIPK3m+@$6r*D$"HhN902fRmMSRma2%NQRkBP*h8m*1DM#H+QkdZHmlk#B)c%lH
+H@Yhbdi6II9TqU1*p@hl'i(Gf9$mG&5pqaZ)h29GRSCpQr#kJZCN-kiHE`%m9`0c
+lIS5G$9`2jMapE4Xb!,pVmNkP9VEl#c%!Ya!j1*icES1*-ki(lXCj'dQleKdh0b,
+AQ)Nm6EB),JThK(R+PHea5f3mj(6C2RQ'S-BPm[pbq9mQrjI+rp*`eX&6J@bj28[
+XcTErFb6HFd9rRX6l)SRra4,[q4,r"I,r%[&hB6M$`HNp[[iLmAmaTNKj,`[MGKA
+-a)b3!(mL`K'C*&Sb4PE)"&NN%r@3!%b(8!dMBcC3JDcC8L$6C*K-GfACVhHh`U1
+k(4KPY!qHZAE1E(bHNHlH8YMK&(1HZhec2VcQkQJNFI,&!'T3EAhfak!5Zqee#q6
+ifCQHB0C*r*JD$[bNAjYe%MpEi(I'V*mJ12(6JYrp@hiQi(GQ`dpQdXp&66rFTTQ
+Ef5VN-I5c*Ai(CTh%cb6L9hA@5IaX4Dald!pE0EYRf8)rfq"hB-E+qYN!4*LamRN
+K2"mH#GH(L0K0j&(h`qr(Z"GH8LeXZhTZj2MiVQXM6fMFDcdV1R-YHcM8Y9mEQAM
+`Bk%ZN4mGjVq$kGV)@jp!2jCk[ICdDHcED`hUQlq)[Y*jMi@1@X!hXYhKlGf*NH0
+YX,r1'$Qae6MiYYXEFEL6VShXRj@91!B1KG3V)8qqK00k*D3"DQYDa'RheT@3!-U
+iHmDZh4q-f`&dXl9MJEQlJ@kfAXAF%rZAE)d"B1lZRjZYh3+h9JrA[32NeZT6Ar2
+ak+h9RA(`(!'-ZhUBDeeFa9fZcSPl@Yd6GkFk!Hj&03MMP,M2Y#lcqYAArXYQ-UQ
+HDr$ArAk,H'fk%PI'XI!+9j3i&PUqcchP5l#DYTMFS+*2Y,I&"14eQ$-%A,UIN`r
+&88A1rMS,kZ2-(ab9r1"Vf'MYY#jKc-L`qcLrqPPdPEUl81d[ei@kHlM4IA3#a0&
+@pRd&L"%!kBj$X*kmHTIkj+CVk!6)KqRf13(LX0fq[ML'ZRdR"j@b1SDpYX5aE!6
+@bibRS4phGiFaI+UQEMD1Y+mkYYFip$k#b5CBNVJ)pLmeMPcrCmE`Fr#RFCc#+ZV
+*af#GDCGP3HeL[G*P-8$8'mI4[6P6*IGFMQ-`(kE,iJ5S9p0PF3,%`I2Kc2ZI[*S
+iT$bm(pI(`@jepJ4pkh"1*KF$X"Z1#fQUe-0E($maqG#@[IpLEmTrYXEkRZ%`6S!
+iCQhhYL8KRm`VV04aFL'pi8*2edH1#ceGVqk!MV2K3X2i!3)IlG4q1)%cQ&Ih41H
+DTjcUUEbD11"8`r8aX&PcXrLh'Dqq0m4dh%ScAX22X66M0A54I%FJMS*CXH(R!*N
+9k`53!%GRaEU4fK8`+qBcpcQf0c6E&-h%6c"h4`8cG3)JTeX"U3CIG9'1!k5Rih$
+CP02h(!5p'$I3TTcKjeMDP$28LqN)a%A3LhR!KflF@I(F@aYhUZ2rAPYFaIcr+JE
+RhYJMm"$ckScM-HE9Nj!!0FbV'SGcBMr#%22U#-3YX'I"Mq1Nbh9'%(+ePNm+H[f
+i!4L"LF-TXII"RED*mp"`Hk0jfCl``Z$+K2r2A`TeLBF1(Z+rJkQrZ01HY40lRC,
+8fle1YY'NQcMRqcY-f2[eHYpSH+q"@fS6jqrlJZ%QcM*19cCa&R$DEEk*diR!h0e
+!8pTpc0eH1Z%1B1l1SdfF$qr3PZRUiEVIS'ABa(RGXUI39HVZ3V@rA"IUkN10lU-
+6))lb*Xjb(*@0Ji@ZQ1ND1J(bBETp6S!iJNfF[A%-GI[-pVRC`p%QcZ6ma"ESC40
+RF[%(4Y6cLCAlAdkI6*LMTq&50R'11J[lcb9@hVX[XILqMNBFC[YF6ci'kkbmLE-
+F4f86Cb'1mLE1pIN`A4BR3,fD,SX6)!jHIK2RqVbD11*0R1[Mf%#dfF5j)Cp`#rH
+'X`CcmTrm)b)!&D@,"NrG-aAKj-%2"d94Z!%a,@'m+4(q$RKM6&LIH1b,b9f"#dk
+CZJpVG81"!5FEql,CrJQMG(II`2KQL-5#rN,Cc*IX-YH`e@lS6AI"Cl2m*q8r*Im
+EbAp0-i*N@mB0A-mYFprjmClPlDD41V)"45'R&Q'0KZpU3EJQBk3ibFKr(IrPDT!
+!"[P[&$[VTdRq4i[p+2kRP$,j,i"Pr03Up5l4'hrLam3Rrdh0C05mPIQAC4b,kei
+Kc)C0h3MaRQPkbbbNYebDda+45E2iDT()*dJ-0R0M*8-Yc9MUPc!@pYmY+&L"Jle
+VE@k4LaK0!X6CT[)r2R5hlr`(YRpeV2Nb(rh)hJPplRhMdI$pkY'A%+@8p5DUiJI
+6Qi!1ack3!%ED&EE[6Ii'DJ+l4G0!-SA'BVGJbQlqH"`5AqSVNGeHf!q6fD[MLqb
+f4ha*fNPmN9eQ+8YLLBHV+*+RILC#mZ44r'bPl@lNVLSP*-Nl)hml$""9e1jfr,a
+@flhbMeMJ#MVXNCqPlIEi$d+GEeIl([cXUHf1iFDqY16lD2b-d(C04-q-YXYbrmR
+1fZjbVZ(+LYh98AcArLPdGGTZ&[c9L0dPIm@FDI8IKCpQEEIT%ZJD*'kfTilAGTr
+k!Y(EYb1Ac8HehHXBm`LT'mPIBVkfHpi[%8be$VKrIa0YGrJ+k*SN[Vq+kZEMRi0
+1Z9k+G6C5fhhLYk!EVHff42dQVY0fRrp0')b4ZZ(qJVfeh3cQEkc%mCNSMLrakQe
+Xj@hp!Z,iYVElm+-`f%Mmh4c9`3FBhcM*(pXP08rM2J(GaYTZUc[`Fj1fDlL21IE
+YGX)DRB6Nqb2%J%dP6papm&jYGmrGV#fYearKCdGYPrKRk$E6G[X#Nj+,Y&e,(``
+fehCrJEM6B[I[a*3YY0d0L'rUEfLl,Ai0"Ld5(e[6@LZ"6h`0@HPT`-[-@bT"Z28
+bY,ZH1GZc%T6G+EXd,b!C"ArJEQKAfm6,(l2@*dKpIc(#bpeZB3l8EPRNliS[3cG
+4q-rj%9lHpK3,A[hp,-+c4Gq($Nb'!S#rLTI0cc"@c3HiShKjbd%@[1B[a-XV(S&
+Z'l%,mI*@BXDffZijU'H,PrGb,G0Nm8Hp+NkFqehSYY0fGF3MaFXErKUk2p*f2m@
+raFYhXYCdbp61pdGiH3jh+i(ra-'riXIC"k#MGX!KI'MGl2mpBSEL&VGP+-lpj'%
+#N!"[Ya[`hH,PkmmbB)d2EU&iqElIJfiA`BQT84bh%brK@I*frfL%Paka!6r%38e
+S(Ga'E+,fi3(JZ-8$X'!hEEFrm9(amYej"UCf8VX@,hrmac$B3h!DI&5mI-[2XpC
+pZdRNMiUAep2AAYVZi$q*m2+H,!bQDEX2246KjD*[`Z#C'PCffK6Kj9KLbGk5ekm
+em6*X1Vd(H*PH+hJCfNhk+QY,m6+dUqpXiQ9SPb3Ae2VBrTqJ)lFNK![0&5p[)(i
+r@qS*(UMqM[Ppk2E4GJF3Ha3[AdFmjY3%m[I,#-qqM0alc!2Pr-N),bGq#$VG8TY
+q1F,,CBHKdjeL+I!NLjI[C!jeLf`0HBA'pmeICJ(lGQFp(Z(PjX4[hGCB`reXLK-
+IC'`(50h!Ka3[ac#[HQ(0Eh$+NFA,HmPh$p*fCqk-m2)meX3XLB1m+RkdSFrJbDl
+U1YlLSA9c0R&&Y`42BRdVcPe'VMP(fme%2m$LjAXq6N"4RJ'1+&lH3Li1YP#UB*l
+'F59jJlC6cJ-f@l`m&4M[rB,%)IQcGA$H%p$"kFJ(q+ej1T2B!$E+Hr&SK*GI)Cr
+@cYRji#X@,rFL[k(R)1m#e*r&brQmK!Pq5YbA4hLj'E$FfkcY,[jdK*HhN!!(d!H
+3!0$'`*r&bdq6-p2I%,[Mrb(#bldr"3YUJIMJm4B[YII"Zq38-8ha-V5E62iNZ'M
+`-V5EmYY0[!cY%Z4G@KpI*aBFSqfQlS[`FL5aj(Q#Cq4&rEf@(1PBEAFJDe(amNc
+f4DJTD!Xmaq)@r2)ib3IeV(MjpSp!TbG26#%R8lbmmPqJdk-NNYb-U(JjJALJHqj
+f24R&G`(jVZl4H`RU`Z,PYY`CU(HNl%jX9TbiLaLR+p&hB5p%mA*2FJ2r(T(%JiK
+ch%PYp`2bB0ek[`ciB[(bApK$d6f*Zab*m2)UaUTpY'fIM1VQr(q(6[IVlI,R%Fl
+Gq#hSp$D65i%,&LrI$-cfT(qhbpp&H(N-Hc'keh8+qciDadI*DE@[GcNiSXA,,l"
+R!#lJljUS$Pj0,0I0Nj1"3cC2Ql''kDA)qqJR)lcFQER`qib*Gc`BiH@9a!Pr(f,
+L*qP2mI)XpR4drH%8FJM&bbq`$[apMSQI!TjD[2aRFMl`A1`f*bp8ZaELk$RDlTq
+3!#q,PdHa"hHZMQp2pKZH,hLT28(mI3fkG%R`-QIRhFJq`[D#Pk(G92C&,&k'FA`
+)IC2kHb["d&5r-l%8pCCm6kAQ`epSPpcj)ZRTh,3IJ!H$+l56i8p`-Zfc4R(mL*c
+eHX40(HAk3)QELAG[&lZ3!1rZbVl1C,(,iAVL1H,0Zm3ZbLXmd+qR6)EF5eF-Em[
+HJeqAfAGpL36*YkYP[ka'qlZ2r3ELKGi+Rr-'YGfpj!4`9H+$4fPm&j,,JS(82Id
+Q2ll-hj!!keiSI!*FpZ2,[T1p*rSHd&*mDhc[B%q%(L$a`4-d[P1*6aGVZeRX,fK
+mhb'hJq06#0+hX2Rl'$%GAL2[&Gq*iVZ&ZAQja!Fqq2&PhmcBk+H"+pKTI@c&HVT
+8ffAB4p(ir[-[SB1r8-,JSmEhFr+$2pATZ)Gp)SY2fTXfGY+I#2SISGdrXPGNkcj
+RjkeN6"DI3VZYLI'#"`E23VZTl-Rjr#CPNG2#@b@qM`1(Y"q3!2S`Bi+,LGdGb)2
+LEZS@FP6iR5$2424&,1kqLM(5ba9r@j%h+aqkRG`1lNcF`P19$k8kL,9AL"fFaZF
+CUAh%2rScf0&h84jc"hYYVp(aEBfHJI+Ke##j0eaEhPcb2jm2TEDb"`D2!aITR@X
+F[f'[aEpP+,%-26cP3kNKFNYi-IlS4fZqPj!!%`Z[iE84Mj5[I*JFlidkMQF!!j4
+ITJjm$4C[d[kbl2[iH*!!r![f5Um5QJeqqAL3!,VZDHMJ+I*QN!#Rq6`ie80FHE2
+%$ArbHA$UqVq&lLf5ThG&[1dDaJ3R`LlX%hq@24[i"A($LAhHPUT`YZ&YfZjQp&m
+XEl[c$iJa[Yefl(%UErXemB0H$ALFUi08NKK2ld[mh3*-9Gk@1M!'#f)"RqKhq2f
+$e"TL$AQM[Z%EQUIVf0Z&KmUlJEALp`p5Gl*R4km'f+([S$cq%q6(j%IHAUceZ49
+rTPrHaYkBY3YjdJcb#@XAmU%Cj%R@,X*Aq-3Sm$0iFGJ[1BKeq3Va&r+YV`,[Nfm
+*mq5GB$m-h"1lli'ATYkVl3jR(6#,3AcdjAdmp[DcEQl5rZj#Mp$'m5PL#Id"-6N
+F[-A'F41j2MJ2G)#A'XHh'$FF42`GaIk6aV'-'%'HaH4Sp%jX(*Ha[mZX#R8$TQS
+Fah%@jF[Dhl(NVaV("iMTp0l&j$Md0@dFLmJ4QHqJRUKEMH-ZcP[FS[fG!1bhFAb
+5I46U9%a13Rr)a['AV%Z`MT+N"kpa[)#B"3q5GaCaH93&&bcNDT+kq5(lFpqY@00
+A4L4,i*F*h6FDrB[Xh6"V)bDh%BF1dhBhXdp*he,XrS(qrdcEIB+FQhk,a,%!r#(
+4TZfH5rb',i[G+F!e'pq,L%0Ieh(mL,@LmHh$rJ5F92bG5VmDhlICXb!@X9X)EQ(
+M1i+e4"p'l%k$$a[I%HaYI8[E,5+IdrMZCKm&2S8GGD2aEF)krSkf@`aqCH-E5kb
+P"X9Z#A$IaMH&f(5RYMZGpDEahI&ek1J*L0dCR!2aia[e6FkFI&rXT%pTicZBR*!
+![U[B,3AZf2MH5Nbm5pZGbEkiaVFAqhRd2F6Z,2D40Ap6f31'[f!Rm@KmSrk0R*!
+!2UIhr`#3!`d23Np"Ae4ME&0SC@aXFbkj"cIeFJ#3#!Fhph4`f3#3%([+!*!)rj!
+%68e3FN0A588"!+qqEm1bEl`a!*!&!H(X!*!'-DN!!"d(!*!'R,J'q)lh$M+bf4&
+qRH6jN5fHl$0TjG1ZGc2#0NZbMmPTpVDTQpkQAl3Lq`KhcI#F(TlGqXEa9rc-VY-
+k2lE0M*(EAZq4rB346MECjlQpcMbbcipY`RZf6h+EE-+IX+iME,mGfi4hAK*1pX$
+HMQ`l"e%XB,a!9'Q6[Y00MR[ENe#bb5Dr#5HE62D4iEk9Y`,36lXqVeJfd"cPjD"
+Ll[Gl&lE2KFFqqic*[HeCAYlLZE$YGel(ZLlZlII+LcIaHUphdBB0[(b[3EjAIJl
+X1MX[1bFjb'%6Vr0kXj'$TJ"B!'IP),04GVh(ciAGCXYa`VmMQh#bbH,&h3#-i$X
+!S$V2ldY492BmEar2bdhcFRI1p(*h[GhcAVk@Q1Ybq4a(qkf0KS+"BKb(8Hcha0(
+bS&4[a(T5[VDX&Y6&r,r#mikHkAR(#-qpcfT)IeGklU+VdKYE8l"`GI2EFmHFBQX
+dZV[dlTFQ5`jb2Lfh0VGrrZ`GfE5jDFpjBf2MBImePV-2U0FGq9jkZHHpDFaq1U4
+P@bhXbPVEhfrCmE93AA1E"03aZI!*e0(YeD1mr9p5L+V&8V3l4ahH01q!h-EmkXB
+j5k,bcXhp1,GjRfRHG0*`JqIp[0#FSY,)P$+S`"N*,rSG+ZL+h!fj,IP(YPC3N!#
+E)Xm9XZ&pb&V1QmVrU+9(rkpS3X"S&9i*(kqrTDS1[U2jYlSRjr@12dprMq*rMV$
+,V9i%HaArH@'rP@EFITrK[e2BAr%[$+6X2I1%$A#B,qaB$JF)1j2$!Q'2jE"3f08
+F$K6f*Y80f1pb@#6X5a`1%[DI("D,"-Ra`F,ZcZ%3B5Ga1&6B"4`1%rC8$NZ%[B4
+$Pl"I8lf!IC4$Yl#rj0$MX&DVM9jKbcMd#EX[KhjKCh!Jrf!r`i&l`*l&B9$B+cN
+-#IY0$XZ&r5'(B@&rcf&%0%`0M`SM,f2#U'Pi"H`d$SF,JlU3!,YJ[(ZP-0ip,Zb
+p($4['1ac(+JGX(rJF!q(cE'k28)BEcj5f$%FY+)ff)-ih&-BR(B[B5MYH`[l&I%
+2f,Xir)5`6h&B*Ha[1Gc(BHh')p38'2A!Hm')q8PKQcM!,@$8Yq&-M6f*`fTKeh"
+B)qaA1D`9pRi1a`NM"qZ%ICR$mF,qQF-*$XXE0jdSM$Ui[c$H$mq!8Am2%2C)$ZZ
+&2Cf$m(,Hq1CNB@rNX%(Blh$B+1b21$a3f0q)Uk&I11"8BA!!q3HMERNl'(QR(X%
+iRbi-h`KH!S2r(LcX&cM!b@$`heR#i$rY,4RXDa`HiV"1irL(#S-6caC'RIqd-(+
+a@GK@$Jm6pN`1j`MMhHF+qh81j`Rl!`i2&`B22F*KFde,R#m-6U6H`FJhY3E'qp%
+bB*Gb)1GJcqG`S6#YNA*9BH4B*0jFUr[(#2Yh$[#frZDC(VKB'(a(2X'SHG&[mbb
+2D"Q`bcJm6YM,1$aHf$XiA#)-[L%rB&rPm!5(c6I0*ZTZ[VhlLF,JBMJ0$&li1@(
+NQ[H#`6'L31HMCA2R#H2Ge$[Blh0iQV!rim#GB0rNJ1l6h`'Qaki3KUjiKM#iN[S
+&Jbr3&'$NlNTKe249`Yl*!Ii(q`+(j`Ml&`l2GGJ#dfES2M"U#am6$0jkRM"U$`i
+(ibjU'Hak$Lm3pM%1,a6f&aaHj,#&TQPI,!`0"[H#S41S%6"iN!!k"D2Hb#(B,h(
+i4@'r`3%Fl)XFIPRBIh"iZF-10$fTA8D$SCI31f$`1jS,$!j#8i04*km@KLkj9YM
+[FEK1f*pcH)h$lQ,Fm&TKF2rVK&%hVaI'@hN,'&cj"Q(`!PS$M(T!Ai1pK30e"2C
+"$R!Mf*pbH,1`Iq@!,Y$I)Y2Eh!Q'*RZV-26Bfi6"rI!j'2PqZc"b!"H"88[`!aJ
+ak%%`Z2p'B@L1Gc[X)02Fla&'lUP(-,3VfKN-cBDH"81Ii&H!`F@r,3b1H*m`mSX
+'"2Xi"r3A'(VV!`jEE"i(rJ-B@ThD")-,U4F`h[SKBA$kKi94Cam44QfJ0F#)KiI
+"i#Ui5hm(QlBM$f$i#jm3KUlqT$"iN4S"3fqJ)m$J`8m,SjlaCm"iffH&iG1JmI9
+Rl*(2#d0R`-pJD$Mi$3bGL4F"KZC"Ni,"dAmX$,li%f(N&0i!qfX1H$Ak1p6m)l3
+9'2i&ZJ--(3krJD%K[b)-EB-Q!S-RU"%`Z!BI"ScD)*pJe#YFSEr$c)ILl@$`rGH
+&8DrF!iC@`fF!3rrmR6#i'lm&$1j!Hi*4!rmS$*hd$BFY-6m!(!a[j9[#d)AI&JE
+rrC-`p!pq!KKeJ`i#)jG`,"K[rMH(GGRld+&JF$aD!``[!1m,$)dU[QBAZXKCIPh
+`MA-fZq!!*Iq[Le`VqAp,mH#-A`HQr5!PrfmT[SD5rlF8RDcNrbe&MbRjIdZT45A
+rEbPmT16r,5AA5[jI0hkFN[rAM6qKj2peSe'8r,pZY,H5rpH0YP2brlVK-#ArVaX
+19I,rZUPR*Iq[KcFVqAmpq!&+rPm2[+,Nrr93kdVqA`mk@FRrkd(M+IPr2@J2*Iq
+["dj8m[pki!)PrkqAh#RjIlei2dVqAbqD3mRrkd8(+2Pr[@JGihq#D9j4m[pkd5G
++rPm[[+,Nrr95fdVqAamj8[,rqUaZa2rV`d[526m@dpk(N[rAKeCAm[rkd)T+rPm
+IHNE*rqZ$6jAm[hlUA-RrkbFA5[jI2jTBbIrVakp4m[rki@-PrkrIkNEm[hjdQT,
+reipQ82,rqZ&(*Ip[J"T@m[m'M'2%raZ`A)Vr0i$[Sq6r$H![+2Pr!qKE*Ip[!(f
+Pj2m0S!H8r,pPF*!!mCE"G2dSqAr,L&IbrjEKCbRjIm[3CdVqhc,dQC,rYmab+Il
+I-UY,mImS95ArEj!!'PEbr`D0Bm6r'm628[,r"Leri[m0@Lf+rcH)KP6br`E4+NV
+qhj!!mBViId28YT,r0f3F,2lIN!$9Z[Kr3rJX5[lI%"k"N[mhC"`TrYq3!2'@q(r
+,i8FPrfmjYDVNrbh(me$brjEM54P2(NcV5#ArElPa[2Krbp'@5[lIFV50N[mh$#m
+VqAr$m)k5rcG-c5MjIm1FPIbrBE`L*Ip['%p(bImE0ViArfmBlDhNr`fM-jAm[f(
+dNT,r0f*j&Ip[a,KIr,m4ic$ardE)YC,r0i*18[,r4[#jP2br%E`B*Ip[""p"bIm
+E-6i6rfr%q%cm[e(dLC,r0fV[&[p[&-ib[3aJZMk9r,p4hUrNrihDZmAr'mAV8I,
+r4ZhGi[q0SSH9r,maY*D5rcH'(P$brmC-2iRr0dDZPIbr-I`q*Ip[$,p*bImEXhS
+5rfm-rDcNrkf`(N,areBBpiMrY`)18[,r9T!!4bArE`AHLC,rY`,r4FRr@f%e+[l
+I#[5UN[ph1$V0G0Vj@6jm4Uhl1Z%@)i("Rk*1QUHU'qGTeSP$ej'fF)f'$dqkAmP
+q54Y6EPpkXmbI`HHVPfKKBH$8rP*j89!F#Z+H(JQFk-[kc0V5&LMA*p@D9qYAe$F
+90)2CjLAA3l6V@mbYSPA,Ac2[`C-[ZrG4idTm"A`'2!@m#V+$6i%riIU5m$2)$Gi
+%rJ(H!Ti#IS2i$pk#Ve!K1Km,&aI2+,DALdN5*+fV3LQ*`RGQCiqrZ1eNTdV2h&-
+Ij,Tp6raCC(mbAK0!X9BTKe'V're[l!%G2m,r-2r,q4rJIaRrJrchm*rR(cqbPrp
+$q*r,rd,q&r!rTMBfbSd5T$aG@FV66%P5VT3Tj8Mj8XU8SpK!hS22N!#$*60PU9R
+"raMr9!%15*lr3Ik(q&r1riK9K[l[iEqArlRmBqaSAYaHL)jFSka("%@98#&NRbS
+Jqe3MP8"PL"(Q@IJJbC@@)2fr&+PK"B9`[rX[#S4)'-MR8QF#jblTk@bYaF&TS54
+ZT8JiUBCU@E49YDaG8*Je@mj*mFlS+qL8L)9GcqVY,)aV6NF!h5+ipEJXZ!3SGSS
+I&i@1%aa[ZP(S3X'Y`FR"@F#"31QMr((,F1e`dh!b825i$*3$lK21'Xi0VJiZ$+i
+-MJe1#Ui*$JQZ%fSHJX!Ca*@%I&$[+(881Qi&cJ%CT"-'T`3h!&@2iNHj3c5SGP`
+lh%1RSR!3F"4`)h'JF+G`VL!Ph%GF0BJ-K`rR$5'*HiGVKd1(@iEEKXZ''iH$KeZ
+(#iJE#3(L!L)2B!HF90aA(&XF39a(FEK-jaTZ!Li#lJ'Z!@i"ML911FiVMLY1,T+
+&ML&F(K`Ah'!F@0`ih$PX1JJ9p`-(&MF,0pJT4T`Zh&L)$`FBT`rh$RF,p`UR#RF
+,G`P(#JF',R*GX6K@Z-8i3M!+EK!Z%!ie*)m,M@X'Td,i1&ELYNjp[-`(d2rY!IP
+d#A3@JRJim,[hY%02IFIbVHlTk8UP30[mVS9,5b[#)4YlFASIBVKT0`6e&qYPJZE
+hGRI,A*9U2D&hb6KhUIh4,Iep)d(C9%"q3@GA"kAIS[2"1VIUh+EcS6SICQINC[L
+LPLQ&U"l&8ERSGi@$F6%fLRF2QU0cqm5&V3F@"R69"B&a8BFZFGRSe(Q"cRI4Uh[
+YM*3A[%Ii`SR(YEh-mRY+N!"%Sh%TICh,j3'keEfbDq,@r%[YeN,k60ia%H612Yd
+jAqH$,VpmM-,-rTZNZ0X@SaDT3fU11U3'U6[H6Jl*'f9&59%a9!Z93T8i9dPjBE%
+FVT)RIHYhpUP*[CJH,[i2SCeG$f)[V"EVrhkqCE0Er,ViTP[(S$4G!L[9c5b&U&J
+p!Q-2I!*M*E`(qX-dSZ`H&h0GlZZjar-2EK[PJ+K'`(2ZZ$lkmR&MB`qV,5!NaMX
+5ja[lY-8cbkil[i$*G#[*'8q`j4h[#F#-aIAR@PBm!TmED9*iSHH'0(Cr2e+chS"
+2SI*&PRSpT(QKC@55PUaU&U2eabElpeZ$*M-6ZfSf5h3@BlNDeXAE0Tf+VKF%`pZ
+iD#i!ar["A0RlBMN&f1#Q+G(FF,Z"6mmbC[BYVim#c1Xef*HQ`aYMb1Sb1+J[V06
++J@q'hQJbFQbY9P+hXIf)Xc+4U5DYeT@[ECXc0(h"Dr#T#8(C*&!1KrT0+FDVq5B
+b`ZF'H[PR2Nf#KiS%eh5hrB8)GFckl54)F@pU`N##@P)b'kcFS9AkC,b#TC(Qq`S
+G9IElJ3Lemd#B!m,m$qCq-%Z$H5(-r@$H"h-qQ$I#2"(QI+!NQ1["2!rQH$#rJlN
+Gc1YJ6JIc1CL4`6`1jR!`Id22*@'H!A--Q&r!h!,Q)6$[J,N&c#YJ6J(c%TL(`*`
+#jK-`Pi"j"-`KB2i!F`HB0m#F!HB,-&H!H3,BYm`2-(-9k"#LkiY1*,U$k,kLfiF
+q%$V(k2M#'D#ML#ibZVVSfU)VLbiLZV,SHU,VL+i[h'XN,Te&VUX)Bi)Z*,UBk#b
+M`icZ)VU9k&+LBiaj)F`*B6i)Fd'B0m)m%HD#k-B@8i,-)p(c4N`a``rdHfZKM'C
+Q[JGc2CMR`4`2jRF`Yi0j(FcT-2-jQ1@KZmlS#kFIR$j`jKm`pi"j"m`jB(i#ma'
+BFm"m!qBD-&q"IRCQ+0$,cR`$jKS`ci!j"X`[B'i"m`UB8m"m!ZB5-)q!136-(f$
+Z!2-B62mlR9p4&alGBR5)dBe("aaGI(54d6d@GI24FdhE$l1GQ1R%,#IQb6#lLCP
+0c(YK4K1cQHJqBbi6mjLB`m6m*GG($'R5kH@D9qNqSk10VLmklHJBS9-0+8AI#je
+rG0YKG*)re`j+4aVGE(6%dB9'4aNGINl-d5e(ee[D6JV0-Sq)186-(f,Z%21-Q&I
+%h#(Q#6&RL*Nec$0LcK#cH*Mp`c`KjXX`2iLj3F`,BNi3mi'B#m3m)1B!-Ip(cdA
+#M'9Z!2-#Q"2!I"AQUM"2K6NUc'GKrJTc9*LI`Y`8jVF`ii!C,F`hB(i+Fe1BPm+
+F&1DM-"H&H5M-3@(q#A02Q(I#R"2QQc$AK(N[CLB#(B"dcp%Y5$FPhB4`,af8G&R
+5eBJ)drHElN2p"Y2C5"HNIS[TS-48eZmdAC4d-p+K5'FLABLZSe'rfA34dX9)Gk2
+1Nl'bG*k-UF6X,'CQ-5Z,Q8V-hQ+f&V0lQ"h&6#aQFc&lLjPBc#GLcK1cVjKja9`
+VCP`afiUC9XbbBSB9XkZB@B93C-B*-d-dIc&$JGN*c-TJ4JDc-CL*`D`0CQN`%i0
+C'-c!B"B(mb#BYm%X#'CK-!1$f4I-['$@"6-ZQ'h"6!YQ@6$$JYN9c+aJ9J8c+TM
+GBHC(d!9+ab-GS65Gd&P*Kb4GSR5mdZ0&TbAq)3iDRD"dQp+C5MFPhDGdU',,dHh
+U[$KR`H'md8e,KbZGTFlfSiZ8VP2A9HSCq,4B[pCTH#h9M@GP@rC+VACa+ehBa0C
+IV!j0Y-&Y+j8,a9*EVGCC$HZY*F-h"BN3(9N!36B-,JIF%Jj@H1li806!FTe9615
+(&dX"cmceGAB[@GU+-cYZk%5a2T+H6fr[(Dh@`dU3!)DYINYITprHZ%@RD+9KqN(
+bG*HNmGK,4LD5[V%89@TK13b'I'F"QrcD-SLkp3T*M[cLm9TTa+ijZR9'Dc*5(Rq
+XVS!YBDPB$k-Ulp9SP+U*!D'!'q2Jb35iYrBIkFqD[F+h5H@jVAkMlJ-ImiJXeLl
+hk#X,QD)+p$@Q#R4@0[5PL+dRrBDJF)i[6TXC6TmpG&4l)dc+6-2pM@J6Z'TV)R5
+*MAP%pAG@DP&Fpm&c*aA,j5LUNX`Y0H10YG2EMcikMG6JaQ*5+TC6p*4JPFGjG9,
+aPVCh,eL`p3dE1lE"mCZGal5U39Ip9&pbKbQ3!$!['Xm9HJDf`5ic!NTQ3-2AQq"
+6Zf#@S",1(Um%'`I,(0I9PD**C4AL(9TN-Kf48S-1%Ec)GlARbeh4Lm2V5BZG'K!
+5KG5*+4-E2,BM%cBUH&"%9cC8#%rZ-E4(-9V1,$q[8Vhf#@6*h)mfd1(k[H-h@f`
+J0M4FL,9NJ'J*ll0&%Pa"IPCCbX-VB$eZG9a1YJ*j!)r'JBiaZG'NeG"H-@'m-!e
+1#b)3"BDT,#HRr*c)+[XF$@a'3*bAP1+`9RF&%3B8hKcGiKiDaTKm2'VR69'@NNK
+6AD@3!++Z3GQY@BKZdaHY@HKU2Z,H03ZG+MJRULC41@K0kU1$L@Qq4h(rL9dGC`6
+9HSTcr83aV)+jqpFXh%i5J9"EXp#S5h+`VVm$8CAH@G4%pNDja)!&2SSj-ATDN!!
+3"mG+PSJ0E8q&b+@&E'eSQhKmjSkA!Y2FaIGEY*'pj+QQ!$HdZ3UN3$Hd5G#MrU"
+2c6FAVD""b`DJ+L4Jl@K5MbVqQi1ccScLSF4V+m&3@j&&fdDJTXedrflcqi*k2D`
+1*pk#N!$(6X!6"Pdc'TD(r)k9pELBH21$`G(Ki5$fhCdj*l,@TKUACaTBlpe`NA[
+)TKkHH&&3pMTlrHiD-N1hV9eXZY#Sf41#DSSG&bE@lR6KS$dKc#+3!&CVpL`l2&K
+0+Dr5)V2`GV,YAJ8@[bSX"5$h'P%mpr#lLYAKd5)pd%%4(1%%Yhl0HA%UpA-RC)N
+pbQmE'JSY5SY+%U[Td$rJhRJ"[dl-kjV-f2Y&66k,Q`+dpYc8%'fkk3TMQ(`!R`p
+K`-UYmbDDDGdH@3cf#Zc@N6e@aVKkI6j24-0iar-c#hdURbqQdAP+d%`A"j6LfSh
+-4c-Gr@#&*R3G-(qm`Ae2%hS3d%+[M4d2i)'Td-8YlGhc1eVmP[PYr@dF0hDfpfX
+BYLrPmm8-G-Qd[brLme1-&bJ(qAmqhm6SQhejr'%bY4-k88`2jh5X$1Z,k)fNXq#
+@,2S)4KAFmY'R[IR2)f9m-jmEX-2r`N*3Mk-cJhK&iYYFR[kq9rIk4q9QA(G9EXC
+TmjCdqlf,4V`Mr$ilV@NjI#i$!(6(mm"Y8`jIl!hl5paQ!e,V,BGr4mU`C90qlM8
+rp0DX@62qVqllp$*[bjBYfrjIbY$1#(rpq[92h((EIb@ReE[5YrXIrQrFX+&*`M[
+Gjir)1rc3L285m-2ZYmGpjD[85p9I#*25pTEc930KYGGD[D4$+`QqC2DX4Vp@&LR
+0@PQJ2,FB+IfppDG+G0#qP85[Sj2Vd6Z[2$kUlRbM%3$ejdX05*GF%TcfhLA4F5G
+H%KThhL@K8E0E&KQh[QAKeGU+fZ++q8Ykr#V"pFU5pVTLVB6GIeRN91V#cX!XN!!
+q`A*8V9UM(X)N01iS6%,6,XNLAm3pNp%-JS3JimJL2mDa%6f@!U8-5R%ZhmRlLpa
+B#3i+1!i@CSaM$$('%6%[9M-[&"E(TU`B"mHN'%I'R"K(4T4B#SaTT44G+DH)$j2
+%*A4BMUd9Nj!!B9)J)4H@!TXj#jQ`&!F4CN(9kSaS-)k-@6#16%N`SBDB!ph-J)6
+rJUJLp`9a%Hr&3C,`1-EPYI$@)YHPJ8&T"S(#F3&Zq#e!BfiVC94S+)K,15d)60U
+YA96-C8&8a'0a8-`(F@4D'K&h&C+6m&Ba,LZ-`M3)5AV)9A&3,5mK4m8am&-58+U
+ZL*H#U*L6JUL8M`TP((042%dP)D3NY-K+5A"%69PNd&kH"VS%&j03C+TUG&#95E4
+`9K*NL#X*LGQV9J2#2NP`bQ0*G%aQ5@M-D%PSdTkI4KDEpG2`DQe&,&I-Ad*ePH"
+kC3RT&@XPC,iXFLTe)3GQJ4"K1DT@V4%P*U(&'3K4D%U14Ek)'G,aJBPD(bBl2C0
+iJ%2C&p1YeBqK6kXFqD$#MLJlR-*fC*I&Crc5c'L3!)GQJIUGF9$fc%!Fa%p-Y*i
+m,`R56`X#XQFPC4@rV8c(mX"bT(jP%T8p0Chh8f,UdJ8a@CHL8iBSAC!!N!"%+6c
+Qqe*d42R9i*JkUcHim5@9f'5)4j2qkr'"!XMLV3JSaF@PABU1UVX@2*N`9rkP`*X
+C)0@4M3ZDkBlN669i4jQ')UFDLmkT"6E+)9BlTHKBm*5LL`+q&"pTq'T`)j9&ZdQ
+')e8X(aHDQMiZVZaCZ0#5JqB#8k[)a4A0SLJXY@@Lf))a%d99dPXbMC,)b$B+)J2
+Mb%@NHX[&&49A(&C14UM&A%K9j,RJXKPB$+fNVqKc4@'0NNUmVLK+h+ii*%YXkRL
+jZ*S2DfCD0Iec'ejcd'hXT)PV`qZY$$DijVrEf+S$A`LYqGQ&q064,N5@l'XTJES
+6(d9RAVa%&pei'eAc(QaXeAd)3qY*+RN60Qc+",%A6(CYa1'0p&BE#`UKdk9BD5i
+S4-EY"@&B,IQe&J-E@cHZDZb@aYFpb"UrTI%0ElM-F'P`cF@XFecPJT)GQ,&FU4B
+DEQD9jdVKUD0CCVSdZ'C8PEQZ'Kcl@!ff5fpSfZ%e[L[&9chD1Z09,UJACZE8CU4
+AMUfiY@ADbfB9lR$dbZ4AMYrZkP8SX(a"dpR,L,!HhV505R4BMkik4&95R,bKCR[
+&e&L1E$Tp'8%f`UH59rAl'NaC[Q5ljeIMbmS9$Gq[cTVe1jSPA(Ar-[UXKGFG`$+
+*&LGc6MNM0VjZMGMJTMGLia[QL)fZZb-fZ'D2&',VSVa`38Q9&d)cr5fed,")S[#
+bL5$KU8PL`qSZL3fZf54KE#09Q9&LikDG%RY$dbU*ibI6A$0,#V(E#l0UPa4#%lm
+NM+YA3GdaXF%0bk6'Hk8,'UC*MIP+&dcD*QAZ+dAAMC-kqe9[b"4kaRpC88bD*e8
+'c1*,pNQC!d[4G31Pc)+ek-4#DI"JkBST%kA'K0N&04ZPcSA9'aTP@RC5-MUX"&H
+pP$)KPNFRlh46bV4BZ@#(Re)KamS08ij+4T'0q#P"AL,+4RK0GeITXRP&h9L)5E-
+51Z@XC03j'6qG`TUjdZ$3bLdll*8DNeE[Q$4BkRcDZ'5US'XH5dDXpIL'be+Qeh$
+JH,AVbF@@fTjFB+A[bF9QM8mZXY6jj!,6eUFSVY5S%`@(R6T4@05A%q3jDhp+3Z-
+'SL#dd!$P3NSG8#i`EB'+ibSTLCUJA%bY#mT&9pUJLV(90+D08&(FC)%9@k'L-0F
+,&FH8-ecUKR+"fefrG$*p'PqB4Cp'dYQhEQ8TF'2FTqJ`I@*9"`E2V%4ARaUP1(e
+Lc*("dk+SkT25&&F'h+GhC!2[da[#!IKTD(8JIU8#+TQSh*0PSh*,Q*&+H$8V8I&
+8XK(&CeQ)SX2A4f%HP18!@*!!9"qlmSe0Kq*aKLURlEIe2@ETdF)pE[9qZDK`$l[
+QV0je6r!iI3rlk"`cH3qljXbE[)GpG"C-hX0q1i[qQZr`([DT@E,V2E+2VVQ(!H[
+VXhYU%aje&,[BG%bqQheYmT2hX"01jq3pl*DcEGFp8AlB2@IVj$f-,6jrmKif%pJ
+bH3mlm6cLZAX+K+5A3Y,I$+pjPHp"'$d@(RFci0ddkFGG(feJpkd$Y(1cTqel!U6
+JGPYf[(!TLerUAE-fD5Gj6p[h40YMYFJ,2`X[M)q0VG%qqckf6l6#V"HTldQmb2D
+R[8Kp$elIFE[Z#4kRlm(V@cGj$hZ9(Gqi*rqd*kM[`41Fp4KPiFGCle$IJpFhkah
+UHpJ4EGBle2IJ#FjkKrSH[,jC$drI`rjTXjkJ[JG2F0CMe2IJ#FjkPV)!Z0rE1r3
+-h-1Zc2SiUAqF,Y6hQ!@%Eli(Mf*5*iAhi(h1REa(rc9l@F*ld-'c[6Ek(RBcR1a
+j#HpKhm1ll,VR+42hQ*d3EmiM26lhHDlAaZ`JVAILZrNHGSkCeF(k(RU"'[SaHJp
+l+6EdD(32ZbXfG'Cd$lXY0R4`G!pl,ckL`92eHr`V[1aY[XIT$E5D%e6S(5I#m1+
+F"mmZQDjrKrdSh3lHl(AUqMIB%p@Y@-XqU'K22RDPG([IX0FSHi6bXE-SZT12286
+4PRcXPqQfF'@A62T!qGMrdfh+`KkID%FqGQYP6e%qGN0&+j*HmXMHSQ$dIU)0`I"
+S`F(`"p'#B1c-5Il"f0f5R8A"f1d5I3I'$UaS1$$f9@@(86"f`m4,"Q-I8raL-(E
+Sj,eJl-3TbhBTbbApRQ$X#)[2#mBHX(LjB1bdLPp,HC*,2&N`FN%[*KMlIXUD5#f
+fQbBq+aKE1-RQCbffRbYq+4JlZj*c-2BeCIp3-,C9N5hq@k`ILhe%`DK4pK)&Brp
+2pK)&)jIX*`V'6UEX+3V'9LAN")apCYP&&)cpADN[k!@1J%r!U%0f&!8M[q`U#XD
+ZR1`U#XDZRZ`X#XC1X1a"#XC1XZcA#FD58Y`*"XH`CbFBHkl+$NHYPM2CZl29pN@
+eDcARpV&pEGRM%i`pDf9[k$EM0AEr"+0ZU5m`mJ8rJ,%h+,Z#JV(p&,Z%JX%6a)+
+a)bXlKi+aZb[j"'0h9hB3"B2rf%88M0e+f888M"eBl@BaZ4IC$UZbIhkEm36V9i(
+Th@AY,Y#DSZ&VmJ!'9mTDrh1-QeM'#J`ZB$p4-1U+RDc!b+2Cc8TMl'0V&VI5'$[
+IJS1a2bRlfB+aPbalfS+45fS6$*jJEeX`q*[pEm(Bca@p!!CR`dY15V!l,KJmcZk
+iB15*hA$"U(2C3V[GmN4pJC%,mJ-'(l#c,KKl1V'l,KKmKMB"BaGDlJ&Mee9ff38
+M6qbd#dDHi%N`G[U9VH[E69[)2MejdcEXX3Z'CT!!hB$bPM-C!*!!0ck5lB2b9Y[
+S"6$UK$eh`6LMPF$Bk9E@$-lElVEX"`X'(m!KB2#"l##90kk9jHMcYNF`(!M'[Vb
+bX&H(D5eU&JcG)P[TG*K1N!"qP!lMA23,',c'IUYJm!MD$BbDC,GI-(,0MVpJ[%(
+k0cYXVecfr39$0m"eB1bCbaklB1`-bceJE*K(cX()+h`#aYkfl-%,aMl&l--,4Ym
+Ah!j'MYQ29hqGPQ2fi`9$6l!R,aLDLRej`G"#l-X,4Ph#9f"`+hS0$)iMEck%6bZ
+,dKU2hY8[AE(6`r,T,J%a0Aa[RpGQ+I9S-rYJ&pE`HhbBM$bjP,SIB(20R9qdP,V
+eKLq6DrjNeI06j)Sr9Flkdq5H2efZq`YeIT(1,pEj*6TI,QIm#MR`ce$F-h9qPYj
+lTI#Vp0jRkrh2dAZIUrGIVI22blPrRZkp4[FqAflp#p,hqLQfd2-FE05QYT!!pVP
+0S,CQkepNqiD$f+hCA!q,2TZYf8)mq%raQELGmC@FcVkjJNIIG"jQFY9ibdaFqUj
+EhR&lrVlr[NEqGpeAHAIMRY[VjTDDEEl$,lICTVrJfjp!8+YiKUeTAqjFI,"$QXI
+e*Y"$EKTQiB09`cBBqB*5dcCL326+6!'Qm@NqZ,$B[)d,LR``ar("U[U+fDdcQVI
+*"-F(fMmiD"XI'*RJHH1$aG[ii**b10L866H'I(!`h6&UcS4VI@UGrCShad1-3RK
+BA)c2QP2Skr,Edj-HNl#U,aU05d(6-Fi)rB01a`GQ)-DTSl9D&0IR,!U+3d'F0&-
+6#Si2Y0qXRZ)$U``Z#*US-8,)"bhrd)YV`QSc-hB)rB2fIrS(HS@F#k2UR*l4`A*
+BmMZVTI,S8*-`%4(b3IjIIT+2M!`52ZK`I[-jE)qdZGkmV88Tj)01p4p-4(&JZfG
+YpBpVRGPk3V-eCJMjB#jkFGk8j`B`GVR*8RGqM$YGADXe!4K[acXQ#PfD8Y[mY1$
+YlkbBBdTQDhG-p(4THZfqGjcHVZQiGqEeP,lHA5qmp4fE1TEfY`k1H+8NQH(PrRL
+qGf#[TXIUVf041JPd6E&FMU+U[bJS0kCQU0mpP',UbN[@fGQm3fE30Vk*!GrYK$C
+C(HiGKf[DmSrIX5-Krr11(F0#r[FGfaqbpahRVDajdeI0Fr9kr6dMB`r2baZqq'j
+QJepkMFFDD,Cq6dKVHA1b`LIHeZ[A0kHcdF`lC1l[$r*K4LAcMTfc923lC)ZfCQ,
+Y1r3#Fjk!Gjbc*l-cH@AFVh[(0"2YIFI11E@ZA+FrmikYhXKZRVCV`H95SRDK+8q
+IdGkp9mG`ar(2+TPcSj)Q-rrIKrki1)QI93flhl&eT+aTf-e2VeFhUmqfeNHE",b
+$Ej`Lq9&H'9XZLM[FbUriq6m8YmjXlBlE&(Ic(Gi!aEhKT-AD3k$j6I3-l-f(jd1
+j6fEe0Z8qqiipbRhf(AZ8qdh[f+hFCpiaSpcGR#arJ(+[jq0lbVfCf&Z9qm`lpLM
+hqM1qUpaRhV&6ZHYhc)ThUpc2'rjIhAXr&,IH6,9faff+Hr)GI*i!aDdAT$rbH(p
+LdrRLerQmBY,[f-i-he&-XqrBSh4ZHXGZT62cMZm`HIdGhfAbQAIX*$hp$V-Br`a
+$M$1)BcSqG#5Q+N5rip'$fUkLpQdBA,lh(Cf&CrGJk#J8fV9EajhIIc1HhS@85Vc
+T(9[qTKAe1lD`1QPKNG&k4CmED*q0IARGTaN#,Ee6Nqppa`aclUbcS$kf032BUA0
+H1ZjcLQ-@T1lM$8IHJDXdk8*9[S),pE*e$II4#r#1YH8NmD!B65#6lp"F6ejcZhe
+biaTk!I*Kh$i[`$ZFfcIpMVeZhrRe5YRV@Z[HF3@EQl6XQem+IXMT-r*6hl(*qeP
+qeJ9rk2TUhYpXQjcS68d1[*ripqCRRA0qIZTjk6BcjKf2Y#TUjQ0ARBR,FN(YQAV
+&BM&%0281jYAQE+c[[VSh,SXAS&k0bq)&H!HIT61p4Fi2mfVHSFXMpprk1$QUDU1
+B4J)R#Me0!2BbBAlQM26)6@dqdIQ`Y[[LCl`TqlNDQrk-K[%#[11NjI&TVIcr++q
+S8Rp&cq,d9p&#k9I33RI@4d%,h9Q[rS"H-D1&p[%($(aQ@0[EJE-VVri*jjT200A
+rjp@mBqFNq9h[Q'RabKhDr+h(DrVEUh6m5MeHqcl28SrABfTle1P-ARd%AGkk9fc
+Ij`(T&DX6b(Gla5DCfKI3+aDZ&9ql*0pm3VPl+T5T&i!jr3T-YHZEh96-rq(TH&`
+Qj8ar(J)[aJmd+@IIjeQDP,2ALkNpa%X`F@Il*a0hYRrqVBNl-qhrZ5R0+[VrpbJ
+irmBFJHmSVrSl[UHmQJQj9AR0[--l-4pKVr+U2F3[-'I"[Z1m2AA')r4-8LX+TZl
+a!bJ#m`k[a0b(F21JMR3cL2hpKmf$&MfjHC!!MqfEh%6*EKlNHpY%b6HhHC!!E!k
+bAm@aHC!!hYPiGNDQpr4EZk!!q9hVGV[ADphVlHjp+`AJMCYaX*pUYSA@h"FU%&Y
+SHGliS,+&PSIYblE3fJp!f$V+RlDP@ZF,'BSYY+EQ+AP22leePYipkp54S0adCIX
+XphRAYp!k+4[UdV%qaDVE,EcSLK46IC[AfYR$0&[[icHZhVV6M$)mfN+V0jFEhfP
+'EETT#[%hj$EG[#ahb8%c'qr`I'fKPI&dG3ZY)NrlcEI3mL)SGcr3KJ,6bTe2P,Z
+ki1"P63#8ZepU#kepGEpIbl#&eZEU,EK+Nbj8j5Zi8&pHfh!I[3$[b,E3bYj4hED
+Tk)SCep!,N!!2irCj!Gi4E+%epBkpETrC[1M02GN@@ZV#h(I"p4CDDZh'QVFqGqh
+G0heqG@lGL8BQHJZYK9ALRjblpXljZE8rjEjSmk*Q2RE9@ED&9[D1kKCDaAGN@fM
+GN3rMXRJ"kY@i,&k!Gr!P@fMGN9IcMRJ,V6[HXCpSXi9@#fR48eR0cr[b,@jTljl
+IdH+hc'rVEq1iXE1p[k@j5J&iB6M!%r2jCeM!AmZ,2V[[B1B2m[RRP*-qmaH4JJC
+p0"cKje@DrJc5p2pT)CqNP[EaZK5j8mlh['1m5P,Id3[HIJ3V@ckCZ1,mPD1Bjpp
+ZF4GYMe2(FaJPlS,YFIFjKL8!j(fY$f4a,er+!#&jAa6AYjJ@8(PI&$IR-!jcDc&
+cX9Xf[XBHE10DhXKKb-AGD0-+@T52EfIhV9`#eUVlk(5paX8pqe0JHK8S%rG0$LH
+jZ([rb4iXlkC2pHiZlNSEV-#@a-3aH96ZZriVB*fU'jUb&lZi*3H$X8mack3M@[,
+a&GYjS%pjHQD@[hXH#bBcqY6EX[ZZ[KGX`-@ehTEPla0hJ#h6IESZA6iZHKb-'Z(
+G0#p,rUkq#QaBF6GNphhm&M"T,'el*-[I*BD0ZELZ6eTZ,U`RaJG5BhbA`arYmbV
+eG%j2'0HpN!#$MYX5EBqEBqmqN!$li)N`VX9U3[*pejq!(D1mXZ@,e-IEhJ0'[I1
+1"GPpChd#l&JAG`rV&jIkH,jaK&PG@0rhJ5cI(lS5E,AULIG)IEc+FL*cH9U0hq5
+qcli6E*hLhT(9aaZXdjXmNkI4,"qIlJ3lbm80fp4FbGq#G@!rT6U$Eq@qDeV"(U,
+m[5I,hcEMPBIU(F4*2VUY[Xp@hA#3!2ce@4e,*rF)fffjqjjNr#'GiL-rb2,h*EJ
+fTq&H9hf$1PjIU3r[i114Ar('ZeCU#E84a3hb(V@kTbZTHrQ$V)BZGA&,M#G%"d6
+hGIf#`bZSHcVI`lTIbVYcbm3V`VPmem#M!Dq%FGh[RAK(&(IN"+q%F6f[jh#dH#L
+-'lQa8CHYFbm#)fr8'H0-T5j[-1kleX8pd1k`GGPkLR%6fN&rpcFp)(Af6Y-FVh&
+aiarJX,'5l15jZjNHF(&4RY!ZMPrEXlLAd+5Ihdpe%-Eef2[HUMS)ihU0ee`GK((
+,dA1jZDU$-'l#*PqlI)4a5daRG+9jlCMk8@SGAD1r'p%ahEpfFIG#NkLT,Zkklh(
+pr$3ZIr9Ma#ebFCp$jaejNEZ[l4A%(H6L"Vi&PRIhIH-8-,35lriUKm2FIDGpN6K
+pTq&,H0$@CFGKD$Ee5Yf(9P[JiZkhJEK$AGb+3m(DhIXqmeN`2HRGm0"mU`0lhq&
+h%EG%FHb5B0q4Ir`KiVTFh1'@ibqiqp4R`25lM*j!4dQqRiIf9DC2NA@Fapep$rX
+FF6dZlJCQG,3jRXK[SFl8Ur31G(1ELhYh,h'L#jIGD9aZhh%kR+'N#eI#alRC,Zl
+i!iJ6A6Ki-SF$A&cR'F5*,Zbb1-[hqIY[*djdBCG0DT!!HMUC@PI'$r!%ifrHlq,
+QSF28DehF%Ge@3rBG(riDQ1M))ffHifYGh&[3B8SkXXX'9pJkb$q'9MEk5"rIm5"
+dD1ZQSr0X!Tbq4!F)hh6!LmVT-'8jF(ac00T*14fQTP'lMQmq$cFU0iG)YIiSijY
+HhU#Ncqk'(R0mmd@cU@9hL0kh0[JQr`!k6jPf)aAk(Diq9U,9P'NPH*Im#YqXXcc
+*&-B6m$Q%EcS1J918jYreEXcijYk@l`R&`EIbMP8I)qjNk3Ni`2*0rL2'SlVZc(f
+2crMQdqKATH%GieXb[PQ%PP1@6rfp(Ai4[ZNidAK)[m[`$IN3[[N'QP2e53paVq@
+Er+eS(GA[iSkb1KDq1GIi!bm&R85mm-f+$a%(cj!!*rMBmNh(kXZ)1edklpPC2Dd
+R"`TG`(IA4aYmNlmHEDI3!R`2X(S5(I"!0+[a3j!!ZZKEbcFGCE5('YICm*I8`4(
+i(%SkHq+HM'm@QMi3R6eSHY(b6Ilf,a&RGEDb)AM#0rRISl'8dpRUA2)PI00a#$@
+Xh,"YG3(qK2"0rTYI)%$'BDmhlK'qqG`[l@%fEXLdZr$0ZfmJ6R4jRqNPUBrchbA
+I!cj'r`K2('Bk5I6k"[5dijZ6H*25*2aaibIKQc'i8QRHk[!(XhFFJrC9QY"c#RV
+&mFhVb+Q5IcImmBa[[[CYiQ5bbp)2Claq,Ck0dPB!Tl&'Qp-hhrSYFH)EYTh6i*Z
+13dfhb85a%dhhL,ijbh)TIQ+[k@c,0rR,,+rS9I3pHX2b6Ai62Tc5c+2KUc0pmdV
+HUNkA6X)lNAUkZp@Cq*ZRQNBA[[NNRU$5**ihh*IacIRN9'R`cK[KB+G[[[PpiQ5
+5d)QACRA`((`1KHELHbYFi[KQ,MP9aY[kq#kmY*EpdVMF!A#Y@ZRL2[BkI*)MA0`
+TF+L5Mc*NRShPTe`!KbNhe%hG!NqiGkc%%e*S#Z,HLejelhMS&343Gk3)IT&hh0I
+d%ek@2Vi2IH,Hm5UV!mdja(d!2mqpil2fMXY86ar-hR'9m3Hq)[a+r2`+Xb%,hJ(
+IQma2q95PZ'0qTlS9hD#FAj@l$Up#R5HGXC!!`bBApfSdZRUhLpZ)&XpGkZ+10Cf
+("kL2lm&6890Fh0IH!+Ec4Yb(M-2NI9Y0cehZhV'*ZV6[ZfcX%E`$GD',ZplU80j
+hlFh%i5rTiiIa4GclPTM1`kI9airJiERhhGGbq5cTHh`&bGp4q,,+H%`I2iL(iGk
+h$8fThZrL2QUEDFMl6[S0'2SSphm!G`)!!!%!N!0AHJ!!9RS!!!*kEf`l$3N*CR-
+ZF'&b583J25!UC'Pb1`d*#8jKE@9$Eh!50#i`)&0PE'BY4AKdFQ&MG'pbFJ)!N!0
+"8&"-2j!%!!""8&"-2j!%)!$rN!3!N"+Xp[d9!*!'@I3*#3d*#5TfEf`J25"QFbj
+f8Q9Q6R9Y1`d*#5TNDA)J25"QFbj`BA**4$X0#3P1B@eP3fp`H5KQFbjZB@eP,'j
+KE@8T1`d*#3d*#5ThBA0'EfaNCA*"E'PKFb!p)'Pc4QpXC'9b1`d*#3d*#A*PG(9
+bEL"bCA0eE(3l$3Pp$3N0#5Th!!!#L%&%3e)$!!-S$9d,iCE!0Qd2b6Z[IH9Ehp5
+Ue9CEkEAkC*9FPqJ9+UeD(CpNDpA*@5)i3-Q)R'5k55HY1-"hcYF,r!1f#E,M5[U
+MC@C+a!jlH+aC@B3V[%icXLX@fR,DNr0`SMITBMNC8cDC6Z*'D,'pk"KZJpfp@@Y
+N0fce%Me#6X-#1je1j30JAcZ3!!lQ+MM%ppFL13@,l3`kNiq#Xra)29V1aZ2p8$e
+-6X$$l9JkMKI#GRp!ljGYH)IYT+em*paYXfN1h`AcrADp66EM8cD0CR)dR2%&qSc
+-`1RqK$iT8r%HQd[cZ"kHY4l823UZ0RLjRL2VFBIRp%(CJ[IC4YV%pd*IreFIPcl
+iY(@PE[`Sl'hl8'rq(IEcAE4D$X)KIUZ@bRMmhLE5"2iFIVC40*TrJM&HU6r)*&a
+MlDNGr`LGr#[p@MVJ5&qYUk3cVV@a0)lA34GE5X[i1hM(rpDrj$emhrr6A[)FrQm
+Id,[m$hcUYIUPI),If"+DaGp#2rZB2Z-'k1NVp3[TL1IC#r3+A`5[qX9kSEb-Jra
+'[88'i`hf%Ah)em-)[dU[PQ&iV8fKSA`Gh'3$D6KI!rhpCLf6!ILDAk+AbZYiZEe
+*Er%9F,kp5-rcZI#5Ak#Ab4Y4q[3RrF'2`GYqT6iN[q#[rV!q)VmK'T-`3"4Cj"V
+@eLC8PNBMkcLAbb96p2B`aCDaP&9&U@-[5hXk6QI5UA49HN(DD[*0fCDk4QmZA"b
+hC9*QKDeY8Bq9e54!3"2#XdXQSE`ZSEJ`S5P3&#J)Y)Ab`R#S$SIkd&B5D'e1lV3
+f*HZ5PSJk56D-!bP*#TP!2[bb3,EL8QK,"6+"jSS2"5`IY[4X3MD3!)N6iRa#69)
+'!*!$,d&%3e)$!!"@$8X$RHJ'ApX&YA!,!-!YrkSA!!$3@iYDH!'Kj[m$@)8Habq
+AC[SF!*!'*lp"4%05!`!rmJp9$AC'!4!aiqGMIjYcMV()-TE9'U0IM"@MlZFhK%X
+0M$Q(cV&kM"'6f&`D[K#b%A#b!`R2br85Na)aK#$0iD9FNLE'pSA*#4a,Z66Aaq2
+4A%Sje-FeP%XTKkD%BiLe3#RJ!((Ipr[[lr[QCJkplE[hrI`('k5R+%%3*%%52*%
+"I!+Dpk1@k$81XCK2KMmBkh)ImdEZFT0$AjL%ESQ#Q[A"f+5lUd1X8%03`%TJXZ0
+G8#P3K%U%iPa9heDKjeeZFCT8f%RNL[a%6Xl(Kq@H#NEkblD+H`kJd#!9&R6m19E
+#N!"@#`8L1LLBQkT*bA,EbTI8INfUkU#1afYrX(Z[U%d8m(MZKZ%5'MEBDhm3C0i
+JK)p5BU8akQ"S@![63Pml6kiTHVpAihr2j32Lf+fkG@ZlZ2qbbrfRcfYiFSC,bG5
+Y8d[GbakZ`C*!PqQbISC,9cUh[kq,Qp3XJ@&0&dqqhqhq(hIamEjq6RGIeV6GIBq
+pj1,qPhCcdd[G20RajrS$`9R3X$UYkqliY"IALYEQ6KjA1h*[iHHed5N0*R[[V!i
+NhcQ&U81EjPqfE9TdZ9HB2YR2ihfK63fRECZq21eb,hd!JqT8iV&%8@1[1[8Q"(U
+mB&C#-Z4L!dNfeDUT$R9UF**EDh0$am8D%VjcI3Bl(HC)AEh(&bT[R-U`MaT@Jph
+SYKeETNk06r)iPN6GqD*Sf))1(1bLli`H9iDUf$lE2P[YrafP#h@UQh(Y)eAQU!L
+"dYE4-rA'5f-6,@jF-Qe%FM+L3VJ20NjCD2[LY!M#e4HMHX0pp*'1e"CVaQ'`l%a
+NBCU5(l-J1fM"hCpL`8$3JXIql3+aM&$4Hci))BmbK)3b8IXe[G)kX8DXmGE#9&M
++5leI#B-maQ2H"K3Xh1,p5L*fe2eSD8VFMHJJ,'U-N9kHY$IM&A@14GXKc1b`Hlk
+a#dE#'"h5B*,%,2(+4)Bb"DC5Ha+[)UFl$+3fh58MPq2TKVX`,*Ffh(9Z5fmH6'*
+kV36NJGU[XHe(eBR)*"IjkhBV*CH*BS&Sc6Z#@4$*j$*aR`5JE-J6C6Ipj21m0$X
+JhJ(&3pi1JdT0KrXQ%UFk2KPJ`VB,"cZ,'"TZmZ(lPR9cGr$a4m0KCXk*TNYKFSp
+YHhhhRQ0,4l28MU&5Yd'*'I5aqTrc4RhL6FjhV[TCfdHr%IGq0&dXBm`2Mikc4%,
++@0*N,QQb[)%-qeJ+-%*D`qVDc`fVFC523&LG+9bj#Y#X0$9Ui43UG*CT1*UeZ$-
+F$A'rYYPZ6BHdUY$*Y4Tq)8-aGJ&aY'VER[)M13EffUT"Na`H$cDX3T@*GS,X08Z
+"CB0,'qRUekSEZVA*YMhDbLkheN3,(9Yc&$4Q-14,NpdlLXR5TB0q3RQIrN+'IDR
+`b5[G0QfPm0'CPb*#")P`%e"+4ZV'kRakDTVYa6dZ0+%Prkm&#-&!I"N-DG'NMce
+bMIHiTM)8,Si3q[-$J5YPmE@i8MYGLDH6Jc$mLKi'SNEij!B')[YiVD9UbRj-DG0
+1[I'i'*K'!T*0Y$1`(BE&`Z(N'&8F"N6`Z(-S%G,''V#KcX`0"D*)KeKq*2GM*E+
+K9rK`Q(+8`"Df2d,Ej0`Af*!!0%-d""9Lh'Vi%L%'#LqX9cXFhmY4*SpAS4&M)`E
++)JL)i2AD"&H4I)(XkdYI1mk(IPL!6"35#,a@i(MZe8,H"d,$!8*94Z-S*BVF#+$
+U[H0)p#,f2X1rJ$J5[Le6M#a%jGIcYS$XYr,iXcbdKC(G3Q$fUGmKST5B)N(k2K)
+L(V39,*!!!15+8"J+5V)4'G%bL'$'UYdM6b%m8d5NaGX18lL%KTpj[R"peE$L++d
+DlUXDpMRmUH(c!4,V(899``%5BijNeA#!4"5Ek8#QP,C5hSp-d"F@e2PQ3jiX'qD
+,qILjGK$!Liqdl4Ah)l"e`f'%dRF5Ri@14)kbKYZ6L9))T%24-2H,C441`DF(`TL
+d-03V[S2N*jXYf4TBBMN+BHf'I'!b,*l%0$(mH0L56,$k(DU3!0%X,G3*FKi3'3Y
+eLhfXH`X4!ZReSrjd*&f+T!hCc,b%e"8,AcdFFXZ($0qUr8TU),,5NA%NbL0eeYP
+pif-VZ+Af+erhKBa,h(,6B%rV$#2G(GkR$akADkj4Q'm00Aid1*MPE@CS`#dU)B%
+MfRKL9"rjGpSdTkGcXpSrh,rlMcbZ3rM#[Icq1h-I8)cYQeAAX)Z'ep,`RqlrHXB
+$1-bMIrd04*+P40V9dqmDI19Qe$XqG&b0fa&98hY#%r*H3eMH!pBbA*JI[-RpFS8
+b1T3Rm[kM!mQ%Y5&2VR!f2iY`XlcRi"PZN[FVaKk`$i"Gl8q%j6)NSrj,XhdJBqq
+NL3M-`E#mAjV)3arTX,bhkVLF3)"Q&8-0mq8$GM@5ar@bA&L[jXQ(3&"f,lXrZr(
+NX(ji[V`A8mRi16V`ZHT#je%f'4HhTG#pThGPRPacLF[,-F@Ke"3e6fSZePkQT*Q
+)jMk&N!#XP$c*9`MCd*!!NY(FBc"5`c`)0GZbPa)STi*0K@%EQaHR`18J"F$U,1q
+Yj3MD%YV'R(d4&`*2fha'CjJYeSN)I&NDf2,@l5jAeR+@H"9KLbGad1mj6#'p21q
+J5clY"[$8i&X!3R0,fekj"JKd!S9(@(+I*hpLKb#T0"ZfJ$8A@EI)qi2-FF0mq33
+Y*mEFMk('RY#0'lB!kHb'e835a#CUrkSC*p5Vr@S`UrBd8kSQ*MV!R-X#[jbIa-F
+rq)kM35QQJ1l3fGXFE'MQRilk2V6I&$iL03Xrc,ZJ@LN`j25icj!!bJ0NAS6NcUS
+ZiRiS'4Ui"85MIXkG-2A'r(-JVXF`e(Kp50pIaZ11q*`5CGjfZVBkYU,V0#P2&!l
+f&6Rp!2AbB,,f0!AS@`m%+3FHk9KM`V(bq$K,[19Y8R*mQTRf&l&-h)"AXcJ23h%
+44bUHTLc,$!N3mk"dH+9&FD"l+eZLJZdL%TK1PX#%m4QR")BP+pP1[d08aX!XN!#
+IcdLUM'3m-9pX##,C(#VijlEGCm@5N!"02#V'S#l24!EH54Rpr$2f2+",#EE3Md)
+P3UlImhS-pb&6MR6hT(@f5lHIS!j#*pT%m9"#YpRSp@#k'`"YP%hHb5l9I4$0QTK
+!Pj'3!)4e&50"baHc$IHaaF@%Q!k6pbNb,80KjjCZTXUr4U!m9rM-HIU%`m8%a')
+N&46J&&Y5)!QUD!Kr`R!bj[@`j8m4HI`$&F@j#9e@dZY*63k`XL&FhA#3!),AR"2
+qFB$`q6m4N!#C3B$-C@3`P0`D!%)!d(RqL8)"%!+`DYKfr[QdV["5(SNX-6VXK#k
+q)m8!FQMk)-lNPeE394+kTlmPG@)5NcmeVI!aPF%%RjBQRj9"M)H%$fRc#p0C%)$
+c,BQfLL-m0j6l[0Y@2HE0mmVN$##+kRMZYPTVED+f"HVPIr&1j+l*A@1`-j%'dir
+8*9YIc"0r8Gj)+1%mVkSBVKLTbh)JJdD"L"EaGdi@,RGBAY5A[dX(k-blG8jLmff
+AEGC)AH[bK'iVhk![hi@I-P+(b[FDE18l0a6`52QqNESM2Q6hJS!5YF'QM4fZJ!U
+Q(LkMB6M$',[e'r6DT-'QM6#Q,'a@5$X'pBf!G!cU*TYVIiGX3pY4+!hjDhm(Yje
+EdQHdpRFrq&Yh&TCj62U5%V[TQL9!''Lm#kTIc'(XdQZ0KXAP0EiXTj@TD3R@$&Z
+"2&Tlj-dDEM%C(5Di5m#4JlF,kKUIj*b5#--@8ZSTF8MVB&Q!FKTe)V'49$Va"T*
+mZ&)B`Z,AKY$KbLk%BEE'S'lD$PH3!-*jZ%bViVU4&p(%D6I$D(!%kZBK8MVAjIV
+d!aP1AUT9EFHmEpUd8AkGLQd9@jB3f$L@9SH(3'G+TQN38kmVp1QRD0%l)h9KE'f
+XPCC%ER,,PKCR+j3i*hjZN[VVYXN3K*i+Al-J'B9"q4TR`rPEBaLZMj!!NPmjNI'
+m!9F*D5ZK*$r8Z!cCl,F1IfiBcE%IcN@f6@iFma`NKG8qr85'diUK%@QSJSEXrQp
+L-5ArCkGke%'Gb8)L0E'3!"Jp2%mJ$M-E('YH(Mr4YJ#,#Z11F4L9jlbS"cKj0)f
+f%Nh"`SQ-)%+F#1hHFeJ@&"pe+LHFJ-&"-(3Np@)2`NF($KE`E@5@`Bq4b#!,fJl
+)K2DeCEl3!GNCTd-rA!Qe,FpY1h`%2hX(3j[3J+[c-29#A!I*r(!%Qh6N-,Nq[8r
+$)h8[9!0ajM#4!8Z#d60L-h4V%fKZ-qdH*X4K'hqp8jJ'`KJNi0Ym68JElS5iN!$
+2frhNR)1IDA$QmU@,e*!!20#i@*jUI1`X'8`AFpqd%J`U',``Y`4ESXS@Cc-fe8"
+Eh6`'iHFc#'0*fHHX'f4UAR-FJr0pa8Kd6bqmH'ZYkMrj"`5YLN$-N!$Q`P%QFe,
+('K!fr9Mmkli!S*DhI,h1YqLkkG$K)i1K`h$kDVh'",@i8fhDmFZEK+ba3e)hYic
+4J3P#P#1CSa#`X6N#@PT-,(X$aCXI6d2TH0S4AVcaHZh`50hQkHN3LNqKDcU&BA!
+NR$IkN!"KS#)XmIADNiD3!&P@M-,'%1UU,a2!CRNL!iX+KR&3Xh"3XdT#EH)RdQ&
+jQS*U,#-3P625SH(i)f90@9km,&eMY'R(NB[XNM'Kfak9%'HE`p')F!pY%'XqJTE
+%YT'5#H6l"0HX(#!aG46Al-6R!XU5'flbkpSSblJir+j1GY8)3jUl)h9l)aFb)+!
+%LE5P6*!!JQ1$XG8BcB)"*KTTKhKAk&cMbcUe$80qChXNbE2XSc$**,P&BMMMp2M
+DZH98$-0qER(5F"B+ULpNVT%QK!PhMqj#"LAEKbYIe*YV*$2,Rf2,#!"I[ZR1UH'
+%MTrm[Q[BMF+(UedrAf+2NBNk-ClHQRYb%!DpN9I95p6JFFZ`@dQ@VYX-MdKma[E
+TcqS0!amY%@ZfVB!4-0mdrj8#8BBE&4PiYYS02TMPmP3-LYc%TNUm3SkPq0JmI'B
+)(bCZ8PS0cl!P*M$(l&%-qc'F4+%84T0RZ$r5adf@G&imeQG*pqMAkAN@)pBFlH2
+qcF2fj$SL'ShN$iUQ1eH&ckfa2Y-Bh%6rfcBGpcHSprd($2&YVl6aZ+r2p2Y6pGB
+qbdEFB8F%aM"R()$2AAF64rId+rQQ''rfjCGUEGfBZKR,G3El4eLZI[TQIRb!ecZ
+L1BTck-fEI$hhj'3j-eqibGrLL4F+qRY@IBHh1LcS6VjbNhYB+15+ZQViq)9205[
++,Skm5eZY-QI$eDid1ARah-AIGrhXchB)+ccb`@*bpKc19NCKBPq6d*9p0)cKHDI
+Y5GpTZeA4lUlQkUmDBI`RYK)$JZNm0[+NHK`CT"(X2FVHfdqF1irf5E%ppra0&'k
+GrkrREk13!1diG`N44Ik*dr'ULX*lrh4,T8,&UDZh8,"N2[Gbi5N8$$BE-9KZRA[
+14SAX3T5S`+8r)-iM`pKLKcrb$(m9,X$@b$0)mD*1IipH5FEk)Mqr8)+-S+!4Ka-
+LL[HL!@"EKJmI0Y&[5G[lT%eEVhjk&1EjBeX5h`Ul)rVaHVXRSKqXYmI`kS2j86r
+H"mGD##HB0Zi!1MK+#@e"LJXERGHDd0&4$V'Mr*I5e5kKX9L3!1e-BJPANM3!Gd3
+ZcaD3!)&lKYh@HMZACmhM6Zh[rd10SR-H3qCNPVmSZK@K))BHRLES%5AdL%hb,,"
+I&&$4jU'V4Ai@`Bcf#&kP0[pC[3#JV!3$jXd!B(f@k)*XHjbF&VR(Qk'1JfhY6`i
+")FY&KLq43h'XhUf2rG#(%)bp'DqNhImMR4,,e5N4iI0Y(3*%ZMM!'3GDU-I*r@@
+N%FV*E+!Y%!D1SA!YiR&#Q+N-eV9-rI3&U0EFbKJmZ4q$SARN5D"V"S%63qM*kFr
+j@$'pr6%5am#3!"&$aU#KT#-V4e(mMUbhP5D-F6$'Q`a&-"5K)8T++*3%%A%[%2M
+6N8BFaMJ3)fQkidcQ2KJ'%cPjKe2-%l82i5$m`pP)LU,K$b9Re%qCZ[!8#@beZFJ
+@%F2VkVKp''lT%iPk"$5MGXmmr98%CFqffC1aqRHA+GTBV%HI'djP'aa$5cS,!NC
+-I2c"$&,((C`F5N8MM1iJ#!&X(h2(K)#"d+BaM2!j,4D1pkklYhrUhNml5%N8@d)
+N&MjqN!$F4ID&5(#T#5BT0a`mcUh5iMJY2KYBA*c1`N+2q!i@@X@&M04TU*1jca+
+j$eMJ-SH4+jE)[F-!M!,!p`"B23"l4#)H)q+I6[52p,L#L"XCm4JM(K')`qM8P1K
+E!P'SJ'qVIa(q3G`64,ajT2%"ZV4VeBMV8q(D%[Pp),HI!GVN)-f2-k)a!,U,$T3
+18MV3#SRiNL$LS(eIGaAa#R)#V!qc`%3F"XCQ'&@XNAbdI@rCeP-@qm!&dE@#13*
+R#Sl!05X3EUeSq0"ZI$"MN!!C!mIphN`F[4%+F#-6E(F&ZJ4AGlP%-qk-B$K-Rc@
+c0H034U*`r[eI8%`qH6#$`XYJ28)"$&`*$-iVM2f)&0Bi))5[j+2S8S3&0!@Bbc#
+8q@#''XPpN!$#e)0mh&qlp1"a!U,f(c6M$K-F%Jii2G)LFQB2XdRQpBdVXF!``1V
+T!eK1NmErjYrL%-R&AGc)A"CR"Y$aT,$Yr@GGUcVkHcXHl1I-p0qRdd9QU%Rh-JT
+Z9Jp2ZNR*RMMra-ZN[0EQKXG(1kj`YAGS)YqL&2VmpQM-kLkTd#[q@+Dlj2D1jGc
+R[fpTYppA#TAL$GfS#V(M-[Im5@"4`T&5[Q2lE$-#E&((TXC5'S!,RU[`6PG(GGq
+UACBf&(453EpU&ip"K0aFh8fL9+PBlF+`6qSHN3Sp%Y[6eIF5ffDaHJ$$&k4Z45V
+FNYLDUfm5fcUaqJb'mk6ZFe,KGY@89k3T#c"F)R9IP!VCM1@'a(+(QC!!"&0p&Sb
+Vj1`GSDDjjh8Nekr$058kV,I#FELRPlS`''[S,Cb"KMiD&*UaEE`MK)XqcJi%(5L
+,D')8K(0DQG)-pCRI%04RT4iG1j`80SY')Clb)JTP34aI,T!!K8%BM0lcETYjP[I
+lJb%%Q'SDEHBjU*!!mHqDN!"jfRXfmdbB'M#apmE+ii@Gp'(Hllhah['JiH6Cd-B
+lbPjdPG%J%X6-L3c@I4(6`-(!dS2"p`'@MKe"039Zl5`X[ZL(%($,&N%FUdjk[mh
+#P$RiD2CqQc%P'C-a&EUV!RBk!lD&!6ZEJ2ACc!XZ654XjRRTU#$@E'UKJ[FL#qa
+3#"-+qkCUB4#-#kSBIp5%dF3BC`Q$!$P*Nd2GjX,N[XAQKCF+ZQcQcmUAi,@m[!A
+(Y!6(Y$5b'+%2MZj%SKI%mbeBBUk$S28@%pd-l9`DA#J-3Ya"SCdVQE4!BJBEXD3
+k%k(bkBdZ'%YQNqX!1F`-3!cJbl"a$"bfb4r$K,)%2p-hf-b9j5eil4-@H,m2BLY
+C85XJ#aaJSZrLmR5T(Kb@-)b!B"4J93@5Q""`6qf+VZ2QP8$L([0RH'de,m9,-5r
+I8'!aQCIJ)f5HMYHRjKDm$TTRSi1E'r'K0mpL(62a'M(2B4h69*YjTF28H(*5MbS
+6bC1&h,4"Epkh$8,)*e-EfXb9kb'XRi"c`!Qpql2(),*[-*42aq"m$#ikdFB'NdN
+$0k*M550G&SFb#eIEd&EH`P"PQ)4AZLc3BbrE5*i+lLrUlcUqmEUL"V%FDFT5Zij
+BK%-e!*N01"cm,$!X0YIKCq&JU(bRpbjHqlcAT9"ChE2Cl2L0`L&54RdAl05TdQB
+'MTB0JXa4bQiNk[PZ`[4#KM'$3fa!"rYBik0LR"LkEQkCCMk+c6Y+VM4NmV'6dGF
+BaP#A69i$aU4$l0+EMkTC,)-4!&8Lj1ip-ZpDTD8%bJ*cN!#$c%%%L(BXB"5b$*!
+!q-h)5X&N3[&V[$dNDdJ-&qF,dbDbP'faN!"X1G8+HrS,GZXCB`mr&32E'M$0IPb
+[c!*,6"+I66fpe+@X&&#8"&K5b'-S+#UZS[Uih3U6Cj5-Mb4FQV8NB!SX")+P[Ur
+!iKX&FLJDZ*-NJj`&KU0G5,b-U#,6aD1Q%R)D1"G'&B%i-piXJFT[TF9`1NMDNk0
+ReFh1P55`eJZ11%H`aDqLZY&Lmi&E-F1@3Gh$6e)6AIY2[R&lM$SGHBdIiN!2T$)
+m,F)90F5m854Q)0Pb(0JB(9K#RdCie+YJHC`kiIUE2j!!N8UNf-ATD(8q#[V5jQk
+$)H'Y"$N,5)P1H5*PEUN+lMmf8[H,*B)CJE+T41i,#TKUT0!e"50(kM)253I13Kq
+EbJD3!06+f04IPl&0XkB-416NCRE#%4JQKZT-r#cVkS#"#N(R,TF8d)i5-SJG$"Q
+D,Jc$0(88`D2N)+T@aGr[+TKilYc,fPKA`GP98bm!S9)NR[E"2%8U+Z6&*C,4dU6
+Gr'qQLY08mVke)5e$#CQ-`$1!c"GN"ej6mXZ'qk`KqDEli8'Ul"#5E9)K,48+T3)
+IY+6!-Ph!346*&-Vbf'%fP8IPPjR4**k18"JrqID&$!6`*C-+NY*T$6EjPPeP6*Q
+8c$9eVCKl"FGj,i5CZQSVVM@!+af5c%flYRme`65lp5db"FP*ZP`J'`VC$aR2+Q@
+mERCaLh4aK9em3(jCJa!X,[C-eG925B@`9$JM&5b"UeZZXUYEF29kG[91q@8!Ib(
+iqNAHl9cIqH1[rim&)h8("ZMkQi`-KHY6drhL-Ph32-T-CCc2&G"YlYbe2(a$B)R
+H0YP%@IE"K'4QaV*Y+-VfGPqrIC+51&PM9`'Q4TZ*E$6,RQQbbFJR5G[2GQTEf5Y
+653U$'fbb6eX2CJ13!-dQZi"U0VP$fiIAK&BA3$Yf!$kl"J6Rf$YTBZI3`9j82(#
+*+j!!*CG4eSJi`iZC`Pf(Mp1Np#V0U8[Y(#0!!@$%&j+(cM!hM*`fU-JlUi*R-J)
+B5El1(Yd!JD@m8['MLC@U1U(D+"b!+$YHXd5-I2ajIrd+2SkTGY,%QrI#I(kekR0
+R*-aI&(I#F*k%N4a&9VeKjl-VH*Jre)-LUf##*!9,CX"i5L'fIa5BGQ[j3k`i)bF
+Fk5epp"*9JQbRJAHT+J008H8fNM`UQ5+,dk4BlF686R+-LT8%9dBCTdT59BN*a,S
+l!SUEMK#`jHrKjdJ)4bkHa'Y#2#&Xl%&XLhJDVfla-MTFiN*m1-9jH0d5&`J)-D2
+&`hfP-2"(fCDl8S'ICr9LKUr8RSNX0HT-iY9TE`D486LN!h(&q3VX3B3Z6Mr!b@!
+Ej#H"9ET1`#!r`V*HGb"4)9-bQFd&jjrUBX'JE"V&G*e-Q5XL8NNZ12"dSH+*YYZ
+(+c-8C4R$%Fp4N!#m1H(ZU6@%4&N6NK-!5b0H&`c*-(XhrVL'&35[DmH%jMA3X&C
+cbDbG#d*Va1[5iD!CKQQLl[!dAbr#0dQ3!(p"YV#'&Dl-V'P9cm#XKXD9@iaRHmQ
+F,B![qi4XCh%(VP38EJpTTqJB!-4*C)immB4@Y`&1qpSa[%jVkhfi$$Zq*,Ij13C
++l4'`,8+Q3M8FV4((N!!")b%GHj38#FU!k&U)$)S$#Kb1$aR)ILXG%V9)jPBLJ*)
+0XEhi2lI!H,e0YBRDiBjI03*Gka`ap5pNd%hmK@@qX,J#BLLbh82A#)`H,),!"'F
+*XEJ"cLqfT3,*U0D`@$MiJ3a-9@drFl"Eb-*JU"BbEK3C4qNjfrX'!hNpMQ!XB,3
+[KcTbE&rJf'UH9*28P)9,!S-(&J!B)@RMFR[!P#iH*4@L+Pb(N!$q50e[@aRk0GZ
+Mj'3#B`#3!*-E!k)c*3qNVUcD`kpSG+89bM"6*&G6dM*cfUJqr,RhI2J'Z4M@rKk
+Z"(rSkCh+U(+FcI+1qcjdcJjbcMa%$RF`9V$Q3c2*Vb1TQ8Z"369dl-XZrE%[m,0
+LJfYMYX'fXG9JUmj"H1N+IMLDT8r`8lmY9$l$e#EZX-GJPDhfYr'R%GVHMm4kEfG
+)GU#`-[)BjrFFX%8RG9436*0&%,)3L$!0851@KU0$1R5X!8h,LXXA"@CFe@U,MNS
+,4V&J)j))bb%JiKNimY'#"4LiFIN2)hADph`ADF'P#ck!P9FYC%RY)CBCh$39$"a
+qDBT'harSF#mP`(b&-D2Ke5jKc+dd$CK,*I)r)PCKdd50!$)H2##!FJDSdCN18G-
+A[3+8(+2%X%Qc9ScYZ*d+B@h!SCC2DqS8@-U4)$RbS%cMN!"+)-$KXV+M-+R5X6&
+Mm$d(`P``3%&B*b4mKT!!N!$#V&fpD*`QY$%KmiG$f[VfV'q$(&#[UTV)50fK'Yr
+G2%r%*[j&LbUC`X'8cjh+`*60T'JI@iiNrdF$'D5XmQ@TTJFErdA$iQ-Vk%#1)6X
+Fqa+&,mM4M5&QK+QA%D$,&cf,Mhe"TS)Q6S"@##20$A5e1"9rMb*3'+qAb%@[(Lk
+#%8-KEiFEB$-pm!$'A,Kdr3J"Y%-MkABq",!5!![9D!29q1N3I$Gj,%p,46K1)jZ
+8'`11iD`jY$*MBBf[%)c9QRBHSkQ%#GK$&)CH+N#9arDAb%@`(P1@![RQ5YN16GK
+-V`D"VN-V@D0998NH6IblpMK0kmL%fCK9pFLTFLH%JY@-CS(%Qk6JeTS+[C)VbSp
+RBikBriD4A#E`F)US[CiF'[*H,5aN,Z-!6h!#dB`(h'5C'8GJ(`-lBb,h#c)(1U8
+VL9pUq%"'X'XY1mL66PBC(qBm90Hh5`fP4(Bq((Zdq+Pfk+K#*BS,m92'R$fd31S
+qE`DF+`U%!DT-LF'eE("ZC$kjlSLI1@G&jM1hRqA1*A!5LpKeM(d[@,r,@0Z&!BQ
+%L)k$V)-D"Y(1(R4J1!RA"J6aP'E*r+Tp!BBBlKFH+'*1+8NcbE(f'JH)j%Uq#`e
+@(6QPS%$KFP59P"F*lL4b$VNDNT-+'BFB'K[46)i+3r,q9Zj,3RL*UNphjQreGh,
+D!-Ij2*8pB!3L)j&2EB,6PA)h`HY9"lPel+Tb8jSVZ#Q"6C9!ZTFf`@NP9c6DPT3
+,%0XScYmK9b!NPbHfj`L8qceQbUfXQYV*MQjZP6Y5TH$ZJki1iH,Q#MDG4Q#Nbc-
+(-B3pK5BLjH4$KPlKD-`,fC+)F'"Q,hdbB$Tp#01S4ArrQS'B&0b0T%@251aAT'R
+2#CFeRi%lmPkqNicNJXU(V6R0R+,)l63ARcNS[)e'ZjL#-*,,f0X`3cB2!pA34,m
+IP"NX%(6L3VBK!5MPPN0,i3J6F("1`T8QU54lHTAC$Tj#GMP1e345&9LZm3)%!aZ
+q4*8!M`HSm0dTMXI)E0%M@0[&a)S'Z!R'hB@FUKG4*LL%+f%Fj[Tc)CJ$a*-(Tm6
+E!,d!S#Z8C6AFe`[hNRcQ%RI0EN`4h3+95#*k!@5QiHGa,0iABX&@XB+4U`'C&JU
+l%KRRHVJp'C(`Q@Kk(16%50hqDXdiN33j9#Ak,Ki9Jkj62!9Jmd3'Ueba,0KP1RA
+9dEP0rNqNR*mGr)0K04T)"R+IHS0,0!i*lV9*5P+J20p4ZJ8AkmT)H"aC`)9(R-$
+pSjeIFFfiUaE"fA4)J`F$)I4!4TTkaN*'3d2ML@'pJe8PJ!0-9X#P'C@,9J[*dVr
+@898DYS6F38'f+RN#XX,4&5#NT3S3+A-)!l12h-+TfJ-fl*h*l`ceYUjc&b[eQ8E
+hBjGG[[km0EjqCj`HL0+!#N#h*JGZV,aaGCqLCPS&"PXV'+b*6S(K,+Y3iG2R*Ep
+jr4[6RjMa[eZHMlBE*cmC+PDmhjMZp!pmVUaTAcH+!69qm[0+226KQ`prFVd5MmH
+i&%[(@B@5-lePc1'c1Cd&4e#UG$!3MNpNU&NR2rpQb98Z2JQ6qmlYEC*UR2c9k,+
+Uelq2PJ5lU,0!'Djj9Rq1UhpAr`l9YTSk"r&3'ULQb(JNU%A[3&L@QVmX5Zch96A
+E3*)$DjXfd%!e`C5`6jG9iA)QVd5RSi,H&@lUj9R*AJ6ik[b'39f-*TK*9@8d+pK
+NU&3ZjKPX)J`3BUA2aC4kPm2kpq@VpP520YkBe+H0JcT,Ql!-XYfAh%m$8-jRZQr
+UbHeX#!ea""e48YQ)B04+"K0P#X,[8'"a8I8`&ZhqSjkj'q#&cj``((r8)+BjQKA
+"a)Z@%d!T`N9IN!$aJ-H$8Bl#5E5!+Y$4Bk"'m3%EFL,iU!l(QKk9HjNe*1lj9fm
+*VJc"V()#eirBH,fiblCNE8MFEqVI)G+M&S#SR`rT8D89#"ATjj%mDap-@'*P@5i
+Yq`V,P!%D1"ICaiEm0LJRZpCDKi[FIhrdJ9Q,aCfME3T9NZ(LSh$#4q8e0'fS'VH
+@UdAZCBpQ0a+,RNMX+b%#C`Q3!,0S)&[keN@k88Pq9%hf&)1Y!T@8,dD+bDR5&LH
+P,RQS!)NiA4DZ"bj*`(i,9CjVX&"c5j2``af0hkYI3iqb@"&m'&Vr6hmB4-cCZSD
+1C(HTb+iDVlTU(0I[")[H+B"d&5,NY$@kHm6P0R%rBpj4aEa$h*AFcGZDEN[jPIr
+[E9NX6[XrfjLKi)hTC"[6fA4MKYki-6eXBkaA1#TkAh@)MGdDIXAbDe[65aekqkH
+rP2V2MApVr&YL8Vkf$%GfR8fiP`(m)GKkqK2p+l),Qbql%[f6c*hfG,D5a%IbG(C
+LGbFEZTaGGr'5[kii$bjh24F&4%QK$!*p*i04a[mCS8cN)KXbjI1cZjh6&@k1NaJ
+V9Z#kILSJG,*lEVCa,VUV&9kcLbh&idCD$b"4HP)`S*0a3Lk!)D1!URJqQMfT9cb
+M(ErG)qidR-*MTC!!m+jC)BSp[4-h)VeCIPYPbN3ZK(l*+-3U58H%"f&XfN80pa@
+Hcrrk'b5dlXH,eBjhIq1*ZIm`p*hre&+hffjF@aVT&d@R(pPk&"ArL`SX$mhhp9r
++(-5@$4E4BlRiF,K%DNa1N!$`dY-pm2NA5)5IQ"IX8ZrJ3f"Ufb1rBc992'*UicX
+D%kMY*(hm8Ip6I"VBCmP2qM3CK+)D9#9T"f[D*R&aQ0STN!!DbCXXX2`k$a8G2)P
+q((mf*6H6qVljh2V$AQkDiBVdalJ0CLPHTr1EA$[%6VmMXR0arU&Tl+%DpfH[1KB
+e#89+TXK)D)q4NC!!YUE(*KHX[kXi09EPDV5)FhYBf#`NP6[a'!Lrm,RU506[Fk&
+jKfY53PV@9k,K5RX6GP-9ZfPll&89cYmA'#RlU2S%,S,M2a*Fe4M9ijLD0QQ6me(
+T$Jri#mim[cbcrFccm1+UM"0$aQQKM%,KQ4dL5`VQMZVleYhQ(UTbM+lp,![p&3Z
+fq@'Q')qdmD+VR"rGA@eC2kYYeLpMI14GHMJ!&YmBeIHi2(Mi#+m-$*d9KQB&KU#
+QNI#q6%S`QP-2#VVrJ4m@#`mZN!!BLjXQ'9Kd)cpV#6,h9$F$MAAG4ee[)"*8BEq
++Q$+52dL,NpfScS2PZpMb(rbdbf1"6iHPdHmT)8@UTlHZpbUA[lJQ2AVXrZbAlNC
+0E2J)QI5&6&4c,kUk(K!H##"Abh2N#M%LkX8#SEUl`Klq"A6B)hp*kX&J9J`"9RI
+*)%mE"GA&('1CX"G)rVdRCU8UUV-+VAh#eU0bPT'bprm%SP2P#50c54MiI#9Pf[e
+TUZ`LLEFETb2a+4%$&D@4h5Y23%'-GYR%LZTjAEh9#j%JUG8V0pJfCPF[-LbZIUp
+Y6r8R9B)rJYj8A@"T!`(PJf',c%(915"6*i3RBI$+&J3+CY$aerlhVZ0i"*!!6Gb
+,kSeiT@2HMdCHp8k-[!S!!!*#!*!$#J#3!h)!N!4#H!T+RFj1ZJ!d6VS!*%*R5(N
+!!2rr5'm!"%KA5(J!!5)krpC1Y4!!)'d!E%k3!+Rd)MVrbQF%6V83!%je@Bm[2&T
+&8Np#CkQJ*&GCMbmm4%&838*RUD!J9b"3)RJ*##45B!ibf'B+-KTJ!N)C8FRrr,[
+*CZkTSkQM@Bm[2%4548a#CkQJ)&HJ*5"3iN!N$@!'-KM9Y4!!8FMrq+QM6R8JAc)
+B0"L`@&I*rrT+3QIq6[!Jr#"I-KJd',#B9mRrqNT#Crj1m#$k)&mb'$3BX%*Z#T!
+!3@d'd%""m!!#-""RrNl`!!!J,`!%,d%!"#)[!!J[A`!%51Fm!#3!*J&)3X6$+!!
+U!8K&b-A84%K#N!2!`G##60m!2#)I6R8J,`!%,d%!"#)[!!J[A`!%51Fa!%kk!*a
+-h`#-)Kp1G5![!!3[33!%)Lm!##pI!!4)jc%!6VS!I#!"60m!M#)I6R8J,`!%,d%
+!"#)[!!J[A`!%51Fa!%kk!#a-h`#-)Kp1G5![!!3[33!%)Lm!##pI!!4)jc%!6VS
+!$#!"60m!M#)I6R9+J'SF5S&U$%5!4)&1ZJ!J4)&1G85!6VS!&N5!4)&1G8U"DJT
+%J8kk!!C%J%je,M`!!2rrXS"M"L)!F!"1GE#(BJb!`8K!-J"#3%K!6R@bKf)D,J"
+#3%K!J-&)3%K(2J")4il"-!G)4c)(6R8N!#B"iSMLLE+(B[L!`F#(-J2#`#i$5%I
+1`%K(dSGP#*+#BJ4%J8je8d"Jj%je!*!$A!#3!i!!!!aB!*!$B!#3!b!!!$mm!!1
+Tm%&%3e)$!!"B$9-$R1S'YiZ&ElRP&ZjU#kJ&,-#Y&VE`,r!YGe&Vp9i!!4lq2r+
+65hNQLaM%"%SP-R')#kJ$EAISXa!"!*!$#PM!!!`!N!--!*!&I!!"!*!&D3"M!(d
+!R`3#6dX!N!Fp!'!!miKF9'KPFQ8JDA-JEQpd)'9ZEh9RD#"bEfpY)'pZ)0*H-0-
+JG'mJBfpZG'PZG@8J9@j6G(9QCQPZCbiJ)%&Z)'&NC'PdD@pZB@`JAM%JBRPdCA-
+JBA*P)'jPC@4PC#i!N!05!!%!N!9Y!'B!J3#L"!*25`#3"33!5!"R!31)-P0[FR*
+j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i`+5"SBA-JEf0MGA*bC@3Z!*!
+$6!!#!*!&-3"R!%8!V33%8A9TG!#3"3S!8!!F!4#)'P9Z8h4eCQCTEQFJGf&c)(0
+eBf0PFh0QG@`K!*!&#!!1!#J!,U!#!!%!N!0q!!%!N!96!(-!C`#["!*25`#3"33
+!53"&!5k)A8&Z)'PdC@dJGf&c)'0[EA"bCA0cC@3JGfPdD#"K)'ePG'K[C#"dD'&
+d)(4SDA-JGQ9bFfP[EL"[CL"dD'8JFf9XCLePH(4bB@0dEh)JC'pPFb"ZEh3JD'&
+ZC'aP,J#3"&S!!3#3"9d!F!"a!+`%!Np,!*!(5J"9!41)1P0[FR*j,L!J5@jcG'&
+XE'&dD@pZ)'0KEL"[EQaj)'*P)("PFQC[FQePC#"[EL")4P-JGQpXG@ePFbi!N!0
+Z!!%!N!9S!(S!I!#f"!*25`#3"dJ!AJ%PL%j6EfeP)'PdC@ec)(GPFQ8JFfYTF("
+PC#"LC@0KGA0P)(4SCANJBA*P)'j[G#"cGA"`Eh*dC@3JBRNJG'KTFb"cC@aQ,@9
+iG(*KBh4[FLi!N!0D!!%!N!9G!(!!F3#X"!*25`#3"dS!93%6L$T8D'8JCQPXC5$
+5AM$6)'eKH5"LC5"NB@eKCf9N,L!J8'aPBA0P)(9cC5"TG#"hDA4S)'0KGA4TEfi
+Z!*!$+!!"!*!&c!#1!1!!dJ3)3fpZG'PZG@8!N!8%!!3!``&L`!)$k!#3!``!+!!
+S!,B"(!3"998!N!--!#!!#!#L!4`!JP99!*!$$!"L!*)!m!'B!)9993#3!``!+!!
+S!(8"2!#(998!N!--!%B!TJ#k!GB!KP99!*!$$!!J!!J!SJ%F!)"993#3!``!+!!
+S!+i"6J#e998!N!-2!!)%)'pQ)!FJDA4PEA-Z!*!$-33!J!#3!`-d,M!Q0#i`,#!
+!U5!a16N`,6Nf,#""E'&NC'PZ)&0jFh4PEA-X)%PZBbi!N!-D"!#!!*!$!c3Z-!p
+6G(9QCNPd)&0&35!d,M!!N!--#e9Z8h4eCQBJBA-k!*!$#!FJCQpXC'9b!!!%-d&
+%3e)$!!Ch$9803b)5%HCHEK"N,4P%D[*%*!X3@DZQ*LHh2BZ-i(ERb%Qh-e2bQAp
+h[qrELM`EhmbhY8#5eFlXbH4*f,ilNa'5j9ENLDc)laq42j1IbEcCeRB454B6XMF
+Yb5)S31)(rdjCKT&84$LS#cYiiLGf)5c5J1e3aD%@GK*H(mq1D3bR6lpC+R)6)mR
+Y[@4[%r6@hmf'R%[)+8FIZEr5&V,ejRAjaL3*5bPTf0kN&a@6NPGC,a$mi-RK`KF
+HI%V$*QM4BN6+hFfqTX2b,*5j55k)jb(*(2h&i)XDJqim&Fee*9$cG*JIMZ6*i#S
+GjViNe#Xq)@+3!*h[`af,NK")heX@$ED[(5XhPA-`LA1fRcbNbSE0RBqrZ,m'l)Y
+Vm[NQUD!A@)"Ck2@aqNDT+'b%UlJKdF4%D4j'8D8QKLJRXm5(8JQR40@4X8N6+L,
+JmB-'82KL!,85ECR3J#8d%@TbLdfC`eLTT"qR$+aeU)[Di0J#T6DMFe4B`aLflrd
+NJ-)Z!m3jBTLiESAmcl%RFHbLl9fAJNh,JDRU`pD$+ZFdM(GdeX@!G"Z$#pDfYBX
+aSNc2)HBbh"2bA1lEQ20L2d(0f,[Q&#I)A'ZQ2(KBb@@qIDUNT-rSkShVZbh3b(2
+j4EE#Hi"%aD`5%YXK48JPi!JpjfESS#*')G-lpU&Zma9#N6ZP%AF+hP-PhjBJ16h
+DlDNc*qDmR%1jlK@TB-cEfPh+FK[jplG1#3aZ,GrmP`rLNbG@J3Mpl)N"@`NmD#E
+1Ye,'NV,SJ&0-'N"4lGDH(L15jV)kGQArf*KLjXEBBNT+ilSFVqIQ2L6S6,2!-qd
+r5A,SM5rZ8%e+qrrFIEa)TAK+(ePf3"KU9mH96KeiJM&J8-CCH2(UplHlTpQ8&pI
+V!mfS&!eYS22Y"H59K,,GX(5'$iDUN!!D1!1%4[Dm+R'd+EK+q$Ll6eBP[SHY1Jm
+&+*f0f9@c1LPl$U`!LB0EA#,N"l-#h9`&eEjM4RfXIVf`GZf$Y!rlJeGII3NEUUX
+[JA!5-Xp,Z*!!K9k#PFalib#6LH[)jR!53fYB8Y@+#cA4e!fZkRA5eL(bC5reTB0
+Nq+`1N!#ULm1*SfpKL@KA(V8&MK(J'6fDpK)ZJ-$X$'lTUd'pQXb1L-Hl60lqhlJ
+2YkIbbBfVNkBAI5lbXT26-1CCQI@i%dADZX@J'V("P$45$f-VG@mlh@!+D@pipZK
+GMr,CUC9ZcXXMqF'dI'XXGU%XA8IkajQ+#fPh$2Aj@FVRjqVrINKT#[0r9hl1a'B
+ar[EhjGLF9@FZ6fPZ&[UQ90aX9RVbi))fT0[hNY60m9Pip++5qIc2PqqBK`c8pE9
+GaLXRlhFHm(""&mY9YB2CTqfiUkZ$G385RX(1bd[ERX3qk'4JZaVPpDGj!R%'T["
+3[!PH+Gc$PhJ`"hHqIVA3@F0Eeq31!!!",d&%3e)$!!&Z$98,Sa,3(`,[MX0G"i1
+VS')4Q(4+"CeP@S'Clmb(SM82Ip(I(*K(D4A2I'$q&[0K9K8c&"2&r$@V5EkTU*K
+9439&phSP6c(*!"1aC5A+J0LHE33'eM"R5Q-Af($455FbMP!J*%5L5"VfFJe#ABT
+bVcRA4B@a96dp+RHhD`rFF&F@))QYk$RCaCMM3iY@r'%I9"NNRi3H&+6Nb+Ekq,R
+[CKIQhmVFF$J`VdQ5m'YemhE`p&D5E6j5(VmrPl$l$k3rXTPHl)!0@&jc$0ZABIP
+&mp&"JI!#DaENdTMml81I`#icTcGeq@6Upd1K&[m+1ImYiqD1UMI2ikh!"rA+h@G
+FD3IbmLC@e9$jp9!k6JUl9a2!KP1+'B$U)Bc230$[U!%J"*%91SCK"!!!#4G"4%0
+5!`!1K3jG#k55),ibhjhrq-jHjTcIRm3X@FlH1F3CSh%X80,b[R0QLXqEJ*aX40@
+UcFUD#%5Rl(e8JllrGqBa*dc)b``NKG+`*T5N3Y"1UPMIThV[djD9N!!b0-6@8G9
+SS`-*3XV@EJZ,ppfG(@H&VG9l$HjZ05)#-d3M(d0&9JkT3rK[IJhrMG+c8Cl(B+4
+U`aFMihF0N!#jkkJ(bAf)aK,IG)P[ca,IG-NC,*)9Q2S@4ApLIjK&+S'Id[Z4`Ve
+!C&F!hk33*VJjb0NB50)-%!X)p`RCp6"I8pTh4UI[+E8`dFID4ZkGr@lA$AQDlbl
+dTY[ZH@,hr!+XiD9#H+cpQa8c%jVX(JTT(9@GRD&+8bJflXSeSl4`5cY$Y5BUZhI
+&Y(p9rDdY9MhmA'a'S26RfD0D,'"MJPS)PR+'Y$*IGS48-42MQe(`[2"&@fPYS(Z
+$2,ZVS#hMPle6m-bhq8GG`NZPN!#-)R+V%99PNPlh36fhm*9bM*6G5(DLl6*[`RR
+N%1kYe0apJX"08h9pBpI"UeK@ZP%fDY[@f0f"j$FB'16,"hmb'lqqr(ZIF,[qqr(
+8P4F2LPmU8Y6lJ@,C*HD'0C[m5%SlDaYhr0f9c5@RlpTrl%Ba0h%pIrF&([T)hhC
+PQkhZV!V"p*ICGPYr00)ATYFTIIZZ+Zh!F'lqJ+RpekRmf5JSrZ#`Jfc9YhilkVT
+Hh9L([6AGJPqp[j5#5'i#SGl@1!l!f0$([Z4B9)JpbTMr8K%pV8&b'lM9+a*8%hV
+&U'bb498Z@DQS*MRZ&3U9S9IX$jNN*bhPP@UI8TA)Arc+eR608jlGh#RG(Y%mCIV
+ZHjY0eR5&1qC1dXc90emD5,Ej@(eFD1XV&rqi5CRVdF[i&43@eN[fU#"2lpYa(Vl
+C*ZUUNZp0XGNQB,2*LUI#aR9CrBK0&Sp+b8*6C1J9E63Tqf"5i25flDL4ELQ!0#R
+1JdB29[1P&-F&`EQV34i-5ZXME9iP2CJ#Sq!JM5UKU,HpAUd@9Ujj,Ce3erhrA2Y
+0)fVEk2m'%q('2UUC%2HLD&+GqD$mXUXk4$HdCk9'VaEk0mH(e6-fT4pmjRa9e3I
+09fm)JH',*UjGkCYBVDUp[eRI+)5dJF4`UL@ija2YP0UeSHUUm2!Y1A!N#i,p%r+
+mraE)KC!!h)mYI"M-*-j`h-92m%VhR)6A)GbRK)!S@)q!m3bE39ZF$L3#NlajP54
+K$2XaQX4Q&+bEm4`j1AMiN!!D$8bLH48j)NdQ4ZlPFU1$$j(RK3$Nj8cC#bja3Z9
+@VceajE1aV$3CP1@85*e1e)0Q)jGcLA5!ibD49*QcdSUIb6+I1lrc$,UNCTa,i@!
+(l&NX8Z!UXl)Fc@N10p%$TmlaarF12*%VqVQP+IbmGAC[Z(*i4%i0ElMdXHT++-Z
+e+['9N53H0#4Y9,3%Ib#8d),3L422HK!GJGBFY,LYf`X9ljIeI"9HZ54kVCUF308
+$Ta+%AGi0FXiSpX5"dhYD$!,RQ3U0(P3fjfdBeq`NrZ'e,erl6RVGI#'mVR"`phb
+T-2,3[')Sd$cb3&!%V`adK&KR!aa2Y%%,Z,h0rNH#iVJi,$5IJe1*KV4GN8AeTLJ
+dhii*%jh+4+0lL-6G`Gb!1(p'+l"R#Xqlj[FAI)G0QQ+9i'Uh+QCdXfkhYb)Q$Qa
+("&X5L'&#mPXXm@0)Ucd%5eJUcINKX48pJ6d%PbS*K&[ci9Z%V*(I3hJPL`MrdJS
+I3`D53``T(FqmS[EkqkCA(rKLZIm!-KZ&[1GiTPFGl*ZpSH[blmr0kANl3fU1pr3
+DII1R0R@Yr)*!qJH3!1C*GFpaYEH[Hmh&ZN*A@%M6!%pD0diEiCSl$VHQjr`k#`[
+26@IZ9DI$daI6KAA2pN(q9D3Y+FMIp2MMdq%6Qblq,Td1hibPQPH&k,ZJH0C&,1f
+SJfdU0CD1i33[B404!YdjT'r8eK+UMqe@Db3GV(dcl%e2@"m1dpJq%Rh(6&#9H,q
+%2[!CM`9RLm[r%li9iPZYi6IUKXJLDiC`*LQ1j@0C1-R3A,AUd"L@,!$X'#)f9Q`
+GU4qjDTIlE$mqA(M5%LlfVkUm(4R$6f-Y*2qH0D6p36il*,[YSYC3Ef@,rIqX9*l
+!Ebf0'B$Bc0CR("AbR`1@-IY,[Y#8e9pF9R&@mL*83(aXZ8)Z"La%VB`"J[[p584
+Bj!eI5+Z3!-m'FQle8ke"Xl)9E+f!P-EiV3U5Rr1e(UmFZASXGdNpP#jSPS%Mep0
+4%N&XLQ8J!kB+PhfShJLZT1Hk&EZ'!AIMZcc23,,Q+,p414k9S,B6,'a82bfhAaY
+ETNrA%56ja02ZG*T5j4lME!"-qUA2Y$MMJiY4T!6X@Z)k)D`B8d'!AjJ-cVeXTE3
+(16-(E(Pb4Q#Tj'@9#%5hl5$Glld`DH2L9KVmeH*EFa9hpIDl1`$QYF(BlY&bTX2
+dqBA$reLmd2TDRl(Y0,(GBIAPhAX"rrC*9qj6Dcd$H#M1@jc&$Y'NGA48bXlAXh*
+S@kH!Zkfbli`-Z2M"q(b&pHX4I'G4%de6YE9A(RA@qh)a&f[!UpMFMmNq0q"eB[p
+iVX)kEUcG1DPY3V0$`62A6#EC@@pc!%i&h!kia8UMBYEe3)A945F$!Zi8m+KTci2
+1HV%pT#rHl4bkG*dEl!9mF@EmL(@Qr)X@N!!HQJGM-lYP`%2C`r@*QVC6V('0%["
+TN!#F,[k0%(eX#hU3!0aHNqRj@JSe6JF*I04KqTHADUE2Tc,B-J[*j9f1hMkq&-B
+!U*!!KfX`AB-8B"Ah@IS[4f&li'IQ$1CAe9if%aiqGN!&Q%S4&CiQhDIf@FS1cNU
+jaA2YaBpQiQbY3i'CP4mCLmX+L8rILUK3`8dZHmjaV0YkRM[jP2ccRlVip*4Me-q
+APMjP-@A,$9P,I85&#Ulqe@iaGfcqU-aPXh*qlF1-@ZZSlH5C1mA0TJqUQTkf2j&
+8)5`qd`4i3-FVSVN)cQ3YT[jL52V`9&+&J$mj!EMGASjQX`p@2&,*6%A`c5D4[Tl
+00DT3H*AkL5leI''P)l9im[YlhCrhTp2DG*J[E4#Y4L*[6e`je+K#q,'4%64@!PY
+K&Z!k%mV9AKd1kGd&SBA5Q+kqLIFl@5H@2&IJeq44!*!$'!!d!!!"(!&S!!%"!!%
+!N!8$k!#3!j3!N!-)!#!J!3!#!*!&('&eFh3!N!-"4P*&4J#3"B"*3diM!*!&J!#
+3!`G"8&"-!*!&!3!!!3#3!`+!!!!%3!!!#5!!!"13!!!!*mJ!!%%%!!#"!J!"!!%
+!!JI!J!32i%!)''!J%"[m%#3DP!K-'[3NRc)%-N`ek2NN05Jb%$Ii*!J`i!J%(q!
+3!J$!)!%$m%!!J!#!!%#"!!!JJJ!!%q3!!!R)!!!%N!!!!!)J!!!"3!#3!i!!!!%
+!N!-$J!!!"m!!!!rJ!!!Im!!!2rJ!!(rm!!$rrJ!"rrm!!rrrJ!Irrm!2rrrJ(rr
+rm$rrrrKrrrrmrj!$rRrrN!-rrrrq(rrrr!rrrrJ(rrr`!rrri!(rrm!!rrq!!(r
+r!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!$J!#3"#!IU5!a16N`,6Nf)%&XB@4
+ND@iJ8hPcG'9YFb`J5@jM,J!!&8J!N!-"GJ"1F8U$CKT"l3!J-,`!#$&m2c`!!M&
+m!!%!"$&mUI!!"Lm$,c`!!"5Q3IVrd0$m!+)[#%+RB3!#*Ylm!""R%NU$C`4`!8j
+e6Ud!)Q%!!pDTp%ja5S0Q!URdF!"1G@"b38a"4%4$69!!!`#30&"b3@e)jf$`G$+
+I`Lp)!#!J6b*8-@N!&!!B)8!!*$&m!!%!,0+4)8%!,U!#hm*-h`m'6R9+1!THC``
+J+J!)C``J3#!3C`B[1[q%6R9)jam'3IVrRR!-)LS!"-+i!aTKT'B!!4*)H[q16VS
+%i&K2X(Vr@QB!!1bK'Li)##S!"J!%C`BJH!+QS"XX+J!%+LS!#"JU!!5Ae*A8)$V
+r9U%HCJ!!c#a))$Vr5L)'`VJ$'PK"B3$r8L!krd,!Z!-D3IVr2L#!5S9Q"+%LB!3
+J4D!RCJ!!Q#T),cVr!Lmkr[S[1[lb,cVr!Lmkr[T)H[m5,a!J1[m!8B""q[lf))!
+J$P#!3IVqk##!5(S!HQ%!#L6Hr!!J5N"R!URr)%kJ(b"(S"Yb!")%j`RM'H34!!%
+!)!)"!1!J6D"T!J!!(i!")%fJDYA8ep4"q[kB5T!!C`K`!D'BF!1KQ#"0*8J!#(!
+!60pJq%je60pJq'!!rZ!J6U!IeG6Ae#"(S"X`1!)J-F!+B*()B1"19J!!51F!1#K
+Z!!a(q[jD4IVq@L!8X**Y"#!5+)"+J'm5)&-LEJ!)SLiJ&0'6NC*`!'!%-$crf8c
+I(!"1ANje6PEreNMR%aJX,J!35IVpmN)(S4SY52rQ5Li!#fF')(J#TU!E,c`!!+$
+m6VS#RLe!rqTB6fF!!Ai[,[rU6VS"q%S!@%pR"R!"B!!"FNKZrrK)E[rd5'lrlNk
+k!j)J,[rdS4iY52r`6qm!$'F!!8JJ,[riS4iY52rmC`!"1LmZrrJ[#%kk!qC+VJ!
+88%pQ!!#8@Bm[2%024%9`!$m!U"mQAb!,ChiJ%h)Bd)%[!%kk!Y`-3!!$@%pQDL!
+0FLM3J5e!rpSJ%h3Bd))Y32rH,`"1ZJ,`5-!Y32rL)%ZJ+5!Zrpj3J#P!!#KCMbm
+,6VS3d#!IFL#3!)%T3!!X,blrr#mZrr3[,[r`,`B[,J!-5'lriLmZrpT)H[kX6VS
+)9Lm,UD02l`!N+@lrkJ!-+@lrm!!3+@lrp!!8+@lrr!!B,c`!!+'B6VS"L#e!rpB
+[2!!!U*p1ZJ&k)LlreV#"9X0%!dL$5--T3`!F+8B!)#PZ!!`!*%Kkr*!!2cbJr#m
+m!!#Jr%kk!54BMam!6VS3@#mm!!#KQ%kk!6T+J%r[!!aR"%kk%&B`1!&Di%!-3!!
+'CJK"qJ!D)FJ$2(i")'lrjU!E%!G-lKM)rm*1ANje6PB!!%MR!4K#"bmm!!#Jr%k
+k!2)S3#!-@%pR5#m-6VS!8%S!@%pR2#C-,bX!$$mmS2`[2!!!S2a1ZJ#L@)mI!%k
+k$pBJD`!3S"mJD`!BS"m`1!&Di%!-3!!'CJC`!#(!!caq!4!(61iBJ2rd6Pj1G8j
+@!!")ja!)+'i!#(B!$+a"6%&%!!*Q&!bX4%008!!'CJT`!l"X!!TQ!RB"%!0-lK!
+)rrK1ANje6PB!!&Q22cbSER!"(`"1ZJp-@Bmr2+TZF!%I!%kk$ciJ(l#ICJB`2!)
+!B!3`2!3!6Pj1G8j@!!![!c!m#!$!EJ!+FJ!b!%U"8X0%!fF%F!&J!R!!*Llrr%j
+H6R919J!!51FI!$iZ!!T)abm(6VVraKS!F!!3"3a!!!&B6fB3!NF(rdkkrhb`4fi
+%F!"J+PQ22cbSRh!"(`"1ZJl#+"pCMcm((`91ZJkf,"qiKPI$4!0R"(!!B!)J"Nc
+Z!2Mrl%jH6R919J!!51F4#$iZ!!iJEJ!)+&"f!(!!-"3-J!!!384Q,R!!-#`!!Jb
+!!!"$8QBJ$%IrrfFB)#`!"%*!5%$J5#)m!*!$rm+!5-HqJ@B#GJ%3!dcZ%)Mrp%j
+H6R919J!!F2m[!%KZ!!K1Z[qB5J"36fFD)'i!##!S!!4#3%K!i%JL2!#3!rr#J$!
+"B!*`rdjH6R919J!!F2m[!%KZ!!K1Z[pL5J"36fF3)'i!##!m!2q3!m#S!!4J!R$
+r6Pj1G8j@!!")j`!B*Qi!%#KZ!!`JEJ!)-,`$!A!!+)!'P!!!!53'P!!!!NJ'P!#
+3!b!'P!#3!i!'P!#3!i!'P!!!"*!!"T3!!!%N"T3!!!53!!D8!*!$I!D8!!#!!#D
+!"T-!N!-N"T-!N!-J"T-!N!0)"T-!N!-qF!"-lKJ!rrK1ANje6PErp%MR%aJQEJ!
+),8[rp!DZ!*!$*2rd+'lrp!DZ!*!$)2rd,@lrp2ri"Ui!N!0)rr3YE[rdrr`'VJ#
+3!clrp#!Zrr53!+i!#,#Z!!aM"R"PB!!!X%*(3NCJ4R!!-!F-3!!%9F0%!fF%F!"
+J$(!!-!GCJ()%6VS0)R)!-JFAJ"J!F!!`"b"ZrrM3J$''#!"`!$!(%$-)!()"iDR
+F36!(8NG`!$!($%!!*'@`3NGm!@"'F!!`"`a!!!&9`d3$C`4`!'!-F!!`"e1!FJ*
+1ZJc-FJ!b"aQ!'!"`!$!()'lrr0#!-BB)!(!!-!F30!J!FJ(KUGa"-!G54h!!-!F
+-3!!ICE"`!%cZ'-Mri%jH6R919[rm51F2'#CZ!!`SEJ!83NCJ$R!!-!E3J%*d#!!
+`"P*'F!!`"R)!-Li!%Y+"XS"ZiN*'H!*J!!#D3N9#4h!!-!BJEJ!)jB!YF!J!rra
+JE(!"`+lrr0j!F!!`"A)!-JCd!"3c'!"63NM#Y)"[+(!!-!I3J()!-M3)!%U"CJa
+`!$!(d)!jK!J!9%4`!$!(d)!q0!J!B"K`!$!'FJ!b,J!5dS(5J(!!-!I3J$Q"#!!
+`"9*&)#lrr1+),8$rr(!!-!9b!$)'G!!8-aJ!Y%"LJM!'8NDmEJ!5C3$rBNcZ'2$
+rj%jH6R919J!!51F2'$iZ!!iQEJ!3+'i!#$JZ!"Bk"qC0F!!`"h`(c%"q!(!!-!8
+30!J!l#Kb!")!F!(!!A)!%J$HJ5!(d)"b!$)c#!!Z!9*'F!!`"R))XS"Q"N*'-!9
+54A!!-!63J,#(BX"`!$!%d)!L"j+!%!&-lKM`rqK1ANje6PB!!%MR$`Ji,J!52Li
+!$LKZ!!Jm"qC1F!!`"hS(bN"`!$!'IJ!H0!J!F!!`"A)!-J65J1D*CbT6J@F@8i&
+Q)R!!-!C8J()!%M3)!%K"3N'1JA!!-!C5J()!%M3)!1'*MS&`!$!&i+p`)*!!"(,
+ri+R#Kc!"61i3m2rX6Pj1G8j@rqT)j`mB*Qi!##KZ!"!'VJ!!!53!&!DZ!!!#5!!
+8,@i!&2rd"Ui!N!-J!"3YEJ!8rrJ'VJ#3!i!!&#eZ!"6rr"!6jJKb!")!F!I!!A)
+!%J"536e"rqS3%q))FJ!5!(!$`!&b!")!1!&84(!"kDJp32rbF!!3%h*!`J"`!"!
+"28$rm(!"kDK6J$e!rqj`!"!6FJ(#!'F+F!!`,[rZ8i"J!R$r28$rl(S)5Qlrm'G
+@,bi!&#mZrr4`!$!Zrr)[!#!,8S![!%kkrcKb!$)!ji(D35mZ!"3[,[riF!!`,[r
+b,`![,[rd6VS)I#mZrra`!$!Zrr)[!#mZrr3[,[ri6VVp)Nr[!$"#4f!!!2C+E[r
+`Cc*`!$!Zrr)[!#mZrra`!$!&,`![#dkkrGjm!"`!F!!`"L"Zrr4b!")`#!$D38r
+[!""J'R!!-!3[!(!!-!8[!#m,6VVq,M`!fN42l`!-['lrl'B3-!G54h)!-J"#0"J
+!B!!!MVaZrqjQG%TZrr"R-R!!-#lrmLm!,blrr(!!-!8[!#m,6VVpF(`!(!"`!$!
+')'lrp()!%M!)!0T"6qm!%'!DF!!`"#m!F!!`"5m!,`Y1Z[h!2!$D4%r[!!a@4Q!
+8F!!`"e1!FJ!b"aQd#!!B!$!(8NF`"P0'5N"Qj'!5%!E3,[rV-JG54h3!0!%CJ#J
+![Qi!$Q8!r`C`!$!&AS$QL%cZ'2$rdNjH6R919[q'51F2'#eZ!#6rj!DZ!*!$*!!
+N,@i!*2rd"Ui!N!-J!#3YEJ!NrqJ'VJ#3!dJ!*#eZ!#6rq#CZ!"c@r!%Ne[`#50E
+m!#$@r!#!e[`!J#e,rpM@r!53!#e,rpc@r!%N,8[ri0Em"*!!,8[rm0Em!(`Y5rr
+)er`!!)!!)!Z3!+i!(,#Z!#"M"R"PB!!&8RS!3NFJ,[r)d,`!!)!!,8$rc#KZrmJ
+YI!!!J!$rr%KZrr`[,[r))'i!#%k3!%UZrra36fB'F'GJ!!8B)!a5J,#ZrmaMC#e
+-rlSYE[r-rliJ$&+!N!#ZrliY32qf)#lrZT!!V[r),8$rXL!Zrlk3!+lrZLe!rkj
+R$#"-)Qlrb#!ZrkkL,LKZrklCl[r)5'lrXLmZrmJJEJ!)6T!!)#lrXV#ZrlC36f3
+'F'GJ!!5U(9crah!!%#lradM!d)"63$e!rqa`!$!Zrqc3J$e!rqiJEJ!3)"$3VJ!
+-,8$re#mZ!"`[,[rF5(J"*#m-6VVmG()!-J"+JGR",bi!(#mZrpK)H!%N,blrh%k
+k"E`[,[rJ5(J"*#mZrp`[,[rB6VVkCLmZ!"`[,[rFF!!`,[rX,`![$%kkr#jb!$)
+!5S(C`5mZ!"`[,[rBF!!`,[rX,`![,[rF6VS&FLmZrr"`!$!Zrq`[!#mZrp`[,[r
+B6VVk'(S!3NFYEJ!-rp"2l`"JB!!$X%*'B!!!Q(!!-!G+J'Cd)!a5J,#ZrmaMC#e
+-rkBYE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r),8$rRL!ZrkU3!+lrTLe!rjT
+R$#"-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJJEJ!)6T!!)#lrRV#Zrk*36f3
+'F'GJ!!0HHJ!D((i)F!(!KGa!F!!`"L"Zrq$3J$``#!$LM6!(8dG`!$!'$%!#5'8
+!rf!%4J*)F!!`"Ja!!3"N%#!Zrp"5V[r3)%!3KQ!!!ZS%4J%!F!!`"L"ZrqM3J$J
+`#!"`!$!')'lrj()!%M!)!$e"rm*`!$!Zrm*+J'-!!+*JH#!-8S#`V[r-Bf3Y62q
+Q,@lrc2qU)!a5J*!!V[qU,8$rSL!ZrkD3!+lrb#e!rjiJ,[qUN!#ZrkBY32qDC``
+J6#*ZrmJJ,[qDSLiSE[qDfHlrb%KZrji[,[r))'i!#%k3!#!Zrjk`V[qL8%pN"R"
+RB!!#G(!!%"c[U)U!8%G`!$!($%!!''-!rhj`)*!!,[r$F[rJUF+&f%&`!$!Zrm,
+JVCjZrm*#4Q!!!*K`!$!(5S"QG#!-8S#`V[r-Bf3Y62q5,@lrc2q@)!a5J*!!V[q
+@,8$rML!Zrj+3!+lrb#e!riSJ,[q@N!#Zrj)Y32q'C``J6#*ZrmJJ,[q'SLiSE[q
+'fHlrb%KZriS[,[r))'i!#%k3!#!ZriU`V[q18%pN"R"RB!!"b(S!'Kaq#(!"`)A
+F3(!!-!BJE[r`d)!m-!J!iSd`"e0(['lrlQ8!rf5FE[rZF!!`"L"ZrrM3J$e`#!$
+ra(!!-!BJE[rdFJ!5-!J!28(r`R!!-#lr`NU!B`!!T'"i)!a5J,#ZrmaMC#e-rkB
+YE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r),8$rRL!ZrkU3!+lrTLe!rjTR$#"
+-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJJEJ!)6T!!)#lrRV#Zrk*36f3'F'G
+J!!$qF!!3(1qSLS"34h!!-!F-3!!BB`$rIR!JN!!Zrm0brq#T`SA6E[r%F!!`,[r
+#i+fHE[r#F!!`,[r%5S!QE[r3Pm#hlJ!-C6BJE[r38Ulrd"#E)'lrd&+Zrp!3Qb!
+Zrp"5V[r3)%!3Qf!+)'lrd&+Zrp!3Qc!%8d4+3'EZB&C@4#!Z!"M3VJ!8FJ!b,[r
+%*#lrd*5Z!!b5JLC!Pm&J$L"Zrp"5V[r3%*X`"&0%5N4R$#!Z!"M3VJ!8X)YLiLC
+Z!!aJ#L"Zrp"5V[r3%*X`"&0%5N"QlL!Zrp#`V[r8C3$m5#!Zrp#`V[r8C`4`Cf!
+3)#lrd*!!VJ!-)'i!%##!F!"-lKM`rfj1ANje6PB!!%MR$aJQEJ!81#i!#LKZ!""
+J!!%`2!3q,J!18NDmEJ!1C"*`!$!'FJ!b""!d#!#`0"J!CHC64lK(C"*`!$!(FJ!
+b""!d#!#`0"J!BZLq4Q0)F!!`"RS!'M3)!(!!-!Gb!$)''E3)!"J!F!!`"aQ&#!"
+`!$!'d)!k-`J!F!!`"p#!FJ!b"Y+"0l-)!"J!F!!`"p#!0i8)!'##Z%GQ"P*%B!!
+!SR!!-!4k!"Sd#!"`!$!(FJ!b""Qd#!!B!(!!-!FCK3J!F!!`"0#!1M-)!(!!-!I
+3J()!-J65J6Hc#!!B!(!!-!I3J$H&#!"`!$!(FJ!b"*!!JA)!-Li!$R3!0!G5JT+
+#XS"M(Lm,,`a`!$!(,`"`!$!%,`"1Z[lQ1!G54%r[!""J)#m,,`a`!$!Z!!i[!(!
+!-!G5J#m!6VVqa$e(!!j2l`!3F!!`,J!1FJ!b"*!!JA)"XS"Y!2l!61iBm2rS6Pj
+1G8j@rra)j`mB+'i!&!DZ!!!"*!!8*Qi!&%*'B#"`!$!')'i!#()!-JBCX!J!'!"
+`!$!'d)!hKJJ!-!C54VaZ!!jPfLm,,`a`!$!Z!!i[!(!!,`"1Z[j)3NC2l`!3B!3
+`"P*'['i!$Q31F!!`"R)!%M3)!%U"CqK`!#e!rraJGR!!-!C+J'-NF!!`"R)!%M3
+)!(!!-!C6J(3!&$3)!**#5-%J,[rmikJY32rmF!!`"RJ!'$3)!#SZrraq!'!1)!I
+ML()"`S@#J#i"iSd`"&0%5N"QkR!!-!E3J()!-M-)!#"Z!"$PJ5'('!!`"P*')#l
+rr&+ZrrbmEJ!1CB4-lKM`rq41ANje)PmJAk!P,S"U!N+A6Y%LAa)I-"p+!@F%TdC
+J!U0',SK1d5*I%Km`(b"I5J&R"+C(B!+L4dl4)Pp`!D'B6Y%L,`!%)#m!#%(k!!S
+bI!!#6[#5rQ!'6%%)!8je6VS!*#!"6R8L,`!%)#m!#%(k!!SbI!!#6[#5rQ!)6%%
+)!F0!6R9+J'X85S&V"Nkk!%C1G85"6VS!2N5"6R9%J%U"D`T1ZJ!`4)"%J8je4)&
+1ZJ!N4)"1G5)[!!3J,`!)3IS!#M*m!!*1m*,qB!K-33!"`d"1G6m"5%&+3@BF)J"
+#38K"C`U#edK"5%!`!8K!J0mb!%*!5%"1G8K"2S)[!c3!*J&b!8*!5%"Q$%K!-!*
+b!'!@dN&P%Y4#dB#`JfAdN!#$dN%)`3!!C1iQ(c3I6R8!!!%!N!0AHJ!!9RS!!!*
+k!3,f[$J`!*!$(!*U!"&%394"!*!$NPT&8Nm!N!1H4&*&6!#3!kT$6d4&!!-!YP0
+*@N8!N!2Q4%P86!!(!2*"6&*8!!B"8P088L-!!!'QGQ9bF`!"!E*69&)J!!%"bP"
+cCA3!!!(L8%P$9!!"!Hj%6%p(!!!#"NCPBA3!!!)53Nj%6!!!!Kj'8N9'!!!#+NP
+$6L-!!!)fBA9cG!!!!N)!!2rr+!#3#Irr#!!#M!#3"[rr+!!#[`#3"3,rrcJ!!X-
+"![DF!!(rra`!+SB"![D!!!$rrbJ!,-`"![A-!!2rr`!!35i"![A3rj!%!!!Y,!#
+3"!3"rrmJ!#dk!*!&KIrr*!!YZJ%#pR3!Krrr!!!Z%!#3"BErrb3!,Q!"![C-!)$
+rr`!!,Z)!N!@errmJ!#p!!*!&J[rr!!![XJ#3"!2SrrmJ!$!3!*!%"!(rrb!!-$`
+!N!@#rrmJ!$"-!*!&KIrr*!!`A!%#pP`!Krrr)!!`E!#3"BErrb3!-(`"![CB!)$
+rrb!!-)`!N!@"rrmJ!$#F!*!&J2rr!!!`V!#3"3(rrb!!-,m!N!8#rrmJ!$$d!*!
+%!J#3!b!!-4)!N!3#!3!()!!a)J#3"B$rr`!!-5i!N!9rrrm!!$9P!*!%!qMrr`!
+!0TJ!N!3$k2rr)!!rX`#3"[rr)!!rc`#3"B$rr`!!2pX!N!@!rrm!!$rl!*!&J2r
+r)!"!"J#3"[rr!!""#J#3"!C`FQpYF(3)a#"cG@CQDAM(93:
diff --git a/tcl/mac/tclMacResource.c b/tcl/mac/tclMacResource.c
new file mode 100644
index 00000000000..1695ca6ca1d
--- /dev/null
+++ b/tcl/mac/tclMacResource.c
@@ -0,0 +1,2205 @@
+/*
+ * tclMacResource.c --
+ *
+ *	This file contains several commands that manipulate or use
+ *	Macintosh resources.  Included are extensions to the "source"
+ *	command, the mac specific "beep" and "resource" commands, and
+ *	administration for open resource file references.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Errors.h>
+#include <FSpCompat.h>
+#include <Processes.h>
+#include <Resources.h>
+#include <Sound.h>
+#include <Strings.h>
+#include <Traps.h>
+#include <LowMem.h>
+
+#include "FullPath.h"
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+#include "tclMacPort.h"
+
+/*
+ * This flag tells the RegisterResource function to insert the
+ * resource into the tail of the resource fork list.  Needed only
+ * Resource_Init.
+ */
+ 
+#define TCL_RESOURCE_INSERT_TAIL 1
+/*
+ * 2 is taken by TCL_RESOURCE_DONT_CLOSE
+ * which is the only public flag to TclMacRegisterResourceFork.
+ */
+ 
+#define TCL_RESOURCE_CHECK_IF_OPEN 4
+
+/*
+ * Pass this in the mode parameter of SetSoundVolume to determine
+ * which volume to set.
+ */
+
+enum WhichVolume {
+    SYS_BEEP_VOLUME,    /* This sets the volume for SysBeep calls */ 
+    DEFAULT_SND_VOLUME, /* This one for SndPlay calls */
+    RESET_VOLUME        /* And this undoes the last call to SetSoundVolume */
+};
+ 
+/*
+ * Hash table to track open resource files.
+ */
+
+typedef struct OpenResourceFork {
+    short fileRef;
+    int   flags;
+} OpenResourceFork;
+
+
+
+static Tcl_HashTable nameTable;		/* Id to process number mapping. */
+static Tcl_HashTable resourceTable;	/* Process number to id mapping. */
+static Tcl_Obj *resourceForkList;       /* Ordered list of resource forks */
+static int appResourceIndex;            /* This is the index of the application*
+					 * in the list of resource forks */
+static int newId = 0;			/* Id source. */
+static int initialized = 0;		/* 0 means static structures haven't 
+					 * been initialized yet. */
+static int osTypeInit = 0;		/* 0 means Tcl object of osType hasn't 
+					 * been initialized yet. */
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupOSTypeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		ResourceInit _ANSI_ARGS_((void));
+static void             BuildResourceForkList _ANSI_ARGS_((void));
+static int		SetOSTypeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfOSType _ANSI_ARGS_((Tcl_Obj *objPtr));
+static OpenResourceFork* GetRsrcRefFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+		                int okayOnReadOnly, const char *operation,
+	                        Tcl_Obj *resultPtr));
+
+static void 		SetSoundVolume(int volume, enum WhichVolume mode);
+
+/*
+ * The structures below defines the Tcl object type defined in this file by
+ * means of procedures that can be invoked by generic object code.
+ */
+
+static Tcl_ObjType osType = {
+    "ostype",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupOSTypeInternalRep,	        /* dupIntRepProc */
+    UpdateStringOfOSType,		/* updateStringProc */
+    SetOSTypeFromAny			/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ResourceObjCmd --
+ *
+ *	This procedure is invoked to process the "resource" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ResourceObjCmd(
+    ClientData clientData,		/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int objc,				/* Number of arguments. */
+    Tcl_Obj *CONST objv[])		/* Argument values. */
+{
+    Tcl_Obj *resultPtr, *objPtr;
+    int index, result;
+    long fileRef, rsrcId;
+    FSSpec fileSpec;
+    Tcl_DString buffer;
+    char *nativeName;
+    char *stringPtr;
+    char errbuf[16];
+    OpenResourceFork *resourceRef;
+    Handle resource = NULL;
+    OSErr err;
+    int count, i, limitSearch = false, length;
+    short id, saveRef, resInfo;
+    Str255 theName;
+    OSType rezType;
+    int gotInt, releaseIt = 0, force;
+    char *resourceId = NULL;	
+    long size;
+    char macPermision;
+    int mode;
+
+    static char *switches[] = {"close", "delete" ,"files", "list", 
+            "open", "read", "types", "write", (char *) NULL
+    };
+	        
+    enum {
+            RESOURCE_CLOSE, RESOURCE_DELETE, RESOURCE_FILES, RESOURCE_LIST, 
+            RESOURCE_OPEN, RESOURCE_READ, RESOURCE_TYPES, RESOURCE_WRITE
+    };
+              
+    static char *writeSwitches[] = {
+            "-id", "-name", "-file", "-force", (char *) NULL
+    };
+            
+    enum {
+            RESOURCE_WRITE_ID, RESOURCE_WRITE_NAME, 
+            RESOURCE_WRITE_FILE, RESOURCE_FORCE
+    };
+            
+    static char *deleteSwitches[] = {"-id", "-name", "-file", (char *) NULL};
+             
+    enum {RESOURCE_DELETE_ID, RESOURCE_DELETE_NAME, RESOURCE_DELETE_FILE};
+
+    resultPtr = Tcl_GetObjResult(interp);
+    
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (!initialized) {
+	ResourceInit();
+    }
+    result = TCL_OK;
+
+    switch (index) {
+	case RESOURCE_CLOSE:			
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "resourceRef");
+		return TCL_ERROR;
+	    }
+	    stringPtr = Tcl_GetStringFromObj(objv[2], &length);
+	    fileRef = TclMacUnRegisterResourceFork(stringPtr, resultPtr);
+	    
+	    if (fileRef >= 0) {
+	        CloseResFile((short) fileRef);
+	        return TCL_OK;
+	    } else {
+	        return TCL_ERROR;
+	    }
+	case RESOURCE_DELETE:
+	    if (!((objc >= 3) && (objc <= 9) && ((objc % 2) == 1))) {
+		Tcl_WrongNumArgs(interp, 2, objv, 
+		    "?-id resourceId? ?-name resourceName? ?-file \
+resourceRef? resourceType");
+		return TCL_ERROR;
+	    }
+	    
+	    i = 2;
+	    fileRef = -1;
+	    gotInt = false;
+	    resourceId = NULL;
+	    limitSearch = false;
+
+	    while (i < (objc - 2)) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], deleteSwitches,
+			"option", 0, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+
+		switch (index) {
+		    case RESOURCE_DELETE_ID:		
+			if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
+				!= TCL_OK) {
+			    return TCL_ERROR;
+			}
+			gotInt = true;
+			break;
+		    case RESOURCE_DELETE_NAME:		
+			resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
+			if (length > 255) {
+			    Tcl_AppendStringsToObj(resultPtr,"-name argument ",
+			            "too long, must be < 255 characters",
+			            (char *) NULL);
+			    return TCL_ERROR;
+			}
+			strcpy((char *) theName, resourceId);
+			resourceId = (char *) theName;
+			c2pstr(resourceId);
+			break;
+		    case RESOURCE_DELETE_FILE:
+		        resourceRef = GetRsrcRefFromObj(objv[i+1], 0, 
+		                "delete from", resultPtr);
+		        if (resourceRef == NULL) {
+		            return TCL_ERROR;
+		        }	
+			limitSearch = true;
+			break;
+		}
+		i += 2;
+	    }
+	    
+	    if ((resourceId == NULL) && !gotInt) {
+		Tcl_AppendStringsToObj(resultPtr,"you must specify either ",
+		        "\"-id\" or \"-name\" or both ",
+		        "to \"resource delete\"",
+		        (char *) NULL);
+	        return TCL_ERROR;
+            }
+
+	    if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    if (limitSearch) {
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+	    }
+	    
+	    SetResLoad(false);
+	    
+	    if (gotInt == true) {
+	        if (limitSearch) {
+		    resource = Get1Resource(rezType, rsrcId);
+		} else {
+		    resource = GetResource(rezType, rsrcId);
+		}
+                err = ResError();
+            
+                if (err == resNotFound || resource == NULL) {
+	            Tcl_AppendStringsToObj(resultPtr, "resource not found",
+	                (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+                } else if (err != noErr) {
+                    char buffer[16];
+                
+                    sprintf(buffer, "%12d", err);
+	            Tcl_AppendStringsToObj(resultPtr, "resource error #",
+	                    buffer, "occured while trying to find resource",
+	                    (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+	        }
+	    } 
+	    
+	    if (resourceId != NULL) {
+	        Handle tmpResource;
+	        if (limitSearch) {
+	            tmpResource = Get1NamedResource(rezType,
+			    (StringPtr) resourceId);
+	        } else {
+	            tmpResource = GetNamedResource(rezType,
+			    (StringPtr) resourceId);
+	        }
+                err = ResError();
+            
+                if (err == resNotFound || tmpResource == NULL) {
+	            Tcl_AppendStringsToObj(resultPtr, "resource not found",
+	                (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+                } else if (err != noErr) {
+                    char buffer[16];
+                
+                    sprintf(buffer, "%12d", err);
+	            Tcl_AppendStringsToObj(resultPtr, "resource error #",
+	                    buffer, "occured while trying to find resource",
+	                    (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+	        }
+	        
+	        if (gotInt) { 
+	            if (resource != tmpResource) {
+	                Tcl_AppendStringsToObj(resultPtr,
+				"\"-id\" and \"-name\" ",
+	                        "values do not point to the same resource",
+	                        (char *) NULL);
+	                result = TCL_ERROR;
+	                goto deleteDone;
+	            }
+	        } else {
+	            resource = tmpResource;
+	        }
+	    }
+	        
+       	    resInfo = GetResAttrs(resource);
+	    
+	    if ((resInfo & resProtected) == resProtected) {
+	        Tcl_AppendStringsToObj(resultPtr, "resource ",
+	                "cannot be deleted: it is protected.",
+	                (char *) NULL);
+	        result = TCL_ERROR;
+	        goto deleteDone;               
+	    } else if ((resInfo & resSysHeap) == resSysHeap) {   
+	        Tcl_AppendStringsToObj(resultPtr, "resource",
+	                "cannot be deleted: it is in the system heap.",
+	                (char *) NULL);
+	        result = TCL_ERROR;
+	        goto deleteDone;               
+	    }
+	    
+	    /*
+	     * Find the resource file, if it was not specified,
+	     * so we can flush the changes now.  Perhaps this is
+	     * a little paranoid, but better safe than sorry.
+	     */
+	     
+	    RemoveResource(resource);
+	    
+	    if (!limitSearch) {
+	        UpdateResFile(HomeResFile(resource));
+	    } else {
+	        UpdateResFile(resourceRef->fileRef);
+	    }
+	    
+	    
+	    deleteDone:
+	    
+            SetResLoad(true);
+	    if (limitSearch) {
+                 UseResFile(saveRef);                        
+	    }
+	    return result;
+	    
+	case RESOURCE_FILES:
+	    if ((objc < 2) || (objc > 3)) {
+		Tcl_SetStringObj(resultPtr,
+		        "wrong # args: should be \"resource files \
+?resourceId?\"", -1);
+		return TCL_ERROR;
+	    }
+	    
+	    if (objc == 2) {
+	        stringPtr = Tcl_GetStringFromObj(resourceForkList, &length);
+	        Tcl_SetStringObj(resultPtr, stringPtr, length);
+	    } else {
+                FCBPBRec fileRec;
+                Handle pathHandle;
+                short pathLength;
+                Str255 fileName;
+	        
+	        if (strcmp(Tcl_GetStringFromObj(objv[2], NULL), "ROM Map")
+			    == 0) {
+	            Tcl_SetStringObj(resultPtr,"no file path for ROM Map", -1);
+	            return TCL_ERROR;
+	        }
+	        
+	        resourceRef = GetRsrcRefFromObj(objv[2], 1, "files", resultPtr);
+	        if (resourceRef == NULL) {
+	            return TCL_ERROR;
+	        }
+
+                fileRec.ioCompletion = NULL;
+                fileRec.ioFCBIndx = 0;
+                fileRec.ioNamePtr = fileName;
+                fileRec.ioVRefNum = 0;
+                fileRec.ioRefNum = resourceRef->fileRef;
+                err = PBGetFCBInfo(&fileRec, false);
+                if (err != noErr) {
+                    Tcl_SetStringObj(resultPtr,
+                            "could not get FCB for resource file", -1);
+                    return TCL_ERROR;
+                }
+                
+                err = GetFullPath(fileRec.ioFCBVRefNum, fileRec.ioFCBParID,
+                        fileRec.ioNamePtr, &pathLength, &pathHandle);
+                if ( err != noErr) {
+                    Tcl_SetStringObj(resultPtr,
+                            "could not get file path from token", -1);
+                    return TCL_ERROR;
+                }
+                
+                HLock(pathHandle);
+                Tcl_SetStringObj(resultPtr,*pathHandle,pathLength);
+                HUnlock(pathHandle);
+                DisposeHandle(pathHandle);
+            }                    	    
+	    return TCL_OK;
+	case RESOURCE_LIST:			
+	    if (!((objc == 3) || (objc == 4))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "resourceType ?resourceRef?");
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    if (objc == 4) {
+	        resourceRef = GetRsrcRefFromObj(objv[3], 1, 
+		                "list", resultPtr);
+		if (resourceRef == NULL) {
+		    return TCL_ERROR;
+		}	
+
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+		limitSearch = true;
+	    }
+
+	    Tcl_ResetResult(interp);
+	    if (limitSearch) {
+		count = Count1Resources(rezType);
+	    } else {
+		count = CountResources(rezType);
+	    }
+	    SetResLoad(false);
+	    for (i = 1; i <= count; i++) {
+		if (limitSearch) {
+		    resource = Get1IndResource(rezType, i);
+		} else {
+		    resource = GetIndResource(rezType, i);
+		}
+		if (resource != NULL) {
+		    GetResInfo(resource, &id, (ResType *) &rezType, theName);
+		    if (theName[0] != 0) {
+			objPtr = Tcl_NewStringObj((char *) theName + 1,
+				theName[0]);
+		    } else {
+			objPtr = Tcl_NewIntObj(id);
+		    }
+		    ReleaseResource(resource);
+		    result = Tcl_ListObjAppendElement(interp, resultPtr,
+			    objPtr);
+		    if (result != TCL_OK) {
+			Tcl_DecrRefCount(objPtr);
+			break;
+		    }
+		}
+	    }
+	    SetResLoad(true);
+	
+	    if (limitSearch) {
+		UseResFile(saveRef);
+	    }
+	
+	    return TCL_OK;
+	case RESOURCE_OPEN:			
+	    if (!((objc == 3) || (objc == 4))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "fileName ?permissions?");
+		return TCL_ERROR;
+	    }
+	    stringPtr = Tcl_GetStringFromObj(objv[2], &length);
+	    nativeName = Tcl_TranslateFileName(interp, stringPtr, &buffer);
+	    if (nativeName == NULL) {
+		return TCL_ERROR;
+	    }
+	    err = FSpLocationFromPath(strlen(nativeName), nativeName,
+		    &fileSpec) ;
+	    Tcl_DStringFree(&buffer);
+	    if (!((err == noErr) || (err == fnfErr))) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"invalid path", (char *) NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Get permissions for the file.  We really only understand
+	     * read-only and shared-read-write.  If no permissions are 
+	     * given we default to read only.
+	     */
+	    
+	    if (objc == 4) {
+		stringPtr = Tcl_GetStringFromObj(objv[3], &length);
+		mode = TclGetOpenMode(interp, stringPtr, &index);
+		if (mode == -1) {
+		    /* TODO: TclGetOpenMode doesn't work with Obj commands. */
+		    return TCL_ERROR;
+		}
+		switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+		    case O_RDONLY:
+			macPermision = fsRdPerm;
+		    break;
+		    case O_WRONLY:
+		    case O_RDWR:
+			macPermision = fsRdWrShPerm;
+			break;
+		    default:
+			panic("Tcl_ResourceObjCmd: invalid mode value");
+		    break;
+		}
+	    } else {
+		macPermision = fsRdPerm;
+	    }
+	    
+	    /*
+	     * Don't load in any of the resources in the file, this could 
+	     * cause problems if you open a file that has CODE resources...
+	     */
+	     
+	    SetResLoad(false); 
+	    fileRef = (long) FSpOpenResFileCompat(&fileSpec, macPermision);
+	    SetResLoad(true);
+	    
+	    if (fileRef == -1) {
+	    	err = ResError();
+		if (((err == fnfErr) || (err == eofErr)) &&
+			(macPermision == fsRdWrShPerm)) {
+		    /*
+		     * No resource fork existed for this file.  Since we are
+		     * opening it for writing we will create the resource fork
+		     * now.
+		     */
+		     
+		    HCreateResFile(fileSpec.vRefNum, fileSpec.parID,
+			    fileSpec.name);
+		    fileRef = (long) FSpOpenResFileCompat(&fileSpec,
+			    macPermision);
+		    if (fileRef == -1) {
+			goto openError;
+		    }
+		} else if (err == fnfErr) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			"file does not exist", (char *) NULL);
+		    return TCL_ERROR;
+		} else if (err == eofErr) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			"file does not contain resource fork", (char *) NULL);
+		    return TCL_ERROR;
+		} else {
+		    openError:
+		    Tcl_AppendStringsToObj(resultPtr,
+			"error opening resource file", (char *) NULL);
+		    return TCL_ERROR;
+		}
+	    }
+	    	    
+            /*
+             * The FspOpenResFile function does not set the ResFileAttrs.
+             * Even if you open the file read only, the mapReadOnly
+             * attribute is not set.  This means we can't detect writes to a 
+             * read only resource fork until the write fails, which is bogus.  
+             * So set it here...
+             */
+            
+            if (macPermision == fsRdPerm) {
+                SetResFileAttrs(fileRef, mapReadOnly);
+            }
+            
+            Tcl_SetStringObj(resultPtr, "", 0);
+            if (TclMacRegisterResourceFork(fileRef, resultPtr, 
+                    TCL_RESOURCE_CHECK_IF_OPEN) != TCL_OK) {
+                CloseResFile(fileRef);
+		return TCL_ERROR;
+            }
+
+	    return TCL_OK;
+	case RESOURCE_READ:			
+	    if (!((objc == 4) || (objc == 5))) {
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"resourceType resourceId ?resourceRef?");
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    
+	    if (Tcl_GetLongFromObj((Tcl_Interp *) NULL, objv[3], &rsrcId)
+		    != TCL_OK) {
+		resourceId = Tcl_GetStringFromObj(objv[3], &length);
+            }
+
+	    if (objc == 5) {
+		stringPtr = Tcl_GetStringFromObj(objv[4], &length);
+	    } else {
+		stringPtr = NULL;
+	    }
+	
+	    resource = Tcl_MacFindResource(interp, rezType, resourceId,
+		rsrcId, stringPtr, &releaseIt);
+			    
+	    if (resource != NULL) {
+		size = GetResourceSizeOnDisk(resource);
+		Tcl_SetStringObj(resultPtr, *resource, size);
+
+		/*
+		 * Don't release the resource unless WE loaded it...
+		 */
+		 
+		if (releaseIt) {
+		    ReleaseResource(resource);
+		}
+		return TCL_OK;
+	    } else {
+		Tcl_AppendStringsToObj(resultPtr, "could not load resource",
+		    (char *) NULL);
+		return TCL_ERROR;
+	    }
+	case RESOURCE_TYPES:			
+	    if (!((objc == 2) || (objc == 3))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?resourceRef?");
+		return TCL_ERROR;
+	    }
+
+	    if (objc == 3) {
+	        resourceRef = GetRsrcRefFromObj(objv[2], 1, 
+		                "get types of", resultPtr);
+		if (resourceRef == NULL) {
+		    return TCL_ERROR;
+		}
+			
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+		limitSearch = true;
+	    }
+
+	    if (limitSearch) {
+		count = Count1Types();
+	    } else {
+		count = CountTypes();
+	    }
+	    for (i = 1; i <= count; i++) {
+		if (limitSearch) {
+		    Get1IndType((ResType *) &rezType, i);
+		} else {
+		    GetIndType((ResType *) &rezType, i);
+		}
+		objPtr = Tcl_NewOSTypeObj(rezType);
+		result = Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(objPtr);
+		    break;
+		}
+	    }
+		
+	    if (limitSearch) {
+		UseResFile(saveRef);
+	    }
+		
+	    return result;
+	case RESOURCE_WRITE:			
+	    if ((objc < 4) || (objc > 11)) {
+		Tcl_WrongNumArgs(interp, 2, objv, 
+		"?-id resourceId? ?-name resourceName? ?-file resourceRef?\
+ ?-force? resourceType data");
+		return TCL_ERROR;
+	    }
+	    
+	    i = 2;
+	    gotInt = false;
+	    resourceId = NULL;
+	    limitSearch = false;
+	    force = 0;
+
+	    while (i < (objc - 2)) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], writeSwitches,
+			"switch", 0, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+
+		switch (index) {
+		    case RESOURCE_WRITE_ID:		
+			if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
+				!= TCL_OK) {
+			    return TCL_ERROR;
+			}
+			gotInt = true;
+		        i += 2;
+			break;
+		    case RESOURCE_WRITE_NAME:		
+			resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
+			strcpy((char *) theName, resourceId);
+			resourceId = (char *) theName;
+			c2pstr(resourceId);
+		        i += 2;
+			break;
+		    case RESOURCE_WRITE_FILE:		
+	                resourceRef = GetRsrcRefFromObj(objv[i+1], 0, 
+		                        "write to", resultPtr);
+                        if (resourceRef == NULL) {
+                            return TCL_ERROR;
+		        }	
+			limitSearch = true;
+		        i += 2;
+			break;
+		    case RESOURCE_FORCE:
+		        force = 1;
+		        i += 1;
+		        break;
+		}
+	    }
+	    if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    stringPtr = Tcl_GetStringFromObj(objv[i+1], &length);
+
+	    if (gotInt == false) {
+		rsrcId = UniqueID(rezType);
+	    }
+	    if (resourceId == NULL) {
+		resourceId = (char *) "\p";
+	    }
+	    if (limitSearch) {
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+	    }
+	    
+	    /*
+	     * If we are adding the resource by number, then we must make sure
+	     * there is not already a resource of that number.  We are not going
+	     * load it here, since we want to detect whether we loaded it or
+	     * not.  Remember that releasing some resources in particular menu
+	     * related ones, can be fatal.
+	     */
+	     
+	    if (gotInt == true) {
+	        SetResLoad(false);
+	        resource = Get1Resource(rezType,rsrcId);
+	        SetResLoad(true);
+	    }     
+	    	    
+	    if (resource == NULL) {
+	        /*
+	         * We get into this branch either if there was not already a
+	         * resource of this type & id, or the id was not specified.
+	         */
+	         
+	        resource = NewHandle(length);
+	        if (resource == NULL) {
+	            resource = NewHandleSys(length);
+	            if (resource == NULL) {
+	                panic("could not allocate memory to write resource");
+	            }
+	        }
+	        HLock(resource);
+	        memcpy(*resource, stringPtr, length);
+	        HUnlock(resource);
+	        AddResource(resource, rezType, (short) rsrcId,
+		    (StringPtr) resourceId);
+		releaseIt = 1;
+            } else {
+                /* 
+                 * We got here because there was a resource of this type 
+                 * & ID in the file. 
+                 */ 
+                
+                if (*resource == NULL) {
+                    releaseIt = 1;
+                } else {
+                    releaseIt = 0;
+                }
+               
+                if (!force) {
+                    /*
+                     *We only overwrite extant resources
+                     * when the -force flag has been set.
+                     */
+                     
+                    sprintf(errbuf,"%d", rsrcId);
+                  
+                    Tcl_AppendStringsToObj(resultPtr, "the resource ",
+                          errbuf, " already exists, use \"-force\"",
+                          " to overwrite it.", (char *) NULL);
+                    
+                    result = TCL_ERROR;
+                    goto writeDone;
+                } else if (GetResAttrs(resource) & resProtected) {
+                    /*  
+                     *  
+                     * Next, check to see if it is protected...
+                     */
+                 
+                    sprintf(errbuf,"%d", rsrcId);
+                    Tcl_AppendStringsToObj(resultPtr,
+			    "could not write resource id ",
+                            errbuf, " of type ",
+                            Tcl_GetStringFromObj(objv[i],&length),
+                            ", it was protected.",(char *) NULL);
+                    result = TCL_ERROR;
+                    goto writeDone;
+                } else {
+                    /*
+                     * Be careful, the resource might already be in memory
+                     * if something else loaded it.
+                     */
+                     
+                    if (*resource == 0) {
+                    	LoadResource(resource);
+                    	err = ResError();
+                    	if (err != noErr) {
+                            sprintf(errbuf,"%d", rsrcId);
+                            Tcl_AppendStringsToObj(resultPtr,
+				    "error loading resource ",
+                                    errbuf, " of type ",
+                                    Tcl_GetStringFromObj(objv[i],&length),
+                                    " to overwrite it", (char *) NULL);
+                            goto writeDone;
+                    	}
+                    }
+                     
+                    SetHandleSize(resource, length);
+                    if ( MemError() != noErr ) {
+                        panic("could not allocate memory to write resource");
+                    }
+
+                    HLock(resource);
+	            memcpy(*resource, stringPtr, length);
+	            HUnlock(resource);
+	           
+                    ChangedResource(resource);
+                
+                    /*
+                     * We also may have changed the name...
+                     */ 
+                 
+                    SetResInfo(resource, rsrcId, (StringPtr) resourceId);
+                }
+            }
+            
+	    err = ResError();
+	    if (err != noErr) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"error adding resource to resource map",
+		        (char *) NULL);
+		result = TCL_ERROR;
+		goto writeDone;
+	    }
+	    
+	    WriteResource(resource);
+	    err = ResError();
+	    if (err != noErr) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"error writing resource to disk",
+		        (char *) NULL);
+		result = TCL_ERROR;
+	    }
+	    
+	    writeDone:
+	    
+	    if (releaseIt) {
+	        ReleaseResource(resource);
+	        err = ResError();
+	        if (err != noErr) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			    "error releasing resource",
+		            (char *) NULL);
+		    result = TCL_ERROR;
+	        }
+	    }
+	    
+	    if (limitSearch) {
+		UseResFile(saveRef);
+	    }
+
+	    return result;
+	default:
+	    panic("Tcl_GetIndexFromObject returned unrecognized option");
+	    return TCL_ERROR;	/* Should never be reached. */
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MacSourceObjCmd --
+ *
+ *	This procedure is invoked to process the "source" Tcl command.
+ *	See the user documentation for details on what it does.  In 
+ *	addition, it supports sourceing from the resource fork of
+ *	type 'TEXT'.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_MacSourceObjCmd(
+    ClientData dummy,			/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int objc,				/* Number of arguments. */
+    Tcl_Obj *CONST objv[])		/* Argument objects. */
+{
+    char *errNum = "wrong # args: ";
+    char *errBad = "bad argument: ";
+    char *errStr;
+    char *fileName = NULL, *rsrcName = NULL;
+    long rsrcID = -1;
+    char *string;
+    int length;
+
+    if (objc < 2 || objc > 4)  {
+    	errStr = errNum;
+    	goto sourceFmtErr;
+    }
+    
+    if (objc == 2)  {
+	string = TclGetStringFromObj(objv[1], &length);
+	return Tcl_EvalFile(interp, string);
+    }
+    
+    /*
+     * The following code supports a few older forms of this command
+     * for backward compatability.
+     */
+    string = TclGetStringFromObj(objv[1], &length);
+    if (!strcmp(string, "-rsrc") || !strcmp(string, "-rsrcname")) {
+	rsrcName = TclGetStringFromObj(objv[2], &length);
+    } else if (!strcmp(string, "-rsrcid")) {
+	if (Tcl_GetLongFromObj(interp, objv[2], &rsrcID) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+    	errStr = errBad;
+    	goto sourceFmtErr;
+    }
+    
+    if (objc == 4) {
+	fileName = TclGetStringFromObj(objv[3], &length);
+    }
+    return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
+	
+    sourceFmtErr:
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
+		Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		" fileName\" or \"",
+		Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		" -rsrc name ?fileName?\" or \"", 
+		Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		" -rsrcid id ?fileName?\"", (char *) NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_BeepObjCmd --
+ *
+ *	This procedure makes the beep sound.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Makes a beep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_BeepObjCmd(
+    ClientData dummy,			/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int objc,				/* Number of arguments. */
+    Tcl_Obj *CONST objv[])		/* Argument values. */
+{
+    Tcl_Obj *resultPtr, *objPtr;
+    Handle sound;
+    Str255 sndName;
+    int volume = -1, length;
+    char * sndArg = NULL;
+
+    resultPtr = Tcl_GetObjResult(interp);
+    if (objc == 1) {
+	SysBeep(1);
+	return TCL_OK;
+    } else if (objc == 2) {
+	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-list")) {
+	    int count, i;
+	    short id;
+	    Str255 theName;
+	    ResType rezType;
+			
+	    count = CountResources('snd ');
+	    for (i = 1; i <= count; i++) {
+		sound = GetIndResource('snd ', i);
+		if (sound != NULL) {
+		    GetResInfo(sound, &id, &rezType, theName);
+		    if (theName[0] == 0) {
+			continue;
+		    }
+		    objPtr = Tcl_NewStringObj((char *) theName + 1,
+			    theName[0]);
+		    Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+		}
+	    }
+	    return TCL_OK;
+	} else {
+	    sndArg = Tcl_GetStringFromObj(objv[1], &length);
+	}
+    } else if (objc == 3) {
+	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
+	    Tcl_GetIntFromObj(interp, objv[2], &volume);
+	} else {
+	    goto beepUsage;
+	}
+    } else if (objc == 4) {
+	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
+	    Tcl_GetIntFromObj(interp, objv[2], &volume);
+	    sndArg = Tcl_GetStringFromObj(objv[3], &length);
+	} else {
+	    goto beepUsage;
+	}
+    } else {
+	goto beepUsage;
+    }
+	
+    /*
+     * Play the sound
+     */
+    if (sndArg == NULL) {
+	/*
+         * Set Volume for SysBeep
+         */
+
+	if (volume >= 0) {
+	    SetSoundVolume(volume, SYS_BEEP_VOLUME);
+	}
+	SysBeep(1);
+
+	/*
+         * Reset Volume
+         */
+
+	if (volume >= 0) {
+	    SetSoundVolume(0, RESET_VOLUME);
+	}
+    } else {
+	strcpy((char *) sndName + 1, sndArg);
+	sndName[0] = length;
+	sound = GetNamedResource('snd ', sndName);
+	if (sound != NULL) {
+	    /*
+             * Set Volume for Default Output device
+             */
+
+	    if (volume >= 0) {
+		SetSoundVolume(volume, DEFAULT_SND_VOLUME);
+	    }
+
+	    SndPlay(NULL, (SndListHandle) sound, false);
+
+	    /*
+             * Reset Volume
+             */
+
+	    if (volume >= 0) {
+		SetSoundVolume(0, RESET_VOLUME);
+	    }
+	} else {
+	    Tcl_AppendStringsToObj(resultPtr, " \"", sndArg, 
+		    "\" is not a valid sound.  (Try ",
+		    Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		    " -list)", NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    return TCL_OK;
+
+    beepUsage:
+    Tcl_WrongNumArgs(interp, 1, objv, "[-volume num] [-list | sndName]?");
+    return TCL_ERROR;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SetSoundVolume --
+ *
+ *	Set the volume for either the SysBeep or the SndPlay call depending
+ *	on the value of mode (SYS_BEEP_VOLUME or DEFAULT_SND_VOLUME
+ *      respectively.
+ *
+ *      It also stores the last channel set, and the old value of its 
+ *	VOLUME.  If you call SetSoundVolume with a mode of RESET_VOLUME, 
+ *	it will undo the last setting.  The volume parameter is
+ *      ignored in this case.
+ *
+ * Side Effects:
+ *	Sets the System Volume
+ *
+ * Results:
+ *      None
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+void
+SetSoundVolume(
+    int volume,              /* This is the new volume */
+    enum WhichVolume mode)   /* This flag says which volume to
+			      * set: SysBeep, SndPlay, or instructs us
+			      * to reset the volume */
+{
+    static int hasSM3 = -1;
+    static enum WhichVolume oldMode;
+    static long oldVolume = -1;
+
+    /*
+     * The volume setting calls only work if we have SoundManager
+     * 3.0 or higher.  So we check that here.
+     */
+    
+    if (hasSM3 == -1) {
+    	if (GetToolboxTrapAddress(_SoundDispatch) 
+		!= GetToolboxTrapAddress(_Unimplemented)) {
+	    NumVersion SMVers = SndSoundManagerVersion();
+	    if (SMVers.majorRev > 2) {
+	    	hasSM3 = 1;
+	    } else {
+		hasSM3 = 0;
+	    }
+	} else {
+	    /*
+	     * If the SoundDispatch trap is not present, then
+	     * we don't have the SoundManager at all.
+	     */
+	    
+	    hasSM3 = 0;
+	}
+    }
+    
+    /*
+     * If we don't have Sound Manager 3.0, we can't set the sound volume.
+     * We will just ignore the request rather than raising an error.
+     */
+    
+    if (!hasSM3) {
+    	return;
+    }
+    
+    switch (mode) {
+    	case SYS_BEEP_VOLUME:
+	    GetSysBeepVolume(&oldVolume);
+	    SetSysBeepVolume(volume);
+	    oldMode = SYS_BEEP_VOLUME;
+	    break;
+	case DEFAULT_SND_VOLUME:
+	    GetDefaultOutputVolume(&oldVolume);
+	    SetDefaultOutputVolume(volume);
+	    oldMode = DEFAULT_SND_VOLUME;
+	    break;
+	case RESET_VOLUME:
+	    /*
+	     * If oldVolume is -1 someone has made a programming error
+	     * and called reset before setting the volume.  This is benign
+	     * however, so we will just exit.
+	     */
+	  
+	    if (oldVolume != -1) {	
+	        if (oldMode == SYS_BEEP_VOLUME) {
+	    	    SetSysBeepVolume(oldVolume);
+	        } else if (oldMode == DEFAULT_SND_VOLUME) {
+		    SetDefaultOutputVolume(oldVolume);
+	        }
+	    }
+	    oldVolume = -1;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_MacEvalResource --
+ *
+ *	Used to extend the source command.  Sources Tcl code from a Text
+ *	resource.  Currently only sources the resouce by name file ID may be
+ *	supported at a later date.
+ *
+ * Side Effects:
+ *	Depends on the Tcl code in the resource.
+ *
+ * Results:
+ *      Returns a Tcl result.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Tcl_MacEvalResource(
+    Tcl_Interp *interp,		/* Interpreter in which to process file. */
+    char *resourceName,		/* Name of TEXT resource to source,
+				   NULL if number should be used. */
+    int resourceNumber,		/* Resource id of source. */
+    char *fileName)		/* Name of file to process.
+				   NULL if application resource. */
+{
+    Handle sourceText;
+    Str255 rezName;
+    char msg[200];
+    int result, iOpenedResFile = false;
+    short saveRef, fileRef = -1;
+    char idStr[64];
+    FSSpec fileSpec;
+    Tcl_DString buffer;
+    char *nativeName;
+
+    saveRef = CurResFile();
+	
+    if (fileName != NULL) {
+	OSErr err;
+	
+	nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+	if (nativeName == NULL) {
+	    return TCL_ERROR;
+	}
+	err = FSpLocationFromPath(strlen(nativeName), nativeName,
+                &fileSpec);
+	Tcl_DStringFree(&buffer);
+	if (err != noErr) {
+	    Tcl_AppendResult(interp, "Error finding the file: \"", 
+		fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+		
+	fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
+	if (fileRef == -1) {
+	    Tcl_AppendResult(interp, "Error reading the file: \"", 
+		fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+		
+	UseResFile(fileRef);
+	iOpenedResFile = true;
+    } else {
+	/*
+	 * The default behavior will search through all open resource files.
+	 * This may not be the behavior you desire.  If you want the behavior
+	 * of this call to *only* search the application resource fork, you
+	 * must call UseResFile at this point to set it to the application
+	 * file.  This means you must have already obtained the application's 
+	 * fileRef when the application started up.
+	 */
+    }
+	
+    /*
+     * Load the resource by name or ID
+     */
+    if (resourceName != NULL) {
+	strcpy((char *) rezName + 1, resourceName);
+	rezName[0] = strlen(resourceName);
+	sourceText = GetNamedResource('TEXT', rezName);
+    } else {
+	sourceText = GetResource('TEXT', (short) resourceNumber);
+    }
+	
+    if (sourceText == NULL) {
+	result = TCL_ERROR;
+    } else {
+	char *sourceStr = NULL;
+
+	HLock(sourceText);
+	sourceStr = Tcl_MacConvertTextResource(sourceText);
+	HUnlock(sourceText);
+	ReleaseResource(sourceText);
+		
+	/*
+	 * We now evaluate the Tcl source
+	 */
+	result = Tcl_Eval(interp, sourceStr);
+	ckfree(sourceStr);
+	if (result == TCL_RETURN) {
+	    result = TCL_OK;
+	} else if (result == TCL_ERROR) {
+	    sprintf(msg, "\n    (rsrc \"%.150s\" line %d)",
+                    resourceName,
+		    interp->errorLine);
+	    Tcl_AddErrorInfo(interp, msg);
+	}
+				
+	goto rezEvalCleanUp;
+    }
+	
+    rezEvalError:
+    sprintf(idStr, "ID=%d", resourceNumber);
+    Tcl_AppendResult(interp, "The resource \"",
+	    (resourceName != NULL ? resourceName : idStr),
+	    "\" could not be loaded from ",
+	    (fileName != NULL ? fileName : "application"),
+	    ".", NULL);
+
+    rezEvalCleanUp:
+
+    /* 
+     * TRICKY POINT: The code that you are sourcing here could load a
+     * shared library.  This will go AHEAD of the resource we stored away
+     * in saveRef on the resource path.  
+     * If you restore the saveRef in this case, you will never be able
+     * to get to the resources in the shared library, since you are now
+     * pointing too far down on the resource list.  
+     * So, we only reset the current resource file if WE opened a resource
+     * explicitly, and then only if the CurResFile is still the 
+     * one we opened... 
+     */
+     
+    if (iOpenedResFile && (CurResFile() == fileRef)) {
+        UseResFile(saveRef);
+    }
+	
+    if (fileRef != -1) {
+	CloseResFile(fileRef);
+    }
+
+    return result;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_MacConvertTextResource --
+ *
+ *	Converts a TEXT resource into a Tcl suitable string.
+ *
+ * Side Effects:
+ *	Mallocs the returned memory, converts '\r' to '\n', and appends a NULL.
+ *
+ * Results:
+ *      A new malloced string.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+char *
+Tcl_MacConvertTextResource(
+    Handle resource)		/* Handle to TEXT resource. */
+{
+    int i, size;
+    char *resultStr;
+
+    size = GetResourceSizeOnDisk(resource);
+    
+    resultStr = ckalloc(size + 1);
+    
+    for (i=0; i<size; i++) {
+	if ((*resource)[i] == '\r') {
+	    resultStr[i] = '\n';
+	} else {
+	    resultStr[i] = (*resource)[i];
+	}
+    }
+    
+    resultStr[size] = '\0';
+
+    return resultStr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_MacFindResource --
+ *
+ *	Higher level interface for loading resources.
+ *
+ * Side Effects:
+ *	Attempts to load a resource.
+ *
+ * Results:
+ *      A handle on success.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+Handle
+Tcl_MacFindResource(
+    Tcl_Interp *interp,		/* Interpreter in which to process file. */
+    long resourceType,		/* Type of resource to load. */
+    char *resourceName,		/* Name of resource to find,
+				 * NULL if number should be used. */
+    int resourceNumber,		/* Resource id of source. */
+    char *resFileRef,		/* Registered resource file reference,
+				 * NULL if searching all open resource files. */
+    int *releaseIt)	        /* Should we release this resource when done. */
+{
+    Tcl_HashEntry *nameHashPtr;
+    OpenResourceFork *resourceRef;
+    int limitSearch = false;
+    short saveRef;
+    Handle resource;
+
+    if (resFileRef != NULL) {
+	nameHashPtr = Tcl_FindHashEntry(&nameTable, resFileRef);
+	if (nameHashPtr == NULL) {
+	    Tcl_AppendResult(interp, "invalid resource file reference \"",
+			     resFileRef, "\"", (char *) NULL);
+	    return NULL;
+	}
+	resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
+	saveRef = CurResFile();
+	UseResFile((short) resourceRef->fileRef);
+	limitSearch = true;
+    }
+
+    /* 
+     * Some system resources (for example system resources) should not 
+     * be released.  So we set autoload to false, and try to get the resource.
+     * If the Master Pointer of the returned handle is null, then resource was 
+     * not in memory, and it is safe to release it.  Otherwise, it is not.
+     */
+    
+    SetResLoad(false);
+	 
+    if (resourceName == NULL) {
+	if (limitSearch) {
+	    resource = Get1Resource(resourceType, resourceNumber);
+	} else {
+	    resource = GetResource(resourceType, resourceNumber);
+	}
+    } else {
+	c2pstr(resourceName);
+	if (limitSearch) {
+	    resource = Get1NamedResource(resourceType,
+		    (StringPtr) resourceName);
+	} else {
+	    resource = GetNamedResource(resourceType,
+		    (StringPtr) resourceName);
+	}
+	p2cstr((StringPtr) resourceName);
+    }
+    
+    if (*resource == NULL) {
+    	*releaseIt = 1;
+    	LoadResource(resource);
+    } else {
+    	*releaseIt = 0;
+    }
+    
+    SetResLoad(true);
+    	
+
+    if (limitSearch) {
+	UseResFile(saveRef);
+    }
+
+    return resource;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResourceInit --
+ *
+ *	Initialize the structures used for resource management.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResourceInit()
+{
+
+    initialized = 1;
+    Tcl_InitHashTable(&nameTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&resourceTable, TCL_ONE_WORD_KEYS);
+    resourceForkList = Tcl_NewObj();
+    Tcl_IncrRefCount(resourceForkList);
+
+    BuildResourceForkList();
+    
+}
+/***/
+
+/*Tcl_RegisterObjType(typePtr) */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewOSTypeObj --
+ *
+ *	This procedure is used to create a new resource name type object.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have a NULL
+ *	string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_NewOSTypeObj(
+    OSType newOSType)		/* Int used to initialize the new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    if (!osTypeInit) {
+	osTypeInit = 1;
+	Tcl_RegisterObjType(&osType);
+    }
+
+    objPtr = Tcl_NewObj();
+    objPtr->bytes = NULL;
+    objPtr->internalRep.longValue = newOSType;
+    objPtr->typePtr = &osType;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetOSTypeObj --
+ *
+ *	Modify an object to be a resource type and to have the 
+ *	specified long value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetOSTypeObj(
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    OSType newOSType)		/* Integer used to set object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (!osTypeInit) {
+	osTypeInit = 1;
+	Tcl_RegisterObjType(&osType);
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = newOSType;
+    objPtr->typePtr = &osType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetOSTypeFromObj --
+ *
+ *	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.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in interp->objResult
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetOSTypeFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,		/* The object from which to get a int. */
+    OSType *osTypePtr)		/* Place to store resulting int. */
+{
+    register int result;
+    
+    if (!osTypeInit) {
+	osTypeInit = 1;
+	Tcl_RegisterObjType(&osType);
+    }
+
+    if (objPtr->typePtr == &osType) {
+	*osTypePtr = objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+
+    result = SetOSTypeFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*osTypePtr = objPtr->internalRep.longValue;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupOSTypeInternalRep --
+ *
+ *	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
+DupOSTypeInternalRep(
+    Tcl_Obj *srcPtr,	/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
+{
+    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+    copyPtr->typePtr = &osType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOSTypeFromAny --
+ *
+ *	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 interp->objResult
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, an int is stored as "objPtr"s internal
+ *	representation. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOSTypeFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr)		/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string;
+    int length;
+    long newOSType;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = TclGetStringFromObj(objPtr, &length);
+
+    if (length != 4) {
+	if (interp != NULL) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "expected Macintosh OS type but got \"", string, "\"",
+		    (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+    newOSType =  *((long *) string);
+    
+    /*
+     * The conversion to resource type succeeded. Free the old internalRep 
+     * before setting the new one.
+     */
+
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = newOSType;
+    objPtr->typePtr = &osType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfOSType --
+ *
+ *	Update the string representation for an resource type 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
+UpdateStringOfOSType(
+    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
+{
+    objPtr->bytes = ckalloc(5);
+    sprintf(objPtr->bytes, "%-4.4s", &(objPtr->internalRep.longValue));
+    objPtr->length = 4;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetRsrcRefFromObj --
+ *
+ *	Given a String object containing a resource file token, return
+ *	the OpenResourceFork structure that it represents, or NULL if 
+ *	the token cannot be found.  If okayOnReadOnly is false, it will 
+ *      also check whether the token corresponds to a read-only file, 
+ *      and return NULL if it is.
+ *
+ * Results:
+ *	A pointer to an OpenResourceFork structure, or NULL.
+ *
+ * Side effects:
+ *	An error message may be left in resultPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OpenResourceFork *
+GetRsrcRefFromObj(
+    register Tcl_Obj *objPtr,	/* String obj containing file token     */
+    int okayOnReadOnly,         /* Whether this operation is okay for a *
+                                 * read only file.                      */
+    const char *operation,      /* String containing the operation we   *
+                                 * were trying to perform, used for errors */
+    Tcl_Obj *resultPtr)         /* Tcl_Obj to contain error message     */
+{
+    char *stringPtr;
+    Tcl_HashEntry *nameHashPtr;
+    OpenResourceFork *resourceRef;
+    int length;
+    OSErr err;
+    
+    stringPtr = Tcl_GetStringFromObj(objPtr, &length);
+    nameHashPtr = Tcl_FindHashEntry(&nameTable, stringPtr);
+    if (nameHashPtr == NULL) {
+        Tcl_AppendStringsToObj(resultPtr,
+	        "invalid resource file reference \"",
+	        stringPtr, "\"", (char *) NULL);
+        return NULL;
+    }
+
+    resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
+    
+    if (!okayOnReadOnly) {
+        err = GetResFileAttrs((short) resourceRef->fileRef);
+        if (err & mapReadOnly) {
+            Tcl_AppendStringsToObj(resultPtr, "cannot ", operation, 
+                    " resource file \"",
+                    stringPtr, "\", it was opened read only",
+                    (char *) NULL);
+            return NULL;
+        }
+    }
+    return resourceRef;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacRegisterResourceFork --
+ *
+ *	Register an open resource fork in the table of open resources 
+ *	managed by the procedures in this file.  If the resource file
+ *      is already registered with the table, then no new token is made.
+ *
+ *      The behavior is controlled by the value of tokenPtr, and of the 
+ *	flags variable.  For tokenPtr, the possibilities are:
+ *	  - NULL: The new token is auto-generated, but not returned.
+ *        - The string value of tokenPtr is the empty string: Then
+ *		the new token is auto-generated, and returned in tokenPtr
+ *	  - tokenPtr has a value: The string value will be used for the token,
+ *		unless it is already in use, in which case a new token will
+ *		be generated, and returned in tokenPtr.
+ *
+ *      For the flags variable:  it can be one of:
+ *	  - TCL_RESOURCE__INSERT_TAIL: The element is inserted at the
+ *              end of the list of open resources.  Used only in Resource_Init.
+ *	  - TCL_RESOURCE_DONT_CLOSE: The resource close command will not close
+ *	        this resource.
+ *	  - TCL_RESOURCE_CHECK_IF_OPEN: This will check to see if this file's
+ *	        resource fork is already opened by this Tcl shell, and return 
+ *	        an error without registering the resource fork.
+ *
+ * Results:
+ *	Standard Tcl Result
+ *
+ * Side effects:
+ *	An entry may be added to the resource name table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacRegisterResourceFork(
+    short fileRef,        	/* File ref for an open resource fork. */
+    Tcl_Obj *tokenPtr,		/* A Tcl Object to which to write the  *
+				 * new token */
+    int flags)	     		/* 1 means insert at the head of the resource
+                                 * fork list, 0 means at the tail */
+
+{
+    Tcl_HashEntry *resourceHashPtr;
+    Tcl_HashEntry *nameHashPtr;
+    OpenResourceFork *resourceRef;
+    int new;
+    char *resourceId = NULL;
+   
+    if (!initialized) {
+        ResourceInit();
+    }
+    
+    /*
+     * If we were asked to, check that this file has not been opened
+     * already with a different permission.  It it has, then return an error.
+     */
+     
+    new = 1;
+    
+    if (flags & TCL_RESOURCE_CHECK_IF_OPEN) {
+        Tcl_HashSearch search;
+        short oldFileRef, filePermissionFlag;
+        FCBPBRec newFileRec, oldFileRec;
+        OSErr err;
+        
+        oldFileRec.ioCompletion = NULL;
+        oldFileRec.ioFCBIndx = 0;
+        oldFileRec.ioNamePtr = NULL;
+        
+        newFileRec.ioCompletion = NULL;
+        newFileRec.ioFCBIndx = 0;
+        newFileRec.ioNamePtr = NULL;
+        newFileRec.ioVRefNum = 0;
+        newFileRec.ioRefNum = fileRef;
+        err = PBGetFCBInfo(&newFileRec, false);
+        filePermissionFlag = ( newFileRec.ioFCBFlags >> 12 ) & 0x1;
+            
+        
+        resourceHashPtr = Tcl_FirstHashEntry(&resourceTable, &search);
+        while (resourceHashPtr != NULL) {
+            oldFileRef = (short) Tcl_GetHashKey(&resourceTable,
+                    resourceHashPtr);
+            if (oldFileRef == fileRef) {
+                new = 0;
+                break;
+            }
+            oldFileRec.ioVRefNum = 0;
+            oldFileRec.ioRefNum = oldFileRef;
+            err = PBGetFCBInfo(&oldFileRec, false);
+            
+            /*
+             * err might not be noErr either because the file has closed 
+             * out from under us somehow, which is bad but we're not going
+             * to fix it here, OR because it is the ROM MAP, which has a 
+             * fileRef, but can't be gotten to by PBGetFCBInfo.
+             */
+   
+            if ((err == noErr) 
+                    && (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
+                    && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) {
+                /* In MacOS 8.1 it seems like we get different file refs even though
+                 * we pass the same file & permissions.  This is not what Inside Mac
+                 * says should happen, but it does, so if it does, then close the new res
+                 * file and return the original one...
+                 */
+                 
+                if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) {
+                    CloseResFile(fileRef);
+                    new = 0;
+                    break;
+                } else {
+                    if (tokenPtr != NULL) {
+                        Tcl_SetStringObj(tokenPtr, 
+                                 "Resource already open with different permissions.", -1);
+                    }   	
+                    return TCL_ERROR;
+                }
+            }
+            resourceHashPtr = Tcl_NextHashEntry(&search);
+        }
+    }
+       
+    
+    /*
+     * If the file has already been opened with these same permissions, then it
+     * will be in our list and we will have set new to 0 above.
+     * So we will just return the token (if tokenPtr is non-null)
+     */
+     
+    if (new) {
+        resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
+		(char *) fileRef, &new);
+    }
+    
+    if (!new) {
+        if (tokenPtr != NULL) {   
+            resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
+	    Tcl_SetStringObj(tokenPtr, resourceId, -1);
+        }
+        return TCL_OK;
+    }        
+
+    /*
+     * If we were passed in a result pointer which is not an empty
+     * string, attempt to use that as the key.  If the key already
+     * exists, silently fall back on resource%d...
+     */
+     
+    if (tokenPtr != NULL) {
+        char *tokenVal;
+        int length;
+        tokenVal = (char *) Tcl_GetStringFromObj(tokenPtr, &length);
+        if (length > 0) {
+            nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenVal);
+            if (nameHashPtr == NULL) {
+                resourceId = ckalloc(length + 1);
+                memcpy(resourceId, tokenVal, length);
+                resourceId[length] = '\0';
+            }
+        }
+    }
+    
+    if (resourceId == NULL) {	
+        resourceId = (char *) ckalloc(15);
+        sprintf(resourceId, "resource%d", newId);
+    }
+    
+    Tcl_SetHashValue(resourceHashPtr, resourceId);
+    newId++;
+
+    nameHashPtr = Tcl_CreateHashEntry(&nameTable, resourceId, &new);
+    if (!new) {
+	panic("resource id has repeated itself");
+    }
+    
+    resourceRef = (OpenResourceFork *) ckalloc(sizeof(OpenResourceFork));
+    resourceRef->fileRef = fileRef;
+    resourceRef->flags = flags;
+    
+    Tcl_SetHashValue(nameHashPtr, (ClientData) resourceRef);
+    if (tokenPtr != NULL) {
+        Tcl_SetStringObj(tokenPtr, resourceId, -1);
+    }
+    
+    if (flags & TCL_RESOURCE_INSERT_TAIL) {
+        Tcl_ListObjAppendElement(NULL, resourceForkList, tokenPtr);
+    } else {
+        Tcl_ListObjReplace(NULL, resourceForkList, 0, 0, 1, &tokenPtr);	
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacUnRegisterResourceFork --
+ *
+ *	Removes the entry for an open resource fork from the table of 
+ *	open resources managed by the procedures in this file.
+ *      If resultPtr is not NULL, it will be used for error reporting.
+ *
+ * Results:
+ *	The fileRef for this token, or -1 if an error occured.
+ *
+ * Side effects:
+ *	An entry is removed from the resource name table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+short
+TclMacUnRegisterResourceFork(
+    char *tokenPtr,
+    Tcl_Obj *resultPtr)
+
+{
+    Tcl_HashEntry *resourceHashPtr;
+    Tcl_HashEntry *nameHashPtr;
+    OpenResourceFork *resourceRef;
+    char *resourceId = NULL;
+    short fileRef;
+    char *bytes;
+    int i, match, index, listLen, length, elemLen;
+    Tcl_Obj **elemPtrs;
+    
+     
+    nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenPtr);
+    if (nameHashPtr == NULL) {
+        if (resultPtr != NULL) {
+	    Tcl_AppendStringsToObj(resultPtr,
+		    "invalid resource file reference \"",
+		    tokenPtr, "\"", (char *) NULL);
+        }
+	return -1;
+    }
+    
+    resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
+    fileRef = resourceRef->fileRef;
+        
+    if ( resourceRef->flags & TCL_RESOURCE_DONT_CLOSE ) {
+        if (resultPtr != NULL) {
+	    Tcl_AppendStringsToObj(resultPtr,
+		    "can't close \"", tokenPtr, "\" resource file", 
+		    (char *) NULL);
+	}
+	return -1;
+    }            
+
+    Tcl_DeleteHashEntry(nameHashPtr);
+    ckfree((char *) resourceRef);
+    
+    
+    /* 
+     * Now remove the resource from the resourceForkList object 
+     */
+     
+    Tcl_ListObjGetElements(NULL, resourceForkList, &listLen, &elemPtrs);
+    
+ 
+    index = -1;
+    length = strlen(tokenPtr);
+    
+    for (i = 0; i < listLen; i++) {
+	match = 0;
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
+	if (length == elemLen) {
+		match = (memcmp(bytes, tokenPtr,
+			(size_t) length) == 0);
+	}
+	if (match) {
+	    index = i;
+	    break;
+	}
+    }
+    if (!match) {
+        panic("the resource Fork List is out of synch!");
+    }
+    
+    Tcl_ListObjReplace(NULL, resourceForkList, index, 1, 0, NULL);
+    
+    resourceHashPtr = Tcl_FindHashEntry(&resourceTable, (char *) fileRef);
+    
+    if (resourceHashPtr == NULL) {
+	panic("Resource & Name tables are out of synch in resource command.");
+    }
+    ckfree(Tcl_GetHashValue(resourceHashPtr));
+    Tcl_DeleteHashEntry(resourceHashPtr);
+    
+    return fileRef;
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildResourceForkList --
+ *
+ *	Traverses the list of open resource forks, and builds the 
+ *	list of resources forks.  Also creates a resource token for any that 
+ *      are opened but not registered with our resource system.
+ *      This is based on code from Apple DTS.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *      The list of resource forks is updated.
+ *	The resource name table may be augmented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+BuildResourceForkList()
+{
+    Handle currentMapHandle, mSysMapHandle;  
+    Ptr tempPtr;
+    FCBPBRec fileRec;
+    char fileName[256];
+    char appName[62];
+    Tcl_Obj *nameObj;
+    OSErr err;
+    ProcessSerialNumber psn;
+    ProcessInfoRec info;
+    FSSpec fileSpec;
+        
+    /* 
+     * Get the application name, so we can substitute
+     * the token "application" for the application's resource.
+     */ 
+     
+    GetCurrentProcess(&psn);
+    info.processInfoLength = sizeof(ProcessInfoRec);
+    info.processName = (StringPtr) &appName;
+    info.processAppSpec = &fileSpec;
+    GetProcessInformation(&psn, &info);
+    p2cstr((StringPtr) appName);
+
+    
+    fileRec.ioCompletion = NULL;
+    fileRec.ioVRefNum = 0;
+    fileRec.ioFCBIndx = 0;
+    fileRec.ioNamePtr = (StringPtr) &fileName;
+    
+    
+    currentMapHandle = LMGetTopMapHndl();
+    mSysMapHandle = LMGetSysMapHndl();
+    
+    while (1) {
+        /* 
+         * Now do the ones opened after the application.
+         */
+       
+        nameObj = Tcl_NewObj();
+        
+        tempPtr = *currentMapHandle;
+
+        fileRec.ioRefNum = *((short *) (tempPtr + 20));
+        err = PBGetFCBInfo(&fileRec, false);
+        
+        if (err != noErr) {
+            /*
+             * The ROM resource map does not correspond to an opened file...
+             */
+             Tcl_SetStringObj(nameObj, "ROM Map", -1);
+        } else {
+            p2cstr((StringPtr) fileName);
+            if (strcmp(fileName,(char *) appName) == 0) {
+                Tcl_SetStringObj(nameObj, "application", -1);
+            } else {
+                Tcl_SetStringObj(nameObj, fileName, -1);
+            }
+            c2pstr(fileName);
+        }
+        
+        TclMacRegisterResourceFork(fileRec.ioRefNum, nameObj, 
+            TCL_RESOURCE_DONT_CLOSE | TCL_RESOURCE_INSERT_TAIL);
+       
+        if (currentMapHandle == mSysMapHandle) {
+            break;
+        }
+        
+        currentMapHandle = *((Handle *) (tempPtr + 16));
+    }
+}
diff --git a/tcl/mac/tclMacResource.r b/tcl/mac/tclMacResource.r
new file mode 100644
index 00000000000..4bde129b4e9
--- /dev/null
+++ b/tcl/mac/tclMacResource.r
@@ -0,0 +1,92 @@
+/* 
+ * tclMacResource.r --
+ *
+ *	This file creates resources for use in a simple shell.
+ *	This is designed to be an example of using the Tcl libraries
+ *	statically in a Macintosh Application.  For an example of
+ *	of using the dynamic libraries look at tclMacApplication.r.
+ *
+ * Copyright (c) 1993-94 Lockheed Missle & Space Company
+ * Copyright (c) 1994-97 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+
+#if (TCL_RELEASE_LEVEL == 0)
+#   define RELEASE_LEVEL alpha
+#elif (TCL_RELEASE_LEVEL == 1)
+#   define RELEASE_LEVEL beta
+#elif (TCL_RELEASE_LEVEL == 2)
+#   define RELEASE_LEVEL final
+#endif
+
+#if (TCL_RELEASE_LEVEL == 2)
+#   define MINOR_VERSION (TCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+#else
+#   define MINOR_VERSION TCL_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+	TCL_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	TCL_PATCH_LEVEL,
+	TCL_PATCH_LEVEL ", by Ray Johnson © Sun Microsystems"
+};
+
+resource 'vers' (2) {
+	TCL_MAJOR_VERSION, MINOR_VERSION,
+	RELEASE_LEVEL, 0x00, verUS,
+	TCL_PATCH_LEVEL,
+	"Simple Tcl Shell " TCL_PATCH_LEVEL " © 1996"
+};
+
+
+/* 
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application.  The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl".  This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * require some predetermined file structure - all needed Tcl "files"
+ * are located within the application.  To source a file for the
+ * resource fork the source command has been modified to support
+ * sourcing from resources.  In the below case "source -rsrc {Init}"
+ * will load the TEXT resource named "Init".
+ */
+
+read 'TEXT' (0, "Init", purgeable, preload) "::library:init.tcl";
+read 'TEXT' (1, "History", purgeable,preload) "::library:history.tcl";
+read 'TEXT' (2, "Word", purgeable,preload) "::library:word.tcl";
+
+/*
+ * The following resource is used when creating the 'env' variable in
+ * the Macintosh environment.  The creation mechanisim looks for the
+ * 'STR#' resource named "Tcl Environment Variables" rather than a
+ * specific resource number.  (In other words, feel free to change the
+ * resource id if it conflicts with your application.)  Each string in
+ * the resource must be of the form "KEYWORD=SOME STRING".  See Tcl
+ * documentation for futher information about the env variable.
+ *
+ * A good example of something you may want to set is: "TCL_LIBRARY=My
+ * disk:etc."
+ */
+ 
+resource 'STR#' (128, "Tcl Environment Variables") {
+	{	"SCHEDULE_NAME=Agent Controller Schedule",
+		"SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+	};
+};
+
diff --git a/tcl/mac/tclMacShLib.exp b/tcl/mac/tclMacShLib.exp
new file mode 100644
index 00000000000..89361149844
--- /dev/null
+++ b/tcl/mac/tclMacShLib.exp
@@ -0,0 +1,1069 @@
+AddrToName
+AddrToStr
+BuildAFPVolMountInfo
+BumpDate
+ChangeCreatorType
+ChangeFDFlags
+CheckObjectLock
+CheckVolLock
+ClearHasBeenInited
+ClearHasCustomIcon
+ClearIsInvisible
+ClearIsStationery
+ClearNameLocked
+CloseResolver
+ConfigureMemory
+CopyDirectoryAccess
+CopyFileMgrAttributes
+CopyFork
+CreateFileIDRef
+DTCopyComment
+DTGetIcon
+DTOpen
+DTSetComment
+DeleteDirectory
+DeleteDirectoryContents
+DeleteFileIDRef
+DetermineVRefNum
+DirectoryCopy
+EnumCache
+##EnvStr
+ExchangeFiles
+FSMakeFSSpecCompat
+FSReadNoCache
+FSWriteNoCache
+FSWriteVerify
+FSpBumpDate
+FSpCatMoveCompat
+FSpChangeCreatorType
+FSpChangeFDFlags
+FSpCheckObjectLock
+FSpClearHasBeenInited
+FSpClearHasCustomIcon
+FSpClearIsInvisible
+FSpClearIsStationery
+FSpClearNameLocked
+FSpCopyDirectoryAccess
+FSpCopyFile
+FSpCopyFileMgrAttributes
+FSpCreateCompat
+FSpCreateFileIDRef
+FSpCreateMinimum
+FSpCreateResFileCompat
+FSpDTCopyComment
+FSpDTSetComment
+FSpDeleteCompat
+FSpDirCreateCompat
+FSpDirectoryCopy
+FSpExchangeFilesCompat
+FSpFileCopy
+FSpFilteredDirectoryCopy
+FSpFindFolder
+FSpGetDInfo
+FSpGetDefaultDir
+FSpGetDirAccess
+FSpGetDirectoryID
+FSpGetFInfoCompat
+FSpGetFLockCompat
+FSpGetFileLocation
+FSpGetFileSize
+FSpGetForeignPrivs
+FSpGetFullPath
+FSpGetIOACUser
+FSpLocationFromFullPath
+FSpLocationFromPath
+FSpMoveRename
+FSpMoveRenameCompat
+FSpOpenAware
+FSpOpenDFCompat
+FSpOpenRFAware
+FSpOpenRFCompat
+FSpOpenResFileCompat
+FSpPathFromLocation
+FSpRenameCompat
+FSpResolveFileIDRef
+FSpRstFLockCompat
+FSpSetDInfo
+FSpSetDefaultDir
+FSpSetDirAccess
+FSpSetFInfoCompat
+FSpSetFLockCompat
+FSpSetForeignPrivs
+FSpSetHasCustomIcon
+FSpSetIsInvisible
+FSpSetIsStationery
+FSpSetNameLocked
+FSpShare
+FSpUnshare
+FileCopy
+FilteredDirectoryCopy
+FindDrive
+FlushFile
+FreeAllMemory
+GetCPanelFolder
+GetCatInfoNoName
+GetDInfo
+GetDirItems
+GetDirName
+GetDirectoryID
+GetDiskBlocks
+GetDriverName
+GetFileLocation
+GetFileSize
+GetFilenameFromPathname
+GetForeignPrivs
+GetFullPath
+GetGlobalMouse
+GetIOACUser
+GetObjectLocation
+GetParentID
+GetSystemFolder
+GetTempBuffer
+GetTrapType
+GetUGEntries
+GetUGEntry
+GetVolMountInfo
+GetVolMountInfoSize
+GetVolumeInfoNoName
+HCopyFile
+HCreateMinimum
+HGetDirAccess
+HGetLogInInfo
+HGetVInfo
+HGetVolParms
+HInfo
+HMapID
+HMapName
+HMoveRename
+HMoveRenameCompat
+HOpenAware
+HOpenRFAware
+hypotd
+HSetDirAccess
+InstallConsole
+LocationFromFullPath
+LockRange
+MXInfo
+NumToolboxTraps
+OnLine
+OpenOurRF
+OpenResolver
+PBXGetVolInfoSync
+ReadCharsFromConsole
+RemoveConsole
+ResolveFileIDRef
+RestoreDefault
+RetrieveAFPVolMountInfo
+SIOUXBigRect
+SIOUXCantSaveAlert
+SIOUXDoAboutBox
+SIOUXDoContentClick
+SIOUXDoEditClear
+SIOUXDoEditCopy
+SIOUXDoEditCut
+SIOUXDoEditPaste
+SIOUXDoEditSelectAll
+SIOUXDoMenuChoice
+SIOUXDoPageSetup
+SIOUXDoPrintText
+SIOUXDoSaveText
+SIOUXDragRect
+SIOUXDrawGrowBox
+SIOUXHandleOneEvent
+SIOUXIsAppWindow
+SIOUXMyGrowWindow
+SIOUXQuitting
+SIOUXSetTitle
+SIOUXSettings
+SIOUXSetupMenus
+SIOUXSetupTextWindow
+SIOUXState
+SIOUXTextWindow
+SIOUXUpdateMenuItems
+SIOUXUpdateScrollbar
+SIOUXUpdateStatusLine
+SIOUXUpdateWindow
+SIOUXUseWaitNextEvent
+SIOUXYesNoCancelAlert
+SIOUXisinrange
+SIOUXselstart
+SearchFolderForDNRP
+SetDInfo
+SetDefault
+SetForeignPrivs
+SetHasCustomIcon
+SetIsInvisible
+SetIsStationery
+SetNameLocked
+Share
+StrToAddr
+TclAllocateFreeObjects
+TclChdir
+TclCleanupByteCode
+TclCleanupCommand
+TclCompileBreakCmd
+TclCompileCatchCmd
+TclCompileContinueCmd
+TclCompileDollarVar
+TclCompileExpr
+TclCompileExprCmd
+TclCompileForCmd
+TclCompileForeachCmd
+TclCompileIfCmd
+TclCompileIncrCmd
+TclCompileQuotes
+TclCompileSetCmd
+TclCompileString
+TclCompileWhileCmd
+TclCopyAndCollapse
+TclCopyChannel
+TclCreateAuxData
+TclCreateExecEnv
+TclDate_TclDates
+TclDate_TclDatev
+TclDateact
+TclDatechar
+TclDatechk
+TclDatedebug
+TclDatedef
+TclDateerrflag
+TclDateexca
+TclDatelval
+TclDatenerrs
+TclDatepact
+TclDateparse
+TclDatepgo
+TclDateps
+TclDatepv
+TclDater1
+TclDater2
+TclDates
+TclDatestate
+TclDatetmp
+TclDatev
+TclDateval
+TclDeleteCompiledLocalVars
+TclDeleteExecEnv
+TclDeleteVars
+TclDoGlob
+TclEmitForwardJump
+TclExecuteByteCode
+TclExpandCodeArray
+TclExpandJumpFixupArray
+TclExpandParseValue
+TclExprFloatError
+TclFileAttrsCmd
+TclFileCopyCmd
+TclFileDeleteCmd
+TclFileMakeDirsCmd
+TclFileRenameCmd
+TclFindElement
+TclFindProc
+TclFixupForwardJump
+TclFormatInt
+TclFreeCompileEnv
+TclFreeJumpFixupArray
+TclFreeObj
+TclFreePackageInfo
+TclGetCwd
+TclGetDate
+TclGetDefaultStdChannel
+TclGetElementOfIndexedArray
+TclGetEnv
+TclGetExceptionRangeForPc
+TclGetExtension
+TclGetFrame
+TclGetIndexedScalar
+TclGetIntForIndex
+TclGetLoadedPackages
+TclGetLong
+TclGetNamespaceForQualName
+TclGetOpenMode
+TclGetOriginalCommand
+TclGetRegError
+TclGetSrcInfoForPc
+TclGetUserHome
+TclGlobalInvoke
+TclGuessPackageName
+TclHasSockets
+TclHideUnsafeCommands
+TclInExit
+TclIncrElementOfIndexedArray
+TclIncrIndexedScalar
+TclIncrVar2
+TclInitByteCodeObj
+TclInitCompileEnv
+TclInitJumpFixupArray
+TclInitNamespaces
+TclInterpInit
+TclInvoke
+TclInvokeObjectCommand
+TclInvokeStringCommand
+TclIsProc
+TclLoadFile
+TclLooksLikeInt
+TclLookupVar
+TclMacAccess
+TclMacCreateEnv
+TclMacExitHandler
+TclMacFOpenHack
+TclMacInitExitToShell
+TclMacInstallExitToShellPatch
+TclMacOSErrorToPosixError
+TclMacReadlink
+TclMacRemoveTimer
+TclMacStartTimer
+TclMacStat
+TclMacTimerExpired
+TclMatchFiles
+TclNeedSpace
+TclObjIndexForString
+TclObjInterpProc
+TclObjInvoke
+TclObjInvokeGlobal
+TclParseBraces
+TclParseNestedCmd
+TclParseQuotes
+TclPlatformExit
+TclPlatformInit
+TclPreventAliasLoop
+TclPrintByteCodeObj
+TclPrintInstruction
+TclPrintSource
+TclRegComp
+TclRegError
+TclRegExec
+TclRenameCommand
+TclResetShadowedCmdRefs
+TclServiceIdle
+TclSetElementOfIndexedArray
+TclSetEnv
+TclSetIndexedScalar
+TclSetupEnv
+TclSockGetPort
+TclTeardownNamespace
+TclTestChannelCmd
+TclTestChannelEventCmd
+TclUnsetEnv
+TclUpdateReturnInfo
+TclWordEnd
+Tcl_AddErrorInfo
+Tcl_AddObjErrorInfo
+Tcl_AfterCmd
+Tcl_Alloc
+Tcl_AllowExceptions
+Tcl_AppendAllObjTypes
+Tcl_AppendElement
+Tcl_AppendObjCmd
+Tcl_AppendResult
+Tcl_AppendStringsToObj
+Tcl_AppendToObj
+Tcl_ArrayObjCmd
+Tcl_AsyncCreate
+Tcl_AsyncDelete
+Tcl_AsyncInvoke
+Tcl_AsyncMark
+Tcl_AsyncReady
+Tcl_BackgroundError
+Tcl_Backslash
+Tcl_BeepObjCmd
+Tcl_BinaryObjCmd
+Tcl_BreakCmd
+Tcl_CallWhenDeleted
+Tcl_CancelIdleCall
+Tcl_CaseObjCmd
+Tcl_CatchObjCmd
+Tcl_ClockObjCmd
+Tcl_Close
+Tcl_CommandComplete
+Tcl_Concat
+Tcl_ConcatObj
+Tcl_ConcatObjCmd
+Tcl_ContinueCmd
+Tcl_ConvertCountedElement
+Tcl_ConvertElement
+Tcl_ConvertToType
+Tcl_CreateAlias
+Tcl_CreateAliasObj
+Tcl_CreateChannel
+Tcl_CreateChannelHandler
+Tcl_CreateCloseHandler
+Tcl_CreateCommand
+Tcl_CreateEventSource
+Tcl_CreateExitHandler
+Tcl_CreateInterp
+Tcl_CreateMathFunc
+Tcl_CreateNamespace
+Tcl_CreateObjCommand
+Tcl_CreateSlave
+Tcl_CreateTimerHandler
+Tcl_CreateTrace
+Tcl_DStringAppend
+Tcl_DStringAppendElement
+Tcl_DStringEndSublist
+Tcl_DStringFree
+Tcl_DStringGetResult
+Tcl_DStringInit
+Tcl_DStringResult
+Tcl_DStringSetLength
+Tcl_DStringStartSublist
+Tcl_DbCkalloc
+Tcl_DbCkfree
+Tcl_DbCkrealloc
+Tcl_DbDecrRefCount
+Tcl_DbIsShared
+Tcl_DbIncrRefCount
+Tcl_DbNewBooleanObj
+Tcl_DbNewDoubleObj
+Tcl_DbNewListObj
+Tcl_DbNewLongObj
+Tcl_DbNewObj
+Tcl_DbNewStringObj
+Tcl_DeleteAssocData
+Tcl_DeleteChannelHandler
+Tcl_DeleteCloseHandler
+Tcl_DeleteCommand
+Tcl_DeleteCommandFromToken
+Tcl_DeleteEventSource
+Tcl_DeleteEvents
+Tcl_DeleteExitHandler
+Tcl_DeleteHashEntry
+Tcl_DeleteHashTable
+Tcl_DeleteInterp
+Tcl_DeleteNamespace
+Tcl_DeleteTimerHandler
+Tcl_DeleteTrace
+Tcl_DoOneEvent
+Tcl_DoWhenIdle
+Tcl_DontCallWhenDeleted
+Tcl_DumpActiveMemory
+Tcl_DuplicateObj
+Tcl_EchoCmd
+Tcl_Eof
+Tcl_ErrnoId
+Tcl_ErrnoMsg
+Tcl_ErrorObjCmd
+Tcl_Eval
+Tcl_EvalFile
+Tcl_EvalObj
+Tcl_EvalObjCmd
+Tcl_EventuallyFree
+Tcl_ExecCmd
+Tcl_Exit
+Tcl_ExitObjCmd
+Tcl_ExposeCommand
+Tcl_ExprBoolean
+Tcl_ExprBooleanObj
+Tcl_ExprDouble
+Tcl_ExprDoubleObj
+Tcl_ExprLong
+Tcl_ExprLongObj
+Tcl_ExprObjCmd
+Tcl_ExprString
+Tcl_FconfigureCmd
+Tcl_FcopyObjCmd
+Tcl_FileEventCmd
+Tcl_FileObjCmd
+Tcl_Finalize
+Tcl_FindCommand
+Tcl_FindExecutable
+Tcl_FindNamespace
+Tcl_FindNamespaceVar
+Tcl_FirstHashEntry
+Tcl_Flush
+Tcl_FlushObjCmd
+Tcl_ForCmd
+Tcl_ForeachObjCmd
+Tcl_ForgetImport
+Tcl_FormatCmd
+Tcl_Free
+Tcl_FreeResult
+Tcl_GetAlias
+Tcl_GetAliasObj
+Tcl_GetAssocData
+Tcl_GetBoolean
+Tcl_GetBooleanFromObj
+Tcl_GetChannel
+Tcl_GetChannelBufferSize
+Tcl_GetChannelHandle
+Tcl_GetChannelInstanceData
+Tcl_GetChannelMode
+Tcl_GetChannelName
+Tcl_GetChannelOption
+Tcl_GetChannelType
+Tcl_GetCommandFromObj
+Tcl_GetCommandFullName
+Tcl_GetCommandInfo
+Tcl_GetCommandName
+Tcl_GetCurrentNamespace
+Tcl_GetDouble
+Tcl_GetDoubleFromObj
+Tcl_GetErrno
+Tcl_GetGlobalNamespace
+Tcl_GetHostName
+Tcl_GetIndexFromObj
+Tcl_GetInt
+Tcl_GetIntFromObj
+Tcl_GetInterpPath
+Tcl_GetLongFromObj
+Tcl_GetMaster
+Tcl_GetOSTypeFromObj
+Tcl_GetObjResult
+Tcl_GetObjType
+Tcl_GetPathType
+Tcl_GetServiceMode
+Tcl_GetSlave
+Tcl_GetStdChannel
+Tcl_GetStringFromObj
+Tcl_GetStringResult
+Tcl_GetVar
+Tcl_GetVar2
+Tcl_GetVariableFullName
+Tcl_Gets
+Tcl_GetsObj
+Tcl_GetsObjCmd
+Tcl_GlobCmd
+Tcl_GlobalEval
+Tcl_GlobalEvalObj
+Tcl_GlobalObjCmd
+Tcl_HashStats
+Tcl_HideCommand
+Tcl_HistoryCmd
+Tcl_IfCmd
+Tcl_Import
+Tcl_IncrCmd
+Tcl_InfoObjCmd
+Tcl_Init
+Tcl_InitHashTable
+Tcl_InitMemory
+Tcl_InputBlocked
+Tcl_InputBuffered
+Tcl_InterpDeleted
+Tcl_InterpObjCmd
+Tcl_IsSafe
+Tcl_JoinObjCmd
+Tcl_JoinPath
+Tcl_LappendObjCmd
+Tcl_LindexObjCmd
+Tcl_LinkVar
+Tcl_LinsertObjCmd
+Tcl_ListObjAppendElement
+Tcl_ListObjAppendList
+Tcl_ListObjCmd
+Tcl_ListObjGetElements
+Tcl_ListObjIndex
+Tcl_ListObjLength
+Tcl_ListObjReplace
+Tcl_LlengthObjCmd
+Tcl_LoadCmd
+Tcl_LrangeObjCmd
+Tcl_LreplaceObjCmd
+Tcl_LsCmd
+Tcl_LsearchObjCmd
+Tcl_LsortObjCmd
+Tcl_MacConvertTextResource
+Tcl_MacEvalResource
+Tcl_MacFindResource
+Tcl_MacSetEventProc
+Tcl_MacSourceObjCmd
+Tcl_Main
+Tcl_MakeSafe
+Tcl_MakeTcpClientChannel
+Tcl_Merge
+Tcl_NamespaceObjCmd
+Tcl_NewBooleanObj
+Tcl_NewDoubleObj
+Tcl_NewIntObj
+Tcl_NewListObj
+Tcl_NewLongObj
+Tcl_NewOSTypeObj
+Tcl_NewObj
+Tcl_NewStringObj
+Tcl_NextHashEntry
+Tcl_NotifyChannel
+Tcl_ObjGetVar2
+Tcl_ObjSetVar2
+Tcl_OpenCmd
+Tcl_OpenFileChannel
+Tcl_OpenTcpClient
+Tcl_OpenTcpServer
+Tcl_PackageCmd
+Tcl_ParseVar
+Tcl_PidObjCmd
+Tcl_PkgProvide
+Tcl_PkgRequire
+Tcl_PopCallFrame
+Tcl_PosixError
+Tcl_Preserve
+Tcl_PrintDouble
+Tcl_ProcObjCmd
+Tcl_PushCallFrame
+Tcl_PutEnv
+Tcl_PutsObjCmd
+Tcl_PwdCmd
+Tcl_QueueEvent
+Tcl_Read
+Tcl_ReadObjCmd
+Tcl_Realloc
+Tcl_RecordAndEval
+Tcl_RegExpCompile
+Tcl_RegExpExec
+Tcl_RegExpMatch
+Tcl_RegExpRange
+Tcl_RegexpCmd
+Tcl_RegisterChannel
+Tcl_RegisterObjType
+Tcl_RegsubCmd
+Tcl_Release
+Tcl_RenameObjCmd
+Tcl_ResetResult
+Tcl_ResourceObjCmd
+Tcl_ReturnObjCmd
+Tcl_ScanCmd
+Tcl_ScanCountedElement
+Tcl_ScanElement
+Tcl_Seek
+Tcl_SeekCmd
+Tcl_ServiceAll
+Tcl_ServiceEvent
+Tcl_SetAssocData
+Tcl_SetBooleanObj
+Tcl_SetChannelBufferSize
+Tcl_SetChannelOption
+Tcl_SetCmd
+Tcl_SetCommandInfo
+Tcl_SetDoubleObj
+Tcl_SetErrno
+Tcl_SetErrorCode
+Tcl_SetIntObj
+Tcl_SetListObj
+Tcl_SetLongObj
+Tcl_SetMaxBlockTime
+Tcl_SetOSTypeObj
+Tcl_SetObjErrorCode
+Tcl_SetObjLength
+Tcl_SetObjResult
+Tcl_SetPanicProc
+Tcl_SetRecursionLimit
+Tcl_SetResult
+Tcl_SetServiceMode
+Tcl_SetStdChannel
+Tcl_SetStringObj
+Tcl_SetTimer
+Tcl_SetVar
+Tcl_SetVar2
+Tcl_SignalId
+Tcl_SignalMsg
+Tcl_Sleep
+Tcl_SocketCmd
+Tcl_SourceObjCmd
+Tcl_SourceRCFile
+Tcl_SplitList
+Tcl_SplitPath
+Tcl_StaticPackage
+Tcl_StringMatch
+Tcl_StringObjCmd
+Tcl_SubstCmd
+Tcl_SwitchObjCmd
+Tcl_Tell
+Tcl_TellCmd
+Tcl_TimeObjCmd
+Tcl_TraceCmd
+Tcl_TraceVar
+Tcl_TraceVar2
+Tcl_TranslateFileName
+Tcl_Ungets
+Tcl_UnlinkVar
+Tcl_UnregisterChannel
+Tcl_UnsetObjCmd
+Tcl_UnsetVar
+Tcl_UnsetVar2
+Tcl_UntraceVar
+Tcl_UntraceVar2
+Tcl_UpVar
+Tcl_UpVar2
+Tcl_UpdateCmd
+Tcl_UpdateLinkedVar
+Tcl_UplevelObjCmd
+Tcl_UpvarObjCmd
+Tcl_ValidateAllMemory
+Tcl_VarEval
+Tcl_VarTraceInfo
+Tcl_VarTraceInfo2
+Tcl_VariableObjCmd
+Tcl_VwaitCmd
+Tcl_WaitForEvent
+Tcl_WaitPid
+Tcl_WhileCmd
+Tcl_Write
+Tcl_WrongNumArgs
+TclpAlloc
+TclpCopyDirectory
+TclpCopyFile
+TclpCreateDirectory
+TclpDeleteFile
+TclpFree
+TclpGetClicks
+TclpGetDate
+TclpGetSeconds
+TclpGetTime
+TclpGetTimeZone
+TclpListVolumes
+TclpRealloc
+TclpRemoveDirectory
+TclpRenameFile
+TrapExists
+TruncPString
+UnlockRange
+UnmountAndEject
+Unshare
+VolumeMount
+WriteCharsToConsole
+XGetVInfo
+_Ctype
+_Stderr
+_Stoul
+abort
+abs
+acosf
+appMemory
+asctime
+asinf
+atan
+atan2
+atan2_d_dd
+atan2_d_pdpd
+atan2_r_prpr
+atan2_r_rr
+atan2f
+atan_d_d
+atan_d_pd
+atan_r_pr
+atan_r_r
+atanf
+atexit
+atof
+atoi
+atol
+bsearch
+builtinFuncTable
+calloc
+ccommand
+ceilf
+chdir
+clearerr
+clock
+close
+closeUPP
+completeUPP
+cos
+cos_d_d
+cos_d_pd
+cos_r_pr
+cos_r_r
+cosf
+coshf
+creat
+ctime
+cuserid
+difftime
+div
+environ
+errno
+exec
+exit
+exp
+exp_d_d
+exp_d_pd
+exp_r_pr
+exp_r_r
+expf
+fabsf
+fclose
+fcntl
+fdopen
+feof
+ferror
+fflush
+fgetc
+fgetpos
+fgets
+fileno
+floorf
+fmodf
+fopen
+fprintf
+fputc
+fputs
+fread
+free
+freopen
+frexpf
+fscanf
+fseek
+fsetpos
+fstat
+ftell
+fwrite
+getStdChannelsProc
+getc
+getchar
+getcwd
+getenv
+getlogin
+gets
+gmtime
+instructionTable
+isalnum
+isalpha
+isatty
+iscntrl
+isdigit
+isgraph
+islower
+isprint
+ispunct
+isspace
+isupper
+isxdigit
+labs
+ldexpf
+ldiv
+localeconv
+localtime
+log
+log10
+log10_d_d
+log10_d_pd
+log10f
+log_d_d
+log_d_pd
+logf
+longjmp
+lseek
+malloc
+mblen
+mbstowcs
+mbtowc
+memchr
+memcmp
+memcpy
+memmove
+memset
+mkdir
+mktime
+open
+panic
+panicProc
+perror
+pow
+power_d_dd
+powf
+printf
+putc
+putchar
+puts
+qsort
+raise
+rand
+read
+realloc
+remove
+rename
+resultUPP
+rewind
+rmdir
+scanf
+setbuf
+setlocale
+setvbuf
+signal
+sin
+sin_d_d
+sin_d_pd
+sin_r_pr
+sin_r_r
+sinf
+sinhf
+sleep
+sprintf
+sqrt
+sqrt_d_d
+sqrt_d_pd
+sqrt_r_pr
+sqrt_r_r
+sqrtf
+srand
+sscanf
+stat
+strcasecmp
+strcat
+strchr
+strcmp
+strcoll
+strcpy
+strcspn
+strerror
+strftime
+strlen
+strncasecmp
+strncat
+strncmp
+strncpy
+strpbrk
+strrchr
+strspn
+strstr
+strtod
+strtok
+strtol
+strtoul
+strxfrm
+system
+systemMemory
+tanf
+tanhf
+tclBooleanType
+tclByteCodeType
+tclCmdNameType
+tclDoubleType
+tclDummyLinkVarPtr
+tclExecutableName
+tclFreeObjList
+tclIndexType
+tclIntType
+tclListType
+tclMemDumpFileName
+tclNsNameType
+tclPlatform
+tclStringType
+tclTraceCompile
+tclTraceExec
+tclTypeTable
+tcl_MathInProgress
+tclpFileAttrProcs
+tclpFileAttrStrings
+tell
+time
+tmpfile
+tmpnam
+tolower
+toupper
+ttyname
+uname
+ungetc
+unlink
+utime
+utimes
+vfprintf
+vprintf
+vsprintf
+wcstombs
+wctob
+wctomb
+write
+#DTGetAPPL
+#DTGetComment
+#FSpDTGetAPPL
+#FSpDTGetComment
+#TclMacInitializeFragment
+#TclMacTerminateFragment
+#_Aldata
+#_Assert
+#_Atcount
+#_Atfuns
+#_Clocale
+#_Closreg
+#_Costate
+#_Daysto
+#_Dbl
+#_Defloc
+#_Environ
+#_Environ1
+#_Fgpos
+#_Files
+#_Flt
+#_Fopen
+#_Foprep
+#_Fread
+#_Freeloc
+#_Frprep
+#_Fspos
+#_Fwprep
+#_Fwrite
+#_Genld
+#_Gentime
+#_Getdst
+#_Getfld
+#_Getfloat
+#_Getint
+#_Getloc
+#_Getmem
+#_Getstr
+#_Gettime
+#_Getzone
+#_Isdst
+#_Ldbl
+#_Ldtob
+#_Litob
+#_Locale
+#_Locsum
+#_Loctab
+#_Locterm
+#_Locvar
+#_MWERKS_Atcount
+#_MWERKS_Atfuns
+#_Makeloc
+#_Makestab
+#_Makewct
+#_Mbcurmax
+#_Mbstate
+#_Mbtowc
+#_Nnl
+#_PJP_C_Copyright
+#_Printf
+#_Putfld
+#_Putstr
+#_Puttxt
+#_Randseed
+#_Readloc
+#_Scanf
+#_Setloc
+#_Skip
+#_Stdin
+#_Stdout
+#_Stod
+#_Stof
+#_Stoflt
+#_Stold
+#_Strerror
+#_Strftime
+#_Strxfrm
+#_Times
+#_Tolower
+#_Toupper
+#_Ttotm
+#_WCostate
+#_Wcstate
+#_Wctob
+#_Wctomb
+#_Wctrans
+#_Wctype
+#__CheckForSystem7
+#__RemoveConsoleHandler__
+#__aborting
+#__ctopstring
+#__cvt_fp2unsigned
+#__getcreator
+#__gettype
+#__initialize
+#__myraise
+#__ptmf_null
+#__ptr_glue
+#__system7present
+#__terminate
+#__ttyname
+#_atexit
+#_exit
+#_fcreator
+#_ftype
diff --git a/tcl/mac/tclMacSock.c b/tcl/mac/tclMacSock.c
new file mode 100644
index 00000000000..690bee29699
--- /dev/null
+++ b/tcl/mac/tclMacSock.c
@@ -0,0 +1,2615 @@
+/* 
+ * tclMacSock.c
+ *
+ *	Channel drivers for Macintosh sockets.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMacInt.h"
+#include <AddressXlation.h>
+#include <Aliases.h>
+#undef Status
+#include <Devices.h>
+#include <Errors.h>
+#include <Events.h>
+#include <Files.h>
+#include <Gestalt.h>
+#include <MacTCP.h>
+#include <Processes.h>
+#include <Strings.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * If debugging is on we may drop into the debugger to handle certain cases
+ * that are not supposed to happen.  Otherwise, we change ignore the error
+ * and most code should handle such errors ok.
+ */
+
+#ifndef TCL_DEBUG
+    #define Debugger()
+#endif
+
+/*
+ * The preferred buffer size for Macintosh channels.
+ */
+
+#define CHANNEL_BUF_SIZE	8192
+
+/*
+ * Port information structure.  Used to match service names
+ * to a Tcp/Ip port number.
+ */
+
+typedef struct {
+    char *name;			/* Name of service. */
+    int port;			/* Port number. */
+} PortInfo;
+
+/*
+ * This structure describes per-instance state of a tcp based channel.
+ */
+
+typedef struct TcpState {
+    TCPiopb pb;			   /* Parameter block used by this stream. 
+				    * This must be in the first position. */
+    ProcessSerialNumber	psn;	   /* PSN used to wake up process. */
+    StreamPtr tcpStream;	   /* Macintosh tcp stream pointer. */
+    int port;			   /* The port we are connected to. */
+    int flags;			   /* Bit field comprised of the flags
+				    * described below.  */
+    int checkMask;		   /* OR'ed combination of TCL_READABLE and
+				    * TCL_WRITABLE as set by an asynchronous
+				    * event handler. */
+    int watchMask;		   /* OR'ed combination of TCL_READABLE and
+				    * TCL_WRITABLE as set by Tcl_WatchFile. */
+    Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
+    ClientData acceptProcData;	   /* The data for the accept proc. */
+    wdsEntry dataSegment[2];       /* List of buffers to be written async. */
+    rdsEntry rdsarray[5+1];	   /* Array used when cleaning out recieve 
+				    * buffers on a closing socket. */
+    Tcl_Channel channel;	   /* Channel associated with this socket. */
+    struct TcpState *nextPtr;	   /* The next socket on the global socket
+				    * list. */
+} TcpState;
+
+/*
+ * This structure is used by domain name resolver callback.
+ */
+
+typedef struct DNRState {
+    struct hostInfo hostInfo;	/* Data structure used by DNR functions. */
+    int done;			/* Flag to determine when we are done. */
+    ProcessSerialNumber psn;	/* Process to wake up when we are done. */
+} DNRState;
+
+/*
+ * The following macros may be used to set the flags field of
+ * a TcpState structure.
+ */
+
+#define TCP_ASYNC_SOCKET	(1<<0)  /* The socket is in async mode. */
+#define TCP_ASYNC_CONNECT	(1<<1)  /* The socket is trying to connect. */
+#define TCP_CONNECTED		(1<<2)  /* The socket is connected. */
+#define TCP_PENDING		(1<<3)	/* A SocketEvent is on the queue. */
+#define TCP_LISTENING 		(1<<4)  /* This socket is listening for
+					 * a connection. */
+#define TCP_LISTEN_CONNECT 	(1<<5)  /* Someone has connect to the
+					 * listening port. */
+#define TCP_REMOTE_CLOSED 	(1<<6)  /* The remote side has closed
+					 * the connection. */
+#define TCP_RELEASE	 	(1<<7)  /* The socket may now be released. */
+#define TCP_WRITING		(1<<8)  /* A background write is in progress. */
+#define TCP_SERVER_ZOMBIE	(1<<9)  /* The server can no longer accept connects. */
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * a socket event occurs.
+ */
+
+typedef struct SocketEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    TcpState *statePtr;		/* Socket descriptor that is ready. */
+    StreamPtr tcpStream;	/* Low level Macintosh stream. */
+} SocketEvent;
+
+/*
+ * Static routines for this file:
+ */
+
+static pascal void	CleanUpExitProc _ANSI_ARGS_((void));
+static void		ClearZombieSockets _ANSI_ARGS_((void));
+static void		CloseCompletionRoutine _ANSI_ARGS_((TCPiopb *pb));
+static TcpState *	CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
+			    int port, char *host, char *myAddr,  int myPort,
+			    int server, int async));
+static pascal void	DNRCompletionRoutine _ANSI_ARGS_((
+			    struct hostInfo *hostinfoPtr,
+			    DNRState *dnrStatePtr));
+static void		FreeSocketInfo _ANSI_ARGS_((TcpState *statePtr));
+static long		GetBufferSize _ANSI_ARGS_((void));
+static OSErr		GetHostFromString _ANSI_ARGS_((char *name,
+			    ip_addr *address));
+static OSErr		GetLocalAddress _ANSI_ARGS_((unsigned long *addr));
+static void		IOCompletionRoutine _ANSI_ARGS_((TCPiopb *pb));
+static void		InitMacTCPParamBlock _ANSI_ARGS_((TCPiopb *pBlock,
+			    int csCode));
+static void		InitSockets _ANSI_ARGS_((void));
+static TcpState *	NewSocketInfo _ANSI_ARGS_((StreamPtr stream));
+static OSErr		ResolveAddress _ANSI_ARGS_((ip_addr tcpAddress,
+			    Tcl_DString *dsPtr));
+static void		SocketCheckProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		SocketEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+			    int flags));
+static void		SocketExitHandler _ANSI_ARGS_((ClientData clientData));
+static void		SocketFreeProc _ANSI_ARGS_((ClientData clientData));
+static int		SocketReady _ANSI_ARGS_((TcpState *statePtr));
+static void		SocketSetupProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static void		TcpAccept _ANSI_ARGS_((TcpState *statePtr));
+static int		TcpBlockMode _ANSI_ARGS_((ClientData instanceData, int mode));
+static int		TcpClose _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp));
+static int		TcpGetHandle _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static int		TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+                            Tcl_Interp *interp, char *optionName,
+			    Tcl_DString *dsPtr));
+static int		TcpInput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toRead, int *errorCodePtr));
+static int		TcpOutput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toWrite, int *errorCodePtr));
+static void		TcpWatch _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+static int		WaitForSocketEvent _ANSI_ARGS_((TcpState *infoPtr,
+		            int mask, int *errorCodePtr));
+
+/*
+ * This structure describes the channel type structure for TCP socket
+ * based IO:
+ */
+
+static Tcl_ChannelType tcpChannelType = {
+    "tcp",			/* Type name. */
+    TcpBlockMode,		/* Set blocking or
+                                 * non-blocking mode.*/
+    TcpClose,			/* Close proc. */
+    TcpInput,			/* Input proc. */
+    TcpOutput,			/* Output proc. */
+    NULL,			/* Seek proc. */
+    NULL,			/* Set option proc. */
+    TcpGetOptionProc,		/* Get option proc. */
+    TcpWatch,			/* Initialize notifier. */
+    TcpGetHandle		/* Get handles out of channel. */
+};
+
+/*
+ * Universal Procedure Pointers (UPP) for various callback
+ * routines used by MacTcp code.
+ */
+
+ResultUPP resultUPP = NULL;
+TCPIOCompletionUPP completeUPP = NULL;
+TCPIOCompletionUPP closeUPP = NULL;
+
+/*
+ * Built-in commands, and the procedures associated with them:
+ */
+
+static PortInfo portServices[] = {
+    {"echo",		7},
+    {"discard",		9},
+    {"systat",		11},
+    {"daytime",		13},
+    {"netstat",		15},
+    {"chargen",		19},
+    {"ftp-data",	20},
+    {"ftp",		21},
+    {"telnet",		23},
+    {"telneto",		24},
+    {"smtp",		25},
+    {"time",		37},
+    {"whois",		43},
+    {"domain",		53},
+    {"gopher",		70},
+    {"finger",		79},
+    {"hostnames",	101},
+    {"sunrpc",		111},
+    {"nntp",		119},
+    {"exec",		512},
+    {"login",		513},
+    {"shell",		514},
+    {"printer",		515},
+    {"courier",		530},
+    {"uucp",		540},
+    {NULL,		0},
+};
+
+/*
+ * Every open socket has an entry on the following list.
+ */
+
+static TcpState *socketList = NULL;
+
+/*
+ * Globals for holding information about OS support for sockets.
+ */
+
+static int socketsTestInited = false;
+static int hasSockets = false;
+static short driverRefNum = 0;
+static int socketNumber = 0;
+static int socketBufferSize = CHANNEL_BUF_SIZE;
+static ProcessSerialNumber applicationPSN;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitSockets --
+ *
+ *	Load the MacTCP driver and open the name resolver.  We also
+ *	create several UPP's used by our code.  Lastly, we install
+ *	a patch to ExitToShell to clean up socket connections if
+ *	we are about to exit.
+ *
+ * Results:
+ *	1 if successful, 0 on failure.
+ *
+ * Side effects:
+ *	Creates a new event source, loads the MacTCP driver,
+ *	registers an exit to shell callback.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define gestaltMacTCPVersion 'mtcp'
+static void
+InitSockets()
+{
+    ParamBlockRec pb; 
+    OSErr err;
+    long response;
+
+    initialized = 1;
+    Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
+	
+    if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
+	hasSockets = true;
+    } else {
+	hasSockets = false;
+    }
+
+    if (!hasSockets) {
+	return;
+    }
+
+    /*
+     * Load MacTcp driver and name server resolver.
+     */
+	
+		
+    pb.ioParam.ioCompletion = 0L; 
+    pb.ioParam.ioNamePtr = "\p.IPP"; 
+    pb.ioParam.ioPermssn = fsCurPerm; 
+    err = PBOpenSync(&pb); 
+    if (err != noErr) {
+	hasSockets = 0;
+	return;
+    }
+    driverRefNum = pb.ioParam.ioRefNum; 
+	
+    socketBufferSize = GetBufferSize();
+    err = OpenResolver(NULL);
+    if (err != noErr) {
+	hasSockets = 0;
+	return;
+    }
+
+    GetCurrentProcess(&applicationPSN);
+    /*
+     * Create UPP's for various callback routines.
+     */
+
+    resultUPP = NewResultProc(DNRCompletionRoutine);
+    completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
+    closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
+
+    /*
+     * Install an ExitToShell patch.  We use this patch instead
+     * of the Tcl exit mechanism because we need to ensure that
+     * these routines are cleaned up even if we crash or are forced
+     * to quit.  There are some circumstances when the Tcl exit
+     * handlers may not fire.
+     */
+
+    TclMacInstallExitToShellPatch(CleanUpExitProc);
+    
+    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+
+    initialized = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketExitHandler --
+ *
+ *	Callback invoked during exit clean up to deinitialize the
+ *	socket module.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SocketExitHandler(
+    ClientData clientData)              /* Not used. */
+{
+    if (hasSockets) {
+	Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
+	/* CleanUpExitProc();
+	TclMacDeleteExitToShellPatch(CleanUpExitProc); */
+    }
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclHasSockets --
+ *
+ *	This function determines whether sockets are available on the
+ *	current system and returns an error in interp if they are not.
+ *	Note that interp may be NULL.
+ *
+ * Results:
+ *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with
+ *	an error in interp.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclHasSockets(
+    Tcl_Interp *interp)		/* Interp for error messages. */
+{
+    if (!initialized) {
+	InitSockets();
+    }
+
+    if (hasSockets) {
+	return TCL_OK;
+    }
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "sockets are not available on this system",
+		NULL);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketSetupProc --
+ *
+ *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ *	for an event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SocketSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    TcpState *statePtr;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Check to see if there is a ready socket.  If so, poll.
+     */
+
+    for (statePtr = socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if (statePtr->flags & TCP_RELEASE) {
+	    continue;
+	}
+	if (SocketReady(statePtr)) {
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketCheckProc --
+ *
+ *	This procedure is called by Tcl_DoOneEvent to check the socket
+ *	event source for events. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SocketCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    TcpState *statePtr;
+    SocketEvent *evPtr;
+    TcpState dummyState;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Queue events for any ready sockets that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
+
+    for (statePtr = socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	/*
+	 * Check to see if this socket is dead and needs to be cleaned
+	 * up.  We use a dummy statePtr whose only valid field is the
+	 * nextPtr to allow the loop to continue even if the element
+	 * is deleted.
+	 */
+
+	if (statePtr->flags & TCP_RELEASE) {
+	    if (!(statePtr->flags & TCP_PENDING)) {
+		dummyState.nextPtr = statePtr->nextPtr;
+		SocketFreeProc(statePtr);
+		statePtr = &dummyState;
+	    }
+	    continue;
+	}
+
+	if (!(statePtr->flags & TCP_PENDING) && SocketReady(statePtr)) {
+	    statePtr->flags |= TCP_PENDING;
+	    evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
+	    evPtr->header.proc = SocketEventProc;
+	    evPtr->statePtr = statePtr;
+	    evPtr->tcpStream = statePtr->tcpStream;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketReady --
+ *
+ *	This function checks the current state of a socket to see
+ *	if any interesting conditions are present.
+ *
+ * Results:
+ *	Returns 1 if an event that someone is watching is present, else
+ *	returns 0.
+ *
+ * Side effects:
+ *	Updates the checkMask for the socket to reflect any newly
+ *	detected events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SocketReady(
+    TcpState *statePtr)
+{
+    TCPiopb statusPB;
+    int foundSomething = 0;
+    int didStatus = 0;
+    int amount;
+    OSErr err;
+
+    if (statePtr->flags & TCP_LISTEN_CONNECT) {
+	foundSomething = 1;
+	statePtr->checkMask |= TCL_READABLE;
+    }
+    if (statePtr->watchMask & TCL_READABLE) {
+	if (statePtr->checkMask & TCL_READABLE) {
+	    foundSomething = 1;
+	} else if (statePtr->flags & TCP_CONNECTED) {
+	    statusPB.ioCRefNum = driverRefNum;
+	    statusPB.tcpStream = statePtr->tcpStream;
+	    statusPB.csCode = TCPStatus;
+	    err = PBControlSync((ParmBlkPtr) &statusPB);
+	    didStatus = 1;
+
+	    /*
+	     * We make the fchannel readable if 1) we get an error,
+	     * 2) there is more data available, or 3) we detect
+	     * that a close from the remote connection has arrived.
+	     */
+
+	    if ((err != noErr) ||
+		    (statusPB.csParam.status.amtUnreadData > 0) ||
+		    (statusPB.csParam.status.connectionState == 14)) {
+		statePtr->checkMask |= TCL_READABLE;
+		foundSomething = 1;
+	    }
+	}
+    }
+    if (statePtr->watchMask & TCL_WRITABLE) {
+	if (statePtr->checkMask & TCL_WRITABLE) {
+	    foundSomething = 1;
+	} else if (statePtr->flags & TCP_CONNECTED) {
+	    if (!didStatus) {
+		statusPB.ioCRefNum = driverRefNum;
+		statusPB.tcpStream = statePtr->tcpStream;
+		statusPB.csCode = TCPStatus;
+		err = PBControlSync((ParmBlkPtr) &statusPB);
+	    }
+
+	    /*
+	     * If there is an error or there if there is room to
+	     * send more data we make the channel writeable.
+	     */
+
+	    amount = statusPB.csParam.status.sendWindow - 
+		statusPB.csParam.status.amtUnackedData;
+	    if ((err != noErr) || (amount > 0)) {
+		statePtr->checkMask |= TCL_WRITABLE;
+		foundSomething = 1;
+	    }
+	}
+    }
+    return foundSomething;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitMacTCPParamBlock--
+ *
+ *	Initialize a MacTCP parameter block.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the parameter block.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitMacTCPParamBlock(
+    TCPiopb *pBlock,		/* Tcp parmeter block. */
+    int csCode)			/* Tcp operation code. */
+{
+    memset(pBlock, 0, sizeof(TCPiopb));
+    pBlock->ioResult = 1;
+    pBlock->ioCRefNum = driverRefNum;
+    pBlock->csCode = (short) csCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpBlockMode --
+ *
+ *	Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpBlockMode(
+    ClientData instanceData, 		/* Channel state. */
+    int mode)				/* The mode to set. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+    
+    if (mode == TCL_MODE_BLOCKING) {
+	statePtr->flags &= ~TCP_ASYNC_SOCKET;
+    } else {
+	statePtr->flags |= TCP_ASYNC_SOCKET;
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpClose --
+ *
+ *	Close the socket.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpClose(
+    ClientData instanceData,		/* The socket to close. */
+    Tcl_Interp *interp)			/* Interp for error messages. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+    StreamPtr tcpStream;
+    TCPiopb closePB;
+    OSErr err;
+
+    tcpStream = statePtr->tcpStream;
+    statePtr->flags &= ~TCP_CONNECTED;
+    
+    /*
+     * If this is a server socket we can't use the statePtr
+     * param block because it is in use.  However, we can 
+     * close syncronously.
+     */
+
+    if ((statePtr->flags & TCP_LISTENING) ||
+	    (statePtr->flags & TCP_LISTEN_CONNECT)) {
+	InitMacTCPParamBlock(&closePB, TCPClose);
+    	closePB.tcpStream = tcpStream;
+    	closePB.ioCompletion = NULL; 
+    	err = PBControlSync((ParmBlkPtr) &closePB);
+    	if (err != noErr) {
+    	    Debugger();
+            panic("error closing server socket");
+    	}
+	statePtr->flags |= TCP_RELEASE;
+
+	/*
+	 * Server sockets are closed sync.  Therefor, we know it is OK to
+	 * release the socket now.
+	 */
+
+	InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
+	statePtr->pb.tcpStream = statePtr->tcpStream;
+	err = PBControlSync((ParmBlkPtr) &statePtr->pb);
+	if (err != noErr) {
+            panic("error releasing server socket");
+	}
+
+	/*
+	 * Free the buffer space used by the socket and the 
+	 * actual socket state data structure.
+	 */
+
+	ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
+	FreeSocketInfo(statePtr);
+	return 0;
+    }
+
+    /*
+     * If this socket is in the midddle on async connect we can just
+     * abort the connect and release the stream right now.
+     */
+ 
+    if (statePtr->flags & TCP_ASYNC_CONNECT) {
+	InitMacTCPParamBlock(&closePB, TCPClose);
+    	closePB.tcpStream = tcpStream;
+    	closePB.ioCompletion = NULL; 
+    	err = PBControlSync((ParmBlkPtr) &closePB);
+    	if (err != noErr) {
+            panic("error closing async connect socket");
+    	}
+	statePtr->flags |= TCP_RELEASE;
+
+	InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
+	statePtr->pb.tcpStream = statePtr->tcpStream;
+	err = PBControlSync((ParmBlkPtr) &statePtr->pb);
+	if (err != noErr) {
+            panic("error releasing async connect socket");
+	}
+
+	/*
+	 * Free the buffer space used by the socket and the 
+	 * actual socket state data structure.
+	 */
+
+	ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
+	FreeSocketInfo(statePtr);
+	return 0;
+    }
+
+    /*
+     * Client sockets:
+     * If a background write is in progress, don't close
+     * the socket yet.  The completion routine for the 
+     * write will take care of it.
+     */
+    
+    if (!(statePtr->flags & TCP_WRITING)) {
+	InitMacTCPParamBlock(&statePtr->pb, TCPClose);
+    	statePtr->pb.tcpStream = tcpStream;
+    	statePtr->pb.ioCompletion = closeUPP; 
+    	statePtr->pb.csParam.close.userDataPtr = (Ptr) statePtr;
+    	err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
+    	if (err != noErr) {
+	    Debugger();
+	    statePtr->flags |= TCP_RELEASE;
+            /* return 0; */
+    	}
+    }
+
+    SocketFreeProc(instanceData);
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseCompletionRoutine --
+ *
+ *	Handles the close protocol for a Tcp socket.  This will do
+ *	a series of calls to release all data currently buffered for
+ *	the socket.  This is important to do to as it allows the remote
+ *	connection to recieve and issue it's own close on the socket.
+ *	Note that this function is running at interupt time and can't
+ *	allocate memory or do much else except set state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The buffers for the socket are flushed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CloseCompletionRoutine(
+    TCPiopb *pbPtr)		/* Tcp parameter block. */
+{
+    TcpState *statePtr;
+    OSErr err;
+    
+    if (pbPtr->csCode == TCPClose) {
+	statePtr = (TcpState *) (pbPtr->csParam.close.userDataPtr);
+    } else {
+	statePtr = (TcpState *) (pbPtr->csParam.receive.userDataPtr);
+    }
+
+    /*
+     * It's very bad if the statePtr is nNULL - we should probably panic...
+     */
+
+    if (statePtr == NULL) {
+	Debugger();
+	return;
+    }
+    
+    WakeUpProcess(&statePtr->psn);
+
+    /*
+     * If there is an error we assume the remote side has already
+     * close.  We are done closing as soon as we decide that the
+     * remote connection has closed.
+     */
+    
+    if (pbPtr->ioResult != noErr) {
+	statePtr->flags |= TCP_RELEASE;
+	return;
+    }
+    if (statePtr->flags & TCP_REMOTE_CLOSED) {
+	statePtr->flags |= TCP_RELEASE;
+	return;
+    }
+    
+    /*
+     * If we just did a recieve we need to return the buffers.
+     * Otherwise, attempt to recieve more data until we recieve an
+     * error (usually because we have no more data).
+     */
+
+    if (statePtr->pb.csCode == TCPNoCopyRcv) {
+	InitMacTCPParamBlock(&statePtr->pb, TCPRcvBfrReturn);
+    	statePtr->pb.tcpStream = statePtr->tcpStream;
+	statePtr->pb.ioCompletion = closeUPP; 
+	statePtr->pb.csParam.receive.rdsPtr = (Ptr) statePtr->rdsarray;
+    	statePtr->pb.csParam.receive.userDataPtr = (Ptr) statePtr;
+	err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
+    } else {
+	InitMacTCPParamBlock(&statePtr->pb, TCPNoCopyRcv);
+    	statePtr->pb.tcpStream = statePtr->tcpStream;
+	statePtr->pb.ioCompletion = closeUPP; 
+	statePtr->pb.csParam.receive.commandTimeoutValue = 1;
+	statePtr->pb.csParam.receive.rdsPtr = (Ptr) statePtr->rdsarray;
+	statePtr->pb.csParam.receive.rdsLength = 5;
+    	statePtr->pb.csParam.receive.userDataPtr = (Ptr) statePtr;
+	err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
+    }
+
+    if (err != noErr) {
+	statePtr->flags |= TCP_RELEASE;
+    }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketFreeProc --
+ *
+ *      This callback is invoked in order to delete
+ *      the notifier data associated with a file handle.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Removes the SocketInfo from the global socket list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SocketFreeProc(
+    ClientData clientData)      /* Channel state. */
+{
+    TcpState *statePtr = (TcpState *) clientData;
+    OSErr err;
+    TCPiopb statusPB;
+
+    /*
+     * Get the status of this connection.  We need to do a
+     * few tests to see if it's OK to release the stream now.
+     */
+
+    if (!(statePtr->flags & TCP_RELEASE)) {
+	return;
+    }
+    statusPB.ioCRefNum = driverRefNum;
+    statusPB.tcpStream = statePtr->tcpStream;
+    statusPB.csCode = TCPStatus;
+    err = PBControlSync((ParmBlkPtr) &statusPB);
+    if ((statusPB.csParam.status.connectionState == 0) ||
+	(statusPB.csParam.status.connectionState == 2)) {
+	/*
+	 * If the conection state is 0 then this was a client
+	 * connection and it's closed.  If it is 2 then this a
+	 * server client and we may release it.  If it isn't
+	 * one of those values then we return and we'll try to
+	 * clean up later.
+	 */
+
+    } else {
+	return;
+    }
+    
+    /*
+     * The Close request is made async.  We know it's
+     * OK to release the socket when the TCP_RELEASE flag
+     * gets set.
+     */
+
+    InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
+    statePtr->pb.tcpStream = statePtr->tcpStream;
+    err = PBControlSync((ParmBlkPtr) &statePtr->pb);
+    if (err != noErr) {
+        Debugger(); /* Ignoreing leaves stranded stream.  Is there an
+		       alternative?  */
+    }
+
+    /*
+     * Free the buffer space used by the socket and the 
+     * actual socket state data structure.
+     */
+
+    ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
+    FreeSocketInfo(statePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpInput --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error 
+ *	indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned.  A value of -1
+ *	implies an error occured.  A value of zero means we have reached
+ *	the end of data (EOF).
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TcpInput(
+    ClientData instanceData,		/* Channel state. */
+    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 = (TcpState *) instanceData;
+    StreamPtr tcpStream;
+    OSErr err;
+    TCPiopb statusPB;
+    int toRead, dataAvail;
+
+    *errorCodePtr = 0;
+    errno = 0;
+    tcpStream = statePtr->tcpStream;
+
+    if (bufSize == 0) {
+        return 0;
+    }
+    toRead = bufSize;
+
+    /*
+     * First check to see if EOF was already detected, to prevent
+     * calling the socket stack after the first time EOF is detected.
+     */
+
+    if (statePtr->flags & TCP_REMOTE_CLOSED) {
+	return 0;
+    }
+
+    /*
+     * If an asynchronous connect is in progress, attempt to wait for it
+     * to complete before reading.
+     */
+    
+    if ((statePtr->flags & TCP_ASYNC_CONNECT)
+	    && ! WaitForSocketEvent(statePtr, TCL_READABLE, errorCodePtr)) {
+	return -1;
+    }
+
+    /*
+     * No EOF, and it is connected, so try to read more from the socket.
+     * If the socket is blocking, we keep trying until there is data
+     * available or the socket is closed.
+     */
+
+    while (1) {
+
+	statusPB.ioCRefNum = driverRefNum;
+	statusPB.tcpStream = tcpStream;
+	statusPB.csCode = TCPStatus;
+	err = PBControlSync((ParmBlkPtr) &statusPB);
+	if (err != noErr) {
+	    Debugger();
+	    statePtr->flags |= TCP_REMOTE_CLOSED;
+	    return 0;	/* EOF */
+	}
+	dataAvail = statusPB.csParam.status.amtUnreadData;
+	if (dataAvail < bufSize) {
+	    toRead = dataAvail;
+	} else {
+	    toRead = bufSize;
+	}
+	if (toRead != 0) {
+	    /*
+	     * Try to read the data.
+	     */
+	    
+	    InitMacTCPParamBlock(&statusPB, TCPRcv);
+	    statusPB.tcpStream = tcpStream;
+	    statusPB.csParam.receive.rcvBuff = buf;
+	    statusPB.csParam.receive.rcvBuffLen = toRead;
+	    err = PBControlSync((ParmBlkPtr) &statusPB);
+
+	    statePtr->checkMask &= ~TCL_READABLE;
+	    switch (err) {
+		case noErr:
+		    /*
+		     * The channel remains readable only if this read succeds
+		     * and we had more data then the size of the buffer we were
+		     * trying to fill.  Use the info from the call to status to
+		     * determine this.
+		     */
+
+		    if (dataAvail > bufSize) {
+			statePtr->checkMask |= TCL_READABLE;
+		    }
+		    return statusPB.csParam.receive.rcvBuffLen;
+		case connectionClosing:
+		    *errorCodePtr = errno = ESHUTDOWN;
+		    statePtr->flags |= TCP_REMOTE_CLOSED;
+		    return 0;
+		case connectionDoesntExist:
+		case connectionTerminated:
+		    *errorCodePtr = errno = ENOTCONN;
+		    statePtr->flags |= TCP_REMOTE_CLOSED;
+		    return 0;
+		case invalidStreamPtr:
+		default:
+		    *errorCodePtr = EINVAL;
+		    return -1;
+	    }
+	}
+
+	/*
+	 * No data is available, so check the connection state to
+	 * see why this is the case.  
+	 */
+
+	if (statusPB.csParam.status.connectionState == 14) {
+	    statePtr->flags |= TCP_REMOTE_CLOSED;
+	    return 0;
+	}
+	if (statusPB.csParam.status.connectionState != 8) {
+	    Debugger();
+	}
+	statePtr->checkMask &= ~TCL_READABLE;
+	if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return -1;
+	}
+
+	/*
+	 * In the blocking case, wait until the file becomes readable
+	 * or closed and try again.
+	 */
+
+	if (!WaitForSocketEvent(statePtr, TCL_READABLE, errorCodePtr)) {
+	    return -1;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetHandle --
+ *
+ *	Called from Tcl_GetChannelFile to retrieve handles from inside
+ *	a file based channel.
+ *
+ * Results:
+ *	The appropriate handle or NULL if not present. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpGetHandle(
+    ClientData instanceData,		/* The file state. */
+    int direction,			/* Which handle to retrieve? */
+    ClientData *handlePtr)
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+
+    *handlePtr = (ClientData) statePtr->tcpStream;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpOutput--
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpOutput(
+    ClientData instanceData, 		/* Channel state. */
+    char *buf, 				/* The data buffer. */
+    int toWrite, 			/* How many bytes to write? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+    StreamPtr tcpStream;
+    OSErr err;
+    int amount;
+    TCPiopb statusPB;
+
+    *errorCodePtr = 0;
+    tcpStream = statePtr->tcpStream;
+
+    /*
+     * If an asynchronous connect is in progress, attempt to wait for it
+     * to complete before writing.
+     */
+    
+    if ((statePtr->flags & TCP_ASYNC_CONNECT)
+	    && ! WaitForSocketEvent(statePtr, TCL_WRITABLE, errorCodePtr)) {
+	return -1;
+    }
+
+    /*
+     * Loop until we have written some data, or an error occurs.
+     */
+
+    while (1) {
+	statusPB.ioCRefNum = driverRefNum;
+	statusPB.tcpStream = tcpStream;
+	statusPB.csCode = TCPStatus;
+	err = PBControlSync((ParmBlkPtr) &statusPB);
+	if ((err == connectionDoesntExist) || ((err == noErr) && 
+		(statusPB.csParam.status.connectionState == 14))) {
+	    /*
+	     * The remote connection is gone away.  Report an error
+	     * and don't write anything.
+	     */
+
+	    *errorCodePtr = errno = EPIPE;
+	    return -1;
+	} else if (err != noErr) {
+	    return -1;
+	}
+	amount = statusPB.csParam.status.sendWindow
+	    - statusPB.csParam.status.amtUnackedData;
+
+	/*
+	 * Attempt to write the data to the socket if a background
+	 * write isn't in progress and there is room in the output buffers.
+	 */
+
+	if (!(statePtr->flags & TCP_WRITING) && amount > 0) {
+	    if (toWrite < amount) {
+		amount = toWrite;
+	    }
+	    statePtr->dataSegment[0].length = amount;
+	    statePtr->dataSegment[0].ptr = buf;
+	    statePtr->dataSegment[1].length = 0;
+	    InitMacTCPParamBlock(&statePtr->pb, TCPSend);
+	    statePtr->pb.ioCompletion = completeUPP;
+	    statePtr->pb.tcpStream = tcpStream;
+	    statePtr->pb.csParam.send.wdsPtr = (Ptr) statePtr->dataSegment;
+	    statePtr->pb.csParam.send.pushFlag = 1;
+	    statePtr->pb.csParam.send.userDataPtr = (Ptr) statePtr;
+	    statePtr->flags |= TCP_WRITING;
+	    err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
+	    switch (err) {
+		case noErr:
+		    return amount;
+		case connectionClosing:
+		    *errorCodePtr = errno = ESHUTDOWN;
+		    statePtr->flags |= TCP_REMOTE_CLOSED;
+		    return -1;
+		case connectionDoesntExist:
+		case connectionTerminated:
+		    *errorCodePtr = errno = ENOTCONN;
+		    statePtr->flags |= TCP_REMOTE_CLOSED;
+		    return -1;
+		case invalidStreamPtr:
+		default:
+		    return -1;
+	    }
+
+	}
+
+	/*
+	 * The socket wasn't writable.  In the non-blocking case, return
+	 * immediately, otherwise wait  until the file becomes writable
+	 * or closed and try again.
+	 */
+
+	if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	    statePtr->checkMask &= ~TCL_WRITABLE;
+	    *errorCodePtr = EWOULDBLOCK;
+	    return -1;
+	} else if (!WaitForSocketEvent(statePtr, TCL_WRITABLE, errorCodePtr)) {
+	    return -1;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetOptionProc --
+ *
+ *	Computes an option value for a TCP socket based channel, or a
+ *	list of all options and their values.
+ *
+ *	Note: This code is based on code contributed by John Haxby.
+ *
+ * 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.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpGetOptionProc(
+    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 *) instanceData;
+    int doPeerName = false, doSockName = false, doAll = false;
+    ip_addr tcpAddress;
+    char buffer[128];
+    OSErr err;
+    Tcl_DString dString;
+    TCPiopb statusPB;
+    int errorCode;
+
+    /*
+     * If an asynchronous connect is in progress, attempt to wait for it
+     * to complete before accessing the socket state.
+     */
+    
+    if ((statePtr->flags & TCP_ASYNC_CONNECT)
+	    && ! WaitForSocketEvent(statePtr, TCL_WRITABLE, &errorCode)) {
+	if (interp) {
+	    /*
+	     * fix the error message.
+	     */
+
+	    Tcl_AppendResult(interp, "connect is in progress and can't wait",
+	    		NULL);
+	}
+	return TCL_ERROR;
+    }
+            
+    /*
+     * Determine which options we need to do.  Do all of them
+     * if optionName is NULL.
+     */
+
+    if (optionName == (char *) NULL || optionName[0] == '\0') {
+        doAll = true;
+    } else {
+	if (!strcmp(optionName, "-peername")) {
+	    doPeerName = true;
+	} else if (!strcmp(optionName, "-sockname")) {
+	    doSockName = true;
+	} else {
+	    return Tcl_BadChannelOption(interp, optionName, 
+	    		"peername sockname");
+	}
+    }
+
+    /*
+     * Get status on the stream.  Make sure to use a new pb struct because
+     * the struct in the statePtr may be part of an asyncronous call.
+     */
+
+    statusPB.ioCRefNum = driverRefNum;
+    statusPB.tcpStream = statePtr->tcpStream;
+    statusPB.csCode = TCPStatus;
+    err = PBControlSync((ParmBlkPtr) &statusPB);
+    if ((err == connectionDoesntExist) ||
+	((err == noErr) && (statusPB.csParam.status.connectionState == 14))) {
+	/*
+	 * The socket was probably closed on the other side of the connection.
+	 */
+
+	if (interp) {
+	    Tcl_AppendResult(interp, "can't access socket info: ",
+			     "connection reset by peer", NULL);
+	}
+	return TCL_ERROR;
+    } else if (err != noErr) {
+	if (interp) { 
+	    Tcl_AppendResult(interp, "unknown socket error", NULL);
+	}
+	Debugger();
+	return TCL_ERROR;
+    }
+
+
+    /*
+     * Get the sockname for the socket.
+     */
+
+    Tcl_DStringInit(&dString);
+    if (doAll || doSockName) {
+	if (doAll) {
+	    Tcl_DStringAppendElement(dsPtr, "-sockname");
+	    Tcl_DStringStartSublist(dsPtr);
+	}
+	tcpAddress = statusPB.csParam.status.localHost;
+	sprintf(buffer, "%d.%d.%d.%d", tcpAddress>>24,
+		tcpAddress>>16 & 0xff, tcpAddress>>8 & 0xff,
+		tcpAddress & 0xff);
+	Tcl_DStringAppendElement(dsPtr, buffer);
+	if (ResolveAddress(tcpAddress, &dString) == noErr) {
+	    Tcl_DStringAppendElement(dsPtr, dString.string);
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "<unknown>");
+	}
+	sprintf(buffer, "%d", statusPB.csParam.status.localPort);
+	Tcl_DStringAppendElement(dsPtr, buffer);
+	if (doAll) {
+	    Tcl_DStringEndSublist(dsPtr);
+	}
+    }
+
+    /*
+     * Get the peername for the socket.
+     */
+
+    if ((doAll || doPeerName) && (statePtr->flags & TCP_CONNECTED)) {
+	if (doAll) {
+	    Tcl_DStringAppendElement(dsPtr, "-peername");
+	    Tcl_DStringStartSublist(dsPtr);
+	}
+	tcpAddress = statusPB.csParam.status.remoteHost;
+	sprintf(buffer, "%d.%d.%d.%d", tcpAddress>>24,
+		tcpAddress>>16 & 0xff, tcpAddress>>8 & 0xff,
+		tcpAddress & 0xff);
+	Tcl_DStringAppendElement(dsPtr, buffer);
+	Tcl_DStringSetLength(&dString, 0);
+	if (ResolveAddress(tcpAddress, &dString) == noErr) {
+	    Tcl_DStringAppendElement(dsPtr, dString.string);
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "<unknown>");
+	}
+	sprintf(buffer, "%d", statusPB.csParam.status.remotePort);
+	Tcl_DStringAppendElement(dsPtr, buffer);
+	if (doAll) {
+	    Tcl_DStringEndSublist(dsPtr);
+	}
+    }
+
+    Tcl_DStringFree(&dString);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpWatch --
+ *
+ *	Initialize the notifier to watch this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the watchMask for the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TcpWatch(instanceData, mask)
+    ClientData instanceData;		/* The file state. */
+    int mask;				/* Events of interest; an OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+
+    statePtr->watchMask = mask;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewSocketInfo --
+ *
+ *	This function allocates and initializes a new SocketInfo
+ *	structure.
+ *
+ * Results:
+ *	Returns a newly allocated SocketInfo.
+ *
+ * Side effects:
+ *	Adds the socket to the global socket list, allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TcpState *
+NewSocketInfo(
+    StreamPtr tcpStream)
+{
+    TcpState *statePtr;
+
+    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+    statePtr->tcpStream = tcpStream;
+    statePtr->psn = applicationPSN;
+    statePtr->flags = 0;
+    statePtr->checkMask = 0;
+    statePtr->watchMask = 0;
+    statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
+    statePtr->acceptProcData = (ClientData) NULL;
+    statePtr->nextPtr = socketList;
+    socketList = statePtr;
+    return statePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeSocketInfo --
+ *
+ *	This function deallocates a SocketInfo structure that is no
+ *	longer needed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes the socket from the global socket list, frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeSocketInfo(
+    TcpState *statePtr)		/* The state pointer to free. */
+{
+    if (statePtr == socketList) {
+	socketList = statePtr->nextPtr;
+    } else {
+	TcpState *p;
+	for (p = socketList; p != NULL; p = p->nextPtr) {
+	    if (p->nextPtr == statePtr) {
+		p->nextPtr = statePtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    ckfree((char *) statePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeTcpClientChannel --
+ *
+ *	Creates a Tcl_Channel from an existing client TCP socket.
+ *
+ * Results:
+ *	The Tcl_Channel wrapped around the preexisting TCP socket.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeTcpClientChannel(
+    ClientData sock)	/* The socket to wrap up into a channel. */
+{
+    TcpState *statePtr;
+    char channelName[20];
+
+    if (TclHasSockets(NULL) != TCL_OK) {
+	return NULL;
+    }
+	
+    statePtr = NewSocketInfo((StreamPtr) sock);
+    /* TODO: do we need to set the port??? */
+    
+    sprintf(channelName, "sock%d", socketNumber++);
+    
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+    Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
+    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocket --
+ *
+ *	This function opens a new socket and initializes the
+ *	SocketInfo structure.
+ *
+ * Results:
+ *	Returns a new SocketInfo, or NULL with an error in interp.
+ *
+ * Side effects:
+ *	Adds a new socket to the socketList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TcpState *
+CreateSocket(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
+    int port,			/* Port number to open. */
+    char *host,			/* Name of host on which to open port. */
+    char *myaddr,		/* Optional client-side address */
+    int myport,			/* Optional client-side port */
+    int server,			/* 1 if socket should be a server socket,
+				 * else 0 for a client socket. */
+    int async)			/* 1 create async, 0 do sync. */
+{
+    ip_addr macAddr;
+    OSErr err;
+    TCPiopb pb;
+    StreamPtr tcpStream;
+    TcpState *statePtr;
+    char * buffer;
+    
+    /*
+     * Figure out the ip address from the host string.
+     */
+
+    if (host == NULL) {
+	err = GetLocalAddress(&macAddr);
+    } else {
+	err = GetHostFromString(host, &macAddr);
+    }
+    if (err != noErr) {
+	Tcl_SetErrno(EHOSTUNREACH);
+	if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_AppendResult(interp, "couldn't open socket: ",
+                        Tcl_PosixError(interp), (char *) NULL);
+	}
+	return (TcpState *) NULL;
+    }
+    
+    /*
+     * Create a MacTCP stream and create the state used for socket
+     * transactions from here on out.
+     */
+
+    ClearZombieSockets();
+    buffer = ckalloc(socketBufferSize);
+    InitMacTCPParamBlock(&pb, TCPCreate);
+    pb.csParam.create.rcvBuff = buffer;
+    pb.csParam.create.rcvBuffLen = socketBufferSize;
+    err = PBControlSync((ParmBlkPtr) &pb);
+    if (err != noErr) {
+        Tcl_SetErrno(0); /* TODO: set to ENOSR - maybe?*/
+        if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_AppendResult(interp, "couldn't open socket: ",
+		Tcl_PosixError(interp), (char *) NULL);
+        }
+	return (TcpState *) NULL;
+    }
+
+    tcpStream = pb.tcpStream;
+    statePtr = NewSocketInfo(tcpStream);
+    statePtr->port = port;
+    
+    if (server) {
+        /* 
+         * Set up server connection.
+         */
+
+	InitMacTCPParamBlock(&statePtr->pb, TCPPassiveOpen);
+	statePtr->pb.tcpStream = tcpStream;
+	statePtr->pb.csParam.open.localPort = statePtr->port;
+	statePtr->pb.ioCompletion = completeUPP; 
+	statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
+	statePtr->flags |= TCP_LISTENING;
+	err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
+
+	/*
+	 * If this is a server on port 0 then we need to wait until
+	 * the dynamic port allocation is made by the MacTcp driver.
+	 */
+
+	if (statePtr->port == 0) {
+	    EventRecord dummy;
+
+	    while (statePtr->pb.csParam.open.localPort == 0) {
+		WaitNextEvent(0, &dummy, 1, NULL);
+		if (statePtr->pb.ioResult != 0) {
+		    break;
+		}
+	    }
+	    statePtr->port = statePtr->pb.csParam.open.localPort;
+	}
+	Tcl_SetErrno(EINPROGRESS);
+    } else {
+	/*
+	 * Attempt to connect. The connect may fail at present with an
+	 * EINPROGRESS but at a later time it will complete. The caller
+	 * will set up a file handler on the socket if she is interested in
+	 * being informed when the connect completes.
+	 */
+
+	InitMacTCPParamBlock(&statePtr->pb, TCPActiveOpen);
+	statePtr->pb.tcpStream = tcpStream;
+	statePtr->pb.csParam.open.remoteHost = macAddr;
+	statePtr->pb.csParam.open.remotePort = port;
+	statePtr->pb.csParam.open.localHost = 0;
+	statePtr->pb.csParam.open.localPort = myport;
+	statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
+	statePtr->pb.ioCompletion = completeUPP;
+	if (async) {
+	    statePtr->flags |= TCP_ASYNC_CONNECT;
+	    err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
+	    Tcl_SetErrno(EINPROGRESS);
+	} else {
+	    err = PBControlSync((ParmBlkPtr) &(statePtr->pb));
+	}
+    }
+    
+    switch (err) {
+	case noErr:
+	    if (!async) {
+		statePtr->flags |= TCP_CONNECTED;
+	    }
+	    return statePtr;
+	case duplicateSocket:
+	    Tcl_SetErrno(EADDRINUSE);
+	    break;
+	case openFailed:
+	case connectionTerminated:
+	    Tcl_SetErrno(ECONNREFUSED);
+	    break;
+	case invalidStreamPtr:
+	case connectionExists:
+	default:
+	    /*
+	     * These cases should never occur.  However, we will fail
+	     * gracefully and hope Tcl can resume.  The alternative is to panic
+	     * which is probably a bit drastic.
+	     */
+
+	    Debugger();
+	    Tcl_SetErrno(err);
+    }
+
+    /*
+     * We had error during the connection.  Release the stream
+     * and file handle.  Also report to the interp.
+     */
+
+    pb.ioCRefNum = driverRefNum;
+    pb.csCode = TCPRelease;
+    pb.tcpStream = tcpStream;
+    pb.ioCompletion = NULL; 
+    err = PBControlSync((ParmBlkPtr) &pb);
+
+    if (interp != (Tcl_Interp *) NULL) {
+	Tcl_AppendResult(interp, "couldn't open socket: ",
+	    Tcl_PosixError(interp), (char *) NULL);
+    }
+
+    ckfree(buffer);
+    FreeSocketInfo(statePtr);
+    return (TcpState *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpClient --
+ *
+ *	Opens a TCP client socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed. On failure, the routine also
+ *	sets the output argument errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Opens a client socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpClient(
+    Tcl_Interp *interp, 		/* For error reporting; can be NULL. */
+    int port, 				/* Port number to open. */
+    char *host, 			/* Host on which to open port. */
+    char *myaddr, 			/* Client-side address */
+    int myport, 			/* Client-side port */
+    int async)				/* If nonzero, attempt to do an
+                                         * asynchronous connect. Otherwise
+                                         * we do a blocking connect. 
+                                         * - currently ignored */
+{
+    TcpState *statePtr;
+    char channelName[20];
+
+    if (TclHasSockets(interp) != TCL_OK) {
+	return NULL;
+    }
+	
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    statePtr = CreateSocket(interp, port, host, myaddr, myport, 0, async);
+    if (statePtr == NULL) {
+	return NULL;
+    }
+    
+    sprintf(channelName, "sock%d", socketNumber++);
+
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+    Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
+    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ *	Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed.
+ *
+ * Side effects:
+ *	Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(
+    Tcl_Interp *interp,			/* For error reporting - may be
+                                         * NULL. */
+    int port,				/* Port number to open. */
+    char *host,				/* Name of local host. */
+    Tcl_TcpAcceptProc *acceptProc,	/* Callback for accepting connections
+                                         * from new clients. */
+    ClientData acceptProcData)		/* Data for the callback. */
+{
+    TcpState *statePtr;
+    char channelName[20];
+
+    if (TclHasSockets(interp) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    statePtr = CreateSocket(interp, port, host, NULL, 0, 1, 1);
+    if (statePtr == NULL) {
+	return NULL;
+    }
+
+    statePtr->acceptProc = acceptProc;
+    statePtr->acceptProcData = acceptProcData;
+
+    sprintf(channelName, "sock%d", socketNumber++);
+
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, 0);
+    Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
+    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketEventProc --
+ *
+ *	This procedure is called by Tcl_ServiceEvent when a socket event
+ *	reaches the front of the event queue.  This procedure is
+ *	responsible for notifying the generic channel code.
+ *
+ * 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 channel callback procedures do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SocketEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    TcpState *statePtr;
+    SocketEvent *eventPtr = (SocketEvent *) evPtr;
+    int mask = 0;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Find the specified socket on the socket list.
+     */
+
+    for (statePtr = socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if ((statePtr == eventPtr->statePtr) && 
+		(statePtr->tcpStream == eventPtr->tcpStream)) {
+	    break;
+	}
+    }
+
+    /*
+     * Discard events that have gone stale.
+     */
+
+    if (!statePtr) {
+	return 1;
+    }
+    statePtr->flags &= ~(TCP_PENDING);
+    if (statePtr->flags & TCP_RELEASE) {
+	SocketFreeProc(statePtr);
+	return 1;
+    }
+
+
+    /*
+     * Handle connection requests directly.
+     */
+
+    if (statePtr->flags & TCP_LISTEN_CONNECT) {
+	if (statePtr->checkMask & TCL_READABLE) {
+	    TcpAccept(statePtr);
+	}
+	return 1;
+    }
+
+    /*
+     * Mask off unwanted events then notify the channel.
+     */
+
+    mask = statePtr->checkMask & statePtr->watchMask;
+    if (mask) {
+	Tcl_NotifyChannel(statePtr->channel, mask);
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForSocketEvent --
+ *
+ *	Waits until one of the specified events occurs on a socket.
+ *
+ * Results:
+ *	Returns 1 on success or 0 on failure, with an error code in
+ *	errorCodePtr.
+ *
+ * Side effects:
+ *	Processes socket events off the system queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForSocketEvent(
+    TcpState *statePtr,		/* Information about this socket. */
+    int mask,			/* Events to look for. */
+    int *errorCodePtr)		/* Where to store errors? */
+{
+    OSErr err;
+    TCPiopb statusPB;
+    EventRecord dummy;
+
+    /*
+     * Loop until we get the specified condition, unless the socket is
+     * asynchronous.
+     */
+    
+    do {
+	statusPB.ioCRefNum = driverRefNum;
+	statusPB.tcpStream = statePtr->tcpStream;
+	statusPB.csCode = TCPStatus;
+	err = PBControlSync((ParmBlkPtr) &statusPB);
+	if (err != noErr) {
+	    statePtr->checkMask |= (TCL_READABLE | TCL_WRITABLE);
+	    return 1;
+	}
+	statePtr->checkMask = 0;
+	if (statusPB.csParam.status.amtUnreadData > 0) {
+	    statePtr->checkMask |= TCL_READABLE;
+	}
+	if (!(statePtr->flags & TCP_WRITING)
+		&& (statusPB.csParam.status.sendWindow - 
+			statusPB.csParam.status.amtUnackedData) > 0) {
+	    statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+	    statePtr->checkMask |= TCL_WRITABLE;
+	}
+	if (mask & statePtr->checkMask) {
+	    return 1;
+	}
+
+	/*
+	 * Call the system to let other applications run while we
+	 * are waiting for this event to occur.
+	 */
+	
+	WaitNextEvent(0, &dummy, 1, NULL);
+    } while (!(statePtr->flags & TCP_ASYNC_SOCKET));
+    *errorCodePtr = EWOULDBLOCK;
+    return 0;
+} 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpAccept --
+ *	Accept a TCP socket connection.  This is called by the event 
+ *	loop, and it in turns calls any registered callbacks for this
+ *	channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Evals the Tcl script associated with the server socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TcpAccept(
+    TcpState *statePtr)
+{
+    TcpState *newStatePtr;
+    StreamPtr tcpStream;
+    char remoteHostname[255];
+    OSErr err;
+    ip_addr remoteAddress;
+    long remotePort;
+    char channelName[20];
+    
+    statePtr->flags &= ~TCP_LISTEN_CONNECT;
+    statePtr->checkMask &= ~TCL_READABLE;
+
+    /*
+     * Transfer sever stream to new connection.
+     */
+
+    tcpStream = statePtr->tcpStream;
+    newStatePtr = NewSocketInfo(tcpStream);
+    newStatePtr->tcpStream = tcpStream;
+    sprintf(channelName, "sock%d", socketNumber++);
+
+
+    newStatePtr->flags |= TCP_CONNECTED;
+    newStatePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) newStatePtr, (TCL_READABLE | TCL_WRITABLE));
+    Tcl_SetChannelBufferSize(newStatePtr->channel, socketBufferSize);
+    Tcl_SetChannelOption(NULL, newStatePtr->channel, "-translation",
+	    "auto crlf");
+
+    remoteAddress = statePtr->pb.csParam.open.remoteHost;
+    remotePort = statePtr->pb.csParam.open.remotePort;
+
+    /*
+     * Reopen passive connect.  Make new tcpStream the server.
+     */
+
+    ClearZombieSockets();
+    InitMacTCPParamBlock(&statePtr->pb, TCPCreate);
+    statePtr->pb.csParam.create.rcvBuff = ckalloc(socketBufferSize);
+    statePtr->pb.csParam.create.rcvBuffLen = socketBufferSize;
+    err = PBControlSync((ParmBlkPtr) &statePtr->pb);
+    if (err != noErr) {
+	/* 
+	 * Hmmm...  We can't reopen the server.  We'll go ahead
+	 * an continue - but we are kind of broken now...
+	 */
+	 Debugger();
+	 statePtr->tcpStream = -1;
+	 statePtr->flags |= TCP_SERVER_ZOMBIE;
+    }
+
+    tcpStream = statePtr->tcpStream = statePtr->pb.tcpStream;
+    
+    InitMacTCPParamBlock(&statePtr->pb, TCPPassiveOpen);
+    statePtr->pb.tcpStream = tcpStream;
+    statePtr->pb.csParam.open.localHost = 0;
+    statePtr->pb.csParam.open.localPort = statePtr->port;
+    statePtr->pb.ioCompletion = completeUPP; 
+    statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
+    statePtr->flags |= TCP_LISTENING;
+    err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
+    /*
+     * TODO: deal with case where we can't recreate server socket...
+     */
+
+    /*
+     * Finally we run the accept procedure.  We must do this last to make
+     * sure we are in a nice clean state.  This Tcl code can do anything
+     * including closing the server or client sockets we've just delt with.
+     */
+
+    if (statePtr->acceptProc != NULL) {
+	sprintf(remoteHostname, "%d.%d.%d.%d", remoteAddress>>24,
+		remoteAddress>>16 & 0xff, remoteAddress>>8 & 0xff,
+		remoteAddress & 0xff);
+		
+	(statePtr->acceptProc)(statePtr->acceptProcData, newStatePtr->channel, 
+	    remoteHostname, remotePort);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetHostName --
+ *
+ *	Returns the name of the local host.
+ *
+ * Results:
+ *	A string containing the network name for this machine, or
+ *	an empty string if we can't figure out the name.  The caller 
+ *	must not modify or free this string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetHostName()
+{
+    static int  hostnameInited = 0;
+    static char hostname[255];
+    ip_addr ourAddress;
+    Tcl_DString dString;
+    OSErr err;
+    
+    if (hostnameInited) {
+        return hostname;
+    }
+    
+    if (TclHasSockets(NULL) == TCL_OK) {
+	err = GetLocalAddress(&ourAddress);
+	if (err == noErr) {
+	    /*
+	     * Search for the doman name and return it if found.  Otherwise, 
+	     * just print the IP number to a string and return that.
+	     */
+
+	    Tcl_DStringInit(&dString);
+	    err = ResolveAddress(ourAddress, &dString);
+	    if (err == noErr) {
+		strcpy(hostname, dString.string);
+	    } else {
+		sprintf(hostname, "%d.%d.%d.%d", ourAddress>>24, ourAddress>>16 & 0xff,
+		    ourAddress>>8 & 0xff, ourAddress & 0xff);
+	    }
+	    Tcl_DStringFree(&dString);
+	    
+	    hostnameInited = 1;
+	    return hostname;
+	}
+    }
+
+    hostname[0] = '\0';
+    hostnameInited = 1;
+    return hostname;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResolveAddress --
+ *
+ *	This function is used to resolve an ip address to it's full 
+ *	domain name address.
+ *
+ * Results:
+ *	An os err value.
+ *
+ * Side effects:
+ *	Treats client data as int we set to true.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSErr 
+ResolveAddress(
+    ip_addr tcpAddress, 	/* Address to resolve. */
+    Tcl_DString *dsPtr)		/* Returned address in string. */
+{
+    int i;
+    EventRecord dummy;
+    DNRState dnrState;
+    OSErr err;
+
+    /*
+     * Call AddrToName to resolve our ip address to our domain name.
+     * The call is async, so we must wait for a callback to tell us
+     * when to continue.
+     */
+
+     for (i = 0; i < NUM_ALT_ADDRS; i++) {
+	dnrState.hostInfo.addr[i] = 0;
+     }
+    dnrState.done = 0;
+    GetCurrentProcess(&(dnrState.psn));
+    err = AddrToName(tcpAddress, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+    if (err == cacheFault) {
+	while (!dnrState.done) {
+	    WaitNextEvent(0, &dummy, 1, NULL);
+	}
+    }
+    
+    /*
+     * If there is no error in finding the domain name we set the
+     * result into the dynamic string.  We also work around a bug in
+     * MacTcp where an extranious '.' may be found at the end of the name.
+     */
+
+    if (dnrState.hostInfo.rtnCode == noErr) {
+	i = strlen(dnrState.hostInfo.cname) - 1;
+	if (dnrState.hostInfo.cname[i] == '.') {
+	    dnrState.hostInfo.cname[i] = '\0';
+	}
+	Tcl_DStringAppend(dsPtr, dnrState.hostInfo.cname, -1);
+    }
+    
+    return dnrState.hostInfo.rtnCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DNRCompletionRoutine --
+ *
+ *	This function is called when the Domain Name Server is done
+ *	seviceing our request.  It just sets a flag that we can poll
+ *	in functions like Tcl_GetHostName to let them know to continue.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Treats client data as int we set to true.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal void 
+DNRCompletionRoutine(
+    struct hostInfo *hostinfoPtr, 	/* Host infor struct. */
+    DNRState *dnrStatePtr)		/* Completetion state. */
+{
+    dnrStatePtr->done = true;
+    WakeUpProcess(&(dnrStatePtr->psn));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanUpExitProc --
+ *
+ *	This procedure is invoked as an exit handler when ExitToShell
+ *	is called.  It aborts any lingering socket connections.  This 
+ *	must be called or the Mac OS will more than likely crash.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal void
+CleanUpExitProc()
+{
+    TCPiopb exitPB;
+    TcpState *statePtr;
+
+    while (socketList != NULL) {
+	statePtr = socketList;
+	socketList = statePtr->nextPtr;
+
+	/*
+	 * Close and Release the connection.
+	 */
+
+	exitPB.ioCRefNum = driverRefNum;
+	exitPB.csCode = TCPClose;
+	exitPB.tcpStream = statePtr->tcpStream;
+	exitPB.csParam.close.ulpTimeoutValue = 60 /* seconds */;
+	exitPB.csParam.close.ulpTimeoutAction = 1 /* 1:abort 0:report */;
+	exitPB.csParam.close.validityFlags = timeoutValue | timeoutAction;
+	exitPB.ioCompletion = NULL; 
+	PBControlSync((ParmBlkPtr) &exitPB);
+
+	exitPB.ioCRefNum = driverRefNum;
+	exitPB.csCode = TCPRelease;
+	exitPB.tcpStream = statePtr->tcpStream;
+	exitPB.ioCompletion = NULL; 
+	PBControlSync((ParmBlkPtr) &exitPB);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetHostFromString --
+ *
+ *	Looks up the passed in domain name in the domain resolver.  It
+ *	can accept strings of two types: 1) the ip number in string
+ *	format, or 2) the domain name.
+ *
+ * Results:
+ *	We return a ip address or 0 if there was an error or the 
+ *	domain does not exist.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSErr
+GetHostFromString(
+    char *name, 		/* Host in string form. */
+    ip_addr *address)		/* Returned IP address. */
+{
+    OSErr err;
+    int i;
+    EventRecord dummy;
+    DNRState dnrState;
+	
+    if (TclHasSockets(NULL) != TCL_OK) {
+	return 0;
+    }
+
+    /*
+     * Call StrToAddr to get the ip number for the passed in domain
+     * name.  The call is async, so we must wait for a callback to 
+     * tell us when to continue.
+     */
+
+    for (i = 0; i < NUM_ALT_ADDRS; i++) {
+	dnrState.hostInfo.addr[i] = 0;
+    }
+    dnrState.done = 0;
+    GetCurrentProcess(&(dnrState.psn));
+    err = StrToAddr(name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+    if (err == cacheFault) {
+	while (!dnrState.done) {
+	    WaitNextEvent(0, &dummy, 1, NULL);
+	}
+    }
+    
+    /*
+     * For some reason MacTcp may return a cachFault a second time via
+     * the hostinfo block.  This seems to be a bug in MacTcp.  In this case 
+     * we run StrToAddr again - which seems to then work just fine.
+     */
+
+    if (dnrState.hostInfo.rtnCode == cacheFault) {
+	dnrState.done = 0;
+	err = StrToAddr(name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+	if (err == cacheFault) {
+	    while (!dnrState.done) {
+		WaitNextEvent(0, &dummy, 1, NULL);
+	    }
+	}
+    }
+
+    if (dnrState.hostInfo.rtnCode == noErr) {
+	*address = dnrState.hostInfo.addr[0];
+    }
+    
+    return dnrState.hostInfo.rtnCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IOCompletionRoutine --
+ *
+ *	This function is called when an asynchronous socket operation
+ *	completes.  Since this routine runs as an interrupt handler, 
+ *	it will simply set state to tell the notifier that this socket
+ *	is now ready for action.  Note that this function is running at
+ *	interupt time and can't allocate memory or do much else except 
+ *      set state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets some state in the socket state.  May also wake the process
+ *	if we are not currently running.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IOCompletionRoutine(
+    TCPiopb *pbPtr)		/* Tcp parameter block. */
+{
+    TcpState *statePtr;
+    
+    if (pbPtr->csCode == TCPSend) {
+    	statePtr = (TcpState *) pbPtr->csParam.send.userDataPtr;
+    } else {
+	statePtr = (TcpState *) pbPtr->csParam.open.userDataPtr;
+    }
+    
+    /*
+     * Always wake the process in case it's in WaitNextEvent.
+     * If an error has a occured - just return.  We will deal
+     * with the problem later.
+     */
+
+    WakeUpProcess(&statePtr->psn);
+    if (pbPtr->ioResult != noErr) {
+	return;
+    }
+    
+    if (statePtr->flags & TCP_ASYNC_CONNECT) {
+	statePtr->flags &= ~TCP_ASYNC_CONNECT;
+	statePtr->flags |= TCP_CONNECTED;
+	statePtr->checkMask |= TCL_READABLE & TCL_WRITABLE;
+    } else if (statePtr->flags & TCP_LISTENING) {
+	if (statePtr->port == 0) {
+	    Debugger();
+	}
+	statePtr->flags &= ~TCP_LISTENING;
+	statePtr->flags |= TCP_LISTEN_CONNECT;
+	statePtr->checkMask |= TCL_READABLE;
+    } else if (statePtr->flags & TCP_WRITING) {
+	statePtr->flags &= ~TCP_WRITING;
+	statePtr->checkMask |= TCL_WRITABLE;
+	if (!(statePtr->flags & TCP_CONNECTED)) {
+	    InitMacTCPParamBlock(&statePtr->pb, TCPClose);
+    	    statePtr->pb.tcpStream = statePtr->tcpStream;
+    	    statePtr->pb.ioCompletion = closeUPP; 
+    	    statePtr->pb.csParam.close.userDataPtr = (Ptr) statePtr;
+    	    if (PBControlAsync((ParmBlkPtr) &statePtr->pb) != noErr) {
+	        statePtr->flags |= TCP_RELEASE;
+    	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetLocalAddress --
+ *
+ *	Get the IP address for this machine.  The result is cached so
+ *	the result is returned quickly after the first call.
+ *
+ * Results:
+ *	Macintosh error code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSErr 
+GetLocalAddress(
+    unsigned long *addr)	/* Returns host IP address. */
+{
+    struct GetAddrParamBlock pBlock;
+    OSErr err = noErr;
+    static unsigned long localAddress = 0;
+
+    if (localAddress == 0) {
+	memset(&pBlock, 0, sizeof(pBlock));
+	pBlock.ioResult = 1;
+	pBlock.csCode = ipctlGetAddr;
+	pBlock.ioCRefNum = driverRefNum;
+	err = PBControlSync((ParmBlkPtr) &pBlock);
+
+	if (err != noErr) {
+	    return err;
+	}
+	localAddress = pBlock.ourAddress;
+    }
+    
+    *addr = localAddress;
+    return noErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBufferSize --
+ *
+ *	Get the appropiate buffer size for our machine & network.  This
+ *	value will be used by the rest of Tcl & the MacTcp driver for
+ *	the size of its buffers.  If out method for determining the
+ *	optimal buffer size fails for any reason - we return a 
+ *	reasonable default.
+ *
+ * Results:
+ *	Size of optimal buffer in bytes.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static long 
+GetBufferSize()
+{
+    UDPiopb iopb;
+    OSErr err = noErr;
+    long bufferSize;
+	
+    memset(&iopb, 0, sizeof(iopb));
+    err = GetLocalAddress(&iopb.csParam.mtu.remoteHost);
+    if (err != noErr) {
+	return CHANNEL_BUF_SIZE;
+    }
+    iopb.ioCRefNum = driverRefNum;
+    iopb.csCode = UDPMaxMTUSize;
+    err = PBControlSync((ParmBlkPtr)&iopb);
+    if (err != noErr) {
+	return CHANNEL_BUF_SIZE;
+    }
+    bufferSize = (iopb.csParam.mtu.mtuSize * 4) + 1024;
+    if (bufferSize < CHANNEL_BUF_SIZE) {
+	bufferSize = CHANNEL_BUF_SIZE;
+    }
+    return bufferSize;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSockGetPort --
+ *
+ *	Maps from a string, which could be a service name, to a port.
+ *	Used by socket creation code to get port numbers and resolve
+ *	registered service names to port numbers.
+ *
+ * Results:
+ *	A standard Tcl result.  On success, the port number is
+ *	returned in portPtr. On failure, an error message is left in
+ *	interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclSockGetPort(
+    Tcl_Interp *interp, 	/* Interp for error messages. */
+    char *string, 		/* Integer or service name */
+    char *proto, 		/* "tcp" or "udp", typically - 
+    				 * ignored on Mac - assumed to be tcp */
+    int *portPtr)		/* Return port number */
+{
+    PortInfo *portInfoPtr = NULL;
+    
+    if (Tcl_GetInt(interp, string, portPtr) == TCL_OK) {
+	if (*portPtr > 0xFFFF) {
+	    Tcl_AppendResult(interp, "couldn't open socket: port number too high",
+                (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (*portPtr < 0) {
+	    Tcl_AppendResult(interp, "couldn't open socket: negative port number",
+                (char *) NULL);
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    for (portInfoPtr = portServices; portInfoPtr->name != NULL; portInfoPtr++) {
+	if (!strcmp(portInfoPtr->name, string)) {
+	    break;
+	}
+    }
+    if (portInfoPtr != NULL && portInfoPtr->name != NULL) {
+	*portPtr = portInfoPtr->port;
+	Tcl_ResetResult(interp);
+	return TCL_OK;
+    }
+    
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClearZombieSockets --
+ *
+ *	This procedure looks through the socket list and removes the
+ *	first stream it finds that is ready for release. This procedure 
+ *	should be called before we ever try to create new Tcp streams
+ *	to ensure we can least allocate one stream.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Tcp streams may be released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClearZombieSockets()
+{
+    TcpState *statePtr;
+
+    for (statePtr = socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if (statePtr->flags & TCP_RELEASE) {
+	    SocketFreeProc(statePtr);
+	    return;
+	}
+    }
+}
diff --git a/tcl/mac/tclMacTest.c b/tcl/mac/tclMacTest.c
new file mode 100644
index 00000000000..06a66ba62c0
--- /dev/null
+++ b/tcl/mac/tclMacTest.c
@@ -0,0 +1,242 @@
+/* 
+ * tclMacTest.c --
+ *
+ *	Contains commands for platform specific tests for
+ *	the Macintosh platform.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define TCL_TEST
+
+#include "tclInt.h"
+#include "tclMacInt.h"
+#include "tclMacPort.h"
+#include "Files.h"
+#include <Errors.h>
+#include <Resources.h>
+#include <Script.h>
+#include <Strings.h>
+#include <FSpCompat.h>
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+int			TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+static int		DebuggerCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		WriteTextResource _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+			    
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclplatformtestInit --
+ *
+ *	Defines commands that test platform specific functionality for
+ *	Unix platforms.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclplatformtestInit(
+    Tcl_Interp *interp)		/* Interpreter to add commands to. */
+{
+    /*
+     * Add commands for platform specific tests on MacOS here.
+     */
+    
+    Tcl_CreateCommand(interp, "debugger", DebuggerCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testWriteTextResource", WriteTextResource,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DebuggerCmd --
+ *
+ *	This procedure simply calls the low level debugger.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DebuggerCmd(
+    ClientData clientData,		/* Not used. */
+    Tcl_Interp *interp,			/* Not used. */
+    int argc,				/* Not used. */
+    char **argv)			/* Not used. */
+{
+    Debugger();
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteTextResource --
+ *
+ *	This procedure will write a text resource out to the 
+ *	application or a given file.  The format for this command is
+ *	textwriteresource 
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WriteTextResource(
+    ClientData clientData,		/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int argc,				/* Number of arguments. */
+    char **argv)			/* Argument strings. */
+{
+    char *errNum = "wrong # args: ";
+    char *errBad = "bad argument: ";
+    char *errStr;
+    char *fileName = NULL, *rsrcName = NULL;
+    char *data = NULL;
+    int rsrcID = -1, i, protectIt = 0;
+    short fileRef = -1;
+    OSErr err;
+    Handle dataHandle;
+    Str255 resourceName;
+    FSSpec fileSpec;
+
+    /*
+     * Process the arguments.
+     */
+    for (i = 1 ; i < argc ; i++) {
+	if (!strcmp(argv[i], "-rsrc")) {
+	    rsrcName = argv[i + 1];
+	    i++;
+	} else if (!strcmp(argv[i], "-rsrcid")) {
+	    rsrcID = atoi(argv[i + 1]);
+	    i++;
+	} else if (!strcmp(argv[i], "-file")) {
+	    fileName = argv[i + 1];
+	    i++;
+	} else if (!strcmp(argv[i], "-protected")) {
+	    protectIt = 1;
+	} else {
+	    data = argv[i];
+	}
+    }
+	
+    if ((rsrcName == NULL && rsrcID < 0) ||
+	    (fileName == NULL) || (data == NULL)) {
+    	errStr = errBad;
+    	goto sourceFmtErr;
+    }
+
+    /*
+     * Open the resource file.
+     */
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    if (!(err == noErr || err == fnfErr)) {
+	Tcl_AppendResult(interp, "couldn't validate file name", (char *) NULL);
+	return TCL_ERROR;
+    }
+    
+    if (err == fnfErr) {
+	FSpCreateResFile(&fileSpec, 'WIsH', 'rsrc', smSystemScript);
+    }
+    fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm);
+    if (fileRef == -1) {
+	Tcl_AppendResult(interp, "couldn't open resource file", (char *) NULL);
+	return TCL_ERROR;
+    }
+		
+    UseResFile(fileRef);
+
+    /*
+     * Prepare data needed to create resource.
+     */
+    if (rsrcID < 0) {
+	rsrcID = UniqueID('TEXT');
+    }
+    
+    strcpy((char *) resourceName, rsrcName);
+    c2pstr((char *) resourceName);
+    
+    dataHandle = NewHandle(strlen(data));
+    HLock(dataHandle);
+    strcpy(*dataHandle, data);
+    HUnlock(dataHandle);
+     
+    /*
+     * Add the resource to the file and close it.
+     */
+    AddResource(dataHandle, 'TEXT', rsrcID, resourceName);
+    
+    UpdateResFile(fileRef);
+    if (protectIt) {
+        SetResAttrs(Get1Resource('TEXT', rsrcID), resProtected);
+    }
+    
+    CloseResFile(fileRef);
+    return TCL_OK;
+    
+    sourceFmtErr:
+    Tcl_AppendResult(interp, errStr, "error in \"", argv[0], "\"",
+	    (char *) NULL);
+    return TCL_ERROR;
+}
+
+int
+TclMacChmod(
+    char *path, 
+    int mode)
+{
+    HParamBlockRec hpb;
+    OSErr err;
+    
+    c2pstr(path);
+    hpb.fileParam.ioNamePtr = (unsigned char *) path;
+    hpb.fileParam.ioVRefNum = 0;
+    hpb.fileParam.ioDirID = 0;
+    
+    if (mode & 0200) {
+        err = PBHRstFLockSync(&hpb);
+    } else {
+        err = PBHSetFLockSync(&hpb);
+    }
+    p2cstr((unsigned char *) path);
+    
+    if (err != noErr) {
+        errno = TclMacOSErrorToPosixError(err);
+        return -1;
+    }
+    
+    return 0;
+}
+
diff --git a/tcl/mac/tclMacTime.c b/tcl/mac/tclMacTime.c
new file mode 100644
index 00000000000..f27a0425568
--- /dev/null
+++ b/tcl/mac/tclMacTime.c
@@ -0,0 +1,312 @@
+/* 
+ * tclMacTime.c --
+ *
+ *	Contains Macintosh specific versions of Tcl functions that
+ *	obtain time values from the operating system.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <OSUtils.h>
+#include <Timer.h>
+#include <time.h>
+
+/*
+ * Static variables used by the TclpGetTime function.
+ */
+ 
+static int initalized = false;
+static unsigned long baseSeconds;
+static UnsignedWide microOffset;
+
+/*
+ * Prototypes for procedures that are private to this file:
+ */
+
+static void SubtractUnsignedWide _ANSI_ARGS_((UnsignedWide *x,
+	UnsignedWide *y, UnsignedWide *result));
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpGetSeconds --
+ *
+ *	This procedure returns the number of seconds from the epoch.  On
+ *	the Macintosh the epoch is Midnight Jan 1, 1904.  Unfortunatly,
+ *	the Macintosh doesn't tie the epoch to a particular time zone.  For
+ *	Tcl we tie the epoch to GMT.  This makes the time zone date parsing
+ *	code work.  The epoch for Mac-Tcl is: Midnight Jan 1, 1904 GMT.
+ *
+ * Results:
+ *	Number of seconds from the epoch in GMT.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetSeconds()
+{
+    unsigned long seconds;
+    MachineLocation loc;
+    long int offset;
+    
+    ReadLocation(&loc);
+    offset = loc.u.gmtDelta & 0x00ffffff;
+    if (offset & 0x00800000) {
+	offset = offset | 0xff000000;
+    }
+
+    if (ReadDateTime(&seconds) == noErr) {
+	return (seconds - offset);
+    } else {
+	panic("Can't get time.");
+	return 0;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpGetClicks --
+ *
+ *	This procedure returns a value that represents the highest resolution
+ *	clock available on the system.  There are no garantees on what the
+ *	resolution will be.  In Tcl we will call this value a "click".  The
+ *	start time is also system dependant.
+ *
+ * Results:
+ *	Number of clicks from some start time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetClicks()
+{
+    UnsignedWide micros;
+
+    Microseconds(&micros);
+    return micros.lo;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTimeZone --
+ *
+ *	Get the current time zone.
+ *
+ * Results:
+ *	The return value is the local time zone, measured in
+ *	minutes away from GMT (-ve for east, +ve for west).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetTimeZone (
+    unsigned long  currentTime)		/* Ignored on Mac. */
+{
+    MachineLocation loc;
+    long int offset;
+
+    ReadLocation(&loc);
+    offset = loc.u.gmtDelta & 0x00ffffff;
+    if (offset & 0x00700000) {
+	offset |= 0xff000000;
+    }
+
+    /*
+     * Convert the Mac offset from seconds to minutes and
+     * add an hour if we have daylight savings time.
+     */
+    offset = -offset;
+    offset /= 60;
+    if (loc.u.dlsDelta < 0) {
+	offset += 60;
+    }
+    
+    return offset;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTime --
+ *
+ *	Gets the current system time in seconds and microseconds
+ *	since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ *	Returns the current time (in the local timezone) in timePtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpGetTime(
+    Tcl_Time *timePtr)		/* Location to store time information. */
+{
+    UnsignedWide micro;
+#ifndef NO_LONG_LONG
+    long long *microPtr;
+#endif
+	
+    if (initalized == false) {
+        MachineLocation loc;
+        long int offset;
+    
+        ReadLocation(&loc);
+        offset = loc.u.gmtDelta & 0x00ffffff;
+        if (offset & 0x00800000) {
+            offset = offset | 0xff000000;
+	}
+	if (ReadDateTime(&baseSeconds) != noErr) {
+	    /*
+	     * This should never happen!
+	     */
+	    return;
+	}
+	/*
+	 * Remove the local offset that ReadDateTime() adds.
+	 */
+	baseSeconds -= offset;
+	Microseconds(&microOffset);
+	initalized = true;
+    }
+
+    Microseconds(&micro);
+
+#ifndef NO_LONG_LONG
+    microPtr = (long long *) &micro;
+    *microPtr -= *((long long *) &microOffset);
+    timePtr->sec = baseSeconds + (*microPtr / 1000000);
+    timePtr->usec = *microPtr % 1000000;
+#else
+    SubtractUnsignedWide(&micro, &microOffset, &micro);
+
+    /*
+     * This lovely computation is equal to: base + (micro / 1000000)
+     * For the .hi part the ratio of 0x100000000 / 1000000 has been
+     * reduced to avoid overflow.  This computation certainly has 
+     * problems as the .hi part gets large.  However, your application
+     * would have to run for a long time to make that happen.
+     */
+
+    timePtr->sec = baseSeconds + (micro.lo / 1000000) + 
+    	(long) (micro.hi * ((double) 33554432.0 / 15625.0));
+    timePtr->usec = micro.lo % 1000000;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetDate --
+ *
+ *	Converts raw seconds to a struct tm data structure.  The
+ *	returned time will be for Greenwich Mean Time if the useGMT flag 
+ *	is set.  Otherwise, the returned time will be for the local
+ *	time zone.  This function is meant to be used as a replacement
+ *	for localtime and gmtime which is broken on most ANSI libs
+ *	on the Macintosh.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *  	The passed in struct tm data structure is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+struct tm *
+TclpGetDate(
+    const time_t *tp,	/* Time struct to fill. */
+    int useGMT)		/* True if date should reflect GNT time. */
+{
+    DateTimeRec dtr;
+    MachineLocation loc;
+    long int offset;
+    static struct tm statictime;
+    static const short monthday[12] =
+        {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
+
+    ReadLocation(&loc);
+	
+    if (useGMT) {
+	SecondsToDate(*tp, &dtr);
+    } else {
+	offset = loc.u.gmtDelta & 0x00ffffff;
+	if (offset & 0x00700000) {
+	    offset |= 0xff000000;
+	}
+	
+	SecondsToDate(*tp + offset, &dtr);
+    }
+
+    statictime.tm_sec = dtr.second;
+    statictime.tm_min = dtr.minute;
+    statictime.tm_hour = dtr.hour;
+    statictime.tm_mday = dtr.day;
+    statictime.tm_mon = dtr.month - 1;
+    statictime.tm_year = dtr.year - 1900;
+    statictime.tm_wday = dtr.dayOfWeek - 1;
+    statictime.tm_yday = monthday[statictime.tm_mon]
+	+ statictime.tm_mday - 1;
+    if (1 < statictime.tm_mon && !(statictime.tm_year & 3)) {
+	++statictime.tm_yday;
+    }
+    statictime.tm_isdst = loc.u.dlsDelta;
+    return(&statictime);
+}
+
+#ifdef NO_LONG_LONG
+/*
+ *----------------------------------------------------------------------
+ *
+ * SubtractUnsignedWide --
+ *
+ *	Subtracts one UnsignedWide value from another.
+ *
+ * Results:
+ *  	The subtracted value.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SubtractUnsignedWide(
+    UnsignedWide *x,		/* Ptr to wide int. */
+    UnsignedWide *y,		/* Ptr to wide int. */
+    UnsignedWide *result)	/* Ptr to result. */
+{
+    result->hi = x->hi - y->hi;
+    if (x->lo < y->lo) {
+	result->hi--;
+    }
+    result->lo = x->lo - y->lo;
+}
+#endif
diff --git a/tcl/mac/tclMacUnix.c b/tcl/mac/tclMacUnix.c
new file mode 100644
index 00000000000..9f5f42aa94c
--- /dev/null
+++ b/tcl/mac/tclMacUnix.c
@@ -0,0 +1,464 @@
+/* 
+ * tclMacUnix.c --
+ *
+ *	This file contains routines to implement several features
+ *	available to the Unix implementation, but that require
+ *      extra work to do on a Macintosh.  These include routines
+ *      Unix Tcl normally hands off to the Unix OS.
+ *
+ * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Files.h>
+#include <Strings.h>
+#include <TextUtils.h>
+#include <Finder.h>
+#include <FSpCompat.h>
+#include <Aliases.h>
+#include <Errors.h>
+
+#include "tclInt.h"
+#include "tclMacInt.h"
+
+/*
+ * The following two Includes are from the More Files package
+ */
+#include "FileCopy.h"
+#include "MoreFiles.h"
+#include "MoreFilesExtras.h"
+
+/*
+ * The following may not be defined in some versions of
+ * MPW header files.
+ */
+#ifndef kIsInvisible
+#define kIsInvisible 0x4000
+#endif
+#ifndef kIsAlias
+#define kIsAlias 0x8000
+#endif
+
+/*
+ * Missing error codes
+ */
+#define usageErr		500
+#define noSourceErr		501
+#define isDirErr		502
+
+/*
+ * Static functions in this file.
+ */
+
+static int	GlobArgs _ANSI_ARGS_((Tcl_Interp *interp,
+		    int *argc, char ***argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GlobArgs --
+ *
+ *	The following function was taken from Peter Keleher's Alpha
+ *	Editor.  *argc should only count the end arguments that should
+ *	be globed.  argv should be incremented to point to the first
+ *	arg to be globed.
+ *
+ * Results:
+ *	Returns 'true' if it worked & memory was allocated, else 'false'.
+ *
+ * Side effects:
+ *	argv will be alloced, the call will need to release the memory
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static int
+GlobArgs(
+    Tcl_Interp *interp,		/* Tcl interpreter. */
+    int *argc,			/* Number of arguments. */
+    char ***argv)		/* Argument strings. */
+{
+    int res, len;
+    char *list;
+	
+    /*
+     * Places the globbed args all into 'interp->result' as a list.
+     */
+    res = Tcl_GlobCmd(NULL, interp, *argc + 1, *argv - 1);
+    if (res != TCL_OK) {
+	return false;
+    }
+    len = strlen(interp->result);
+    list = (char *) ckalloc(len + 1);
+    strcpy(list, interp->result);
+    Tcl_ResetResult(interp);
+	
+    res = Tcl_SplitList(interp, list, argc, argv);
+    ckfree((char *) list);
+    if (res != TCL_OK) {
+	return false;
+    }
+    return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EchoCmd --
+ *
+ *    Implements the TCL echo command:
+ *        echo ?str ...?
+ *
+ * Results:
+ *      Always returns TCL_OK.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EchoCmd(
+    ClientData dummy,			/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int argc,				/* Number of arguments. */
+    char **argv)			/* Argument strings. */
+{
+    Tcl_Channel chan;
+    int mode, result, i;
+
+    chan = Tcl_GetChannel(interp, "stdout", &mode);
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+    for (i = 1; i < argc; i++) {
+	result = Tcl_Write(chan, argv[i], -1);
+	if (result < 0) {
+	    Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
+		    ": ", Tcl_PosixError(interp), (char *) NULL);
+	    return TCL_ERROR;
+	}
+        if (i < (argc - 1)) {
+	    Tcl_Write(chan, " ", -1);
+	}
+    }
+    Tcl_Write(chan, "\n", -1);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LsCmd --
+ *
+ *	This procedure is invoked to process the "ls" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_LsCmd(
+    ClientData dummy,			/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int argc,				/* Number of arguments. */
+    char **argv)			/* Argument strings. */
+{
+#define STRING_LENGTH 80
+#define CR '\n'
+    int i, j;
+    int fieldLength, len = 0, maxLen = 0, perLine;
+    char **origArgv = argv;
+    OSErr err;
+    CInfoPBRec paramBlock;
+    HFileInfo *hpb = (HFileInfo *)&paramBlock;
+    DirInfo *dpb = (DirInfo *)&paramBlock;
+    char theFile[256];
+    char theLine[STRING_LENGTH + 2];
+    int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
+	cFlag = false, hFlag = false;
+
+    /*
+     * Process command flags.  End if argument doesn't start
+     * with a dash or is a dash by itself.  The remaining arguments
+     * should be files.
+     */
+    for (i = 1; i < argc; i++) {
+	if (argv[i][0] != '-') {
+	    break;
+	}
+		
+	if (!strcmp(argv[i], "-")) {
+	    i++;
+	    break;
+	}
+		
+	for (j = 1 ; argv[i][j] ; ++j) {
+	    switch(argv[i][j]) {
+	    case 'a':
+	    case 'A':
+		aFlag = true;
+		break;
+	    case '1':
+		cFlag = false;
+		break;
+	    case 'C':
+		cFlag = true;
+		break;
+	    case 'F':
+		fFlag = true;
+		break;
+	    case 'H':
+		hFlag = true;
+		break;
+	    case 'p':
+		pFlag = true;
+		break;
+	    case 'l':
+		pFlag = false;
+		lFlag = true;
+		break;
+	    default:
+		Tcl_AppendResult(interp, "error - unknown flag ",
+			"usage: ls -apCFHl1 ?files? ", NULL);
+		return TCL_ERROR;
+	    }
+	}
+    }
+
+    argv += i;
+    argc -= i;
+
+    /*
+     * No file specifications means we search for all files.
+     * Glob will be doing most of the work.
+     */
+     if (!argc) {
+	argc = 1;
+	argv = origArgv;
+	strcpy(argv[0], "*");
+    }
+
+    if (!GlobArgs(interp, &argc, &argv)) {
+	Tcl_ResetResult(interp);
+	return TCL_ERROR;
+    }
+
+    /*
+     * There are two major methods for listing files: the long
+     * method and the normal method.
+     */
+    if (lFlag) {
+	char	creator[5], type[5], time[16], date[16];
+	char	lineTag;
+	long	size;
+	unsigned short flags;
+
+	/*
+	 * Print the header for long listing.
+	 */
+	if (hFlag) {
+	    sprintf(theLine, "T %7s %8s %8s %4s %4s %6s %s",
+		    "Size", "ModTime", "ModDate",
+		    "CRTR", "TYPE", "Flags", "Name");
+	    Tcl_AppendResult(interp, theLine, "\n", NULL);
+	    Tcl_AppendResult(interp,
+		    "-------------------------------------------------------------\n",
+		    NULL);
+	}
+		
+	for (i = 0; i < argc; i++) {
+	    strcpy(theFile, argv[i]);
+			
+	    c2pstr(theFile);
+	    hpb->ioCompletion = NULL;
+	    hpb->ioVRefNum = 0;
+	    hpb->ioFDirIndex = 0;
+	    hpb->ioNamePtr = (StringPtr) theFile;
+	    hpb->ioDirID = 0L;
+	    err = PBGetCatInfoSync(&paramBlock);
+	    p2cstr((StringPtr) theFile);
+
+	    if (hpb->ioFlAttrib & 16) {
+		/*
+		 * For directories use zero as the size, use no Creator
+		 * type, and use 'DIR ' as the file type.
+		 */
+		if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
+		    continue;
+		}
+		lineTag = 'D';
+		size = 0;
+		IUTimeString(dpb->ioDrMdDat, false, (unsigned char *)time);
+		p2cstr((StringPtr)time);
+		IUDateString(dpb->ioDrMdDat, shortDate, (unsigned char *)date);
+		p2cstr((StringPtr)date);
+		strcpy(creator, "    ");
+		strcpy(type, "DIR ");
+		flags = dpb->ioDrUsrWds.frFlags;
+		if (fFlag || pFlag) {
+		    strcat(theFile, ":");
+		}
+	    } else {
+		/*
+		 * All information for files should be printed.  This
+		 * includes size, modtime, moddate, creator type, file
+		 * type, flags, anf file name.
+		 */
+		if ((aFlag == false) &&
+			(hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
+		    continue;
+		}
+		lineTag = 'F';
+		size = hpb->ioFlLgLen + hpb->ioFlRLgLen;
+		IUTimeString(hpb->ioFlMdDat, false, (unsigned char *)time);
+		p2cstr((StringPtr)time);
+		IUDateString(hpb->ioFlMdDat, shortDate, (unsigned char *)date);
+		p2cstr((StringPtr)date);
+		strncpy(creator, (char *) &hpb->ioFlFndrInfo.fdCreator, 4);
+		creator[4] = 0;
+		strncpy(type, (char *) &hpb->ioFlFndrInfo.fdType, 4);
+		type[4] = 0;
+		flags = hpb->ioFlFndrInfo.fdFlags;
+		if (fFlag) {
+		    if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
+			strcat(theFile, "@");
+		    } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
+			strcat(theFile, "*");
+		    }
+		}
+	    }
+			
+	    sprintf(theLine, "%c %7ld %8s %8s %-4.4s %-4.4s 0x%4.4X %s",
+		    lineTag, size, time, date, creator, type, flags, theFile);
+						 
+	    Tcl_AppendResult(interp, theLine, "\n", NULL);
+	    
+	}
+		
+	if ((interp->result != NULL) && (*(interp->result) != '\0')) {
+	    int slen = strlen(interp->result);
+	    if (interp->result[slen - 1] == '\n') {
+		interp->result[slen - 1] = '\0';
+	    }
+	}
+    } else {
+	/*
+	 * Not in long format. We only print files names.  If the
+	 * -C flag is set we need to print in multiple coloumns.
+	 */
+	int argCount, linePos;
+	Boolean needNewLine = false;
+
+	/*
+	 * Fiend the field length: the length each string printed
+	 * to the terminal will be.
+	 */
+	if (!cFlag) {
+	    perLine = 1;
+	    fieldLength = STRING_LENGTH;
+	} else {
+	    for (i = 0; i < argc; i++) {
+		len = strlen(argv[i]);
+		if (len > maxLen) {
+		    maxLen = len;
+		}
+	    }
+	    fieldLength = maxLen + 3;
+	    perLine = STRING_LENGTH / fieldLength;
+	}
+
+	argCount = 0;
+	linePos = 0;
+	memset(theLine, ' ', STRING_LENGTH);
+	while (argCount < argc) {
+	    strcpy(theFile, argv[argCount]);
+			
+	    c2pstr(theFile);
+	    hpb->ioCompletion = NULL;
+	    hpb->ioVRefNum = 0;
+	    hpb->ioFDirIndex = 0;
+	    hpb->ioNamePtr = (StringPtr) theFile;
+	    hpb->ioDirID = 0L;
+	    err = PBGetCatInfoSync(&paramBlock);
+	    p2cstr((StringPtr) theFile);
+
+	    if (hpb->ioFlAttrib & 16) {
+		/*
+		 * Directory. If -a show hidden files.  If -f or -p
+		 * denote that this is a directory.
+		 */
+		if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
+		    argCount++;
+		    continue;
+		}
+		if (fFlag || pFlag) {
+		    strcat(theFile, ":");
+		}
+	    } else {
+		/*
+		 * File: If -a show hidden files, if -f show links
+		 * (aliases) and executables (APPLs).
+		 */
+		if ((aFlag == false) &&
+			(hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
+		    argCount++;
+		    continue;
+		}
+		if (fFlag) {
+		    if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
+			strcat(theFile, "@");
+		    } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
+			strcat(theFile, "*");
+		    }
+		}
+	    }
+
+	    /*
+	     * Print the item, taking into account multi-
+	     * coloum output.
+	     */
+	    strncpy(theLine + (linePos * fieldLength), theFile,
+		    strlen(theFile));
+	    linePos++;
+			
+	    if (linePos == perLine) {
+		theLine[STRING_LENGTH] = '\0';
+		if (needNewLine) {
+		    Tcl_AppendResult(interp, "\n", theLine, NULL);
+		} else {
+		    Tcl_AppendResult(interp, theLine, NULL);
+		    needNewLine = true;
+		}
+		linePos = 0;
+		memset(theLine, ' ', STRING_LENGTH);
+	    }
+			
+	    argCount++;
+	}
+		
+	if (linePos != 0) {
+	    theLine[STRING_LENGTH] = '\0';
+	    if (needNewLine) {
+		Tcl_AppendResult(interp, "\n", theLine, NULL);
+	    } else {
+		Tcl_AppendResult(interp, theLine, NULL);
+	    }
+	}
+    }
+	
+    ckfree((char *) argv);
+	
+    return TCL_OK;
+}
diff --git a/tcl/mac/tclMacUtil.c b/tcl/mac/tclMacUtil.c
new file mode 100644
index 00000000000..7d7867abe40
--- /dev/null
+++ b/tcl/mac/tclMacUtil.c
@@ -0,0 +1,441 @@
+/* 
+ * tclMacUtil.c --
+ *
+ *  This contains utility functions used to help with
+ *  implementing Macintosh specific portions of the Tcl port.
+ *
+ * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclMacInt.h"
+#include "tclMath.h"
+#include "tclMacPort.h"
+
+#include <Aliases.h>
+#include <Errors.h>
+#include <Files.h>
+#include <Folders.h>
+#include <FSpCompat.h>
+#include <Strings.h>
+#include <TextUtils.h>
+#include <MoreFilesExtras.h>
+
+/* 
+ * The following two Includes are from the More Files package.
+ */
+#include <FileCopy.h>
+#include <MoreFiles.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * hypotd --
+ *
+ *	The standard math function hypot is not supported by Think C.
+ *	It is included here so everything works. It is supported by
+ *	CodeWarrior Pro 1, but the 68K version does not support doubles.
+ *	So we hack it in.
+ *
+ * Results:
+ *	Result of computation.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+#if defined(THINK_C) || defined(__MWERKS__)
+double hypotd(double x, double y);
+
+double
+hypotd(
+    double x,		/* X value */
+    double y)		/* Y value */
+{
+    double sum;
+
+    sum = x*x + y*y;
+    return sqrt(sum);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpGetDefaultDir --
+ *
+ *	This function gets the current default directory.
+ *
+ * Results:
+ *	The provided FSSpec is changed to point to the "default"
+ *	directory.  The function returns what ever errors
+ *	FSMakeFSSpecCompat may encounter.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+FSpGetDefaultDir(
+	FSSpecPtr dirSpec)	/* On return the default directory. */
+{
+    OSErr err;
+    short vRefNum = 0;
+    long int dirID = 0;
+
+    err = HGetVol(NULL, &vRefNum, &dirID);
+	
+    if (err == noErr) {
+	err = FSMakeFSSpecCompat(vRefNum, dirID, (ConstStr255Param) NULL,
+		dirSpec);
+    }
+	
+    return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpSetDefaultDir --
+ *
+ *	This function sets the default directory to the directory
+ *	pointed to by the provided FSSpec.
+ *
+ * Results:
+ *	The function returns what ever errors HSetVol may encounter.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+FSpSetDefaultDir(
+	FSSpecPtr dirSpec)	/* The new default directory. */
+{
+    OSErr err;
+
+    /*
+     * The following special case is needed to work around a bug
+     * in the Macintosh OS.  (Acutally PC Exchange.)
+     */
+    
+    if (dirSpec->parID == fsRtParID) {
+	err = HSetVol(NULL, dirSpec->vRefNum, fsRtDirID);
+    } else {
+	err = HSetVol(dirSpec->name, dirSpec->vRefNum, dirSpec->parID);
+    }
+    
+    return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpFindFolder --
+ *
+ *	This function is a version of the FindFolder function that 
+ *	returns the result as a FSSpec rather than a vRefNum and dirID.
+ *
+ * Results:
+ *	Results will be simaler to that of the FindFolder function.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSErr
+FSpFindFolder(
+    short vRefNum,		/* Volume reference number. */
+    OSType folderType,		/* Folder type taken by FindFolder. */
+    Boolean createFolder,	/* Should we create it if non-existant. */
+    FSSpec *spec)		/* Pointer to resulting directory. */
+{
+    short foundVRefNum;
+    long foundDirID;
+    OSErr err;
+
+    err = FindFolder(vRefNum, folderType, createFolder,
+	    &foundVRefNum, &foundDirID);
+    if (err != noErr) {
+	return err;
+    }
+		
+    err = FSMakeFSSpecCompat(foundVRefNum, foundDirID, "\p", spec);
+    return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpLocationFromPath --
+ *
+ *	This function obtains an FSSpec for a given macintosh path.
+ *	Unlike the More Files function FSpLocationFromFullPath, this
+ *	function will also accept partial paths and resolve any aliases
+ *	along the path.  
+ *
+ * Results:
+ *	OSErr code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+FSpLocationFromPath(
+    int length,			/* Length of path. */
+    CONST char *path,		/* The path to convert. */
+    FSSpecPtr fileSpecPtr)	/* On return the spec for the path. */
+{
+    Str255 fileName;
+    OSErr err;
+    short vRefNum;
+    long dirID;
+    int pos, cur;
+    Boolean isDirectory;
+    Boolean wasAlias;
+
+    /*
+     * Check to see if this is a full path.  If partial
+     * we assume that path starts with the current working
+     * directory.  (Ie. volume & dir = 0)
+     */
+    vRefNum = 0;
+    dirID = 0;
+    cur = 0;
+    if (length == 0) {
+        return fnfErr;
+    }
+    if (path[cur] == ':') {
+	cur++;
+	if (cur >= length) {
+	    /*
+	     * If path = ":", just return current directory.
+	     */
+	    FSMakeFSSpecCompat(0, 0, NULL, fileSpecPtr);
+	    return noErr;
+	}
+    } else {
+	while (path[cur] != ':' && cur < length) {
+	    cur++;
+	}
+	if (cur > 255) {
+	    return bdNamErr;
+	}
+	if (cur < length) {
+	    /*
+	     * This is a full path
+	     */
+	    cur++;
+	    strncpy((char *) fileName + 1, path, cur);
+	    fileName[0] = cur;
+	    err = FSMakeFSSpecCompat(0, 0, fileName, fileSpecPtr);
+	    if (err != noErr) return err;
+	    FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
+	    vRefNum = fileSpecPtr->vRefNum;
+	} else {
+	    cur = 0;
+	}
+    }
+    
+    isDirectory = 1;
+    while (cur < length) {
+	if (!isDirectory) {
+	    return dirNFErr;
+	}
+	pos = cur;
+	while (path[pos] != ':' && pos < length) {
+	    pos++;
+	}
+	if (pos == cur) {
+	    /* Move up one dir */
+	    /* cur++; */
+	    strcpy((char *) fileName + 1, "::");
+	    fileName[0] = 2;
+	} else if (pos - cur > 255) {
+	    return bdNamErr;
+	} else {
+	    strncpy((char *) fileName + 1, &path[cur], pos - cur);
+	    fileName[0] = pos - cur;
+	}
+	err = FSMakeFSSpecCompat(vRefNum, dirID, fileName, fileSpecPtr);
+	if (err != noErr) return err;
+	err = ResolveAliasFile(fileSpecPtr, true, &isDirectory, &wasAlias);
+	if (err != noErr) return err;
+	FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
+	vRefNum = fileSpecPtr->vRefNum;
+	cur = pos;
+	if (path[cur] == ':') {
+	    cur++;
+	}
+    }
+    
+    return noErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpPathFromLocation --
+ *
+ *	This function obtains a full path name for a given macintosh
+ *	FSSpec.  Unlike the More Files function FSpGetFullPath, this
+ *	function will return a C string in the Handle.  It also will
+ *	create paths for FSSpec that do not yet exist.
+ *
+ * Results:
+ *	OSErr code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSErr
+FSpPathFromLocation(
+    FSSpec *spec,		/* The location we want a path for. */
+    int *length,		/* Length of the resulting path. */
+    Handle *fullPath)		/* Handle to path. */
+{
+    OSErr err;
+    FSSpec tempSpec;
+    CInfoPBRec pb;
+	
+    *fullPath = NULL;
+	
+    /* 
+     * Make a copy of the input FSSpec that can be modified.
+     */
+    BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
+	
+    if (tempSpec.parID == fsRtParID) {
+	/* 
+	 * The object is a volume.  Add a colon to make it a full 
+	 * pathname.  Allocate a handle for it and we are done.
+	 */
+	tempSpec.name[0] += 2;
+	tempSpec.name[tempSpec.name[0] - 1] = ':';
+	tempSpec.name[tempSpec.name[0]] = '\0';
+		
+	err = PtrToHand(&tempSpec.name[1], fullPath, tempSpec.name[0]);
+    } else {
+	/* 
+	 * The object isn't a volume.  Is the object a file or a directory? 
+	 */
+	pb.dirInfo.ioNamePtr = tempSpec.name;
+	pb.dirInfo.ioVRefNum = tempSpec.vRefNum;
+	pb.dirInfo.ioDrDirID = tempSpec.parID;
+	pb.dirInfo.ioFDirIndex = 0;
+	err = PBGetCatInfoSync(&pb);
+
+	if ((err == noErr) || (err == fnfErr)) {
+	    /* 
+	     * If the file doesn't currently exist we start over.  If the
+	     * directory exists everything will work just fine.  Otherwise we
+	     * will just fail later.  If the object is a directory, append a
+	     * colon so full pathname ends with colon.
+	     */
+	    if (err == fnfErr) {
+		BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
+	    } else if ( (pb.hFileInfo.ioFlAttrib & ioDirMask) != 0 ) {
+		tempSpec.name[0] += 1;
+		tempSpec.name[tempSpec.name[0]] = ':';
+	    }
+			
+	    /* 
+	     * Create a new Handle for the object - make it a C string.
+	     */
+	    tempSpec.name[0] += 1;
+	    tempSpec.name[tempSpec.name[0]] = '\0';
+	    err = PtrToHand(&tempSpec.name[1], fullPath, tempSpec.name[0]);
+	    if (err == noErr) {
+		/* 
+		 * Get the ancestor directory names - loop until we have an 
+		 * error or find the root directory.
+		 */
+		pb.dirInfo.ioNamePtr = tempSpec.name;
+		pb.dirInfo.ioVRefNum = tempSpec.vRefNum;
+		pb.dirInfo.ioDrParID = tempSpec.parID;
+		do {
+		    pb.dirInfo.ioFDirIndex = -1;
+		    pb.dirInfo.ioDrDirID = pb.dirInfo.ioDrParID;
+		    err = PBGetCatInfoSync(&pb);
+		    if (err == noErr) {
+			/* 
+			 * Append colon to directory name and add 
+			 * directory name to beginning of fullPath.
+			 */
+			++tempSpec.name[0];
+			tempSpec.name[tempSpec.name[0]] = ':';
+						
+			(void) Munger(*fullPath, 0, NULL, 0, &tempSpec.name[1],
+				tempSpec.name[0]);
+			err = MemError();
+		    }
+		} while ( (err == noErr) &&
+			(pb.dirInfo.ioDrDirID != fsRtDirID) );
+	    }
+	}
+    }
+    
+    /*
+     * On error Dispose the handle, set it to NULL & return the err.
+     * Otherwise, set the length & return.
+     */
+    if (err == noErr) {
+	*length = GetHandleSize(*fullPath) - 1;
+    } else {
+	if ( *fullPath != NULL ) {
+	    DisposeHandle(*fullPath);
+	}
+	*fullPath = NULL;
+	*length = 0;
+    }
+
+    return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetGlobalMouse --
+ *
+ *	This procedure obtains the current mouse position in global
+ *	coordinates.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+GetGlobalMouse(
+    Point *mouse)		/* Mouse position. */
+{
+    EventRecord event;
+    
+    OSEventAvail(0, &event);
+    *mouse = event.where;
+}
diff --git a/tcl/tests/README b/tcl/tests/README
new file mode 100644
index 00000000000..ef48e10fd81
--- /dev/null
+++ b/tcl/tests/README
@@ -0,0 +1,96 @@
+Tcl Test Suite
+--------------
+
+RCS: @(#) $Id$
+
+This directory contains a set of validation tests for the Tcl
+commands.  Each of the files whose name ends in ".test" is
+intended to fully exercise one or a few Tcl commands.  The
+commands tested by a given file are listed in the first line
+of the file.
+
+You can run the tests in two ways:
+    (a) type "make test" in ../unix; this will run all of the tests.
+    (b) start up tcltest in this directory, then "source" the test
+        file (for example, type "source parse.test").  To run all
+	of the tests, type "source all".
+In either case no output will be generated if all goes well, except
+for a listing of the tests..  If there are errors then additional
+messages will appear in the format described below.  Note: don't
+run the tests as superuser, since this will cause several of the tests
+to fail.
+
+The rest of this file provides additional information on the
+features of the testing environment.
+
+This approach to testing was designed and initially implemented
+by Mary Ann May-Pumphrey of Sun Microsystems.  Many thanks to
+her for donating her work back to the public Tcl release.
+
+Definitions file:
+-----------------
+
+The file "defs" defines a collection of procedures and variables
+used to run the tests.  It is read in automatically by each of the
+.test files if needed, but once it has been read once it will not
+be read again by the .test files.  If you change defs while running
+tests you'll have to "source" it by hand to load its new contents.
+
+Test output:
+------------
+
+Normally, output only appears when there are errors.  However, if
+the variable VERBOSE is set to 1 then tests will be run in "verbose"
+mode and output will be generated for each test regardless of
+whether it succeeded or failed.  Test output consists of the
+following information:
+
+    - the test identifier (which can be used to locate the test code
+	    in the .test file)
+    - a brief description of the test
+    - the contents of the test code
+    - the actual results produced by the tests
+    - a "PASSED" or "FAILED" message
+    - the expected results (if the test failed)
+
+You can set VERBOSE either interactively (after the defs file has been
+read in), or you can change the default value in "defs".
+
+Selecting tests for execution:
+------------------------------
+
+Normally, all the tests in a file are run whenever the file is
+"source"d.  However, you can select a specific set of tests using
+the global variable TESTS.  This variable contains a pattern;  any
+test whose identifier matches TESTS will be run.  For example,
+the following interactive command causes all of the "for" tests in
+groups 2 and 4 to be executed:
+
+    set TESTS {for-[24]*}
+
+TESTS defaults to *, but you can change the default in "defs" if
+you wish.
+
+Saving keystrokes:
+------------------
+
+A convenience procedure named "dotests" is included in file
+"defs".  It takes two arguments--the name of the test file (such
+as "parse.test"), and a pattern selecting the tests you want to
+execute.  It sets TESTS to the second argument, calls "source" on
+the file specified in the first argument, and restores TESTS to
+its pre-call value at the end.
+
+Batch vs. interactive execution:
+--------------------------------
+
+The tests can be run in either batch or interactive mode.  Batch
+mode refers to using I/O redirection from a UNIX shell.  For example,
+the following command causes the tests in the file named "parse.test"
+to be executed:
+
+    tclTest < parse.test > parse.test.results
+
+Users who want to execute the tests in this fashion need to first
+ensure that the file "defs" has proper values for the global
+variables that control the testing environment (VERBOSE and TESTS).
diff --git a/tcl/tests/append.test b/tcl/tests/append.test
new file mode 100644
index 00000000000..ba058f53f5e
--- /dev/null
+++ b/tcl/tests/append.test
@@ -0,0 +1,174 @@
+# Commands covered:  append lappend
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset x}
+test append-1.1 {append command} {
+    catch {unset x}
+    list [append x 1 2 abc "long string"] $x
+} {{12abclong string} {12abclong string}}
+test append-1.2 {append command} {
+    set x ""
+    list [append x first] [append x second] [append x third] $x
+} {first firstsecond firstsecondthird firstsecondthird}
+test append-1.3 {append command} {
+    set x "abcd"
+    append x
+} abcd
+
+test append-2.1 {long appends} {
+    set x ""
+    for {set i 0} {$i < 1000} {set i [expr $i+1]} {
+	append x "foobar "
+    }
+    set y "foobar"
+    set y "$y $y $y $y $y $y $y $y $y $y"
+    set y "$y $y $y $y $y $y $y $y $y $y"
+    set y "$y $y $y $y $y $y $y $y $y $y "
+    expr {$x == $y}
+} 1
+
+test append-3.1 {append errors} {
+    list [catch {append} msg] $msg
+} {1 {wrong # args: should be "append varName ?value value ...?"}}
+test append-3.2 {append errors} {
+    set x ""
+    list [catch {append x(0) 44} msg] $msg
+} {1 {can't set "x(0)": variable isn't array}}
+test append-3.3 {append errors} {
+    catch {unset x}
+    list [catch {append x} msg] $msg
+} {1 {can't read "x": no such variable}}
+
+test append-4.1 {lappend command} {
+    catch {unset x}
+    list [lappend x 1 2 abc "long string"] $x
+} {{1 2 abc {long string}} {1 2 abc {long string}}}
+test append-4.2 {lappend command} {
+    set x ""
+    list [lappend x first] [lappend x second] [lappend x third] $x
+} {first {first second} {first second third} {first second third}}
+test append-4.3 {lappend command} {
+    proc foo {} {
+	global x
+	set x old
+	unset x
+	lappend x new
+    }
+    set result [foo]
+    rename foo {}
+    set result
+} {new}
+test append-4.4 {lappend command} {
+    set x {}
+    lappend x \{\  abc
+} {\{\  abc}
+test append-4.5 {lappend command} {
+    set x {}
+    lappend x \{ abc
+} {\{ abc}
+test append-4.6 {lappend command} {
+    set x {1 2 3}
+    lappend x
+} {1 2 3}
+test append-4.7 {lappend command} {
+    set x "a\{"
+    lappend x abc
+} "a\\\{ abc"
+test append-4.8 {lappend command} {
+    set x "\\\{"
+    lappend x abc
+} "\\{ abc"
+test append-4.9 {lappend command} {
+    set x " \{"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
+test append-4.10 {lappend command} {
+    set x "	\{"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
+test append-4.11 {lappend command} {
+    set x "\{\{\{"
+    list [catch {lappend x abc} msg] $msg
+} {1 {unmatched open brace in list}}
+test append-4.12 {lappend command} {
+    set x "x \{\{\{"
+    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"
+test append-4.14 {lappend command} {
+    set x " "
+    lappend x abc
+} "abc"
+test append-4.15 {lappend command} {
+    set x "\\ "
+    lappend x 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]
+    if {$l != $size} {
+	return "length mismatch: should have been $size, was $l"
+    }
+    for {set i 0} {$i < $size} {set i [expr $i+1]} {
+	set j [lindex $var $i]
+	if {$j != "item $i"} {
+	    return "element $i should have been \"item $i\", was \"$j\""
+	}
+    }
+    return ok
+}
+test append-5.1 {long lappends} {
+    set x ""
+    for {set i 0} {$i < 300} {set i [expr $i+1]} {
+	lappend x "item $i"
+    }
+    check $x 300
+} ok
+
+test append-6.1 {lappend errors} {
+    list [catch {lappend} msg] $msg
+} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
+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-7.1 {lappend-created var and error in trace on that var} {
+    catch {rename foo ""}
+    catch {unset x}
+    trace variable x w foo
+    proc foo {} {global x; unset x}
+    catch {lappend x 1}
+    proc foo {args} {global x; unset x}
+    info exists x
+    set x
+    lappend x 1
+    list [info exists x] [catch {set x} msg] $msg
+} {0 1 {can't read "x": no such variable}}
+
+catch {unset x}
+catch {rename foo ""}
diff --git a/tcl/tests/assocd.test b/tcl/tests/assocd.test
new file mode 100644
index 00000000000..c5d06dc523d
--- /dev/null
+++ b/tcl/tests/assocd.test
@@ -0,0 +1,57 @@
+# This file tests the AssocData facility of Tcl
+#
+# 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-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {[string compare testsetassocdata [info commands testsetassocdata]] != 0} {
+    puts "This application hasn't been compiled with the tests for assocData,"
+    puts "therefore I am skipping all of these tests."
+    return
+}
+
+test assocd-1.1 {testing setting assoc data} {
+   testsetassocdata a 1
+} ""
+test assocd-1.2 {testing setting assoc data} {
+   testsetassocdata a 2
+} ""
+test assocd-1.3 {testing setting assoc data} {
+   testsetassocdata 123 456
+} ""
+test assocd-1.4 {testing setting assoc data} {
+   testsetassocdata abc "abc d e f"
+} ""
+
+test assocd-2.1 {testing getting assoc data} {
+   testgetassocdata a
+} 2
+test assocd-2.2 {testing getting assoc data} {
+   testgetassocdata 123
+} 456
+test assocd-2.3 {testing getting assoc data} {
+   testgetassocdata abc
+} {abc d e f}
+test assocd-2.4 {testing getting assoc data} {
+   testgetassocdata xxx
+} ""
+
+test assocd-3.1 {testing deleting assoc data} {
+   testdelassocdata a
+} ""
+test assocd-3.2 {testing deleting assoc data} {
+   testdelassocdata 123
+} ""
+test assocd-3.3 {testing deleting assoc data} {
+   list [catch {testdelassocdata nonexistent} msg] $msg
+} {0 {}}
diff --git a/tcl/tests/async.test b/tcl/tests/async.test
new file mode 100644
index 00000000000..70dea8700bb
--- /dev/null
+++ b/tcl/tests/async.test
@@ -0,0 +1,131 @@
+# Commands covered:  none
+#
+# This file contains a collection of tests for Tcl_AsyncCreate and related
+# library procedures.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 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.
+#
+# RCS: @(#) $Id$
+
+if {[info commands testasync] == {}} {
+    puts "This application hasn't been compiled with the \"testasync\""
+    puts "command, so I can't test Tcl_AsyncCreate et al."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+proc async1 {result code} {
+    global aresult acode
+    set aresult $result
+    set acode $code
+    return "new result"
+}
+proc async2 {result code} {
+    global aresult acode
+    set aresult $result
+    set acode $code
+    return -code error "xyzzy"
+}
+proc async3 {result code} {
+    global aresult
+    set aresult "test pattern"
+    return -code $code $result
+}
+
+set handler1 [testasync create async1]
+set handler2 [testasync create async2]
+set handler3 [testasync create async3]
+test async-1.1 {basic async handlers} {
+    set aresult xxx
+    set acode yyy
+    list [catch {testasync mark $handler1 "original" 0} msg] $msg \
+	   $acode $aresult
+} {0 {new result} 0 original}
+test async-1.2 {basic async handlers} {
+    set aresult xxx
+    set acode yyy
+    list [catch {testasync mark $handler1 "original" 1} msg] $msg \
+	   $acode $aresult
+} {0 {new result} 1 original}
+test async-1.3 {basic async handlers} {
+    set aresult xxx
+    set acode yyy
+    list [catch {testasync mark $handler2 "old" 0} msg] $msg \
+	   $acode $aresult
+} {1 xyzzy 0 old}
+test async-1.4 {basic async handlers} {
+    set aresult xxx
+    set acode yyy
+    list [catch {testasync mark $handler2 "old" 3} msg] $msg \
+	   $acode $aresult
+} {1 xyzzy 3 old}
+test async-1.5 {basic async handlers} {
+    set aresult xxx
+    list [catch {testasync mark $handler3 "foobar" 0} msg] $msg $aresult
+} {0 foobar {test pattern}}
+test async-1.6 {basic async handlers} {
+    set aresult xxx
+    list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult
+} {1 foobar {test pattern}}
+
+proc mult1 {result code} {
+    global x
+    lappend x mult1
+    return -code 7 mult1
+}
+set hm1 [testasync create mult1]
+proc mult2 {result code} {
+    global x
+    lappend x mult2
+    return -code 9 mult2
+}
+set hm2 [testasync create mult2]
+proc mult3 {result code} {
+    global x hm1 hm2
+    lappend x [catch {testasync mark $hm2 serial2 0}]
+    lappend x [catch {testasync mark $hm1 serial1 0}]
+    lappend x mult3
+    return -code 11 mult3
+}
+set hm3 [testasync create mult3]
+
+test async-2.1 {multiple handlers} {
+    set x {}
+    list [catch {testasync mark $hm3 "foobar" 5} msg] $msg $x
+} {9 mult2 {0 0 mult3 mult1 mult2}}
+
+proc del1 {result code} {
+    global x hm1 hm2 hm3 hm4
+    lappend x [catch {testasync mark $hm3 serial2 0}]
+    lappend x [catch {testasync mark $hm1 serial1 0}]
+    lappend x [catch {testasync mark $hm4 serial1 0}]
+    testasync delete $hm1
+    testasync delete $hm2
+    testasync delete $hm3
+    lappend x del1
+    return -code 13 del1
+}
+proc del2 {result code} {
+    global x
+    lappend x del2
+    return -code 3 del2
+}
+testasync delete $handler1
+testasync delete $hm2
+testasync delete $hm3
+set hm2 [testasync create del1]
+set hm3 [testasync create mult2]
+set hm4 [testasync create del2]
+
+test async-3.1 {deleting handlers} {
+    set x {}
+    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
+} {3 del2 {0 0 0 del1 del2}}
+
+testasync delete
diff --git a/tcl/tests/autoMkindex.tcl b/tcl/tests/autoMkindex.tcl
new file mode 100644
index 00000000000..7a72fbe824e
--- /dev/null
+++ b/tcl/tests/autoMkindex.tcl
@@ -0,0 +1,52 @@
+# Test file for:
+#   auto_mkindex
+#
+# This file provides example cases for testing the Tcl autoloading
+# facility.  Things are much more complicated with namespaces and classes.
+# The "auto_mkindex" facility can no longer be built on top of a simple
+# regular expression parser.  It must recognize constructs like this:
+#
+#   namespace eval foo {
+#       proc test {x y} { ... }
+#       namespace eval bar {
+#           proc another {args} { ... }
+#       }
+#   }
+#
+# Note that procedures and itcl class definitions can be nested inside
+# of namespaces.
+#
+# Copyright (c) 1993-1998  Lucent Technologies, Inc.
+
+# This shouldn't cause any problems
+namespace import -force blt::*
+
+# Should be able to handle "proc" definitions, even if they are
+# preceded by white space.
+
+proc normal {x y} {return [expr $x+$y]}
+  proc indented {x y} {return [expr $x+$y]}
+
+#
+# Should be able to handle proc declarations within namespaces,
+# even if they have explicit namespace paths.
+#
+namespace eval buried {
+    proc inside {args} {return "inside: $args"}
+
+    namespace export pub_*
+    proc pub_one {args} {return "one: $args"}
+    proc pub_two {args} {return "two: $args"}
+}
+proc buried::within {args} {return "within: $args"}
+
+namespace eval buried {
+    namespace eval under {
+        proc neath {args} {return "neath: $args"}
+    }
+    namespace eval ::buried {
+        proc relative {args} {return "relative: $args"}
+        proc ::top {args} {return "top: $args"}
+        proc ::buried::explicit {args} {return "explicit: $args"}
+    }
+}
diff --git a/tcl/tests/autoMkindex.test b/tcl/tests/autoMkindex.test
new file mode 100644
index 00000000000..9428f84d903
--- /dev/null
+++ b/tcl/tests/autoMkindex.test
@@ -0,0 +1,61 @@
+# Commands covered:  auto_mkindex auto_import
+#
+# This file contains tests related to autoloading and generating
+# the autoloading index.
+#
+# Copyright (c) 1998  Lucent Technologies, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test autoMkindex-1.1 {remove any existing tclIndex file} {
+    file delete tclIndex
+    file exists tclIndex
+} {0}
+
+test autoMkindex-1.2 {build tclIndex based on a test file} {
+    auto_mkindex . autoMkindex.tcl
+    file exists tclIndex
+} {1}
+
+set element "{source [file join . autoMkindex.tcl]}"
+
+test autoMkindex-1.3 {examine tclIndex} {
+    namespace eval tcl_autoMkindex_tmp {
+        set dir "."
+        variable auto_index
+        source tclIndex
+        set result ""
+        foreach elem [lsort [array names auto_index]] {
+            lappend result [list $elem $auto_index($elem)]
+        }
+        set result
+    }
+} "{::buried::explicit $element} {::buried::inside $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"
+
+namespace delete tcl_autoMkindex_tmp
+
+test autoMkindex-2.1 {commands on the autoload path can be imported} {
+    set interp [interp create]
+    set final [$interp eval {
+        namespace eval blt {}
+        set auto_path [linsert $auto_path 0 .]
+        set info [list [catch {namespace import buried::*} result] $result]
+        foreach name [lsort [info commands pub_*]] {
+            lappend info $name [namespace origin $name]
+        }
+        set info
+    }]
+    interp delete $interp
+    set final
+} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
+
+#
+# Clean up.
+#
+
+catch {file delete tclIndex}
diff --git a/tcl/tests/basic.test b/tcl/tests/basic.test
new file mode 100644
index 00000000000..e3b8cf6162e
--- /dev/null
+++ b/tcl/tests/basic.test
@@ -0,0 +1,403 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+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"}}
+
+# NB: More tests about hide/expose are found in interp.test
+
+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 x} msg] $msg \
+	 [catch {test_interp hide x test_ns_basic::p} msg1] $msg1 \
+         [interp delete test_interp]
+} {1 {can only hide global namespace commands (use rename then hide)} 1 {cannot use namespace qualifiers as hidden commandtoken (rename)} {}}
+
+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, a command stays in the global namespace and can not go to another 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 exposeCmdFailing {} {
+            interp expose {} cmd ::test_ns_basic::newCmd
+        }
+        proc exposeCmdWorkAround {} {
+            interp expose {} cmd;
+	    rename cmd ::test_ns_basic::newCmd;
+        }
+        proc callCmd {} {
+            cmd
+        }
+    }
+    list [test_ns_basic::callCmd] \
+         [test_ns_basic::hideCmd] \
+         [catch {test_ns_basic::exposeCmdFailing} msg] $msg \
+         [test_ns_basic::exposeCmdWorkAround] \
+         [test_ns_basic::newCmd] \
+         [namespace delete test_ns_basic]
+} {:: {} 1 {can not expose to a namespace (use expose to toplevel, then rename)} {} ::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_ns_basic}}
+
+if {[info command testcmdtoken] != {}} {
+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 basic-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_DeleteCommandFromToken, 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_DeleteCommandFromToken, 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_DeleteCommandFromToken, 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} {}}
+
+if {[info command testcmdtrace] != {}} {
+test basic-12.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+    testcmdtrace tracetest {set stuff [info tclversion]}
+} {{info tclversion} {info tclversion} {set stuff [info tclversion]} {set stuff 8.0}}
+test basic-12.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+    testcmdtrace deletetest {set stuff [info tclversion]}
+} 8.0
+}
+
+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}
+set x 0
+unset x
diff --git a/tcl/tests/binary.test b/tcl/tests/binary.test
new file mode 100644
index 00000000000..becc2d070fb
--- /dev/null
+++ b/tcl/tests/binary.test
@@ -0,0 +1,1443 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 format 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
+} \xff\x7f\xff\xff
+test binary-13.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable pcOnly} {
+    binary format f -3.402825e+38
+} \xff\xff\x7f\xff
+test binary-13.14 {Tcl_BinaryObjCmd: float underflow} {nonPortable macOrUnix} {
+    binary format f -3.402825e-100
+} \x80\x00\x00\x00
+test binary-13.15 {Tcl_BinaryObjCmd: float underflow} {nonPortable pcOnly} {
+    binary format f -3.402825e-100
+} \x00\x00\x00\x80
+test binary-13.16 {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.17 {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.18 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+    set a {1.6 3.4}
+    binary format f1 $a
+} \x3f\xcc\xcc\xcd
+test binary-13.19 {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 scan 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.60000002384 3.40000009537}}
+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.60000002384 3.40000009537}}
+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.60000002384}
+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.60000002384}
+test binary-31.6 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
+    catch {unset arg1}
+    list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
+} {1 1.60000002384}
+test binary-31.7 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+    catch {unset arg1}
+    list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
+} {1 1.60000002384}
+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.60000002384 3.40000009537}}
+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.60000002384 3.40000009537}}
+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.60000002384 3.40000009537} 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.60000002384 3.40000009537} 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.6 3.4}}
+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.6 3.4}}
+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.6}
+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.6}
+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.6}
+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.6}
+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.6 3.4}}
+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.6 3.4}}
+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.6 3.4} 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.6 3.4} 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 {}}
+test binary-37.9 {GetFormatSpec: numbers} {
+    # test format of neg numbers
+    # bug report/fix provided by Harald Kirsch
+    set x [binary format f* {1 -1 2 -2 0}]
+    binary scan $x f* bla
+    set bla
+} {1.0 -1.0 2.0 -2.0 0.0}
+
+test binary-38.1 {FormatNumber: word alignment} {
+    set x [binary format c1s1 1 1]
+} \x01\x01\x00
+test binary-38.2 {FormatNumber: word alignment} {
+    set x [binary format c1S1 1 1]
+} \x01\x00\x01
+test binary-38.3 {FormatNumber: word alignment} {
+    set x [binary format c1i1 1 1]
+} \x01\x01\x00\x00\x00
+test binary-38.4 {FormatNumber: word alignment} {
+    set x [binary format c1I1 1 1]
+} \x01\x00\x00\x00\x01
+test binary-38.5 {FormatNumber: word alignment} {nonPortable macOrUnix} {
+    set x [binary format c1d1 1 1.6]
+} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a
+test binary-38.6 {FormatNumber: word alignment} {nonPortable pcOnly} {
+    set x [binary format c1d1 1 1.6]
+} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f
+test binary-38.7 {FormatNumber: word alignment} {nonPortable macOrUnix} {
+    set x [binary format c1f1 1 1.6]
+} \x01\x3f\xcc\xcc\xcd
+test binary-38.8 {FormatNumber: word alignment} {nonPortable pcOnly} {
+    set x [binary format c1f1 1 1.6]
+} \x01\xcd\xcc\xcc\x3f
+
+test binary-39.1 {ScanNumber: sign extension} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 c2 arg1] $arg1
+} {1 {82 -93}}
+test binary-39.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-39.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-39.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-39.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-40.1 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+    catch {unset arg1}
+    list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
+} {1 -NaN}
+test binary-40.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-40.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-40.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-40.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-40.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}
+
+test binary-41.1 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.2 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.3 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.4 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.5 {ScanNumber: word alignment} {nonPortable macOrUnix} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
+} {2 1 1.60000002384}
+test binary-41.6 {ScanNumber: word alignment} {nonPortable pcOnly} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
+} {2 1 1.60000002384}
+test binary-41.7 {ScanNumber: word alignment} {nonPortable macOrUnix} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
+} {2 1 1.6}
+test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
+} {2 1 1.6}
diff --git a/tcl/tests/case.test b/tcl/tests/case.test
new file mode 100644
index 00000000000..bb0117fa486
--- /dev/null
+++ b/tcl/tests/case.test
@@ -0,0 +1,83 @@
+# Commands covered:  case
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test case-1.1 {simple pattern} {
+    case a in a {format 1} b {format 2} c {format 3} default {format 4}
+} 1
+test case-1.2 {simple pattern} {
+    case b a {format 1} b {format 2} c {format 3} default {format 4}
+} 2
+test case-1.3 {simple pattern} {
+    case x in a {format 1} b {format 2} c {format 3} default {format 4}
+} 4
+test case-1.4 {simple pattern} {
+    case x a {format 1} b {format 2} c {format 3}
+} {}
+test case-1.5 {simple pattern matches many times} {
+    case b a {format 1} b {format 2} b {format 3} b {format 4}
+} 2
+test case-1.6 {fancier pattern} {
+    case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
+} 3
+test case-1.7 {list of patterns} {
+    case abc in {a b c} {format 1} {def abc ghi} {format 2}
+} 2
+
+test case-2.1 {error in executed command} {
+    list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
+	    $msg $errorInfo
+} {1 {Just a test} {Just a test
+    while executing
+"error "Just a test""
+    ("a" arm line 1)
+    invoked from within
+"case a in a {error "Just a test"} default {format 1}"}}
+test case-2.2 {error: not enough args} {
+    list [catch {case} msg] $msg
+} {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
+test case-2.3 {error: pattern with no body} {
+    list [catch {case a b} msg] $msg
+} {1 {extra case pattern with no body}}
+test case-2.4 {error: pattern with no body} {
+    list [catch {case a in b {format 1} c} msg] $msg
+} {1 {extra case pattern with no body}}
+test case-2.5 {error in default command} {
+    list [catch {case foo in a {error case1} default {error case2} \
+	    b {error case 3}} msg] $msg $errorInfo
+} {1 case2 {case2
+    while executing
+"error case2"
+    ("default" arm line 1)
+    invoked from within
+"case foo in a {error case1} default {error case2}  b {error case 3}"}}
+
+test case-3.1 {single-argument form for pattern/command pairs} {
+    case b in {
+	a {format 1}
+	b {format 2}
+	default {format 6}
+    }
+} {2}
+test case-3.2 {single-argument form for pattern/command pairs} {
+    case b {
+	a {format 1}
+	b {format 2}
+	default {format 6}
+    }
+} {2}
+test case-3.3 {single-argument form for pattern/command pairs} {
+    list [catch {case z in {a 2 b}} msg] $msg
+} {1 {extra case pattern with no body}}
diff --git a/tcl/tests/clock.test b/tcl/tests/clock.test
new file mode 100644
index 00000000000..9515bad2265
--- /dev/null
+++ b/tcl/tests/clock.test
@@ -0,0 +1,175 @@
+# Commands covered:  clock
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test clock-1.1 {clock tests} {
+    list [catch {clock} msg] $msg
+} {1 {wrong # args: should be "clock option ?arg ...?"}}
+test clock-1.2 {clock tests} {
+    list [catch {clock foo} msg] $msg
+} {1 {bad option "foo": must be clicks, format, scan, or seconds}}
+
+# clock clicks
+test clock-2.1 {clock clicks tests} {
+    expr [clock clicks]+1
+    concat {}
+} {}
+test clock-2.2 {clock clicks tests} {
+    list [catch {clock clicks foo} msg] $msg
+} {1 {wrong # args: should be "clock clicks"}}
+test clock-2.3 {clock clicks tests} {
+    set start [clock clicks]
+    after 10
+    set end [clock clicks]
+    expr "$end > $start"
+} {1}
+
+# clock format
+test clock-3.1 {clock format tests} {unixOnly} {
+    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.2 {clock format tests} {
+    list [catch {clock format} msg] $msg
+} {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 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: 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: 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"}}
+test clock-4.3 {clock scan tests} {
+    clock format [clock scan "14 Feb 92" -gmt true] \
+      -format {%m/%d/%y %I:%M:%S %p} -gmt true
+} {02/14/92 12:00:00 AM}
+test clock-4.4 {clock scan tests} {
+    clock format [clock scan "Feb 14, 1992 12:20 PM" -gmt true] \
+      -format {%m/%d/%y %I:%M:%S %p} -gmt true
+} {02/14/92 12:20:00 PM}
+test clock-4.5 {clock scan tests} {
+    clock format \
+      [clock scan "Feb 14, 1992 12:20 PM" -base 319363200 -gmt true] \
+      -format {%m/%d/%y %I:%M:%S %p} -gmt true
+} {02/14/92 12:20:00 PM}
+test clock-4.6 {clock scan tests} {
+    set time [clock scan "Oct 23,1992 15:00"]
+    clock format $time -format {%b %d,%Y %H:%M}
+} {Oct 23,1992 15:00}
+test clock-4.7 {clock scan tests} {
+    set time [clock scan "Oct 23,1992 15:00 GMT"]
+    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
+} {Oct 23,1992 15:00 GMT}
+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} {
+    expr [clock seconds]+1
+    concat {}
+} {}
+test clock-5.2 {clock seconds tests} {
+    list [catch {clock seconds foo} msg] $msg
+} {1 {wrong # args: should be "clock seconds"}}
+test clock-5.3 {clock seconds tests} {
+    set start [clock seconds]
+    after 2000
+    set end [clock seconds]
+    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}
+test clock-6.5 {clock roll over dates} {
+    set time [clock scan "January 1, 2000" -gmt true]
+    clock format $time -format %A -gmt true
+} {Saturday}
+test clock-6.6 {clock roll over dates} {
+    set time [clock scan "January 1, 2000" -gmt true]
+    clock format $time -format %j -gmt true
+} {001}
+test clock-6.7 {clock roll over dates} {
+    set time [clock scan "February 29, 2000" -gmt true]
+    clock format $time -format %A -gmt true
+} {Tuesday}
+test clock-6.8 {clock roll over dates} {
+    set time [clock scan "February 29, 2000" -gmt true]
+    clock format $time -format %j -gmt true
+} {060}
+test clock-6.9 {clock roll over dates} {
+    set time [clock scan "March 1, 2000" -gmt true]
+    clock format $time -format %A -gmt true
+} {Wednesday}
+test clock-6.10 {clock roll over dates} {
+    set time [clock scan "March 1, 2000" -gmt true]
+    clock format $time -format %j -gmt true
+} {061}
+test clock-6.11 {clock roll over dates} {
+    set time [clock scan "March 1, 2001" -gmt true]
+    clock format $time -format %j -gmt true
+} {060}
diff --git a/tcl/tests/cmdAH.test b/tcl/tests/cmdAH.test
new file mode 100644
index 00000000000..65a9451a0ad
--- /dev/null
+++ b/tcl/tests/cmdAH.test
@@ -0,0 +1,1273 @@
+# The file tests the tclCmdAH.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 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+global env
+catch {set platform [testgetplatform]}
+
+test cmdAH-1.1 {Tcl_FileObjCmd} {
+    list [catch file msg] $msg
+} {1 {wrong # args: should be "file option ?arg ...?"}}
+test cmdAH-1.2 {Tcl_FileObjCmd} {
+    list [catch {file x} msg] $msg
+} {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
+
+if {[info commands testsetplatform] == {}} {
+    puts "This application hasn't been compiled with the \"testsetplatform\""
+    puts "command, so I can't test Tcl_FileObjCmd etc."
+} else {
+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-4.2 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    file dirname /a/b
+} /a
+test cmdAH-4.3 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    file dirname {}
+} .
+test cmdAH-4.4 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    file dirname {}
+} :
+test cmdAH-4.5 {Tcl_FileObjCmd: dirname} {
+    testsetplatform win
+    file dirname {}
+} .
+test cmdAH-4.6 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    file dirname .def
+} .
+test cmdAH-4.7 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    file dirname a
+} :
+test cmdAH-4.8 {Tcl_FileObjCmd: dirname} {
+    testsetplatform win
+    file dirname a
+} .
+test cmdAH-4.9 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    file dirname a/b/c.d
+} a/b
+test cmdAH-4.10 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    file dirname a/b.c/d
+} a/b.c
+test cmdAH-4.11 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    file dirname /.
+} /
+test cmdAH-4.12 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname /} msg] $msg
+} {0 /}
+test cmdAH-4.13 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname /foo} msg] $msg
+} {0 /}
+test cmdAH-4.14 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname //foo} msg] $msg
+} {0 /}
+test cmdAH-4.15 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname //foo/bar} msg] $msg
+} {0 /foo}
+test cmdAH-4.16 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname {//foo\/bar/baz}} msg] $msg
+} {0 {/foo\/bar}}
+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-4.18 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname /foo//} msg] $msg
+} {0 /}
+test cmdAH-4.19 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname ./a} msg] $msg
+} {0 .}
+test cmdAH-4.20 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname a/.a} msg] $msg
+} {0 a}
+test cmdAH-4.21 {Tcl_FileObjCmd: dirname} {
+    testsetplatform windows
+    list [catch {file dirname c:foo} msg] $msg
+} {0 c:}
+test cmdAH-4.22 {Tcl_FileObjCmd: dirname} {
+    testsetplatform windows
+    list [catch {file dirname c:} msg] $msg
+} {0 c:}
+test cmdAH-4.23 {Tcl_FileObjCmd: dirname} {
+    testsetplatform windows
+    list [catch {file dirname c:/} msg] $msg
+} {0 c:/}
+test cmdAH-4.24 {Tcl_FileObjCmd: dirname} {
+    testsetplatform windows
+    list [catch {file dirname {c:\foo}} msg] $msg
+} {0 c:/}
+test cmdAH-4.25 {Tcl_FileObjCmd: dirname} {
+    testsetplatform windows
+    list [catch {file dirname {//foo/bar/baz}} msg] $msg
+} {0 //foo/bar}
+test cmdAH-4.26 {Tcl_FileObjCmd: dirname} {
+    testsetplatform windows
+    list [catch {file dirname {//foo/bar}} msg] $msg
+} {0 //foo/bar}
+test cmdAH-4.27 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname :} msg] $msg
+} {0 :}
+test cmdAH-4.28 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname :Foo} msg] $msg
+} {0 :}
+test cmdAH-4.29 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname Foo:} msg] $msg
+} {0 Foo:}
+test cmdAH-4.30 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname Foo:bar} msg] $msg
+} {0 Foo:}
+test cmdAH-4.31 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname :Foo:bar} msg] $msg
+} {0 :Foo}
+test cmdAH-4.32 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname ::} msg] $msg
+} {0 :}
+test cmdAH-4.33 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname :::} msg] $msg
+} {0 ::}
+test cmdAH-4.34 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname /foo/bar/} msg] $msg
+} {0 foo:}
+test cmdAH-4.35 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname /foo/bar} msg] $msg
+} {0 foo:}
+test cmdAH-4.36 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname /foo} msg] $msg
+} {0 foo:}
+test cmdAH-4.37 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname foo} msg] $msg
+} {0 :}
+test cmdAH-4.38 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname ~/foo} msg] $msg
+} {0 ~}
+test cmdAH-4.39 {Tcl_FileObjCmd: dirname} {
+    testsetplatform unix
+    list [catch {file dirname ~bar/foo} msg] $msg
+} {0 ~bar}
+test cmdAH-4.40 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname ~bar/foo} msg] $msg
+} {0 ~bar:}
+test cmdAH-4.41 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname ~/foo} msg] $msg
+} {0 ~:}
+test cmdAH-4.42 {Tcl_FileObjCmd: dirname} {
+    testsetplatform mac
+    list [catch {file dirname ~:baz} msg] $msg
+} {0 ~:}
+test cmdAH-4.43 {Tcl_FileObjCmd: dirname} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform unix
+    set result [list [catch {file dirname ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 /home}
+test cmdAH-4.44 {Tcl_FileObjCmd: dirname} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "~"
+    testsetplatform unix
+    set result [list [catch {file dirname ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 ~}
+test cmdAH-4.45 {Tcl_FileObjCmd: dirname} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform windows
+    set result [list [catch {file dirname ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 /home}
+test cmdAH-4.46 {Tcl_FileObjCmd: dirname} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform mac
+    set result [list [catch {file dirname ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 home:}
+
+# 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-5.2 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail /a/b
+} b
+test cmdAH-5.3 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail {}
+} {}
+test cmdAH-5.4 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail {}
+} {}
+test cmdAH-5.5 {Tcl_FileObjCmd: tail} {
+    testsetplatform win
+    file tail {}
+} {}
+test cmdAH-5.6 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail .def
+} .def
+test cmdAH-5.7 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail a
+} a
+test cmdAH-5.8 {Tcl_FileObjCmd: tail} {
+    testsetplatform win
+    file tail a
+} a
+test cmdAH-5.9 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file ta a/b/c.d
+} c.d
+test cmdAH-5.10 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail a/b.c/d
+} d
+test cmdAH-5.11 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail /.
+} .
+test cmdAH-5.12 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail /
+} {}
+test cmdAH-5.13 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail /foo
+} foo
+test cmdAH-5.14 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail //foo
+} foo
+test cmdAH-5.15 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail //foo/bar
+} bar
+test cmdAH-5.16 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail {//foo\/bar/baz}
+} baz
+test cmdAH-5.17 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail {//foo\/bar/baz/blat}
+} blat
+test cmdAH-5.18 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail /foo//
+} foo
+test cmdAH-5.19 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail ./a
+} a
+test cmdAH-5.20 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail a/.a
+} .a
+test cmdAH-5.21 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail c:foo
+} foo
+test cmdAH-5.22 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail c:
+} {}
+test cmdAH-5.23 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail c:/
+} {}
+test cmdAH-5.24 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail {c:\foo}
+} foo
+test cmdAH-5.25 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail {//foo/bar/baz}
+} baz
+test cmdAH-5.26 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail {//foo/bar}
+} {}
+test cmdAH-5.27 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail :
+} :
+test cmdAH-5.28 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail :Foo
+} Foo
+test cmdAH-5.29 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail Foo:
+} {}
+test cmdAH-5.30 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail Foo:bar
+} bar
+test cmdAH-5.31 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail :Foo:bar
+} bar
+test cmdAH-5.32 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail ::
+} ::
+test cmdAH-5.33 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail :::
+} ::
+test cmdAH-5.34 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail /foo/bar/
+} bar
+test cmdAH-5.35 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail /foo/bar
+} bar
+test cmdAH-5.36 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail /foo
+} {}
+test cmdAH-5.37 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail foo
+} foo
+test cmdAH-5.38 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail ~:foo
+} foo
+test cmdAH-5.39 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail ~bar:foo
+} foo
+test cmdAH-5.40 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail ~bar/foo
+} foo
+test cmdAH-5.41 {Tcl_FileObjCmd: tail} {
+    testsetplatform mac
+    file tail ~/foo
+} foo
+test cmdAH-5.42 {Tcl_FileObjCmd: tail} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform unix
+    set result [file tail ~]
+    set env(HOME) $temp
+    set result
+} test
+test cmdAH-5.43 {Tcl_FileObjCmd: tail} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "~"
+    testsetplatform unix
+    set result [file tail ~]
+    set env(HOME) $temp
+    set result
+} {}
+test cmdAH-5.44 {Tcl_FileObjCmd: tail} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform windows
+    set result [file tail ~]
+    set env(HOME) $temp
+    set result
+} test
+test cmdAH-5.45 {Tcl_FileObjCmd: tail} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform mac
+    set result [file tail ~]
+    set env(HOME) $temp
+    set result
+} test
+test cmdAH-5.46 {Tcl_FileObjCmd: tail} {
+    testsetplatform unix
+    file tail {f.oo\bar/baz.bat}
+} baz.bat
+test cmdAH-5.47 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail c:foo
+} foo
+test cmdAH-5.48 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail c:
+} {}
+test cmdAH-5.49 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail c:/foo
+} foo
+test cmdAH-5.50 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail {c:/foo\bar}
+} bar
+test cmdAH-5.51 {Tcl_FileObjCmd: tail} {
+    testsetplatform windows
+    file tail {foo\bar}
+} bar
+
+# 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-6.2 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname {}
+} {}
+test cmdAH-6.3 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file ro foo
+} foo
+test cmdAH-6.4 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname foo.
+} foo
+test cmdAH-6.5 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname .foo
+} {}
+test cmdAH-6.6 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname abc.def
+} abc
+test cmdAH-6.7 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname abc.def.ghi
+} abc.def
+test cmdAH-6.8 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname a/b/c.d
+} a/b/c
+test cmdAH-6.9 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname a/b.c/d
+} a/b.c/d
+test cmdAH-6.10 {Tcl_FileObjCmd: rootname} {
+    testsetplatform unix
+    file rootname a/b.c/
+} a/b.c/
+test cmdAH-6.11 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file ro foo
+} foo
+test cmdAH-6.12 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname {}
+} {}
+test cmdAH-6.13 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname foo.
+} foo
+test cmdAH-6.14 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname .foo
+} {}
+test cmdAH-6.15 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname abc.def
+} abc
+test cmdAH-6.16 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname abc.def.ghi
+} abc.def
+test cmdAH-6.17 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname a:b:c.d
+} a:b:c
+test cmdAH-6.18 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname a:b.c:d
+} a:b.c:d
+test cmdAH-6.19 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname a/b/c.d
+} a/b/c
+test cmdAH-6.20 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname a/b.c/d
+} a/b.c/d
+test cmdAH-6.21 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname /a.b
+} /a
+test cmdAH-6.22 {Tcl_FileObjCmd: rootname} {
+    testsetplatform mac
+    file rootname foo.c:
+} foo.c:
+test cmdAH-6.23 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname {}
+} {}
+test cmdAH-6.24 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file ro foo
+} foo
+test cmdAH-6.25 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname foo.
+} foo
+test cmdAH-6.26 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname .foo
+} {}
+test cmdAH-6.27 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname abc.def
+} abc
+test cmdAH-6.28 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname abc.def.ghi
+} abc.def
+test cmdAH-6.29 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname a/b/c.d
+} a/b/c
+test cmdAH-6.30 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname a/b.c/d
+} a/b.c/d
+test cmdAH-6.31 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname a\\b.c\\
+} a\\b.c\\
+test cmdAH-6.32 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname a\\b\\c.d
+} a\\b\\c
+test cmdAH-6.33 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname a\\b.c\\d
+} a\\b.c\\d
+test cmdAH-6.34 {Tcl_FileObjCmd: rootname} {
+    testsetplatform windows
+    file rootname a\\b.c\\
+} a\\b.c\\
+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-6.$num {Tcl_FileObjCmd: rootname and extension options} {
+	testsetplatform unix
+	format %s%s [file rootname $thing] [file ext $thing]
+    } $thing
+    set num [expr $num+1]
+  }
+}
+
+# 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-7.2 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension {}
+} {}
+test cmdAH-7.3 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file ext foo
+} {}
+test cmdAH-7.4 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension foo.
+} .
+test cmdAH-7.5 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension .foo
+} .foo
+test cmdAH-7.6 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension abc.def
+} .def
+test cmdAH-7.7 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension abc.def.ghi
+} .ghi
+test cmdAH-7.8 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension a/b/c.d
+} .d
+test cmdAH-7.9 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension a/b.c/d
+} {}
+test cmdAH-7.10 {Tcl_FileObjCmd: extension} {
+    testsetplatform unix
+    file extension a/b.c/
+} {}
+test cmdAH-7.11 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file ext foo
+} {}
+test cmdAH-7.12 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension {}
+} {}
+test cmdAH-7.13 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension foo.
+} .
+test cmdAH-7.14 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension .foo
+} .foo
+test cmdAH-7.15 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension abc.def
+} .def
+test cmdAH-7.16 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension abc.def.ghi
+} .ghi
+test cmdAH-7.17 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension a:b:c.d
+} .d
+test cmdAH-7.18 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension a:b.c:d
+} {}
+test cmdAH-7.19 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension a/b/c.d
+} .d
+test cmdAH-7.20 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension a/b.c/d
+} {}
+test cmdAH-7.21 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension /a.b
+} .b
+test cmdAH-7.22 {Tcl_FileObjCmd: extension} {
+    testsetplatform mac
+    file extension foo.c:
+} {}
+test cmdAH-7.23 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension {}
+} {}
+test cmdAH-7.24 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file ext foo
+} {}
+test cmdAH-7.25 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension foo.
+} .
+test cmdAH-7.26 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension .foo
+} .foo
+test cmdAH-7.27 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension abc.def
+} .def
+test cmdAH-7.28 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension abc.def.ghi
+} .ghi
+test cmdAH-7.29 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension a/b/c.d
+} .d
+test cmdAH-7.30 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension a/b.c/d
+} {}
+test cmdAH-7.31 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension a\\b.c\\
+} {}
+test cmdAH-7.32 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension a\\b\\c.d
+} .d
+test cmdAH-7.33 {Tcl_FileObjCmd: extension} {
+    testsetplatform windows
+    file extension a\\b.c\\d
+} {}
+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-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-8.2 {Tcl_FileObjCmd: pathtype} {
+    testsetplatform unix
+    file pathtype /a
+} absolute
+test cmdAH-8.3 {Tcl_FileObjCmd: pathtype} {
+    testsetplatform unix
+    file p a
+} relative
+test cmdAH-8.4 {Tcl_FileObjCmd: pathtype} {
+    testsetplatform windows
+    file pathtype c:a
+} volumerelative
+
+# 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-9.2 {Tcl_FileObjCmd: split} {
+    testsetplatform unix
+    file split a
+} a
+test cmdAH-9.3 {Tcl_FileObjCmd: split} {
+    testsetplatform unix
+    file split a/b
+} {a b}
+
+# join
+
+test cmdAH-10.1 {Tcl_FileObjCmd: join} {
+    testsetplatform unix
+    file join a
+} a
+test cmdAH-10.2 {Tcl_FileObjCmd: join} {
+    testsetplatform unix
+    file join a b
+} a/b
+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-11.1 {Tcl_FileObjCmd} {
+    testsetplatform unix
+    list [catch {file atime ~_bad_user} msg] $msg
+} {1 {user "_bad_user" doesn't exist}}
+
+testsetplatform $platform
+}
+
+# readable
+
+if {[info commands testchmod] == {}} {
+    puts "This application hasn't been compiled with the \"testchmod\""
+    puts "command, so I can't test Tcl_FileObjCmd etc."
+} else {
+makeFile abcde gorp.file
+makeDirectory dir.file
+
+test cmdAH-12.1 {Tcl_FileObjCmd: readable} {
+    list [catch {file readable a b} msg] $msg
+} {1 {wrong # args: should be "file readable name"}}
+testchmod 444 gorp.file
+test cmdAH-12.2 {Tcl_FileObjCmd: readable} {
+    file readable gorp.file
+} 1
+testchmod 333 gorp.file
+test cmdAH-12.3 {Tcl_FileObjCmd: readable} {unixOnly && !root} {
+    file reada gorp.file
+} 0
+
+# writable
+
+test cmdAH-13.1 {Tcl_FileObjCmd: writable} {
+    list [catch {file writable a b} msg] $msg
+} {1 {wrong # args: should be "file writable name"}}
+testchmod 555 gorp.file
+test cmdAH-13.2 {Tcl_FileObjCmd: writable} {!root} {
+    file writable gorp.file
+} 0
+testchmod 222 gorp.file
+test cmdAH-13.3 {Tcl_FileObjCmd: writable} {
+    file writable gorp.file
+} 1
+
+# executable
+
+file delete -force dir.file gorp.file
+file mkdir dir.file
+makeFile abcde gorp.file
+
+test cmdAH-14.1 {Tcl_FileObjCmd: executable} {
+    list [catch {file executable a b} msg] $msg
+} {1 {wrong # args: should be "file executable name"}}
+test cmdAH-14.2 {Tcl_FileObjCmd: executable} {
+    file executable gorp.file
+} 0
+test cmdAH-14.3 {Tcl_FileObjCmd: executable} {unix} {
+    # Only on unix will setting the execute bit on a regular file
+    # cause that file to be executable.   
+    
+    testchmod 775 gorp.file
+    file exe gorp.file
+} 1
+
+test cmdAH-14.4 {Tcl_FileObjCmd: executable} {mac} {
+    # On mac, the only executable files are of type APPL.
+
+    set x [file exe gorp.file]    
+    file attrib gorp.file -type APPL
+    lappend x [file exe gorp.file]
+} {0 1}
+test cmdAH-14.5 {Tcl_FileObjCmd: executable} {pc} {
+    # On pc, must be a .exe, .com, etc.
+    
+    set x [file exe gorp.file]
+    makeFile foo gorp.exe
+    lappend x [file exe gorp.exe]
+    file delete gorp.exe
+    set x
+} {0 1}
+test cmdAH-14.6 {Tcl_FileObjCmd: executable} {
+    # Directories are always executable.
+    
+    file exe dir.file
+} 1
+
+file delete -force dir.file  
+file delete gorp.file
+file delete link.file
+}
+
+# exists
+
+test cmdAH-15.1 {Tcl_FileObjCmd: exists} {
+    list [catch {file exists a b} msg] $msg
+} {1 {wrong # args: should be "file exists name"}}
+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 {
+    makeFile abcde gorp.file
+    makeDirectory dir.file
+    makeFile 12345 [file join dir.file gorp.file]
+}
+test cmdAH-15.4 {Tcl_FileObjCmd: exists} {
+    file exists gorp.file
+} 1
+test cmdAH-15.5 {Tcl_FileObjCmd: exists} {
+    file exists [file join dir.file gorp.file]
+} 1
+
+# nativename
+if {[info commands testsetplatform] == {}} {
+    puts "This application hasn't been compiled with the \"testsetplatform\""
+    puts "command, so I can't test Tcl_FileObjCmd etc."
+} else {
+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 {}}
+}
+
+test cmdAH-15.9 {Tcl_FileObjCmd: ~ : exists} {
+    file exists ~nOsUcHuSeR
+} 0
+test cmdAH-15.10 {Tcl_FileObjCmd: ~ : nativename} {
+    # should probably be 0 in fact...
+    catch {file nativename ~nOsUcHuSeR}
+} 1
+
+# 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"} {
+    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-15.9 {Tcl_FileObjCmd: exists} {
+	    file exists /tmp/tcl.foo.dir/file
+	} 0
+    }
+    exec chmod 775 /tmp/tcl.foo.dir
+    file delete /tmp/tcl.foo.dir/file
+    removeDirectory /tmp/tcl.foo.dir
+}
+
+# Stat related commands
+
+catch {testsetplatform $platform}
+file delete gorp.file
+makeFile "Test string" gorp.file
+catch {exec chmod 765 gorp.file}
+
+# 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-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-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-17.1 {Tcl_FileObjCmd: isdirectory} {
+    list [catch {file isdirectory a b} msg] $msg
+} {1 {wrong # args: should be "file isdirectory name"}}
+test cmdAH-17.2 {Tcl_FileObjCmd: isdirectory} {
+    file isdirectory gorp.file
+} 0
+test cmdAH-17.3 {Tcl_FileObjCmd: isdirectory} {
+    file isd dir.file
+} 1
+
+# 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-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-19.1 {Tcl_FileObjCmd: lstat} {
+    list [catch {file lstat a} msg] $msg
+} {1 {wrong # args: should be "file lstat name varName"}}
+test cmdAH-19.2 {Tcl_FileObjCmd: lstat} {
+    list [catch {file lstat a b c} msg] $msg
+} {1 {wrong # args: should be "file lstat name varName"}}
+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-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-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-19.6 {Tcl_FileObjCmd: lstat errors} {
+    catch {unset x}
+    set x 44
+    list [catch {file lstat gorp.file x} msg] $msg $errorCode
+} {1 {can't set "x(dev)": variable isn't array} NONE}
+catch {unset stat}
+
+# 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-20.2 {Tcl_FileObjCmd: mtime} {
+    set old [file mtime gorp.file]
+    after 2000
+    set f [open gorp.file w]
+    puts $f "More text"
+    close $f
+    set new [file mtime gorp.file]
+    expr {($new > $old) && ($new <= ($old+5))}
+} {1}
+test cmdAH-20.3 {Tcl_FileObjCmd: mtime} {
+    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-20.4 {Tcl_FileObjCmd: mtime} {
+    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-21.1 {Tcl_FileObjCmd: owned} {
+    list [catch {file owned a b} msg] $msg
+} {1 {wrong # args: should be "file owned name"}}
+test cmdAH-21.2 {Tcl_FileObjCmd: owned} {
+    file owned gorp.file
+} 1
+test cmdAH-21.3 {Tcl_FileObjCmd: owned} {unixOnly && !root} {
+    file owned /
+} 0
+
+# 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-22.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
+    file readlink link.file
+} gorp.file
+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-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-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-23.1 {Tcl_FileObjCmd: size} {
+    list [catch {file size a b} msg] $msg
+} {1 {wrong # args: should be "file size name"}}
+test cmdAH-23.2 {Tcl_FileObjCmd: size} {
+    set oldsize [file size gorp.file]
+    set f [open gorp.file a]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f "More text"
+    close $f
+    expr {[file size gorp.file] - $oldsize}
+} {10}
+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
+
+catch {testsetplatform $platform}
+makeFile "Test string" gorp.file
+catch {exec chmod 765 gorp.file}
+
+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-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-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-24.4 {Tcl_FileObjCmd: stat} {
+    catch {unset stat}
+    file stat gorp.file stat
+    list $stat(nlink) $stat(size) $stat(type)
+} {1 12 file}
+test cmdAH-24.5 {Tcl_FileObjCmd: stat} {unix} {
+    catch {unset stat}
+    file stat gorp.file stat
+    expr $stat(mode)&0777
+} {501}
+test cmdAH-24.6 {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-24.7 {Tcl_FileObjCmd: stat} {
+    catch {unset x}
+    set x 44
+    list [catch {file stat gorp.file x} msg] $msg $errorCode
+} {1 {can't set "x(dev)": variable isn't array} NONE}
+catch {unset stat}
+
+# type
+
+file delete link.file
+
+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-25.2 {Tcl_FileObjCmd: type} {
+    file type dir.file
+} directory
+test cmdAH-25.3 {Tcl_FileObjCmd: type} {
+    file type gorp.file
+} file
+test cmdAH-25.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
+    exec ln -s a/b/c link.file
+    set result [file type link.file]
+    file delete link.file
+    set result
+} link
+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-26.1 {error conditions} {
+    list [catch {file gorp x} msg] $msg
+} {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 {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 {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 {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 {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 {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 {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/tcl/tests/cmdIL.test b/tcl/tests/cmdIL.test
new file mode 100644
index 00000000000..115e0f65c92
--- /dev/null
+++ b/tcl/tests/cmdIL.test
@@ -0,0 +1,295 @@
+# 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.
+# Copyright (c) 1998 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+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, -dictionary option} {
+    lsort -dictionary {1k 0k 10k}
+} {0k 1k 10k}
+test cmdIL-1.10 {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.11 {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.12 {Tcl_LsortObjCmd procedure, -index option} {
+    list [catch {lsort -index foo {1 3 2 5}} msg] $msg
+} {1 {bad index "foo": must be integer or "end"}}
+test cmdIL-1.13 {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.14 {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.15 {Tcl_LsortObjCmd procedure, -integer option} {
+    lsort -integer {24 6 300 18}
+} {6 18 24 300}
+test cmdIL-1.16 {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.17 {Tcl_LsortObjCmd procedure, -real option} {
+    lsort -real {24.2 6e3 150e-1}
+} {150e-1 24.2 6e3}
+test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
+    list [catch {lsort "1 2 3 \{ 4"} msg] $msg
+} {1 {unmatched open brace in list}}
+test cmdIL-1.19 {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 2)
+    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, leading zeros} {
+    lsort -dictionary {00000 000}
+} {000 00000}
+test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} {
+    lsort -dictionary {a321b a03210b}
+} {a321b a03210b}
+test cmdIL-4.7 {DictionaryCompare procedure, numerics, different lengths} {
+    lsort -dictionary {a03210b a321b}
+} {a321b a03210b}
+test cmdIL-4.8 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {48 6a 18b 22a 21aa 35 36}
+} {6a 18b 21aa 22a 35 36 48}
+test cmdIL-4.9 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a123x a123b}
+} {a123b a123x}
+test cmdIL-4.10 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a123b a123x}
+} {a123b a123x}
+test cmdIL-4.11 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b aab}
+} {a1b aab}
+test cmdIL-4.12 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b a!b}
+} {a!b a1b}
+test cmdIL-4.13 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b2c a1b1c}
+} {a1b1c a1b2c}
+test cmdIL-4.14 {DictionaryCompare procedure, numerics} {
+    lsort -dictionary {a1b2c a1b3c}
+} {a1b2c a1b3c}
+test cmdIL-4.15 {DictionaryCompare procedure, long numbers} {
+    lsort -dictionary {a7654884321988762b a7654884321988761b}
+} {a7654884321988761b a7654884321988762b}
+test cmdIL-4.16 {DictionaryCompare procedure, long numbers} {
+    lsort -dictionary {a8765488432198876b a7654884321988761b}
+} {a7654884321988761b a8765488432198876b}
+test cmdIL-4.17 {DictionaryCompare procedure, case} {
+    lsort -dictionary {aBCd abcc}
+} {abcc aBCd}
+test cmdIL-4.18 {DictionaryCompare procedure, case} {
+    lsort -dictionary {aBCd abce}
+} {aBCd abce}
+test cmdIL-4.19 {DictionaryCompare procedure, case} {
+    lsort -dictionary {abcd ABcc}
+} {ABcc abcd}
+test cmdIL-4.20 {DictionaryCompare procedure, case} {
+    lsort -dictionary {abcd ABce}
+} {abcd ABce}
+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}
+test cmdIL-4.23 {DictionaryCompare procedure, case} {
+    lsort -dictionary {ABcd AbCd}
+} {ABcd AbCd}
+test cmdIL-4.24 {DefaultCompare procedure, signed characters} {
+    set l [lsort [list "abc\200" "abc"]]
+    set viewlist {}
+    foreach s $l {
+	set viewelem ""
+	set len [string length $s]
+	for {set i 0} {$i < $len} {incr i} {
+	    set c [string index $s $i]
+	    scan $c %c d
+	    if {$d > 0 && $d < 128} {
+		append viewelem $c
+	    } else {
+		append viewelem "\\[format %03o $d]"
+	    }
+	}
+	lappend viewlist $viewelem
+    }
+    set viewlist
+} [list "abc" "abc\\200"]
+test cmdIL-4.25 {DictionaryCompare procedure, signed characters} {
+    set l [lsort -dictionary [list "abc\200" "abc"]]
+    set viewlist {}
+    foreach s $l {
+	set viewelem ""
+	set len [string length $s]
+	for {set i 0} {$i < $len} {incr i} {
+	    set c [string index $s $i]
+	    scan $c %c d
+	    if {$d > 0 && $d < 128} {
+		append viewelem $c
+	    } else {
+		append viewelem "\\[format %03o $d]"
+	    }
+	}
+	lappend viewlist $viewelem
+    }
+    set viewlist
+} [list "abc" "abc\\200"]
diff --git a/tcl/tests/cmdInfo.test b/tcl/tests/cmdInfo.test
new file mode 100644
index 00000000000..d49da1ef341
--- /dev/null
+++ b/tcl/tests/cmdInfo.test
@@ -0,0 +1,98 @@
+# Commands covered:  none
+#
+# This file contains a collection of tests for Tcl_GetCommandInfo,
+# Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and
+# Tcl_NameOfCommand.  Sourcing this file into Tcl runs the tests
+# and generates output for errors.  No output means no errors were
+# found.
+#
+# Copyright (c) 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.
+#
+# RCS: @(#) $Id$
+
+if {[info commands testcmdinfo] == {}} {
+    puts "This application hasn't been compiled with the \"testcmdinfo\""
+    puts "command, so I can't test Tcl_GetCommandInfo etc."
+    return
+}
+
+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 :: stringProc}
+test cmdinfo-1.2 {command procedure and clientData} {
+    testcmdinfo create x1
+    x1
+} {CmdProc1 original}
+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 :: stringProc}
+test cmdinfo-1.4 {command procedure and clientData} {
+    testcmdinfo create x1
+    testcmdinfo modify x1
+    x1
+} {CmdProc2 new_command_data}
+
+test cmdinfo-2.1 {command deletion callbacks} {
+    testcmdinfo create x1
+    testcmdinfo delete x1
+} {CmdDelProc1 original}
+test cmdinfo-2.2 {command deletion callbacks} {
+    testcmdinfo create x1
+    testcmdinfo modify x1
+    testcmdinfo delete x1
+} {CmdDelProc2 new_delete_data}
+
+test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {
+    testcmdinfo get non_existent
+} {??}
+test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {
+    testcmdinfo create x1
+    testcmdinfo modify x1
+} 1
+test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {
+    testcmdinfo modify non_existent
+} 0
+
+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
+    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/tcl/tests/cmdMZ.test b/tcl/tests/cmdMZ.test
new file mode 100644
index 00000000000..142ab29fd3d
--- /dev/null
+++ b/tcl/tests/cmdMZ.test
@@ -0,0 +1,559 @@
+# The tests in this file cover the procedures in tclCmdMZ.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) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) cmdMZ.test 1.20 98/01/08 18:23:43
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Tcl_PwdObjCmd
+
+test cmdMZ-1.1 {Tcl_PwdObjCmd} {
+    list [catch {pwd a} msg] $msg
+} {1 {wrong # args: should be "pwd"}}
+test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
+    catch pwd
+} 0
+test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
+    expr [string length pwd]>0
+} 1
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly} {
+    file delete -force foo
+    file mkdir foo
+    set cwd [pwd]
+    cd foo
+    file attr . -permissions 000
+    set result [list [catch {pwd} msg] $msg]
+    cd $cwd
+    file delete -force foo
+    set result
+} {1 {error getting working directory name: permission denied}}
+
+# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test
+
+# Tcl_RenameObjCmd
+
+test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
+    list [catch {rename r1} msg] $msg $errorCode
+} {1 {wrong # args: should be "rename oldName newName"} NONE}
+test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
+    list [catch {rename r1 r2 r3} msg] $msg $errorCode
+} {1 {wrong # args: should be "rename oldName newName"} NONE}
+test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
+    catch {rename r2 {}}
+    proc r1 {} {return "r1"}
+    rename r1 r2
+    r2
+} {r1}
+test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
+    proc r1 {} {return "r1"}
+    rename r1 {}
+    list [catch {r1} msg] $msg
+} {1 {invalid command name "r1"}}
+
+# The tests for Tcl_ReturnObjCmd are in proc-old.test
+# The tests for Tcl_ScanObjCmd are in scan.test
+
+# Tcl_SourceObjCmd
+
+test cmdMZ-3.1 {Tcl_SourceObjCmd: error conditions} {macOnly} {
+    list [catch {source} msg] $msg
+} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+test cmdMZ-3.2 {Tcl_SourceObjCmd: error conditions} {macOnly} {
+    list [catch {source a b} msg] $msg
+} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
+    list [catch {source} msg] $msg
+} {1 {wrong # args: should be "source fileName"}}
+test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
+    list [catch {source a b} msg] $msg
+} {1 {wrong # args: should be "source fileName"}}
+test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} {
+    makeFile {
+	set x 146
+	error "error in sourced file"
+	set y $x
+    } source.file
+    list [catch {source source.file} msg] $msg $errorInfo
+} {1 {error in sourced file} {error in sourced file
+    while executing
+"error "error in sourced file""
+    (file "source.file" line 3)
+    invoked from within
+"source source.file"}}
+test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
+    makeFile {list result} source.file
+    source source.file
+} result
+
+# Tcl_SplitObjCmd
+
+test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
+    list [catch split msg] $msg $errorCode
+} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
+    list [catch {split a b c} msg] $msg $errorCode
+} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
+    split "a\n b\t\r c\n "
+} {a {} b {} {} c {} {}}
+test cmdMZ-4.4 {Tcl_SplitObjCmd: basic split commands} {
+    split "word 1xyzword 2zword 3" xyz
+} {{word 1} {} {} {word 2} {word 3}}
+test cmdMZ-4.5 {Tcl_SplitObjCmd: basic split commands} {
+    split "12345" {}
+} {1 2 3 4 5}
+test cmdMZ-4.6 {Tcl_SplitObjCmd: basic split commands} {
+    split "a\}b\[c\{\]\$"
+} "a\\}b\\\[c\\{\\\]\\\$"
+test cmdMZ-4.7 {Tcl_SplitObjCmd: basic split commands} {
+    split {} {}
+} {}
+test cmdMZ-4.8 {Tcl_SplitObjCmd: basic split commands} {
+    split {}
+} {}
+test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
+    split {   }
+} {{} {} {} {}}
+test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
+    proc foo {} {
+        set x {}
+        foreach f [split {]\n} {}] {
+            append x $f
+        }
+        return $x	
+    }
+    foo
+} {]\n}
+test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
+    proc foo {} {
+        set x ab\000c
+        set y [split $x {}]
+        return $y
+    }
+    foo
+} "a b \000 c"
+test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
+    split "a0ab1b2bbb3\000c4" ab\000c
+} {{} 0 {} 1 2 {} {} 3 {} 4}
+test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
+    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
+    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
+} "a b qw\u5e4eN wq"
+
+# Tcl_StringObjCmd
+
+test cmdMZ-5.1 {Tcl_StringObjCmd: error conditions} {
+    list [catch {string} msg] $msg
+} {1 {wrong # args: should be "string option arg ?arg ...?"}}
+test cmdMZ-5.2 {Tcl_StringObjCmd: error conditions} {
+    list [catch {string gorp a b} msg] $msg
+} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+
+test cmdMZ-6.1 {Tcl_StringObjCmd: string compare} {
+    list [catch {string compare a} msg] $msg
+} {1 {wrong # args: should be "string compare string1 string2"}}
+test cmdMZ-6.2 {Tcl_StringObjCmd: string compare} {
+    list [catch {string compare a b c} msg] $msg
+} {1 {wrong # args: should be "string compare string1 string2"}}
+test cmdMZ-6.3 {Tcl_StringObjCmd: string compare} {
+    string compare abcde abdef
+} -1
+test cmdMZ-6.4 {Tcl_StringObjCmd: string compare} {
+    string c abcde ABCDE
+} 1
+test cmdMZ-6.5 {Tcl_StringObjCmd: string compare} {
+    string compare abcde abcde
+} 0
+test cmdMZ-6.6 {Tcl_StringObjCmd: string compare} {
+    string compare ab abcde
+} -1
+test cmdMZ-6.7 {Tcl_StringObjCmd: string compare} {
+    string compare abcde ab
+} 1
+test cmdMZ-6.8 {Tcl_StringObjCmd: string compare} {
+    string compare cde ab
+} 1
+test cmdMZ-6.9 {Tcl_StringObjCmd: string compare} {
+    string compare ab cde
+} -1
+test cmdMZ-6.10 {Tcl_StringObjCmd: string compare, unicode} {
+    string compare ab\u7266 ab\u7267
+} -1
+test cmdMZ-6.11 {Tcl_StringObjCmd: string compare, high bit} {
+    # This test will fail if the underlying comparaison
+    # is using signed chars instead of unsigned chars.
+    # (like SunOS's default memcmp thus the compat/memcmp.c)
+    string compare "\x80" "@"
+    # Nb this tests works also in utf8 space because \x80 is
+    # translated into a 2 or more bytes but whose first byte has
+    # the high bit set.
+} 1
+
+test cmdMZ-7.1 {Tcl_StringObjCmd: string first} {
+    list [catch {string first a} msg] $msg
+} {1 {wrong # args: should be "string first string1 string2"}}
+test cmdMZ-7.2 {Tcl_StringObjCmd: string first} {
+    list [catch {string first a b c} msg] $msg
+} {1 {wrong # args: should be "string first string1 string2"}}
+test cmdMZ-7.3 {Tcl_StringObjCmd: string first} {
+    string first bq abcdefgbcefgbqrs
+} 12
+test cmdMZ-7.4 {Tcl_StringObjCmd: string first} {
+    string fir bcd abcdefgbcefgbqrs
+} 1
+test cmdMZ-7.5 {Tcl_StringObjCmd: string first} {
+    string f b abcdefgbcefgbqrs
+} 1
+test cmdMZ-7.6 {Tcl_StringObjCmd: string first} {
+    string first xxx x123xx345xxx789xxx012
+} 9
+test cmdMZ-7.7 {Tcl_StringObjCmd: string first} {
+    string first "" x123xx345xxx789xxx012
+} -1
+test cmdMZ-7.8 {Tcl_StringObjCmd: string first, unicode} {
+    string first x abc\u7266x
+} 4
+test cmdMZ-7.9 {Tcl_StringObjCmd: string first, unicode} {
+    string first \u7266 abc\u7266x
+} 3
+
+test cmdMZ-8.1 {Tcl_StringObjCmd: string index} {
+    list [catch {string index} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test cmdMZ-8.2 {Tcl_StringObjCmd: string index} {
+    list [catch {string index a b c} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test cmdMZ-8.3 {Tcl_StringObjCmd: string index} {
+    list [catch {string index a xyz} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test cmdMZ-8.4 {Tcl_StringObjCmd: string index} {
+    string index abcde 0
+} a
+test cmdMZ-8.5 {Tcl_StringObjCmd: string index} {
+    string i abcde 4
+} e
+test cmdMZ-8.6 {Tcl_StringObjCmd: string index} {
+    string index abcde 5
+} {}
+test cmdMZ-8.7 {Tcl_StringObjCmd: string index} {
+    list [catch {string index abcde -10} msg] $msg
+} {0 {}}
+test cmdMZ-8.8 {Tcl_StringObjCmd: string index, unicode} {
+    string index abc\u7266d 4
+} d
+test cmdMZ-8.9 {Tcl_StringObjCmd: string index, unicode} {
+    string index abc\u7266d 3
+} \u7266
+
+test cmdMZ-9.1 {Tcl_StringObjCmd: string last} {
+    list [catch {string last a} msg] $msg
+} {1 {wrong # args: should be "string last string1 string2"}}
+test cmdMZ-9.2 {Tcl_StringObjCmd: string last} {
+    list [catch {string last a b c} msg] $msg
+} {1 {wrong # args: should be "string last string1 string2"}}
+test cmdMZ-9.3 {Tcl_StringObjCmd: string last} {
+    string la xxx xxxx123xx345x678
+} 1
+test cmdMZ-9.4 {Tcl_StringObjCmd: string last} {
+    string last xx xxxx123xx345x678
+} 7
+test cmdMZ-9.5 {Tcl_StringObjCmd: string last} {
+    string las x xxxx123xx345x678
+} 12
+test cmdMZ-9.6 {Tcl_StringObjCmd: string last, unicode} {
+    string las x xxxx12\u7266xx345x678
+} 12
+test cmdMZ-9.7 {Tcl_StringObjCmd: string last, unicode} {
+    string las \u7266 xxxx12\u7266xx345x678
+} 6
+
+test cmdMZ-10.1 {Tcl_StringObjCmd: string length} {
+    list [catch {string length} msg] $msg
+} {1 {wrong # args: should be "string length string"}}
+test cmdMZ-10.2 {Tcl_StringObjCmd: string length} {
+    list [catch {string length a b} msg] $msg
+} {1 {wrong # args: should be "string length string"}}
+test cmdMZ-10.3 {Tcl_StringObjCmd: string length} {
+    string length "a little string"
+} 15
+test cmdMZ-10.4 {Tcl_StringObjCmd: string length} {
+    string le ""
+} 0
+test cmdMZ-10.5 {Tcl_StringObjCmd: string length, unicode} {
+    string le "abcd\u7266"
+} 5
+
+test cmdMZ-11.1 {Tcl_StringObjCmd: string match} {
+    list [catch {string match a} msg] $msg
+} {1 {wrong # args: should be "string match pattern string"}}
+test cmdMZ-11.2 {Tcl_StringObjCmd: string match} {
+    list [catch {string match a b c} msg] $msg
+} {1 {wrong # args: should be "string match pattern string"}}
+test cmdMZ-11.3 {Tcl_StringObjCmd: string match} {
+    string match abc abc
+} 1
+test cmdMZ-11.4 {Tcl_StringObjCmd: string match} {
+    string m abc abd
+} 0
+
+test cmdMZ-12.1 {Tcl_StringObjCmd: string range} {
+    list [catch {string range} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test cmdMZ-12.2 {Tcl_StringObjCmd: string range} {
+    list [catch {string range a 1} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test cmdMZ-12.3 {Tcl_StringObjCmd: string range} {
+    list [catch {string range a 1 2 3} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test cmdMZ-12.4 {Tcl_StringObjCmd: string range} {
+    list [catch {string range abc abc 1} msg] $msg
+} {1 {bad index "abc": must be integer or "end"}}
+test cmdMZ-12.5 {Tcl_StringObjCmd: string range} {
+    list [catch {string range abc 1 eof} msg] $msg
+} {1 {bad index "eof": must be integer or "end"}}
+test cmdMZ-12.6 {Tcl_StringObjCmd: string range, first < 0} {
+    string range abcdefghijklmnop -3 2
+} {abc}
+test cmdMZ-12.7 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop 2 14
+} {cdefghijklmno}
+test cmdMZ-12.8 {Tcl_StringObjCmd: string range, last > length} {
+    string range abcdefghijklmnop 7 1000
+} {hijklmnop}
+test cmdMZ-12.9 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop 10 e
+} {klmnop}
+test cmdMZ-12.10 {Tcl_StringObjCmd: string range, last < first} {
+    string range abcdefghijklmnop 10 9
+} {}
+test cmdMZ-12.11 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop -3 -2
+} {}
+test cmdMZ-12.12 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop 1000 1010
+} {}
+test cmdMZ-12.13 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop -100 end
+} {abcdefghijklmnop}
+test cmdMZ-12.14 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop end end
+} {p}
+test cmdMZ-12.15 {Tcl_StringObjCmd: string range} {
+    string range abcdefghijklmnop e 1000
+} {p}
+test cmdMZ-12.16 {Tcl_StringObjCmd: string range, unicode} {
+    string range ab\u7266cdefghijklmnop 5 5
+} e
+test cmdMZ-12.17 {Tcl_StringObjCmd: string range, unicode} {
+    string range ab\u7266cdefghijklmnop 2 3
+} \u7266c
+
+test cmdMZ-13.1 {Tcl_StringObjCmd: string tolower} {
+    list [catch {string tolower} msg] $msg
+} {1 {wrong # args: should be "string tolower string"}}
+test cmdMZ-13.2 {Tcl_StringObjCmd: string tolower} {
+    list [catch {string tolower a b} msg] $msg
+} {1 {wrong # args: should be "string tolower string"}}
+test cmdMZ-13.3 {Tcl_StringObjCmd: string tolower} {
+    string tolower ABCDeF
+} {abcdef}
+test cmdMZ-13.4 {Tcl_StringObjCmd: string tolower} {
+    string tolower "ABC  XyZ"
+} {abc  xyz}
+test cmdMZ-13.5 {Tcl_StringObjCmd: string tolower} {
+    string tolower {123#$&*()}
+} {123#$&*()}
+test cmdMZ-13.6 {Tcl_StringObjCmd: string tolower, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string tolower ABCabc\xc7\xe7]
+    restore_locale
+    set result
+} "abcabc\xe7\xe7"
+
+test cmdMZ-14.1 {Tcl_StringObjCmd: string toupper} {
+    list [catch {string toupper} msg] $msg
+} {1 {wrong # args: should be "string toupper string"}}
+test cmdMZ-14.2 {Tcl_StringObjCmd: string toupper} {
+    list [catch {string toupper a b} msg] $msg
+} {1 {wrong # args: should be "string toupper string"}}
+test cmdMZ-14.3 {Tcl_StringObjCmd: string toupper} {
+    string toupper abCDEf
+} {ABCDEF}
+test cmdMZ-14.4 {Tcl_StringObjCmd: string toupper} {
+    string toupper "abc xYz"
+} {ABC XYZ}
+test cmdMZ-14.5 {Tcl_StringObjCmd: string toupper} {
+    string toupper {123#$&*()}
+} {123#$&*()}
+test cmdMZ-14.6 {Tcl_StringObjCmd: string toupper, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string toupper ABCabc\xc7\xe7]
+    restore_locale
+    set result
+} "ABCABC\xc7\xc7"
+
+test cmdMZ-15.1 {Tcl_StringObjCmd: string trim} {
+    list [catch {string trim} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+test cmdMZ-15.2 {Tcl_StringObjCmd: string trim} {
+    list [catch {string trim a b c} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+test cmdMZ-15.3 {Tcl_StringObjCmd: string trim} {
+    string trim "    XYZ      "
+} {XYZ}
+test cmdMZ-15.4 {Tcl_StringObjCmd: string trim} {
+    string trim "\t\nXYZ\t\n\r\n"
+} {XYZ}
+test cmdMZ-15.5 {Tcl_StringObjCmd: string trim} {
+    string trim "  A XYZ A    "
+} {A XYZ A}
+test cmdMZ-15.6 {Tcl_StringObjCmd: string trim} {
+    string trim "XXYYZZABC XXYYZZ" ZYX
+} {ABC }
+test cmdMZ-15.7 {Tcl_StringObjCmd: string trim} {
+    string trim "    \t\r      "
+} {}
+test cmdMZ-15.8 {Tcl_StringObjCmd: string trim} {
+    string trim {abcdefg} {}
+} {abcdefg}
+test cmdMZ-15.9 {Tcl_StringObjCmd: string trim} {
+    string trim {}
+} {}
+test cmdMZ-15.10 {Tcl_StringObjCmd: string trim} {
+    string trim ABC DEF
+} {ABC}
+test cmdMZ-15.11 {Tcl_StringObjCmd: string trim, unicode} {
+    string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
+} " AB\xe7C "
+
+test cmdMZ-16.1 {Tcl_StringObjCmd: string trimleft} {
+    string trimleft "    XYZ      "
+} {XYZ      }
+test cmdMZ-16.2 {Tcl_StringObjCmd: string trimleft} {
+    list [catch {string trimleft} msg] $msg
+} {1 {wrong # args: should be "string trimleft string ?chars?"}}
+test cmdMZ-16.3 {Tcl_StringObjCmd: string trimleft} {
+    string length [string trimleft " "]
+} {0}
+
+test cmdMZ-17.1 {Tcl_StringObjCmd: string trimright} {
+    string trimright "    XYZ      "
+} {    XYZ}
+test cmdMZ-17.2 {Tcl_StringObjCmd: string trimright} {
+    string trimright "   "
+} {}
+test cmdMZ-17.3 {Tcl_StringObjCmd: string trimright} {
+    string trimright ""
+} {}
+test cmdMZ-17.4 {Tcl_StringObjCmd: string trimright errors} {
+    list [catch {string trimright} msg] $msg
+} {1 {wrong # args: should be "string trimright string ?chars?"}}
+test cmdMZ-17.5 {Tcl_StringObjCmd: string trimright errors} {
+    list [catch {string trimg a} msg] $msg
+} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+
+test cmdMZ-18.1 {Tcl_StringObjCmd: string wordend} {
+    list [catch {string wordend a} msg] $msg
+} {1 {wrong # args: should be "string wordend string index"}}
+test cmdMZ-18.2 {Tcl_StringObjCmd: string wordend} {
+    list [catch {string wordend a b c} msg] $msg
+} {1 {wrong # args: should be "string wordend string index"}}
+test cmdMZ-18.3 {Tcl_StringObjCmd: string wordend} {
+    list [catch {string wordend a gorp} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test cmdMZ-18.4 {Tcl_StringObjCmd: string wordend} {
+    string wordend abc. -1
+} 3
+test cmdMZ-18.5 {Tcl_StringObjCmd: string wordend} {
+    string wordend abc. 100
+} 4
+test cmdMZ-18.6 {Tcl_StringObjCmd: string wordend} {
+    string wordend "word_one two three" 2
+} 8
+test cmdMZ-18.7 {Tcl_StringObjCmd: string wordend} {
+    string wordend "one .&# three" 5
+} 6
+test cmdMZ-18.8 {Tcl_StringObjCmd: string wordend} {
+    string worde "x.y" 0
+} 1
+test cmdMZ-18.9 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string wordend "xyz\u00c7de fg" 0]
+    restore_locale
+    set result
+} 6
+test cmdMZ-18.10 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string wordend "xyz\uc700de fg" 0]
+    restore_locale
+    set result
+} 3
+test cmdMZ-18.11 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string wordend "xyz\uc700de fg" 0]
+    restore_locale
+    set result
+} 3
+test cmdMZ-18.12 {Tcl_StringObjCmd: string wordend, unicode} {
+    string wordend "\uc700\uc700 abc" 8
+} 6
+
+test cmdMZ-19.1 {Tcl_StringObjCmd: string wordstart} {
+    list [catch {string word a} msg] $msg
+} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
+test cmdMZ-19.2 {Tcl_StringObjCmd: string wordstart} {
+    list [catch {string wordstart a} msg] $msg
+} {1 {wrong # args: should be "string wordstart string index"}}
+test cmdMZ-19.3 {Tcl_StringObjCmd: string wordstart} {
+    list [catch {string wordstart a b c} msg] $msg
+} {1 {wrong # args: should be "string wordstart string index"}}
+test cmdMZ-19.4 {Tcl_StringObjCmd: string wordstart} {
+    list [catch {string wordstart a gorp} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test cmdMZ-19.5 {Tcl_StringObjCmd: string wordstart} {
+    string wordstart "one two three_words" 400
+} 8
+test cmdMZ-19.6 {Tcl_StringObjCmd: string wordstart} {
+    string wordstart "one two three_words" 2
+} 0
+test cmdMZ-19.7 {Tcl_StringObjCmd: string wordstart} {
+    string wordstart "one two three_words" -2
+} 0
+test cmdMZ-19.8 {Tcl_StringObjCmd: string wordstart} {
+    string wordstart "one .*&^ three" 6
+} 6
+test cmdMZ-19.9 {Tcl_StringObjCmd: string wordstart} {
+    string wordstart "one two three" 4
+} 4
+test cmdMZ-19.10 {Tcl_StringObjCmd: string wordstart, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string wordstart "one tw\u00c7o three" 7]
+    restore_locale
+    set result
+} 4
+test cmdMZ-19.11 {Tcl_StringObjCmd: string wordstart, unicode} {hasIsoLocale} {
+    set_iso8859_1_locale
+    set result [string wordstart "ab\uc700\uc700 cdef ghi" 12]
+    restore_locale
+    set result
+} 10
+test cmdMZ-19.12 {Tcl_StringObjCmd: string wordstart, unicode} {
+    string wordstart "\uc700\uc700 abc" 8
+} 3
+
+# The tests for Tcl_SubstObjCmd are in subst.test
+# The tests for Tcl_SwitchObjCmd are in switch.test
+# There are no tests for Tcl_TimeObjCmd
+# The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test
+# The tests for Tcl_WhileObjCmd are in while.test
+
+return
diff --git a/tcl/tests/compile.test b/tcl/tests/compile.test
new file mode 100644
index 00000000000..a245084007c
--- /dev/null
+++ b/tcl/tests/compile.test
@@ -0,0 +1,179 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 {TclCompileString: look up cmds in proc ns, not current ns} {
+    catch {namespace delete test_ns_compile}
+    catch {unset x}
+    set x 123
+    namespace eval test_ns_compile {
+        proc set {args} {
+            global x
+            lappend x test_ns_compile::set
+        }
+        proc p {} {
+            set 0
+        }
+    }
+    list [test_ns_compile::p] [set x]
+} {{123 test_ns_compile::set} {123 test_ns_compile::set}}
+test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} {
+    proc p {x} {info commands 3m}
+    list [catch {p} msg] $msg
+} {1 {no value given for parameter "x" to "p"}}
+
+test compile-2.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-2.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-2.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-2.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-3.2 {TclCompileCatchCmd: non-local variables} {
+    set ::foo 1
+    proc catch-test {} {
+	catch {set x 3} ::foo
+    }
+    catch-test
+    set ::foo
+} 3
+
+
+test compile-1.16 {TclCompileForCmd: command substituted test expression} {
+    set i 0
+    set j 0
+    # Should be "forever"
+    for {} [expr $i < 3] {} {
+	set j [incr i]
+	if {$j > 3} break
+    }
+    set j
+} {4}
+
+test compile-3.1 {TclCompileForeachCmd: exception stack} {
+    proc foreach-exception-test {} {
+	foreach array(index) [list 1 2 3] break
+	foreach array(index) [list 1 2 3] break
+	foreach scalar [list 1 2 3] break
+    }
+    list [catch foreach-exception-test result] $result
+} {0 {}}
+test compile-3.2 {TclCompileForeachCmd: non-local variables} {
+    set ::foo 1
+    proc foreach-test {} {
+	foreach ::foo {1 2 3} {}
+    }
+    foreach-test
+    set ::foo
+} 3
+
+test compile-4.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-4.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-4.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-1.15 {TclCompileWhileCmd: command substituted test expression} {
+    set i 0
+    set j 0
+    # Should be "forever"
+    while [expr $i < 3] {
+	set j [incr i]
+	if {$j > 3} break
+    }
+    set j
+} {4}
+
+test compile-5.1 {CollectArgInfo: binary data} {
+    list [catch "string length \000foo" msg] $msg
+} {0 4}
+test compile-5.2 {CollectArgInfo: binary data} {
+    list [catch "string length foo\000" msg] $msg
+} {0 4}
+test compile-5.3 {CollectArgInfo: handle "]" at end of command properly} {
+    set x ]
+} {]}
+
+test compile-6.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}
+
+return
diff --git a/tcl/tests/concat.test b/tcl/tests/concat.test
new file mode 100644
index 00000000000..94ae3668682
--- /dev/null
+++ b/tcl/tests/concat.test
@@ -0,0 +1,46 @@
+# Commands covered:  concat
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test concat-1.1 {simple concatenation} {
+    concat a b c d e f g
+} {a b c d e f g}
+test concat-1.2 {merging lists together} {
+    concat a {b c d} {e f g h}
+} {a b c d e f g h}
+test concat-1.3 {merge lists, retain sub-lists} {
+    concat a {b {c d}} {{e f}} g h
+} {a b {c d} {e f} g h}
+test concat-1.4 {special characters} {
+    concat a\{ {b \{c d} \{d
+} "a{ b \\{c d {d"
+
+test concat-2.1 {error: one empty argument} {
+    concat {}
+} {}
+
+test concat-3.1 {error: no arguments} {
+    list [catch concat msg] $msg
+} {0 {}}
+
+test concat-4.1 {pruning off extra white space} {
+    concat {} {a b c}
+} {a b c}
+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/tcl/tests/dcall.test b/tcl/tests/dcall.test
new file mode 100644
index 00000000000..050df35bbdc
--- /dev/null
+++ b/tcl/tests/dcall.test
@@ -0,0 +1,40 @@
+# Commands covered:  none
+#
+# This file contains a collection of tests for Tcl_CallWhenDeleted.
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors.  No output means no errors were found.
+#
+# Copyright (c) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[info commands testdcall] == {}} {
+    puts "This application hasn't been compiled with the \"testdcall\""
+    puts "command, so I can't test Tcl_CallWhenDeleted."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test dcall-1.1 {deletion callbacks} {
+    lsort -increasing [testdcall 1 2 3]
+} {1 2 3}
+test dcall-1.2 {deletion callbacks} {
+    testdcall
+} {}
+test dcall-1.3 {deletion callbacks} {
+    lsort -increasing [testdcall 20 21 22 -22]
+} {20 21}
+test dcall-1.4 {deletion callbacks} {
+    lsort -increasing [testdcall 20 21 22 -20]
+} {21 22}
+test dcall-1.5 {deletion callbacks} {
+    lsort -increasing [testdcall 20 21 22 -21]
+} {20 22}
+test dcall-1.6 {deletion callbacks} {
+    lsort -increasing [testdcall 20 21 22 -21 -22 -20]
+} {}
diff --git a/tcl/tests/dstring.test b/tcl/tests/dstring.test
new file mode 100644
index 00000000000..7a308049f88
--- /dev/null
+++ b/tcl/tests/dstring.test
@@ -0,0 +1,248 @@
+# Commands covered:  none
+#
+# This file contains a collection of tests for Tcl's dynamic string
+# library procedures.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[info commands testdstring] == {}} {
+    puts "This application hasn't been compiled with the \"testdstring\""
+    puts "command, so I can't test Tcl_DStringAppend et al."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test dstring-1.1 {appending and retrieving} {
+    testdstring free
+    testdstring append "abc" -1
+    list [testdstring get] [testdstring length]
+} {abc 3}
+test dstring-1.2 {appending and retrieving} {
+    testdstring free
+    testdstring append "abc" -1
+    testdstring append " xyzzy" 3
+    testdstring append " 12345" -1
+    list [testdstring get] [testdstring length]
+} {{abc xy 12345} 12}
+test dstring-1.3 {appending and retrieving} {
+    testdstring free
+    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
+    }
+    list [testdstring get] [testdstring length]
+} {{aaaaaaaaaaaaaaaaaaaaa
+bbbbbbbbbbbbbbbbbbbbb
+ccccccccccccccccccccc
+ddddddddddddddddddddd
+eeeeeeeeeeeeeeeeeeeee
+fffffffffffffffffffff
+ggggggggggggggggggggg
+hhhhhhhhhhhhhhhhhhhhh
+iiiiiiiiiiiiiiiiiiiii
+jjjjjjjjjjjjjjjjjjjjj
+kkkkkkkkkkkkkkkkkkkkk
+lllllllllllllllllllll
+mmmmmmmmmmmmmmmmmmmmm
+nnnnnnnnnnnnnnnnnnnnn
+ooooooooooooooooooooo
+ppppppppppppppppppppp
+} 352}
+
+test dstring-2.1 {appending list elements} {
+    testdstring free
+    testdstring element "abc"
+    testdstring element "d e f"
+    list [testdstring get] [testdstring length]
+} {{abc {d e f}} 11}
+test dstring-2.2 {appending list elements} {
+    testdstring free
+    testdstring element "x"
+    testdstring element "\{"
+    testdstring element "ab\}"
+    testdstring get
+} {x \{ ab\}}
+test dstring-2.3 {appending list elements} {
+    testdstring free
+    foreach l {a b c d e f g h i j k l m n o p} {
+	testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l
+    }
+    testdstring get
+} {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
+test dstring-2.4 {appending list elements} {
+    testdstring free
+    testdstring append "a\{" -1
+    testdstring element abc
+    testdstring append "	\{" -1
+    testdstring element xyzzy
+    testdstring get
+} "a{ abc	{xyzzy"
+test dstring-2.5 {appending list elements} {
+    testdstring free
+    testdstring append " \{" -1
+    testdstring element abc
+    testdstring get
+} " {abc"
+test dstring-2.6 {appending list elements} {
+    testdstring free
+    testdstring append " " -1
+    testdstring element abc
+    testdstring get
+} { abc}
+test dstring-2.7 {appending list elements} {
+    testdstring free
+    testdstring append "\\ " -1
+    testdstring element abc
+    testdstring get
+} "\\  abc"
+test dstring-2.8 {appending list elements} {
+    testdstring free
+    testdstring append "x " -1
+    testdstring element abc
+    testdstring get
+} {x abc}
+
+test dstring-3.1 {nested sublists} {
+    testdstring free
+    testdstring start
+    testdstring element foo
+    testdstring element bar
+    testdstring end
+    testdstring element another
+    testdstring get
+} {{foo bar} another}
+test dstring-3.2 {nested sublists} {
+    testdstring free
+    testdstring start
+    testdstring start
+    testdstring element abc
+    testdstring element def
+    testdstring end
+    testdstring end
+    testdstring element ghi
+    testdstring get
+} {{{abc def}} ghi}
+test dstring-3.3 {nested sublists} {
+    testdstring free
+    testdstring start
+    testdstring start
+    testdstring start
+    testdstring element foo
+    testdstring element foo2
+    testdstring end
+    testdstring end
+    testdstring element foo3
+    testdstring end
+    testdstring element foo4
+    testdstring get
+} {{{{foo foo2}} foo3} foo4}
+test dstring-3.4 {nested sublists} {
+    testdstring free
+    testdstring element before
+    testdstring start
+    testdstring element during
+    testdstring element more
+    testdstring end
+    testdstring element last
+    testdstring get
+} {before {during more} last}
+test dstring-3.5 {nested sublists} {
+    testdstring free
+    testdstring element "\{"
+    testdstring start
+    testdstring element first
+    testdstring element second
+    testdstring end
+    testdstring get
+} {\{ {first second}}
+
+test dstring-4.1 {truncation} {
+    testdstring free
+    testdstring append "abcdefg" -1
+    testdstring trunc 3
+    list [testdstring get] [testdstring length]
+} {abc 3}
+test dstring-4.2 {truncation} {
+    testdstring free
+    testdstring append "xyzzy" -1
+    testdstring trunc 0
+    list [testdstring get] [testdstring length]
+} {{} 0}
+
+test dstring-5.1 {copying to result} {
+    testdstring free
+    testdstring append xyz -1
+    testdstring 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
+    }
+    set a [testdstring result]
+    testdstring append abc -1
+    list $a [testdstring get]
+} {{aaaaaaaaaaaaaaaaaaaaa
+bbbbbbbbbbbbbbbbbbbbb
+ccccccccccccccccccccc
+ddddddddddddddddddddd
+eeeeeeeeeeeeeeeeeeeee
+fffffffffffffffffffff
+ggggggggggggggggggggg
+hhhhhhhhhhhhhhhhhhhhh
+iiiiiiiiiiiiiiiiiiiii
+jjjjjjjjjjjjjjjjjjjjj
+kkkkkkkkkkkkkkkkkkkkk
+lllllllllllllllllllll
+mmmmmmmmmmmmmmmmmmmmm
+nnnnnnnnnnnnnnnnnnnnn
+ooooooooooooooooooooo
+ppppppppppppppppppppp
+} abc}
+
+test dstring-6.1 {Tcl_DStringGetResult} {
+    testdstring free
+    list [testdstring gresult staticsmall] [testdstring get]
+} {{} short}
+test dstring-6.2 {Tcl_DStringGetResult} {
+    testdstring free
+    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
+    }
+    list [testdstring gresult staticsmall] [testdstring get]
+} {{} short}
+test dstring-6.3 {Tcl_DStringGetResult} {
+    set result {}
+    lappend result [testdstring gresult staticlarge]
+    testdstring append x 1
+    lappend result [testdstring get]
+} {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
+second0 second1 second2 second3 second4 second5 second6 second7 second8 second9
+third0 third1 third2 third3 third4 third5 third6 third7 third8 third9
+fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9
+fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9
+sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9
+seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9
+x}}
+test dstring-6.4 {Tcl_DStringGetResult} {
+    set result {}
+    lappend result [testdstring gresult free]
+    testdstring append y 1
+    lappend result [testdstring get]
+} {{} {This is a malloc-ed stringy}}
+test dstring-6.5 {Tcl_DStringGetResult} {
+    set result {}
+    lappend result [testdstring gresult special]
+    testdstring append z 1
+    lappend result [testdstring get]
+} {{} {This is a specially-allocated stringz}}
+
+testdstring free
diff --git a/tcl/tests/env.test b/tcl/tests/env.test
new file mode 100644
index 00000000000..cecb2ba28e4
--- /dev/null
+++ b/tcl/tests/env.test
@@ -0,0 +1,152 @@
+# Commands covered:  none (tests environment variable implementation)
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+#
+# These tests will run on any platform (and indeed crashed
+# on the Mac).  So put them before you test for the existance
+# of exec.
+#
+test env-1.1 {propagation of env values to child interpreters} {
+    catch {interp delete child}
+    catch {unset env(test)}
+    interp create child
+    set env(test) garbage
+    set return [child eval {set env(test)}]
+    interp delete child
+    unset env(test)
+    set return
+} {garbage}
+#
+# This one crashed on Solaris under Tcl8.0, so we only
+# want to make sure it runs.
+#
+test env-1.2 {lappend to env value} {
+    catch {unset env(test)}
+    set env(test) aaaaaaaaaaaaaaaa
+    append env(test) bbbbbbbbbbbbbb
+    unset env(test)
+} {}    
+if {[info commands exec] == ""} {
+    puts "exec not implemented for this machine"
+    return
+}
+
+if {$tcl_platform(os) == "Win32s"} {
+    puts "Cannot run multiple copies of tcl at the same time under Win32s"
+    return
+}
+   
+set f [open printenv w]
+puts $f {
+    proc lrem {listname name} {
+	upvar $listname list
+	set i [lsearch $list $name]
+	if {$i >= 0} {
+	    set list [lreplace $list $i $i]
+	}
+	return $list
+    }
+	
+    set names [lsort [array names env]]
+    if {$tcl_platform(platform) == "windows"} {
+	lrem names HOME
+        lrem names COMSPEC
+	lrem names ComSpec
+	lrem names ""
+    }	
+    foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH SHLIB_PATH} {
+	lrem names $name
+    }
+    foreach p $names {
+	puts "$p=$env($p)"
+    }
+}
+close $f
+	
+proc getenv {} {
+    global printenv tcltest
+    catch {exec $tcltest printenv} out
+    if {$out == "child process exited abnormally"} {
+	set out {}
+    }
+    return $out
+}
+
+# Save the current environment variables at the start of the test.
+
+foreach name [array names env] {
+    set env2($name) $env($name)
+    unset env($name)
+}
+
+# Added the following lines so that child tcltest can actually find its
+# library if the initial tcltest is run from a non-standard place.
+# ('saved' env vars)
+foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH SHLIB_PATH} {
+  if {[info exists env2($name)]} {
+     set env($name) $env2($name);
+  }
+}
+
+test env-2.1 {adding environment variables} {
+    getenv
+} {}
+
+set env(NAME1) "test string"
+test env-2.2 {adding environment variables} {
+    getenv
+} {NAME1=test string}
+
+set env(NAME2) "more"
+test env-2.3 {adding environment variables} {
+    getenv
+} {NAME1=test string
+NAME2=more}
+
+set env(XYZZY) "garbage"
+test env-2.4 {adding environment variables} {
+    getenv
+} {NAME1=test string
+NAME2=more
+XYZZY=garbage}
+
+set env(NAME2) "new value"
+test env-3.1 {changing environment variables} {
+    getenv
+} {NAME1=test string
+NAME2=new value
+XYZZY=garbage}
+
+unset env(NAME2)
+test env-4.1 {unsetting environment variables} {
+    getenv
+} {NAME1=test string
+XYZZY=garbage}
+unset env(NAME1)
+test env-4.2 {unsetting environment variables} {
+    getenv
+} {XYZZY=garbage}
+
+# Restore the environment variables at the end of the test.
+
+foreach name [array names env] {
+    unset env($name)
+}
+foreach name [array names env2] {
+    set env($name) $env2($name)
+}
+
+file delete printenv
diff --git a/tcl/tests/error.test b/tcl/tests/error.test
new file mode 100644
index 00000000000..df8bb608f0d
--- /dev/null
+++ b/tcl/tests/error.test
@@ -0,0 +1,175 @@
+# Commands covered:  error, catch
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+proc foo {} {
+    global errorInfo
+    set a [catch {format [error glorp2]} b]
+    error {Human-generated}
+}
+
+proc foo2 {} {
+    global errorInfo
+    set a [catch {format [error glorp2]} b]
+    error {Human-generated} $errorInfo
+}
+
+# Catch errors occurring in commands and errors from "error" command
+
+test error-1.1 {simple errors from commands} {
+    catch {format [string compare]} b
+} 1
+
+test error-1.2 {simple errors from commands} {
+    catch {format [string compare]} b
+    set b
+} {wrong # args: should be "string compare string1 string2"}
+
+test error-1.3 {simple errors from commands} {
+    catch {format [string compare]} b
+    set errorInfo
+} {wrong # args: should be "string compare string1 string2"
+    while executing
+"string compare"}
+
+test error-1.4 {simple errors from commands} {
+    catch {error glorp} b
+} 1
+
+test error-1.5 {simple errors from commands} {
+    catch {error glorp} b
+    set b
+} glorp
+
+test error-1.6 {simple errors from commands} {
+    catch {catch a b c} b
+} 1
+
+test error-1.7 {simple errors from commands} {
+    catch {catch a b c} b
+    set b
+} {wrong # args: should be "catch command ?varName?"}
+
+test error-1.8 {simple errors from commands} {nonPortable} {
+    # This test is non-portable: it generates a memory fault on
+    # machines like DEC Alphas (infinite recursion overflows
+    # stack?)
+
+    proc p {} {
+        uplevel 1 catch p error
+    }
+    p
+} 0
+
+# Check errors nested in procedures.  Also check the optional argument
+# to "error" to generate a new error trace.
+
+test error-2.1 {errors in nested procedures} {
+    catch foo b
+} 1
+
+test error-2.2 {errors in nested procedures} {
+    catch foo b
+    set b
+} {Human-generated}
+
+test error-2.3 {errors in nested procedures} {
+    catch foo b
+    set errorInfo
+} {Human-generated
+    while executing
+"error {Human-generated}"
+    (procedure "foo" line 4)
+    invoked from within
+"foo"}
+
+test error-2.4 {errors in nested procedures} {
+    catch foo2 b
+} 1
+
+test error-2.5 {errors in nested procedures} {
+    catch foo2 b
+    set b
+} {Human-generated}
+
+test error-2.6 {errors in nested procedures} {
+    catch foo2 b
+    set errorInfo
+} {glorp2
+    while executing
+"error glorp2"
+    (procedure "foo2" line 3)
+    invoked from within
+"foo2"}
+
+# Error conditions related to "catch".
+
+test error-3.1 {errors in catch command} {
+    list [catch {catch} msg] $msg
+} {1 {wrong # args: should be "catch command ?varName?"}}
+test error-3.2 {errors in catch command} {
+    list [catch {catch a b c} msg] $msg
+} {1 {wrong # args: should be "catch command ?varName?"}}
+test error-3.3 {errors in catch command} {
+    catch {unset a}
+    set a(0) 22
+    list [catch {catch {format 44} a} msg] $msg
+} {1 {couldn't save command result in variable}}
+catch {unset a}
+
+# More tests related to errorInfo and errorCode
+
+test error-4.1 {errorInfo and errorCode variables} {
+    list [catch {error msg1 msg2 msg3} msg] $msg $errorInfo $errorCode
+} {1 msg1 msg2 msg3}
+test error-4.2 {errorInfo and errorCode variables} {
+    list [catch {error msg1 {} msg3} msg] $msg $errorInfo $errorCode
+} {1 msg1 {msg1
+    while executing
+"error msg1 {} msg3"} msg3}
+test error-4.3 {errorInfo and errorCode variables} {
+    list [catch {error msg1 {}} msg] $msg $errorInfo $errorCode
+} {1 msg1 {msg1
+    while executing
+"error msg1 {}"} NONE}
+test error-4.4 {errorInfo and errorCode variables} {
+    set errorCode bogus
+    list [catch {error msg1} msg] $msg $errorInfo $errorCode
+} {1 msg1 {msg1
+    while executing
+"error msg1"} NONE}
+test error-4.5 {errorInfo and errorCode variables} {
+    set errorCode bogus
+    list [catch {error msg1 msg2 {}} msg] $msg $errorInfo $errorCode
+} {1 msg1 msg2 {}}
+
+# Errors in error command itself
+
+test error-5.1 {errors in error command} {
+    list [catch {error} msg] $msg
+} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
+test error-5.2 {errors in error command} {
+    list [catch {error a b c d} msg] $msg
+} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
+
+# Make sure that catch resets error information
+
+test error-6.1 {catch must reset error state} {
+    catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]}
+    list $errorCode $errorInfo
+} {NONE 1}
+
+catch {rename p ""}
+return ""
diff --git a/tcl/tests/eval.test b/tcl/tests/eval.test
new file mode 100644
index 00000000000..74064e6fdb8
--- /dev/null
+++ b/tcl/tests/eval.test
@@ -0,0 +1,55 @@
+# Commands covered:  eval
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test eval-1.1 {single argument} {
+    eval {format 22}
+} 22
+test eval-1.2 {multiple arguments} {
+    set a {$b}
+    set b xyzzy
+    eval format $a
+} xyzzy
+test eval-1.3 {single argument} {
+    eval concat a b c d e f g
+} {a b c d e f g}
+
+test eval-2.1 {error: not enough arguments} {catch eval} 1
+test eval-2.2 {error: not enough arguments} {
+    catch eval msg
+    set msg
+} {wrong # args: should be "eval arg ?arg ...?"}
+test eval-2.3 {error in eval'ed command} {
+    catch {eval {error "test error"}}
+} 1
+test eval-2.4 {error in eval'ed command} {
+    catch {eval {error "test error"}} msg
+    set msg
+} {test error}
+test eval-2.5 {error in eval'ed command: setting errorInfo} {
+    catch {eval {
+	set a 1
+	error "test error"
+    }} msg
+    set errorInfo
+} "test error
+    while executing
+\"error \"test error\"\"
+    (\"eval\" body line 3)
+    invoked from within
+\"eval {
+	set a 1
+	error \"test error\"
+    }\""
diff --git a/tcl/tests/event.test b/tcl/tests/event.test
new file mode 100644
index 00000000000..3beb69d05e7
--- /dev/null
+++ b/tcl/tests/event.test
@@ -0,0 +1,567 @@
+# This file contains a collection of tests for the procedures in the file
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {[catch {testfilehandler create 0 off off}] == 0 } {
+    test event-1.1 {Tcl_CreateFileHandler, reading} {
+	testfilehandler close
+	testfilehandler create 0 readable off
+	testfilehandler clear 0
+	testfilehandler oneevent
+	set result ""
+	lappend result [testfilehandler counts 0]
+	testfilehandler fillpartial 0
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 0]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 0]
+	testfilehandler close
+	set result
+    } {{0 0} {1 0} {2 0}}
+    test event-1.2 {Tcl_CreateFileHandler, writing} {nonPortable} {
+	# This test is non-portable because on some systems (e.g.
+	# SunOS 4.1.3) pipes seem to be writable always.
+	testfilehandler close
+	testfilehandler create 0 off writable
+	testfilehandler clear 0
+	testfilehandler oneevent
+	set result ""
+	lappend result [testfilehandler counts 0]
+	testfilehandler fillpartial 0
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 0]
+	testfilehandler fill 0
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 0]
+	testfilehandler close
+	set result
+    } {{0 1} {0 2} {0 2}}
+    test event-1.3 {Tcl_DeleteFileHandler} {nonPortable} {
+	testfilehandler close
+	testfilehandler create 2 disabled disabled
+	testfilehandler create 1 readable writable
+	testfilehandler create 0 disabled disabled
+	testfilehandler fillpartial 1
+	set result ""
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler create 1 off off
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler close
+	set result
+    } {{0 1} {1 1} {1 2} {0 0}}
+
+    test event-2.1 {Tcl_DeleteFileHandler} {nonPortable} {
+	testfilehandler close
+	testfilehandler create 2 disabled disabled
+	testfilehandler create 1 readable writable
+	testfilehandler fillpartial 1
+	set result ""
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler create 1 off off
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler close
+	set result
+    } {{0 1} {1 1} {1 2} {0 0}}
+    test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} {nonPortable} {
+	testfilehandler close
+	testfilehandler create 0 readable writable
+	testfilehandler fillpartial 0
+	set result ""
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 0]
+	testfilehandler close
+	testfilehandler create 0 readable writable
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 0]
+	testfilehandler close
+	set result
+    } {{0 1} {0 0}}
+
+    test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {
+	testfilehandler close
+	testfilehandler create 1 readable writable
+	testfilehandler fillpartial 1
+	testfilehandler windowevent
+	set result [testfilehandler counts 1]
+	testfilehandler close
+	set result
+    } {0 0}
+
+    test event-4.1 {FileHandlerEventProc, race between event and disabling} {nonPortable} {
+	update
+	testfilehandler close
+	testfilehandler create 2 disabled disabled
+	testfilehandler create 1 readable writable
+	testfilehandler fillpartial 1
+	set result ""
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler create 1 disabled disabled
+	testfilehandler oneevent
+	lappend result [testfilehandler counts 1]
+	testfilehandler close
+	set result
+    } {{0 1} {1 1} {1 2} {0 0}}
+    test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} {nonPortable} {
+	update
+	testfilehandler close
+	testfilehandler create 1 readable writable
+	testfilehandler create 2 readable writable
+	testfilehandler fillpartial 1
+	testfilehandler fillpartial 2
+	testfilehandler oneevent
+	set result ""
+	lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+	testfilehandler windowevent
+	lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+	testfilehandler close
+	set result
+    } {{0 0} {0 1} {0 0} {0 1}}
+    testfilehandler close
+    update
+}
+
+test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
+    catch {rename bgerror {}}
+    proc bgerror msg {
+	global errorInfo errorCode x
+	lappend x [list $msg $errorInfo $errorCode]
+    }
+    after idle {error "a simple error"}
+    after idle {open non_existent}
+    after idle {set errorInfo foobar; set errorCode xyzzy}
+    set x {}
+    update idletasks
+    rename bgerror {}
+    set x
+} {{{a simple error} {a simple error
+    while executing
+"error "a simple error""
+    ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
+    while executing
+"open non_existent"
+    ("after" script)} {POSIX ENOENT {no such file or directory}}}}
+test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
+    catch {rename bgerror {}}
+    proc bgerror msg {
+	global x
+	lappend x $msg
+	return -code break
+    }
+    after idle {error "a simple error"}
+    after idle {open non_existent}
+    set x {}
+    update idletasks
+    rename bgerror {}
+    set x
+} {{a simple error}}
+
+test event-6.1 {BgErrorDeleteProc procedure} {
+    catch {interp delete foo}
+    interp create foo
+    foo eval {
+	proc bgerror args {
+	    global errorInfo
+	    set f [open err.out r+]
+	    seek $f 0 end
+	    puts $f "$args $errorInfo"
+	    close $f
+	}
+	after 100 {error "first error"}
+	after 100 {error "second error"}
+    }
+    makeFile Unmodified err.out
+    after 100 {interp delete foo}
+    after 200
+    update
+    set f [open err.out r]
+    set result [read $f]
+    close $f
+    removeFile err.out
+    set result
+} {Unmodified
+}
+
+test event-7.1 {bgerror / regular} {
+    set errRes {}
+    proc bgerror {err} {
+	global errRes;
+	set errRes $err;
+    }
+    after 0 {error err1}
+    vwait errRes;
+    set errRes;
+} err1
+
+test event-7.2 {bgerror / accumulation} {
+    set errRes {}
+    proc bgerror {err} {
+	global errRes;
+	lappend errRes $err;
+    }
+    after 0 {error err1}
+    after 0 {error err2}
+    after 0 {error err3}
+    update
+    set errRes;
+} {err1 err2 err3}
+
+test event-7.3 {bgerror / accumulation / break} {
+    set errRes {}
+    proc bgerror {err} {
+	global errRes;
+	lappend errRes $err;
+	return -code break "skip!";
+    }
+    after 0 {error err1}
+    after 0 {error err2}
+    after 0 {error err3}
+    update
+    set errRes;
+} err1
+
+test event-7.4 {tkerror is nothing special anymore to tcl} {
+    set errRes {}
+    # we don't just rename bgerror to empty because it could then
+    # be autoloaded...
+    proc bgerror {err} {
+	global errRes;
+	lappend errRes "bg:$err";
+    }
+    proc tkerror {err} {
+	global errRes;
+	lappend errRes "tk:$err";
+    }
+    after 0 {error err1}
+    update
+    rename tkerror {}
+    set errRes
+} bg:err1
+
+# someday : add a test checking that 
+# when there is no bgerror, an error msg goes to stderr
+# ideally one would use sub interp and transfer a fake stderr
+# to it, unfortunatly the current interp tcl API does not allow
+# that. the other option would be to use fork a test but it
+# then becomes more a file/exec test than a bgerror test.
+
+# end of bgerror tests
+catch {rename bgerror {}}
+
+
+if {[info commands testexithandler] != ""} {
+    test event-8.1 {Tcl_CreateExitHandler procedure} {stdio} {
+	set child [open |[list [info nameofexecutable]] r+]
+	puts $child "testexithandler create 41; testexithandler create 4"
+	puts $child "testexithandler create 6; exit"
+	flush $child
+	set result [read $child]
+	close $child
+	set result
+    } {even 6
+even 4
+odd 41
+}
+
+    test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio} {
+	set child [open |[list [info nameofexecutable]] r+]
+	puts $child "testexithandler create 41; testexithandler create 4"
+	puts $child "testexithandler create 6; testexithandler delete 41"
+	puts $child "testexithandler create 16; exit"
+	flush $child
+	set result [read $child]
+	close $child
+	set result
+    } {even 16
+even 6
+even 4
+}
+    test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio} {
+	set child [open |[list [info nameofexecutable]] r+]
+	puts $child "testexithandler create 41; testexithandler create 4"
+	puts $child "testexithandler create 6; testexithandler delete 4"
+	puts $child "testexithandler create 16; exit"
+	flush $child
+	set result [read $child]
+	close $child
+	set result
+    } {even 16
+even 6
+odd 41
+}
+    test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio} {
+	set child [open |[list [info nameofexecutable]] r+]
+	puts $child "testexithandler create 41; testexithandler create 4"
+	puts $child "testexithandler create 6; testexithandler delete 6"
+	puts $child "testexithandler create 16; exit"
+	flush $child
+	set result [read $child]
+	close $child
+	set result
+    } {even 16
+even 4
+odd 41
+}
+    test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio} {
+	set child [open |[list [info nameofexecutable]] r+]
+	puts $child "testexithandler create 41; testexithandler delete 41"
+	puts $child "testexithandler create 16; exit"
+	flush $child
+	set result [read $child]
+	close $child
+	set result
+    } {even 16
+}
+}
+
+test event-10.1 {Tcl_Exit procedure} {stdio} {
+    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-11.1 {Tcl_VwaitCmd procedure} {
+    list [catch {vwait} msg] $msg
+} {1 {wrong # args: should be "vwait name"}}
+test event-11.2 {Tcl_VwaitCmd procedure} {
+    list [catch {vwait a b} msg] $msg
+} {1 {wrong # args: should be "vwait name"}}
+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
+    }
+    after 10; update; # On Mac make sure update won't take long
+    after 100 {set x x-done}
+    after 200 {set y y-done}
+    after 300 {set z z-done}
+    after idle {set q q-done}
+    set x before
+    set y before
+    set z before
+    set q before
+    list [vwait y] $x $y $z $q
+} {{} x-done y-done before q-done}
+
+foreach i [after info] {
+    after cancel $i
+}
+
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
+    set f1 [open test1 w]
+    proc accept {s args} {
+	puts $s foobar
+	close $s
+    }
+    set s1 [socket -server accept 5001]
+    set s2 [socket 127.0.0.1 5001]
+    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-12.2 {Tcl_UpdateCmd procedure} {
+    list [catch {update bogus} msg] $msg
+} {1 {bad option "bogus": must be idletasks}}
+test event-12.3 {Tcl_UpdateCmd procedure} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    after 500 {set x after}
+    after idle {set y after}
+    after idle {set z "after, y = $y"}
+    set x before
+    set y before
+    set z before
+    update idletasks
+    list $x $y $z
+} {before after {after, y = after}}
+test event-12.4 {Tcl_UpdateCmd procedure} {
+    foreach i [after info] {
+	after cancel $i
+    }
+    after 10; update; # On Mac make sure update won't take long
+    after 200 {set x x-done}
+    after 600 {set y y-done}
+    after idle {set z z-done}
+    set x before
+    set y before
+    set z before
+    after 300
+    update
+    list $x $y $z
+} {x-done before z-done}
+
+if {[info commands testfilehandler] != ""} {
+    test event-13.1 {Tcl_WaitForFile procedure, readable} unixOnly {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 set x timeout
+	testfilehandler close
+	testfilehandler create 1 off off
+	set x "no timeout"
+	set result [testfilehandler wait 1 readable 0]
+	update
+	testfilehandler close
+	list $result $x
+    } {{} {no timeout}}
+    test event-13.2 {Tcl_WaitForFile procedure, readable} unixOnly {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 set x timeout
+	testfilehandler close
+	testfilehandler create 1 off off
+	set x "no timeout"
+	set result [testfilehandler wait 1 readable 100]
+	update
+	testfilehandler close
+	list $result $x
+    } {{} timeout}
+    test event-13.3 {Tcl_WaitForFile procedure, readable} unixOnly {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 set x timeout
+	testfilehandler close
+	testfilehandler create 1 off off
+	testfilehandler fillpartial 1
+	set x "no timeout"
+	set result [testfilehandler wait 1 readable 100]
+	update
+	testfilehandler close
+	list $result $x
+    } {readable {no timeout}}
+    test event-13.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 set x timeout
+	testfilehandler close
+	testfilehandler create 1 off off
+	testfilehandler fill 1
+	set x "no timeout"
+	set result [testfilehandler wait 1 writable 0]
+	update
+	testfilehandler close
+	list $result $x
+    } {{} {no timeout}}
+    test event-13.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 set x timeout
+	testfilehandler close
+	testfilehandler create 1 off off
+	testfilehandler fill 1
+	set x "no timeout"
+	set result [testfilehandler wait 1 writable 100]
+	update
+	testfilehandler close
+	list $result $x
+    } {{} timeout}
+    test event-13.6 {Tcl_WaitForFile procedure, writable} unixOnly {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 set x timeout
+	testfilehandler close
+	testfilehandler create 1 off off
+	set x "no timeout"
+	set result [testfilehandler wait 1 writable 100]
+	update
+	testfilehandler close
+	list $result $x
+    } {writable {no timeout}}
+    test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly {
+	foreach i [after info] {
+	    after cancel $i
+	}
+	after 100 lappend x timeout
+	after idle lappend x idle
+	testfilehandler close
+	testfilehandler create 1 off off
+	set x ""
+	set result [list [testfilehandler wait 1 readable 200] $x]
+	update
+	testfilehandler close
+	lappend result $x
+    } {{} {} {timeout idle}}
+}
+
+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]
+	lappend result [testfilewait $f readable -1]
+	close $f
+	set result
+    } {{} readable}
+}
+
+foreach i [after info] {
+    after cancel $i
+}
diff --git a/tcl/tests/exec.test b/tcl/tests/exec.test
new file mode 100644
index 00000000000..c82b0de289d
--- /dev/null
+++ b/tcl/tests/exec.test
@@ -0,0 +1,557 @@
+# Commands covered:  exec
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# If exec is not defined just return with no error
+# Some platforms like the Macintosh do not have the exec command
+if {[info commands exec] == ""} {
+    puts "exec not implemented for this machine"
+    return
+}
+if {$testConfig(stdio) == 0} {
+    return
+}
+
+set f [open echo w]
+puts $f {
+    puts -nonewline [lindex $argv 0]
+    foreach str [lrange $argv 1 end] {
+	puts -nonewline " $str"
+    }
+    puts {}
+}
+close $f
+
+set f [open cat w]
+puts $f {
+    if {$argv == {}} {
+	set argv -
+    }
+    foreach name $argv {
+	if {$name == "-"} {
+	    set f stdin
+	} elseif {[catch {open $name r} f] != 0} {
+	    puts stderr $f
+	    continue
+	}
+	while {[eof $f] == 0} {
+	    puts -nonewline [read $f]
+	}
+	if {$f != "stdin"} {
+	    close $f
+	}
+    }
+}
+close $f
+
+set f [open wc w]
+puts $f {
+    set data [read stdin]
+    set lines [regsub -all "\n" $data {} dummy]
+    set words [regsub -all "\[^ \t\n]+" $data {} dummy]
+    set chars [string length $data]
+    puts [format "%8.d%8.d%8.d" $lines $words $chars]
+}
+close $f
+
+set f [open sh w]
+puts $f {
+    if {[lindex $argv 0] != "-c"} {
+	error "sh: unexpected arguments $argv"
+    }
+    set cmd [lindex $argv 1]
+    lappend cmd ";"
+
+    set newcmd {}
+    
+    foreach arg $cmd {
+	if {$arg == ";"} {
+	    eval exec >@stdout 2>@stderr [list [info nameofexecutable]] $newcmd
+	    set newcmd {}
+	    continue
+	}
+	if {$arg == "1>&2"} {
+	    set arg >@stderr
+	}
+	lappend newcmd $arg
+    }
+}
+close $f
+
+set f [open sleep w]
+puts $f {
+    after [expr $argv*1000]
+}
+close $f
+
+set f [open exit w]
+puts $f {
+    exit $argv
+}
+close $f
+
+# Basic operations.
+
+test exec-1.1 {basic exec operation} {
+    exec $tcltest echo a b c
+} "a b c"
+test exec-1.2 {pipelining} {
+    exec $tcltest echo a b c d | $tcltest cat | $tcltest cat
+} "a b c d"
+test exec-1.3 {pipelining} {
+    set a [exec $tcltest echo a b c d | $tcltest cat | $tcltest wc]
+    list [scan $a "%d %d %d" b c d] $b $c
+} {3 1 4}
+set arg {12345678901234567890123456789012345678901234567890}
+set arg "$arg$arg$arg$arg$arg$arg"
+test exec-1.4 {long command lines} {
+    exec $tcltest echo $arg
+} $arg
+set arg {}
+
+# I/O redirection: input from Tcl command.
+
+test exec-2.1 {redirecting input from immediate source} {
+    exec $tcltest cat << "Sample text"
+} {Sample text}
+test exec-2.2 {redirecting input from immediate source} {
+    exec << "Sample text" $tcltest cat | $tcltest cat
+} {Sample text}
+test exec-2.3 {redirecting input from immediate source} {
+    exec $tcltest cat << "Sample text" | $tcltest cat
+} {Sample text}
+test exec-2.4 {redirecting input from immediate source} {
+    exec $tcltest cat | $tcltest cat << "Sample text"
+} {Sample text}
+test exec-2.5 {redirecting input from immediate source} {
+    exec $tcltest cat "<<Joined to arrows"
+} {Joined to arrows}
+
+# I/O redirection: output to file.
+
+file delete gorp.file
+test exec-3.1 {redirecting output to file} {
+    exec $tcltest echo "Some simple words" > gorp.file
+    exec $tcltest cat gorp.file
+} "Some simple words"
+test exec-3.2 {redirecting output to file} {
+    exec $tcltest echo "More simple words" | >gorp.file $tcltest cat | $tcltest cat
+    exec $tcltest cat gorp.file
+} "More simple words"
+test exec-3.3 {redirecting output to file} {
+    exec > gorp.file $tcltest echo "Different simple words" | $tcltest cat | $tcltest cat
+    exec $tcltest cat gorp.file
+} "Different simple words"
+test exec-3.4 {redirecting output to file} {
+    exec $tcltest echo "Some simple words" >gorp.file
+    exec $tcltest cat gorp.file
+} "Some simple words"
+test exec-3.5 {redirecting output to file} {
+    exec $tcltest echo "First line" >gorp.file
+    exec $tcltest echo "Second line" >> gorp.file
+    exec $tcltest cat gorp.file
+} "First line\nSecond line"
+test exec-3.6 {redirecting output to file} {
+    exec $tcltest echo "First line" >gorp.file
+    exec $tcltest echo "Second line" >>gorp.file
+    exec $tcltest cat gorp.file
+} "First line\nSecond line"
+test exec-3.7 {redirecting output to file} {
+    set f [open gorp.file w]
+    puts $f "Line 1"
+    flush $f
+    exec $tcltest echo "More text" >@ $f
+    exec $tcltest echo >@$f "Even more"
+    puts $f "Line 3"
+    close $f
+    exec $tcltest cat gorp.file
+} "Line 1\nMore text\nEven more\nLine 3"
+
+# I/O redirection: output and stderr to file.
+
+file delete gorp.file
+test exec-4.1 {redirecting output and stderr to file} {
+    exec $tcltest echo "test output" >& gorp.file
+    exec $tcltest cat gorp.file
+} "test output"
+test exec-4.2 {redirecting output and stderr to file} {
+    list [exec $tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \
+	    [exec $tcltest cat gorp.file]
+} {{} {foo bar}}
+test exec-4.3 {redirecting output and stderr to file} {
+    exec $tcltest echo "first line" > gorp.file
+    list [exec $tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \
+	    [exec $tcltest cat gorp.file]
+} "{} {first line\nfoo bar}"
+test exec-4.4 {redirecting output and stderr to file} {
+    set f [open gorp.file w]
+    puts $f "Line 1"
+    flush $f
+    exec $tcltest echo "More text" >&@ $f
+    exec $tcltest echo >&@$f "Even more"
+    puts $f "Line 3"
+    close $f
+    exec $tcltest cat gorp.file
+} "Line 1\nMore text\nEven more\nLine 3"
+test exec-4.5 {redirecting output and stderr to file} {
+    set f [open gorp.file w]
+    puts $f "Line 1"
+    flush $f
+    exec >&@ $f $tcltest sh -c "echo foo bar 1>&2"
+    exec >&@$f $tcltest sh -c "echo xyzzy 1>&2"
+    puts $f "Line 3"
+    close $f
+    exec $tcltest cat gorp.file
+} "Line 1\nfoo bar\nxyzzy\nLine 3"
+
+# I/O redirection: input from file.
+
+exec $tcltest echo "Just a few thoughts" > gorp.file
+test exec-5.1 {redirecting input from file} {
+    exec $tcltest cat < gorp.file
+} {Just a few thoughts}
+test exec-5.2 {redirecting input from file} {
+    exec $tcltest cat | $tcltest cat < gorp.file
+} {Just a few thoughts}
+test exec-5.3 {redirecting input from file} {
+    exec $tcltest cat < gorp.file | $tcltest cat
+} {Just a few thoughts}
+test exec-5.4 {redirecting input from file} {
+    exec < gorp.file $tcltest cat | $tcltest cat
+} {Just a few thoughts}
+test exec-5.5 {redirecting input from file} {
+    exec $tcltest cat <gorp.file
+} {Just a few thoughts}
+test exec-5.6 {redirecting input from file} {
+    set f [open gorp.file r]
+    set result [exec $tcltest cat <@ $f]
+    close $f
+    set result
+} {Just a few thoughts}
+test exec-5.7 {redirecting input from file} {
+    set f [open gorp.file r]
+    set result [exec <@$f $tcltest cat]
+    close $f
+    set result
+} {Just a few thoughts}
+
+# I/O redirection: standard error through a pipeline.
+
+test exec-6.1 {redirecting stderr through a pipeline} {
+    exec $tcltest sh -c "echo foo bar" |& $tcltest cat
+} "foo bar"
+test exec-6.2 {redirecting stderr through a pipeline} {
+    exec $tcltest sh -c "echo foo bar 1>&2" |& $tcltest cat
+} "foo bar"
+test exec-6.3 {redirecting stderr through a pipeline} {
+    exec $tcltest sh -c "echo foo bar 1>&2" \
+	|& $tcltest sh -c "echo second msg 1>&2 ; cat" |& $tcltest cat
+} "second msg\nfoo bar"
+
+# I/O redirection: combinations.
+
+catch {exec rm -f gorp.file2}
+test exec-7.1 {multiple I/O redirections} {
+    exec << "command input" > gorp.file2 $tcltest cat < gorp.file
+    exec $tcltest cat gorp.file2
+} {Just a few thoughts}
+test exec-7.2 {multiple I/O redirections} {
+    exec < gorp.file << "command input" $tcltest cat
+} {command input}
+
+# Long input to command and output from command.
+
+set a "0123456789 xxxxxxxxx abcdefghi ABCDEFGHIJK\n"
+set a [concat $a $a $a $a]
+set a [concat $a $a $a $a]
+set a [concat $a $a $a $a]
+set a [concat $a $a $a $a]
+test exec-8.1 {long input and output} {
+    exec $tcltest cat << $a
+} $a
+
+# Commands that return errors.
+
+test exec-9.1 {commands returning errors} {
+    set x [catch {exec gorp456} msg]
+    list $x [string tolower $msg] [string tolower $errorCode]
+} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
+test exec-9.2 {commands returning errors} {
+    string tolower [list [catch {exec $tcltest 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} {
+    list [catch {exec $tcltest sleep 1 | $tcltest exit 43 | $tcltest sleep 1} msg] $msg
+} {1 {child process exited abnormally}}
+test exec-9.4 {commands returning errors} {
+    list [catch {exec $tcltest exit 43 | $tcltest echo "foo bar"} msg] $msg
+} {1 {foo bar
+child process exited abnormally}}
+test exec-9.5 {commands returning errors} {
+    list [catch {exec gorp456 | $tcltest 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} {
+    list [catch {exec $tcltest sh -c "echo error msg 1>&2"} msg] $msg
+} {1 {error msg}}
+test exec-9.7 {commands returning errors} {
+    list [catch {exec $tcltest sh -c "echo error msg 1>&2" \
+		     | $tcltest sh -c "echo error msg 1>&2"} msg] $msg
+} {1 {error msg
+error msg}}
+
+# Errors in executing the Tcl command, as opposed to errors in the
+# processes that are invoked.
+
+test exec-10.1 {errors in exec invocation} {
+    list [catch {exec} msg] $msg
+} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
+test exec-10.2 {errors in exec invocation} {
+    list [catch {exec | cat} msg] $msg
+} {1 {illegal use of | or |& in command}}
+test exec-10.3 {errors in exec invocation} {
+    list [catch {exec cat |} msg] $msg
+} {1 {illegal use of | or |& in command}}
+test exec-10.4 {errors in exec invocation} {
+    list [catch {exec cat | | cat} msg] $msg
+} {1 {illegal use of | or |& in command}}
+test exec-10.5 {errors in exec invocation} {
+    list [catch {exec cat | |& cat} msg] $msg
+} {1 {illegal use of | or |& in command}}
+test exec-10.6 {errors in exec invocation} {
+    list [catch {exec cat |&} msg] $msg
+} {1 {illegal use of | or |& in command}}
+test exec-10.7 {errors in exec invocation} {
+    list [catch {exec cat <} msg] $msg
+} {1 {can't specify "<" as last word in command}}
+test exec-10.8 {errors in exec invocation} {
+    list [catch {exec cat >} msg] $msg
+} {1 {can't specify ">" as last word in command}}
+test exec-10.9 {errors in exec invocation} {
+    list [catch {exec cat <<} msg] $msg
+} {1 {can't specify "<<" as last word in command}}
+test exec-10.10 {errors in exec invocation} {
+    list [catch {exec cat >>} msg] $msg
+} {1 {can't specify ">>" as last word in command}}
+test exec-10.11 {errors in exec invocation} {
+    list [catch {exec cat >&} msg] $msg
+} {1 {can't specify ">&" as last word in command}}
+test exec-10.12 {errors in exec invocation} {
+    list [catch {exec cat >>&} msg] $msg
+} {1 {can't specify ">>&" as last word in command}}
+test exec-10.13 {errors in exec invocation} {
+    list [catch {exec cat >@} msg] $msg
+} {1 {can't specify ">@" as last word in command}}
+test exec-10.14 {errors in exec invocation} {
+    list [catch {exec cat <@} msg] $msg
+} {1 {can't specify "<@" as last word in command}}
+test exec-10.15 {errors in exec invocation} {
+    list [catch {exec cat < a/b/c} msg] [string tolower $msg]
+} {1 {couldn't read file "a/b/c": no such file or directory}}
+test exec-10.16 {errors in exec invocation} {
+    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
+} {1 {couldn't write file "a/b/c": no such file or directory}}
+test exec-10.17 {errors in exec invocation} {
+    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
+} {1 {couldn't write file "a/b/c": no such file or directory}}
+set f [open gorp.file w]
+test exec-10.18 {errors in exec invocation} {
+    list [catch {exec cat <@ $f} msg] $msg
+} "1 {channel \"$f\" wasn't opened for reading}"
+close $f
+set f [open gorp.file r]
+test exec-10.19 {errors in exec invocation} {
+    list [catch {exec cat >@ $f} msg] $msg
+} "1 {channel \"$f\" wasn't opened for writing}"
+close $f
+test exec-10.20 {errors in exec invocation} {
+    list [catch {exec ~non_existent_user/foo/bar} msg] $msg
+} {1 {user "non_existent_user" doesn't exist}}
+test exec-10.21 {errors in exec invocation} {
+    list [catch {exec $tcltest true | ~xyzzy_bad_user/x | false} msg] $msg
+} {1 {user "xyzzy_bad_user" doesn't exist}}
+
+# Commands in background.
+
+test exec-11.1 {commands in background} {
+    set x [lindex [time {exec $tcltest sleep 2 &}] 0]
+    expr $x<1000000
+} 1
+test exec-11.2 {commands in background} {
+    list [catch {exec $tcltest echo a &b} msg] $msg
+} {0 {a &b}}
+test exec-11.3 {commands in background} {
+    llength [exec $tcltest sleep 1 &]
+} 1
+test exec-11.4 {commands in background} {
+    llength [exec $tcltest sleep 1 | $tcltest sleep 1 | $tcltest sleep 1 &]
+} 3
+test exec-11.5 {commands in background} {
+    set f [open gorp.file w]
+    puts $f { catch { exec [info nameofexecutable] echo foo & } }
+    close $f
+    string compare "foo" [exec $tcltest gorp.file]
+} 0
+
+# Make sure that background commands are properly reaped when
+# they eventually die.
+
+exec $tcltest sleep 3
+test exec-12.1 {reaping background processes} {unixOnly nonPortable} {
+    for {set i 0} {$i < 20} {incr i} {
+	exec echo foo > /dev/null &
+    }
+    exec sleep 1
+    catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg
+    lindex $msg 0
+} 0
+test exec-12.2 {reaping background processes} {unixOnly nonPortable} {
+    exec sleep 2 | sleep 2 | sleep 2 &
+    catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
+    set x [lindex $msg 0]
+    exec sleep 3
+    catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
+    list $x [lindex $msg 0]
+} {3 0}
+test exec-12.3 {reaping background processes} {unixOnly nonPortable} {
+    exec sleep 1000 &
+    exec sleep 1000 &
+    set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
+    set pids {}
+    foreach i [split $x \n] {
+	lappend pids [lindex $i 0]
+    }
+    foreach i $pids {
+	catch {exec kill -STOP $i}
+    }
+    catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg
+    set x [lindex $msg 0]
+
+    foreach i $pids {
+	catch {exec kill -KILL $i}
+    }
+    catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg
+    list $x [lindex $msg 0]
+} {2 0}
+
+# Make sure "errorCode" is set correctly.
+
+test exec-13.1 {setting errorCode variable} {
+    list [catch {exec $tcltest cat < a/b/c} msg] [string tolower $errorCode]
+} {1 {posix enoent {no such file or directory}}}
+test exec-13.2 {setting errorCode variable} {
+    list [catch {exec $tcltest cat > a/b/c} msg] [string tolower $errorCode]
+} {1 {posix enoent {no such file or directory}}}
+test exec-13.3 {setting errorCode variable} {
+    set x [catch {exec _weird_cmd_} msg]
+    list $x [string tolower $msg] [lindex $errorCode 0] \
+	    [string tolower [lrange $errorCode 2 end]]
+} {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}
+
+# Switches before the first argument
+
+test exec-14.1 {-keepnewline switch} {
+    exec -keepnewline $tcltest echo foo
+} "foo\n"
+test exec-14.2 {-keepnewline switch} {
+    list [catch {exec -keepnewline} msg] $msg
+} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
+test exec-14.3 {unknown switch} {
+    list [catch {exec -gorp} msg] $msg
+} {1 {bad switch "-gorp": must be -keepnewline or --}}
+test exec-14.4 {-- switch} {
+    list [catch {exec -- -gorp} msg] [string tolower $msg]
+} {1 {couldn't execute "-gorp": no such file or directory}}
+
+# Redirecting standard error separately from standard output
+
+test exec-15.1 {standard error redirection} {
+    exec $tcltest echo "First line" > gorp.file
+    list [exec $tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \
+	    [exec $tcltest cat gorp.file]
+} {{} {foo bar}}
+test exec-15.2 {standard error redirection} {
+    list [exec $tcltest sh -c "echo foo bar 1>&2" \
+		| $tcltest echo biz baz >gorp.file 2> gorp.file2] \
+	    [exec $tcltest cat gorp.file] \
+	    [exec $tcltest cat gorp.file2]
+} {{} {biz baz} {foo bar}}
+test exec-15.3 {standard error redirection} {
+    list [exec $tcltest sh -c "echo foo bar 1>&2" \
+	        | $tcltest echo biz baz 2>gorp.file > gorp.file2] \
+	    [exec $tcltest cat gorp.file] \
+	    [exec $tcltest cat gorp.file2]
+} {{} {foo bar} {biz baz}}
+test exec-15.4 {standard error redirection} {
+    set f [open gorp.file w]
+    puts $f "Line 1"
+    flush $f
+    exec $tcltest sh -c "echo foo bar 1>&2" 2>@ $f
+    puts $f "Line 3"
+    close $f
+    exec $tcltest cat gorp.file
+} {Line 1
+foo bar
+Line 3}
+test exec-15.5 {standard error redirection} {
+    exec $tcltest echo "First line" > gorp.file
+    exec $tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file
+    exec $tcltest cat gorp.file
+} {First line
+foo bar}
+test exec-15.6 {standard error redirection} {
+    exec $tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \
+	    >& gorp.file 2> gorp.file2 | $tcltest echo biz baz
+    list [exec $tcltest cat gorp.file] [exec $tcltest cat gorp.file2]
+} {{biz baz} {foo bar}}
+
+test exec-16.1 {flush output before exec} {
+    set f [open gorp.file w]
+    puts $f "First line"
+    exec $tcltest echo "Second line" >@ $f
+    puts $f "Third line"
+    close $f
+    exec $tcltest cat gorp.file
+} {First line
+Second line
+Third line}
+test exec-16.2 {flush output before exec} {} {
+    set f [open gorp.file w]
+    puts $f "First line"
+    exec $tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2
+    puts $f "Third line"
+    close $f
+    exec $tcltest cat gorp.file
+} {First line
+Second line
+Third line}
+
+test exec-17.1 { inheriting standard I/O } {
+    set f [open script w]
+    puts $f {close stdout
+	set f [open gorp.file w]
+	catch {exec [info nameofexecutable] echo foobar &}
+	exec [info nameofexecutable] sleep 2
+	close $f
+    }
+    close $f
+    catch {exec $tcltest script} result
+    set f [open gorp.file r]
+    lappend result [read $f]
+    close $f
+    set result
+} {{foobar
+}}
+
+file delete script gorp.file gorp.file2
+file delete echo cat wc sh sleep exit
diff --git a/tcl/tests/execute.test b/tcl/tests/execute.test
new file mode 100644
index 00000000000..1abee4080d7
--- /dev/null
+++ b/tcl/tests/execute.test
@@ -0,0 +1,114 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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}
+concat {}
diff --git a/tcl/tests/expr-old.test b/tcl/tests/expr-old.test
new file mode 100644
index 00000000000..981010a94cd
--- /dev/null
+++ b/tcl/tests/expr-old.test
@@ -0,0 +1,929 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+test expr-old-1.53 {integer operators} {
+    catch {unset x}
+    set x yes
+    list [expr {1 && $x}] [expr {$x && 1}] \
+         [expr {0 || $x}] [expr {$x || 0}]
+} {1 1 1 1}
+
+# Check the floating-point operators individually, along with
+# automatic conversion to integers where needed.
+
+test expr-old-2.1 {floating-point operators} {expr -4.2} -4.2
+test expr-old-2.2 {floating-point operators} {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} {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} {expr 2.3+2.1} 4.4
+test expr-old-2.11 {floating-point operators} {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} {expr 3.3>2.3?44.3:66.3} 44.3
+test expr-old-2.37 {floating-point operators} {expr 2.3>3.3?44.3:66.3} 66.3
+test expr-old-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
+
+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} {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} {eformat} {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} {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}
+
+# The following test is different for 32-bit versus 64-bit architectures.
+
+if {0x80000000 > 0} {
+    test expr-old-32.25 {math functions in expressions} {nonPortable} {
+	list [catch {expr abs(0x8000000000000000)} msg] $msg
+    } {1 {integer value too large to represent}}
+} else {
+    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} {
+    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 {expr 0289.1} msg] $msg
+} {0 289.1}
+test expr-old-36.4 {ExprLooksLikeInt procedure} {
+    set x 0289.1
+    list [catch {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"}}
+
+if {[info commands testexprlong] == {}} {
+    puts "This application hasn't been compiled with the \"testexprlong\""
+    puts "command, so I can't test Tcl_ExprLong etc."
+} else {
+test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} {
+    testexprlong
+} {This is a result: 5}
+}
+
+if {[info commands testexprstring] == {}} {
+    puts "This application hasn't been compiled with the \"testexprstring\""
+    puts "command, so I can't test Tcl_ExprString etc."
+} else {
+test expr-old-38.1 {Verify Tcl_ExprString's basic operation} {
+    list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
+        [catch {testexprstring "1+"} msg] $msg
+} {5 10.2 1 {syntax error in expression "1+"}}
+}
+
+# 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/tcl/tests/expr.test b/tcl/tests/expr.test
new file mode 100644
index 00000000000..f1edcaabc5e
--- /dev/null
+++ b/tcl/tests/expr.test
@@ -0,0 +1,670 @@
+# 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
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+}
+
+# procedures used below
+
+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
+}
+
+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
+}
+
+# start of tests
+
+catch {unset a b i x}
+
+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} {
+    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-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
+    set a xxx
+    set x 2;  set b {$x};  set a [expr $b == 2]
+    set a
+} 1
+
+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-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
+
+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-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-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 "&"}}
+
+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
+
+# The following test is different for 32-bit versus 64-bit
+# architectures because LONG_MIN is different
+
+if {0x80000000 > 0} {
+    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+	expr {1<<63}
+    } -9223372036854775808
+} else {
+    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-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-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-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
+} 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} {
+    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 {$a(foo}"}
+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
+    expr "$i+$x"
+} 579
+test expr-14.20 {CompilePrimaryExpr: quoted string primary} {
+    set i 3
+    set x 6
+    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 {[set]}"}
+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 i"
+    while compiling
+"expr {[set i}"}
+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 2+(3*[set])"}
+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: just var ref in subexpression primary} {
+    set i "5+10"
+    list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
+} {{15 == 15} {15 == 15} {15 == 15}}
+test expr-14.32 {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-15.7 {CompileMathFuncCall: call registered math function} {
+	expr 2*T1()
+    } 246
+    test expr-15.8 {CompileMathFuncCall: call registered math function} {
+	expr T2()*3
+    } 1035
+
+    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
+}
+
+test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
+    catch {unset a}
+    set a(VALUE) ff15
+    set i 123
+    if {[expr 0x$a(VALUE)] & 16} {
+        set i {}
+    }
+    set i
+} {}
+test expr-16.2 {GetToken: check for string literal in braces} {
+    expr {{1}}
+} {1}
+
+# Check "expr" and computed command names.
+
+test expr-17.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-18.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-19.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
+
+unset a
diff --git a/tcl/tests/fCmd.test b/tcl/tests/fCmd.test
new file mode 100644
index 00000000000..02862cdcc7d
--- /dev/null
+++ b/tcl/tests/fCmd.test
@@ -0,0 +1,2102 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+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} {
+    cleanup
+    file delete -force foo
+    file mkdir foo
+    file attr foo -perm 040000
+    set result [list [catch {file mkdir foo/tf1} msg] $msg]
+    file delete -force foo
+    set result
+} {1 {can't create directory "foo/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} {!$testConfig(win32s) || ($root == "C:/")} {
+    # Don't run this test under Win32s on a drive mounted from an NT 
+    # machine; it causes the NT machine to die.
+
+    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} {
+    cleanup
+    file mkdir foo/bar
+    file attr foo -perm 040555
+    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
+    set a1 {1 {can't unlink "foo/bar": permission denied}}
+    set result [expr {$msg == $a1}]
+    catch {file delete /tmp/bar}
+    catch {file attr foo -perm 040777}
+    catch {file delete -force foo}
+    set result
+} {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} {
+    file mkdir td1
+    file attr td1 -perm 040000
+    set result [list [catch {file rename ~$user td1} msg] $msg]
+    file delete -force td1
+    set result
+} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
+
+test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
+    cleanup
+    file mkdir td1
+    file mkdir td2
+    file attr td2 -perm 040000
+    set result [list [catch {file rename td1 td2/} msg] $msg]
+    file delete -force td2
+    file delete -force td1
+    set result
+} {1 {error renaming "td1" to "td2/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/tcl/tests/fileName.test b/tcl/tests/fileName.test
new file mode 100644
index 00000000000..c095582ecd7
--- /dev/null
+++ b/tcl/tests/fileName.test
@@ -0,0 +1,1449 @@
+# This file tests the filename manipulation routines.
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {[info commands testsetplatform] == {}} {
+    puts "This application hasn't been compiled with the \"testsetplatform\""
+    puts "command, so I can't test the filename conversion procedures."
+    return 
+} 
+
+global env
+set platform [testgetplatform]
+
+test filename-1.1 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype /
+} absolute
+test filename-1.2 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype /foo
+} absolute
+test filename-1.3 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype foo
+} relative
+test filename-1.4 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype c:/foo
+} relative
+test filename-1.5 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype ~
+} absolute
+test filename-1.6 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype ~/foo
+} absolute
+test filename-1.7 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype ~foo
+} absolute
+test filename-1.8 {Tcl_GetPathType: unix} {
+    testsetplatform unix
+    file pathtype ./~foo
+} relative
+
+test filename-2.1 {Tcl_GetPathType: mac, denerate names} {
+    testsetplatform mac
+    file pathtype /
+} relative
+test filename-2.2 {Tcl_GetPathType: mac, denerate names} {
+    testsetplatform mac
+    file pathtype /.
+} relative
+test filename-2.3 {Tcl_GetPathType: mac, denerate names} {
+    testsetplatform mac
+    file pathtype /..
+} relative
+test filename-2.4 {Tcl_GetPathType: mac, denerate names} {
+    testsetplatform mac
+    file pathtype //.//
+} relative
+test filename-2.5 {Tcl_GetPathType: mac, denerate names} {
+    testsetplatform mac
+    file pathtype //.//../.
+} relative
+test filename-2.6 {Tcl_GetPathType: mac, tilde names} {
+    testsetplatform mac
+    file pathtype ~
+} absolute
+test filename-2.7 {Tcl_GetPathType: mac, tilde names} {
+    testsetplatform mac
+    file pathtype ~:
+} absolute
+test filename-2.8 {Tcl_GetPathType: mac, tilde names} {
+    testsetplatform mac
+    file pathtype ~:foo
+} absolute
+test filename-2.9 {Tcl_GetPathType: mac, tilde names} {
+    testsetplatform mac
+    file pathtype ~/
+} absolute
+test filename-2.10 {Tcl_GetPathType: mac, tilde names} {
+    testsetplatform mac
+    file pathtype ~/foo
+} absolute
+test filename-2.11 {Tcl_GetPathType: mac, unix-style names} {
+    testsetplatform mac
+    file pathtype /foo
+} absolute
+test filename-2.12 {Tcl_GetPathType: mac, unix-style names} {
+    testsetplatform mac
+    file pathtype /./foo
+} absolute
+test filename-2.13 {Tcl_GetPathType: mac, unix-style names} {
+    testsetplatform mac
+    file pathtype /..//./foo
+} absolute
+test filename-2.14 {Tcl_GetPathType: mac, unix-style names} {
+    testsetplatform mac
+    file pathtype /foo/bar
+} absolute
+test filename-2.15 {Tcl_GetPathType: mac, unix-style names} {
+    testsetplatform mac
+    file pathtype foo/bar
+} relative
+test filename-2.16 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype :
+} relative
+test filename-2.17 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype :foo
+} relative
+test filename-2.18 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype foo:
+} absolute
+test filename-2.19 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype foo:bar
+} absolute
+test filename-2.20 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype :foo:bar
+} relative
+test filename-2.21 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype ::foo:bar
+} relative
+test filename-2.22 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype ~foo
+} absolute
+test filename-2.23 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype :~foo
+} relative
+test filename-2.24 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype ~foo:
+} absolute
+test filename-2.25 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype foo/bar:
+} absolute
+test filename-2.26 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype /foo:
+} absolute
+test filename-2.27 {Tcl_GetPathType: mac, mac-style names} {
+    testsetplatform mac
+    file pathtype foo
+} relative
+
+test filename-3.1 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype /
+} volumerelative
+test filename-3.2 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype \\
+} volumerelative
+test filename-3.3 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype /foo
+} volumerelative
+test filename-3.4 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype \\foo
+} volumerelative
+test filename-3.5 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype c:/
+} absolute
+test filename-3.6 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype c:\\
+} absolute
+test filename-3.7 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype c:/foo
+} absolute
+test filename-3.8 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype c:\\foo
+} absolute
+test filename-3.9 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype c:
+} volumerelative
+test filename-3.10 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype c:foo
+} volumerelative
+test filename-3.11 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype foo
+} relative
+test filename-3.12 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype //foo/bar
+} absolute
+test filename-3.13 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype ~foo
+} absolute
+test filename-3.14 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype ~
+} absolute
+test filename-3.15 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype ~/foo
+} absolute
+test filename-3.16 {Tcl_GetPathType: windows} {
+    testsetplatform windows
+    file pathtype ./~foo
+} relative
+
+test filename-4.1 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split /
+} {/}
+test filename-4.2 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split /foo
+} {/ foo}
+test filename-4.3 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split /foo/bar
+} {/ foo bar}
+test filename-4.4 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split /foo/bar/baz
+} {/ foo bar baz}
+test filename-4.5 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split foo/bar
+} {foo bar}
+test filename-4.6 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ./foo/bar
+} {. foo bar}
+test filename-4.7 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split /foo/../././foo/bar
+} {/ foo .. . . foo bar}
+test filename-4.8 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ../foo/bar
+} {.. foo bar}
+test filename-4.9 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split {}
+} {}
+test filename-4.10 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split .
+} {.}
+test filename-4.11 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ../
+} {..}
+test filename-4.12 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ../..
+} {.. ..}
+test filename-4.13 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split //foo
+} {/ foo}
+test filename-4.14 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split foo//bar
+} {foo bar}
+test filename-4.15 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ~foo
+} {~foo}
+test filename-4.16 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ~foo/~bar
+} {~foo ./~bar}
+test filename-4.17 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split ~foo/~bar/~baz
+} {~foo ./~bar ./~baz}
+test filename-4.18 {Tcl_SplitPath: unix} {
+    testsetplatform unix
+    file split foo/bar~/baz
+} {foo bar~ baz}
+
+test filename-5.1 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:b
+} {a: b}
+test filename-5.2 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:b:c
+} {a: b c}
+test filename-5.3 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:b:c:
+} {a: b c}
+test filename-5.4 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:
+} {a:}
+test filename-5.5 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a::
+} {a: ::}
+test filename-5.6 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:::
+} {a: :: ::}
+test filename-5.7 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split :a
+} {a}
+test filename-5.8 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split :a::
+} {a ::}
+test filename-5.9 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split :
+} {:}
+test filename-5.10 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ::
+} {::}
+test filename-5.11 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split :::
+} {:: ::}
+test filename-5.12 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:::b
+} {a: :: :: b}
+test filename-5.13 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /a:b
+} {/a: b}
+test filename-5.14 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~:
+} {~:}
+test filename-5.15 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~/:
+} {~/:}
+test filename-5.16 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~:foo
+} {~: foo}
+test filename-5.17 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~/foo
+} {~: foo}
+test filename-5.18 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~foo:
+} {~foo:}
+test filename-5.19 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:~foo
+} {a: :~foo}
+test filename-5.20 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /
+} {:/}
+test filename-5.21 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a:b/c
+} {a: :b/c}
+test filename-5.22 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /foo
+} {foo:}
+test filename-5.23 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /a/b
+} {a: b}
+test filename-5.24 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /a/b/foo
+} {a: b foo}
+test filename-5.25 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a/b
+} {a b}
+test filename-5.26 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ./foo/bar
+} {: foo bar}
+test filename-5.27 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ../foo/bar
+} {:: foo bar}
+test filename-5.28 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split {}
+} {}
+test filename-5.29 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split .
+} {:}
+test filename-5.30 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ././
+} {: :}
+test filename-5.31 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ././.
+} {: : :}
+test filename-5.32 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ../
+} {::}
+test filename-5.33 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ..
+} {::}
+test filename-5.34 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ../..
+} {:: ::}
+test filename-5.35 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split //foo
+} {foo:}
+test filename-5.36 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split foo//bar
+} {foo bar}
+test filename-5.37 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~foo
+} {~foo:}
+test filename-5.38 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~
+} {~:}
+test filename-5.39 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split foo
+} {foo}
+test filename-5.40 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~/
+} {~:}
+test filename-5.41 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~foo/~bar
+} {~foo: :~bar}
+test filename-5.42 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split ~foo/~bar/~baz
+} {~foo: :~bar :~baz}
+test filename-5.43 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split foo/bar~/baz
+} {foo bar~ baz}
+test filename-5.44 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a/../b
+} {a :: b}
+test filename-5.45 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a/../../b
+} {a :: :: b}
+test filename-5.46 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split a/.././../b
+} {a :: : :: b}
+test filename-5.47 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /../bar
+} {bar:}
+test filename-5.48 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /./bar
+} {bar:}
+test filename-5.49 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split //.//.././bar
+} {bar:}
+test filename-5.50 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split /..
+} {:/..}
+test filename-5.51 {Tcl_SplitPath: mac} {
+    testsetplatform mac
+    file split //.//.././
+} {://.//.././}
+
+test filename-6.1 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /
+} {/}
+test filename-6.2 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /foo
+} {/ foo}
+test filename-6.3 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /foo/bar
+} {/ foo bar}
+test filename-6.4 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /foo/bar/baz
+} {/ foo bar baz}
+test filename-6.5 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split foo/bar
+} {foo bar}
+test filename-6.6 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ./foo/bar
+} {. foo bar}
+test filename-6.7 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /foo/../././foo/bar
+} {/ foo .. . . foo bar}
+test filename-6.8 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ../foo/bar
+} {.. foo bar}
+test filename-6.9 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split {}
+} {}
+test filename-6.10 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split .
+} {.}
+test filename-6.11 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ../
+} {..}
+test filename-6.12 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ../..
+} {.. ..}
+test filename-6.13 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split //foo
+} {/ foo}
+test filename-6.14 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split foo//bar
+} {foo bar}
+test filename-6.15 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /\\/foo//bar
+} {//foo/bar}
+test filename-6.16 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /\\/foo//bar
+} {//foo/bar}
+test filename-6.17 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split /\\/foo//bar
+} {//foo/bar}
+test filename-6.18 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split \\\\foo\\bar
+} {//foo/bar}
+test filename-6.19 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split \\\\foo\\bar/baz
+} {//foo/bar baz}
+test filename-6.20 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:/foo
+} {c:/ foo}
+test filename-6.21 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:foo
+} {c: foo}
+test filename-6.22 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:
+} {c:}
+test filename-6.23 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:\\
+} {c:/}
+test filename-6.24 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:/
+} {c:/}
+test filename-6.25 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:/./..
+} {c:/ . ..}
+test filename-6.26 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ~foo
+} {~foo}
+test filename-6.27 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ~foo/~bar
+} {~foo ./~bar}
+test filename-6.28 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split ~foo/~bar/~baz
+} {~foo ./~bar ./~baz}
+test filename-6.29 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split foo/bar~/baz
+} {foo bar~ baz}
+test filename-6.30 {Tcl_SplitPath: win} {
+    testsetplatform win
+    file split c:~foo
+} {c: ./~foo}
+
+test filename-7.1 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join / a
+} {/a}
+test filename-7.2 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join a b
+} {a/b}
+test filename-7.3 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join /a c /b d
+} {/b/d}
+test filename-7.4 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join /
+} {/}
+test filename-7.5 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join a
+} {a}
+test filename-7.6 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join {}
+} {}
+test filename-7.7 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join /a/ b
+} {/a/b}
+test filename-7.8 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join /a// b
+} {/a/b}
+test filename-7.9 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join /a/./../. b
+} {/a/./.././b}
+test filename-7.10 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join ~ a
+} {~/a}
+test filename-7.11 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join ~a ~b
+} {~b}
+test filename-7.12 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join ./~a b
+} {./~a/b}
+test filename-7.13 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join ./~a ~b
+} {~b}
+test filename-7.14 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join ./~a ./~b
+} {./~a/~b}
+test filename-7.15 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join a . b
+} {a/./b}
+test filename-7.16 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join a . ./~b
+} {a/./~b}
+test filename-7.17 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join //a b
+} {/a/b}
+test filename-7.18 {Tcl_JoinPath: unix} {
+    testsetplatform unix
+    file join /// a b
+} {/a/b}
+
+test filename-8.1 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a b
+} {:a:b}
+test filename-8.2 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join :a b
+} {:a:b}
+test filename-8.3 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a b:
+} {b:}
+test filename-8.4 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a: :b
+} {a:b}
+test filename-8.5 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a: :b:
+} {a:b}
+test filename-8.6 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a :: b
+} {:a::b}
+test filename-8.7 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a :: :: b
+} {:a:::b}
+test filename-8.8 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a ::: b
+} {:a:::b}
+test filename-8.9 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a: b:
+} {b:}
+test filename-8.10 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join /a/b
+} {a:b}
+test filename-8.11 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join /a/b c/d
+} {a:b:c:d}
+test filename-8.12 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join /a/b :c:d
+} {a:b:c:d}
+test filename-8.13 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join ~ foo
+} {~:foo}
+test filename-8.14 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join :: ::
+} {:::}
+test filename-8.15 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a: ::
+} {a::}
+test filename-8.16 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a {} b
+} {:a:b}
+test filename-8.17 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a::: b
+} {a:::b}
+test filename-8.18 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a : : :
+} {:a}
+test filename-8.19 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join :
+} {:}
+test filename-8.20 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join : a
+} {:a}
+test filename-8.21 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join a: :b/c
+} {a:b/c}
+test filename-8.22 {Tcl_JoinPath: mac} {
+    testsetplatform mac
+    file join :a :b/c
+} {:a:b/c}
+
+test filename-9.1 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join a b
+} {a/b}
+test filename-9.2 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join /a b
+} {/a/b}
+test filename-9.3 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join /a /b
+} {/b}
+test filename-9.4 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join c: foo
+} {c:foo}
+test filename-9.5 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join c:/ foo
+} {c:/foo}
+test filename-9.6 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join c:\\bar foo
+} {c:/bar/foo}
+test filename-9.7 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join /foo c:bar
+} {c:bar}
+test filename-9.8 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join ///host//share dir
+} {//host/share/dir}
+test filename-9.9 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join ~ foo
+} {~/foo}
+test filename-9.10 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join ~/~foo
+} {~/~foo}
+test filename-9.11 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join ~ ./~foo
+} {~/~foo}
+test filename-9.12 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join / ~foo
+} {~foo}
+test filename-9.13 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join ./a/ b c
+} {./a/b/c}
+test filename-9.14 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join ./~a/ b c
+} {./~a/b/c}
+test filename-9.15 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join // host share path
+} {/host/share/path}
+test filename-9.16 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join foo . bar
+} {foo/./bar}
+test filename-9.17 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join foo .. bar
+} {foo/../bar}
+test filename-9.18 {Tcl_JoinPath: win} {
+    testsetplatform win
+    file join foo/./bar
+} {foo/./bar}
+
+test filename-10.1 {Tcl_TranslateFileName} {
+    testsetplatform unix
+    list [catch {testtranslatefilename foo} msg] $msg
+} {0 foo}
+test filename-10.2 {Tcl_TranslateFileName} {
+    testsetplatform windows
+    list [catch {testtranslatefilename {c:/foo}} msg] $msg
+} {0 {c:\foo}}
+test filename-10.3 {Tcl_TranslateFileName} {
+    testsetplatform windows
+    list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
+} {0 {c:\foo}}
+test filename-10.4 {Tcl_TranslateFileName} {
+    testsetplatform mac
+    list [catch {testtranslatefilename foo} msg] $msg
+} {0 :foo}
+test filename-10.5 {Tcl_TranslateFileName} {
+    testsetplatform mac
+    list [catch {testtranslatefilename :~foo} msg] $msg
+} {0 :~foo}
+test filename-10.6 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform unix
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 /home/test/foo}
+test filename-10.7 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    unset env(HOME)
+    testsetplatform unix
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {1 {couldn't find HOME environment variable to expand path}}
+test filename-10.8 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test"
+    testsetplatform unix
+    set result [list [catch {testtranslatefilename ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 /home/test}
+test filename-10.9 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test/"
+    testsetplatform unix
+    set result [list [catch {testtranslatefilename ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 /home/test}
+test filename-10.10 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "/home/test/"
+    testsetplatform unix
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 /home/test/foo}
+test filename-10.11 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "Root:"
+    testsetplatform mac
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 Root:foo}
+test filename-10.12 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "Root:home"
+    testsetplatform mac
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 Root:home:foo}
+test filename-10.13 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "Root:home"
+    testsetplatform mac
+    set result [list [catch {testtranslatefilename ~::foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 Root:home::foo}
+test filename-10.14 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "Root:home"
+    testsetplatform mac
+    set result [list [catch {testtranslatefilename ~} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 Root:home}
+test filename-10.15 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "Root:home:"
+    testsetplatform mac
+    set result [list [catch {testtranslatefilename ~::foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 Root:home::foo}
+test filename-10.16 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "Root:home::"
+    testsetplatform mac
+    set result [list [catch {testtranslatefilename ~::foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 Root:home:::foo}
+test filename-10.17 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "\\home\\"
+    testsetplatform windows
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 {\home\foo}}
+test filename-10.18 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "\\home\\"
+    testsetplatform windows
+    set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 {\home\foo\bar}}
+test filename-10.19 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "c:"
+    testsetplatform windows
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 c:foo}
+test filename-10.20 {Tcl_TranslateFileName} {
+    list [catch {testtranslatefilename ~blorp/foo} msg] $msg
+} {1 {user "blorp" doesn't exist}}
+test filename-10.21 {Tcl_TranslateFileName} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) "c:\\"
+    testsetplatform windows
+    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    set env(HOME) $temp
+    set result
+} {0 {c:\foo}}
+test filename-10.22 {Tcl_TranslateFileName} {
+    testsetplatform windows
+    list [catch {testtranslatefilename foo//bar} msg] $msg
+} {0 {foo\bar}}
+
+testsetplatform $platform
+
+test filename-10.23 {Tcl_TranslateFileName} {nonPortable unixOnly} {
+    # this test fails if ~ouster is not /home/ouster
+    list [catch {testtranslatefilename ~ouster} msg] $msg
+} {0 /home/ouster}
+test filename-10.24 {Tcl_TranslateFileName} {nonPortable unixOnly} {
+    # this test fails if ~ouster is not /home/ouster
+    list [catch {testtranslatefilename ~ouster/foo} msg] $msg
+} {0 /home/ouster/foo}
+
+
+test filename-11.1 {Tcl_GlobCmd} {
+    list [catch {glob} msg] $msg
+} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
+test filename-11.2 {Tcl_GlobCmd} {
+    list [catch {glob -gorp} msg] $msg
+} {1 {bad switch "-gorp": must be -nocomplain or --}}
+test filename-11.3 {Tcl_GlobCmd} {
+    list [catch {glob -nocomplai} msg] $msg
+} {1 {bad switch "-nocomplai": must be -nocomplain or --}}
+test filename-11.4 {Tcl_GlobCmd} {
+    list [catch {glob -nocomplain} msg] $msg
+} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
+test filename-11.5 {Tcl_GlobCmd} {
+    list [catch {glob -nocomplain ~xyqrszzz} msg] $msg
+} {0 {}}
+test filename-11.6 {Tcl_GlobCmd} {
+    list [catch {glob ~xyqrszzz} msg] $msg
+} {1 {user "xyqrszzz" doesn't exist}}
+test filename-11.7 {Tcl_GlobCmd} {
+    list [catch {glob -- -nocomplain} msg] $msg
+} {1 {no files matched glob patterns "-nocomplain"}}
+test filename-11.8 {Tcl_GlobCmd} {
+    list [catch {glob -nocomplain -- -nocomplain} msg] $msg
+} {0 {}}
+test filename-11.9 {Tcl_GlobCmd} {
+    testsetplatform unix
+    list [catch {glob ~\\xyqrszzz/bar} msg] $msg
+} {1 {globbing characters not supported in user names}}
+test filename-11.10 {Tcl_GlobCmd} {
+    testsetplatform unix
+    list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
+} {0 {}}
+test filename-11.11 {Tcl_GlobCmd} {
+    testsetplatform unix
+    list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
+} {1 {user "xyqrszzz" doesn't exist}}
+test filename-11.12 {Tcl_GlobCmd} {
+    testsetplatform unix
+    set home $env(HOME)
+    unset env(HOME)
+    set x [list [catch {glob ~/*} msg] $msg]
+    set env(HOME) $home
+    set x
+} {1 {couldn't find HOME environment variable to expand path}}
+
+testsetplatform $platform
+
+test filename-11.13 {Tcl_GlobCmd} {
+    list [catch {file join [lindex [glob ~] 0]} msg] $msg
+} [list 0 [file join $env(HOME)]]
+
+set oldhome $env(HOME)
+set env(HOME) [pwd]
+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]
+close [open "globTest/weird name.c" w]
+close [open globTest/a1/b1/x2.c w]
+close [open globTest/a1/b2/y2.c w]
+
+# Cannot create a file with the following names under Win32s.  We have to
+# skip the tests that are checking the difference between a "." or "," in
+# the file name vs. a "." or "," in the glob pattern.
+
+catch {close [open globTest/.1 w]}
+catch {close [open globTest/x,z1.c w]}
+
+test filename-11.14 {Tcl_GlobCmd} {
+    list [catch {glob ~/globTest} msg] $msg
+} [list 0 [list [file join $env(HOME) globTest]]]
+test filename-11.15 {Tcl_GlobCmd} {
+    list [catch {glob ~\\/globTest} msg] $msg
+} [list 0 [list [file join $env(HOME) globTest]]]
+test filename-11.16 {Tcl_GlobCmd} {
+    list [catch {glob globTest} msg] $msg
+} {0 globTest}
+
+test filename-12.1 {simple globbing} {unixOrPc} {
+    list [catch {glob {}} msg] $msg
+} {0 .}
+test filename-12.2 {simple globbing} {macOnly} {
+    list [catch {glob {}} msg] $msg
+} {0 :}
+test filename-12.3 {simple globbing} {
+    list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
+} {0 {}}
+
+if {$tcl_platform(platform) == "macintosh"} {
+  set globPreResult :globTest:
+} else {
+  set globPreResult globTest/
+}
+set x1 x1.c
+set y1 y1.c
+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} {
+    list [catch {glob globTest\\/x1.c} msg] $msg
+} "0 $globPreResult$x1"
+test filename-12.6 {simple globbing} {
+    list [catch {glob globTest\\/\\x1.c} msg] $msg
+} "0 $globPreResult$x1"
+
+test filename-13.1 {globbing with brace substitution} {
+    list [catch {glob globTest/\{\}} msg] $msg
+} "0 $globPreResult"
+test filename-13.2 {globbing with brace substitution} {
+    list [catch {glob globTest/\{} msg] $msg
+} {1 {unmatched open-brace in file name}}
+test filename-13.3 {globbing with brace substitution} {
+    list [catch {glob globTest/\{\\\}} msg] $msg
+} {1 {unmatched open-brace in file name}}
+test filename-13.4 {globbing with brace substitution} {
+    list [catch {glob globTest/\{\\} msg] $msg
+} {1 {unmatched open-brace in file name}}
+test filename-13.5 {globbing with brace substitution} {
+    list [catch {glob globTest/\}} msg] $msg
+} {1 {unmatched close-brace in file name}}
+test filename-13.6 {globbing with brace substitution} {
+    list [catch {glob globTest/\{\}x1.c} msg] $msg
+} "0 $globPreResult$x1"
+test filename-13.7 {globbing with brace substitution} {
+    list [catch {glob globTest/\{x\}1.c} msg] $msg
+} "0 $globPreResult$x1"
+test filename-13.8 {globbing with brace substitution} {
+    list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
+} "0 $globPreResult$x1"
+test filename-13.9 {globbing with brace substitution} {!win32s} {
+    list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
+} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
+test filename-13.10 {globbing with brace substitution} {!win32s} {
+    list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
+} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
+test filename-13.11 {globbing with brace substitution} {unixOrPc && !win32s} {
+    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} {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.13 {globbing with brace substitution} {
+    lsort [glob globTest/{a,b,x,y}1.c]
+} [list $globPreResult$x1 $globPreResult$y1]
+test filename-13.14 {globbing with brace substitution} {unixOrPc} {
+    lsort [glob {globTest/{x1,y2,weird name}.c}]
+} {{globTest/weird name.c} globTest/x1.c}
+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.16 {globbing with brace substitution} {unixOrPc} {
+    lsort [glob globTest/{x1.c,a1/*}]
+} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
+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.18 {globbing with brace substitution} {unixOrPc} {
+    lsort [glob globTest/{x1.c,{a},a1/*}]
+} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
+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.20 {globbing with brace substitution} {unixOrPc} {
+    lsort [glob globTest/{a,x}1/*/{x,y}*]
+} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
+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.22 {globbing with brace substitution} {
+    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} {unixOrPc && !win32s} {
+    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} {win32s} {
+    lsort [glob g*/*.c]
+} {globtest/weirdn~1.c globtest/x1.c globtest/y1.c globtest/z1.c}
+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.3 {asterisks, question marks, and brackets} {unixOrPc} {
+    lsort [glob globTest/?1.c]
+} {globTest/x1.c globTest/y1.c globTest/z1.c}
+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.5 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+    lsort [glob */*/*/*.c]
+} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
+test filename-14.5 {asterisks, question marks, and brackets} {win32s} {
+    lsort [glob */*/*/*.c]
+} {globtest/a1/b1/x2.c globtest/a1/b2/y2.c}
+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.7 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+    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.7 {asterisks, question marks, and brackets} {win32s} {
+    lsort [glob globTest/*]
+} {globTest/a1 globTest/a2 globTest/a3 globTest/weirdn~1.c globTest/x1.c globTest/y1.c globTest/z1.c}
+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.9 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+    lsort [glob globTest/.*]
+} {globTest/. globTest/.. globTest/.1}
+test filename-14.9 {asterisks, question marks, and brackets} {win32s} {
+    lsort [glob globTest/.*]
+} {globTest/. globTest/..}
+test filename-14.10 {asterisks, question marks, and brackets} {macOnly} {
+    lsort [glob globTest/.*]
+} {:globTest:.1}
+test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} {
+    lsort [glob globTest/*/*]
+} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
+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.13 {asterisks, question marks, and brackets} {unixOrPc} {
+    lsort [glob {globTest/[xyab]1.*}]
+} {globTest/x1.c globTest/y1.c}
+test filename-14.14 {asterisks, question marks, and brackets} {macOnly} {
+    lsort [glob {globTest/[xyab]1.*}]
+} {:globTest:x1.c :globTest:y1.c}
+test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} {
+    lsort [glob globTest/*/]
+} {globTest/a1/ globTest/a2/ globTest/a3/}
+test filename-14.16 {asterisks, question marks, and brackets} {macOnly} {
+    lsort [glob globTest/*/]
+} {:globTest:a1: :globTest:a2: :globTest:a3:}
+test filename-14.17 {asterisks, question marks, and brackets} {
+    global env
+    set temp $env(HOME)
+    set env(HOME) [file join $env(HOME) globTest]
+    set result [list [catch {glob ~/z*} msg] $msg]
+    set env(HOME) $temp
+    set result
+} [list 0 [list [file join $env(HOME) globTest z1.c]]]
+test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+    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.18 {asterisks, question marks, and brackets} {win32s} {
+    list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
+} {0 {globTest/weirdn~1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
+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.20 {asterisks, question marks, and brackets} {
+    list [catch {glob -nocomplain goo/*} msg] $msg
+} {0 {}}
+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.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.23 {slash globbing} {unixOrPc} {
+    glob /
+} /
+test filename-14.24 {slash globbing} {pcOnly} {
+    glob {\\}
+} /
+
+# The following tests are only valid for Unix systems.
+
+if {$tcl_platform(platform) == "unix"} {
+    # On some systems, like AFS, "000" protection doesn't prevent
+    # access by owner, so the following test is not portable.
+
+    exec chmod 000 globTest/a1
+    test filename-15.1 {unix specific globbing} {nonPortable} {
+	string tolower [list [catch {glob globTest/a1/*} msg]  $msg $errorCode]
+    } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
+    test filename-15.2 {unix specific no complain: no errors} {nonPortable} {
+	glob -nocomplain globTest/a1/*
+    } {}
+    test filename-15.3 {unix specific no complain: no errors, good result} {nonPortable knownBug} {
+	# test fails because if an error occur , the interp's result
+	# is reset...
+	glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
+    } {globTest/a2 globTest/a3}
+    exec chmod 755 globTest/a1
+    test filename-15.4 {unix specific no complain: no errors, good result} {nonPortable knownBug} {
+	# test fails because if an error occur , the interp's result
+	# is reset... (or you don't run at sunscript where the
+	# outser and demailly's users exists
+	glob -nocomplain ~ouster ~foo ~demailly
+    } {/home/ouster /home/demailly}
+    test filename-15.5 {unix specific globbing} {nonPortable} {
+	glob ~ouster/.csh*
+    } "/home/ouster/.cshrc"
+    close [open globTest/odd\\\[\]*?\{\}name w]
+    test filename-15.6 {unix specific globbing} {
+	global env
+	set temp $env(HOME)
+	set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
+	set result [list [catch {glob ~} msg] $msg]
+	set env(HOME) $temp
+	set result
+    } [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]]
+    exec rm -f globTest/odd\\\[\]*?\{\}name
+}
+
+# The following tests are only valid for Windows systems.
+
+if {$tcl_platform(platform) == "windows"} {
+    set temp [pwd]
+    cd c:/
+    catch {
+	removeDirectory globTest
+	makeDirectory globTest
+	close [open globTest/x1.BAT w]
+	close [open globTest/y1.Bat w]
+	close [open globTest/z1.bat w]
+    }
+    
+    test filename-16.1 {windows specific globbing} {!win32s} {
+	lsort [glob globTest/*.bat]
+    } {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
+    test filename-16.1 {windows specific globbing} {win32s} {
+	lsort [glob globTest/*.bat]
+    } {globTest/x1.bat globTest/y1.bat globTest/z1.bat}
+    test filename-16.2 {windows specific globbing} {
+	glob c:
+    } c:
+    test filename-16.3 {windows specific globbing} {
+	glob c:\\\\
+	} c:/
+    test filename-16.4 {windows specific globbing} {
+	glob c:/
+    } c:/
+    test filename-16.5 {windows specific globbing} {!win32s} {
+	glob c:*Test
+    } c:globTest
+    test filename-16.5 {windows specific globbing} {win32s} {
+	glob c:*Test
+    } c:globtest
+    test filename-16.6 {windows specific globbing} {!win32s} {
+	glob c:\\\\*Test
+    } c:/globTest
+    test filename-16.6 {windows specific globbing} {win32s} {
+	glob c:\\\\*Test
+    } c:/globtest
+    test filename-16.7 {windows specific globbing} {!win32s} {
+	glob c:/*Test
+    } c:/globTest
+    test filename-16.7 {windows specific globbing} {win32s} {
+	glob c:/*Test
+    } c:/globtest
+    test filename-16.8 {windows specific globbing} {!win32s} {
+	lsort [glob c:globTest/*.bat]
+    } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
+    test filename-16.8 {windows specific globbing} {win32s} {
+	lsort [glob c:globTest/*.bat]
+    } {c:globTest/x1.bat c:globTest/y1.bat c:globTest/z1.bat}
+    test filename-16.9 {windows specific globbing} {!win32s} {
+	lsort [glob c:/globTest/*.bat]
+    } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
+    test filename-16.9 {windows specific globbing} {win32s} {
+	lsort [glob c:/globTest/*.bat]
+    } {c:/globTest/x1.bat c:/globTest/y1.bat c:/globTest/z1.bat}
+    test filename-16.10 {windows specific globbing} {!win32s} {
+	lsort [glob c:globTest\\\\*.bat]
+    } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
+    test filename-16.10 {windows specific globbing} {win32s} {
+	lsort [glob c:globTest\\\\*.bat]
+    } {c:globTest/x1.bat c:globTest/y1.bat c:globTest/z1.bat}
+    test filename-16.11 {windows specific globbing} {!win32s} {
+	lsort [glob c:\\\\globTest\\\\*.bat]
+    } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
+    test filename-16.11 {windows specific globbing} {win32s} {
+	lsort [glob c:\\\\globTest\\\\*.bat]
+    } {c:/globTest/x1.bat c:/globTest/y1.bat c:/globTest/z1.bat}
+
+    removeDirectory globTest
+
+    if {($testConfig(nonPortable) != 0) && [catch {cd //gaspode/d}] == 0} {
+	removeDirectory globTest
+	makeDirectory globTest
+
+	close [open globTest/x1.BAT w]
+	close [open globTest/y1.Bat w]
+	close [open globTest/z1.bat w]
+
+	test filename-16.12 {windows specific globbing} {
+	    glob //gaspode/d/*Test
+	} //gaspode/d/globTest
+	test filename-16.13 {windows specific globbing} {
+	    glob {\\\\gaspode\\d\\*Test}
+	} //gaspode/d/globTest
+
+	removeDirectory globTest
+    }	    
+
+    cd $temp
+}
+
+removeDirectory globTest
+set env(HOME) $oldhome
+
+testsetplatform $platform
+catch {unset oldhome platform temp result}
+concat ""
diff --git a/tcl/tests/for-old.test b/tcl/tests/for-old.test
new file mode 100644
index 00000000000..9ad7a6639c3
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/for.test b/tcl/tests/for.test
new file mode 100644
index 00000000000..e12c47e8630
--- /dev/null
+++ b/tcl/tests/for.test
@@ -0,0 +1,592 @@
+# 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) 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Basic "for" operation.
+
+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 {set}"}}
+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 {set i 0} {$i<}"}
+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 {set i 0} {$i < 5} {incr i} {set}"}
+catch {unset a}
+test for-1.9 {TclCompileForCmd: simple command body} {
+    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-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 {}
+    for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
+    set a
+} {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 {set i 0} {$i < 5} {set} {puts $i}"}
+test for-1.13 {TclCompileForCmd: long command body} {
+    set a {}
+    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
+} {}
+
+# Check "for" and "continue".
+
+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 {}
+    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+	if {$i == 2} continue
+	set a [concat $a $i]
+    }
+    set a
+} {1 3 4}
+test for-2.4 {continue tests} {
+    set a {}
+    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
+	if {$i != 2} continue
+	set a [concat $a $i]
+    }
+    set a
+} {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
+} {1.1 1.2 2.1 3.1 4.1}
+test for-2.6 {continue tests, long command body} {
+    set a {}
+    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
+} {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"}
+test for-3.2 {TclCompileBreakCmd: break result} {
+    catch break
+} 3
+test for-3.3 {break tests} {
+    set a {}
+    for {set i 1} {$i <= 4} {incr i} {
+	if {$i == 3} break
+	set a [concat $a $i]
+    }
+    set a
+} {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 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 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 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/tcl/tests/foreach.test b/tcl/tests/foreach.test
new file mode 100644
index 00000000000..4eca220186b
--- /dev/null
+++ b/tcl/tests/foreach.test
@@ -0,0 +1,212 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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}}
+
+test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
+    catch {unset x}
+    foreach {12.0} {a b c} {
+        set x 12.0  
+        set x [expr $x + 1]
+    }
+    set x
+} 13.0
+
+# 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/tcl/tests/format.test b/tcl/tests/format.test
new file mode 100644
index 00000000000..48427ffa94e
--- /dev/null
+++ b/tcl/tests/format.test
@@ -0,0 +1,438 @@
+# Commands covered:  format
+#
+# 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-1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# The following code is needed because some versions of SCO Unix have
+# a round-off error in sprintf which would cause some of the tests to
+# fail.  Someday I hope this code shouldn't be necessary (code added
+# 9/9/91).
+
+set roundOffBug 0
+if {"[format %7.1e  68.514]" == "6.8e+01"} {
+    puts stdout "Note: this system has a sprintf round-off bug, some tests skipped\n"
+    set roundOffBug 1
+}
+
+test format-1.1 {integer formatting} {
+    format "%*d %d %d %d" 6 34 16923 -12 -1
+} {    34 16923 -12 -1}
+test format-1.2 {integer formatting} {nonPortable} {
+    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
+} {   6   34 16923  -12 -1 0xe 0XC}
+
+# %u output depends on word length, so this test is not portable.
+
+test format-1.3 {integer formatting} {nonPortable} {
+    format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
+} {   6   34 16923 4294967284 -1 0}
+test format-1.4 {integer formatting} {
+    format "%-4d %-4i %-4d %-4ld" 6 34 16923 -12 -1
+} {6    34   16923 -12 }
+test format-1.5 {integer formatting} {
+    format "%04d %04d %04d %04i" 6 34 16923 -12 -1
+} {0006 0034 16923 -012}
+test format-1.6 {integer formatting} {
+    format "%00*d" 6 34
+} {000034}
+
+# Printing negative numbers in hex or octal format depends on word
+# length, so these tests are not portable.
+
+test format-1.7 {integer formatting} {nonPortable} {
+    format "%4x %4x %4x %4x" 6 34 16923 -12 -1
+} {   6   22 421b fffffff4}
+test format-1.8 {integer formatting} {nonPortable} {
+    format "%#x %#X %#X %#x" 6 34 16923 -12 -1
+} {0x6 0X22 0X421B 0xfffffff4}
+test format-1.9 {integer formatting} {nonPortable} {
+    format "%#20x %#20x %#20x %#20x" 6 34 16923 -12 -1
+} {                 0x6                 0x22               0x421b           0xfffffff4}
+test format-1.10 {integer formatting} {nonPortable} {
+    format "%-#20x %-#20x %-#20x %-#20x" 6 34 16923 -12 -1
+} {0x6                  0x22                 0x421b               0xfffffff4          }
+test format-1.11 {integer formatting} {nonPortable} {
+    format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
+} {06                   042                  041033               037777777764        }
+
+test format-2.1 {string formatting} {
+    format "%s %s %c %s" abcd {This is a very long test string.} 120 x
+} {abcd This is a very long test string. x x}
+test format-2.2 {string formatting} {
+    format "%20s %20s %20c %20s" abcd {This is a very long test string.} 120 x
+} {                abcd This is a very long test string.                    x                    x}
+test format-2.3 {string formatting} {
+    format "%.10s %.10s %c %.10s" abcd {This is a very long test string.} 120 x
+} {abcd This is a  x x}
+test format-2.4 {string formatting} {
+    format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x
+} {abcd This is a very long test string. % x x}
+
+test format-3.1 {e and f formats} {eformat} {
+    format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053
+} {3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
+test format-3.2 {e and f formats} {eformat} {
+    format "%20e %20e %20e %20e" 34.2e12 68.514 -.125 -16000. .000053
+} {        3.420000e+13         6.851400e+01        -1.250000e-01        -1.600000e+04}
+if {!$roundOffBug} {
+    test format-3.3 {e and f formats} {eformat} {
+	format "%.1e %.1e %.1e %.1e" 34.2e12 68.514 -.126 -16000. .000053
+    } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
+    test format-3.4 {e and f formats} {eformat} {
+	format "%020e %020e %020e %020e" 34.2e12 68.514 -.126 -16000. .000053
+    } {000000003.420000e+13 000000006.851400e+01 -00000001.260000e-01 -00000001.600000e+04}
+    test format-3.5 {e and f formats} {eformat} {
+	format "%7.1e %7.1e %7.1e %7.1e" 34.2e12 68.514 -.126 -16000. .000053
+    } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
+    test format-3.6 {e and f formats} {
+	format "%f %f %f %f" 34.2e12 68.514 -.125 -16000. .000053
+    } {34200000000000.000000 68.514000 -0.125000 -16000.000000}
+}
+test format-3.7 {e and f formats} {nonPortable} {
+    format "%.4f %.4f %.4f %.4f %.4f" 34.2e12 68.514 -.125 -16000. .000053
+} {34200000000000.0000 68.5140 -0.1250 -16000.0000 0.0001}
+test format-3.8 {e and f formats} {eformat} {
+    format "%.4e %.5e %.6e" -9.99996 -9.99996 9.99996
+} {-1.0000e+01 -9.99996e+00 9.999960e+00}
+test format-3.9 {e and f formats} {
+    format "%.4f %.5f %.6f" -9.99996 -9.99996 9.99996
+} {-10.0000 -9.99996 9.999960}
+test format-3.10 {e and f formats} {
+    format "%20f %-20f %020f" -9.99996 -9.99996 9.99996
+} {           -9.999960 -9.999960            0000000000009.999960}
+test format-3.11 {e and f formats} {
+    format "%-020f %020f" -9.99996 -9.99996 9.99996
+} {-9.999960            -000000000009.999960}
+test format-3.12 {e and f formats} {eformat} {
+    format "%.0e %#.0e" -9.99996 -9.99996 9.99996
+} {-1e+01 -1.e+01}
+test format-3.13 {e and f formats} {
+    format "%.0f %#.0f" -9.99996 -9.99996 9.99996
+} {-10 -10.}
+test format-3.14 {e and f formats} {
+    format "%.4f %.5f %.6f" -9.99996 -9.99996 9.99996
+} {-10.0000 -9.99996 9.999960}
+test format-3.15 {e and f formats} {
+    format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001
+} {  1   1   1   1}
+test format-3.16 {e and f formats} {
+    format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001
+} {0.0 0.1 0.0 0.0}
+
+test format-4.1 {g-format} {eformat} {
+    format "%.3g" 12341.0
+} {1.23e+04}
+test format-4.2 {g-format} {eformat} {
+    format "%.3G" 1234.12345
+} {1.23E+03}
+test format-4.3 {g-format} {
+    format "%.3g" 123.412345
+} {123}
+test format-4.4 {g-format} {
+    format "%.3g" 12.3412345
+} {12.3}
+test format-4.5 {g-format} {
+    format "%.3g" 1.23412345
+} {1.23}
+test format-4.6 {g-format} {
+    format "%.3g" 1.23412345
+} {1.23}
+test format-4.7 {g-format} {
+    format "%.3g" .123412345
+} {0.123}
+test format-4.8 {g-format} {
+    format "%.3g" .012341
+} {0.0123}
+test format-4.9 {g-format} {
+    format "%.3g" .0012341
+} {0.00123}
+test format-4.10 {g-format} {
+    format "%.3g" .00012341
+} {0.000123}
+test format-4.11 {g-format} {eformat} {
+    format "%.3g" .00001234
+} {1.23e-05}
+test format-4.12 {g-format} {eformat} {
+    format "%.4g" 9999.6
+} {1e+04}
+test format-4.13 {g-format} {
+    format "%.4g" 999.96
+} {1000}
+test format-4.14 {g-format} {
+    format "%.3g" 1.0
+} {1}
+test format-4.15 {g-format} {
+    format "%.3g" .1
+} {0.1}
+test format-4.16 {g-format} {
+    format "%.3g" .01
+} {0.01}
+test format-4.17 {g-format} {
+    format "%.3g" .001
+} {0.001}
+test format-4.18 {g-format} {eformat} {
+    format "%.3g" .00001
+} {1e-05}
+test format-4.19 {g-format} {eformat} {
+    format "%#.3g" 1234.0
+} {1.23e+03}
+test format-4.20 {g-format} {eformat} {
+    format "%#.3G" 9999.5
+} {1.00E+04}
+
+test format-5.1 {floating-point zeroes} {eformat} {
+    format "%e %f %g" 0.0 0.0 0.0 0.0
+} {0.000000e+00 0.000000 0}
+test format-5.2 {floating-point zeroes} {eformat} {
+    format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0
+} {0.0000e+00 0.0000 0}
+test format-5.3 {floating-point zeroes} {eformat} {
+    format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0
+} {0.0000e+00 0.0000 0.000}
+test format-5.4 {floating-point zeroes} {eformat} {
+    format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0
+} {0e+00 0 0}
+test format-5.5 {floating-point zeroes} {eformat} {
+    format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0
+} {0.e+00 0. 0.}
+test format-5.6 {floating-point zeroes} {
+    format "%3.0f %3.0f %3.0f %3.0f" 0.0 0.0 0.0 0.0
+} {  0   0   0   0}
+test format-5.7 {floating-point zeroes} {
+    format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001
+} {  1   1   1   1}
+test format-5.8 {floating-point zeroes} {
+    format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001
+} {0.0 0.1 0.0 0.0}
+
+test format-6.1 {various syntax features} {
+    format "%*.*f" 12 3 12.345678901
+} {      12.346}
+test format-6.2 {various syntax features} {
+    format "%0*.*f" 12 3 12.345678901
+} {00000012.346}
+test format-6.3 {various syntax features} {
+    format "\*\t\\n"
+} {*	\n}
+
+test format-7.1 {error conditions} {
+    catch format
+} 1
+test format-7.2 {error conditions} {
+    catch format msg
+    set msg
+} {wrong # args: should be "format formatString ?arg arg ...?"}
+test format-7.3 {error conditions} {
+    catch {format %*d}
+} 1
+test format-7.4 {error conditions} {
+    catch {format %*d} msg
+    set msg
+} {not enough arguments for all format specifiers}
+test format-7.5 {error conditions} {
+    catch {format %*.*f 12}
+} 1
+test format-7.6 {error conditions} {
+    catch {format %*.*f 12} msg
+    set msg
+} {not enough arguments for all format specifiers}
+test format-7.7 {error conditions} {
+    catch {format %*.*f 12 3}
+} 1
+test format-7.8 {error conditions} {
+    catch {format %*.*f 12 3} msg
+    set msg
+} {not enough arguments for all format specifiers}
+test format-7.9 {error conditions} {
+    list [catch {format %*d x 3} msg] $msg
+} {1 {expected integer but got "x"}}
+test format-7.10 {error conditions} {
+    list [catch {format %*.*f 2 xyz 3} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test format-7.11 {error conditions} {
+    catch {format %d 2a}
+} 1
+test format-7.12 {error conditions} {
+    catch {format %d 2a} msg
+    set msg
+} {expected integer but got "2a"}
+test format-7.13 {error conditions} {
+    catch {format %c 2x}
+} 1
+test format-7.14 {error conditions} {
+    catch {format %c 2x} msg
+    set msg
+} {expected integer but got "2x"}
+test format-7.15 {error conditions} {
+    catch {format %f 2.1z}
+} 1
+test format-7.16 {error conditions} {
+    catch {format %f 2.1z} msg
+    set msg
+} {expected floating-point number but got "2.1z"}
+test format-7.17 {error conditions} {
+    catch {format ab%}
+} 1
+test format-7.18 {error conditions} {
+    catch {format ab% 12} msg
+    set msg
+} {format string ended in middle of field specifier}
+test format-7.19 {error conditions} {
+    catch {format %q x}
+} 1
+test format-7.20 {error conditions} {
+    catch {format %q x} msg
+    set msg
+} {bad field specifier "q"}
+test format-7.21 {error conditions} {
+    catch {format %d}
+} 1
+test format-7.22 {error conditions} {
+    catch {format %d} msg
+    set msg
+} {not enough arguments for all format specifiers}
+test format-7.23 {error conditions} {
+    catch {format "%d %d" 24 xyz} msg
+    set msg
+} {expected integer but got "xyz"}
+
+test format-8.1 {long result} {
+    set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
+    format {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 %s %s} $a $a
+} {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 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
+
+test format-9.1 {"h" format specifier} {nonPortable} {
+    format %hd 0xffff
+} -1
+test format-9.2 {"h" format specifier} {nonPortable} {
+    format %hx 0x10fff
+} fff
+test format-9.3 {"h" format specifier} {nonPortable} {
+    format %hd 0x10000
+} 0
+
+test format-10.1 {XPG3 %$n specifiers} {
+    format {%2$d %1$d} 4 5
+} {5 4}
+test format-10.2 {XPG3 %$n specifiers} {
+    format {%2$d %1$d %1$d %3$d} 4 5 6
+} {5 4 4 6}
+test format-10.3 {XPG3 %$n specifiers} {
+    list [catch {format {%2$d %3$d} 4 5} msg] $msg
+} {1 {"%n$" argument index out of range}}
+test format-10.4 {XPG3 %$n specifiers} {
+    list [catch {format {%2$d %0$d} 4 5 6} msg] $msg
+} {1 {"%n$" argument index out of range}}
+test format-10.5 {XPG3 %$n specifiers} {
+    list [catch {format {%d %1$d} 4 5 6} msg] $msg
+} {1 {cannot mix "%" and "%n$" conversion specifiers}}
+test format-10.6 {XPG3 %$n specifiers} {
+    list [catch {format {%2$d %d} 4 5 6} msg] $msg
+} {1 {cannot mix "%" and "%n$" conversion specifiers}}
+test format-10.7 {XPG3 %$n specifiers} {
+    list [catch {format {%2$d %3d} 4 5 6} msg] $msg
+} {1 {cannot mix "%" and "%n$" conversion specifiers}}
+test format-10.8 {XPG3 %$n specifiers} {
+    format {%2$*d %3$d} 1 10 4
+} {         4 4}
+test format-10.9 {XPG3 %$n specifiers} {
+    format {%2$.*s %4$d} 1 5 abcdefghijklmnop 44
+} {abcde 44}
+test format-10.10 {XPG3 %$n specifiers} {
+    list [catch {format {%2$*d} 4} msg] $msg
+} {1 {"%n$" argument index out of range}}
+test format-10.11 {XPG3 %$n specifiers} {
+    list [catch {format {%2$*d} 4 5} msg] $msg
+} {1 {"%n$" argument index out of range}}
+test format-10.12 {XPG3 %$n specifiers} {
+    list [catch {format {%2$*d} 4 5 6} msg] $msg
+} {0 {    6}}
+
+test format-11.1 {negative width specifiers} {
+    format "%*d" -47 25
+} {25}
+test format-12.1 {tcl_precision fuzzy comparison} {
+    catch {unset a}
+    catch {unset b}
+    catch {unset c}
+    catch {unset d}
+    set a 0.0000000000001
+    set b 0.00000000000001
+    set c 0.00000000000000001
+    set d [expr $a + $b + $c]
+    format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
+} {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001}
+test format-12.2 {tcl_precision fuzzy comparison} {
+    catch {unset a}
+    catch {unset b}
+    catch {unset c}
+    catch {unset d}
+    set a 0.000000000001
+    set b 0.000000000000005
+    set c 0.0000000000000008
+    set d [expr $a + $b + $c]
+    format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
+} {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580}
+test format-12.3 {tcl_precision fuzzy comparison} {
+    catch {unset a}
+    catch {unset b}
+    catch {unset c}
+    set a 0.00000000000099
+    set b 0.000000000000011
+    set c [expr $a + $b]
+    format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c
+} {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100}
+test format-12.4 {tcl_precision fuzzy comparison} {
+    catch {unset a}
+    catch {unset b}
+    catch {unset c}
+    set a 0.444444444444
+    set b 0.33333333333333
+    set c [expr $a + $b]
+    format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c
+} {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300}
+test format-12.5 {tcl_precision fuzzy comparison} {
+    catch {unset a}
+    catch {unset b}
+    catch {unset c}
+    set a 0.444444444444
+    set b 0.99999999999999
+    set c [expr $a + $b]
+    format {%0.10f %0.12f %0.15f} $c $c $c
+} {1.4444444444 1.444444444444 1.444444444443990}
+test format-13.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
+    format {%s} ""
+} {}
+test format-13.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
+    format {%s} "a"
+} {a}
+
+set a "0123456789"
+set b ""
+for {set i 0} {$i < 290} {incr i} {
+    append b $a
+}
+for {set i 290} {$i < 400} {incr i} {
+    test format-14.[expr $i -290] {testing MAX_FLOAT_SIZE} {
+        format {%s} $b    
+    } $b
+    append b "x"
+}
+
+
+catch {unset a}
+catch {unset b}
+catch {unset c}
+catch {unset d}
+return
diff --git a/tcl/tests/get.test b/tcl/tests/get.test
new file mode 100644
index 00000000000..f582048d411
--- /dev/null
+++ b/tcl/tests/get.test
@@ -0,0 +1,91 @@
+# Commands covered:  none
+#
+# This file contains a collection of tests for the procedures in the
+# file tclGet.c.  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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test get-1.1 {Tcl_GetInt procedure} {
+    set x 44
+    incr x { 	  22}
+} {66}
+test get-1.2 {Tcl_GetInt procedure} {
+    set x 44
+    incr x -3
+} {41}
+test get-1.3 {Tcl_GetInt procedure} {
+    set x 44
+    incr x +8
+} {52}
+test get-1.4 {Tcl_GetInt procedure} {
+    set x 44
+    list [catch {incr x foo} msg] $msg
+} {1 {expected integer but got "foo"}}
+test get-1.5 {Tcl_GetInt procedure} {
+    set x 44
+    list [catch {incr x {16	 }} msg] $msg
+} {0 60}
+test get-1.6 {Tcl_GetInt procedure} {
+    set x 44
+    list [catch {incr x {16	 x}} msg] $msg
+} {1 {expected integer but got "16	 x"}}
+
+# The following tests are non-portable because they depend on
+# word size.  18446744073709551614
+
+if {0x80000000 > 0} {
+    test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
+	set x 44
+	list [catch {incr x 18446744073709551616} msg] $msg $errorCode
+    } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x 18446744073709551614} msg] $msg
+    } {0 -2}
+    test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x +18446744073709551614} msg] $msg
+    } {0 -2}
+    test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x -18446744073709551614} msg] $msg
+    } {0 2}
+} else {
+    test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
+	set x 44
+	list [catch {incr x 4294967296} msg] $msg $errorCode
+    } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x 4294967294} msg] $msg
+    } {0 -2}
+    test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x +4294967294} msg] $msg
+    } {0 -2}
+    test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x -4294967294} msg] $msg
+    } {0 2}
+}
+
+test get-2.1 {Tcl_GetInt procedure} {
+    format %g 1.23
+} {1.23}
+test get-2.2 {Tcl_GetInt procedure} {
+    format %g { 	 1.23 	}
+} {1.23}
+test get-2.3 {Tcl_GetInt procedure} {
+    list [catch {format %g clip} msg] $msg
+} {1 {expected floating-point number but got "clip"}}
+test get-2.4 {Tcl_GetInt procedure} {nonPortable} {
+    list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode
+} {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}}
diff --git a/tcl/tests/history.test b/tcl/tests/history.test
new file mode 100644
index 00000000000..876bb78fb71
--- /dev/null
+++ b/tcl/tests/history.test
@@ -0,0 +1,211 @@
+# Commands covered:  history
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+  
+if {[catch {history}]} {
+    puts stdout "This version of Tcl was built without the history command;\n"
+    puts stdout "history tests will be skipped.\n"
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+set num [history nextid]
+history keep 3
+history add {set a 12345}
+history add {set b [format {A test %s} string]}
+history add {Another test}
+
+# "history event"
+
+test history-1.1 {event option} {history event -1} \
+	{set b [format {A test %s} string]}
+test history-1.2 {event option} {history event $num} \
+	{set a 12345}
+test history-1.3 {event option} {history event [expr $num+2]} \
+	{Another test}
+test history-1.4 {event option} {history event set} \
+	{set b [format {A test %s} string]}
+test history-1.5 {event option} {history e "* a*"} \
+	{set a 12345}
+test history-1.6 {event option} {catch {history event *gorp} msg} 1
+test history-1.7 {event option} {
+    catch {history event *gorp} msg
+    set msg
+} {no event matches "*gorp"}
+test history-1.8 {event option} {history event} \
+	{set b [format {A test %s} string]}
+test history-1.9 {event option} {catch {history event 123 456} msg} 1
+test history-1.10 {event option} {
+    catch {history event 123 456} msg
+    set msg
+} {wrong # args: should be "history event ?event?"}
+
+# "history redo"
+
+set a 0
+history redo -2
+test history-2.1 {redo option} {set a} 12345
+set b 0
+history redo
+test history-2.2 {redo option} {set b} {A test string}
+test history-2.3 {redo option} {catch {history redo -3 -4}} 1
+test history-2.4 {redo option} {
+    catch {history redo -3 -4} msg
+    set msg
+} {wrong # args: should be "history redo ?event?"}
+
+# "history add"
+
+history add "set a 444" exec
+test history-3.1 {add option} {set a} 444
+test history-3.2 {add option} {catch {history add "set a 444" execGorp}} 1
+test history-3.3 {add option} {
+    catch {history add "set a 444" execGorp} msg
+    set msg
+} {bad argument "execGorp": should be "exec"}
+test history-3.4 {add option} {catch {history add "set a 444" a} msg} 1
+test history-3.5 {add option} {
+    catch {history add "set a 444" a} msg
+    set msg
+} {bad argument "a": should be "exec"}
+history add "set a 555" e
+test history-3.6 {add option} {set a} 555
+history add "set a 666"
+test history-3.7 {add option} {set a} 555
+test history-3.8 {add option} {catch {history add "set a 666" e f} msg} 1
+test history-3.9 {add option} {
+    catch {history add "set a 666" e f} msg
+    set msg
+} {wrong # args: should be "history add event ?exec?"}
+
+# "history change"
+
+history change "A test value"
+test history-4.1 {change option} {history event [expr {[history n]-1}]} \
+	"A test value"
+history ch "Another test" -1
+test history-4.2 {change option} {history e} "Another test"
+test history-4.3 {change option} {history event [expr {[history n]-1}]} \
+	"A test value"
+test history-4.4 {change option} {catch {history change Foo 4 10}} 1
+test history-4.5 {change option} {
+    catch {history change Foo 4 10} msg
+    set msg
+} {wrong # args: should be "history change newValue ?event?"}
+test history-4.6 {change option} {
+    catch {history change Foo [expr {[history n]-4}]}
+} 1
+set num [expr {[history n]-4}]
+test history-4.7 {change option} {
+    catch {history change Foo $num} msg
+    set msg
+} "event \"$num\" is too far in the past"
+
+# "history info"
+
+set num [history n]
+history add set\ a\ {b\nc\ d\ e}
+history add {set b 1234}
+history add set\ c\ {a\nb\nc}
+test history-5.1 {info option} {history info} [format {%6d  set a {b
+	c d e}
+%6d  set b 1234
+%6d  set c {a
+	b
+	c}} $num [expr $num+1] [expr $num+2]]
+test history-5.2 {info option} {history i 2} [format {%6d  set b 1234
+%6d  set c {a
+	b
+	c}} [expr $num+1] [expr $num+2]]
+test history-5.3 {info option} {catch {history i 2 3}} 1
+test history-5.4 {info option} {
+    catch {history i 2 3} msg
+    set msg
+} {wrong # args: should be "history info ?count?"}
+test history-5.5 {info option} {history} [format {%6d  set a {b
+	c d e}
+%6d  set b 1234
+%6d  set c {a
+	b
+	c}} $num [expr $num+1] [expr $num+2]]
+
+# "history keep"
+
+history add "foo1"
+history add "foo2"
+history add "foo3"
+history keep 2
+test history-6.1 {keep option} {history event [expr [history n]-1]} foo3
+test history-6.2 {keep option} {history event -1} foo2
+test history-6.3 {keep option} {catch {history event -3}} 1
+test history-6.4 {keep option} {
+    catch {history event -3} msg
+    set msg
+} {event "-3" is too far in the past}
+history k 5
+test history-6.5 {keep option} {history event -1} foo2
+test history-6.6 {keep option} {history event -2} {}
+test history-6.7 {keep option} {history event -3} {}
+test history-6.8 {keep option} {history event -4} {}
+test history-6.9 {keep option} {catch {history event -5}} 1
+test history-6.10 {keep option} {catch {history keep 4 6}} 1
+test history-6.11 {keep option} {
+    catch {history keep 4 6} msg
+    set msg
+} {wrong # args: should be "history keep ?count?"}
+test history-6.12 {keep option} {catch {history keep}} 0
+test history-6.13 {keep option} {
+    history keep
+} {5}
+test history-6.14 {keep option} {catch {history keep -3}} 1
+test history-6.15 {keep option} {
+    catch {history keep -3} msg
+    set msg
+} {illegal keep count "-3"}
+test history-6.16 {keep option} {
+    catch {history keep butter} msg
+    set msg
+} {illegal keep count "butter"}
+
+# "history nextid"
+
+set num [history n]
+history add "Testing"
+history add "Testing2"
+test history-7.1 {nextid option} {history event} "Testing"
+test history-7.2 {nextid option} {history next} [expr $num+2]
+test history-7.3 {nextid option} {catch {history nextid garbage}} 1
+test history-7.4 {nextid option} {
+    catch {history nextid garbage} msg
+    set msg
+} {wrong # args: should be "history nextid"}
+
+# "history clear"
+
+set num [history n]
+history add "Testing"
+history add "Testing2"
+test history-8.1 {clear option} {catch {history clear junk}} 1
+test history-8.2 {clear option} {history clear} {}
+history add "Testing"
+test history-8.3 {clear option} {history} {     1  Testing}
+
+# miscellaneous
+
+test history-9.1 {miscellaneous} {catch {history gorp} msg} 1
+test history-9.2 {miscellaneous} {
+    catch {history gorp} msg
+    set msg
+} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
+
diff --git a/tcl/tests/http.test b/tcl/tests/http.test
new file mode 100644
index 00000000000..aa85e36406b
--- /dev/null
+++ b/tcl/tests/http.test
@@ -0,0 +1,417 @@
+# Commands covered:  http::config, http::geturl, 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.
+#
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {[catch {package require http 2.0}]} {
+    if {[info exist http2]} {
+	catch {puts stderr "Cannot load http 2.0 package"}
+	return
+    } else {
+	catch {puts stderr "Running http 2.0 tests in slave interp"}
+	set interp [interp create http2]
+	$interp eval [list set http2 "running"]
+	$interp eval [list source [info script]]
+	interp delete $interp
+	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.
+
+set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
+proc httpdRespond { sock } {
+    global httpd bindata port
+    upvar #0 httpd$sock data
+
+    if {[string match *binary* $data(url)]} {
+	set html "$bindata[info hostname]:$port$data(url)"
+	set type application/octet-stream
+    } else {
+	set type text/html
+
+	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"
+		if {[string compare $key timeout] == 0} {
+		    # Simulate a timeout by not responding,
+		    # but clean up our socket later.
+
+		    after 50 [list httpdSockDone $sock]
+		    httpd_log $sock Noresponse ""
+		    return
+		}
+	    }
+	    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: $type"
+    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 ###########################
+
+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 http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.0}}
+
+test http-1.2 {http::config} {
+    http::config -proxyfilter
+} http::ProxyRequired
+
+test http-1.3 {http::config} {
+    catch {http::config -junk}
+} 1
+
+test http-1.4 {http::config} {
+    set savedconf [http::config]
+    http::config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
+    set x [http::config]
+    eval http::config $savedconf
+    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::geturl} {
+    catch {http::geturl -bogus flag}
+} 1
+test http-3.2 {http::geturl} {
+    catch {http::geturl http:junk} err
+    set err
+} {Unsupported URL: http:junk}
+
+set url [info hostname]:$port
+test http-3.3 {http::geturl} {
+    set token [http::geturl $url]
+    http::data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET /</h2>
+</body></html>"
+
+set tail /a/b/c
+set url [info hostname]:$port/a/b/c
+set binurl [info hostname]:$port/binary
+
+test http-3.4 {http::geturl} {
+    set token [http::geturl $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.5 {http::geturl} {
+    http::config -proxyfilter selfproxy
+    set token [http::geturl $url]
+    http::config -proxyfilter http::ProxyRequired
+    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.6 {http::geturl} {
+    http::config -proxyfilter bogus
+    set token [http::geturl $url]
+    http::config -proxyfilter http::ProxyRequired
+    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::geturl} {
+    set token [http::geturl $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.8 {http::geturl} {
+    set token [http::geturl $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.9 {http::geturl} {
+    set token [http::geturl $url -validate 1]
+    http::code $token
+} "HTTP/1.0 200 OK"
+
+
+test http-4.1 {http::Event} {
+    set token [http::geturl $url]
+    upvar #0 $token data
+    array set meta $data(meta)
+    expr ($data(totalsize) == $meta(Content-Length))
+} 1
+
+test http-4.2 {http::Event} {
+    set token [http::geturl $url]
+    upvar #0 $token data
+    array set meta $data(meta)
+    string compare $data(type) [string trim $meta(Content-Type)]
+} 0
+
+test http-4.3 {http::Event} {
+    set token [http::geturl $url]
+    http::code $token
+} {HTTP/1.0 200 Data follows}
+
+test http-4.4 {http::Event} {
+    set out [open testfile w]
+    set token [http::geturl $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 {http::Event} {
+    set out [open testfile w]
+    set token [http::geturl $url -channel $out]
+    close $out
+    upvar #0 $token data
+    file delete testfile
+    expr $data(currentsize) == $data(totalsize)
+} 1
+
+test http-4.6 {http::Event} {
+    set out [open testfile w]
+    set token [http::geturl $binurl -channel $out]
+    close $out
+    set in [open testfile]
+    fconfigure $in -translation binary
+    set x [read $in]
+    close $in
+    file delete testfile
+    set x
+} "$bindata$binurl"
+
+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 {http::Event} {
+	set token [http::geturl $url -blocksize 50 -progress myProgress]
+	set progress
+    } {111 111}
+}
+test http-4.7 {http::Event} {
+    set token [http::geturl $url -progress myProgress]
+    set progress
+} {111 111}
+test http-4.8 {http::Event} {
+    set token [http::geturl $url]
+    http::status $token
+} {ok}
+test http-4.9 {http::Event} {
+    set token [http::geturl $url -progress myProgress]
+    http::code $token
+} {HTTP/1.0 200 Data follows}
+test http-4.10 {http::Event} {
+    set token [http::geturl $url -progress myProgress]
+    http::size $token
+} {111}
+test http-4.11 {http::Event} {
+    set token [http::geturl $url -timeout 1 -command {#}]
+    http::reset $token
+    http::status $token
+} {reset}
+test http-4.12 {http::Event} {
+    set token [http::geturl $url?timeout=10 -timeout 1 -command {#}]
+    http::wait $token
+    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 {http::ProxyRequired} {
+    http::config -proxyhost [info hostname] -proxyport $port
+    set token [http::geturl $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/tcl/tests/httpold.test b/tcl/tests/httpold.test
new file mode 100644
index 00000000000..79c3483ceca
--- /dev/null
+++ b/tcl/tests/httpold.test
@@ -0,0 +1,411 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+
+if {[catch {package require http 1.0}]} {
+    if {[info exist httpold]} {
+	catch {puts stderr "Cannot load http 1.0 package"}
+	return
+    } else {
+	catch {puts stderr "Running http 1.0 tests in slave interp"}
+	set interp [interp create httpold]
+	$interp eval [list set httpold "running"]
+	$interp eval [list source [info script]]
+	interp delete $interp
+	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
+    catch {close $sock}
+}
+
+# Respond to the query.
+
+set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
+proc httpdRespond { sock } {
+    global httpd bindata port
+    upvar #0 httpd$sock data
+
+    if {[string match *binary* $data(url)]} {
+	set html "$bindata[info hostname]:$port$data(url)"
+	set type application/octet-stream
+    } else {
+	set type text/html
+
+	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: $type"
+    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 ###########################
+
+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 \
+	-useragent "Tcl http client package 1.0"
+    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 http:junk} err
+    set err
+} {Unsupported URL: http:junk}
+
+set url [info hostname]:$port
+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 /</h2>
+</body></html>"
+
+set tail /a/b/c
+set url [info hostname]:$port/a/b/c
+set binurl [info hostname]:$port/binary
+
+test http-3.4 {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.5 {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.6 {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.7 {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.8 {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.9 {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
+
+test http-4.6 {httpEvent} {
+    set out [open testfile w]
+    set token [http_get $binurl -channel $out]
+    close $out
+    set in [open testfile]
+    fconfigure $in -translation binary
+    set x [read $in]
+    close $in
+    file delete testfile
+    set x
+} "$bindata$binurl"
+
+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} {
+    update
+    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} {
+    update
+    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/tcl/tests/if-old.test b/tcl/tests/if-old.test
new file mode 100644
index 00000000000..5b0630ebc89
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/if.test b/tcl/tests/if.test
new file mode 100644
index 00000000000..71c5110c850
--- /dev/null
+++ b/tcl/tests/if.test
@@ -0,0 +1,505 @@
+# Commands covered:  if
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# 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 {1+}"}}
+test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
+    set a {}
+    if {1<2} {set a 1}
+    set a
+} {1}
+test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
+    set a {}
+    if 1<2 {set a 1}
+    set a
+} {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" then script line 1)
+    while compiling
+"if {$a!="xxx"} then {set}"}}
+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.15 {TclCompileIfCmd: taking proper branch} {
+    set a {}
+    if 1>2 {set a 1}
+    set a
+} {}
+test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" 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
+    }
+    set a
+} 3
+test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
+    set a {}
+    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}
+# 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 {}
+    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 {}
+    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 3>4 {set a 1} elseif {1>}"}}
+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
+} 6
+
+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
+} 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 line 1)
+    while compiling
+"if 2<1 {set a 1} else {set}"}
+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
+} 9
+
+test if-4.1 {TclCompileIfCmd: "if" command result} {
+    set a {}
+    set a [if 3<4 {set i 27}]
+    set a
+} 27
+test if-4.2 {TclCompileIfCmd: "if" command result} {
+    set a {}
+    set a [if 3>4 {set i 27}]
+    set a
+} {}
+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-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-4.5 {TclCompileIfCmd: return value} {
+    if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
+} def
+
+# 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/tcl/tests/incr-old.test b/tcl/tests/incr-old.test
new file mode 100644
index 00000000000..b506be745f5
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/incr.test b/tcl/tests/incr.test
new file mode 100644
index 00000000000..4e338878814
--- /dev/null
+++ b/tcl/tests/incr.test
@@ -0,0 +1,246 @@
+# 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) 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Basic "incr" operation.
+
+catch {unset x}
+catch {unset i}
+
+test incr-1.1 {TclCompileIncrCmd: missing variable name} {
+    list [catch {incr} msg] $msg
+} {1 {wrong # args: should be "incr varName ?increment?"}}
+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"
+    (increment expression)
+    while compiling
+"incr i [set]"}
+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 {"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 [set]"}}
+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
+    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-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
+    set x "  -  "
+    list [catch {incr x 1} msg] $msg
+} {1 {expected integer but got "  -  "}}
+    
+# Check "incr" and computed command names.
+
+test incr-2.1 {incr and computed command names} {
+    set i 5
+    set z incr
+    $z i -1
+    set i
+} 4
diff --git a/tcl/tests/indexObj.test b/tcl/tests/indexObj.test
new file mode 100644
index 00000000000..ea4c0750bea
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/info.test b/tcl/tests/info.test
new file mode 100644
index 00000000000..3149035c1bf
--- /dev/null
+++ b/tcl/tests/info.test
@@ -0,0 +1,596 @@
+# Commands covered:  info
+#
+# 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-1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test info-1.1 {info args option} {
+    proc t1 {a bbb c} {return foo}
+    info args t1
+} {a bbb c}
+test info-1.2 {info args option} {
+    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
+    info a t1
+} {a bbb c args}
+test info-1.3 {info args option} {
+    proc t1 "" {return foo}
+    info args t1
+} {}
+test info-1.4 {info args option} {
+    catch {rename t1 {}}
+    list [catch {info args t1} msg] $msg
+} {1 {"t1" isn't a procedure}}
+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}
+    info body t1
+} {body of t1}
+test info-2.2 {info body option} {
+    list [catch {info body set} msg] $msg
+} {1 {"set" isn't a procedure}}
+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
+} 1
+test info-3.2 {info body option} {
+    list [catch {info cmdcount 1} msg] $msg
+} {1 {wrong # args: should be "info cmdcount"}}
+
+test info-4.1 {info commands option} {
+    proc t1 {} {}
+    proc t2 {} {}
+    set x " [info commands] "
+    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
+            [string match {* set *} $x] [string match {* list *} $x]
+} {1 1 1 1}
+test info-4.2 {info commands option} {
+    proc t1 {} {}
+    rename t1 {}
+    set x [info comm]
+    string match {* t1 *} $x
+} 0
+test info-4.3 {info commands option} {
+    proc _t1_ {} {}
+    proc _t2_ {} {}
+    info commands _t1_
+} _t1_
+test info-4.4 {info commands option} {
+    proc _t1_ {} {}
+    proc _t2_ {} {}
+    lsort [info commands _t*]
+} {_t1_ _t2_}
+catch {rename _t1_ {}}
+catch {rename _t2_ {}}
+test info-4.5 {info commands option} {
+    list [catch {info commands a b} msg] $msg
+} {1 {wrong # args: should be "info commands ?pattern?"}}
+
+test info-5.1 {info complete option} {
+    info complete ""
+} 1
+test info-5.2 {info complete option} {
+    info complete "  \n"
+} 1
+test info-5.3 {info complete option} {
+    info complete "abc def"
+} 1
+test info-5.4 {info complete option} {
+    info complete "a b c d e f \t\n"
+} 1
+test info-5.5 {info complete option} {
+    info complete {a b c"d}
+} 1
+test info-5.6 {info complete option} {
+    info complete {a b "c d" e}
+} 1
+test info-5.7 {info complete option} {
+    info complete {a b "c d"}
+} 1
+test info-5.8 {info complete option} {
+    info complete {a b "c d"}
+} 1
+test info-5.9 {info complete option} {
+    info complete {a b "c d}
+} 0
+test info-5.10 {info complete option} {
+    info complete {a b "}
+} 0
+test info-5.11 {info complete option} {
+    info complete {a b "cd"xyz}
+} 1
+test info-5.12 {info complete option} {
+    info complete {a b "c $d() d"}
+} 1
+test info-5.13 {info complete option} {
+    info complete {a b "c $dd("}
+} 0
+test info-5.14 {info complete option} {
+    info complete {a b "c \"}
+} 0
+test info-5.15 {info complete option} {
+    info complete {a b "c [d e f]"}
+} 1
+test info-5.16 {info complete option} {
+    info complete {a b "c [d e f] g"}
+} 1
+test info-5.17 {info complete option} {
+    info complete {a b "c [d e f"}
+} 0
+test info-5.18 {info complete option} {
+    info complete {a {b c d} e}
+} 1
+test info-5.19 {info complete option} {
+    info complete {a {b c d}}
+} 1
+test info-5.20 {info complete option} {
+    info complete "a b\{c d"
+} 1
+test info-5.21 {info complete option} {
+    info complete "a b \{c"
+} 0
+test info-5.22 {info complete option} {
+    info complete "a b \{c{ }"
+} 0
+test info-5.23 {info complete option} {
+    info complete "a b {c d e}xxx"
+} 1
+test info-5.24 {info complete option} {
+    info complete "a b {c \\\{d e}xxx"
+} 1
+test info-5.25 {info complete option} {
+    info complete {a b [ab cd ef]}
+} 1
+test info-5.26 {info complete option} {
+    info complete {a b x[ab][cd][ef] gh}
+} 1
+test info-5.27 {info complete option} {
+    info complete {a b x[ab][cd[ef] gh}
+} 0
+test info-5.28 {info complete option} {
+    info complete {a b x[ gh}
+} 0
+test info-5.29 {info complete option} {
+    info complete {[]]]}
+} 1
+test info-5.30 {info complete option} {
+    info complete {abc x$yyy}
+} 1
+test info-5.31 {info complete option} {
+    info complete "abc x\${abc\[\\d} xyz"
+} 1
+test info-5.32 {info complete option} {
+    info complete "abc x\$\{ xyz"
+} 0
+test info-5.33 {info complete option} {
+    info complete {word $a(xyz)}
+} 1
+test info-5.34 {info complete option} {
+    info complete {word $a(}
+} 0
+test info-5.35 {info complete option} {
+    info complete "set a \\\n"
+} 0
+test info-5.36 {info complete option} {
+    info complete "set a \\n "
+} 1
+test info-5.37 {info complete option} {
+    info complete "set a \\"
+} 1
+test info-5.38 {info complete option} {
+    info complete "foo \\\n\{"
+} 0
+test info-5.39 {info complete option} {
+    info complete " # \{"
+} 1
+test info-5.40 {info complete option} {
+    info complete "foo bar;# \{"
+} 1
+test info-5.41 {info complete option} {
+    info complete "a\nb\n# \{\n# \{\nc\n"
+} 1
+test info-5.42 {info complete option} {
+    info complete "#Incomplete comment\\\n"
+} 0
+test info-5.43 {info complete option} {
+    info complete "#Incomplete comment\\\nBut now it's complete.\n"
+} 1
+test info-5.44 {info complete option} {
+    info complete "# Complete comment\\\\\n"
+} 1
+test info-5.45 {info complete option} {
+    info complete "abc\\\n def"
+} 1
+test info-5.46 {info complete option} {
+    info complete "abc\\\n "
+} 1
+test info-5.47 {info complete option} {
+    info complete "abc\\\n"
+} 0
+test info-5.48 {info complete option} {
+    info complete "set x [binary format H 00]; puts hi"
+} 1
+test info-5.49 {info complete option} {
+    info complete "set x [binary format H 00]; \{"
+} 0
+
+test info-6.1 {info default option} {
+    proc t1 {a b {c d} {e "long default value"}} {}
+    info default t1 a value
+} 0
+test info-6.2 {info default option} {
+    proc t1 {a b {c d} {e "long default value"}} {}
+    set value 12345
+    info d t1 a value
+    set value
+} {}
+test info-6.3 {info default option} {
+    proc t1 {a b {c d} {e "long default value"}} {}
+    info default t1 c value
+} 1
+test info-6.4 {info default option} {
+    proc t1 {a b {c d} {e "long default value"}} {}
+    set value 12345
+    info default t1 c value
+    set value
+} d
+test info-6.5 {info default option} {
+    proc t1 {a b {c d} {e "long default value"}} {}
+    set value 12345
+    set x [info default t1 e value]
+    list $x $value
+} {1 {long default value}}
+test info-6.6 {info default option} {
+    list [catch {info default a b} msg] $msg
+} {1 {wrong # args: should be "info default procname arg varname"}}
+test info-6.7 {info default option} {
+    list [catch {info default _nonexistent_ a b} msg] $msg
+} {1 {"_nonexistent_" isn't a procedure}}
+test info-6.8 {info default option} {
+    proc t1 {a b} {}
+    list [catch {info default t1 x value} msg] $msg
+} {1 {procedure "t1" doesn't have an argument "x"}}
+test info-6.9 {info default option} {
+    catch {unset a}
+    set a(0) 88
+    proc t1 {a b} {}
+    list [catch {info default t1 a a} msg] $msg
+} {1 {couldn't store default value in variable "a"}}
+test info-6.10 {info default option} {
+    catch {unset a}
+    set a(0) 88
+    proc t1 {{a 18} b} {}
+    list [catch {info default t1 a a} msg] $msg
+} {1 {couldn't store default value in variable "a"}}
+catch {unset a}
+
+test info-7.1 {info exists option} {
+    set value foo
+    info exists value
+} 1
+catch {unset _nonexistent_}
+test info-7.2 {info exists option} {
+    info exists _nonexistent_
+} 0
+test info-7.3 {info exists option} {
+    proc t1 {x} {return [info exists x]}
+    t1 2
+} 1
+test info-7.4 {info exists option} {
+    proc t1 {x} {
+        global _nonexistent_
+        return [info exists _nonexistent_]
+    }
+    t1 2
+} 0
+test info-7.5 {info exists option} {
+    proc t1 {x} {
+        set y 47
+        return [info exists y]
+    }
+    t1 2
+} 1
+test info-7.6 {info exists option} {
+    proc t1 {x} {return [info exists value]}
+    t1 2
+} 0
+test info-7.7 {info exists option} {
+    catch {unset x}
+    set x(2) 44
+    list [info exists x] [info exists x(1)] [info exists x(2)]
+} {1 0 1}
+catch {unset x}
+test info-7.8 {info exists option} {
+    list [catch {info exists} msg] $msg
+} {1 {wrong # args: should be "info exists varName"}}
+test info-7.9 {info exists option} {
+    list [catch {info exists 1 2} msg] $msg
+} {1 {wrong # args: should be "info exists varName"}}
+
+test info-8.1 {info globals option} {
+    set x 1
+    set y 2
+    set value 23
+    set a " [info globals] "
+    list [string match {* x *} $a] [string match {* y *} $a] \
+            [string match {* value *} $a] [string match {* _foobar_ *} $a]
+} {1 1 1 0}
+test info-8.2 {info globals option} {
+    set _xxx1 1
+    set _xxx2 2
+    lsort [info g _xxx*]
+} {_xxx1 _xxx2}
+test info-8.3 {info globals option} {
+    list [catch {info globals 1 2} msg] $msg
+} {1 {wrong # args: should be "info globals ?pattern?"}}
+
+test info-9.1 {info level option} {
+    info level
+} 0
+test info-9.2 {info level option} {
+    proc t1 {a b} {
+        set x [info le]
+        set y [info level 1]
+        list $x $y
+    }
+    t1 146 testString
+} {1 {t1 146 testString}}
+test info-9.3 {info level option} {
+    proc t1 {a b} {
+        t2 [expr $a*2] $b
+    }
+    proc t2 {x y} {
+        list [info level] [info level 1] [info level 2] [info level -1] \
+                [info level 0]
+    }
+    t1 146 {a {b c} {{{c}}}}
+} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
+test info-9.4 {info level option} {
+    proc t1 {} {
+        set x [info level]
+        set y [info level 1]
+        list $x $y
+    }
+    t1
+} {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?"}}
+test info-9.6 {info level option} {
+    list [catch {info level 123a} msg] $msg
+} {1 {expected integer but got "123a"}}
+test info-9.7 {info level option} {
+    list [catch {info level 0} msg] $msg
+} {1 {bad level "0"}}
+test info-9.8 {info level option} {
+    proc t1 {} {info level -1}
+    list [catch {t1} msg] $msg
+} {1 {bad level "-1"}}
+test info-9.9 {info level option} {
+    proc t1 {x} {info level $x}
+    list [catch {t1 -3} msg] $msg
+} {1 {bad level "-3"}}
+
+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"}}
+test info-10.2 {info library option} {
+    set tcl_library 12345
+    info library
+} {12345}
+test info-10.3 {info library option} {
+    unset tcl_library
+    list [catch {info library} msg] $msg
+} {1 {no library has been specified for Tcl}}
+set tcl_library $savedLibrary
+
+test info-11.1 {info loaded option} {
+    list [catch {info loaded a b} msg] $msg
+} {1 {wrong # args: should be "info loaded ?interp?"}}
+test info-11.2 {info loaded option} {
+    list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
+} {0 1 {couldn't find slave interpreter named "gorp"}}
+
+test info-12.1 {info locals option} {
+    set a 22
+    proc t1 {x y} {
+        set b 13
+        set c testing
+        global a
+        return [info locals]
+    }
+    lsort [t1 23 24]
+} {b c x y}
+test info-12.2 {info locals option} {
+    proc t1 {x y} {
+        set xx1 2
+        set xx2 3
+        set y 4
+        return [info loc x*]
+    }
+    lsort [t1 2 3]
+} {x xx1 xx2}
+test info-12.3 {info locals option} {
+    list [catch {info locals 1 2} msg] $msg
+} {1 {wrong # args: should be "info locals ?pattern?"}}
+test info-12.4 {info locals option} {
+    info locals
+} {}
+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-12.7 {info locals with temporary variables} {
+    proc t1 {} {
+        foreach a {b c} {}
+        info locals
+    }
+    t1
+} {a}
+
+test info-13.1 {info nameofexecutable option} {
+    list [catch {info nameofexecutable foo} msg] $msg
+} {1 {wrong # args: should be "info nameofexecutable"}}
+
+test info-14.1 {info patchlevel option} {
+    set a [info patchlevel]
+    regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
+} 1
+test info-14.2 {info patchlevel option} {
+    list [catch {info patchlevel a} msg] $msg
+} {1 {wrong # args: should be "info patchlevel"}}
+test info-14.3 {info patchlevel option} {
+    set t $tcl_patchLevel
+    unset tcl_patchLevel
+    set result [list [catch {info patchlevel} msg] $msg]
+    set tcl_patchLevel $t
+    set result
+} {1 {can't read "tcl_patchLevel": no such variable}}
+
+test info-15.1 {info procs option} {
+    proc t1 {} {}
+    proc t2 {} {}
+    set x " [info procs] "
+    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
+            [string match {* _undefined_ *} $x]
+} {1 1 0}
+test info-15.2 {info procs option} {
+    proc _tt1 {} {}
+    proc _tt2 {} {}
+    lsort [info pr _tt*]
+} {_tt1 _tt2}
+catch {rename _tt1 {}}
+catch {rename _tt2 {}}
+test info-15.3 {info procs option} {
+    list [catch {info procs 2 3} msg] $msg
+} {1 {wrong # args: should be "info procs ?pattern?"}}
+
+set self info.test
+if {$tcl_platform(os) == "Win32s"} {
+    set self info~1.tes
+}
+
+test info-16.1 {info script option} {
+    list [catch {info script x} msg] $msg
+} {1 {wrong # args: should be "info script"}}
+test info-16.2 {info script option} {
+    file tail [info sc]
+} $self
+removeFile gorp.info
+makeFile "info script\n" gorp.info
+test info-16.3 {info script option} {
+    list [source gorp.info] [file tail [info script]]
+} [list gorp.info $self]
+test info-16.4 {resetting "info script" after errors} {
+    catch {source ~_nobody_/foo}
+    file tail [info script]
+} $self
+test info-16.5 {resetting "info script" after errors} {
+    catch {source _nonexistent_}
+    file tail [info script]
+} $self
+removeFile gorp.info
+
+test info-17.1 {info sharedlibextension option} {
+    list [catch {info sharedlibextension foo} msg] $msg
+} {1 {wrong # args: should be "info sharedlibextension"}}
+
+test info-18.1 {info tclversion option} {
+    set x [info tclversion]
+    scan $x "%d.%d%c" a b c
+} 2
+test info-18.2 {info tclversion option} {
+    list [catch {info t 2} msg] $msg
+} {1 {wrong # args: should be "info tclversion"}}
+test info-18.3 {info tclversion option} {
+    set t $tcl_version
+    unset tcl_version
+    set result [list [catch {info tclversion} msg] $msg]
+    set tcl_version $t
+    set result
+} {1 {can't read "tcl_version": no such variable}}
+
+test info-19.1 {info vars option} {
+    set a 1
+    set b 2
+    proc t1 {x y} {
+        global a b
+        set c 33
+        return [info vars]
+    }
+    lsort [t1 18 19]
+} {a b c x y}
+test info-19.2 {info vars option} {
+    set xxx1 1
+    set xxx2 2
+    proc t1 {xxa y} {
+        global xxx1 xxx2
+        set c 33
+        return [info vars x*]
+    }
+    lsort [t1 18 19]
+} {xxa xxx1 xxx2}
+test info-19.3 {info vars option} {
+    lsort [info vars]
+} [lsort [info globals]]
+test info-19.4 {info vars option} {
+    list [catch {info vars a b} msg] $msg
+} {1 {wrong # args: should be "info vars ?pattern?"}}
+test info-19.5 {info vars with temporary variables} {
+    proc t1 {} {
+        foreach a {b c} {}
+        info vars
+    }
+    t1
+} {a}
+
+test info-20.1 {miscellaneous error conditions} {
+    list [catch {info} msg] $msg
+} {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": 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 {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 {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 {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/tcl/tests/init.test b/tcl/tests/init.test
new file mode 100644
index 00000000000..cfea5054940
--- /dev/null
+++ b/tcl/tests/init.test
@@ -0,0 +1,149 @@
+# Functionality covered: this file contains a collection of tests for the
+# auto loading and namespaces.
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+
+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_*]}
+
+# Six cases - white box testing
+
+test init-1.1 {auto_qualify - absolute cmd - namespace} {
+    auto_qualify ::foo::bar ::blue
+} ::foo::bar
+
+test init-1.2 {auto_qualify - absolute cmd - global} {
+    auto_qualify ::global ::sub
+} global
+
+test init-1.3 {auto_qualify - no colons cmd - global} {
+    auto_qualify nocolons ::
+} nocolons 
+
+test init-1.4 {auto_qualify - no colons cmd - namespace} {
+    auto_qualify nocolons ::sub
+} {::sub::nocolons nocolons}
+
+test init-1.5 {auto_qualify - colons in cmd - global} {
+    auto_qualify foo::bar ::
+} ::foo::bar
+
+test init-1.6 {auto_qualify - colons in cmd - namespace} {
+    auto_qualify foo::bar ::sub
+} {::sub::foo::bar ::foo::bar}
+
+# Some additional tests
+
+test init-1.7 {auto_qualify - multiples colons 1} {
+    auto_qualify :::foo::::bar ::blue
+} ::foo::bar
+
+test init-1.8 {auto_qualify - multiple colons 2} {
+    auto_qualify :::foo ::bar
+} foo
+
+
+# we use a sub interp and auto_reset and double the tests because there is 2
+# places where auto_loading occur (before loading the indexes files and after)
+
+set testInterp [interp create]
+interp eval $testInterp [list set VERBOSE $VERBOSE]
+interp eval $testInterp [list set TESTS $TESTS]
+
+interp eval $testInterp {
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+auto_reset
+catch {rename parray {}}
+
+test init-2.0 {load parray - stage 1} {
+    set ret [catch {namespace eval ::test {parray}} error]
+    rename parray {} ; # remove it, for the next test - that should not fail.
+    list $ret $error
+} {1 {no value given for parameter "a" to "parray"}}
+
+
+test init-2.1 {load parray - stage 2} {
+    set ret [catch {namespace eval ::test {parray}} error]
+    list $ret $error
+} {1 {no value given for parameter "a" to "parray"}}
+
+
+auto_reset
+catch {rename ::safe::setLogCmd {}}
+#unset auto_index(::safe::setLogCmd)
+#unset auto_oldpath
+
+test init-2.2 {load ::safe::setLogCmd - stage 1} {
+    ::safe::setLogCmd
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+test init-2.3 {load ::safe::setLogCmd - stage 2} {
+    ::safe::setLogCmd
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+auto_reset
+catch {rename ::safe::setLogCmd {}}
+
+test init-2.4 {load safe:::setLogCmd - stage 1} {
+    safe:::setLogCmd ; # intentionally 3 :
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+test init-2.5 {load safe:::setLogCmd - stage 2} {
+    safe:::setLogCmd ; # intentionally 3 :
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+auto_reset
+catch {rename ::safe::setLogCmd {}}
+
+test init-2.6 {load setLogCmd from safe:: - stage 1} {
+    namespace eval safe setLogCmd 
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+test init-2.7 {oad setLogCmd from safe::  - stage 2} {
+    namespace eval safe setLogCmd 
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+
+auto_reset
+package require http 2.0
+catch {rename ::http::geturl {}}
+
+test init-2.8 {load http::geturl (package)} {
+    # 3 ':' on purpose
+    set ret [catch {namespace eval ::test {http:::geturl}} error]
+    # removing it, for the next test. should not fail.
+    rename ::http::geturl {} ; 
+    list $ret $error
+} {1 {no value given for parameter "url" to "http:::geturl"}}
+
+
+test init-3.0 {random stuff in the auto_index, should still work} {
+    set auto_index(foo:::bar::blah) {
+	namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
+    }
+    foo:::bar::blah
+} 1
+
+}
+
+interp delete $testInterp
+
diff --git a/tcl/tests/interp.test b/tcl/tests/interp.test
new file mode 100644
index 00000000000..2062f95f8b0
--- /dev/null
+++ b/tcl/tests/interp.test
@@ -0,0 +1,2269 @@
+# This file tests the multiple interpreter facility of Tcl
+#
+# 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.
+# Copyright (c) 1998 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+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}
+} else {
+    set hidden_cmds {cd exec exit fconfigure file glob load open pwd socket source}
+}
+
+foreach i [interp slaves] {
+  interp delete $i
+}
+
+proc equiv {x} {return $x}
+
+# Part 0: Check out options for interp command
+test interp-1.1 {options for interp command} {
+    list [catch {interp} msg] $msg
+} {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": 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
+} ""
+test interp-1.4 {options for interp command} {
+    list [catch {interp delete foo bar} msg] $msg
+} {1 {interpreter named "foo" not found}}
+test interp-1.5 {options for interp command} {
+    list [catch {interp exists foo bar} msg] $msg
+} {1 {wrong # args: should be "interp exists ?path?"}}
+#
+# test interp-0.6 was removed
+#
+test interp-1.6 {options for interp command} {
+    list [catch {interp slaves foo bar zop} msg] $msg
+} {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": 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": 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": 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"}}
+
+# Part 1: Basic interpreter creation tests:
+test interp-2.1 {basic interpreter creation} {
+    interp create a
+} a
+test interp-2.2 {basic interpreter creation} {
+    catch {interp create}
+} 0
+test interp-2.3 {basic interpreter creation} {
+    catch {interp create -safe}
+} 0 
+test interp-2.4 {basic interpreter creation} {
+    list [catch {interp create a} msg] $msg
+} {1 {interpreter named "a" already exists, cannot create}}
+test interp-2.5 {basic interpreter creation} {
+    interp create b -safe
+} b
+test interp-2.6 {basic interpreter creation} {
+    interp create d -safe
+} d
+test interp-2.7 {basic interpreter creation} {
+    list [catch {interp create -froboz} msg] $msg
+} {1 {bad option "-froboz": should be -safe}}
+test interp-2.8 {basic interpreter creation} {
+    interp create -- -froboz
+} -froboz
+test interp-2.9 {basic interpreter creation} {
+    interp create -safe -- -froboz1
+} -froboz1
+test interp-2.10 {basic interpreter creation} {
+    interp create {a x1}
+    interp create {a x2}
+    interp create {a x3} -safe
+} {a x3}
+test interp-2.11 {anonymous interps vs existing procs} {
+    set x [interp create]
+    regexp "interp(\[0-9]+)" $x dummy thenum
+    interp delete $x
+    incr thenum
+    proc interp$thenum {} {}
+    set x [interp create]
+    regexp "interp(\[0-9]+)" $x dummy anothernum
+    expr $anothernum - $thenum
+} 1    
+test interp-2.12 {anonymous interps vs existing procs} {
+    set x [interp create -safe]
+    regexp "interp(\[0-9]+)" $x dummy thenum
+    interp delete $x
+    incr thenum
+    proc interp$thenum {} {}
+    set x [interp create -safe]
+    regexp "interp(\[0-9]+)" $x dummy anothernum
+    expr $anothernum - $thenum
+} 1    
+    
+foreach i [interp slaves] {
+    interp delete $i
+}
+
+# Part 2: Testing "interp slaves" and "interp exists"
+test interp-3.1 {testing interp exists and interp slaves} {
+    interp slaves
+} ""
+test interp-3.2 {testing interp exists and interp slaves} {
+    interp create a
+    interp exists a
+} 1
+test interp-3.3 {testing interp exists and interp slaves} {
+    interp exists nonexistent
+} 0
+test interp-3.4 {testing interp exists and interp slaves} {
+    list [catch {interp slaves a b c} msg] $msg
+} {1 {wrong # args: should be "interp slaves ?path?"}}
+test interp-3.5 {testing interp exists and interp slaves} {
+    list [catch {interp exists a b c} msg] $msg
+} {1 {wrong # args: should be "interp exists ?path?"}}
+test interp-3.6 {testing interp exists and interp slaves} {
+    interp exists
+} 1
+test interp-3.7 {testing interp exists and interp slaves} {
+    interp slaves
+} a
+test interp-3.8 {testing interp exists and interp slaves} {
+    list [catch {interp slaves a b c} msg] $msg
+} {1 {wrong # args: should be "interp slaves ?path?"}}
+test interp-3.9 {testing interp exists and interp slaves} {
+    interp create {a a2} -safe
+    expr {[lsearch [interp slaves a] a2] >= 0}
+} 1
+test interp-3.10 {testing interp exists and interp slaves} {
+    interp exists {a a2}
+} 1
+
+# Part 3: Testing "interp delete"
+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} {
+    list [catch {interp delete nonexistent} msg] $msg
+} {1 {interpreter named "nonexistent" not found}}
+test interp-4.3 {testing interp delete} {
+    list [catch {interp delete x y z} msg] $msg
+} {1 {interpreter named "x" not found}}
+test interp-4.4 {testing interp delete} {
+    interp delete
+} ""
+test interp-4.5 {testing interp delete} {
+    interp create a
+    interp create {a x1}
+    interp delete {a x1}
+    expr {[lsearch [interp slaves a] x1] >= 0}
+} 0
+test interp-4.6 {testing interp delete} {
+    interp create c1
+    interp create c2
+    interp create c3
+    interp delete c1 c2 c3
+} ""
+test interp-4.7 {testing interp delete} {
+    interp create c1
+    interp create c2
+    list [catch {interp delete c1 c2 c3} msg] $msg
+} {1 {interpreter named "c3" not found}}
+test interp-4.8 {testing interp delete} {
+    list [catch {interp delete {}} msg] $msg
+} {1 {interpreter named "" not found}}
+
+foreach i [interp slaves] {
+    interp delete $i
+}
+
+# Part 4: Consistency checking - all nondeleted interpreters should be
+# there:
+test interp-5.1 {testing consistency} {
+    interp slaves
+} ""
+test interp-5.2 {testing consistency} {
+    interp exists a
+} 0
+test interp-5.3 {testing consistency} {
+    interp exists nonexistent
+} 0
+
+# Recreate interpreter "a"
+interp create a
+
+# Part 5: Testing eval in interpreter object command and with interp command
+test interp-6.1 {testing eval} {
+    a eval expr 3 + 5
+} 8
+test interp-6.2 {testing eval} {
+    list [catch {a eval foo} msg] $msg
+} {1 {invalid command name "foo"}}
+test interp-6.3 {testing eval} {
+    a eval {proc foo {} {expr 3 + 5}}
+    a eval foo
+} 8
+test interp-6.4 {testing eval} {
+    interp eval a foo
+} 8
+
+test interp-6.5 {testing eval} {
+    interp create {a x2}
+    interp eval {a x2} {proc frob {} {expr 4 * 9}}
+    interp eval {a x2} frob
+} 36
+test interp-6.6 {testing eval} {
+    list [catch {interp eval {a x2} foo} msg] $msg
+} {1 {invalid command name "foo"}}
+
+# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
+proc in_master {args} {
+     return [list seen in master: $args]
+}
+
+# Part 6: Testing basic alias creation
+test interp-7.1 {testing basic alias creation} {
+    a alias foo in_master
+} foo
+test interp-7.2 {testing basic alias creation} {
+    a alias bar in_master a1 a2 a3
+} bar
+# Test 6.3 has been deleted.
+test interp-7.3 {testing basic alias creation} {
+    a alias foo
+} in_master
+test interp-7.4 {testing basic alias creation} {
+    a alias bar
+} {in_master a1 a2 a3}
+test interp-7.5 {testing basic alias creation} {
+    a aliases
+} {foo bar}
+
+# 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 {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!
+
+if {[info command nonexistent-command-in-master] != ""} {
+    rename nonexistent-command-in-master {}
+}
+
+# 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} {
+    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 {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
+} 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
+} 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]
+    a eval {rename zoppo {}}
+    interp alias "" foo a {}
+    equiv $x
+} {33 33 33}
+
+# Part 10: Testing "interp target"
+test interp-11.1 {testing interp target} {
+    list [catch {interp target} msg] $msg
+} {1 {wrong # args: should be "interp target path alias"}}
+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
+    interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
+    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}}
+test interp-11.6 {testing interp target} {
+    foreach a [interp aliases] {
+	rename $a {}
+    }
+    list [catch {interp target {} foo} msg] $msg
+} {1 {alias "foo" in path "" not found}}
+test interp-11.7 {testing interp target} {
+    catch {interp delete a}
+    interp create a
+    list [catch {interp target a foo} msg] $msg
+} {1 {alias "foo" in path "a" not found}}
+
+# Part 11: testing "interp issafe"
+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 14: testing interp aliases
+test interp-14.1 {testing interp aliases} {
+    interp aliases
+} ""
+test interp-14.2 {testing interp aliases} {
+    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} {
+    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} {
+    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} {
+    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} {
+    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} {
+    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
+catch {removeFile file-15.8}
+
+#
+# Torture tests for interpreter deletion order
+#
+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
+    interp alias ddd kill xxx kill
+    set x [ddd eval kill]
+    interp delete ddd
+    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
+    interp create ddd
+    interp alias ddd kill {xxx yyy} kill
+    set x [ddd eval kill]
+    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
+    after 200
+    update
+    interp exists xxx
+} 0
+
+#
+# Alias loop prevention testing.
+#
+
+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.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.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.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.5 {alias loop prevention} {
+    catch {interp delete x}
+    interp create x
+    x alias z l1
+    interp alias {} l2 x z
+    list [catch {rename l2 l1} msg] $msg
+} {1 {cannot define or rename alias "l2": would create a loop}}
+
+#
+# Test robustness of Tcl_DeleteInterp when applied to a slave interpreter.
+# If there are bugs in the implementation these tests are likely to expose
+# the bugs as a core dump.
+#
+
+if {[info commands testinterpdelete] != ""} {
+    test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
+	list [catch {testinterpdelete} msg] $msg
+    } {1 {wrong # args: should be "testinterpdelete path"}}
+    test interp-18.2 {testing Tcl_DeleteInterp vs slaves} {
+	catch {interp delete a}
+	interp create a
+	testinterpdelete a
+    } ""
+    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.4 {testing Tcl_DeleteInterp vs slaves} {
+	catch {interp delete a}
+	interp create a
+	interp create {a b}
+	testinterpdelete a
+    } ""
+    test interp-18.5 {testing Tcl_DeleteInterp vs slaves} {
+	catch {interp delete a}
+	interp create a
+	interp create {a b}
+	interp alias {a b} dodel {} dodel
+	proc dodel {x} {testinterpdelete $x}
+	list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
+    } {0 {}}
+    test interp-18.6 {testing Tcl_DeleteInterp vs slaves} {
+	catch {interp delete a}
+	interp create a
+	interp create {a b}
+	interp alias {a b} dodel {} dodel
+	proc dodel {x} {testinterpdelete $x}
+	list [catch {interp eval {a b} {dodel a}} msg] $msg
+    } {0 {}}
+    test interp-18.7 {eval in deleted interp} {
+	catch {interp delete a}
+	interp create a
+	a eval {
+	    proc dodel {} {
+		delme
+		dosomething else
+	    }
+	    proc dosomething args {
+		puts "I should not have been called!!"
+	    }
+	}
+	a alias delme dela
+	proc dela {} {interp delete a}
+	list [catch {a eval dodel} msg] $msg
+    } {1 {attempt to call eval in deleted interpreter}}
+    test interp-18.8 {eval in deleted interp} {
+	catch {interp delete a}
+	interp create a
+	a eval {
+	    interp create b
+	    b eval {
+		proc dodel {} {
+		    dela
+		}
+	    }
+	    proc foo {} {
+		b eval dela
+		dosomething else
+	    }
+	    proc dosomething args {
+		puts "I should not have been called!!"
+	    }
+	}
+	interp alias {a b} dela {} dela
+	proc dela {} {interp delete a}
+	list [catch {a eval foo} msg] $msg
+    } {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-20.45 {interp hide vs namespaces} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	namespace eval foo {}
+	proc foo::x {} {}
+    }
+    set l [list [catch {interp hide a foo::x} msg] $msg]
+    interp delete a
+    set l
+} {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}}
+test interp-20.46 {interp hide vs namespaces} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	namespace eval foo {}
+	proc foo::x {} {}
+    }
+    set l [list [catch {interp hide a foo::x x} msg] $msg]
+    interp delete a
+    set l
+} {1 {can only hide global namespace commands (use rename then hide)}}
+test interp-20.47 {interp hide vs namespaces} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	proc x {} {}
+    }
+    set l [list [catch {interp hide a x foo::x} msg] $msg]
+    interp delete a
+    set l
+} {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}}
+test interp-20.48 {interp hide vs namespaces} {
+    catch {interp delete a}
+    interp create a
+    a eval {
+	namespace eval foo {}
+	proc foo::x {} {}
+    }
+    set l [list [catch {interp hide a foo::x bar::x} msg] $msg]
+    interp delete a
+    set l
+} {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}}
+
+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} bar {cd exec exit fconfigure file glob load open pwd socket source} bar {bar cd exec exit fconfigure file glob load open pwd socket source} {} {cd exec exit fconfigure file glob load open pwd socket source}} 
+
+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} bar {beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo exit fconfigure file glob load ls open pwd socket source}} 
+
+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
+} ""
+
+
+# Interps result transmission
+test interp-26.1 {result code transmission 1} {knownBug} {
+    # This test currently fails ! (only ok/error are passed, not the other
+    # codes). Fixing the code is thus needed...  -- dl
+    # (the only other acceptable result list would be
+    #  {-1 0 1 0 3 4 5} because of the way return -code return(=2) works)
+    # test that all the possibles error codes from Tcl get passed
+    catch {interp delete a}
+    interp create a
+    interp eval a {proc ret {code} {return -code $code $code}}
+    set res {}
+    # use a for so if a return -code break 'escapes' we would notice
+    for {set code -1} {$code<=5} {incr code} {
+	lappend res [catch {interp eval a ret $code} msg]
+    }
+    interp delete a
+    set res
+} {-1 0 1 2 3 4 5}
+
+test interp-26.2 {result code transmission 2} {knownBug} {
+    # This test currently fails ! (error is cleared)
+    # Code fixing is needed...  -- dl
+    # (the only other acceptable result list would be
+    #  {-1 0 1 0 3 4 5} because of the way return -code return(=2) works)
+    # test that all the possibles error codes from Tcl get passed
+    set interp [interp create];
+    proc MyTestAlias {interp args} {
+	global aliasTrace;
+	lappend aliasTrace $args;
+	eval interp invokehidden [list $interp] $args
+    }
+    foreach c {return} {
+	interp hide $interp  $c;
+        interp alias $interp $c {} MyTestAlias $interp $c;
+    }
+    interp eval $interp {proc ret {code} {return -code $code $code}}
+    set res {}
+    set aliasTrace {}
+    for {set code -1} {$code<=5} {incr code} {
+	lappend res [catch {interp eval $interp ret $code} msg]
+    }
+    interp delete $interp;
+    list $res
+} {-1 0 1 2 3 4 5}
+
+test interp-26.3 {errorInfo transmission : regular interps} {
+    set interp [interp create];
+    proc MyError {secret} {
+	return -code error "msg"
+    }
+    proc MyTestAlias {interp args} {
+	MyError "some secret"
+    }
+    interp alias $interp test {} MyTestAlias $interp;
+    set res [interp eval $interp {catch test;set errorInfo}]
+    interp delete $interp;
+    set res
+} {msg
+    while executing
+"MyError "some secret""
+    (procedure "test" line 2)
+    invoked from within
+"catch test"}
+
+test interp-26.4 {errorInfo transmission : safe interps} {knownBug} {
+    # this test fails because the errorInfo is fully transmitted
+    # whether the interp is safe or not. this is maybe a feature
+    # and not a bug.
+    set interp [interp create -safe];
+    proc MyError {secret} {
+	return -code error "msg"
+    }
+    proc MyTestAlias {interp args} {
+	MyError "some secret"
+    }
+    interp alias $interp test {} MyTestAlias $interp;
+    set res [interp eval $interp {catch test;set errorInfo}]
+    interp delete $interp;
+    set res
+} {msg
+    while executing
+"catch test"}
+
+# Interps & Namespaces
+test interp-27.1 {interp aliases & namespaces} {
+    set i [interp create];
+    set aliasTrace {};
+    proc tstAlias {args} { 
+	global aliasTrace;
+	lappend aliasTrace [list [namespace current] $args];
+    }
+    $i alias foo::bar tstAlias foo::bar;
+    $i eval foo::bar test
+    interp delete $i
+    set aliasTrace;
+} {{:: {foo::bar test}}}
+
+test interp-27.2 {interp aliases & namespaces} {
+    set i [interp create];
+    set aliasTrace {};
+    proc tstAlias {args} { 
+	global aliasTrace;
+	lappend aliasTrace [list [namespace current] $args];
+    }
+    $i alias foo::bar tstAlias foo::bar;
+    $i eval namespace eval foo {bar test}
+    interp delete $i
+    set aliasTrace;
+} {{:: {foo::bar test}}}
+
+test interp-27.3 {interp aliases & namespaces} {
+    set i [interp create];
+    set aliasTrace {};
+    proc tstAlias {args} { 
+	global aliasTrace;
+	lappend aliasTrace [list [namespace current] $args];
+    }
+    interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
+    interp alias $i foo::bar {} tstAlias foo::bar;
+    interp eval $i {namespace eval foo {bar test}}
+    interp delete $i
+    set aliasTrace;
+} {{:: {foo::bar test}}}
+
+test interp-27.4 {interp aliases & namespaces} {
+    set i [interp create];
+    namespace eval foo2 {
+	variable aliasTrace {};
+	proc bar {args} { 
+	    variable aliasTrace;
+	    lappend aliasTrace [list [namespace current] $args];
+	}
+    }
+    $i alias foo::bar foo2::bar foo::bar;
+    $i eval namespace eval foo {bar test}
+    set r $foo2::aliasTrace;
+    namespace delete foo2;
+    set r
+} {{::foo2 {foo::bar test}}}
+
+# the following tests are commented out while we don't support
+# hiding in namespaces
+
+# test interp-27.5 {interp hidden & namespaces} {
+#    set i [interp create];
+#    interp eval $i {
+#	namespace eval foo {
+#	    proc bar {args} {
+#		return "bar called ([namespace current]) ($args)"
+#	    }
+#	}
+#    }
+#    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
+#    interp hide $i foo::bar;
+#    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
+#    interp delete $i;
+#    set res;
+#} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
+
+# test interp-27.6 {interp hidden & aliases & namespaces} {
+#     set i [interp create];
+#     set v root-master;
+#     namespace eval foo {
+# 	variable v foo-master;
+# 	proc bar {interp args} {
+# 	    variable v;
+# 	    list "master bar called ($v) ([namespace current]) ($args)"\
+# 		    [interp invokehidden $interp foo::bar $args];
+# 	}
+#     }
+#     interp eval $i {
+# 	namespace eval foo {
+# 	    namespace export *
+# 	    variable v foo-slave;
+# 	    proc bar {args} {
+# 		variable v;
+# 		return "slave bar called ($v) ([namespace current]) ($args)"
+# 	    }
+# 	}
+#     }
+#     set res [list [interp eval $i {namespace eval foo {bar test1}}]]
+#     $i hide foo::bar;
+#     $i alias foo::bar foo::bar $i;
+#     set res [concat $res [interp eval $i {
+# 	set v root-slave;
+# 	namespace eval test {
+# 	    variable v foo-test;
+# 	    namespace import ::foo::*;
+# 	    bar test2
+#         }
+#     }]]
+#     namespace delete foo;
+#     interp delete $i;
+#     set res
+# } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
+
+
+# test interp-27.7 {interp hidden & aliases & imports & namespaces} {
+#     set i [interp create];
+#     set v root-master;
+#     namespace eval mfoo {
+# 	variable v foo-master;
+# 	proc bar {interp args} {
+# 	    variable v;
+# 	    list "master bar called ($v) ([namespace current]) ($args)"\
+# 		    [interp invokehidden $interp test::bar $args];
+# 	}
+#     }
+#     interp eval $i {
+# 	namespace eval foo {
+# 	    namespace export *
+# 	    variable v foo-slave;
+# 	    proc bar {args} {
+# 		variable v;
+# 		return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
+# 	    }
+# 	}
+# 	set v root-slave;
+# 	namespace eval test {
+# 	    variable v foo-test;
+# 	    namespace import ::foo::*;
+#         }
+#     }
+#     set res [list [interp eval $i {namespace eval test {bar test1}}]]
+#     $i hide test::bar;
+#     $i alias test::bar mfoo::bar $i;
+#     set res [concat $res [interp eval $i {test::bar test2}]];
+#     namespace delete mfoo;
+#     interp delete $i;
+#     set res
+# } {{slave bar called (foo-slave) (bar test1) (::test) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
+
+#test interp-27.8 {hiding, namespaces and integrity} {
+#    namespace eval foo {
+#	variable v 3;
+#	proc bar {} {variable v; set v}
+#	# next command would currently generate an unknown command "bar" error.
+#	interp hide {} bar;
+#    }
+#    namespace delete foo;
+#    list [catch {interp invokehidden {} foo} msg] $msg;
+#} {1 {invalid hidden command name "foo"}}
+
+
+test interp-28.1 {getting fooled by slave's namespace ?} {
+    set i [interp create -safe];
+    proc master {interp args} {interp hide $interp list}
+    $i alias master master $i;
+    set r [interp eval $i {
+	namespace eval foo {
+	    proc list {args} {
+		return "dummy foo::list";
+	    }
+	    master;
+	}
+	info commands list
+    }]
+    interp delete $i;
+    set r
+} {}
+
+# Tests of recursionlimit
+# We need testsetrecursionlimit so we need Tcltest package
+if {[catch {package require Tcltest} msg]} {
+    puts "This application hasn't been compiled with Tcltest"
+    puts "skipping remining interp tests that relies on it."
+} else {
+    # 
+test interp-29.1 {recursion limit} {
+    set i [interp create]
+    load {} Tcltest $i
+    set r [interp eval $i {
+	testsetrecursionlimit 50
+	proc p {} {incr ::i; p}
+	set i 0
+	catch p
+	set i
+    }]
+   interp delete $i
+   set r
+} 49
+
+test interp-29.2 {recursion limit inheritance} {
+    set i [interp create]
+    load {} Tcltest $i
+    set ii [interp eval $i {
+	testsetrecursionlimit 50
+	interp create
+    }]
+    set r [interp eval [list $i $ii] {
+	proc p {} {incr ::i; p}
+	set i 0
+	catch p
+	set i
+    }]
+   interp delete $i
+   set r
+} 49
+
+#    # Deep recursion (into interps when the regular one fails):
+#    # still crashes...
+#    proc p {} {
+#	if {[catch p ret]} {
+#	    catch {
+#		set i [interp create]
+#		interp eval $i [list proc p {} [info body p]]
+#		interp eval $i p
+#	    }
+#	    interp delete $i
+#	    return ok
+#	}
+#	return $ret
+#    }
+#    p
+
+# more tests needed...
+
+# Interp & stack
+#test interp-29.1 {interp and stack (info level)} {
+#} {}
+
+# End of stack-recursion tests
+}
+
+# This test dumps core in Tcl 8.0.3!
+#test interp-30.1 {deletion of aliases inside namespaces} {
+#    set i [interp create]
+#    $i alias ns::cmd list
+#    $i alias ns::cmd {}
+#} {}
+
+foreach i [interp slaves] {
+  interp delete $i
+}
diff --git a/tcl/tests/io.test b/tcl/tests/io.test
new file mode 100644
index 00000000000..15da487f7d1
--- /dev/null
+++ b/tcl/tests/io.test
@@ -0,0 +1,5223 @@
+# Functionality covered: operation of all IO commands, and all procedures
+# defined in generic/tclIO.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) 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.
+#
+# RCS: @(#) $Id$
+
+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 up a long data file for some of the following tests
+
+set f [open longfile w]
+fconfigure $f -eofchar {} -translation lf
+for { set i 0 } { $i < 100 } { incr i} {
+    puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
+\#123456789abcdef01
+\#"
+    }
+close $f
+
+set f [open cat w]
+puts $f {
+    if {$argv == {}} {
+	set argv -
+    }
+    foreach name $argv {
+	if {$name == "-"} {
+	    set f stdin
+	} elseif {[catch {open $name r} f] != 0} {
+	    puts stderr $f
+	    continue
+	}
+	while {[eof $f] == 0} {
+	    puts -nonewline stdout [read $f]
+	}
+	if {$f != "stdin"} {
+	    close $f
+	}
+    }
+}
+close $f
+
+# These tests are disabled until we decide what to do with "unsupported0".
+#
+#test io-1.7 {unsupported0 command} {
+#    removeFile test1
+#    set f1 [open iocmd.test]
+#    set f2 [open test1 w]
+#    unsupported0 $f1 $f2
+#    close $f1
+#    catch {close $f2}
+#    set s1 [file size [info script]]
+#    set s2 [file size test1]
+#    set x ok
+#    if {"$s1" != "$s2"} {
+#        set x broken
+#    }
+#    set x
+#} ok
+#test io-1.8 {unsupported0 command} {
+#    removeFile test1
+#    set f1 [open [info script]]
+#    set f2 [open test1 w]
+#    unsupported0 $f1 $f2 40
+#    close $f1
+#    close $f2
+#    file size test1
+#} 40
+#test io-1.9 {unsupported0 command} {
+#    removeFile test1
+#    set f1 [open [info script]]
+#    set f2 [open test1 w]
+#    unsupported0 $f1 $f2 -1
+#    close $f1
+#    close $f2
+#    set x ok
+#    set s1 [file size [info script]]
+#    set s2 [file size test1]
+#    if {$s1 != $s2} {
+#        set x broken
+#    }
+#    set x
+#} ok
+#test io-1.10 {unsupported0 command} {unixOrPc} {
+#    removeFile pipe
+#    removeFile test1
+#    set f1 [open pipe w]
+#    puts $f1 {puts ready}
+#    puts $f1 {gets stdin}
+#    puts $f1 {set f1 [open [info script] r]}
+#    puts $f1 {puts [read $f1 100]}
+#    puts $f1 {close $f1}
+#    close $f1
+#    set f1 [open "|[list $tcltest pipe]" r+]
+#    gets $f1
+#    puts $f1 ready
+#    flush $f1
+#    set f2 [open test1 w]
+#    set c [unsupported0 $f1 $f2 40]
+#    catch {close $f1}
+#    close $f2
+#    set s1 [file size test1]
+#    set x ok
+#    if {$s1 != "40"} {
+#        set x broken
+#    }
+#    list $c $x
+#} {40 ok}
+
+# Test standard handle management. The functions tested are
+# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
+# also testing channel table management.
+
+if {$tcl_platform(platform) == "macintosh"} {
+    set consoleFileNames [list console0 console1 console2]
+} else {
+    set consoleFileNames [lsort [testchannel open]]
+}
+test io-1.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
+    set l ""
+    lappend l [fconfigure stdin -buffering]
+    lappend l [fconfigure stdout -buffering]
+    lappend l [fconfigure stderr -buffering]
+    lappend l [lsort [testchannel open]]
+    set l
+} [list line line none $consoleFileNames]
+test io-1.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
+    interp create x
+    set l ""
+    lappend l [x eval {fconfigure stdin -buffering}]
+    lappend l [x eval {fconfigure stdout -buffering}]
+    lappend l [x eval {fconfigure stderr -buffering}]
+    interp delete x
+    set l
+} {line line none}
+test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
+    set f [open test1 w]
+    puts $f {
+	close stdin
+	close stdout
+	close stderr
+	set f [open test1 r]
+	set f2 [open test2 w]
+	set f3 [open test3 w]
+	puts stdout [gets stdin]
+	puts stdout out
+	puts stderr err
+	close $f
+	close $f2
+	close $f3
+    }
+    close $f
+    set result [exec $tcltest test1]
+    set f [open test2 r]
+    set f2 [open test3 r]
+    lappend result [read $f] [read $f2]
+    close $f
+    close $f2
+    set result
+} {{
+out
+} {err
+}}
+# This test relies on the fact that the smallest available fd is used first.
+test io-1.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
+    set f [open test1 w]
+    puts $f { close stdin
+	close stdout
+	close stderr
+	set f [open test1 r]
+	set f2 [open test2 w]
+	set f3 [open test3 w]
+	puts stdout [gets stdin]
+	puts stdout $f2
+	puts stderr $f3
+	close $f
+	close $f2
+	close $f3
+    }
+    close $f
+    set result [exec $tcltest test1]
+    set f [open test2 r]
+    set f2 [open test3 r]
+    lappend result [read $f] [read $f2]
+    close $f
+    close $f2
+    set result
+} {{ close stdin
+file1
+} {file2
+}}
+catch {interp delete z}
+test io-1.5 {Tcl_GetChannel: stdio name translation} {
+    interp create z
+    eof stdin
+    catch {z eval flush stdin} msg1
+    catch {z eval close stdin} msg2
+    catch {z eval flush stdin} msg3
+    set result [list $msg1 $msg2 $msg3]
+    interp delete z
+    set result
+} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
+test io-1.6 {Tcl_GetChannel: stdio name translation} {
+    interp create z
+    eof stdout
+    catch {z eval flush stdout} msg1
+    catch {z eval close stdout} msg2
+    catch {z eval flush stdout} msg3
+    set result [list $msg1 $msg2 $msg3]
+    interp delete z
+    set result
+} {{} {} {can not find channel named "stdout"}}
+test io-1.7 {Tcl_GetChannel: stdio name translation} {
+    interp create z
+    eof stderr
+    catch {z eval flush stderr} msg1
+    catch {z eval close stderr} msg2
+    catch {z eval flush stderr} msg3
+    set result [list $msg1 $msg2 $msg3]
+    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 "|[list $tcltest script]" r]
+    set c [gets $f]
+    close $f
+    set c
+} hello
+test io-1.9 {reuse of stdio special channels} {stdio} {
+    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 "|[list [info nameofexecutable] cat test1]" r]
+	puts [gets $f]
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    set c [gets $f]
+    close $f
+    set c
+} hello
+
+# Must add test function for testing Tcl_CreateCloseHandler and
+# Tcl_DeleteCloseHandler.
+
+# 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.
+
+#
+# CYGNUS LOCAL:
+# I open tclConfig.sh to get the correct paths if I am not in the install
+# directory.  This increments the refcount on the stdin WHEN the interpreter
+# is created, not when you call eof stdin in the child.  Because of this, I
+# had to change the first value in the results for tests 2.1, 2.2 & 2.3 from
+# 0 to 1.  This is really a side issue, and does not affect what the tests
+# were supposed to be looking for, however.
+  
+test io-2.1 {GetChannelTable, DeleteChannelTable on std handles} {
+    set l1 [testchannel refcount stdin]
+    eof stdin
+    interp create x
+    set l ""
+    lappend l [expr [testchannel refcount stdin] - $l1]
+    x eval {eof stdin}
+    lappend l [expr [testchannel refcount stdin] - $l1]
+    interp delete x
+    lappend l [expr [testchannel refcount stdin] - $l1]
+    set l
+} {1 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 [expr [testchannel refcount stdout] - $l1]
+    x eval {eof stdout}
+    lappend l [expr [testchannel refcount stdout] - $l1]
+    interp delete x
+    lappend l [expr [testchannel refcount stdout] - $l1]
+    set l
+} {1 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 [expr [testchannel refcount stderr] - $l1]
+    x eval {eof stderr}
+    lappend l [expr [testchannel refcount stderr] - $l1]
+    interp delete x
+    lappend l [expr [testchannel refcount stderr] - $l1]
+    set l
+} {1 1 0}
+test io-2.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+    removeFile test1
+    set l ""
+    set f [open test1 w]
+    lappend l [lindex [testchannel info $f] 15]
+    close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being closed"
+    }
+    string compare [string tolower $l] \
+	[list 1 [format "can not find channel named \"%s\"" $f]]
+} 0
+test io-2.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+    removeFile test1
+    set l ""
+    set f [open test1 w]
+    lappend l [lindex [testchannel info $f] 15]
+    interp create x
+    interp share "" $f x
+    lappend l [lindex [testchannel info $f] 15]
+    x eval close $f
+    lappend l [lindex [testchannel info $f] 15]
+    interp delete x
+    lappend l [lindex [testchannel info $f] 15]
+    close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being closed"
+    }
+    string compare [string tolower $l] \
+	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
+} 0
+test io-2.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+    removeFile test1
+    set l ""
+    set f [open test1 w]
+    lappend l [lindex [testchannel info $f] 15]
+    interp create x
+    interp share "" $f x
+    lappend l [lindex [testchannel info $f] 15]
+    interp delete x
+    lappend l [lindex [testchannel info $f] 15]
+    close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being closed"
+    }
+    string compare [string tolower $l] \
+	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
+} 0
+test io-2.7 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
+    eof stdin
+} 0
+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-2.9 {Tcl_GetChannel, channel not found} {
+    list [catch {eof file34} msg] $msg
+} {1 {can not find channel named "file34"}}
+test io-2.10 {Tcl_CreateChannel, insertion into channel table} {
+    removeFile test1
+    set f [open test1 w]
+    set l ""
+    lappend l [eof $f]
+    close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being closed"
+    }
+    string compare [string tolower $l] \
+	[list 0 [format "can not find channel named \"%s\"" $f]]
+} 0
+
+# Test management of attributes associated with a channel, such as
+# its default translation, its name and type, etc. The functions
+# tested in this group are Tcl_GetChannelName,
+# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
+# not tested because files do not use the instance data.
+
+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-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-3.3 {Tcl_GetChannelFile, input} {
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f "1234567890\n098765432"
+    close $f
+    set f [open test1 r]
+    gets $f
+    set l ""
+    lappend l [testchannel inputbuffered $f]
+    lappend l [tell $f]
+    close $f
+    set l
+} {10 11}
+test io-3.4 {Tcl_GetChannelFile, output} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello
+    set l ""
+    lappend l [testchannel outputbuffered $f]
+    lappend l [tell $f]
+    flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [tell $f]
+    close $f
+    removeFile test1
+    set l
+} {6 6 0 6}
+
+# Test flushing. The functions tested here are FlushChannel.
+
+test io-4.1 {FlushChannel, no output buffered} {
+    removeFile test1
+    set f [open test1 w]
+    flush $f
+    set s [file size test1]
+    close $f
+    set s
+} 0
+test io-4.2 {FlushChannel, some output buffered} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    set l ""
+    puts $f hello
+    lappend l [file size test1]
+    flush $f
+    lappend l [file size test1]
+    close $f
+    lappend l [file size test1]
+    set l
+} {0 6 6}
+test io-4.3 {FlushChannel, implicit flush on close} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    set l ""
+    puts $f hello
+    lappend l [file size test1]
+    close $f
+    lappend l [file size test1]
+    set l
+} {0 6}
+test io-4.4 {FlushChannel, implicit flush when buffer fills} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    fconfigure $f -buffersize 60
+    set l ""
+    lappend l [file size test1]
+    for {set i 0} {$i < 12} {incr i} {
+	puts $f hello
+    }
+    lappend l [file size test1]
+    flush $f
+    lappend l [file size test1]
+    close $f
+    set l
+} {0 60 72}
+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 {}
+    set l ""
+    lappend l [file size test1]
+    for {set i 0} {$i < 12} {incr i} {
+	puts $f hello
+    }
+    lappend l [file size test1]
+    close $f
+    lappend l [file size test1]
+    set l
+} {0 60 72}
+test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose} {
+    removeFile pipe
+    removeFile output
+    set f [open pipe w]
+    puts $f {
+	set f [open output w]
+	fconfigure $f -translation lf -buffering none -eofchar {}
+	while {![eof stdin]} {
+	    after 20
+	    puts -nonewline $f [read stdin 1024]
+	}
+	close $f
+    }
+    close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+        set x "$x$x"
+    }
+    set f [open output w]
+    close $f
+    set f [open "|[list $tcltest pipe]" w]
+    fconfigure $f -blocking off
+    puts -nonewline $f $x
+    close $f
+    set counter 0
+    while {([file size output] < 65536) && ($counter < 1000)} {
+        incr counter
+        after 20
+        update
+    }
+    if {$counter == 1000} {
+        set result probably_broken
+    } else {
+        set result ok
+    }
+} ok
+
+# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.
+
+test io-5.1 {CloseChannel called when all references are dropped} {
+    removeFile test1
+    set f [open test1 w]
+    interp create x
+    interp share "" $f x
+    set l ""
+    lappend l [testchannel refcount $f]
+    x eval close $f
+    interp delete x
+    lappend l [testchannel refcount $f]
+    close $f
+    set l
+} {2 1}
+test io-5.2 {CloseChannel called when all references are dropped} {
+    removeFile test1
+    set f [open test1 w]
+    interp create x
+    interp share "" $f x
+    puts -nonewline $f abc
+    close $f
+    x eval puts $f def
+    x eval close $f
+    interp delete x
+    set f [open test1 r]
+    set l [gets $f]
+    close $f
+    set l
+} abcdef
+test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose nonPortable tempNotPc} {
+    removeFile pipe
+    removeFile output
+    set f [open pipe w]
+    puts $f {
+
+	# Need to not have eof char appended on close, because the other
+	# side of the pipe already closed, so that writing would cause an
+	# error "invalid file".
+
+	fconfigure stdout -eofchar {}
+	fconfigure stderr -eofchar {}
+
+	set f [open output w]
+	fconfigure $f -translation lf -buffering none
+	for {set x 0} {$x < 20} {incr x} {
+	    after 20
+	    puts -nonewline $f [read stdin 1024]
+	}
+	close $f
+    }
+    close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+        set x "$x$x"
+    }
+    set f [open output w]
+    close $f
+    set f [open "|[list $tcltest pipe]" r+]
+    fconfigure $f -blocking off -eofchar {}
+
+    # Under windows, the first 24576 bytes of $x are copied to $f, and
+    # then the writing fails.  
+
+    puts -nonewline $f $x
+    close $f
+    set counter 0
+    while {([file size output] < 20480) && ($counter < 1000)} {
+        incr counter
+        after 20
+        update
+    }
+    if {$counter == 1000} {
+        set result probably_broken
+    } else {
+        set result ok
+    }
+} ok
+test io-5.4 {Tcl_Close} {
+    removeFile test1
+    set l ""
+    lappend l [lsort [testchannel open]]
+    set f [open test1 w]
+    lappend l [lsort [testchannel open]]
+    close $f
+    lappend l [lsort [testchannel open]]
+    set x [list $consoleFileNames \
+		[lsort [eval list $consoleFileNames $f]] \
+		$consoleFileNames]
+    string compare $l $x
+} 0
+test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	close stdin
+	puts [testchannel open]
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    set l [gets $f]
+    close $f
+    set l
+} {file1 file2}
+
+# Test output on channels. The functions tested are Tcl_Write
+# and Tcl_Flush.
+
+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-6.2 {Tcl_Write, empty string} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -eofchar {}
+    puts -nonewline $f ""
+    close $f
+    file size test1
+} 0
+test io-6.3 {Tcl_Write, nonempty string} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -eofchar {}
+    puts -nonewline $f hello
+    close $f
+    file size test1
+} 5
+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 {}
+    puts $f hello
+    set l ""
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    close $f
+    set l
+} {6 0 0 6}
+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 {}
+    puts -nonewline $f hello
+    set l ""
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    close $f
+    set l
+} {5 0 0 11}
+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 {}
+    puts -nonewline $f hello
+    set l ""
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    close $f
+    set l
+} {0 5 0 11}
+test io-6.7 {Tcl_Flush, full buffering} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf -buffering full -eofchar {}
+    puts -nonewline $f hello
+    set l ""
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    close $f
+    set l
+} {5 0 11 0 0 11}
+test io-6.8 {Tcl_Flush, full buffering} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf -buffering line
+    puts -nonewline $f hello
+    set l ""
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size test1]
+    close $f
+    set l
+} {5 0 0 5 0 11 0 11}
+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-6.10 {Tcl_Write, looping and buffering} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    set f2 [open longfile r]
+    for {set x 0} {$x < 10} {incr x} {
+        puts $f1 [gets $f2]
+    }
+    close $f2
+    close $f1
+    file size test1
+} 387
+test io-6.11 {Tcl_Write, no newline, implicit flush} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -eofchar {}
+    set f2 [open longfile r]
+    for {set x 0} {$x < 10} {incr x} {
+        puts -nonewline $f1 [gets $f2]
+    }
+    close $f1
+    close $f2
+    file size test1
+} 377
+test io-6.12 {Tcl_Write on a pipe} {stdio} {
+    removeFile test1
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	set f1 [open longfile r]
+	for {set x 0} {$x < 10} {incr x} {
+	    puts [gets $f1]
+	}
+    }
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r]
+    set f2 [open longfile r]
+    set y ok
+    for {set x 0} {$x < 10} {incr x} {
+        set l1 [gets $f1]
+        set l2 [gets $f2]
+        if {"$l1" != "$l2"} {
+            set y broken
+        }
+    }
+    close $f1
+    close $f2
+    set y
+} ok
+test io-6.13 {Tcl_Write to a pipe, line buffered} {stdio} {
+    removeFile test1
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	puts [gets stdin]
+	puts [gets stdin]
+    }
+    close $f1
+    set y ok
+    set f1 [open "|[list $tcltest pipe]" r+]
+    fconfigure $f1 -buffering line
+    set f2 [open longfile r]
+    set line [gets $f2]
+    puts $f1 $line
+    set backline [gets $f1]
+    if {"$line" != "$backline"} {
+        set y broken
+    }
+    set line [gets $f2]
+    puts $f1 $line
+    set backline [gets $f1]
+    if {"$line" != "$backline"} {
+        set y broken
+    }
+    close $f1
+    close $f2
+    set y
+} ok
+test io-6.14 {Tcl_Write, buffering and implicit flush at close} {
+    removeFile test3
+    set f [open test3 w]
+    puts -nonewline $f "Text1"
+    puts -nonewline $f " Text 2"
+    puts $f " Text 3"
+    close $f
+    set f [open test3 r]
+    set x [gets $f]
+    close $f
+    set x
+} {Text1 Text 2 Text 3}
+test io-6.15 {Tcl_Flush, channel not open for writing} {
+    removeFile test1
+    set fd [open test1 w]
+    close $fd
+    set fd [open test1 r]
+    set x [list [catch {flush $fd} msg] $msg]
+    close $fd
+    string compare $x \
+	[list 1 "channel \"$fd\" wasn't opened for writing"]
+} 0
+test io-6.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
+    set fd [open "|[list $tcltest 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-6.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf
+    puts $f1 hello
+    puts $f1 hello
+    puts $f1 hello
+    flush $f1
+    set x [file size test1]
+    close $f1
+    set x
+} 18
+test io-6.18 {Tcl_Write and Tcl_Flush intermixed} {
+    removeFile test1
+    set x ""
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf
+    puts $f1 hello
+    puts $f1 hello
+    puts $f1 hello
+    flush $f1
+    lappend x [file size test1]
+    puts $f1 hello
+    flush $f1
+    lappend x [file size test1]
+    puts $f1 hello
+    flush $f1
+    lappend x [file size test1]
+    close $f1
+    set x
+} {18 24 30}
+test io-6.19 {Explicit and implicit flushes} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    set x ""
+    puts $f1 hello
+    puts $f1 hello
+    puts $f1 hello
+    flush $f1
+    lappend x [file size test1]
+    puts $f1 hello
+    flush $f1
+    lappend x [file size test1]
+    puts $f1 hello
+    close $f1
+    lappend x [file size test1]
+    set x
+} {18 24 30}
+test io-6.20 {Implicit flush when buffer is full} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
+    for {set x 0} {$x < 100} {incr x} {
+      puts $f1 $line
+    }
+    set z ""
+    lappend z [file size test1]
+    for {set x 0} {$x < 100} {incr x} {
+        puts $f1 $line
+    }
+    lappend z [file size test1]
+    close $f1
+    lappend z [file size test1]
+    set z
+} {4096 12288 12600}
+test io-6.21 {Tcl_Flush to pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {set x [read stdin 6]}
+    puts $f1 {set cnt [string length $x]}
+    puts $f1 {puts "read $cnt characters"}
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    puts $f1 hello
+    flush $f1
+    set x [gets $f1]
+    catch {close $f1}
+    set x
+} "read 6 characters"
+test io-6.22 {Tcl_Flush called at other end of pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	fconfigure stdout -buffering full
+	puts hello
+	puts hello
+	flush stdout
+	gets stdin
+	puts bye
+	flush stdout
+    }
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    set x ""
+    lappend x [gets $f1]
+    lappend x [gets $f1]
+    puts $f1 hello
+    flush $f1
+    lappend x [gets $f1]
+    close $f1
+    set x
+} {hello hello bye}
+test io-6.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {
+	puts hello
+	puts hello
+	gets stdin
+	puts bye
+    }
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    set x ""
+    lappend x [gets $f1]
+    lappend x [gets $f1]
+    puts $f1 hello
+    flush $f1
+    lappend x [gets $f1]
+    close $f1
+    set x
+} {hello hello bye}
+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"
+    set f2 [open test3]
+    set x {}
+    lappend x [read -nonewline $f2]
+    close $f2
+    flush $f
+    set f2 [open test3]
+    lappend x [read -nonewline $f2]
+    close $f2
+    close $f
+    set x
+} {{} {Line 1
+Line 2}}
+test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
+    removeFile test3
+    set f [open "|[list $tcltest cat | $tcltest cat > test3]" w]
+    puts $f "Line 1"
+    puts $f "Line 2"
+    close $f
+    after 100
+    set f [open test3 r]
+    set x [read $f]
+    close $f
+    set x
+} {Line 1
+Line 2
+}    
+test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc && unixExecs && tempNotPc} {
+    set f [open "|[list cat -u]" r+]
+    puts $f "Line1"
+    flush $f
+    set x [gets $f]
+    close $f
+    set x
+} {Line1}
+test io-6.27 {Tcl_Flush on closed pipeline} {stdio && tempNotPc} {
+    removeFile pipe
+    set f [open pipe w]
+    puts $f {exit}
+    close $f
+    set f [open "|[list $tcltest pipe]" r+]
+    gets $f
+    puts $f output
+    after 50
+    #
+    # The flush below will get a SIGPIPE. This is an expected part of
+    # test and indicates that the test operates correctly. If you run
+    # this test under a debugger, the signal will by intercepted unless
+    # you disable the debugger's signal interception.
+    #
+    if {[catch {flush $f} msg]} {
+	set x [list 1 $msg $errorCode]
+	catch {close $f}
+    } else {
+	if {[catch {close $f} msg]} {
+	    set x [list 1 $msg $errorCode]
+	} else {
+	    set x {this was supposed to fail and did not}
+	}
+    }
+    regsub {".*":} $x {"":} x
+    string tolower $x
+} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
+test io-6.28 {Tcl_Write, lf mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f hello\nthere\nand\nhere
+    flush $f
+    set s [file size test1]
+    close $f
+    set s
+} 21
+test io-6.29 {Tcl_Write, cr mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr -eofchar {}
+    puts $f hello\nthere\nand\nhere
+    close $f
+    file size test1
+} 21
+test io-6.30 {Tcl_Write, crlf mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf -eofchar {}
+    puts $f hello\nthere\nand\nhere
+    close $f
+    file size test1
+} 25
+test io-6.31 {Tcl_Write, background flush} {stdio} {
+    removeFile pipe
+    removeFile output
+    set f [open pipe w]
+    puts $f {set f [open output w]}
+    puts $f {fconfigure $f -translation lf}
+    set x [list while {![eof stdin]}]
+    set x "$x {"
+    puts $f $x
+    puts $f {  puts -nonewline $f [read stdin 4096]}
+    puts $f {  flush $f}
+    puts $f "}"
+    puts $f {close $f}
+    close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+        set x "$x$x"
+    }
+    set f [open output w]
+    close $f
+    set f [open "|[list $tcltest pipe]" r+]
+    fconfigure $f -blocking off
+    puts -nonewline $f $x
+    close $f
+    set counter 0
+    while {([file size output] < 65536) && ($counter < 1000)} {
+        incr counter
+        after 5
+        update
+    }
+    if {$counter == 1000} {
+        set result probably_broken
+    } else {
+        set result ok
+    }
+} ok
+test io-6.32 {Tcl_Write, background flush to slow reader} {stdio && asyncPipeClose} {
+    removeFile pipe
+    removeFile output
+    set f [open pipe w]
+    puts $f {set f [open output w]}
+    puts $f {fconfigure $f -translation lf}
+    set x [list while {![eof stdin]}]
+    set x "$x {"
+    puts $f $x
+    puts $f {  after 20}
+    puts $f {  puts -nonewline $f [read stdin 1024]}
+    puts $f {  flush $f}
+    puts $f "}"
+    puts $f {close $f}
+    close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+        set x "$x$x"
+    }
+    set f [open output w]
+    close $f
+    set f [open "|[list $tcltest pipe]" r+]
+    fconfigure $f -blocking off
+    puts -nonewline $f $x
+    close $f
+    set counter 0
+    while {([file size output] < 65536) && ($counter < 1000)} {
+        incr counter
+        after 20
+        update
+    }
+    if {$counter == 1000} {
+        set result probably_broken
+    } else {
+        set result ok
+    }
+} ok
+test io-6.33 {Tcl_Flush, implicit flush on exit} {stdio} {
+    set f [open script w]
+    puts $f {
+	set f [open test1 w]
+	fconfigure $f -translation lf
+	puts $f hello
+	puts $f bye
+	puts $f strange
+    }
+    close $f
+    exec $tcltest script
+    set f [open test1 r]
+    set r [read $f]
+    close $f
+    set r
+} {hello
+bye
+strange
+}
+
+test io-6.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
+    set c 0
+    set x running
+    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
+    proc writelots {s l} {
+	for {set i 0} {$i < 2000} {incr i} {
+	    puts $s $l
+	}
+    }
+    proc accept {s a p} {
+	global x
+	fileevent $s readable [list readit $s]
+	fconfigure $s -blocking off
+	set x accepted
+    }
+    proc readit {s} {
+	global c x
+	set l [gets $s]
+	
+	if {[eof $s]} {
+	    close $s
+	    set x done
+	} elseif {([string length $l] > 0) || ![fblocked $s]} {
+	    incr c
+	}
+    }
+    set ss [socket -server accept 2828]
+    set cs [socket [info hostname] 2828]
+    vwait x
+    fconfigure $cs -blocking off
+    writelots $cs $l
+    close $cs
+    close $ss
+    vwait x
+    set c
+} 2000
+test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket} {
+    catch {interp delete x}
+    catch {interp delete y}
+    interp create x
+    interp create y
+    set s [socket -server accept 2828]
+    proc accept {s a p} {
+	puts $s hello
+	close $s
+    }
+    set c [socket [info hostname] 2828]
+    interp share {} $c x
+    interp share {} $c y
+    close $c
+    x eval {
+	proc readit {s} {
+	    gets $s
+	    if {[eof $s]} {
+		close $s
+	    }
+	}
+    }
+    y eval {
+	proc readit {s} {
+	    gets $s
+	    if {[eof $s]} {
+		close $s
+	    }
+	}
+    }
+    x eval "fileevent $c readable \{readit $c\}"
+    y eval "fileevent $c readable \{readit $c\}"
+    y eval [list close $c]
+    update
+    close $s
+    interp delete x
+    interp delete y
+} ""
+
+# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
+
+test io-7.1 {Tcl_Write lf, Tcl_Read lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf
+    set x [read $f]
+    close $f
+    set x
+} "hello\nthere\nand\nhere\n"
+test io-7.2 {Tcl_Write lf, Tcl_Read cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr
+    set x [read $f]
+    close $f
+    set x
+} "hello\nthere\nand\nhere\n"
+test io-7.3 {Tcl_Write lf, Tcl_Read crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set x [read $f]
+    close $f
+    set x
+} "hello\nthere\nand\nhere\n"
+test io-7.4 {Tcl_Write cr, Tcl_Read cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr
+    set x [read $f]
+    close $f
+    set x
+} "hello\nthere\nand\nhere\n"
+test io-7.5 {Tcl_Write cr, Tcl_Read lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf
+    set x [read $f]
+    close $f
+    set x
+} "hello\rthere\rand\rhere\r"
+test io-7.6 {Tcl_Write cr, Tcl_Read crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set x [read $f]
+    close $f
+    set x 
+} "hello\rthere\rand\rhere\r"
+test io-7.7 {Tcl_Write crlf, Tcl_Read crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set x [read $f]
+    close $f
+    set x
+} "hello\nthere\nand\nhere\n"
+test io-7.8 {Tcl_Write crlf, Tcl_Read lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf
+    set x [read $f]
+    close $f
+    set x
+} "hello\r\nthere\r\nand\r\nhere\r\n"
+test io-7.9 {Tcl_Write crlf, Tcl_Read cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr
+    set x [read $f]
+    close $f
+    set x
+} "hello\n\nthere\n\nand\n\nhere\n\n"
+test io-7.10 {Tcl_Write lf, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    set c [read $f]
+    set x [fconfigure $f -translation]
+    close $f
+    list $c $x
+} {{hello
+there
+and
+here
+} auto}
+test io-7.11 {Tcl_Write cr, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    set c [read $f]
+    set x [fconfigure $f -translation]
+    close $f
+    list $c $x
+} {{hello
+there
+and
+here
+} auto}
+test io-7.12 {Tcl_Write crlf, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    set c [read $f]
+    set x [fconfigure $f -translation]
+    close $f
+    list $c $x
+} {{hello
+there
+and
+here
+} 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
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	puts $f $line
+    }
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set c [read $f]
+    close $f
+    string length $c
+} [expr 700*15+1]
+
+test io-7.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	puts $f $line
+    }
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set c [read $f]
+    close $f
+    string length $c
+} [expr 700*15+1]
+
+test io-7.15 {Tcl_Write mixed, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\rhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set c [read $f]
+    close $f
+    set c
+} {hello
+there
+and
+here
+}
+test io-7.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f hello\nthere\nand\rhere\n\x1a
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set c [read $f]
+    close $f
+    set c
+} {hello
+there
+and
+here
+}
+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
+    puts $f hello\nthere\nand\rhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set c [read $f]
+    close $f
+    set c
+} {hello
+there
+and
+here
+}
+test io-7.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1 {} 1}
+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
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar {}
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "abc def 0 \x1aghi 0 qrs 0 {} 1"
+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 {}
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar {}
+    set l ""
+    set x [gets $f]
+    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs"]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {0 1 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar {}
+    set l ""
+    set x [gets $f]
+    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs"]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {0 1 {} 1}
+test io-7.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    puts $f $c
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set c [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $e
+} {8 1}
+test io-7.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    puts $f $c
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar \x1a
+    set c [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $e
+} {8 1}
+test io-7.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    puts $f $c
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set c [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $e
+} {8 1}
+test io-7.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    puts $f $c
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar \x1a
+    set c [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $e
+} {8 1}
+test io-7.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    puts $f $c
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set c [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $e
+} {8 1}
+test io-7.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    puts $f $c
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set c [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $e
+} {8 1}
+
+# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.
+
+test io-8.1 {Tcl_Write lf, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    close $f
+    set l
+} {hello 6 auto there 12 auto}
+test io-8.2 {Tcl_Write cr, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    close $f
+    set l
+} {hello 6 auto there 12 auto}
+test io-8.3 {Tcl_Write crlf, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    close $f
+    set l
+} {hello 7 auto there 14 auto}
+test io-8.4 {Tcl_Write lf, Tcl_Gets lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    close $f
+    set l
+} {hello 6 lf there 12 lf}
+test io-8.5 {Tcl_Write lf, Tcl_Gets cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr
+    set l ""
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {20 21 cr 1 {} 21 cr 1}
+test io-8.6 {Tcl_Write lf, Tcl_Gets crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set l ""
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {20 21 crlf 1 {} 21 crlf 1}
+test io-8.7 {Tcl_Write cr, Tcl_Gets cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello 6 cr 0 there 12 cr 0}
+test io-8.8 {Tcl_Write cr, Tcl_Gets lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf
+    set l ""
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {21 21 lf 1 {} 21 lf 1}
+test io-8.9 {Tcl_Write cr, Tcl_Gets crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set l ""
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {21 21 crlf 1 {} 21 crlf 1}
+test io-8.10 {Tcl_Write crlf, Tcl_Gets crlf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello 7 crlf 0 there 14 crlf 0}
+test io-8.11 {Tcl_Write crlf, Tcl_Gets cr} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr
+    set l ""
+    lappend l [gets $f]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello 6 cr 0 6 13 cr 0}
+test io-8.12 {Tcl_Write crlf, Tcl_Gets lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    puts $f hello\nthere\nand\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf
+    set l ""
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    lappend l [string length [gets $f]]
+    lappend l [tell $f]
+    lappend l [fconfigure $f -translation]
+    lappend l [eof $f]
+    close $f
+    set l
+} {6 7 lf 0 6 14 lf 0}
+test io-8.13 {binary mode is synonym of lf mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation binary
+    set x [fconfigure $f -translation]
+    close $f
+    set x
+} lf
+#
+# Test io-9.14 has been removed because "auto" output translation mode is
+# not supoprted.
+#
+test io-8.14 {Tcl_Write mixed, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts $f hello\nthere\rand\r\nhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello there and here 0 {} 1}
+test io-8.15 {Tcl_Write mixed, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f hello\nthere\rand\r\nhere\r
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello there and here 0 {} 1}
+test io-8.16 {Tcl_Write mixed, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f hello\nthere\rand\r\nhere\n
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello there and here 0 {} 1}
+test io-8.17 {Tcl_Write mixed, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    puts -nonewline $f hello\nthere\rand\r\nhere\r\n
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello there and here 0 {} 1}
+test io-8.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set s [format "hello\nthere\nand\rhere\n\%c" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello there and here 0 {} 1}
+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
+    puts $f hello\nthere\nand\rhere
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {hello there and here 0 {} 1}
+test io-8.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a
+    fconfigure $f -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+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
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar {}
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar {}
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar {}
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test io-8.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+test io-8.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar \x1a
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar \x1a
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+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 {}
+    set s [format "abc\ndef\n%cqrs\ntuv" 26]
+    puts $f $s
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l ""
+    lappend l [gets $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {abc def 0 {} 1}
+test io-8.31 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	puts $f $line
+    }
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set c ""
+    while {[gets $f line] >= 0} {
+	append c $line\n
+    }
+    close $f
+    string length $c
+} [expr 700*15+1]
+test io-8.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 256} {incr i} {
+	puts $f $line
+    }
+    close $f
+    set f [open test1 r]
+    fconfigure $f -translation auto
+    set c ""
+    while {[gets $f line] >= 0} {
+	append c $line\n
+    }
+    close $f
+    string length $c
+} [expr 256*15+1]
+
+
+# Test Tcl_Read and buffering.
+
+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-9.2 {Tcl_Read, zero byte count} {
+    read stdin 0
+} ""
+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-9.4 {Tcl_Read, positive byte count} {
+    set f [open longfile r]
+    set x [read $f 1024]
+    set s [string length $x]
+    unset x
+    close $f
+    set s
+} 1024
+test io-9.5 {Tcl_Read, multiple buffers} {
+    set f [open longfile r]
+    fconfigure $f -buffersize 100
+    set x [read $f 1024]
+    set s [string length $x]
+    unset x
+    close $f
+    set s
+} 1024
+test io-9.6 {Tcl_Read, very large read} {
+    set f1 [open longfile r]
+    set z [read $f1 1000000]
+    close $f1
+    set l [string length $z]
+    set x ok
+    set z [file size longfile]
+    if {$z != $l} {
+        set x broken
+    }
+    set x
+} ok
+test io-9.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+    set f1 [open longfile r]
+    fconfigure $f1 -blocking off
+    set z [read $f1 20]
+    close $f1
+    set l [string length $z]
+    set x ok
+    if {$l != 20} {
+        set x broken
+    }
+    set x
+} ok
+test io-9.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+    set f1 [open longfile r]
+    fconfigure $f1 -blocking off
+    set z [read $f1 1000000]
+    close $f1
+    set x ok
+    set l [string length $z]]
+    set z [file size longfile]]
+    if {$z != $l} {
+        set x broken
+    }
+  set x
+} ok
+test io-9.9 {Tcl_Read, read to end of file} {
+    set f1 [open longfile r]
+    set z [read $f1]
+    close $f1
+    set l [string length $z]
+    set x ok
+    set z [file size longfile]
+    if {$z != $l} {
+        set x broken
+    }
+    set x
+} ok
+test io-9.10 {Tcl_Read from a pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {puts [gets stdin]}
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    puts $f1 hello
+    flush $f1
+    set x [read $f1]
+    close $f1
+    set x
+} "hello\n"
+test io-9.11 {Tcl_Read from a pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {puts [gets stdin]}
+    puts $f1 {puts [gets stdin]}
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    puts $f1 hello
+    flush $f1
+    set x ""
+    lappend x [read $f1 6]
+    puts $f1 hello
+    flush $f1
+    lappend x [read $f1]
+    close $f1
+    set x
+} {{hello
+} {hello
+}}
+test io-9.12 {Tcl_Read, -nonewline} {
+    removeFile test1
+    set f1 [open test1 w]
+    puts $f1 hello
+    puts $f1 bye
+    close $f1
+    set f1 [open test1 r]
+    set c [read -nonewline $f1]
+    close $f1
+    set c
+} {hello
+bye}
+test io-9.13 {Tcl_Read, -nonewline} {
+    removeFile test1
+    set f1 [open test1 w]
+    puts $f1 hello
+    puts $f1 bye
+    close $f1
+    set f1 [open test1 r]
+    set c [read -nonewline $f1]
+    close $f1
+    list [string length $c] $c
+} {9 {hello
+bye}}
+test io-9.14 {Tcl_Read, reading in small chunks} {
+    removeFile test1
+    set f [open test1 w]
+    puts $f "Two lines: this one"
+    puts $f "and this one"
+    close $f
+    set f [open test1]
+    set x [list [read $f 1] [read $f 2] [read $f]]
+    close $f
+    set x
+} {T wo { lines: this one
+and this one
+}}
+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"
+    puts $f "and this one"
+    close $f
+    set f [open test1]
+    set x [read $f 100]
+    close $f
+    set x
+} {Two lines: this one
+and this one
+}
+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"
+    puts $f "and this one"
+    close $f
+    set f [open test1]
+    set x [read -nonewline $f]
+    close $f
+    set x
+} {Two lines: this one
+and this one}
+
+# Test Tcl_Gets.
+
+test io-10.1 {Tcl_Gets, reading what was written} {
+    removeFile test1
+    set f1 [open test1 w]
+    set y "first line"
+    puts $f1 $y
+    close $f1
+    set f1 [open test1 r]
+    set x [gets $f1]
+    set z ok
+    if {"$x" != "$y"} {
+        set z broken
+    }
+    close $f1
+    set z
+} ok
+test io-10.2 {Tcl_Gets into variable} {
+    set f1 [open longfile r]
+    set c [gets $f1 x]
+    set l [string length x]
+    set z ok
+    if {$l != $l} {
+        set z broken
+    }
+    close $f1
+    set z
+} ok
+test io-10.3 {Tcl_Gets from pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {puts [gets stdin]}
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    puts $f1 hello
+    flush $f1
+    set x [gets $f1]
+    close $f1
+    set z ok
+    if {"$x" != "hello"} {
+        set z broken
+    }
+    set z
+} ok
+test io-10.4 {Tcl_Gets with long line} {
+    removeFile test3
+    set f [open test3 w]
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    close $f
+    set f [open test3]
+    set x [gets $f]
+    close $f
+    set x
+} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+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-10.6 {Tcl_Gets and end of file} {
+    removeFile test3
+    set f [open test3 w]
+    puts -nonewline $f "Test1\nTest2"
+    close $f
+    set f [open test3]
+    set x {}
+    set y {}
+    lappend x [gets $f y] $y
+    set y {}
+    lappend x [gets $f y] $y
+    set y {}
+    lappend x [gets $f y] $y
+    close $f
+    set x
+} {5 Test1 5 Test2 -1 {}}
+test io-10.7 {Tcl_Gets and bad variable} {
+    set f [open test3 w]
+    puts $f "Line 1"
+    puts $f "Line 2"
+    close $f
+    catch {unset x}
+    set x 24
+    set f [open test3 r]
+    set result [list [catch {gets $f x(0)} msg] $msg]
+    close $f
+    set result
+} {1 {can't set "x(0)": variable isn't array}}
+test io-10.8 {Tcl_Gets, exercising double buffering} {
+    set f [open test3 w]
+    fconfigure $f -translation lf -eofchar {}
+    set x ""
+    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+    for {set y 0} {$y < 100} {incr y} {puts $f $x}
+    close $f
+    set f [open test3 r]
+    fconfigure $f -translation lf
+    for {set y 0} {$y < 100} {incr y} {gets $f}
+    close $f
+    set y
+} 100
+test io-10.9 {Tcl_Gets, exercising double buffering} {
+    set f [open test3 w]
+    fconfigure $f -translation lf -eofchar {}
+    set x ""
+    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+    for {set y 0} {$y < 200} {incr y} {puts $f $x}
+    close $f
+    set f [open test3 r]
+    fconfigure $f -translation lf
+    for {set y 0} {$y < 200} {incr y} {gets $f}
+    close $f
+    set y
+} 200
+test io-10.10 {Tcl_Gets, exercising double buffering} {
+    set f [open test3 w]
+    fconfigure $f -translation lf -eofchar {}
+    set x ""
+    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+    for {set y 0} {$y < 300} {incr y} {puts $f $x}
+    close $f
+    set f [open test3 r]
+    fconfigure $f -translation lf
+    for {set y 0} {$y < 300} {incr y} {gets $f}
+    close $f
+    set y
+} 300
+
+# Test Tcl_Seek and Tcl_Tell.
+
+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-11.2 {Tcl_Seek to offset from start} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 10 start
+    set c [tell $f1]
+    close $f1
+    set c
+} 10
+test io-11.3 {Tcl_Seek to end of file} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 0 end
+    set c [tell $f1]
+    close $f1
+    set c
+} 54
+test io-11.4 {Tcl_Seek to offset from end of file} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 -10 end
+    set c [tell $f1]
+    close $f1
+    set c
+} 44
+test io-11.5 {Tcl_Seek to offset from current position} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 10 current
+    seek $f1 10 current
+    set c [tell $f1]
+    close $f1
+    set c
+} 20
+test io-11.6 {Tcl_Seek to offset from end of file} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 -10 end
+    set c [tell $f1]
+    set r [read $f1]
+    close $f1
+    list $c $r
+} {44 {rstuvwxyz
+}}
+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 {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 -10 end
+    set c1 [tell $f1]
+    set r1 [read $f1 5]
+    seek $f1 0 current
+    set c2 [tell $f1]
+    close $f1
+    list $c1 $r1 $c2
+} {44 rstuv 49}
+test io-11.8 {Tcl_Seek on pipes: not supported} {stdio} {
+    set f1 [open "|[list $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-11.9 {Tcl_Seek, testing buffered input flushing} {
+    removeFile test3
+    set f [open test3 w]
+    fconfigure $f -eofchar {}
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    close $f
+    set f [open test3 RDWR]
+    set x [read $f 1]
+    seek $f 3
+    lappend x [read $f 1]
+    seek $f 0 start
+    lappend x [read $f 1]
+    seek $f 10 current
+    lappend x [read $f 1]
+    seek $f -2 end
+    lappend x [read $f 1]
+    seek $f 50 end
+    lappend x [read $f 1]
+    seek $f 1
+    lappend x [read $f 1]
+    close $f
+    set x
+} {a d a l Y {} b}
+test io-11.10 {Tcl_Seek testing flushing of buffered input} {
+    set f [open test3 w]
+    fconfigure $f -translation lf
+    puts $f xyz\n123
+    close $f
+    set f [open test3 r+]
+    fconfigure $f -translation lf
+    set x [gets $f]
+    seek $f 0 current
+    puts $f 456
+    close $f
+    list $x [viewFile test3]
+} "xyz {xyz
+456}"
+test io-11.11 {Tcl_Seek testing flushing of buffered output} {
+    set f [open test3 w]
+    puts $f xyz\n123
+    close $f
+    set f [open test3 w+]
+    puts $f xyzzy
+    seek $f 2
+    set x [gets $f]
+    close $f
+    list $x [viewFile test3]
+} "zzy xyzzy"
+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
+    close $f
+    set f [open test3 a+]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f xyzzy
+    flush $f
+    set x [tell $f]
+    seek $f -4 cur
+    set y [gets $f]
+    close $f
+    list $x [viewFile test3] $y
+} {14 {xyz
+123
+xyzzy} zzy}
+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-11.14 {Tcl_Tell after seek to end of file} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 0 end
+    set c1 [tell $f1]
+    close $f1
+    set c1
+} 54
+test io-11.15 {Tcl_Tell combined with seeking} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    close $f1
+    set f1 [open test1 r]
+    seek $f1 10 start
+    set c1 [tell $f1]
+    seek $f1 10 current
+    set c2 [tell $f1]
+    close $f1
+    list $c1 $c2
+} {10 20}
+test io-11.16 {Tcl_tell on pipe: always -1} {stdio} {
+    set f1 [open "|[list $tcltest]" r+]
+    set c [tell $f1]
+    close $f1
+    set c
+} -1
+test io-11.17 {Tcl_Tell on pipe: always -1} {stdio} {
+    set f1 [open "|[list $tcltest]" r+]
+    puts $f1 {puts hello}
+    flush $f1
+    set c [tell $f1]
+    gets $f1
+    close $f1
+    set c
+} -1
+test io-11.18 {Tcl_Tell combined with seeking and reading} {
+    removeFile test2
+    set f [open test2 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
+    close $f
+    set f [open test2]
+    fconfigure $f -translation lf
+    set x [tell $f]
+    read $f 3
+    lappend x [tell $f]
+    seek $f 2
+    lappend x [tell $f]
+    seek $f 10 current
+    lappend x [tell $f]
+    seek $f 0 end
+    lappend x [tell $f]
+    close $f
+    set x
+} {0 3 2 12 30}
+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"
+    puts $f "abcdefghijklmnopqrstuvwxyz"
+    close $f
+    set f [open test3 a]
+    set c [tell $f]
+    close $f
+    set c
+} 54
+test io-11.20 {Tcl_Tell combined with writing} {
+    set f [open test3 w]
+    set l ""
+    seek $f 29 start
+    lappend l [tell $f]
+    puts -nonewline $f a
+    seek $f 39 start
+    lappend l [tell $f]
+    puts -nonewline $f a
+    lappend l [tell $f]
+    seek $f 407 end
+    lappend l [tell $f]
+    close $f
+    set l
+} {29 39 40 447}
+
+# Test Tcl_Eof
+
+test io-12.1 {Tcl_Eof} {
+    removeFile test1
+    set f [open test1 w]
+    puts $f hello
+    puts $f hello
+    close $f
+    set f [open test1]
+    set x [eof $f]
+    lappend x [eof $f]
+    gets $f
+    lappend x [eof $f]
+    gets $f
+    lappend x [eof $f]
+    gets $f
+    lappend x [eof $f]
+    lappend x [eof $f]
+    close $f
+    set x
+} {0 0 0 0 1 1}
+test io-12.2 {Tcl_Eof with pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {gets stdin}
+    puts $f1 {puts hello}
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    puts $f1 hello
+    set x [eof $f1]
+    flush $f1
+    lappend x [eof $f1]
+    gets $f1
+    lappend x [eof $f1]
+    gets $f1
+    lappend x [eof $f1]
+    close $f1
+    set x
+} {0 0 0 1}
+test io-12.3 {Tcl_Eof with pipe} {stdio} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {gets stdin}
+    puts $f1 {puts hello}
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    puts $f1 hello
+    set x [eof $f1]
+    flush $f1
+    lappend x [eof $f1]
+    gets $f1
+    lappend x [eof $f1]
+    gets $f1
+    lappend x [eof $f1]
+    gets $f1
+    lappend x [eof $f1]
+    gets $f1
+    lappend x [eof $f1]
+    close $f1
+    set x
+} {0 0 0 1 1 1}
+test io-12.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
+    removeFile test1
+    set f [open test1 w]
+    close $f
+    set f [open test1 r]
+    fconfigure $f -blocking off
+    set l ""
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {{} 1}
+test io-12.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
+    removeFile pipe
+    set f [open pipe w]
+    puts $f {
+	exit
+    }
+    close $f
+    set f [open "|[list $tcltest pipe]" r]
+    set l ""
+    lappend l [gets $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {{} 1}
+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
+    puts $f abc\ndef
+    close $f
+    set s [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $s $l $e
+} {9 8 1}
+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
+    puts $f abc\ndef
+    close $f
+    set s [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $s $l $e
+} {9 8 1}
+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
+    puts $f abc\ndef
+    close $f
+    set s [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $s $l $e
+} {9 8 1}
+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
+    puts $f abc\ndef
+    close $f
+    set s [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $s $l $e
+} {9 8 1}
+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
+    puts $f abc\ndef
+    close $f
+    set s [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $s $l $e
+} {11 8 1}
+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
+    puts $f abc\ndef
+    close $f
+    set s [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $s $l $e
+} {11 8 1}
+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 {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $l $e
+} {17 8 1}
+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 {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $l $e
+} {17 8 1}
+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 {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $l $e
+} {17 8 1}
+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 {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $l $e
+} {17 8 1}
+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 {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $l $e
+} {21 8 1}
+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 {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size test1]
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [read $f]]
+    set e [eof $f]
+    close $f
+    list $c $l $e
+} {21 8 1}
+
+# Test Tcl_InputBlocked
+
+test io-13.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
+    set f1 [open "|[list $tcltest]" r+]
+    puts $f1 {puts hello_from_pipe}
+    flush $f1
+    gets $f1
+    fconfigure $f1 -blocking off -buffering full
+    puts $f1 {puts hello}
+    set x ""
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    flush $f1
+    after 200
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    close $f1
+    set x
+} {{} 1 hello 0 {} 1}
+test io-13.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
+    set f1 [open "|[list $tcltest]" r+]
+    fconfigure $f1 -buffering line
+    puts $f1 {puts hello_from_pipe}
+    set x ""
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    puts $f1 {exit}
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    lappend x [eof $f1]
+    close $f1
+    set x
+} {hello_from_pipe 0 {} 0 1}
+test io-13.3 {Tcl_InputBlocked vs files, short read} {
+    removeFile test1
+    set f [open test1 w]
+    puts $f abcdefghijklmnop
+    close $f
+    set f [open test1 r]
+    set l ""
+    lappend l [fblocked $f]
+    lappend l [read $f 3]
+    lappend l [fblocked $f]
+    lappend l [read -nonewline $f]
+    lappend l [fblocked $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {0 abc 0 defghijklmnop 0 1}
+test io-13.4 {Tcl_InputBlocked vs files, event driven read} {
+    proc in {f} {
+        global l x
+	lappend l [read $f 3]
+	if {[eof $f]} {lappend l eof; close $f; set x done}
+    }
+    removeFile test1
+    set f [open test1 w]
+    puts $f abcdefghijklmnop
+    close $f
+    set f [open test1 r]
+    set l ""
+    fileevent $f readable [list in $f]
+    vwait x
+    set l
+} {abc def ghi jkl mno {p
+} eof}
+test io-13.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
+    removeFile test1
+    set f [open test1 w]
+    puts $f abcdefghijklmnop
+    close $f
+    set f [open test1 r]
+    fconfigure $f -blocking off
+    set l ""
+    lappend l [fblocked $f]
+    lappend l [read $f 3]
+    lappend l [fblocked $f]
+    lappend l [read -nonewline $f]
+    lappend l [fblocked $f]
+    lappend l [eof $f]
+    close $f
+    set l
+} {0 abc 0 defghijklmnop 0 1}
+test io-13.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
+    proc in {f} {
+        global l x
+	lappend l [read $f 3]
+	if {[eof $f]} {lappend l eof; close $f; set x done}
+    }
+    removeFile test1
+    set f [open test1 w]
+    puts $f abcdefghijklmnop
+    close $f
+    set f [open test1 r]
+    fconfigure $f -blocking off
+    set l ""
+    fileevent $f readable [list in $f]
+    vwait x
+    set l
+} {abc def ghi jkl mno {p
+} eof}
+
+# Test Tcl_InputBuffered
+
+test io-14.1 {Tcl_InputBuffered} {
+    set f [open longfile r]
+    fconfigure $f -buffersize 4096
+    read $f 3
+    set l ""
+    lappend l [testchannel inputbuffered $f]
+    lappend l [tell $f]
+    close $f
+    set l
+} {4093 3}
+test io-14.2 {Tcl_InputBuffered, test input flushing on seek} {
+    set f [open longfile r]
+    fconfigure $f -buffersize 4096
+    read $f 3
+    set l ""
+    lappend l [testchannel inputbuffered $f]
+    lappend l [tell $f]
+    seek $f 0 current
+    lappend l [testchannel inputbuffered $f]
+    lappend l [tell $f]
+    close $f
+    set l
+} {4093 3 0 3}
+
+# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
+
+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-15.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
+    set f [open longfile r]
+    set l ""
+    lappend l [fconfigure $f -buffersize]
+    fconfigure $f -buffersize 10000
+    lappend l [fconfigure $f -buffersize]
+    fconfigure $f -buffersize 1
+    lappend l [fconfigure $f -buffersize]
+    fconfigure $f -buffersize -1
+    lappend l [fconfigure $f -buffersize]
+    fconfigure $f -buffersize 0
+    lappend l [fconfigure $f -buffersize]
+    fconfigure $f -buffersize 100000
+    lappend l [fconfigure $f -buffersize]
+    fconfigure $f -buffersize 10000000
+    lappend l [fconfigure $f -buffersize]
+    close $f
+    set l
+} {4096 10000 4096 4096 4096 100000 4096}
+
+# Test Tcl_SetChannelOption, Tcl_GetChannelOption
+
+test io-16.1 {Tcl_GetChannelOption} {
+    removeFile test1
+    set f1 [open test1 w]
+    set x [fconfigure $f1 -blocking]
+    close $f1
+    set x
+} 1
+#
+# Test 17.2 was removed.
+#
+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-16.3 {Tcl_GetChannelOption} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -buffering line
+    set x [fconfigure $f1 -buffering]
+    close $f1
+    set x
+} line
+test io-16.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
+    removeFile test1
+    set f1 [open test1 w]
+    set l ""
+    lappend l [fconfigure $f1 -buffering]
+    fconfigure $f1 -buffering line
+    lappend l [fconfigure $f1 -buffering]
+    fconfigure $f1 -buffering none
+    lappend l [fconfigure $f1 -buffering]
+    fconfigure $f1 -buffering line
+    lappend l [fconfigure $f1 -buffering]
+    fconfigure $f1 -buffering full
+    lappend l [fconfigure $f1 -buffering]
+    close $f1
+    set l
+} {full line none line full}
+test io-16.5 {Tcl_GetChannelOption, invariance} {
+    removeFile test1
+    set f1 [open test1 w]
+    set l ""
+    lappend l [fconfigure $f1 -buffering]
+    lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg]
+    lappend l [fconfigure $f1 -buffering]
+    close $f1
+    set l
+} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
+test io-16.6 {Tcl_SetChannelOption, multiple options} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -buffering line
+    puts $f1 hello
+    puts $f1 bye
+    set x [file size test1]
+    close $f1
+    set x
+} 10
+test io-16.7 {Tcl_SetChannelOption, buffering, translation} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf
+    puts $f1 hello
+    puts $f1 bye
+    set x ""
+    fconfigure $f1 -buffering line
+    lappend x [file size test1]
+    puts $f1 really_bye
+    lappend x [file size test1]
+    close $f1
+    set x
+} {0 21}
+test io-16.8 {Tcl_SetChannelOption, different buffering options} {
+    removeFile test1
+    set f1 [open test1 w]
+    set l ""
+    fconfigure $f1 -translation lf -buffering none -eofchar {}
+    puts -nonewline $f1 hello
+    lappend l [file size test1]
+    puts -nonewline $f1 hello
+    lappend l [file size test1]
+    fconfigure $f1 -buffering full
+    puts -nonewline $f1 hello
+    lappend l [file size test1]
+    fconfigure $f1 -buffering none
+    lappend l [file size test1]
+    puts -nonewline $f1 hello
+    lappend l [file size test1]
+    close $f1
+    lappend l [file size test1]
+    set l
+} {5 10 10 10 20 20}
+test io-16.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
+    removeFile test1
+    set f1 [open test1 w]
+    close $f1
+    set f1 [open test1 r]
+    set x ""
+    lappend x [fconfigure $f1 -blocking]
+    fconfigure $f1 -blocking off
+    lappend x [fconfigure $f1 -blocking]
+    lappend x [gets $f1]
+    lappend x [read $f1 1000]
+    lappend x [fblocked $f1]
+    lappend x [eof $f1]
+    close $f1
+    set x
+} {1 0 {} {} 0 1}
+test io-16.10 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
+    removeFile pipe
+    set f1 [open pipe w]
+    puts $f1 {gets stdin}
+    puts $f1 {after 100}
+    puts $f1 {puts hi}
+    puts $f1 {gets stdin}
+    close $f1
+    set x ""
+    set f1 [open "|[list $tcltest pipe]" r+]
+    fconfigure $f1 -blocking off -buffering line
+    lappend x [fconfigure $f1 -blocking]
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    puts $f1 hello
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    puts $f1 bye
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    fconfigure $f1 -blocking on
+    lappend x [fconfigure $f1 -blocking]
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    lappend x [eof $f1]
+    lappend x [gets $f1]
+    lappend x [eof $f1]
+    close $f1
+    set x
+} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
+test io-16.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -buffersize -10
+    set x [fconfigure $f -buffersize]
+    close $f
+    set x
+} 4096
+test io-16.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -buffersize 10000000
+    set x [fconfigure $f -buffersize]
+    close $f
+    set x
+} 4096
+test io-16.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -buffersize 40000
+    set x [fconfigure $f -buffersize]
+    close $f
+    set x
+} 40000
+test io-16.14 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto lf}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto lf}
+test io-16.15 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto crlf}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto crlf}
+test io-16.16 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto cr}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto cr}
+test io-16.17 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto auto}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto crlf}
+
+test io-17.1 {POSIX open access modes: RDWR} {
+    removeFile test3
+    set f [open test3 w]
+    puts $f xyzzy
+    close $f
+    set f [open test3 RDWR]
+    puts -nonewline $f "ab"
+    seek $f 0 current
+    set x [gets $f]
+    close $f
+    set f [open test3 r]
+    lappend x [gets $f]
+    close $f
+    set x
+} {zzy abzzy}
+test io-17.2 {POSIX open access modes: CREAT} {unixOnly} {
+    removeFile test3
+    set f [open test3 {WRONLY CREAT} 0600]
+    file stat test3 stats
+    set x [format "0%o" [expr $stats(mode)&0777]]
+    puts $f "line 1"
+    close $f
+    set f [open test3 r]
+    lappend x [gets $f]
+    close $f
+    set x
+} {0600 {line 1}}
+test io-17.3 {POSIX open access modes: CREAT} {$testConfig(unix) && ([exec umask] == 2)} {
+    # This test only works if your umask is 2, like ouster's.
+    removeFile test3
+    set f [open test3 {WRONLY CREAT}]
+    close $f
+    file stat test3 stats
+    format "0%o" [expr $stats(mode)&0777]
+} 0664
+test io-17.4 {POSIX open access modes: CREAT} {
+    removeFile test3
+    set f [open test3 w]
+    fconfigure $f -eofchar {}
+    puts $f xyzzy
+    close $f
+    set f [open test3 {WRONLY CREAT}]
+    fconfigure $f -eofchar {}
+    puts -nonewline $f "ab"
+    close $f
+    set f [open test3 r]
+    set x [gets $f]
+    close $f
+    set x
+} abzzy
+test io-17.5 {POSIX open access modes: APPEND} {
+    removeFile test3
+    set f [open test3 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f xyzzy
+    close $f
+    set f [open test3 {WRONLY APPEND}]
+    fconfigure $f -translation lf
+    puts $f "new line"
+    seek $f 0
+    puts $f "abc"
+    close $f
+    set f [open test3 r]
+    fconfigure $f -translation lf
+    set x ""
+    seek $f 6 current
+    lappend x [gets $f]
+    lappend x [gets $f]
+    close $f
+    set x
+} {{new line} abc}
+test io-17.6 {POSIX open access modes: EXCL} {
+    removeFile test3
+    set f [open test3 w]
+    puts $f xyzzy
+    close $f
+    set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg]
+    regsub " already " $msg " " msg
+    string tolower $msg
+} {1 {couldn't open "test3": file exists}}
+test io-17.7 {POSIX open access modes: EXCL} {
+    removeFile test3
+    set f [open test3 {WRONLY CREAT EXCL}]
+    fconfigure $f -eofchar {}
+    puts $f "A test line"
+    close $f
+    viewFile test3
+} {A test line}
+test io-17.8 {POSIX open access modes: TRUNC} {
+    removeFile test3
+    set f [open test3 w]
+    puts $f xyzzy
+    close $f
+    set f [open test3 {WRONLY TRUNC}]
+    puts $f abc
+    close $f
+    set f [open test3 r]
+    set x [gets $f]
+    close $f
+    set x
+} abc
+test io-17.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
+    removeFile test3
+    set f [open test3 {WRONLY NONBLOCK CREAT}]
+    puts $f "NONBLOCK test"
+    close $f
+    set f [open test3 r]
+    set x [gets $f]
+    close $f
+    set x
+} {NONBLOCK test}
+test io-17.10 {POSIX open access modes: RDONLY} {
+    set f [open test1 w]
+    puts $f "two lines: this one"
+    puts $f "and this"
+    close $f
+    set f [open test1 RDONLY]
+    set x [list [gets $f] [catch {puts $f Test} msg] $msg]
+    close $f
+    string compare [string tolower $x] \
+	[list {two lines: this one} 1 \
+		[format "channel \"%s\" wasn't opened for writing" $f]]
+} 0
+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-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-17.13 {POSIX open access modes: WRONLY} {
+    makeFile xyzzy test3
+    set f [open test3 WRONLY]
+    fconfigure $f -eofchar {}
+    puts -nonewline $f "ab"
+    seek $f 0 current
+    set x [list [catch {gets $f} msg] $msg]
+    close $f
+    lappend x [viewFile test3]
+    string compare [string tolower $x] \
+	[list 1 "channel \"$f\" wasn't opened for reading" abzzy]
+} 0
+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-17.15 {POSIX open access modes: RDWR} {
+    makeFile xyzzy test3
+    set f [open test3 RDWR]
+    puts -nonewline $f "ab"
+    seek $f 0 current
+    set x [gets $f]
+    close $f
+    lappend x [viewFile test3]
+} {zzy abzzy}
+if {![file exists ~/_test_] && [file writable ~]} {
+    test io-17.16 {tilde substitution in open} {
+	set f [open ~/_test_ w]
+	puts $f "Some text"
+	close $f
+	set x [file exists [file join $env(HOME) _test_]]
+	removeFile [file join $env(HOME) _test_]
+	set x
+    } 1
+}
+test io-17.17 {tilde substitution in open} {
+    set home $env(HOME)
+    unset env(HOME)
+    set x [list [catch {open ~/foo} msg] $msg]
+    set env(HOME) $home
+    set x
+} {1 {couldn't find HOME environment variable to expand path}}
+
+test io-18.1 {Tcl_FileeventCmd: errors} {
+    list [catch {fileevent foo} msg] $msg
+} {1 {wrong # args: must be "fileevent channelId event ?script?}}
+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-18.3 {Tcl_FileeventCmd: errors} {
+    list [catch {fileevent gorp readable} msg] $msg
+} {1 {can not find channel named "gorp"}}
+test io-18.4 {Tcl_FileeventCmd: errors} {
+    list [catch {fileevent gorp writable} msg] $msg
+} {1 {can not find channel named "gorp"}}
+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}}
+
+#
+# Test fileevent on a file
+#
+
+set f [open foo w+]
+
+test io-19.1 {Tcl_FileeventCmd: creating, deleting, querying} {
+    list [fileevent $f readable] [fileevent $f writable]
+} {{} {}}
+test io-19.2 {Tcl_FileeventCmd: replacing} {
+    set result {}
+    fileevent $f r "first script"
+    lappend result [fileevent $f readable]
+    fileevent $f r "new script"
+    lappend result [fileevent $f readable]
+    fileevent $f r "yet another"
+    lappend result [fileevent $f readable]
+    fileevent $f r ""
+    lappend result [fileevent $f readable]
+} {{first script} {new script} {yet another} {}}
+
+#
+# Test fileevent on a pipe
+#
+
+if {($tcl_platform(platform) != "macintosh") && \
+	($testConfig(unixExecs) == 1)} {
+
+catch {set f2 [open "|[list cat -u]" r+]}
+catch {set f3 [open "|[list cat -u]" r+]}
+
+test io-20.1 {Tcl_FileeventCmd: creating, deleting, querying} {
+    set result {}
+    fileevent $f readable "script 1"
+    lappend result [fileevent $f readable] [fileevent $f writable]
+    fileevent $f writable "write script"
+    lappend result [fileevent $f readable] [fileevent $f writable]
+    fileevent $f readable {}
+    lappend result [fileevent $f readable] [fileevent $f writable]
+    fileevent $f writable {}
+    lappend result [fileevent $f readable] [fileevent $f writable]
+} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
+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"
+    fileevent $f2 r "read f2"
+    fileevent $f3 r "read f3"
+    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
+    fileevent $f2 r {}
+    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
+    fileevent $f3 r {}
+    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
+    fileevent $f r {}
+    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-21.1 {FileEventProc procedure: normal read event} {
+    fileevent $f2 readable {
+	set x [gets $f2]; fileevent $f2 readable {}
+    }
+    puts $f2 text; flush $f2
+    set x initial
+    vwait x
+    set x
+} {text}
+test io-21.2 {FileEventProc procedure: error in read event} {
+    proc bgerror args {
+	global x
+	set x $args
+    }
+    fileevent $f2 readable {error bogus}
+    puts $f2 text; flush $f2
+    set x initial
+    vwait x
+    rename bgerror {}
+    list $x [fileevent $f2 readable]
+} {bogus {}}
+test io-21.3 {FileEventProc procedure: normal write event} {
+    fileevent $f2 writable {
+	lappend x "triggered"
+	incr count -1
+	if {$count <= 0} {
+	    fileevent $f2 writable {}
+	}
+    }
+    set x initial
+    set count 3
+    vwait x
+    vwait x
+    vwait x
+    set x
+} {initial triggered triggered triggered}
+test io-21.4 {FileEventProc procedure: eror in write event} {
+    proc bgerror args {
+	global x
+	set x $args
+    }
+    fileevent $f2 writable {error bad-write}
+    set x initial
+    vwait x
+    rename bgerror {}
+    list $x [fileevent $f2 writable]
+} {bad-write {}}
+test io-21.5 {FileEventProc procedure: end of file} {unixOrPc} {
+    set f4 [open "|[list $tcltest cat << foo]" r]
+    fileevent $f4 readable {
+	if {[gets $f4 line] < 0} {
+	    lappend x eof
+	    fileevent $f4 readable {}
+	} else {
+	    lappend x $line
+	}
+    }
+    set x initial
+    vwait x
+    vwait x
+    close $f4
+    set x
+} {initial foo eof}
+
+catch {close $f2}
+catch {close $f3}
+
+}
+	# Closes if {($platform(platform) != "macintosh") && \
+	#		($testConfig(unixExecs) == 1)} clause
+
+close $f
+makeFile "foo bar" foo
+test io-22.1 {DeleteFileEvent, cleanup on close} {
+    set f [open foo r]
+    fileevent $f readable {
+	lappend x "binding triggered: \"[gets $f]\""
+	fileevent $f readable {}
+    }
+    close $f
+    set x initial
+    after 100 { set y done }
+    vwait y
+    set x
+} {initial}
+test io-22.2 {DeleteFileEvent, cleanup on close} {
+    set f [open foo r]
+    set f2 [open foo r]
+    fileevent $f readable {
+	    lappend x "f triggered: \"[gets $f]\""
+	    fileevent $f readable {}
+	}
+    fileevent $f2 readable {
+	lappend x "f2 triggered: \"[gets $f2]\""
+	fileevent $f2 readable {}
+    }
+    close $f
+    set x initial
+    vwait x
+    close $f2
+    set x
+} {initial {f2 triggered: "foo bar"}}
+test io-22.3 {DeleteFileEvent, cleanup on close} {
+    set f [open foo r]
+    set f2 [open foo r]
+    set f3 [open foo r]
+    fileevent $f readable {f script}
+    fileevent $f2 readable {f2 script}
+    fileevent $f3 readable {f3 script}
+    set x {}
+    close $f2
+    lappend x [catch {fileevent $f readable} msg] $msg \
+	    [catch {fileevent $f2 readable}] \
+	    [catch {fileevent $f3 readable} msg] $msg
+    close $f3
+    lappend x [catch {fileevent $f readable} msg] $msg \
+	    [catch {fileevent $f2 readable}] \
+	    [catch {fileevent $f3 readable}]
+    close $f
+    lappend x [catch {fileevent $f readable}] \
+	    [catch {fileevent $f2 readable}] \
+	    [catch {fileevent $f3 readable}]
+} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
+
+# Execute these tests only if the "testfevent" command is present.
+
+if {[info commands testfevent] == "testfevent"} {
+
+test io-23.1 {Tcl event loop vs multiple interpreters} {
+    testfevent create
+    testfevent cmd {
+        set f [open foo r]
+        set x "no event"
+        fileevent $f readable {
+            set x "f triggered: [gets $f]"
+            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-23.2 {Tcl event loop vs multiple interpreters} {
+    testfevent create
+    testfevent cmd {
+        set x 0
+        after 100 {set x triggered}
+        vwait x
+        set x
+    }
+} {triggered}
+test io-23.3 {Tcl event loop vs multiple interpreters} {
+    testfevent create
+    testfevent cmd {
+        set x 0
+        after 10 {lappend x timer}
+        after 30
+        set result $x
+        update idletasks
+        lappend result $x
+        update
+        lappend result $x
+    }
+} {0 0 {0 timer}}
+
+test io-24.1 {fileevent vs multiple interpreters} {
+    set f [open foo r]
+    set f2 [open foo r]
+    set f3 [open foo r]
+    fileevent $f readable {script 1}
+    testfevent create
+    testfevent share $f2
+    testfevent cmd "fileevent $f2 readable {script 2}"
+    fileevent $f3 readable {sript 3}
+    set x {}
+    lappend x [fileevent $f2 readable]
+    testfevent delete
+    lappend x [fileevent $f readable] [fileevent $f2 readable] \
+        [fileevent $f3 readable]
+    close $f
+    close $f2
+    close $f3
+    set x
+} {{} {script 1} {} {sript 3}}
+test io-24.2 {deleting fileevent on interpreter delete} {
+    set f [open foo r]
+    set f2 [open foo r]
+    set f3 [open foo r]
+    set f4 [open foo r]
+    fileevent $f readable {script 1}
+    testfevent create
+    testfevent share $f2
+    testfevent share $f3
+    testfevent cmd "fileevent $f2 readable {script 2}
+        fileevent $f3 readable {script 3}"
+    fileevent $f4 readable {script 4}
+    testfevent delete
+    set x [list [fileevent $f readable] [fileevent $f2 readable] \
+                [fileevent $f3 readable] [fileevent $f4 readable]]
+    close $f
+    close $f2
+    close $f3
+    close $f4
+    set x
+} {{script 1} {} {} {script 4}}
+test io-24.3 {deleting fileevent on interpreter delete} {
+    set f [open foo r]
+    set f2 [open foo r]
+    set f3 [open foo r]
+    set f4 [open foo r]
+    testfevent create
+    testfevent share $f3
+    testfevent share $f4
+    fileevent $f readable {script 1}
+    fileevent $f2 readable {script 2}
+    testfevent cmd "fileevent $f3 readable {script 3}
+      fileevent $f4 readable {script 4}"
+    testfevent delete
+    set x [list [fileevent $f readable] [fileevent $f2 readable] \
+                [fileevent $f3 readable] [fileevent $f4 readable]]
+    close $f
+    close $f2
+    close $f3
+    close $f4
+    set x
+} {{script 1} {script 2} {} {}}
+test io-24.4 {file events on shared files and multiple interpreters} {
+    set f [open foo r]
+    set f2 [open foo r]
+    testfevent create
+    testfevent share $f
+    testfevent cmd "fileevent $f readable {script 1}"
+    fileevent $f readable {script 2}
+    fileevent $f2 readable {script 3}
+    set x [list [fileevent $f2 readable] \
+                [testfevent cmd "fileevent $f readable"] \
+                [fileevent $f readable]]
+    testfevent delete
+    close $f
+    close $f2
+    set x
+} {{script 3} {script 1} {script 2}}
+test io-24.5 {file events on shared files, deleting file events} {
+    set f [open foo r]
+    testfevent create
+    testfevent share $f
+    testfevent cmd "fileevent $f readable {script 1}"
+    fileevent $f readable {script 2}
+    testfevent cmd "fileevent $f readable {}"
+    set x [list [testfevent cmd "fileevent $f readable"] \
+                [fileevent $f readable]]
+    testfevent delete
+    close $f
+    set x
+} {{} {script 2}}
+test io-24.6 {file events on shared files, deleting file events} {
+    set f [open foo r]
+    testfevent create
+    testfevent share $f
+    testfevent cmd "fileevent $f readable {script 1}"
+    fileevent $f readable {script 2}
+    fileevent $f readable {}
+    set x [list [testfevent cmd "fileevent $f readable"] \
+                [fileevent $f readable]]
+    testfevent delete
+    close $f
+    set x
+} {{script 1} {}}
+
+}
+
+# The above curly closes the test for presence of the "testfevent" command.
+
+test io-25.1 {testing readability conditions} {
+    set f [open bar w]
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    close $f
+    set f [open bar r]
+    fileevent $f readable [list consume $f]
+    proc consume {f} {
+	global x l
+	lappend l called
+	if {[eof $f]} {
+	    close $f
+	    set x done
+	} else {
+	    gets $f
+	}
+    }
+    set l ""
+    set x not_done
+    vwait x
+    list $x $l
+} {done {called called called called called called called}}
+test io-25.2 {testing readability conditions} {nonBlockFiles} {
+    set f [open bar w]
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    close $f
+    set f [open bar r]
+    fileevent $f readable [list consume $f]
+    fconfigure $f -blocking off
+    proc consume {f} {
+	global x l
+	lappend l called
+	if {[eof $f]} {
+	    close $f
+	    set x done
+	} else {
+	    gets $f
+	}
+    }
+    set l ""
+    set x not_done
+    vwait x
+    list $x $l
+} {done {called called called called called called called}}
+test io-25.3 {testing readability conditions} {unixOnly nonBlockFiles} {
+    set f [open bar w]
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    puts $f abcdefg
+    close $f
+    set f [open my_script w]
+    puts $f {
+	proc copy_slowly {f} {
+	    while {![eof $f]} {
+		puts [gets $f]
+		after 200
+	    }
+	    close $f
+	}
+    }
+    close $f
+    set f [open "|[list $tcltest]" r+]
+    fileevent $f readable [list consume $f]
+    fconfigure $f -buffering line
+    fconfigure $f -blocking off
+    proc consume {f} {
+	global x l
+	if {[eof $f]} {
+	    set x done
+	} else {
+	    gets $f
+	    lappend l [fblocked $f]
+	    gets $f
+	    lappend l [fblocked $f]
+	}
+    }
+    set l ""
+    set x not_done
+    puts $f {source my_script}
+    puts $f {set f [open bar r]}
+    puts $f {copy_slowly $f}
+    puts $f {exit}
+    vwait x
+    close $f
+    list $x $l
+} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
+test io-25.4 {lf write, testing readability, ^Z termination, auto read mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set c [format "abc\ndef\n%c" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+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
+    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+test io-25.6 {cr write, testing readability, ^Z termination, auto read mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    set c [format "abc\ndef\n%c" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+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
+    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+test io-25.8 {crlf write, testing readability, ^Z termination, auto read mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set c [format "abc\ndef\n%c" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -translation auto -eofchar \x1a
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+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
+    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation auto
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+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
+    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation lf
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+test io-25.11 {lf write, testing readability, ^Z termination, lf read mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation lf
+    set c [format "abc\ndef\n%c" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -translation lf -eofchar \x1a
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+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
+    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation cr
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+test io-25.13 {cr write, testing readability, ^Z termination, cr read mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation cr
+    set c [format "abc\ndef\n%c" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -translation cr -eofchar \x1a
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+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
+    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -eofchar \x1a -translation crlf
+    fileevent $f readable [list consume $f]
+    vwait x
+    list $c $l
+} {3 {abc def {}}}
+test io-25.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
+    removeFile test1
+    set f [open test1 w]
+    fconfigure $f -translation crlf
+    set c [format "abc\ndef\n%c" 26]
+    puts -nonewline $f $c
+    close $f
+    proc consume {f} {
+	global c x l
+	if {[eof $f]} {
+	   set x done
+	   close $f
+	} else {
+	   lappend l [gets $f]
+	   incr c
+	}
+    }
+    set c 0
+    set l ""
+    set f [open test1 r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    fileevent $f readable [list consume $f]
+    vwait x
+    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]
+    close $f
+    set f [open test1 r]
+    testchannelevent $f add readable [list delhandler $f]
+    proc delhandler {f} {
+	global z
+	set z called
+	testchannelevent $f delete 0
+    }
+    set z not_called
+    update
+    close $f
+    set z
+} called
+test io-27.2 {testing handler deletion with multiple handlers} {
+    removeFile test1
+    set f [open test1 w]
+    close $f
+    set f [open test1 r]
+    testchannelevent $f add readable [list delhandler $f 1]
+    testchannelevent $f add readable [list delhandler $f 0]
+    proc delhandler {f i} {
+	global z
+	lappend z "called delhandler $f $i"
+	testchannelevent $f delete 0
+    }
+    set z ""
+    update
+    close $f
+    string compare [string tolower $z] \
+	[list [list called delhandler $f 0] [list called delhandler $f 1]]
+} 0
+test io-27.3 {testing handler deletion with multiple handlers} {
+    removeFile test1
+    set f [open test1 w]
+    close $f
+    set f [open test1 r]
+    testchannelevent $f add readable [list notcalled $f 1]
+    testchannelevent $f add readable [list delhandler $f 0]
+    set z ""
+    proc notcalled {f i} {
+	global z
+	lappend z "notcalled was called!! $f $i"
+    }
+    proc delhandler {f i} {
+	global z
+	testchannelevent $f delete 1
+	lappend z "delhandler $f $i called"
+	testchannelevent $f delete 0
+	lappend z "delhandler $f $i deleted myself"
+    }
+    set z ""
+    update
+    close $f
+    string compare [string tolower $z] \
+	[list [list delhandler $f 0 called] \
+	      [list delhandler $f 0 deleted myself]]
+} 0
+test io-27.4 {testing handler deletion vs reentrant calls} {
+    removeFile test1
+    set f [open test1 w]
+    close $f
+    set f [open test1 r]
+    testchannelevent $f add readable [list delrecursive $f]
+    proc delrecursive {f} {
+	global z u
+	if {"$u" == "recursive"} {
+	    testchannelevent $f delete 0
+	    lappend z "delrecursive deleting recursive"
+	} else {
+	    lappend z "delrecursive calling recursive"
+	    set u recursive
+	    update
+	}
+    }
+    set u toplevel
+    set z ""
+    update
+    close $f
+    string compare [string tolower $z] \
+	{{delrecursive calling recursive} {delrecursive deleting recursive}}
+} 0
+test io-27.5 {testing handler deletion vs reentrant calls} {
+    removeFile test1
+    set f [open test1 w]
+    close $f
+    set f [open test1 r]
+    testchannelevent $f add readable [list notcalled $f]
+    testchannelevent $f add readable [list del $f]
+    proc notcalled {f} {
+	global z
+	lappend z "notcalled was called!! $f"
+    }
+    proc del {f} {
+	global z u
+	if {"$u" == "recursive"} {
+	    testchannelevent $f delete 1
+	    testchannelevent $f delete 0
+	    lappend z "del deleted notcalled"
+	    lappend z "del deleted myself"
+	} else {
+	    set u recursive
+	    lappend z "del calling recursive"
+	    update
+	    lappend z "del after update"
+	}
+    }
+    set z ""
+    set u toplevel
+    update
+    close $f
+    string compare [string tolower $z] \
+	[list {del calling recursive} {del deleted notcalled} \
+	      {del deleted myself} {del after update}]
+} 0
+test io-27.6 {testing handler deletion vs reentrant calls} {
+    removeFile test1
+    set f [open test1 w]
+    close $f
+    set f [open test1 r]
+    testchannelevent $f add readable [list second $f]
+    testchannelevent $f add readable [list first $f]
+    proc first {f} {
+	global u z
+	if {"$u" == "toplevel"} {
+	    lappend z "first called"
+	    set u first
+	    update
+	    lappend z "first after update"
+	} else {
+	    lappend z "first called not toplevel"
+	}
+    }
+    proc second {f} {
+	global u z
+	if {"$u" == "first"} {
+	    lappend z "second called, first time"
+	    set u second
+	    testchannelevent $f delete 0
+	} elseif {"$u" == "second"} {
+	    lappend z "second called, second time"
+	    testchannelevent $f delete 0
+	} else {
+	    lappend z "second called, cannot happen!"
+	    testchannelevent $f removeall
+	}
+    }
+    set z ""
+    set u toplevel
+    update
+    close $f
+    string compare [string tolower $z] \
+	[list {first called} {first called not toplevel} \
+	      {second called, first time} {second called, second time} \
+	      {first after update}]
+} 0
+
+test io-28.1 {Test old socket deletion on Macintosh} {socket} {
+    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 [info script]]
+    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 [info script]]
+    set f2 [open test1 w]
+    set f3 [open [info script]]
+    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 [info script]]
+    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 [info script]]
+    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 [info script]]
+    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 [info script]]
+    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 [info script]]
+    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 [info script]]
+    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 [info script]] + 5]]
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    set s1 [file size [info script]]
+    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 [info script]]
+    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 [info script]]
+    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} {stdio} {
+    removeFile test1
+    removeFile pipe
+    set f1 [open pipe w]
+    fconfigure $f1 -translation lf
+    puts $f1 {
+	puts ready
+	gets stdin
+	set f1 [open [info script] r]
+	fconfigure $f1 -translation lf
+	puts [read $f1 100]
+	close $f1
+    }
+    close $f1
+    set f1 [open "|[list $tcltest pipe]" r+]
+    fconfigure $f1 -translation lf
+    gets $f1
+    puts $f1 ready
+    flush $f1
+    set f2 [open test1 w]
+    fconfigure $f2 -translation lf
+    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 [info script]]
+    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 [info script]]
+    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 [info script]]
+    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 "|[list $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 "|[list $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 [info script]]	;# 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		;# The error occurs here in the b.g.
+	}
+	close $in
+	close $out
+	set fcopyTestDone	;# 1 for error condition
+    } 1
+}
+test io-30.6 {CopyData: error during fcopy} {stdio} {
+    removeFile pipe
+    removeFile test1
+    catch {unset fcopyTestDone}
+    set f1 [open pipe w]
+    puts $f1 "exit 1"
+    close $f1
+    set in [open "|[list $tcltest pipe]" r+]
+    set out [open test1 w]
+    fcopy $in $out -command [list FcopyTestDone]
+    if ![info exists fcopyTestDone] {
+	vwait fcopyTestDone
+    }
+    catch {close $in}
+    close $out
+    set fcopyTestDone	;# 0 for plain end of file
+} {0}
+
+test io-31.1 {Recursive channel events} {socket} {
+    # 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} {socket} {
+    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
+test io-32.1 {ChannelEventScriptInvoker: deletion} {
+    proc eventScript {fd} {
+	close $fd
+	error "planned error"
+	set ::x whoops
+    }
+    proc bgerror {args} {
+	set ::x got_error
+    }
+    set f [open fooBar w]
+    fileevent $f writable [list eventScript $f]
+    set x not_done
+    vwait x
+    set x
+} {got_error}
+
+test io-33.1 {ChannelTimerProc} {
+    set f [open fooBar w]
+    puts $f "this is a test"
+    close $f
+    set f [open fooBar r]
+    testchannelevent $f add readable {
+	read $f 1
+	incr x
+    }
+    set x 0
+    vwait x
+    vwait x
+    set result $x
+    testchannelevent $f set 0 none
+    after idle {set y done}
+    vwait y
+    close $f
+    lappend result $y
+} {2 done}
+
+test io-34.1 {buffered data and file events, gets} {
+    proc accept {sock args} {
+	set ::s2 $sock
+    }
+    set server [socket -server accept 4040]
+    set s [socket localhost 4040]
+    vwait s2
+    update
+    fileevent $s2 readable {lappend result readable}
+    puts $s "12\n34567890"
+    flush $s
+    set result [gets $s2]
+    after 1000 {lappend result timer}
+    vwait result
+    lappend result [gets $s2]
+    vwait result
+    close $s
+    close $s2
+    close $server
+    set result
+} {12 readable 34567890 timer}
+test io-34.2 {buffered data and file events, read} {
+    proc accept {sock args} {
+	set ::s2 $sock
+    }
+    set server [socket -server accept 4041]
+    set s [socket localhost 4041]
+    vwait s2
+    update
+    fileevent $s2 readable {lappend result readable}
+    puts -nonewline $s "1234567890"
+    flush $s
+    set result [read $s2 1]
+    after 1000 {lappend result timer}
+    vwait result
+    lappend result [read $s2 9]
+    vwait result
+    close $s
+    close $s2
+    close $server
+    set result
+} {1 readable 234567890 timer}
+        
+test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
+    set out [open script w]
+    puts $out {
+	puts "normal message from pipe"
+	puts stderr "error message from pipe"
+	exit 1
+    }
+    proc readit {pipe} {
+	global x result
+	if {[eof $pipe]} {
+	    set x [catch {close $pipe} line]
+	    lappend result catch $line
+	} else {
+	    gets $pipe line
+	    lappend result gets $line
+	}
+    }
+    close $out
+    set pipe [open "|[list $tcltest] script" r]
+    fileevent $pipe readable [list readit $pipe]
+    set x ""
+    set result ""
+    vwait x
+    list $x $result
+} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
+
+
+removeFile fooBar
+removeFile longfile
+removeFile script
+removeFile output
+removeFile test1
+removeFile pipe
+removeFile my_script
+removeFile foo
+removeFile bar
+removeFile test2
+removeFile test3
+
+file delete cat
+
+set x ""
+unset x
diff --git a/tcl/tests/ioCmd.test b/tcl/tests/ioCmd.test
new file mode 100644
index 00000000000..5d4743ff99a
--- /dev/null
+++ b/tcl/tests/ioCmd.test
@@ -0,0 +1,512 @@
+# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
+#		    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
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+removeFile test1
+removeFile pipe
+
+set executable [list [info nameofexecutable]]
+
+test iocmd-1.1 {puts command} {
+   list [catch {puts} msg] $msg
+} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
+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-1.3 {puts command} {
+   list [catch {puts froboz -nonewline kablooie} msg] $msg
+} {1 {bad argument "kablooie": should be "nonewline"}}
+test iocmd-1.4 {puts command} {
+   list [catch {puts froboz hello} msg] $msg
+} {1 {can not find channel named "froboz"}}
+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-2.1 {flush command} {
+   list [catch {flush} msg] $msg
+} {1 {wrong # args: should be "flush channelId"}}
+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-2.3 {flush command} {
+   list [catch {flush foo} msg] $msg
+} {1 {can not find channel named "foo"}}
+test iocmd-2.4 {flush command} {
+   list [catch {flush stdin} msg] $msg
+} {1 {channel "stdin" wasn't opened for writing}}
+
+test iocmd-3.1 {gets command} {
+   list [catch {gets} msg] $msg
+} {1 {wrong # args: should be "gets channelId ?varName?"}}
+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-3.3 {gets command} {
+   list [catch {gets aaa} msg] $msg
+} {1 {can not find channel named "aaa"}}
+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-4.1 {read command} {
+   list [catch {read} msg] $msg
+} {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
+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-4.3 {read command} {
+   list [catch {read aaa} msg] $msg
+} {1 {can not find channel named "aaa"}}
+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-4.5 {read command} {
+   list [catch {read -nonew file4} msg] $msg $errorCode
+} {1 {can not find channel named "-nonew"} NONE}
+test iocmd-4.6 {read command} {
+   list [catch {read stdout} msg] $msg
+} {1 {channel "stdout" wasn't opened for reading}}
+test iocmd-4.7 {read command} {
+   list [catch {read -nonewline stdout} msg] $msg
+} {1 {channel "stdout" wasn't opened for reading}}
+test iocmd-4.8 {read command with incorrect combination of arguments} {
+    removeFile test1
+    set f [open test1 w]
+    puts $f "Two lines: this one"
+    puts $f "and this one"
+    close $f
+    set f [open test1]
+    set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
+    close $f
+    set x
+} {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"} NONE}
+test iocmd-4.9 {read command} {
+    list [catch {read stdin foo} msg] $msg $errorCode
+} {1 {bad argument "foo": should be "nonewline"} NONE}
+test iocmd-4.10 {read command} {
+    list [catch {read file107} msg] $msg $errorCode
+} {1 {can not find channel named "file107"} NONE}
+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-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-5.1 {seek command} {
+    list [catch {seek} msg] $msg
+} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
+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-5.3 {seek command} {
+    list [catch {seek stdin gugu} msg] $msg
+} {1 {expected integer but got "gugu"}}
+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-6.1 {tell command} {
+    list [catch {tell} msg] $msg
+} {1 {wrong # args: should be "tell channelId"}}
+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-6.3 {tell command} {
+    list [catch {tell aaa} msg] $msg
+} {1 {can not find channel named "aaa"}}
+
+test iocmd-7.1 {close command} {
+    list [catch {close} msg] $msg
+} {1 {wrong # args: should be "close channelId"}}
+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-7.3 {close command} {
+    list [catch {close aaa} msg] $msg
+} {1 {can not find channel named "aaa"}}
+
+test iocmd-8.1 {fconfigure command} {
+    list [catch {fconfigure} msg] $msg
+} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
+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-8.3 {fconfigure command} {
+    list [catch {fconfigure a b} msg] $msg
+} {1 {can not find channel named "a"}}
+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": 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-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-8.7 {fconfigure command} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -eofchar {}
+    set x [fconfigure $f1]
+    close $f1
+    set x
+} {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -translation lf}
+test iocmd-8.8 {fconfigure command} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
+		-eofchar {}
+    set x ""
+    lappend x [fconfigure $f1 -buffering]
+    lappend x [fconfigure $f1]
+    close $f1
+    set x
+} {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -translation lf}}
+test iocmd-8.9 {fconfigure command} {
+    removeFile test1
+    set f1 [open test1 w]
+    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
+		-eofchar {}
+    set x [fconfigure $f1]
+    close $f1
+    set x
+} {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -translation lf}
+test iocmd-8.10 {fconfigure command} {
+    list [catch {fconfigure a b} msg] $msg
+} {1 {can not find channel named "a"}}
+test iocmd-8.11 {fconfigure command} {
+    list [catch {fconfigure stdout -froboz blarfo} msg] $msg
+} {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 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 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} {socket} {
+	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} {socket} {
+	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 [catch {fconfigure $cli -peername} msg]
+	iocmdSSHTDWN
+	regsub -all {can([^:])+: } $r {} r;
+	set r
+} 1
+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 && !win32s} {
+	# None of the com port functions are implemented on Win32s.
+	# Also, 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-9.1 {eof command} {
+    list [catch {eof} msg] $msg $errorCode
+} {1 {wrong # args: should be "eof channelId"} NONE}
+test iocmd-9.2 {eof command} {
+    list [catch {eof a b} msg] $msg $errorCode
+} {1 {wrong # args: should be "eof channelId"} NONE}
+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-10.1 {fblocked command} {
+    list [catch {fblocked} msg] $msg
+} {1 {wrong # args: should be "fblocked channelId"}}
+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-10.3 {fblocked command} {
+    list [catch {fblocked file1000} msg] $msg
+} {1 {can not find channel named "file1000"}}
+test iocmd-10.4 {fblocked command} {
+    list [catch {fblocked stdout} msg] $msg
+} {1 {channel "stdout" wasn't opened for reading}}
+test iocmd-10.5 {fblocked command} {
+    fblocked stdin
+} 0
+
+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-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-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-12.1 {POSIX open access modes: RDONLY} {
+    removeFile test1
+    set f [open test1 w]
+    puts $f "Two lines: this one"
+    puts $f "and this one"
+    close $f
+    set f [open test1 RDONLY]
+    set x [list [gets $f] [catch {puts $f Test} msg] $msg]
+    close $f
+    string compare $x \
+	"{Two lines: this one} 1 [list [format "channel \"%s\" wasn't opened for writing" $f]]"
+} 0
+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-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-12.4 {POSIX open access modes: WRONLY} {unixOnly} {
+    removeFile test3
+    set f [open test3 w]
+    fconfigure $f -eofchar {}
+    puts $f xyzzy
+    close $f
+    set f [open test3 WRONLY]
+    fconfigure $f -eofchar {}
+    puts -nonewline $f "ab"
+    seek $f 0 current
+    set x [list [catch {gets $f} msg] $msg]
+    close $f
+    set f [open test3 r]
+    fconfigure $f -eofchar {}
+    lappend x [gets $f]
+    close $f
+    set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy]
+    string compare $x $y
+} 0
+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-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-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-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-13.1 {errors in open command} {
+    list [catch {open} msg] $msg
+} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
+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-13.3 {errors in open command} {
+    list [catch {open test1 x} msg] $msg
+} {1 {illegal access mode "x"}}
+test iocmd-13.4 {errors in open command} {
+    list [catch {open test1 rw} msg] $msg
+} {1 {illegal access mode "rw"}}
+test iocmd-13.5 {errors in open command} {
+    list [catch {open test1 r+1} msg] $msg
+} {1 {illegal access mode "r+1"}}
+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-14.1 {file id parsing errors} {
+    list [catch {eof gorp} msg] $msg $errorCode
+} {1 {can not find channel named "gorp"} NONE}
+test iocmd-14.2 {file id parsing errors} {
+    list [catch {eof filex} msg] $msg
+} {1 {can not find channel named "filex"}}
+test iocmd-14.3 {file id parsing errors} {
+    list [catch {eof file12a} msg] $msg
+} {1 {can not find channel named "file12a"}}
+test iocmd-14.4 {file id parsing errors} {
+    list [catch {eof file123} msg] $msg
+} {1 {can not find channel named "file123"}}
+test iocmd-14.5 {file id parsing errors} {
+    list [catch {eof stdout} msg] $msg
+} {0 0}
+test iocmd-14.6 {file id parsing errors} {
+    list [catch {eof stdin} msg] $msg
+} {0 0}
+test iocmd-14.7 {file id parsing errors} {
+    list [catch {eof stdout} msg] $msg
+} {0 0}
+test iocmd-14.8 {file id parsing errors} {
+    list [catch {eof stderr} msg] $msg
+} {0 0}
+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 w]
+close $f
+set expect "1 {can not find channel named \"$f\"}"
+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 ""
+set x
diff --git a/tcl/tests/join.test b/tcl/tests/join.test
new file mode 100644
index 00000000000..365421495da
--- /dev/null
+++ b/tcl/tests/join.test
@@ -0,0 +1,48 @@
+# Commands covered:  join
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test join-1.1 {basic join commands} {
+    join {a b c} xyz
+} axyzbxyzc
+test join-1.2 {basic join commands} {
+    join {a b c} {}
+} abc
+test join-1.3 {basic join commands} {
+    join {} xyz
+} {}
+test join-1.4 {basic join commands} {
+    join {12 34 56}
+} {12 34 56}
+
+test join-2.1 {join errors} {
+    list [catch join msg] $msg $errorCode
+} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+test join-2.2 {join errors} {
+    list [catch {join a b c} msg] $msg $errorCode
+} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+test join-2.3 {join errors} {
+    list [catch {join "a \{ c" 111} msg] $msg $errorCode
+} {1 {unmatched open brace in list} NONE}
+
+test join-3.1 {joinString is binary ok} {
+  string length [join {a b c} a\0b]
+} 9
+
+test join-3.2 {join is binary ok} {
+  string length [join "a\0b a\0b a\0b"]
+} 11
+
+
diff --git a/tcl/tests/license.terms b/tcl/tests/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/tests/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/tests/lindex.test b/tcl/tests/lindex.test
new file mode 100644
index 00000000000..6a73b53a7d0
--- /dev/null
+++ b/tcl/tests/lindex.test
@@ -0,0 +1,74 @@
+# Commands covered:  lindex
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test lindex-1.1 {basic tests} {
+    lindex {a b c} 0} a
+test lindex-1.2 {basic tests} {
+    lindex {a {b c d} x} 1} {b c d}
+test lindex-1.3 {basic tests} {
+    lindex {a b\ c\ d x} 1} {b c d}
+test lindex-1.4 {basic tests} {
+    lindex {a b c} 3} {}
+test lindex-1.5 {basic tests} {
+    list [catch {lindex {a b c} -1} msg] $msg
+} {0 {}}
+test lindex-1.6 {basic tests} {
+    lindex {a b c d} end
+} d
+test lindex-1.7 {basic tests} {
+    lindex {a b c d} 100
+} {}
+test lindex-1.8 {basic tests} {
+    lindex {a} e
+} a
+test lindex-1.9 {basic tests} {
+    lindex {} end
+} {}
+test lindex-1.10 {basic tests} {
+    lindex {a b c d} 3
+} d
+
+test lindex-2.1 {error conditions} {
+    list [catch {lindex msg} msg] $msg
+} {1 {wrong # args: should be "lindex list index"}}
+test lindex-2.2 {error conditions} {
+    list [catch {lindex 1 2 3 4} msg] $msg
+} {1 {wrong # args: should be "lindex list index"}}
+test lindex-2.3 {error conditions} {
+    list [catch {lindex 1 2a2} msg] $msg
+} {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}}
+test lindex-2.5 {error conditions} {
+    list [catch {lindex {a {b c}d e} 2} msg] $msg
+} {1 {list element in braces followed by "d" instead of space}}
+test lindex-2.6 {error conditions} {
+    list [catch {lindex {a "b c"def ghi} 2} msg] $msg
+} {1 {list element in quotes followed by "def" instead of space}}
+
+test lindex-3.1 {quoted elements} {
+    lindex {a "b c" d} 1
+} {b c}
+test lindex-3.2 {quoted elements} {
+    lindex {"{}" b c} 0
+} {{}}
+test lindex-3.3 {quoted elements} {
+    lindex {ab "c d \" x" y} 1
+} {c d " x}
+test lindex-3.4 {quoted elements} {
+    lindex {a b {c d "e} {f g"}} 2
+} {c d "e}
diff --git a/tcl/tests/link.test b/tcl/tests/link.test
new file mode 100644
index 00000000000..5a878952f5e
--- /dev/null
+++ b/tcl/tests/link.test
@@ -0,0 +1,234 @@
+# Commands covered:  none
+#
+# This file contains a collection of tests for Tcl_LinkVar and related
+# library procedures.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[info commands testlink] == {}} {
+    puts "This application hasn't been compiled with the \"testlink\""
+    puts "command, so I can't test Tcl_LinkVar et al."
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+foreach i {int real bool string} {
+    catch {unset $i}
+}
+test link-1.1 {reading C variables from Tcl} {
+    testlink delete
+    testlink set 43 1.23 4 -
+    testlink create 1 1 1 1
+    list $int $real $bool $string
+} {43 1.23 1 NULL}
+test link-1.2 {reading C variables from Tcl} {
+    testlink delete
+    testlink create 1 1 1 1
+    testlink set -3 2 0 "A long string with spaces"
+    list $int $real $bool $string $int $real $bool $string
+} {-3 2.0 0 {A long string with spaces} -3 2.0 0 {A long string with spaces}}
+
+test link-2.1 {writing C variables from Tcl} {
+    testlink delete
+    testlink set 43 1.21 4 -
+    testlink create 1 1 1 1
+    set int "00721"
+    set real -10.5
+    set bool true
+    set string abcdef
+    concat [testlink get] $int $real $bool $string
+} {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 -
+    testlink create 1 1 1 1
+    list [catch {set int 09a} msg] $msg $int
+} {1 {can't set "int": variable must have integer value} 43}
+test link-2.3 {writing bad values into variables} {
+    testlink delete
+    testlink set 43 1.23 4 -
+    testlink create 1 1 1 1
+    list [catch {set real 1.x3} msg] $msg $real
+} {1 {can't set "real": variable must have real value} 1.23}
+test link-2.4 {writing bad values into variables} {
+    testlink delete
+    testlink set 43 1.23 4 -
+    testlink create 1 1 1 1
+    list [catch {set bool gorp} msg] $msg $bool
+} {1 {can't set "bool": variable must have boolean value} 1}
+
+test link-3.1 {read-only variables} {
+    testlink delete
+    testlink set 43 1.23 4 -
+    testlink create 0 1 1 0
+    list [catch {set int 4} msg] $msg $int \
+	[catch {set real 10.6} msg] $msg $real \
+	[catch {set bool no} msg] $msg $bool \
+	[catch {set string "new value"} msg] $msg $string
+} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL}
+test link-3.2 {read-only variables} {
+    testlink delete
+    testlink set 43 1.23 4 -
+    testlink create 1 0 0 1
+    list [catch {set int 4} msg] $msg $int \
+	[catch {set real 10.6} msg] $msg $real \
+	[catch {set bool no} msg] $msg $bool \
+	[catch {set string "new value"} msg] $msg $string
+} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value}}
+
+test link-4.1 {unsetting linked variables} {
+    testlink delete
+    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.5 0 0 0 stringValue}
+test link-4.2 {unsetting linked variables} {
+    testlink delete
+    testlink set -6 -2.1 0 stringValue
+    testlink create 1 1 1 1
+    unset int real bool string
+    set int 102
+    set real 16
+    set bool true
+    set string newValue
+    testlink get
+} {102 16.0 1 newValue}
+
+test link-5.1 {unlinking variables} {
+    testlink delete
+    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.25 0 stringValue}
+test link-5.2 {unlinking variables} {
+    testlink delete
+    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.25 0 stringValue}
+
+test link-6.1 {errors in setting up link} {
+    testlink delete
+    catch {unset int}
+    set int(44) 1
+    list [catch {testlink create 1 1 1 1} msg] $msg
+} {1 {can't set "int": variable is array}}
+catch {unset int}
+
+test link-7.1 {access to linked variables via upvar} {
+    proc x {} {
+	upvar int y
+	unset y
+    }
+    testlink delete
+    testlink create 1 0 0 0
+    testlink set 14 {} {} {}
+    x
+    list [catch {set int} msg] $msg
+} {0 14}
+test link-7.2 {access to linked variables via upvar} {
+    proc x {} {
+	upvar int y
+	return [set y]
+    }
+    testlink delete
+    testlink create 1 0 0 0
+    testlink set 0 {} {} {}
+    set int
+    testlink set 23 {} {} {}
+    x
+    list [x] $int
+} {23 23}
+test link-7.3 {access to linked variables via upvar} {
+    proc x {} {
+	upvar int y
+	set y 44
+    }
+    testlink delete
+    testlink create 0 0 0 0
+    testlink set 11 {} {} {}
+    list [catch x msg] $msg $int
+} {1 {can't set "y": linked variable is read-only} 11}
+test link-7.4 {access to linked variables via upvar} {
+    proc x {} {
+	upvar int y
+	set y abc
+    }
+    testlink delete
+    testlink create 1 1 1 1
+    testlink set -4 {} {} {}
+    list [catch x msg] $msg $int
+} {1 {can't set "y": variable must have integer value} -4}
+test link-7.5 {access to linked variables via upvar} {
+    proc x {} {
+	upvar real y
+	set y abc
+    }
+    testlink delete
+    testlink create 1 1 1 1
+    testlink set -4 16.75 {} {}
+    list [catch x msg] $msg $real
+} {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
+	set y abc
+    }
+    testlink delete
+    testlink create 1 1 1 1
+    testlink set -4 16.3 1 {}
+    list [catch x msg] $msg $bool
+} {1 {can't set "y": variable must have boolean value} 1}
+
+test link-8.1 {Tcl_UpdateLinkedVar procedure} {
+    proc x args {
+	global x int real bool string
+	lappend x $args $int $real $bool $string
+    }
+    set x {}
+    testlink create 1 1 1 1
+    testlink set 14 -2.0 0 xyzzy
+    trace var int w x
+    testlink update 32 4.0 3 abcd
+    trace vdelete int w x
+    set x
+} {{int {} w} 32 -2.0 0 xyzzy}
+test link-8.2 {Tcl_UpdateLinkedVar procedure} {
+    proc x args {
+	global x int real bool string
+	lappend x $args $int $real $bool $string
+    }
+    set x {}
+    testlink create 1 1 1 1
+    testlink set 14 -2.0 0 xyzzy
+    testlink delete
+    trace var int w x
+    testlink update 32 4.0 6 abcd
+    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} {
+    catch {unset $i}
+}
diff --git a/tcl/tests/linsert.test b/tcl/tests/linsert.test
new file mode 100644
index 00000000000..2f5bde55f08
--- /dev/null
+++ b/tcl/tests/linsert.test
@@ -0,0 +1,105 @@
+# Commands covered:  linsert
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset lis}
+catch {rename p ""}
+
+test linsert-1.1 {linsert command} {
+    linsert {1 2 3 4 5} 0 a
+} {a 1 2 3 4 5}
+test linsert-1.2 {linsert command} {
+    linsert {1 2 3 4 5} 1 a
+} {1 a 2 3 4 5}
+test linsert-1.3 {linsert command} {
+    linsert {1 2 3 4 5} 2 a
+} {1 2 a 3 4 5}
+test linsert-1.4 {linsert command} {
+    linsert {1 2 3 4 5} 3 a
+} {1 2 3 a 4 5}
+test linsert-1.5 {linsert command} {
+    linsert {1 2 3 4 5} 4 a
+} {1 2 3 4 a 5}
+test linsert-1.6 {linsert command} {
+    linsert {1 2 3 4 5} 5 a
+} {1 2 3 4 5 a}
+test linsert-1.7 {linsert command} {
+    linsert {1 2 3 4 5} 2 one two \{three \$four
+} {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}}
+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}}
+test linsert-1.10 {linsert command} {
+    linsert {} 2 a b c
+} {a b c}
+test linsert-1.11 {linsert command} {
+    linsert {} 2 {}
+} {{}}
+test linsert-1.12 {linsert command} {
+    linsert {a b "c c" d e} 3 1
+} {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}
+test linsert-1.14 {linsert command} {
+    linsert {a b c {d e f}} 4 1 2
+} {a b c {d e f} 1 2}
+test linsert-1.15 {linsert command} {
+    linsert {a b c \{\  abc} 4 q r
+} {a b c \{\  q r abc}
+test linsert-1.16 {linsert command} {
+    linsert {a b c \{ abc} 4 q r
+} {a b c \{ q r abc}
+test linsert-1.17 {linsert command} {
+    linsert {a b c} end q r
+} {a b c q r}
+test linsert-1.18 {linsert command} {
+    linsert {a} end q r
+} {a q r}
+test linsert-1.19 {linsert command} {
+    linsert {} end q r
+} {q r}
+
+test linsert-2.1 {linsert errors} {
+    list [catch linsert msg] $msg
+} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
+test linsert-2.2 {linsert errors} {
+    list [catch {linsert a b} msg] $msg
+} {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 {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"
+test linsert-3.2 {linsert won't modify shared argument objects} {
+    catch {unset lis}
+    set lis [format "a \"%s\" c" "b"]
+    linsert $lis 0 [string length $lis]
+} "7 a b c"
+
+catch {unset lis}
+catch {rename p ""}
diff --git a/tcl/tests/list.test b/tcl/tests/list.test
new file mode 100644
index 00000000000..14be313e2aa
--- /dev/null
+++ b/tcl/tests/list.test
@@ -0,0 +1,107 @@
+# Commands covered:  list
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# First, a bunch of individual tests
+
+test list-1.1 {basic tests} {list a b c} {a b c}
+test list-1.2 {basic tests} {list {a b} c} {{a b} c}
+test list-1.3 {basic tests} {list \{a b c} {\{a b c}
+test list-1.4 {basic tests} "list a{}} b{} c}" "a\\{\\}\\} b{} c\\}"
+test list-1.5 {basic tests} {list a\[ b\] } "{a\[} b\\]"
+test list-1.6 {basic tests} {list c\  d\t } "{c } {d\t}"
+test list-1.7 {basic tests} {list e\n f\$ } "{e\n} {f\$}"
+test list-1.8 {basic tests} {list g\; h\\} {{g;} h\\}
+test list-1.9 {basic tests} "list a\\\[} b\\\]} " "a\\\[\\\} b\\\]\\\}"
+test list-1.10 {basic tests} "list c\\\} d\\t} " "c\\} d\\t\\}"
+test list-1.11 {basic tests} "list e\\n} f\\$} " "e\\n\\} f\\$\\}"
+test list-1.12 {basic tests} "list g\\;} h\\\\} " "g\\;\\} {h\\}}"
+test list-1.13 {basic tests} {list a {{}} b} {a {{}} b}
+test list-1.14 {basic tests} {list a b xy\\} "a b xy\\\\"
+test list-1.15 {basic tests} "list a b\} e\\" "a b\\} e\\\\"
+test list-1.16 {basic tests} "list a b\}\\\$ e\\\$\\" "a b\\}\\\$ e\\\$\\\\"
+test list-1.17 {basic tests} {list a\f \{\f} "{a\f} \\\{\\f"
+test list-1.18 {basic tests} {list a\r \{\r} "{a\r} \\\{\\r"
+test list-1.19 {basic tests} {list a\v \{\v} "{a\v} \\\{\\v"
+test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{"
+test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"
+test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\
+test list-1.23 {basic tests} {list \{} "\\{"
+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
+    set num [expr $num+1]
+;   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
+    set num [expr $num+1]
+}
+lcheck a b c
+lcheck "a b" c\td e\nf
+lcheck {{a b}} {} {  }
+lcheck \$ \$ab ab\$
+lcheck \; \;ab ab\;
+lcheck \[ \[ab ab\[
+lcheck \\ \\ab ab\\
+lcheck {"} {"ab} {ab"}
+lcheck {a b} { ab} {ab }
+lcheck a{ a{b \{ab
+lcheck a} a}b }ab
+lcheck a\\} {a \}b} {a \{c}
+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/tcl/tests/listObj.test b/tcl/tests/listObj.test
new file mode 100644
index 00000000000..3e6a091e924
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/llength.test b/tcl/tests/llength.test
new file mode 100644
index 00000000000..5e8a0a3b04a
--- /dev/null
+++ b/tcl/tests/llength.test
@@ -0,0 +1,35 @@
+# Commands covered:  llength
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test llength-1.1 {length of list} {
+    llength {a b c d}
+} 4
+test llength-1.2 {length of list} {
+    llength {a b c {a b {c d}} d}
+} 5
+test llength-1.3 {length of list} {
+    llength {}
+} 0
+
+test llength-2.1 {error conditions} {
+    list [catch {llength} msg] $msg
+} {1 {wrong # args: should be "llength list"}}
+test llength-2.2 {error conditions} {
+    list [catch {llength 123 2} msg] $msg
+} {1 {wrong # args: should be "llength list"}}
+test llength-2.3 {error conditions} {
+    list [catch {llength "a b c \{"} msg] $msg
+} {1 {unmatched open brace in list}}
diff --git a/tcl/tests/load.test b/tcl/tests/load.test
new file mode 100644
index 00000000000..25a1c960d6a
--- /dev/null
+++ b/tcl/tests/load.test
@@ -0,0 +1,160 @@
+# Commands covered:  load
+#
+# 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 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Figure out what extension is used for shared libraries on this
+# platform.
+
+if {$tcl_platform(platform) == "macintosh"} {
+    puts "can't run dynamic library tests on macintosh machines"
+    return
+}
+set ext [info sharedlibextension]
+set testDir [file join [file dirname [info nameofexecutable]] dltest]
+if ![file readable [file join $testDir pkga$ext]] {
+    puts "libraries in $testDir haven't been compiled: skipping tests"
+    return
+}
+
+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?"}}
+test load-1.2 {basic errors} {
+    list [catch {load a b c d} msg] $msg
+} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
+test load-1.3 {basic errors} {
+    list [catch {load a b foobar} msg] $msg
+} {1 {couldn't find slave interpreter named "foobar"}}
+test load-1.4 {basic errors} {
+    list [catch {load {}} msg] $msg
+} {1 {must specify either file name or package name}}
+test load-1.5 {basic errors} {
+    list [catch {load {} {}} msg] $msg
+} {1 {must specify either file name or package name}}
+test load-1.6 {basic errors} {
+    list [catch {load {} Unknown} msg] $msg
+} {1 {package "Unknown" isn't loaded statically}}
+
+test load-2.1 {basic loading, with guess for package name} {
+    load [file join $testDir pkga$ext]
+    list [pkga_eq abc def] [info commands pkga_*]
+} {0 {pkga_eq pkga_quote}}
+interp create -safe child
+test load-2.2 {loading into a safe interpreter, with package name conversion} {
+    load [file join $testDir pkgb$ext] pKgB child
+    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
+	    [catch {pkgb_sub 12 10} msg2] $msg2
+} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
+test load-2.3 {loading with no _Init procedure} {
+    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
+} {1 {couldn't find procedure Foo_Init}}
+test load-2.4 {loading with no _SafeInit procedure} {
+    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
+} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
+
+test load-3.1 {error in _Init procedure, same interpreter} {
+    list [catch {load [file join $testDir pkge$ext] pkge} msg] $msg $errorInfo $errorCode
+} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
+    while executing
+"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}
+    interp create x
+    set errorCode foo
+    set errorInfo bar
+    set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
+	    $msg $errorInfo $errorCode]
+    interp delete x
+    set result
+} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
+    while executing
+"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} {
+    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
+} {0 {}}
+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-6.1 {errors loading file} {nonPortable} {
+    catch {load foo foo}
+} {1}
+
+if {[info command teststaticpkg] != ""} {
+    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-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-7.3 {Tcl_StaticPackage procedure} {
+	set x "not loaded"
+	teststaticpkg More 0 1
+	load {} More
+	set x
+    } {not loaded}
+    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
+    } "{{} 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-8.3 {TclGetLoadedPackages procedure} {
+	list [info loaded {}] [info loaded child]
+    } "{{{} 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} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
+    interp delete child
+}
diff --git a/tcl/tests/lrange.test b/tcl/tests/lrange.test
new file mode 100644
index 00000000000..84f08583417
--- /dev/null
+++ b/tcl/tests/lrange.test
@@ -0,0 +1,83 @@
+# Commands covered:  lrange
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test lrange-1.1 {range of list elements} {
+    lrange {a b c d} 1 2
+} {b c}
+test lrange-1.2 {range of list elements} {
+    lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
+} {{bcd e {f g {}}}}
+test lrange-1.3 {range of list elements} {
+    lrange {a {bcd e {f g {}}} l14 l15 d} 3 end
+} {l15 d}
+test lrange-1.4 {range of list elements} {
+    lrange {a {bcd e {f g {}}} l14 l15 d} 4 10000
+} {d}
+test lrange-1.5 {range of list elements} {
+    lrange {a {bcd e {f g {}}} l14 l15 d} 4 3
+} {}
+test lrange-1.6 {range of list elements} {
+    lrange {a {bcd e {f g {}}} l14 l15 d} 10 11
+} {}
+test lrange-1.7 {range of list elements} {
+    lrange {a b c d e} -1 2
+} {a b c}
+test lrange-1.8 {range of list elements} {
+    lrange {a b c d e} -2 -1
+} {}
+test lrange-1.9 {range of list elements} {
+    lrange {a b c d e} -2 e
+} {a b c d e}
+test lrange-1.10 {range of list elements} {
+    lrange "a b\{c d" 1 2
+} "b\\{c d"
+test lrange-1.11 {range of list elements} {
+    lrange "a b c d" end end
+} d
+test lrange-1.12 {range of list elements} {
+    lrange "a b c d" end 100000
+} d
+test lrange-1.13 {range of list elements} {
+    lrange "a b c d" e 3
+} d
+test lrange-1.14 {range of list elements} {
+    lrange "a b c d" end 2
+} {}
+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
+} {1 {wrong # args: should be "lrange list first last"}}
+test lrange-2.2 {error conditions} {
+    list [catch {lrange a b 6 7} msg] $msg
+} {1 {wrong # args: should be "lrange list first last"}}
+test lrange-2.3 {error conditions} {
+    list [catch {lrange a b 6} msg] $msg
+} {1 {bad index "b": must be integer or "end"}}
+test lrange-2.4 {error conditions} {
+    list [catch {lrange a 0 enigma} msg] $msg
+} {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}}
+test lrange-2.6 {error conditions} {
+    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
+} {1 {unmatched open brace in list}}
diff --git a/tcl/tests/lreplace.test b/tcl/tests/lreplace.test
new file mode 100644
index 00000000000..23098878741
--- /dev/null
+++ b/tcl/tests/lreplace.test
@@ -0,0 +1,131 @@
+# Commands covered:  lreplace
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test lreplace-1.1 {lreplace command} {
+    lreplace {1 2 3 4 5} 0 0 a
+} {a 2 3 4 5}
+test lreplace-1.2 {lreplace command} {
+    lreplace {1 2 3 4 5} 1 1 a
+} {1 a 3 4 5}
+test lreplace-1.3 {lreplace command} {
+    lreplace {1 2 3 4 5} 2 2 a
+} {1 2 a 4 5}
+test lreplace-1.4 {lreplace command} {
+    lreplace {1 2 3 4 5} 3 3 a
+} {1 2 3 a 5}
+test lreplace-1.5 {lreplace command} {
+    lreplace {1 2 3 4 5} 4 4 a
+} {1 2 3 4 a}
+test lreplace-1.6 {lreplace command} {
+    lreplace {1 2 3 4 5} 4 5 a
+} {1 2 3 4 a}
+test lreplace-1.7 {lreplace command} {
+    lreplace {1 2 3 4 5} -1 -1 a
+} {a 1 2 3 4 5}
+test lreplace-1.8 {lreplace command} {
+    lreplace {1 2 3 4 5} 2 end a b c d
+} {1 2 a b c d}
+test lreplace-1.9 {lreplace command} {
+    lreplace {1 2 3 4 5} 0 3
+} {5}
+test lreplace-1.10 {lreplace command} {
+    lreplace {1 2 3 4 5} 0 4
+} {}
+test lreplace-1.11 {lreplace command} {
+    lreplace {1 2 3 4 5} 0 1
+} {3 4 5}
+test lreplace-1.12 {lreplace command} {
+    lreplace {1 2 3 4 5} 2 3
+} {1 2 5}
+test lreplace-1.13 {lreplace command} {
+    lreplace {1 2 3 4 5} 3 end
+} {1 2 3}
+test lreplace-1.14 {lreplace command} {
+    lreplace {1 2 3 4 5} -1 4 a b c
+} {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}
+test lreplace-1.16 {lreplace command} {
+    lreplace { 1 2 3 4 5} 0 0 a
+} {a 2 3 4 5}
+test lreplace-1.17 {lreplace command} {
+    lreplace {1 2 3 4 "5 6"} 4 4 a
+} {1 2 3 4 a}
+test lreplace-1.18 {lreplace command} {
+    lreplace {1 2 3 4 {5 6}} 4 4 a
+} {1 2 3 4 a}
+test lreplace-1.19 {lreplace command} {
+    lreplace {1 2 3 4} 2 end x y z
+} {1 2 x y z}
+test lreplace-1.20 {lreplace command} {
+    lreplace {1 2 3 4} end end a
+} {1 2 3 a}
+test lreplace-1.21 {lreplace command} {
+    lreplace {1 2 3 4} end 3 a
+} {1 2 3 a}
+test lreplace-1.22 {lreplace command} {
+    lreplace {1 2 3 4} end end
+} {1 2 3}
+test lreplace-1.23 {lreplace command} {
+    lreplace {1 2 3 4} 2 -1 xy
+} {1 2 xy 3 4}
+test lreplace-1.24 {lreplace command} {
+    lreplace {1 2 3 4} end -1 z
+} {1 2 3 z 4}
+test lreplace-1.25 {lreplace command} {
+    concat \"[lreplace {\}\     hello} end end]\"
+} {"\}\ "}
+test lreplace-1.26 {lreplace command} {
+    catch {unset foo}
+    set foo {a b}
+    list [set foo [lreplace $foo end end]] \
+        [set foo [lreplace $foo end end]] \
+        [set foo [lreplace $foo end end]]
+} {a {} {}}
+
+
+test lreplace-2.1 {lreplace errors} {
+    list [catch lreplace msg] $msg
+} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+test lreplace-2.2 {lreplace errors} {
+    list [catch {lreplace a b} msg] $msg
+} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+test lreplace-2.3 {lreplace errors} {
+    list [catch {lreplace x a 10} msg] $msg
+} {1 {bad index "a": must be integer or "end"}}
+test lreplace-2.4 {lreplace errors} {
+    list [catch {lreplace x 10 x} msg] $msg
+} {1 {bad index "x": must be integer or "end"}}
+test lreplace-2.5 {lreplace errors} {
+    list [catch {lreplace x 10 1x} msg] $msg
+} {1 {bad index "1x": must be integer or "end"}}
+test lreplace-2.6 {lreplace errors} {
+    list [catch {lreplace x 3 2} msg] $msg
+} {1 {list doesn't contain element 3}}
+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"
+
+catch {unset foo}
diff --git a/tcl/tests/lsearch.test b/tcl/tests/lsearch.test
new file mode 100644
index 00000000000..4d10d3894ee
--- /dev/null
+++ b/tcl/tests/lsearch.test
@@ -0,0 +1,86 @@
+# Commands covered:  lsearch
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+set x {abcd bbcd 123 234 345}
+test lsearch-1.1 {lsearch command} {
+    lsearch $x 123
+} 2
+test lsearch-1.2 {lsearch command} {
+    lsearch $x 3456
+} -1
+test lsearch-1.3 {lsearch command} {
+    lsearch $x *5
+} 4
+test lsearch-1.4 {lsearch command} {
+    lsearch $x *bc*
+} 0
+
+test lsearch-2.1 {search modes} {
+    lsearch -exact {xyz bbcc *bc*} *bc*
+} 2
+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.7 {search modes} {
+    lsearch -regexp {b.x ^bc xy bcx} ^bc
+} 3
+test lsearch-2.8 {search modes} {
+    lsearch -glob {xyz bbcc *bc*} *bc*
+} 1
+test lsearch-2.9 {search modes} {
+    lsearch -glob {b.x ^bc xy bcx} ^bc
+} 1
+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, -regexp, -dictionary, or -nocase}}
+
+test lsearch-3.1 {lsearch errors} {
+    list [catch lsearch msg] $msg
+} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
+test lsearch-3.2 {lsearch errors} {
+    list [catch {lsearch a} msg] $msg
+} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
+test lsearch-3.3 {lsearch errors} {
+    list [catch {lsearch a b c} msg] $msg
+} {1 {bad search mode "a": must be -exact, -glob, -regexp, -dictionary, or -nocase}}
+test lsearch-3.4 {lsearch errors} {
+    list [catch {lsearch a b c d} msg] $msg
+} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
+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/tcl/tests/macFCmd.test b/tcl/tests/macFCmd.test
new file mode 100644
index 00000000000..89e50cdcdca
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+#
+
+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/tcl/tests/misc.test b/tcl/tests/misc.test
new file mode 100644
index 00000000000..a18f3940b81
--- /dev/null
+++ b/tcl/tests/misc.test
@@ -0,0 +1,51 @@
+# Commands covered:  various
+#
+# This file contains a collection of miscellaneous Tcl tests that
+# don't fit naturally in any of the other test files.  Many of these
+# tests are pathological cases that caused bugs in earlier Tcl
+# releases.
+#
+# Copyright (c) 1992-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test misc-1.1 {error in variable ref. in command in array reference} {
+    proc tstProc {} {
+	global a
+    
+	set tst $a([winfo name $zz])
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+    }
+    set msg {}
+    list [catch tstProc msg] $msg
+} {1 {can't read "zz": no such variable}}
+test misc-1.2 {error in variable ref. in command in array reference} {
+    proc tstProc {} "
+	global a
+    
+	set tst \$a(\[winfo name \$\{zz)
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+	# this is a bogus comment
+    "
+    set msg {}
+    list [catch tstProc msg] $msg $errorInfo
+} {1 {missing close-bracket or close-brace} missing\ close-bracket\ or\ close-brace\n\ \ \ \ while\ compiling\n\"set\ tst\ \$a(\[winfo\ name\ \$\{zz)\"\n\ \ \ \ (compiling\ body\ of\ proc\ \"tstProc\",\ line\ 4)\n\ \ \ \ invoked\ from\ within\n\"tstProc\"}
diff --git a/tcl/tests/namespace-old.test b/tcl/tests/namespace-old.test
new file mode 100644
index 00000000000..5a4b1124968
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/namespace.test b/tcl/tests/namespace.test
new file mode 100644
index 00000000000..bc8fc18e1b5
--- /dev/null
+++ b/tcl/tests/namespace.test
@@ -0,0 +1,1097 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 :: test_ns_*
+} {}
+
+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, trailing ::s in ns name are ignored} {
+    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
+} {0 ::test_ns_7}
+test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1:: {
+        namespace eval test_ns_2:: {}
+        namespace eval test_ns_3:: {}
+    }
+    namespace children ::test_ns_1
+} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}
+test namespace-6.5 {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-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+    }
+    namespace eval test_ns_import {
+        namespace import -force ::test_ns_export::*
+    }
+    list [test_ns_import::cmd1 a b c] \
+         [test_ns_export::cmd1 d e f] \
+         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
+         [namespace origin test_ns_import::cmd1] \
+         [namespace origin test_ns_export::cmd1] \
+         [test_ns_import::cmd1 g h i] \
+         [test_ns_export::cmd1 j k l]
+} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
+
+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 :: test_ns_*]
+    }
+} {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, extra ::s are significant for vars} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        variable {}
+        set test_ns_1::(x) y
+    }
+    set test_ns_1::(x)
+} y
+test namespace-14.13 {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 "": only global namespace can have empty 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 option "wombat": must 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_ns_*
+} {}
+
+test namespace-21.1 {NamespaceChildrenCmd, no args} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+    expr {[string first ::test_ns_1 [namespace children]] != -1}
+} {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 option "test_ns_1": must 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/tcl/tests/obj.test b/tcl/tests/obj.test
new file mode 100644
index 00000000000..8ea4ff1c0a3
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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 [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 [testdoubleobj set 1 3.1459]
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 3.1459 double 2}
+
+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 [testdoubleobj set 1 27.56]  ;# makes existing obj double
+    lappend result [testobj type 1]
+    lappend result [testobj refcount 1]
+} {{} 98765 27.56 double 2}
+
+test obj-16.1 {Tcl_GetDoubleFromObj, existing double object} {
+    set result ""
+    lappend result [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 [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 [testdoubleobj set 1 17.1]
+    lappend result [testobj duplicate 1 2]      ;# uses DupDoubleInternalRep
+    lappend result [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 [testdoubleobj set 1 3.14159]
+    lappend result [testdoubleobj mult10 1]
+    lappend result [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 123456789012345678901]
+    lappend result [catch {testintobj mult10 1} msg]
+    lappend result $msg
+} {123456789012345678901 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/tcl/tests/opt.test b/tcl/tests/opt.test
new file mode 100644
index 00000000000..67e95cf7af6
--- /dev/null
+++ b/tcl/tests/opt.test
@@ -0,0 +1,277 @@
+# Package covered:  opt0.1/optparse.tcl
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# the package we are going to test
+package require opt 0.1
+
+# we are using implementation specifics to test the package
+
+
+#### functions tests #####
+
+set n $::tcl::OptDescN
+
+test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
+    list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr $n+1]] [::tcl::OptKeyRegister {}]
+} "$n [expr $n+1] [expr $n+2]"
+
+test opt-2.1 {OptKeyDelete} {
+    list [::tcl::OptKeyRegister {} testkey] [::tcl::OptKeyDelete testkey] \
+	    [catch {::tcl::OptKeyDelete testkey} msg] $msg;
+} {testkey {} 1 {can't unset "OptDesc(testkey)": no such element in array}}
+
+
+test opt-3.1 {OptParse / temp key is removed} {
+    set n $::tcl::OptDescN
+    set prev [array names ::tcl::OptDesc]
+    ::tcl::OptKeyRegister {} $n
+    list [info exists ::tcl::OptDesc($n)]\
+	    [::tcl::OptKeyDelete $n]\
+	    [::tcl::OptParse {{-foo}} {}]\
+	    [info exists ::tcl::OptDesc($n)]\
+	    [expr {"[lsort $prev]"=="[lsort [array names ::tcl::OptDesc]]"}]
+} {1 {} {} 0 1}
+
+
+test opt-3.2 {OptParse / temp key is removed even on errors} {
+    set n $::tcl::OptDescN
+    catch {::tcl::OptKeyDelete $n}
+    list [catch {::tcl::OptParse {{-foo}} {-blah}}] \
+	    [info exists ::tcl::OptDesc($n)]
+} {1 0}
+
+test opt-4.1 {OptProc} {
+    ::tcl::OptProc optTest {} {}
+    optTest ;
+    ::tcl::OptKeyDelete optTest
+} {}
+
+
+test opt-5.1 {OptProcArgGiven} {
+    ::tcl::OptProc optTest {{-foo}} {
+	if {[::tcl::OptProcArgGiven "-foo"]} {
+	    return 1
+	} else {
+	    return 0
+	}
+    }
+    list [optTest] [optTest -f] [optTest -F] [optTest -fOO]
+} {0 1 1 1}
+
+test opt-6.1 {OptKeyParse} {
+    ::tcl::OptKeyRegister {} test;
+    list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
+} {1 {Usage information:
+    Var/FlagName Type Value Help
+    ------------ ---- ----- ----
+    ( -help                 gives this help )}}
+
+
+test opt-7.1 {OptCheckType} {
+    list \
+	    [::tcl::OptCheckType 23 int] \
+	    [::tcl::OptCheckType 23 float] \
+	    [::tcl::OptCheckType true boolean] \
+	    [::tcl::OptCheckType "-blah" any] \
+	    [::tcl::OptCheckType {a b c} list] \
+	    [::tcl::OptCheckType maYbe choice {yes maYbe no}] \
+	    [catch {::tcl::OptCheckType "-blah" string}] \
+	    [catch {::tcl::OptCheckType 6 boolean}] \
+	    [catch {::tcl::OptCheckType x float}] \
+	    [catch {::tcl::OptCheckType "a \{ c" list}] \
+	    [catch {::tcl::OptCheckType 2.3 int}] \
+	    [catch {::tcl::OptCheckType foo choice {x y Foo z}}]
+} {23 23.0 1 -blah {a b c} maYbe 1 1 1 1 1 1}
+
+
+test opt-8.1 {List utilities} {
+    ::tcl::Lempty {}
+} 1
+test opt-8.2 {List utilities} {
+    ::tcl::Lempty {a b c}
+} 0
+test opt-8.3 {List utilities} {
+    ::tcl::Lget {a {b c d} e} {1 2}
+} d
+
+test opt-8.4 {List utilities} {
+    set l {a {b c d e} f}
+    ::tcl::Lvarset l {1 2} D
+    set l
+} {a {b c D e} f}
+
+test opt-8.5 {List utilities} {
+    set l {a b c}
+    ::tcl::Lvarset1 l 6 X
+    set l
+} {a b c {} {} {} X}
+
+test opt-8.6 {List utilities} {
+    set l {a {b c 7 e} f}
+    ::tcl::Lvarincr l {1 2}
+    set l
+} {a {b c 8 e} f}
+
+test opt-8.7 {List utilities} {
+    set l {a {b c 7 e} f}
+    ::tcl::Lvarincr l {1 2} -9
+    set l
+} {a {b c -2 e} f}
+
+test opt-8.8 {List utilities} {
+    set l {{b c 7 e} f}
+    ::tcl::Lfirst $l
+} {b c 7 e}
+
+
+test opt-8.9 {List utilities} {
+    set l {a {b c 7 e} f}
+    ::tcl::Lrest $l
+} {{b c 7 e} f}
+
+test opt-8.10 {List utilities} {
+    set l {a {b c 7 e} f}
+    ::tcl::Lvarpop l
+    set l
+} {{b c 7 e} f}
+
+test opt-8.11 {List utilities} {
+    catch {unset x}
+    set l {a {b c 7 e} f}
+    list [::tcl::Lassign $l u v w x] \
+	    $u $v $w [info exists x]
+} {3 a {b c 7 e} f 0}
+
+test opt-9.1 {Misc utilities} {
+    catch {unset v}
+    ::tcl::SetMax v 3
+    ::tcl::SetMax v 7
+    ::tcl::SetMax v 6
+    set v
+} 7
+
+test opt-9.2 {Misc utilities} {
+    catch {unset v}
+    ::tcl::SetMin v 3
+    ::tcl::SetMin v -7
+    ::tcl::SetMin v 1
+    set v
+} -7
+
+#### behaviour tests #####
+
+test opt-10.1 {ambigous flags} {
+    ::tcl::OptProc optTest {{-fla} {-other} {-flag2xyz} {-flag3xyz}} {}
+    catch {optTest -fL} msg
+    set msg
+} {ambigous option "-fL", choose from:
+    -fla      boolflag (false) 
+    -flag2xyz boolflag (false) 
+    -flag3xyz boolflag (false) }
+
+test opt-10.2 {non ambigous flags} {
+    ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
+	return $flag2xyz
+    }
+    optTest -fLaG2
+} 1
+
+test opt-10.3 {non ambigous flags because of exact match} {
+    ::tcl::OptProc optTest {{-flag1x} {-other} {-flag1} {-flag1xy}} {
+	return $flag1
+    }
+    optTest -flAg1
+} 1
+
+test opt-10.4 {ambigous flags, not exact match} {
+    ::tcl::OptProc optTest {{-flag1xy} {-other} {-flag1} {-flag1xyz}} {
+	return $flag1
+    }
+    catch {optTest -fLag1X} msg
+    set msg
+} {ambigous option "-fLag1X", choose from:
+    -flag1xy  boolflag (false) 
+    -flag1xyz boolflag (false) }
+
+
+
+# medium size overall test example: (defined once)
+::tcl::OptProc optTest {
+    {cmd -choice {print save delete} "sub command to choose"}
+    {-allowBoing -boolean true}
+    {arg2 -string "this is help"}
+    {?arg3? 7 "optional number"}
+    {-moreflags}
+} {
+    list $cmd $allowBoing $arg2 $arg3 $moreflags
+}
+
+test opt-10.5 {medium size overall test} {
+    list [catch {optTest} msg] $msg
+} {1 {no value given for parameter "cmd" (use -help for full usage) :
+    cmd choice (print save delete) sub command to choose}}
+
+
+test opt-10.6 {medium size overall test} {
+    list [catch {optTest -help} msg] $msg
+} {1 {Usage information:
+    Var/FlagName Type     Value   Help
+    ------------ ----     -----   ----
+    ( -help                       gives this help )
+    cmd          choice   (print save delete) sub command to choose
+    -allowBoing  boolean  (true)  
+    arg2         string   ()      this is help
+    ?arg3?       int      (7)     optional number
+    -moreflags   boolflag (false) }}
+
+test opt-10.7 {medium size overall test} {
+    optTest save tst
+} {save 1 tst 7 0}
+
+test opt-10.8 {medium size overall test} {
+    optTest save -allowBoing false -- 8
+} {save 0 8 7 0}
+
+test opt-10.9 {medium size overall test} {
+    optTest save tst -m --
+} {save 1 tst 7 1}
+
+test opt-10.10 {medium size overall test} {
+    list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
+} {1 {too many arguments (unexpected argument(s): foo), usage:}}
+
+
+test opt-11.1 {too many args test 2} {
+    set key [::tcl::OptKeyRegister {-foo}]
+    list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\
+	    [::tcl::OptKeyDelete $key]
+} {1 {too many arguments (unexpected argument(s): blah), usage:
+    Var/FlagName Type     Value   Help
+    ------------ ----     -----   ----
+    ( -help                       gives this help )
+    -foo         boolflag (false) } {}}
+
+
+
+test opt-11.2 {default value for args} {
+    set args {}
+    set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
+    ::tcl::OptKeyParse $key {}
+    ::tcl::OptKeyDelete $key
+    set args
+} {a b c}
+
+
diff --git a/tcl/tests/osa.test b/tcl/tests/osa.test
new file mode 100644
index 00000000000..d70774d332c
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/parse.test b/tcl/tests/parse.test
new file mode 100644
index 00000000000..e5b9fecd19a
--- /dev/null
+++ b/tcl/tests/parse.test
@@ -0,0 +1,556 @@
+# Commands covered:  set (plus basic command syntax).  Also tests
+# the procedures in the file tclParse.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) 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+proc fourArgs {a b c d} {
+    global arg1 arg2 arg3 arg4
+    set arg1 $a
+    set arg2 $b
+    set arg3 $c
+    set arg4 $d
+}
+
+proc getArgs args {
+    global argv
+    set argv $args
+}
+
+# Basic argument parsing.
+
+test parse-1.1 {basic argument parsing} {
+    set arg1 {}
+    fourArgs a b	c 		 d
+    list $arg1 $arg2 $arg3 $arg4
+} {a b c d}
+test parse-1.2 {basic argument parsing} {
+    set arg1 {}
+    eval "fourArgs 123\v4\f56\r7890"
+    list $arg1 $arg2 $arg3 $arg4
+} {123 4 56 7890}
+
+# Quotes.
+
+test parse-2.1 {quotes and variable-substitution} {
+    getArgs "a b c" d
+    set argv
+} {{a b c} d}
+test parse-2.2 {quotes and variable-substitution} {
+    set a 101
+    getArgs "a$a b c"
+    set argv
+} {{a101 b c}}
+test parse-2.3 {quotes and variable-substitution} {
+    set argv "xy[format xabc]"
+    set argv
+} {xyxabc}
+test parse-2.4 {quotes and variable-substitution} {
+    set argv "xy\t"
+    set argv
+} xy\t
+test parse-2.5 {quotes and variable-substitution} {
+    set argv "a b	c
+d e f"
+    set argv
+} a\ b\tc\nd\ e\ f
+test parse-2.6 {quotes and variable-substitution} {
+    set argv a"bcd"e
+    set argv
+} {a"bcd"e}
+
+# Braces.
+
+test parse-3.1 {braces} {
+    getArgs {a b c} d
+    set argv
+} "{a b c} d"
+test parse-3.2 {braces} {
+    set a 101
+    set argv {a$a b c}
+    set b [string index $argv 1]
+    set b
+} {$}
+test parse-3.3 {braces} {
+    set argv {a[format xyz] b}
+    string length $argv
+} 15
+test parse-3.4 {braces} {
+    set argv {a\nb\}}
+    string length $argv
+} 6
+test parse-3.5 {braces} {
+    set argv {{{{}}}}
+    set argv
+} "{{{}}}"
+test parse-3.6 {braces} {
+    set argv a{{}}b
+    set argv
+} "a{{}}b"
+test parse-3.7 {braces} {
+    set a [format "last]"]
+    set a
+} {last]}
+
+# Command substitution.
+
+test parse-4.1 {command substitution} {
+    set a [format xyz]
+    set a
+} xyz
+test parse-4.2 {command substitution} {
+    set a a[format xyz]b[format q]
+    set a
+} axyzbq
+test parse-4.3 {command substitution} {
+    set a a[
+set b 22;
+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.
+
+test parse-5.1 {variable substitution} {
+    set a 123
+    set b $a
+    set b
+} 123
+test parse-5.2 {variable substitution} {
+    set a 345
+    set b x$a.b
+    set b
+} x345.b
+test parse-5.3 {variable substitution} {
+    set _123z xx
+    set b $_123z^
+    set b
+} xx^
+test parse-5.4 {variable substitution} {
+    set a 78
+    set b a${a}b
+    set b
+} a78b
+test parse-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
+test parse-5.6 {variable substitution} {
+    catch {$_non_existent_} msg
+    set msg
+} {can't read "_non_existent_": no such variable}
+test parse-5.7 {array variable substitution} {
+    catch {unset a}
+    set a(xyz) 123
+    set b $a(xyz)foo
+    set b
+} 123foo
+test parse-5.8 {array variable substitution} {
+    catch {unset a}
+    set "a(x y z)" 123
+    set b $a(x y z)foo
+    set b
+} 123foo
+test parse-5.9 {array variable substitution} {
+    catch {unset a}; catch {unset qqq}
+    set "a(x y z)" qqq
+    set $a([format x]\ y [format z]) foo
+    set qqq
+} foo
+test parse-5.10 {array variable substitution} {
+    catch {unset a}
+    list [catch {set b $a(22)} msg] $msg
+} {1 {can't read "a(22)": no such variable}}
+test parse-5.11 {array variable substitution} {
+    set b a$!
+    set b
+} {a$!}
+test parse-5.12 {array variable substitution} {
+    set b a$()
+    set b
+} {a$()}
+catch {unset a}
+test parse-5.13 {array variable substitution} {
+    catch {unset a}
+    set long {This is a very long variable, long enough to cause storage \
+	allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
+	freed up correctly, then a core leak will occur when this test is \
+	run.  This text is probably beginning to sound like drivel, but I've \
+	run out of things to say and I need more characters still.}
+    set a($long) 777
+    set b $a($long)
+    list $b [array names a]
+} {777 {{This is a very long variable, long enough to cause storage \
+	allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
+	freed up correctly, then a core leak will occur when this test is \
+	run.  This text is probably beginning to sound like drivel, but I've \
+	run out of things to say and I need more characters still.}}}
+test parse-5.14 {array variable substitution} {
+    catch {unset a}; catch {unset b}; catch {unset a1}
+    set a1(22) foo
+    set a(foo) bar
+    set b $a($a1(22))
+    set b
+} bar
+catch {unset a}; catch {unset a1}
+
+# Backslash substitution.
+
+set errNum 1
+proc bsCheck {char num} {
+    global errNum
+;   test parse-6.$errNum {backslash substitution} {
+	scan $char %c value
+	set value
+    } $num
+    set errNum [expr $errNum+1]
+}
+
+bsCheck \b	8
+bsCheck \e	101
+bsCheck \f	12
+bsCheck \n	10
+bsCheck \r	13
+bsCheck \t	9
+bsCheck \v	11
+bsCheck \{	123
+bsCheck \}	125
+bsCheck \[	91
+bsCheck \]	93
+bsCheck \$	36
+bsCheck \ 	32
+bsCheck \;	59
+bsCheck \\	92
+bsCheck \Ca	67
+bsCheck \Ma	77
+bsCheck \CMa	67
+bsCheck \8a	8
+bsCheck \14	12
+bsCheck \141	97
+bsCheck \340	224
+bsCheck b\0	98
+bsCheck \x	120
+bsCheck \xa	10
+bsCheck \x41	65
+bsCheck \x541	65
+
+test parse-6.1 {backslash substitution} {
+    set a "\a\c\n\]\}"
+    string length $a
+} 5
+test parse-6.2 {backslash substitution} {
+    set a {\a\c\n\]\}}
+    string length $a
+} 10
+test parse-6.3 {backslash substitution} {
+    set a "abc\
+def"
+    set a
+} {abc def}
+test parse-6.4 {backslash substitution} {
+    set a {abc\
+def}
+    set a
+} {abc def}
+test parse-6.5 {backslash substitution} {
+    set msg {}
+    set a xxx
+    set error [catch {if {24 < \
+	35} {set a 22} {set \
+	    a 33}} msg]
+    list $error $msg $a
+} {0 22 22}
+test parse-6.6 {backslash substitution} {
+    eval "concat abc\\"
+} "abc\\"
+test parse-6.7 {backslash substitution} {
+    eval "concat \\\na"
+} "a"
+test parse-6.8 {backslash substitution} {
+    eval "concat x\\\n   	a"
+} "x a"
+test parse-6.9 {backslash substitution} {
+    eval "concat \\x"
+} "x"
+test parse-6.10 {backslash substitution} {
+    eval "list a b\\\nc d"
+} {a b c d}
+test parse-6.11 {backslash substitution} {
+    eval "list a \"b c\"\\\nd e"
+} {a {b c} d e}
+
+# Semi-colon.
+
+test parse-7.1 {semi-colons} {
+    set b 0
+    getArgs a;set b 2
+    set argv
+} a
+test parse-7.2 {semi-colons} {
+    set b 0
+    getArgs a;set b 2
+    set b
+} 2
+test parse-7.3 {semi-colons} {
+    getArgs a b ; set b 1
+    set argv
+} {a b}
+test parse-7.4 {semi-colons} {
+    getArgs a b ; set b 1
+    set b
+} 1
+
+# The following checks are to ensure that the interpreter's result
+# gets re-initialized by Tcl_Eval in all the right places.
+
+test parse-8.1 {result initialization} {concat abc} abc
+test parse-8.2 {result initialization} {concat abc; proc foo {} {}} {}
+test parse-8.3 {result initialization} {concat abc; proc foo {} $a} {}
+test parse-8.4 {result initialization} {proc foo {} [concat abc]} {}
+test parse-8.5 {result initialization} {concat abc; } abc
+test parse-8.6 {result initialization} {
+    eval {
+    concat abc
+}} abc
+test parse-8.7 {result initialization} {} {}
+test parse-8.8 {result initialization} {concat abc; ; ;} abc
+
+# Syntax errors.
+
+test parse-9.1 {syntax errors} {catch "set a \{bcd" msg} 1
+test parse-9.2 {syntax errors} {
+	catch "set a \{bcd" msg
+	set msg
+} {missing close-brace}
+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
+} {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
+} {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
+} {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 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
+	set msg
+} {invalid command name "gorp-a-lot"}
+test parse-9.13 {syntax errors} {
+    set a [concat {a}\
+ {b}]
+    set a
+} {a b}
+test parse-9.14 {syntax errors} {
+    list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+} {1 {missing )} {missing )
+    (parsing index for array "x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
+    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)
+
+set a {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}
+
+test parse-10.1 {long values} {
+    string length $a
+} 214
+test parse-10.2 {long values} {
+    llength $a
+} 43
+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.4 {long values} {
+    set b "$a"
+    set b
+} $a
+test parse-10.5 {long values} {
+    set b [set a]
+    set b
+} $a
+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.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.8 {long values} {
+    set b
+} $a
+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
+set i 0
+foreach j [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] {
+    set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
+    set test $test$test$test$test
+    set i [expr $i+1]
+    test parse-10.10 {long values} {
+	set j
+    } $test
+}
+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
+
+test parse-11.1 {comments} {
+    set a old
+    eval {  # set a new}
+    set a
+} {old}
+test parse-11.2 {comments} {
+    set a old
+    eval "  # set a new\nset a new"
+    set a
+} {new}
+test parse-11.3 {comments} {
+    set a old
+    eval "  # set a new\\\nset a new"
+    set a
+} {old}
+test parse-11.4 {comments} {
+    set a old
+    eval "  # set a new\\\\\nset a new"
+    set a
+} {new}
+
+test parse-12.1 {comments at the end of a bracketed script} {
+    set x "[
+expr 1+1
+# skip this!
+]"
+} {2}
+
+if {[info command testwordend] == "testwordend"} {
+    test parse-13.1 {TclWordEnd procedure} {
+	testwordend " 	\n abc"
+    } {c}
+    test parse-13.2 {TclWordEnd procedure} {
+	testwordend "   \\\n"
+    } {}
+    test parse-13.3 {TclWordEnd procedure} {
+	testwordend "   \\\n "
+    } { }
+    test parse-13.4 {TclWordEnd procedure} {
+	testwordend {"abc"}
+    } {"}
+    test parse-13.5 {TclWordEnd procedure} {
+	testwordend {{xyz}}
+    } \}
+    test parse-13.6 {TclWordEnd procedure} {
+	testwordend {{a{}b{}\}} xyz}
+    } "\} xyz"
+    test parse-13.7 {TclWordEnd procedure} {
+	testwordend {abc[this is a]def ghi}
+    } {f ghi}
+    test parse-13.8 {TclWordEnd procedure} {
+	testwordend "puts\\\n\n  "
+    } "s\\\n\n  "
+    test parse-13.9 {TclWordEnd procedure} {
+	testwordend "puts\\\n   	"
+    } "s\\\n   	"
+    test parse-13.10 {TclWordEnd procedure} {
+	testwordend "puts\\\n   	xyz"
+    } "s\\\n   	xyz"
+    test parse-13.11 {TclWordEnd procedure} {
+	testwordend {a$x.$y(a long index) foo}
+    } ") foo"
+    test parse-13.12 {TclWordEnd procedure} {
+	testwordend {abc; def}
+    } {; def}
+    test parse-13.13 {TclWordEnd procedure} {
+	testwordend {abc def}
+    } {c def}
+    test parse-13.14 {TclWordEnd procedure} {
+	testwordend {abc	def}
+    } {c	def}
+    test parse-13.15 {TclWordEnd procedure} {
+	testwordend "abc\ndef"
+    } "c\ndef"
+    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} {
+    info complete {puts [
+	expr 1+1
+	#this is a comment ]}
+} {0}
+test parse-14.2 {TclScriptEnd procedure} {
+    info complete "abc\\\n"
+} {0}
+test parse-14.3 {TclScriptEnd procedure} {
+    info complete "abc\\\\\n"
+} {1}
+test parse-14.4 {TclScriptEnd procedure} {
+    info complete "xyz \[abc \{abc\]"
+} {0}
+test parse-14.5 {TclScriptEnd procedure} {
+    info complete "xyz \[abc"
+} {0}
diff --git a/tcl/tests/pid.test b/tcl/tests/pid.test
new file mode 100644
index 00000000000..85c44cff9e9
--- /dev/null
+++ b/tcl/tests/pid.test
@@ -0,0 +1,52 @@
+# Commands covered:  pid
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+# If pid is not defined just return with no error
+# Some platforms may not have the pid command implemented
+if {[info commands pid] == ""} {
+    puts "pid is not implemented for this machine"
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {removeFile test1}
+
+test pid-1.1 {pid command} {
+    regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
+} 1
+test pid-1.2 {pid command} {unixOrPc unixExecs} {
+    set f [open {| echo foo | cat >test1} w]
+    set pids [pid $f]
+    close $f
+    catch {removeFile test1}
+    list [llength $pids] [regexp {^[0-9]+$} [lindex $pids 0]] \
+       [regexp {^[0-9]+$} [lindex $pids 1]] \
+       [expr {[lindex $pids 0] == [lindex $pids 1]}]
+} {2 1 1 0}
+test pid-1.3 {pid command} {
+    set f [open test1 w]
+    set pids [pid $f]
+    close $f
+    set pids
+} {}
+test pid-1.4 {pid command} {
+    list [catch {pid a b} msg] $msg
+} {1 {wrong # args: should be "pid ?channelId?"}}
+test pid-1.5 {pid command} {
+    list [catch {pid gorp} msg] $msg
+} {1 {can not find channel named "gorp"}}
+
+catch {removeFile test1}
+concat {}
diff --git a/tcl/tests/pkg.test b/tcl/tests/pkg.test
new file mode 100644
index 00000000000..5d6314bce93
--- /dev/null
+++ b/tcl/tests/pkg.test
@@ -0,0 +1,563 @@
+# Commands covered:  pkg
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Do all this in a slave interp to avoid garbaging the
+# package list
+set i [interp create]
+interp eval $i [list set VERBOSE $VERBOSE]
+interp eval $i [list set TESTS $TESTS]
+interp eval $i {
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+eval package forget [package names]
+set oldPkgUnknown [package unknown]
+package unknown {}
+set oldPath $auto_path
+set auto_path ""
+
+test pkg-1.1 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3
+} {}
+test pkg-1.2 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3
+    list [catch {package provide t 2.2} msg] $msg
+} {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
+test pkg-1.3 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3
+    list [catch {package provide t 2.4} msg] $msg
+} {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
+test pkg-1.4 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3
+    list [catch {package provide t 3.3} msg] $msg
+} {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
+test pkg-1.5 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3
+    package provide t 2.3
+} {}
+
+test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
+    package forget t
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t
+    set x
+} {3.4}
+test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
+    package forget t
+    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t
+    set x
+} {3.5}
+test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
+    package forget t
+    foreach i {3.5 2.1 2.3} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t 2.2
+    set x
+} {2.3}
+test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
+    package forget t
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require -exact t 2.3
+    set x
+} {2.3}
+test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
+    package forget t
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t 2.1
+    set x
+} {2.4}
+test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
+    package forget t
+    package unknown {}
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    list [catch {package require t 2.5} msg] $msg
+} {1 {can't find package t 2.5}}
+test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
+    package forget t
+    package unknown {}
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    list [catch {package require t 4.1} msg] $msg
+} {1 {can't find package t 4.1}}
+test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
+    package forget t
+    package unknown {}
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    list [catch {package require -exact t 1.3} msg] $msg
+} {1 {can't find package t 1.3}}
+test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
+    package forget t
+    package unknown {}
+    list [catch {package require t} msg] $msg
+} {1 {can't find package t}}
+test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} {
+    package forget t
+    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
+    list [catch {package require t 2.1} msg] $msg $errorInfo
+} {1 {ifneeded test} {ifneeded test
+    while executing
+"error "ifneeded test""
+    ("package ifneeded" script)
+    invoked from within
+"package require t 2.1"}}
+test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} {
+    package forget t
+    package ifneeded t 2.1 "set x invoked"
+    set x xxx
+    list [catch {package require t 2.1} msg] $msg $x
+} {1 {can't find package t 2.1} invoked}
+test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
+    package forget t
+    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
+    set x xxx
+    package require t 1.2
+    set x
+} {1.2}
+test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
+    proc pkgUnknown args {
+	global x
+	set x $args
+	package provide [lindex $args 0] [lindex $args 1]
+    }
+    package forget t
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package unknown pkgUnknown
+    set x xxx
+    package require -exact t 1.5
+    package unknown {}
+    set x
+} {t 1.5 -exact}
+test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
+    proc pkgUnknown args {
+	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
+    }
+    package forget t
+    package unknown pkgUnknown
+    set x xxx
+    set result [list [package require t] $x]
+    package unknown {}
+    set result
+} {1.2 loaded}
+test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
+    proc pkgUnknown args {
+	global x
+	set x $args
+	package provide [lindex $args 0] 2.0
+    }
+    package forget {a b}
+    package unknown pkgUnknown
+    set x xxx
+    package require {a b}
+    package unknown {}
+    set x
+} {{a b} {}}
+test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
+    proc pkgUnknown args {
+	error "testing package unknown"
+    }
+    package forget t 
+    package unknown pkgUnknown
+    set result [list [catch {package require t} msg] $msg $errorInfo]
+    package unknown {}
+    set result
+} {1 {testing package unknown} {testing package unknown
+    while executing
+"error "testing package unknown""
+    (procedure "pkgUnknown" line 2)
+    invoked from within
+"pkgUnknown t {}"
+    ("package unknown" script)
+    invoked from within
+"package require t"}}
+test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} {
+    proc pkgUnknown args {
+	global x
+	set x $args
+    }
+    package forget t
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package unknown pkgUnknown
+    set x xxx
+    set result [list [catch {package require -exact t 1.5} msg] $msg $x]
+    package unknown {}
+    set result
+} {1 {can't find package t 1.5} {t 1.5 -exact}}
+test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    package require t
+} {2.3}
+test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    package require t 2.1
+} {2.3}
+test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    package require t 2.3
+} {2.3}
+test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    list [catch {package require t 2.4} msg] $msg
+} {1 {version conflict for package "t": have 2.3, need 2.4}}
+test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    list [catch {package require t 1.2} msg] $msg
+} {1 {version conflict for package "t": have 2.3, need 1.2}}
+test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    package require -exact t 2.3
+} {2.3}
+test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
+    package forget t
+    package provide t 2.3
+    list [catch {package require -exact t 2.2} msg] $msg
+} {1 {version conflict for package "t": have 2.3, need 2.2}}
+
+test pkg-3.1 {Tcl_PackageCmd procedure} {
+    list [catch {package} msg] $msg
+} {1 {wrong # args: should be "package option ?arg arg ...?"}}
+test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    package names
+} {}
+test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    package forget foo
+} {}
+test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    package ifneeded t 1.1 {first script}
+    package ifneeded t 2.3 {second script}
+    package ifneeded x 1.4 {x's script}
+    set result {}
+    lappend result [lsort [package names]] [package versions t]
+    package forget t
+    lappend result [lsort [package names]] [package versions t]
+} {{t x} {1.1 2.3} x {}}
+test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    package ifneeded a 1.1 {first script}
+    package ifneeded b 2.3 {second script}
+    package ifneeded c 1.4 {third script}
+    package forget
+    set result [list [lsort [package names]]]
+    package forget a c
+    lappend result [lsort [package names]]
+} {{a b c} b}
+test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    list [catch {package ifneeded a} msg] $msg
+} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
+test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    list [catch {package ifneeded a b c d} msg] $msg
+} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
+test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    list [catch {package ifneeded t xyz} msg] $msg
+} {1 {expected version number but got "xyz"}}
+test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    list [package ifneeded foo 1.1] [package names]
+} {{} {}}
+test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    package forget t
+    package ifneeded t 1.4 "script for t 1.4"
+    list [package names] [package ifneeded t 1.4] [package versions t]
+} {t {script for t 1.4} 1.4}
+test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    package forget t
+    package ifneeded t 1.4 "script for t 1.4"
+    list [package ifneeded t 1.5] [package names] [package versions t]
+} {{} t 1.4}
+test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    package forget t
+    package ifneeded t 1.4 "script for t 1.4"
+    package ifneeded t 1.4 "second script for t 1.4"
+    list [package ifneeded t 1.4] [package names] [package versions t]
+} {{second script for t 1.4} t 1.4}
+test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    package forget t
+    package ifneeded t 1.4 "script for t 1.4"
+    package ifneeded t 1.2 "second script"
+    package ifneeded t 3.1 "last script"
+    list [package ifneeded t 1.2] [package versions t]
+} {{second script} {1.4 1.2 3.1}}
+test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
+    list [catch {package names a} msg] $msg
+} {1 {wrong # args: should be "package names"}}
+test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    package names
+} {}
+test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
+    foreach i [package names] {
+	package forget $i
+    }
+    package ifneeded x 1.2 {dummy}
+    package provide x 1.3
+    package provide y 2.4
+    catch {package require z 47.16}
+    lsort [package names]
+} {x y}
+test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
+    list [catch {package provide} msg] $msg
+} {1 {wrong # args: should be "package provide package ?version?"}}
+test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
+    list [catch {package provide a b c} msg] $msg
+} {1 {wrong # args: should be "package provide package ?version?"}}
+test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
+    package forget t
+    package provide t
+} {}
+test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
+    package forget t
+    package provide t 2.3
+    package provide t
+} {2.3}
+test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
+    package forget t
+    list [catch {package provide t a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require} msg] $msg
+} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require a b c} msg] $msg
+} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require -exact a b c} msg] $msg
+} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require -bs a b} msg] $msg
+} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require x a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require -exact x a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require -exact x} msg] $msg
+} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
+    list [catch {package require -exact} msg] $msg
+} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
+    package forget t
+    package provide t 2.3
+    package require t 2.1
+} {2.3}
+test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
+    package forget t
+    list [catch {package require t} msg] $msg
+} {1 {can't find package t}}
+test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
+    package forget t
+    package ifneeded t 2.3 "error {synthetic error}"
+    list [catch {package require t 2.3} msg] $msg
+} {1 {synthetic error}}
+test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
+    list [catch {package unknown a b} msg] $msg
+} {1 {wrong # args: should be "package unknown ?command?"}}
+test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
+    package unknown "test script"
+    package unknown
+} {test script}
+test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
+    package unknown "test script"
+    package unknown {}
+    package unknown
+} {}
+test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
+    list [catch {package vcompare a} msg] $msg
+} {1 {wrong # args: should be "package vcompare version1 version2"}}
+test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
+    list [catch {package vcompare a b c} msg] $msg
+} {1 {wrong # args: should be "package vcompare version1 version2"}}
+test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
+    list [catch {package vcompare x.y 3.4} msg] $msg
+} {1 {expected version number but got "x.y"}}
+test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
+    list [catch {package vcompare 2.1 a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
+    package vc 2.1 2.3
+} {-1}
+test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
+    package vc 2.2.4 2.2.4
+} {0}
+test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
+    list [catch {package versions} msg] $msg
+} {1 {wrong # args: should be "package versions package"}}
+test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
+    list [catch {package versions a b} msg] $msg
+} {1 {wrong # args: should be "package versions package"}}
+test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
+    package forget t
+    package versions t
+} {}
+test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
+    package forget t
+    package provide t 2.3
+    package versions t
+} {}
+test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
+    package forget t
+    package ifneeded t 2.3 x
+    package ifneeded t 2.4 y
+    package versions t
+} {2.3 2.4}
+test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vsatisfies a} msg] $msg
+} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
+test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vsatisfies a b c} msg] $msg
+} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
+test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vsatisfies x.y 3.4} msg] $msg
+} {1 {expected version number but got "x.y"}}
+test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vcompare 2.1 a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    package vs 2.3 2.1
+} {1}
+test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    package vs 2.3 1.2
+} {0}
+test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
+    list [catch {package foo} msg] $msg
+} {1 {bad option "foo": should be forget, ifneeded, names, provide, require, unknown, vcompare, versions, or vsatisfies}}
+
+# No tests for FindPackage;  can't think up anything detectable
+# errors.
+
+test pkg-4.1 {TclFreePackageInfo procedure} {
+    interp create foo
+    foo eval {
+	package ifneeded t 2.3 x
+	package ifneeded t 2.4 y
+	package ifneeded x 3.1 z
+	package provide q 4.3
+	package unknown "will this get freed?"
+    }
+    interp delete foo
+} {}
+test pkg-4.2 {TclFreePackageInfo procedure} {
+    interp create foo
+    foo eval {
+	package ifneeded t 2.3 x
+	package ifneeded t 2.4 y
+	package ifneeded x 3.1 z
+	package provide q 4.3
+    }
+    foo alias z kill
+    proc kill {} {
+	interp delete foo
+    }
+    list [catch {foo eval package require x 3.1} msg] $msg
+} {1 {can't find package x 3.1}}
+
+test pkg-5.1 {CheckVersion procedure} {
+    list [catch {package vcompare 1 2.1} msg] $msg
+} {0 -1}
+test pkg-5.2 {CheckVersion procedure} {
+    list [catch {package vcompare .1 2.1} msg] $msg
+} {1 {expected version number but got ".1"}}
+test pkg-5.3 {CheckVersion procedure} {
+    list [catch {package vcompare 111.2a.3 2.1} msg] $msg
+} {1 {expected version number but got "111.2a.3"}}
+test pkg-5.4 {CheckVersion procedure} {
+    list [catch {package vcompare 1.2.3. 2.1} msg] $msg
+} {1 {expected version number but got "1.2.3."}}
+
+test pkg-6.1 {ComparePkgVersions procedure} {
+    package vcompare 1.23 1.22
+} {1}
+test pkg-6.2 {ComparePkgVersions procedure} {
+    package vcompare 1.22.1.2.3 1.22.1.2.3
+} {0}
+test pkg-6.3 {ComparePkgVersions procedure} {
+    package vcompare 1.21 1.22
+} {-1}
+test pkg-6.4 {ComparePkgVersions procedure} {
+    package vcompare 1.21 1.21.2
+} {-1}
+test pkg-6.5 {ComparePkgVersions procedure} {
+    package vcompare 1.21.1 1.21
+} {1}
+test pkg-6.6 {ComparePkgVersions procedure} {
+    package vsatisfies 1.21.1 1.21
+} {1}
+test pkg-6.7 {ComparePkgVersions procedure} {
+    package vsatisfies 2.22.3 1.21
+} {0}
+test pkg-6.8 {ComparePkgVersions procedure} {
+    package vsatisfies 1 1
+} {1}
+test pkg-6.9 {ComparePkgVersions procedure} {
+    package vsatisfies 2 1
+} {0}
+
+set auto_path $oldPath
+package unknown $oldPkgUnknown
+concat
+
+}
+interp delete $i
diff --git a/tcl/tests/pkg/circ1.tcl b/tcl/tests/pkg/circ1.tcl
new file mode 100644
index 00000000000..a8e7f9a557a
--- /dev/null
+++ b/tcl/tests/pkg/circ1.tcl
@@ -0,0 +1,34 @@
+# circ1.tcl --
+#
+#  Test package for pkg_mkIndex. This package requires circ2, and circ2
+#  requires circ3, which in turn requires circ1.
+#  In case of cirularities, pkg_mkIndex should give up when it gets stuck.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require circ2 1.0
+
+package provide circ1 1.0
+
+namespace eval circ1 {
+    namespace export c1-1 c1-2 c1-3 c1-4
+}
+
+proc circ1::c1-1 { num } {
+    return [circ2::c2-1 $num]
+}
+
+proc circ1::c1-2 { num } {
+    return [circ2::c2-2 $num]
+}
+
+proc circ1::c1-3 {} {
+    return 10
+}
+
+proc circ1::c1-4 {} {
+    return 20
+}
diff --git a/tcl/tests/pkg/circ2.tcl b/tcl/tests/pkg/circ2.tcl
new file mode 100644
index 00000000000..d9bc7c50928
--- /dev/null
+++ b/tcl/tests/pkg/circ2.tcl
@@ -0,0 +1,25 @@
+# circ2.tcl --
+#
+#  Test package for pkg_mkIndex. This package is required by circ1, and
+#  requires circ3. Circ3, in turn, requires circ1 to give us a circularity.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require circ3 1.0
+
+package provide circ2 1.0
+
+namespace eval circ2 {
+    namespace export c2-1 c2-2
+}
+
+proc circ2::c2-1 { num } {
+    return [expr $num * [circ3::c3-1]]
+}
+
+proc circ2::c2-2 { num } {
+    return [expr $num * [circ3::c3-2]]
+}
diff --git a/tcl/tests/pkg/circ3.tcl b/tcl/tests/pkg/circ3.tcl
new file mode 100644
index 00000000000..72ef502a2a3
--- /dev/null
+++ b/tcl/tests/pkg/circ3.tcl
@@ -0,0 +1,25 @@
+# circ3.tcl --
+#
+#  Test package for pkg_mkIndex. This package is required by circ2, and in
+#  turn requires circ1. This closes the circularity.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require circ1 1.0
+
+package provide circ3 1.0
+
+namespace eval circ3 {
+    namespace export c3-1 c3-4
+}
+
+proc circ3::c3-1 {} {
+    return [circ1::c1-3]
+}
+
+proc circ3::c3-2 {} {
+    return [circ1::c1-4]
+}
diff --git a/tcl/tests/pkg/global.tcl b/tcl/tests/pkg/global.tcl
new file mode 100644
index 00000000000..a1689745aa2
--- /dev/null
+++ b/tcl/tests/pkg/global.tcl
@@ -0,0 +1,19 @@
+# global.tcl --
+#
+#  Test package for pkg_mkIndex.
+#  Contains global symbols, used to check that they don't have a leading ::
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package provide global 1.0
+
+proc global_lower { stg } {
+    return [string tolower $stg]
+}
+
+proc global_upper { stg } {
+    return [string toupper $stg]
+}
diff --git a/tcl/tests/pkg/pkg1.tcl b/tcl/tests/pkg/pkg1.tcl
new file mode 100644
index 00000000000..7d029f3e80a
--- /dev/null
+++ b/tcl/tests/pkg/pkg1.tcl
@@ -0,0 +1,26 @@
+# pkg1.tcl --
+#
+#  Test package for pkg_mkIndex. This package requires pkg3, but it does
+#  not use any of pkg3's procs in the code that is executed by the file
+#  (i.e. references to pkg3's procs are in the proc bodies only).
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require pkg3 1.0
+
+package provide pkg1 1.0
+
+namespace eval pkg1 {
+    namespace export p1-1 p1-2
+}
+
+proc pkg1::p1-1 { num } {
+    return [pkg3::p3-1 $num]
+}
+
+proc pkg1::p1-2 { num } {
+    return [pkg3::p3-2 $num]
+}
diff --git a/tcl/tests/pkg/pkg2_a.tcl b/tcl/tests/pkg/pkg2_a.tcl
new file mode 100644
index 00000000000..85e16c4eec3
--- /dev/null
+++ b/tcl/tests/pkg/pkg2_a.tcl
@@ -0,0 +1,22 @@
+# pkg2_a.tcl --
+#
+#  Test package for pkg_mkIndex. This package is required by pkg1.
+#  This package is split into two files, to test packages that are split
+#  over multiple files.
+#
+# Copyright (c) 2998 by Scriptics Corporation.
+#
+# 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%
+
+package provide pkg2 1.0
+
+namespace eval pkg2 {
+    namespace export p2-1
+}
+
+proc pkg2::p2-1 { num } {
+    return [expr $num * 2]
+}
diff --git a/tcl/tests/pkg/pkg2_b.tcl b/tcl/tests/pkg/pkg2_b.tcl
new file mode 100644
index 00000000000..15fb1a85822
--- /dev/null
+++ b/tcl/tests/pkg/pkg2_b.tcl
@@ -0,0 +1,22 @@
+# pkg2_b.tcl --
+#
+#  Test package for pkg_mkIndex. This package is required by pkg1.
+#  This package is split into two files, to test packages that are split
+#  over multiple files.
+#
+# Copyright (c) 2998 by Scriptics Corporation.
+#
+# 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%
+
+package provide pkg2 1.0
+
+namespace eval pkg2 {
+    namespace export p2-2
+}
+
+proc pkg2::p2-2 { num } {
+    return [expr $num * 3]
+}
diff --git a/tcl/tests/pkg/pkg3.tcl b/tcl/tests/pkg/pkg3.tcl
new file mode 100644
index 00000000000..d9c450444f9
--- /dev/null
+++ b/tcl/tests/pkg/pkg3.tcl
@@ -0,0 +1,22 @@
+# pkg3.tcl --
+#
+#  Test package for pkg_mkIndex.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package provide pkg3 1.0
+
+namespace eval pkg3 {
+    namespace export p3-1 p3-2
+}
+
+proc pkg3::p3-1 { num } {
+    return {[expr $num * 2]}
+}
+
+proc pkg3::p3-2 { num } {
+    return {[expr $num * 3]}
+}
diff --git a/tcl/tests/pkg/pkg4.tcl b/tcl/tests/pkg/pkg4.tcl
new file mode 100644
index 00000000000..36587c92874
--- /dev/null
+++ b/tcl/tests/pkg/pkg4.tcl
@@ -0,0 +1,27 @@
+# pkg4.tcl --
+#
+#  Test package for pkg_mkIndex. This package requires pkg3, and it calls
+#  a pkg3 proc in the code that is executed by the file
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require pkg3 1.0
+
+package provide pkg4 1.0
+
+namespace eval pkg4 {
+    namespace export p4-1 p4-2
+    variable m2 [pkg3::p3-1 10]
+}
+
+proc pkg4::p4-1 { num } {
+    variable m2
+    return [expr {$m2 * $num}]
+}
+
+proc pkg4::p4-2 { num } {
+    return [pkg3::p3-2 $num]
+}
diff --git a/tcl/tests/pkg/pkg5.tcl b/tcl/tests/pkg/pkg5.tcl
new file mode 100644
index 00000000000..2d2073b0cde
--- /dev/null
+++ b/tcl/tests/pkg/pkg5.tcl
@@ -0,0 +1,30 @@
+# pkg5.tcl --
+#
+#  Test package for pkg_mkIndex. This package requires pkg2, and it calls
+#  a pkg2 proc in the code that is executed by the file.
+#  Pkg2 is a split package.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require pkg2 1.0
+
+package provide pkg5 1.0
+
+namespace eval pkg5 {
+    namespace export p5-1 p5-2
+    variable m2 [pkg2::p2-1 10]
+    variable m3 [pkg2::p2-2 10]
+}
+
+proc pkg5::p5-1 { num } {
+    variable m2
+    return [expr {$m2 * $num}]
+}
+
+proc pkg5::p5-2 { num } {
+    variable m2
+    return [expr {$m2 * $num}]
+}
diff --git a/tcl/tests/pkg/pkga.tcl b/tcl/tests/pkg/pkga.tcl
new file mode 100644
index 00000000000..cb10a2de89f
--- /dev/null
+++ b/tcl/tests/pkg/pkga.tcl
@@ -0,0 +1,15 @@
+# pkga.tcl --
+#
+#  Test package for pkg_mkIndex. This package provides Pkga,
+#  which is also provided by a DLL.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package provide Pkga 1.0
+
+proc pkga_neq { x } {
+    return [expr {! [pkgq_eq $x]}]
+}
diff --git a/tcl/tests/pkg/simple.tcl b/tcl/tests/pkg/simple.tcl
new file mode 100644
index 00000000000..73f49e3ac49
--- /dev/null
+++ b/tcl/tests/pkg/simple.tcl
@@ -0,0 +1,23 @@
+# simple.tcl --
+#
+#  Test package for pkg_mkIndex. This is a simple package, just to check
+#  basic functionality.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package provide simple 1.0
+
+namespace eval simple {
+    namespace export lower upper
+}
+
+proc simple::lower { stg } {
+    return [string tolower $stg]
+}
+
+proc simple::upper { stg } {
+    return [string toupper $stg]
+}
diff --git a/tcl/tests/pkg/std.tcl b/tcl/tests/pkg/std.tcl
new file mode 100644
index 00000000000..ceb518d2eb9
--- /dev/null
+++ b/tcl/tests/pkg/std.tcl
@@ -0,0 +1,28 @@
+# std.tcl --
+#
+#  Test package for pkg_mkIndex.
+#  Does a package require of direct1, whose pkgIndex.tcl entry (in pkg1)
+#  should be a -direct entry.
+#  This tests that pkg_mkIndex can handle code that is sourced in pkgIndex.tcl
+#  files.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id$
+
+package require direct1
+
+package provide std 1.0
+
+namespace eval std {
+    namespace export p1 p2
+}
+
+proc std::p1 { stg } {
+    return [string tolower $stg]
+}
+
+proc std::p2 { stg } {
+    return [string toupper $stg]
+}
diff --git a/tcl/tests/pkgMkIndex.test b/tcl/tests/pkgMkIndex.test
new file mode 100644
index 00000000000..83fd704bb0d
--- /dev/null
+++ b/tcl/tests/pkgMkIndex.test
@@ -0,0 +1,340 @@
+# This file contains tests for the pkg_mkIndex command.
+# Note that the tests are limited to Tcl scripts only, there are no shared
+# libraries against which to test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors.  No output means no errors were found.
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Add the pkg1 directory to auto_path, so that its packages can be found.
+# packages in pkg1 are used to test indexing of packages in pkg.
+# Make sure that the path to pkg1 is absolute.
+
+set scriptDir [file dirname [info script]]
+set oldDir [pwd]
+lappend auto_path [file join [pwd] $scriptDir pkg1]
+
+namespace eval pkgtest {
+    # Namespace for procs we can discard
+}
+
+# pkgtest::parseArgs --
+#
+#  Parse an argument list.
+#
+# Arguments:
+#  <flags>	(optional) arguments starting with a dash are collected
+#		as options to pkg_mkIndex and passed to pkg_mkIndex.
+#  dirPath	the directory to index
+#  pattern0	pattern to index
+#  ...		pattern to index
+#  patternN	pattern to index
+#
+# Results:
+#  Returns a three element list:
+#    0: the options
+#    1: the directory to index
+#    2: the patterns list
+
+proc pkgtest::parseArgs { args } {
+    set options ""
+
+    set argc [llength $args]
+    for {set iarg 0} {$iarg < $argc} {incr iarg} {
+	set a [lindex $args $iarg]
+	if {[regexp {^-} $a]} {
+	    lappend options $a
+	    if {[string compare -load $a] == 0} {
+		incr iarg
+		lappend options [lindex $args $iarg]
+	    }
+	} else {
+	    break
+	}
+    }
+
+    set dirPath [lindex $args $iarg]
+    incr iarg
+    set patternList [lrange $args $iarg end]
+
+    return [list $options $dirPath $patternList]
+}
+
+# pkgtest::parseIndex --
+#
+#  Loads a pkgIndex.tcl file, records all the calls to "package ifneeded".
+#
+# Arguments:
+#  filePath	path to the pkgIndex.tcl file.
+#
+# Results:
+#  Returns a list, in "array set/get" format, where the keys are the package
+#  name and version (in the form "$name:$version"), and the values the rest
+#  of the command line.
+
+proc pkgtest::parseIndex { filePath } {
+    # create a slave interpreter, where we override "package ifneeded"
+
+    set slave [interp create]
+    if {[catch {
+	$slave eval {
+	    rename package package_original
+	    proc package { args } {
+		if {[string compare [lindex $args 0] ifneeded] == 0} {
+		    set pkg [lindex $args 1]
+		    set ver [lindex $args 2]
+		    set ::PKGS($pkg:$ver) [lindex $args 3]
+		} else {
+		    return [eval package_original $args]
+		}
+	    }
+	    array set ::PKGS {}
+	}
+
+	set dir [file dirname $filePath]
+	$slave eval {set curdir [pwd]}
+	$slave eval [list cd $dir]
+	$slave eval [list set dir $dir]
+	$slave eval [list source [file tail $filePath]]
+	$slave eval {cd $curdir}
+
+	# Create the list in sorted order, so that we don't get spurious
+	# errors because the order has changed.
+
+	array set P {}
+	foreach {k v} [$slave eval {array get ::PKGS}] {
+	    set P($k) $v
+	}
+
+	set PKGS ""
+	foreach k [lsort [array names P]] {
+	    lappend PKGS $k $P($k)
+	}
+    } err]} {
+	set ei $::errorInfo
+	set ec $::errorCode
+
+	catch {interp delete $slave}
+
+	error $ei $ec
+    }
+
+    interp delete $slave
+
+    return $PKGS
+}
+
+# pkgtest::createIndex --
+#
+#  Runs pkg_mkIndex for the given directory and set of patterns.
+#  This procedure deletes any pkgIndex.tcl file in the target directory,
+#  then runs pkg_mkIndex.
+#
+# Arguments:
+#  <flags>	(optional) arguments starting with a dash are collected
+#		as options to pkg_mkIndex and passed to pkg_mkIndex.
+#  dirPath	the directory to index
+#  pattern0	pattern to index
+#  ...		pattern to index
+#  patternN	pattern to index
+#
+# Results:
+#  Returns a two element list:
+#    0: 1 if the procedure encountered an error, 0 otherwise.
+#    1: the error result if element 0 was 1
+
+proc pkgtest::createIndex { args } {
+    set parsed [eval parseArgs $args]
+    set options [lindex $parsed 0]
+    set dirPath [lindex $parsed 1]
+    set patternList [lindex $parsed 2]
+
+    if {[catch {
+	file delete [file join $dirPath pkgIndex.tcl]
+	eval pkg_mkIndex $options $dirPath $patternList
+    } err]} {
+	return [list 1 $err]
+    }
+
+    return [list 0 {}]
+}
+
+# makePkgList --
+#
+#  Takes the output of a pkgtest::parseIndex call, filters it and returns a
+#  cleaned up list of packages and their actions.
+#
+# Arguments:
+#  inList	output from a pkgtest::parseIndex.
+#
+# Results:
+#  Returns a list of two element lists:
+#    0: the name:version
+#    1: a list describing the package.
+#	For tclPkgSetup packages it consists of:
+#	 0: the keyword tclPkgSetup
+#	 1: the first file to source, with its exported procedures
+#	 2: the second file ...
+#	 N: the N-1st file ...
+
+proc makePkgList { inList } {
+    set pkgList ""
+
+    foreach {k v} $inList {
+	switch [lindex $v 0] {
+	    tclPkgSetup {
+		set l tclPkgSetup
+		foreach s [lindex $v 4] {
+		    lappend l $s
+		}
+	    }
+
+	    source {
+		set l $v
+	    }
+
+	    default {
+		error "can't handle $k $v"
+	    }
+	}
+
+	lappend pkgList [list $k $l]
+    }
+
+    return $pkgList
+}
+
+# pkgtest::runIndex --
+#
+#  Runs pkg_mkIndex, parses the generated index file.
+#
+# Arguments:
+#  <flags>	(optional) arguments starting with a dash are collected
+#		as options to pkg_mkIndex and passed to pkg_mkIndex.
+#  dirPath	the directory to index
+#  pattern0	pattern to index
+#  ...		pattern to index
+#  patternN	pattern to index
+#
+# Results:
+#  Returns a two element list:
+#    0: 1 if the procedure encountered an error, 0 otherwise.
+#    1: if no error, this is the parsed generated index file, in the format
+#	returned by pkgtest::parseIndex.
+#	If error, this is the error result.
+
+proc pkgtest::runIndex { args } {
+    set rv [eval createIndex $args]
+    if {[lindex $rv 0] == 0} {
+	set parsed [eval parseArgs $args]
+	set dirPath [lindex $parsed 1]
+	set idxFile [file join $dirPath pkgIndex.tcl]
+
+	if {[catch {
+	    set result [list 0 [makePkgList [parseIndex $idxFile]]]
+	} err]} {
+	    set result [list 1 $err]
+	}
+	file delete $idxFile
+    } else {
+	set result $rv
+    }
+
+    return $result
+}
+
+# If there is no match to the patterns, make sure the directory hasn't
+# changed on us
+
+test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
+    list [pkgtest::runIndex pkg nomatch.tcl] [pwd]
+} [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]]
+cd $oldDir	;# 'cause 8.0.3 is left in the wrong place
+test pkgMkIndex-2.1 {simple package} {
+    pkgtest::runIndex pkg simple.tcl
+} {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}}
+
+test pkgMkIndex-2.2 {simple package - use -direct} {
+    pkgtest::runIndex -direct pkg simple.tcl
+} "0 {{simple:1.0 {source [file join pkg simple.tcl]}}}"
+
+test pkgMkIndex-3.1 {simple package with global symbols} {
+    pkgtest::runIndex pkg global.tcl
+} {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}}
+
+test pkgMkIndex-4.1 {split package} {
+    pkgtest::runIndex pkg pkg2_a.tcl pkg2_b.tcl
+} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}
+
+test pkgMkIndex-4.2 {split package - direct loading} {
+    pkgtest::runIndex -direct pkg pkg2_a.tcl pkg2_b.tcl
+} "0 {{pkg2:1.0 {source [file join pkg pkg2_a.tcl]
+source [file join pkg pkg2_b.tcl]}}}"
+
+# This will fail, with "direct1" procedures in the list of procedures
+# provided by std.
+# It may also fail, if tclblend is in the auto_path, with an additional
+# command "loadJava" which comes from the tclblend pkgIndex.tcl file.
+# Both failures are caused by Tcl code executed in pkgIndex.tcl.
+
+test pkgMkIndex-5.1 {requires -direct package} {
+    pkgtest::runIndex pkg std.tcl
+} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}}
+
+test pkgMkIndex-6.1 {pkg1 requires pkg3} {
+    pkgtest::runIndex pkg pkg1.tcl pkg3.tcl
+} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}
+
+test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
+    pkgtest::runIndex -direct pkg pkg1.tcl pkg3.tcl
+} "0 {{pkg1:1.0 {source [file join pkg pkg1.tcl]}} {pkg3:1.0 {source [file join pkg pkg3.tcl]}}}"
+
+test pkgMkIndex-7.1 {pkg4 uses pkg3} {
+    pkgtest::runIndex pkg pkg4.tcl pkg3.tcl
+} {0 {{pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}} {pkg4:1.0 {tclPkgSetup {pkg4.tcl source {::pkg4::p4-1 ::pkg4::p4-2}}}}}}
+
+test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} {
+    pkgtest::runIndex -direct pkg pkg4.tcl pkg3.tcl
+} "0 {{pkg3:1.0 {source [file join pkg pkg3.tcl]}} {pkg4:1.0 {source [file join pkg pkg4.tcl]}}}"
+
+test pkgMkIndex-8.1 {pkg5 uses pkg2} {
+    pkgtest::runIndex pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
+} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}} {pkg5:1.0 {tclPkgSetup {pkg5.tcl source {::pkg5::p5-1 ::pkg5::p5-2}}}}}}
+
+test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} {
+    pkgtest::runIndex -direct pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
+} "0 {{pkg2:1.0 {source [file join pkg pkg2_a.tcl]
+source [file join pkg pkg2_b.tcl]}} {pkg5:1.0 {source [file join pkg pkg5.tcl]}}}"
+
+test pkgMkIndex-9.1 {circular packages} {
+    pkgtest::runIndex pkg circ1.tcl circ2.tcl circ3.tcl
+} {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}}
+
+# Try to find one of the DLLs in the dltest directory
+set x [file join [pwd] [file dirname [info script]]]
+set x [file join $x ../unix/dltest/pkga[info sharedlibextension]]
+if {[file exists $x]} {
+    file copy -force $x pkg
+    test pkgMkIndex-10.1 {package in DLL and script} {
+	pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
+    } {0 {{Pkga:1.0 {tclPkgSetup {pkga.so load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}}
+    test pkgMkIndex-10.2 {package in DLL hidden by -load} {
+	pkgtest::runIndex -load Pkg* -- pkg pkga[info sharedlibextension]
+    } {0 {}}
+} else {
+    puts "Skipping pkgMkIndex-10.1 (index of DLL and script)"
+}
+
+#
+# cleanup
+#
+if {![info exist TESTS]} {
+    file delete [file join pkg pkgIndex.tcl]
+    namespace delete pkgtest
+}
diff --git a/tcl/tests/proc-old.test b/tcl/tests/proc-old.test
new file mode 100644
index 00000000000..60a1616608f
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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 3)
+    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 5)
+    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/tcl/tests/proc.test b/tcl/tests/proc.test
new file mode 100644
index 00000000000..f00a42137ef
--- /dev/null
+++ b/tcl/tests/proc.test
@@ -0,0 +1,293 @@
+# 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 includes only new tests, in particular
+# tests for code changed for the addition of Tcl namespaces. Other
+# procedure-related tests appear in other test files such as proc-old.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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename p ""}
+catch {rename {} ""}
+catch {unset msg}
+
+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}}
+
+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-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 unless renamed into new namespace} {
+    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 ::} ::p}
+test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} {
+    proc p {x} {info commands 3m}
+    list [catch {p} msg] $msg
+} {1 {no value given for parameter "x" to "p"}}
+
+catch {eval namespace delete [namespace children :: test_ns_*]}
+catch {rename p ""}
+catch {rename {} ""}
+catch {unset msg}
+
+if {[catch {package require procbodytest}]} {
+    puts "This application couldn't load the \"procbodytest\" package, so I"
+    puts "can't test creation of procs whose bodies have type \"procbody\"."
+    return
+}
+
+catch {rename p ""}
+catch {rename t ""}
+
+# Note that the test require that procedures whose body is used to create
+# procbody objects must be executed before the procbodytest::proc command
+# is executed, so that the Proc struct is populated correctly (CompiledLocals
+# are added at compile time).
+
+test proc-4.1 {TclCreateProc, procbody obj} {
+    catch {
+	proc p x {return "$x:$x"}
+	set rv [p P]
+	procbodytest::proc t x p
+	lappend rv [t T]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {P:P T:T}
+
+test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} {
+    catch {
+	proc p x {
+	    set y [string tolower $x]
+	    return "$x:$y"
+	}
+	set rv [p P]
+	procbodytest::proc t x p
+	lappend rv [t T]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {P:p T:t}
+
+test proc-4.3 {TclCreateProc, procbody obj, too many args} {
+    catch {
+	proc p x {
+	    set y [string tolower $x]
+	    return "$x:$y"
+	}
+	set rv [p P]
+	procbodytest::proc t {x x1 x2} p
+	lappend rv [t T]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {procedure "t": arg list contains 3 entries, precompiled header expects 1}
+
+test proc-4.4 {TclCreateProc, procbody obj, inconsitent arg name} {
+    catch {
+	proc p {x y z} {
+	    set v [join [list $x $y $z]]
+	    set w [string tolower $v]
+	    return "$v:$w"
+	}
+	set rv [p P Q R]
+	procbodytest::proc t {x x1 z} p
+	lappend rv [t S T U]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {procedure "t": formal parameter 1 is inconsistent with precompiled body}
+
+test proc-4.5 {TclCreateProc, procbody obj, inconsitent arg default type} {
+    catch {
+	proc p {x y {z Z}} {
+	    set v [join [list $x $y $z]]
+	    set w [string tolower $v]
+	    return "$v:$w"
+	}
+	set rv [p P Q R]
+	procbodytest::proc t {x y z} p
+	lappend rv [t S T U]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
+
+test proc-4.6 {TclCreateProc, procbody obj, inconsitent arg default type} {
+    catch {
+	proc p {x y z} {
+	    set v [join [list $x $y $z]]
+	    set w [string tolower $v]
+	    return "$v:$w"
+	}
+	set rv [p P Q R]
+	procbodytest::proc t {x y {z Z}} p
+	lappend rv [t S T U]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
+
+test proc-4.7 {TclCreateProc, procbody obj, inconsitent arg default value} {
+    catch {
+	proc p {x y {z Z}} {
+	    set v [join [list $x $y $z]]
+	    set w [string tolower $v]
+	    return "$v:$w"
+	}
+	set rv [p P Q R]
+	procbodytest::proc t {x y {z ZZ}} p
+	lappend rv [t S T U]
+	set rv
+    } result
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
+
+catch {rename p ""}
+catch {rename t ""}
diff --git a/tcl/tests/pwd.test b/tcl/tests/pwd.test
new file mode 100644
index 00000000000..b6455cb649e
--- /dev/null
+++ b/tcl/tests/pwd.test
@@ -0,0 +1,22 @@
+# Commands covered:  pwd
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test pwd-1.1 {simple pwd} {
+	catch pwd
+} 0
+test pwd-1.2 {simple pwd} {
+	expr [string length pwd]>0
+} 1
diff --git a/tcl/tests/regexp.test b/tcl/tests/regexp.test
new file mode 100644
index 00000000000..141e7151389
--- /dev/null
+++ b/tcl/tests/regexp.test
@@ -0,0 +1,318 @@
+# Commands covered:  regexp, regsub
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset foo}
+test regexp-1.1 {basic regexp operation} {
+    regexp ab*c abbbc
+} 1
+test regexp-1.2 {basic regexp operation} {
+    regexp ab*c ac
+} 1
+test regexp-1.3 {basic regexp operation} {
+    regexp ab*c ab
+} 0
+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 {}
+    list [regexp ab*c abbbbc foo] $foo
+} {1 abbbbc}
+test regexp-2.2 {getting substrings back from regexp} {
+    set foo {}
+    set f2 {}
+    list [regexp a(b*)c abbbbc foo f2] $foo $f2
+} {1 abbbbc bbbb}
+test regexp-2.3 {getting substrings back from regexp} {
+    set foo {}
+    set f2 {}
+    list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
+} {1 abbbbc bbbb}
+test regexp-2.4 {getting substrings back from regexp} {
+    set foo {}
+    set f2 {}
+    set f3 {}
+    list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
+} {1 abbbbc bbbb c}
+test regexp-2.5 {getting substrings back from regexp} {
+    set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
+    set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {};
+    list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \
+	      12223345556789999aabbb \
+	    foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \
+	    $f6 $f7 $f8 $f9 $fa $fb
+} {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb}
+test regexp-2.6 {getting substrings back from regexp} {
+    set foo 2; set f2 2; set f3 2; set f4 2
+    list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
+} {1 a a {} {}}
+test regexp-2.7 {getting substrings back from regexp} {
+    set foo 1; set f2 1; set f3 1; set f4 1
+    list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
+} {1 ac a {} c}
+
+
+test regexp-3.1 {-indices option to regexp} {
+    set foo {}
+    list [regexp -indices ab*c abbbbc foo] $foo
+} {1 {0 5}}
+test regexp-3.2 {-indices option to regexp} {
+    set foo {}
+    set f2 {}
+    list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
+} {1 {0 5} {1 4}}
+test regexp-3.3 {-indices option to regexp} {
+    set foo {}
+    set f2 {}
+    list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
+} {1 {0 5} {1 4}}
+test regexp-3.4 {-indices option to regexp} {
+    set foo {}
+    set f2 {}
+    set f3 {}
+    list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
+} {1 {0 5} {1 4} {5 5}}
+test regexp-3.5 {-indices option to regexp} {
+    set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
+    set f6 {}; set f7 {}; set f8 {}; set f9 {}
+    list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \
+	    12223345556789999 \
+	    foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
+	    $f6 $f7 $f8 $f9
+} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
+test regexp-3.6 {getting substrings back from regexp} {
+    set foo 2; set f2 2; set f3 2; set f4 2
+    list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
+} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
+test regexp-3.7 {getting substrings back from regexp} {
+    set foo 1; set f2 1; set f3 1; set f4 1
+    list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
+} {1 {1 2} {1 1} {-1 -1} {2 2}}
+
+test regexp-4.1 {-nocase option to regexp} {
+    regexp -nocase foo abcFOo
+} 1
+test regexp-4.2 {-nocase option to regexp} {
+    set f1 22
+    set f2 33
+    set f3 44
+    list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3
+} {1 aBbbxYXxxZ Bbb xYXxx}
+test regexp-4.3 {-nocase option to regexp} {
+    regexp -nocase FOo abcFOo
+} 1
+set x abcdefghijklmnopqrstuvwxyz1234567890
+set x $x$x$x$x$x$x$x$x$x$x$x$x
+test regexp-4.4 {case conversion in regsub} {
+    list [regexp -nocase $x $x foo] $foo
+} "1 $x"
+unset x
+
+test regexp-5.1 {exercise cache of compiled expressions} {
+    regexp .*a b
+    regexp .*b c
+    regexp .*c d
+    regexp .*d e
+    regexp .*e f
+    regexp .*a bbba
+} 1
+test regexp-5.2 {exercise cache of compiled expressions} {
+    regexp .*a b
+    regexp .*b c
+    regexp .*c d
+    regexp .*d e
+    regexp .*e f
+    regexp .*b xxxb
+} 1
+test regexp-5.3 {exercise cache of compiled expressions} {
+    regexp .*a b
+    regexp .*b c
+    regexp .*c d
+    regexp .*d e
+    regexp .*e f
+    regexp .*c yyyc
+} 1
+test regexp-5.4 {exercise cache of compiled expressions} {
+    regexp .*a b
+    regexp .*b c
+    regexp .*c d
+    regexp .*d e
+    regexp .*e f
+    regexp .*d 1d
+} 1
+test regexp-5.5 {exercise cache of compiled expressions} {
+    regexp .*a b
+    regexp .*b c
+    regexp .*c d
+    regexp .*d e
+    regexp .*e f
+    regexp .*e xe
+} 1
+
+test regexp-6.1 {regexp errors} {
+    list [catch {regexp a} msg] $msg
+} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+test regexp-6.2 {regexp errors} {
+    list [catch {regexp -nocase a} msg] $msg
+} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+test regexp-6.3 {regexp errors} {
+    list [catch {regexp -gorp a} msg] $msg
+} {1 {bad switch "-gorp": must be -indices, -nocase, or --}}
+test regexp-6.4 {regexp errors} {
+    list [catch {regexp a( b} msg] $msg
+} {1 {couldn't compile regular expression pattern: unmatched ()}}
+test regexp-6.5 {regexp errors} {
+    list [catch {regexp a( b} msg] $msg
+} {1 {couldn't compile regular expression pattern: unmatched ()}}
+test regexp-6.6 {regexp errors} {
+    list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
+} {0 1}
+test regexp-6.7 {regexp errors} {
+    list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
+} {1 {couldn't compile regular expression pattern: too many ()}}
+test regexp-6.8 {regexp errors} {
+    set f1 44
+    list [catch {regexp abc abc f1(f2)} msg] $msg
+} {1 {couldn't set variable "f1(f2)"}}
+
+test regexp-7.1 {basic regsub operation} {
+    list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
+} {1 xax111aaa222xaa}
+test regexp-7.2 {basic regsub operation} {
+    list [regsub aa+ aaaxaa &111 foo] $foo
+} {1 aaa111xaa}
+test regexp-7.3 {basic regsub operation} {
+    list [regsub aa+ xaxaaa 111& foo] $foo
+} {1 xax111aaa}
+test regexp-7.4 {basic regsub operation} {
+    list [regsub aa+ aaa 11&2&333 foo] $foo
+} {1 11aaa2aaa333}
+test regexp-7.5 {basic regsub operation} {
+    list [regsub aa+ xaxaaaxaa &2&333 foo] $foo
+} {1 xaxaaa2aaa333xaa}
+test regexp-7.6 {basic regsub operation} {
+    list [regsub aa+ xaxaaaxaa 1&22& foo] $foo
+} {1 xax1aaa22aaaxaa}
+test regexp-7.7 {basic regsub operation} {
+    list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo
+} {1 xax1aa22aaxaa}
+test regexp-7.8 {basic regsub operation} {
+    list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo
+} "1 {xax1\\aa22aaxaa}"
+test regexp-7.9 {basic regsub operation} {
+    list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo
+} "1 {xax1\\122aaxaa}"
+test regexp-7.10 {basic regsub operation} {
+    list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo
+} "1 {xax1\\aaaaaxaa}"
+test regexp-7.11 {basic regsub operation} {
+    list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo
+} {1 xax1&aaxaa}
+test regexp-7.12 {basic regsub operation} {
+    list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo
+} {1 xaxaaaaaaaaaaaaaaxaa}
+test regexp-7.13 {basic regsub operation} {
+    set foo xxx
+    list [regsub abc xyz 111 foo] $foo
+} {0 xyz}
+test regexp-7.14 {basic regsub operation} {
+    set foo xxx
+    list [regsub ^ xyz "111 " foo] $foo
+} {1 {111 xyz}}
+test regexp-7.15 {basic regsub operation} {
+    set foo xxx
+    list [regsub -- -foo abc-foodef "111 " foo] $foo
+} {1 {abc111 def}}
+test regexp-7.16 {basic regsub operation} {
+    set foo xxx
+    list [regsub x "" y foo] $foo
+} {0 {}}
+
+test regexp-8.1 {case conversion in regsub} {
+    list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
+} {1 xaAAaAAay}
+test regexp-8.2 {case conversion in regsub} {
+    list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
+} {1 xaAAaAAay}
+test regexp-8.3 {case conversion in regsub} {
+    set foo 123
+    list [regsub a(a+) xaAAaAAay & foo] $foo
+} {0 xaAAaAAay}
+test regexp-8.4 {case conversion in regsub} {
+    set foo 123
+    list [regsub -nocase a CaDE b foo] $foo
+} {1 CbDE}
+test regexp-8.5 {case conversion in regsub} {
+    set foo 123
+    list [regsub -nocase XYZ CxYzD b foo] $foo
+} {1 CbD}
+test regexp-8.6 {case conversion in regsub} {
+    set x abcdefghijklmnopqrstuvwxyz1234567890
+    set x $x$x$x$x$x$x$x$x$x$x$x$x
+    set foo 123
+    list [regsub -nocase $x $x b foo] $foo
+} {1 b}
+
+test regexp-9.1 {-all option to regsub} {
+    set foo 86
+    list [regsub -all x+ axxxbxxcxdx |&| foo] $foo
+} {4 a|xxx|b|xx|c|x|d|x|}
+test regexp-9.2 {-all option to regsub} {
+    set foo 86
+    list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo
+} {4 a|XxX|b|xx|c|X|d|x|}
+test regexp-9.3 {-all option to regsub} {
+    set foo 86
+    list [regsub x+ axxxbxxcxdx |&| foo] $foo
+} {1 a|xxx|bxxcxdx}
+test regexp-9.4 {-all option to regsub} {
+    set foo 86
+    list [regsub -all bc axxxbxxcxdx |&| foo] $foo
+} {0 axxxbxxcxdx}
+test regexp-9.5 {-all option to regsub} {
+    set foo xxx
+    list [regsub -all node "node node more" yy foo] $foo
+} {2 {yy yy more}}
+test regexp-9.6 {-all option to regsub} {
+    set foo xxx
+    list [regsub -all ^ xxx 123 foo] $foo
+} {1 123xxx}
+
+test regexp-10.1 {regsub errors} {
+    list [catch {regsub a b c} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+test regexp-10.2 {regsub errors} {
+    list [catch {regsub -nocase a b c} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+test regexp-10.3 {regsub errors} {
+    list [catch {regsub -nocase -all a b c} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+test regexp-10.4 {regsub errors} {
+    list [catch {regsub a b c d e f} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+test regexp-10.5 {regsub errors} {
+    list [catch {regsub -gorp a b c} msg] $msg
+} {1 {bad switch "-gorp": must be -all, -nocase, or --}}
+test regexp-10.6 {regsub errors} {
+    list [catch {regsub -nocase a( b c d} msg] $msg
+} {1 {couldn't compile regular expression pattern: unmatched ()}}
+test regexp-10.7 {regsub errors} {
+    list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
+} {1 {couldn't set variable "f1(f2)"}}
diff --git a/tcl/tests/registry.test b/tcl/tests/registry.test
new file mode 100644
index 00000000000..62d689e5656
--- /dev/null
+++ b/tcl/tests/registry.test
@@ -0,0 +1,515 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {$tcl_platform(platform) != "windows"} {
+    return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+set lib [lindex [glob [file join [pwd] [file dirname \
+	[info nameofexecutable]] tclreg*.dll]] 0]
+
+if [catch {load $lib registry}] {
+    puts "Unable to find the registry package. Skipping registry tests."
+    return
+}
+
+if {$testConfig(win32s)} {
+    puts "Skipping registry tests under Win32s"
+    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 delete 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 get 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 keys 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 set 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 type 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 values 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/tcl/tests/remote.tcl b/tcl/tests/remote.tcl
new file mode 100644
index 00000000000..660f5a41016
--- /dev/null
+++ b/tcl/tests/remote.tcl
@@ -0,0 +1,161 @@
+# This file contains Tcl code to implement a remote server that can be
+# used during testing of Tcl socket code. This server is used by some
+# of the tests in socket.test.
+#
+# Source this file in the remote server you are using to test Tcl against.
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+# Initialize message delimitor
+
+# Initialize command array
+catch {unset command}
+set command(0) ""
+set callerSocket ""
+
+# Detect whether we should print out connection messages etc.
+if {![info exists VERBOSE]} {
+    set VERBOSE 0
+}
+
+proc __doCommands__ {l s} {
+    global callerSocket VERBOSE
+
+    if {$VERBOSE} {
+	puts "--- Server executing the following for socket $s:"
+	puts $l
+	puts "---"
+    }
+    set callerSocket $s
+    if {[catch {uplevel #0 $l} msg]} {
+	list error $msg
+    } else {
+	list success $msg
+    }
+}
+
+proc __readAndExecute__ {s} {
+    global command VERBOSE
+
+    set l [gets $s]
+    if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
+	if {[info exists command($s)]} {
+	    puts $s [list error incomplete_command]
+	}
+	puts $s "--Marker--Marker--Marker--"
+	return
+    }
+    if {[string compare $l ""] == 0} {
+	if {[eof $s]} {
+	    if {$VERBOSE} {
+		puts "Server closing $s, eof from client"
+	    }
+	    close $s
+	}
+	return
+    }
+    append command($s) $l "\n"
+    if {[info complete $command($s)]} {
+	set cmds $command($s)
+	unset command($s)
+	puts $s [__doCommands__ $cmds $s]
+    }
+    if {[eof $s]} {
+	if {$VERBOSE} {
+	    puts "Server closing $s, eof from client"
+	}
+	close $s
+    }
+}
+
+proc __accept__ {s a p} {
+    global VERBOSE
+
+    if {$VERBOSE} {
+	puts "Server accepts new connection from $a:$p on $s"
+    }
+    fileevent $s readable [list __readAndExecute__ $s]
+    fconfigure $s -buffering line -translation crlf
+}
+
+set serverIsSilent 0
+for {set i 0} {$i < $argc} {incr i} {
+    if {[string compare -serverIsSilent [lindex $argv $i]] == 0} {
+	set serverIsSilent 1
+	break
+    }
+}
+if {![info exists serverPort]} {
+    if {[info exists env(serverPort)]} {
+	set serverPort $env(serverPort)
+    }
+}
+if {![info exists serverPort]} {
+    for {set i 0} {$i < $argc} {incr i} {
+	if {[string compare -port [lindex $argv $i]] == 0} {
+	    if {$i < [expr $argc - 1]} {
+		set serverPort [lindex $argv [expr $i + 1]]
+	    }
+	    break
+	}
+    }
+}
+if {![info exists serverPort]} {
+    set serverPort 2048
+}
+
+if {![info exists serverAddress]} {
+    if {[info exists env(serverAddress)]} {
+	set serverAddress $env(serverAddress)
+    }
+}
+if {![info exists serverAddress]} {
+    for {set i 0} {$i < $argc} {incr i} {
+	if {[string compare -address [lindex $argv $i]] == 0} {
+	    if {$i < [expr $argc - 1]} {
+		set serverAddress [lindex $argv [expr $i + 1]]
+	    }
+	    break
+	}
+    }
+}
+if {![info exists serverAddress]} {
+    set serverAddress 0.0.0.0
+}
+
+if {$serverIsSilent == 0} {
+    set l "Remote server listening on port $serverPort, IP $serverAddress."
+    puts ""
+    puts $l
+    for {set c [string length $l]} {$c > 0} {incr c -1} {puts -nonewline "-"}
+    puts ""
+    puts ""
+    puts "You have set the Tcl variables serverAddress to $serverAddress and"
+    puts "serverPort to $serverPort. You can set these with the -address and"
+    puts "-port command line options, or as environment variables in your"
+    puts "shell."
+    puts ""
+    puts "NOTE: The tests will not work properly if serverAddress is set to"
+    puts "\"localhost\" or 127.0.0.1."
+    puts ""
+    puts "When you invoke tcltest to run the tests, set the variables"
+    puts "remoteServerPort to $serverPort and remoteServerIP to"
+    puts "[info hostname]. You can set these as environment variables"
+    puts "from the shell. The tests will not work properly if you set"
+    puts "remoteServerIP to \"localhost\" or 127.0.0.1."
+    puts ""
+    puts -nonewline "Type Ctrl-C to terminate--> "
+    flush stdout
+}
+
+if {[catch {set serverSocket \
+	[socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
+    puts "Server on $serverAddress:$serverPort cannot start: $msg"
+} else {
+    vwait __server_wait_variable__
+}
diff --git a/tcl/tests/rename.test b/tcl/tests/rename.test
new file mode 100644
index 00000000000..0b1e63420f5
--- /dev/null
+++ b/tcl/tests/rename.test
@@ -0,0 +1,172 @@
+# Commands covered:  rename
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Must eliminate the "unknown" command while the test is running,
+# especially if the test is being run in a program with its
+# own special-purpose unknown command.
+
+catch {rename unknown unknown.old}
+
+catch {rename r2 {}}
+proc r1 {} {return "procedure r1"}
+rename r1 r2
+test rename-1.1 {simple renaming} {
+    r2
+} {procedure r1}
+test rename-1.2 {simple renaming} {
+    list [catch r1 msg] $msg
+} {1 {invalid command name "r1"}}
+rename r2 {}
+test rename-1.3 {simple renaming} {
+    list [catch r2 msg] $msg
+} {1 {invalid command name "r2"}}
+
+# The test below is tricky because it renames a built-in command.
+# It's possible that the test procedure uses this command, so must
+# restore the command before calling test again.
+
+rename list l.new
+set a [catch list msg1]
+set b [l.new a b c]
+rename l.new list
+set c [catch l.new msg2]
+set d [list 111 222]
+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}}
+
+test rename-3.1 {error conditions} {
+    list [catch {rename r1} msg] $msg $errorCode
+} {1 {wrong # args: should be "rename oldName newName"} NONE}
+test rename-3.2 {error conditions} {
+    list [catch {rename r1 r2 r3} msg] $msg $errorCode
+} {1 {wrong # args: should be "rename oldName newName"} NONE}
+test rename-3.3 {error conditions} {
+    proc r1 {} {}
+    proc r2 {} {}
+    list [catch {rename r1 r2} msg] $msg
+} {1 {can't rename to "r2": command already exists}}
+test rename-3.4 {error conditions} {
+    catch {rename r1 {}}
+    catch {rename r2 {}}
+    list [catch {rename r1 r2} msg] $msg
+} {1 {can't rename "r1": command doesn't exist}}
+test rename-3.5 {error conditions} {
+    catch {rename _non_existent_command {}}
+    list [catch {rename _non_existent_command {}} msg] $msg
+} {1 {can't delete "_non_existent_command": command doesn't exist}}
+
+catch {rename unknown {}}
+catch {rename unknown.old unknown}
+
+if {[info command testdel] == "testdel"} {
+    test rename-4.1 {reentrancy issues with command deletion and renaming} {
+	set x {}
+	testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]}
+	rename foo bar
+	lappend x |
+	rename bar {}
+	set x
+    } {| deleted {}}
+    test rename-4.2 {reentrancy issues with command deletion and renaming} {
+	set x {}
+	testdel {} foo {lappend x deleted; rename foo bar}
+	rename foo {}
+	set x
+    } {deleted}
+    test rename-4.3 {reentrancy issues with command deletion and renaming} {
+	set x {}
+	testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}}
+	rename foo {}
+	lappend x |
+	rename foo {}
+	set x
+    } {deleted | deleted2}
+    test rename-4.4 {reentrancy issues with command deletion and renaming} {
+	set x {}
+	testdel {} foo {lappend x deleted; rename foo bar}
+	rename foo {}
+	lappend x | [info command bar]
+    } {deleted | {}}
+    test rename-4.5 {reentrancy issues with command deletion and renaming} {
+	set env(value) before
+	interp create foo
+	testdel foo cmd {set env(value) deleted}
+	interp delete foo
+	set env(value)
+    } {deleted}
+    test rename-4.6 {reentrancy issues with command deletion and renaming} {
+	proc kill args {
+	    interp delete foo
+	}
+	set env(value) before
+	interp create foo
+	foo alias kill kill
+	testdel foo cmd {set env(value) deleted; kill}
+	list [catch {foo eval {rename cmd {}}} msg] $msg $env(value)
+    } {0 {} deleted}
+    test rename-4.7 {reentrancy issues with command deletion and renaming} {
+	proc kill args {
+	    interp delete foo
+	}
+	set env(value) before
+	interp create foo
+	foo alias kill kill
+	testdel foo cmd {set env(value) deleted; kill}
+	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/tcl/tests/resource.test b/tcl/tests/resource.test
new file mode 100644
index 00000000000..78005f2d4a8
--- /dev/null
+++ b/tcl/tests/resource.test
@@ -0,0 +1,352 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+# 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, delete, files, 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 {file does not exist}}
+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
+    file delete rsrc.file
+} {}
+test resource-2.6 {resource open & close tests} {
+    catch {file delete rsrc.file}
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {A test string}
+    set id [resource open rsrc.file]
+    set result [string compare [resource open rsrc.file] $id]
+    lappend result [resource read TEXT fileRsrcName $id]
+    resource close $id
+    file delete rsrc.file
+    set result
+} {0 {A test string}}
+test resource-2.7 {resource open & close tests} {
+    catch {file delete rsrc.file}
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
+    set id [resource open rsrc.file r]
+    set result [catch {resource open rsrc.file w} mssg]
+    resource close $id
+    file delete rsrc.file
+    lappend result $mssg
+    set result
+} {1 {Resource already open with different permissions.}}
+test resource-2.8 {resource open & close tests} {
+    list [catch {resource close} msg] $msg
+} {1 {wrong # args: should be "resource close resourceRef"}}
+test resource-2.9 {resource open & close tests} {
+    list [catch {resource close foo bar} msg] $msg
+} {1 {wrong # args: should be "resource close resourceRef"}}
+test resource-2.10 {resource open & close tests} {
+    list [catch {resource close _bad_resource_} msg] $msg
+} {1 {invalid resource file reference "_bad_resource_"}}
+test resource-2.11 {resource open & close tests} {
+    set result [catch {resource close System} mssg]
+    lappend result $mssg
+} {1 {can't close "System" resource file}}
+test resource-2.12 {resource open & close tests} {
+    set result [catch {resource close application} mssg]
+    lappend result $mssg
+} {1 {can't close "application" resource file}}
+
+# Tests for listing resources
+test resource-3.1 {resource list tests} {
+    list [catch {resource list} msg] $msg
+} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
+test resource-3.2 {resource list tests} {
+    list [catch {resource list _bad_type_} msg] $msg
+} {1 {expected Macintosh OS type but got "_bad_type_"}}
+test resource-3.3 {resource list tests} {
+    list [catch {resource list TEXT _bad_ref_} msg] $msg
+} {1 {invalid resource file reference "_bad_ref_"}}
+test resource-3.4 {resource list tests} {
+    list [catch {resource list TEXT _bad_ref_ extraArg} msg] $msg
+} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
+test resource-3.5 {resource list tests} {
+    catch {file delete rsrc.file}
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
+    set id [resource open rsrc.file]
+    catch "resource list TEXT $id" result
+    resource close $id
+    set result
+} {fileRsrcName}
+test resource-3.6 {resource list tests} {
+    # There should not be any resource of this type
+    resource list XXXX
+} {}
+test resource-3.7 {resource list tests} {
+    set resourceList [resource list STR#]
+    if {[lsearch $resourceList {Tcl Environment Variables}] == -1} {
+        set result {couldn't find resource that should exist}
+    } else {
+        set result ok
+    }
+} {ok}
+
+# Tests for reading resources
+test resource-4.1 {resource read tests} {
+    list [catch {resource read} msg] $msg
+} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
+test resource-4.2 {resource read tests} {
+    list [catch {resource read TEXT} msg] $msg
+} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
+test resource-4.3 {resource read tests} {
+    list [catch {resource read STR# {_non_existant_resource_}} msg] $msg
+} {1 {could not load resource}}
+test resource-4.4 {resource read tests} {
+    # The following resource should exist and load OK without error
+    catch {resource read STR# {Tcl Environment Variables}}
+} {0}
+
+# Tests for getting resource types
+test resource-5.1 {resource types tests} {
+    list [catch {resource types _bad_ref_} msg] $msg
+} {1 {invalid resource file reference "_bad_ref_"}}
+test resource-5.2 {resource types tests} {
+    list [catch {resource types _bad_ref_ extraArg} msg] $msg
+} {1 {wrong # args: should be "resource types ?resourceRef?"}}
+test resource-5.3 {resource types tests} {
+    # This should never cause an error
+    catch {resource types}
+} {0}
+test resource-5.4 {resource types tests} {
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
+    set id [resource open rsrc.file]
+    set result [resource types $id]
+    resource close $id
+    set result
+} {TEXT}
+
+# resource write tests
+test resource-6.1 {resource write tests} {
+    list [catch {resource write} msg] $msg
+} {1 {wrong # args: should be "resource write ?-id resourceId? ?-name resourceName? ?-file resourceRef? ?-force? resourceType data"}}
+test resource-6.2 {resource write tests} {
+    list [catch {resource write _bad_type_ data} msg] $msg
+} {1 {expected Macintosh OS type but got "_bad_type_"}}
+test resource-6.3 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource close $id
+    set id [resource open rsrc2.file r]
+    set result [catch {resource write -file $id -name Hello TEXT foo} errMsg]
+    lappend result [string compare $errMsg "cannot write to resource file \"$id\", it was opened read only"]
+    lappend result [lsearch [resource list TEXT $id] Hello]
+    resource close $id
+    file delete rsrc2.file
+    set result   
+} {1 0 -1}
+test resource-6.4 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -name Hello TEXT {set x "our test data"}
+    source -rsrc Hello rsrc2.file
+    resource close $id
+    file delete rsrc2.file
+    set x
+} {our test data}
+test resource-6.5 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -id 256 TEXT {HAHAHAHAHAHAHA}
+    set result [catch {resource write -file $id -id 256 TEXT {HOHOHOHOHOHO}} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {the resource 256 already exists, use "-force" to overwrite it.}}
+test resource-6.6 {resource write tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 256  -file rsrc2.file  -protected {error "don't tread on me"}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource write -id 256 -force -file $id TEXT {NAHNAHNANAHNAH}} mssg] 
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {could not write resource id 256 of type TEXT, it was protected.}}
+test resource-6.7 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -id 256 -name FOO TEXT {set x [list "our first test data"]}
+    resource write -file $id -id 256 -name BAR -force TEXT {set x [list "our second test data"]}
+    source -rsrcid 256 rsrc2.file
+    lappend x [resource list TEXT $id]
+    resource close $id
+    file delete rsrc2.file
+    set x
+} {{our second test data} BAR}
+
+#Tests for listing open resource files
+test resource-7.1 {resource file tests} {
+    catch {resource files foo bar} mssg
+    set mssg
+} {wrong # args: should be "resource files ?resourceId?"}
+test resource-7.2 {resource file tests} {
+    catch {file delete rsrc2.file}
+    set rsrcFiles [resource files]
+    set id [resource open rsrc2.file w]
+    set result [string compare $rsrcFiles [lrange [resource files] 1 end]]
+    lappend result [string compare $id [lrange [resource files] 0 0]]
+    resource close $id
+    file delete rsrc2.file
+    set result
+} {0 0}
+test resource-7.3 {resource file tests} {
+    set result 0
+    foreach file [resource files] {
+        if {[catch {resource types $file}] != 0} {
+            set result 1
+        }
+    }
+    set result
+} {0}
+test resource-7.4 {resource file tests} {
+    catch {resource files __NO_SUCH_RESOURCE__} mssg
+    set mssg
+} {invalid resource file reference "__NO_SUCH_RESOURCE__"}
+test resource-7.5 {resource file tests} {
+    set sys [resource files System]
+    string compare $sys [file join $env(SYS_FOLDER) System]
+} {0}
+test resource-7.6 {resource file tests} {
+    set app [resource files application]
+    string compare $app [info nameofexecutable]
+} {0}
+
+#Tests for the resource delete command
+test resource-8.1 {resource delete tests} {
+    list [catch {resource delete} msg] $msg
+} {1 {wrong # args: should be "resource delete ?-id resourceId? ?-name resourceName? ?-file resourceRef? resourceType"}}
+test resource-8.2 {resource delete tests} {
+    list [catch {resource delete TEXT} msg] $msg
+} {1 {you must specify either "-id" or "-name" or both to "resource delete"}}
+test resource-8.3 {resource delete tests} {
+    set result [catch {resource delete -file ffffff -id 128 TEXT} mssg]
+    lappend result $mssg    
+} {1 {invalid resource file reference "ffffff"}}    
+test resource-8.4 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
+    set id [resource open rsrc2.file r]
+    set result [catch {resource delete -id 128 -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result [string compare $mssg "cannot delete from resource file \"$id\", it was opened read only"]   
+} {1 0}
+test resource-8.5 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -id 128 -file $id _bad_type_} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {expected Macintosh OS type but got "_bad_type_"}}
+test resource-8.5 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -id 128 -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {resource not found}}
+test resource-8.6 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -name foo -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {resource not found}}
+test resource-8.7 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -name foo -id 128 TEXT {some stuff}
+    resource write -file $id -name bar -id 129 TEXT {some stuff}
+    set result [catch {resource delete -name foo -id 129 -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {"-id" and "-name" values do not point to the same resource}}
+test resource-8.8 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 256  -file rsrc2.file  -protected {error "don't tread on me"}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -id 256 -file $id TEXT } mssg] 
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {resource cannot be deleted: it is protected.}}
+test resource-8.9 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
+    set id [resource open rsrc2.file w]
+    set result [resource list TEXT $id]
+    resource delete -id 128 -file $id TEXT
+    lappend result [resource list TEXT $id]
+    resource close $id
+    file delete rsrc2.file
+    set result
+} {fileRsrcName {}}
+    
+# 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-9.1 {source command} {
+    catch {unset rsrc_foo}
+    source -rsrc fileRsrcName rsrc.file
+    list [catch {set rsrc_foo} msg] $msg
+} {0 1}
+test resource-9.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-9.3 {source command} {
+    catch {unset rsrc_foo}
+    source -rsrcid 128 rsrc.file
+    list [catch {set rsrc_foo} msg] $msg
+} {0 1}
+test resource-9.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-9.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/tcl/tests/safe.test b/tcl/tests/safe.test
new file mode 100644
index 00000000000..bf053eae03c
--- /dev/null
+++ b/tcl/tests/safe.test
@@ -0,0 +1,436 @@
+# safe.test --
+#
+# This file contains a collection of tests for safe Tcl, packages loading,
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+foreach i [interp slaves] {
+  interp delete $i
+}
+
+# Force actual loading of the safe package 
+# because we use un exported (and thus un-autoindexed) APIs
+# in this test result arguments:
+catch {safe::interpConfigure}
+
+proc equiv {x} {return $x}
+
+test safe-1.1 {safe::interpConfigure syntax} {
+    list [catch {safe::interpConfigure} msg] $msg;
+} {1 {no value given for parameter "slave" (use -help for full usage) :
+    slave name () name of the slave}}
+
+test safe-1.2 {safe::interpCreate syntax} {
+    list [catch {safe::interpCreate -help} msg] $msg;
+} {1 {Usage information:
+    Var/FlagName  Type     Value   Help
+    ------------  ----     -----   ----
+    ( -help                        gives this help )
+    ?slave?       name     ()      name of the slave (optional)
+    -accessPath   list     ()      access path for the slave
+    -noStatics    boolflag (false) prevent loading of statically linked pkgs
+    -statics      boolean  (true)  loading of statically linked pkgs
+    -nestedLoadOk boolflag (false) allow nested loading
+    -nested       boolean  (false) nested loading
+    -deleteHook   script   ()      delete hook}}
+
+test safe-1.3 {safe::interpInit syntax} {
+    list [catch {safe::interpInit -noStatics} msg] $msg;
+} {1 {bad value "-noStatics" for parameter
+    slave name () name of the slave}}
+
+
+test safe-2.1 {creating interpreters, should have no aliases} {
+    interp aliases
+} ""
+test safe-2.2 {creating interpreters, should have no aliases} {
+    catch {safe::interpDelete a}
+    interp create a
+    set l [a aliases]
+    safe::interpDelete a
+    set l
+} ""
+test safe-2.3 {creating safe interpreters, should have no aliases} {
+    catch {safe::interpDelete a}
+    interp create a -safe
+    set l [a aliases]
+    interp delete a
+    set l
+} ""
+
+test safe-3.1 {calling safe::interpInit is safe} {
+    catch {safe::interpDelete a}
+    interp create a -safe 
+    safe::interpInit a
+    catch {interp eval a exec ls} msg
+    safe::interpDelete a
+    set msg
+} {invalid command name "exec"}
+test safe-3.2 {calling safe::interpCreate on trusted interp} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    set l [lsort [a aliases]]
+    safe::interpDelete a
+    set l
+} {exit file load source}
+test safe-3.3 {calling safe::interpCreate on trusted interp} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    set x [interp eval a {source [file join $tcl_library init.tcl]}]
+    safe::interpDelete a
+    set x
+} ""
+test safe-3.4 {calling safe::interpCreate on trusted interp} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    catch {set x \
+		[interp eval a {source [file join $tcl_library init.tcl]}]} msg
+    safe::interpDelete a
+    list $x $msg
+} {{} {}}
+
+test safe-4.1 {safe::interpDelete} {
+    catch {safe::interpDelete a}
+    interp create a
+    safe::interpDelete a
+} ""
+test safe-4.2 {safe::interpDelete, indirectly} {
+    catch {safe::interpDelete a}
+    interp create a
+    a alias exit safe::interpDelete a
+    a eval exit
+} ""
+test safe-4.3 {safe::interpDelete, state array (not a public api)} {
+    catch {safe::interpDelete a}
+    namespace eval safe {set [InterpStateName a](foo) 33}
+    # not an error anymore to call it if interp is already
+    # deleted, to make trhings smooth if it's called twice...
+    catch {safe::interpDelete a} m1
+    catch {namespace eval safe {set [InterpStateName a](foo)}} m2
+    list $m1 $m2
+} "{}\
+   {can't read \"[safe::InterpStateName a]\": no such variable}"
+
+
+test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    namespace eval safe {set [InterpStateName a](foo) 33}
+    a eval exit
+    catch {namespace eval safe {set [InterpStateName a](foo)}} msg
+} 1
+
+test safe-4.5 {safe::interpDelete} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    catch {safe::interpCreate a} msg
+    set msg
+} {interpreter named "a" already exists, cannot create}
+test safe-4.6 {safe::interpDelete, indirectly} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    a eval exit
+} ""
+
+# The following test checks whether the definition of tcl_endOfWord can be
+# obtained from auto_loading.
+
+test safe-5.1 {test auto-loading in safe interpreters} {
+    catch {safe::interpDelete a}
+    safe::interpCreate a
+    set r [catch {interp eval a {tcl_endOfWord "" 0}} msg]
+    safe::interpDelete a
+    list $r $msg
+} {0 -1}
+
+# test safe interps 'information leak'
+proc SI {} {
+    global I
+    set I [interp create -safe];
+}
+proc DI {} {
+    global I;
+    interp delete $I;
+}
+test safe-6.1 {test safe interpreters knowledge of the world} {
+    SI; set r [lsort [$I eval {info globals}]]; DI; set r
+} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
+test safe-6.2 {test safe interpreters knowledge of the world} {
+    SI; set r [$I eval {info script}]; DI; set r
+} {}
+test safe-6.3 {test safe interpreters knowledge of the world} {pcOnly} {
+    SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r
+} {byteOrder debug platform}
+test safe-6.3 {test safe interpreters knowledge of the world} {macOrUnix} {
+    SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r
+} {byteOrder platform}
+
+# more test should be added to check that hostname, nameofexecutable,
+# aren't leaking infos, but they still do...
+
+# high level general test
+test safe-7.1 {tests that everything works at high level} {
+    set i [safe::interpCreate];
+    # no error shall occur:
+    # (because the default access_path shall include 1st level sub dirs
+    #  so package require in a slave works like in the master)
+    set v [interp eval $i {package require http 1}]
+    # no error shall occur:
+    interp eval $i {http_config};
+    safe::interpDelete $i
+    set v
+} 1.0
+
+test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
+    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
+    # should not add anything (p0)
+    set token1 [safe::interpAddToAccessPath $i [info library]]
+    # should add as p1
+    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"];
+    # an error shall occur (http is not anymore in the secure 0-level
+    # provided deep path)
+    list $token1 $token2 \
+	    [catch {interp eval $i {package require http 1}} msg] $msg \
+	    [safe::interpConfigure $i]\
+	    [safe::interpDelete $i]
+} "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
+
+
+# test source control on file name
+test safe-8.1 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    list  [catch {$i eval {source}} msg] \
+	    $msg \
+	    [safe::interpDelete $i] ;
+} {1 {wrong # args: should be "source fileName"} {}}
+
+# test source control on file name
+test safe-8.2 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    list  [catch {$i eval {source}} msg] \
+	    $msg \
+	    [safe::interpDelete $i] ;
+} {1 {wrong # args: should be "source fileName"} {}}
+
+test safe-8.3 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    set log {};
+    proc safe-test-log {str} {global log; lappend log $str}
+    set prevlog [safe::setLogCmd];
+    safe::setLogCmd safe-test-log;
+    list  [catch {$i eval {source .}} msg] \
+	    $msg \
+	    $log \
+	    [safe::setLogCmd $prevlog; unset log] \
+	    [safe::interpDelete $i] ;
+} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}}
+
+
+test safe-8.4 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    set log {};
+    proc safe-test-log {str} {global log; lappend log $str}
+    set prevlog [safe::setLogCmd];
+    safe::setLogCmd safe-test-log;
+    list  [catch {$i eval {source /abc/def}} msg] \
+	    $msg \
+	    $log \
+	    [safe::setLogCmd $prevlog; unset log] \
+	    [safe::interpDelete $i] ;
+} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}}
+
+
+test safe-8.5 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    set log {};
+    proc safe-test-log {str} {global log; lappend log $str}
+    set prevlog [safe::setLogCmd];
+    safe::setLogCmd safe-test-log;
+    list  [catch {$i eval {source [file join [info lib] blah]}} msg] \
+	    $msg \
+	    $log \
+	    [safe::setLogCmd $prevlog; unset log] \
+	    [safe::interpDelete $i] ;
+} "1 {blah: must be a *.tcl or tclIndex} {{ERROR for slave a : [file join [info library] blah]:blah: must be a *.tcl or tclIndex}} {} {}"
+
+
+test safe-8.6 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    set log {};
+    proc safe-test-log {str} {global log; lappend log $str}
+    set prevlog [safe::setLogCmd];
+    safe::setLogCmd safe-test-log;
+    list  [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \
+	    $msg \
+	    $log \
+	    [safe::setLogCmd $prevlog; unset log] \
+	    [safe::interpDelete $i] ;
+} "1 {no such file or directory} {{ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory}} {} {}"
+
+
+test safe-8.7 {safe source control on file} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    set log {};
+    proc safe-test-log {str} {global log; lappend log $str}
+    set prevlog [safe::setLogCmd];
+    safe::setLogCmd safe-test-log;
+    list  [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\
+		 msg] \
+	    $msg \
+	    $log \
+	    [safe::setLogCmd $prevlog; unset log] \
+	    [safe::interpDelete $i] ;
+} "1 {xxxxxxxxxxx.tcl: filename too long} {{ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:xxxxxxxxxxx.tcl: filename too long}} {} {}"
+
+test safe-8.8 {safe source forbids -rsrc} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i;
+    list  [catch {$i eval {source -rsrc Init}} msg] \
+	    $msg \
+	    [safe::interpDelete $i] ;
+} {1 {wrong # args: should be "source fileName"} {}}
+
+
+test safe-9.1 {safe interps' deleteHook} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    set res {}
+    proc testDelHook {args} {
+	global res;
+	# the interp still exists at that point
+	interp eval a {set delete 1}
+	# mark that we've been here (successfully)
+	set res $args;
+    }
+    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
+    list [interp eval $i exit] $res
+} {{} {arg1 arg2 a}}
+
+test safe-9.2 {safe interps' error in deleteHook} {
+    set i "a";
+    catch {safe::interpDelete $i}
+    set res {}
+    proc testDelHook {args} {
+	global res;
+	# the interp still exists at that point
+	interp eval a {set delete 1}
+	# mark that we've been here (successfully)
+	set res $args;
+	# create an exception
+	error "being catched";
+    }
+    set log {};
+    proc safe-test-log {str} {global log; lappend log $str}
+    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
+    set prevlog [safe::setLogCmd];
+    safe::setLogCmd safe-test-log;
+    list  [safe::interpDelete $i] $res \
+	    $log \
+	    [safe::setLogCmd $prevlog; unset log];
+} {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
+
+
+test safe-9.3 {dual specification of statics} {
+    list [catch {safe::interpCreate -stat true -nostat} msg] $msg
+} {1 {conflicting values given for -statics and -noStatics}}
+
+test safe-9.4 {dual specification of statics} {
+    # no error shall occur
+    safe::interpDelete [safe::interpCreate -stat false -nostat]
+} {}
+
+test safe-9.5 {dual specification of nested} {
+    list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
+} {1 {conflicting values given for -nested and -nestedLoadOk}}
+
+test safe-9.6 {interpConfigure widget like behaviour} {
+   # this test shall work, don't try to "fix it" unless
+   # you *really* know what you are doing (ie you are me :p) -- dl
+   list [set i [safe::interpCreate \
+	                           -noStatics \
+                                   -nestedLoadOk \
+	                           -deleteHook {foo bar}];
+         safe::interpConfigure $i -accessPath /foo/bar ;
+         safe::interpConfigure $i]\
+	[safe::interpConfigure $i -aCCess]\
+	[safe::interpConfigure $i -nested]\
+	[safe::interpConfigure $i -statics]\
+	[safe::interpConfigure $i -DEL]\
+	[safe::interpConfigure $i -accessPath /blah -statics 1;
+	 safe::interpConfigure $i]\
+	[safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
+	 safe::interpConfigure $i]
+} {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}}
+
+
+# testing that nested and statics do what is advertised
+# (we use a static package : Tcltest)
+
+if {[catch {package require Tcltest} msg]} {
+    puts "This application hasn't been compiled with Tcltest"
+    puts "skipping remining safe test that relies on it."
+} else {
+
+    # we use the Tcltest package , which has no Safe_Init
+
+test safe-10.1 {testing statics loading} {
+    set i [safe::interpCreate]
+    list \
+	    [catch {interp eval $i {load {} Tcltest}} msg] \
+	    $msg \
+            [safe::interpDelete $i];
+} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
+
+test safe-10.2 {testing statics loading / -nostatics} {
+    set i [safe::interpCreate -nostatics]
+    list \
+	    [catch {interp eval $i {load {} Tcltest}} msg] \
+	    $msg \
+            [safe::interpDelete $i];
+} {1 {permission denied (static package)} {}}
+
+
+
+test safe-10.3 {testing nested statics loading / no nested by default} {
+    set i [safe::interpCreate]
+    list \
+	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
+	    $msg \
+            [safe::interpDelete $i];
+} {1 {permission denied (nested load)} {}}
+
+
+test safe-10.4 {testing nested statics loading / -nestedloadok} {
+    set i [safe::interpCreate -nestedloadok]
+    list \
+	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
+	    $msg \
+            [safe::interpDelete $i];
+} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
+
+
+}
diff --git a/tcl/tests/scan.test b/tcl/tests/scan.test
new file mode 100644
index 00000000000..21524ba1b97
--- /dev/null
+++ b/tcl/tests/scan.test
@@ -0,0 +1,246 @@
+# Commands covered:  scan
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test scan-1.1 {integer scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
+} {4 -20 1476 33 0}
+test scan-1.2 {integer scanning} {
+    set a {}; set b {}; set c {}
+    list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c
+} {3 -4 16 7890}
+test scan-1.3 {integer scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d
+} {4 -45 16 10 987}
+test scan-1.4 {integer scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d
+} {4 14 427 50 16}
+test scan-1.5 {integer scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "12345670 1234567890ab cdefg" "%o	 %o %x %lx" a b c d] \
+	    $a $b $c $d
+} {4 2739128 342391 561323 52719}
+test scan-1.6 {integer scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d
+} {4 171 291 -20 52}
+test scan-1.7 {integer scanning} {
+    set a {}; set b {}
+    list [scan "1234567 234 567  " "%*3x %x %*o %4o" a b] $a $b
+} {2 17767 375}
+test scan-1.8 {integer scanning} {
+    set a {}; set b {}
+    list [scan "a	1234" "%d %d" a b] $a $b
+} {0 {} {}}
+test scan-1.9 {integer scanning} {
+    set a {}; set b {}; set c {}; set d {};
+    list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d
+} {4 12 34 56 78}
+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
+} {2 4294967280 -16}
+
+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
+} {3 2.1 -300000000.0 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}
+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}
+test scan-2.6 {floating-point scanning} {eformat} {
+    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}
+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
+} {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
+} {2 4.6 5.2 {} {}}
+
+test scan-3.1 {string and character scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
+} {4 abc def ghijk dum}
+test scan-3.2 {string and character scanning} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "a       bcdef" "%c%c%1s %s" a b c d] $a $b $c $d
+} {4 97 32 b cdef}
+test scan-3.3 {string and character scanning} {
+    set a {}; set b {}; set c {}
+    list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c
+} {1 test {} {}}
+test scan-3.4 {string and character scanning} {
+    set a {}; set b {}; set c {}; set d
+    list [scan "ababcd01234  f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d
+} {4 abab cd {01234  } {f 12345}}
+test scan-3.5 {string and character scanning} {
+    set a {}; set b {}; set c {}
+    list [scan "aaaaaabc aaabcdefg  + +  XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
+} {3 aabc bcdefg 43}
+
+test scan-4.1 {error conditions} {
+    catch {scan a}
+} 1
+test scan-4.2 {error conditions} {
+    catch {scan a} msg
+    set msg
+} {wrong # args: should be "scan string format ?varName varName ...?"}
+test scan-4.3 {error conditions} {
+    catch {scan "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21}
+} 1
+test scan-4.4 {error conditions} {
+    catch {scan "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21} msg
+    set msg
+} {too many fields to scan}
+test scan-4.5 {error conditions} {
+    list [catch {scan a %D} msg] $msg
+} {1 {bad scan conversion character "D"}}
+test scan-4.6 {error conditions} {
+    list [catch {scan a %O} msg] $msg
+} {1 {bad scan conversion character "O"}}
+test scan-4.7 {error conditions} {
+    list [catch {scan a %X} msg] $msg
+} {1 {bad scan conversion character "X"}}
+test scan-4.8 {error conditions} {
+    list [catch {scan a %F} msg] $msg
+} {1 {bad scan conversion character "F"}}
+test scan-4.9 {error conditions} {
+    list [catch {scan a %E} msg] $msg
+} {1 {bad scan conversion character "E"}}
+test scan-4.10 {error conditions} {
+    list [catch {scan a "%d %d" a} msg] $msg
+} {1 {different numbers of variable names and field specifiers}}
+test scan-4.11 {error conditions} {
+    list [catch {scan a "%d %d" a b c} msg] $msg
+} {1 {different numbers of variable names and field specifiers}}
+test scan-4.12 {error conditions} {
+    set a {}; set b {}; set c {}; set d {}
+    list [expr {[scan "  a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d
+} {1 {} {} {} {}}
+test scan-4.13 {error conditions} {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
+} {2 1 2 {} {}}
+test scan-4.14 {error conditions} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {scan 44 %d a} msg] $msg
+} {1 {couldn't set variable "a"}}
+test scan-4.15 {error conditions} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {scan 44 %c a} msg] $msg
+} {1 {couldn't set variable "a"}}
+test scan-4.16 {error conditions} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {scan 44 %s a} msg] $msg
+} {1 {couldn't set variable "a"}}
+test scan-4.17 {error conditions} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {scan 44 %f a} msg] $msg
+} {1 {couldn't set variable "a"}}
+test scan-4.18 {error conditions} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {scan 44 %f a} msg] $msg
+} {1 {couldn't set variable "a"}}
+catch {unset a}
+test scan-4.19 {error conditions} {
+    list [catch {scan 44 %2c a} msg] $msg
+} {1 {field width may not be specified in %c conversion}}
+test scan-4.20 {error conditions} {
+    list [catch {scan abc {%[}} msg] $msg
+} {1 {unmatched [ in format string}}
+
+test scan-5.1 {lots of arguments} {
+    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
+} 20
+test scan-5.2 {lots of arguments} {
+    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
+    set a20
+} 200
+
+test scan-6.1 {miscellaneous tests} {
+    set a {}
+    list [scan ab16c ab%dc a] $a
+} {1 16}
+test scan-6.2 {miscellaneous tests} {
+    set a {}
+    list [scan ax16c ab%dc a] $a
+} {0 {}}
+test scan-6.3 {miscellaneous tests} {
+    set a {}
+    list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a
+} {0 1 114}
+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-7.1 {alignment in results array (TCL_ALIGN)} {
+    scan "123 13.6" "%s %f" a b
+    set b
+} 13.6
+test scan-7.2 {alignment in results array (TCL_ALIGN)} {
+    scan "1234567 13.6" "%s %f" a b
+    set b
+} 13.6
+test scan-7.3 {alignment in results array (TCL_ALIGN)} {
+    scan "12345678901 13.6" "%s %f" a b
+    set b
+} 13.6
+test scan-7.4 {alignment in results array (TCL_ALIGN)} {
+    scan "123456789012345 13.6" "%s %f" a b
+    set b
+} 13.6
+test scan-7.5 {alignment in results array (TCL_ALIGN)} {
+    scan "1234567890123456789 13.6" "%s %f" a b
+    set b
+} 13.6
diff --git a/tcl/tests/set-old.test b/tcl/tests/set-old.test
new file mode 100644
index 00000000000..301d7eafc6f
--- /dev/null
+++ b/tcl/tests/set-old.test
@@ -0,0 +1,794 @@
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+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": must 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, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array anymore a x]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.9 {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.10 {array command, donesearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array donesearch a x]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.11 {array command, exists option} {
+    list [catch {array exists a b} msg] $msg
+} {1 {wrong # args: should be "array exists arrayName"}}
+test set-old-8.12 {array command, exists option} {
+    catch {unset a}
+    array exists a
+} {0}
+test set-old-8.13 {array command, exists option} {
+    catch {unset a}
+    set a(0) 1
+    array exists a
+} {1}
+test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array exists a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 0}
+test set-old-8.15 {array command, get option} {
+    list [catch {array get} msg] $msg
+} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+test set-old-8.16 {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.17 {array command, get option} {
+    catch {unset a}
+    array get a
+} {}
+test set-old-8.18 {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.19 {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.20 {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.21 {array command, get option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array get a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 {}}
+test set-old-8.22 {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.23 {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.24 {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.25 {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.26 {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.27 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array names a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 {}}
+test set-old-8.28 {array command, nextelement option} {
+    list [catch {array nextelement a} msg] $msg
+} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
+test set-old-8.29 {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.30 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array nextelement a b]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.31 {array command, set option} {
+    list [catch {array set a} msg] $msg
+} {1 {wrong # args: should be "array set arrayName list"}}
+test set-old-8.32 {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.33 {array command, set option} {
+    list [catch {array set a "a \{ c"} msg] $msg
+} {1 {unmatched open brace in list}}
+test set-old-8.34 {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.35 {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.36 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array set a {x 0}]
+        }
+        set a(x)
+    }
+    list [catch {foo 1} msg] $msg
+} {0 {}}
+test set-old-8.37 {array command, set option} {
+    catch {unset aVaRnAmE}
+    array set aVaRnAmE {}
+    list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg
+} {1 1 {can't read "aVaRnAmE": variable is array}}
+test set-old-8.37.1 {array command, set scalar} {
+    catch {unset aVaRnAmE}
+    set aVaRnAmE 1
+    list [catch {array set aVaRnAmE {}} msg] $msg
+} {1 {can't array set "aVaRnAmE": variable isn't array}}
+test set-old-8.37.2 {array command, set alias} {
+    catch {unset aVaRnAmE}
+    upvar 0 aVaRnAmE anAliAs
+    array set anAliAs {}
+    list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg
+} {1 1 {can't read "anAliAs": variable is array}}
+test set-old-8.37.3 {array command, set element alias} {
+    catch {unset aVaRnAmE}
+    list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \
+	    [catch {array set elemAliAs {}} msg] $msg
+} {0 1 {can't array set "elemAliAs": variable isn't array}}
+test set-old-8.37.4 {array command, empty set with populated array} {
+    catch {unset aVaRnAmE}
+    array set aVaRnAmE [list e1 v1 e2 v2]
+    array set aVaRnAmE {}
+    array set aVaRnAmE [list e3 v3]
+    list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
+} {{e1 e2 e3} 0 v2}
+test set-old-8.38 {array command, size option} {
+    catch {unset a}
+    array size a
+} {0}
+test set-old-8.39 {array command, size option} {
+    list [catch {array size a 4} msg] $msg
+} {1 {wrong # args: should be "array size arrayName"}}
+test set-old-8.40 {array command, size option} {
+    catch {unset a}
+    array size a
+} {0}
+test set-old-8.41 {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.42 {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.43 {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.44 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array size a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 0}
+test set-old-8.45 {array command, startsearch option} {
+    list [catch {array startsearch a b} msg] $msg
+} {1 {wrong # args: should be "array startsearch arrayName"}}
+test set-old-8.46 {array command, startsearch option} {
+    catch {unset a}
+    list [catch {array startsearch a} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.47 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    catch {rename p ""}
+    proc p {x} {
+        if {$x==1} {
+            return [array startsearch a]
+        }
+        set a(x) 123
+    }
+    list [catch {p 1} 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}
+catch {unset aVaRnAmE}
+return ""
diff --git a/tcl/tests/set.test b/tcl/tests/set.test
new file mode 100644
index 00000000000..01427d04747
--- /dev/null
+++ b/tcl/tests/set.test
@@ -0,0 +1,233 @@
+# 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) 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+catch {unset x}
+catch {unset i}
+
+test set-1.1 {TclCompileSetCmd: missing variable name} {
+    list [catch {set} msg] $msg
+} {1 {wrong # args: should be "set varName ?newValue?"}}
+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 x 27
+    set x [set a(foo) 11]
+    catch {unset a}
+    set x
+} 11
+test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
+    catch {unset a}
+    set i 5
+    set x 789
+    set a(foo5) 27
+    set x [set a(foo$i)]
+    catch {unset a}
+    set x
+} 27
+
+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-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}}
+
+catch {unset a}
+catch {unset b}
+catch {unset i}
+catch {unset x}
+return ""
diff --git a/tcl/tests/socket.test b/tcl/tests/socket.test
new file mode 100644
index 00000000000..438e1e171a6
--- /dev/null
+++ b/tcl/tests/socket.test
@@ -0,0 +1,1381 @@
+# Commands tested in this file: socket.
+#
+# 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) 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.
+#
+# Running socket tests with a remote server:
+# ------------------------------------------
+# 
+# Some tests in socket.test depend on the existence of a remote server to
+# which they connect. The remote server must be an instance of tcltest and it
+# must run the script found in the file "remote.tcl" in this directory. You
+# can start the remote server on any machine reachable from the machine on
+# which you want to run the socket tests, by issuing:
+# 
+#     tcltest remote.tcl -port 2048	# Or choose another port number.
+# 
+# If the machine you are running the remote server on has several IP
+# interfaces, you can choose which interface the server listens on for
+# connections by specifying the -address command line flag, so:
+# 
+#     tcltest remote.tcl -address your.machine.com
+# 
+# These options can also be set by environment variables. On Unix, you can
+# type these commands to the shell from which the remote server is started:
+# 
+#     shell% setenv serverPort 2048
+#     shell% setenv serverAddress your.machine.com
+# 
+# and subsequently you can start the remote server with:
+# 
+#     tcltest remote.tcl
+# 
+# to have it listen on port 2048 on the interface your.machine.com.
+#     
+# When the server starts, it prints out a detailed message containing its
+# configuration information, and it will block until killed with a Ctrl-C.
+# Once the remote server exists, you can run the tests in socket.test with
+# the server by setting two Tcl variables:
+# 
+#     % set remoteServerIP <name or address of machine on which server runs>
+#     % set remoteServerPort 2048
+# 
+# These variables are also settable from the environment. On Unix, you can:
+# 
+#     shell% setenv remoteServerIP machine.where.server.runs
+#     shell% senetv remoteServerPort 2048
+# 
+# The preamble of the socket.test file checks to see if the variables are set
+# either in Tcl or in the environment; if they are, it attempts to connect to
+# the server. If the connection is successful, the tests using the remote
+# server will be performed; otherwise, it will attempt to start the remote
+# server (via exec) on platforms that support this, on the local host,
+# listening at port 2048. If all fails, a message is printed and the tests
+# using the remote server are not performed.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {$testConfig(socket) == 0} {
+    return
+}
+
+#
+# If remoteServerIP or remoteServerPort are not set, check in the
+# environment variables for externally set values.
+#
+
+if {![info exists remoteServerIP]} {
+    if {[info exists env(remoteServerIP)]} {
+	set remoteServerIP $env(remoteServerIP)
+    }
+}
+if {![info exists remoteServerPort]} {
+    if {[info exists env(remoteServerIP)]} {
+	set remoteServerPort $env(remoteServerPort)
+    } else {
+        if {[info exists remoteServerIP]} {
+	    set remoteServerPort 2048
+        }
+    }
+}
+
+#
+# Check if we're supposed to do tests against the remote server
+#
+
+set doTestsWithRemoteServer 1
+if {![info exists remoteServerIP] && ($tcl_platform(platform) != "macintosh")} {
+    set remoteServerIP localhost
+}
+if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
+    set remoteServerPort 2048
+}
+
+# Attempt to connect to a remote server if one is already running. If it
+# is not running or for some other reason the connect fails, attempt to
+# start the remote server on the local host listening on port 2048. This
+# is only done on platforms that support exec (i.e. not on the Mac). On
+# platforms that do not support exec, the remote server must be started
+# by the user before running the tests.
+
+set remoteProcChan ""
+set commandSocket ""
+if {$doTestsWithRemoteServer} {
+    catch {close $commandSocket}
+    if {[catch {set commandSocket [socket $remoteServerIP \
+						$remoteServerPort]}] != 0} {
+	if {[info commands exec] == ""} {
+	    set noRemoteTestReason "can't exec"
+	    set doTestsWithRemoteServer 0
+	} elseif {$testConfig(win32s)} {
+	    set noRemoteTestReason "\ncan't run multiple instances of tcltest under win32s."
+	    set doTestsWithRemoteServer 0
+	} else {
+	    set remoteServerIP localhost
+	    if {[catch {set remoteProcChan \
+				[open "|[list $tcltest remote.tcl \
+					-serverIsSilent \
+					-port $remoteServerPort \
+					-address $remoteServerIP]" \
+					w+]} \
+		   msg] == 0} {
+		after 1000
+		if {[catch {set commandSocket [socket $remoteServerIP \
+				$remoteServerPort]} msg] == 0} {
+		    fconfigure $commandSocket -translation crlf -buffering line
+		} else {
+		    set noRemoteTestReason $msg
+		    set doTestsWithRemoteServer 0
+		}
+	    } else {
+		set noRemoteTestReason "$msg $tcltest"
+		set doTestsWithRemoteServer 0
+	    }
+	}
+    } else {
+	fconfigure $commandSocket -translation crlf -buffering line
+    }
+}
+
+if {$doTestsWithRemoteServer == 0} {
+    puts "Skipping tests with remote server. See tests/socket.test for"
+    puts "information on how to run remote server."
+    if {[info exists VERBOSE] && ($VERBOSE != 0)} {
+	puts "Reason for not doing remote tests: $noRemoteTestReason"
+    }
+}
+
+#
+# If we do the tests, define a command to send a command to the
+# remote server.
+#
+
+if {$doTestsWithRemoteServer == 1} {
+    proc sendCommand {c} {
+	global commandSocket
+
+	if {[eof $commandSocket]} {
+	    error "remote server disappeared"
+	}
+
+	if {[catch {puts $commandSocket $c} msg]} {
+	    error "remote server disappaered: $msg"
+	}
+	if {[catch {puts $commandSocket "--Marker--Marker--Marker--"} msg]} {
+	    error "remote server disappeared: $msg"
+	}
+
+	set resp ""
+	while {1} {
+	    set line [gets $commandSocket]
+	    if {[eof $commandSocket]} {
+		error "remote server disappaered"
+	    }
+	    if {[string compare $line "--Marker--Marker--Marker--"] == 0} {
+		if {[string compare [lindex $resp 0] error] == 0} {
+		    error [lindex $resp 1]
+		} else {
+		    return [lindex $resp 1]
+		}
+	    } else {
+		append resp $line "\n"
+	    }
+	}
+    }
+}
+
+test socket-1.1 {arg parsing for socket command} {
+    list [catch {socket -server} msg] $msg
+} {1 {no argument given for -server option}}
+test socket-1.2 {arg parsing for socket command} {
+    list [catch {socket -server foo} msg] $msg
+} {1 {wrong # args: should be either:
+socket ?-myaddr addr? ?-myport myport? ?-async? host port
+socket -server command ?-myaddr addr? port}}
+test socket-1.3 {arg parsing for socket command} {
+    list [catch {socket -myaddr} msg] $msg
+} {1 {no argument given for -myaddr option}}
+test socket-1.4 {arg parsing for socket command} {
+    list [catch {socket -myaddr 127.0.0.1} msg] $msg
+} {1 {wrong # args: should be either:
+socket ?-myaddr addr? ?-myport myport? ?-async? host port
+socket -server command ?-myaddr addr? port}}
+test socket-1.5 {arg parsing for socket command} {
+    list [catch {socket -myport} msg] $msg
+} {1 {no argument given for -myport option}}
+test socket-1.6 {arg parsing for socket command} {
+    list [catch {socket -myport xxxx} msg] $msg
+} {1 {expected integer but got "xxxx"}}
+test socket-1.7 {arg parsing for socket command} {
+    list [catch {socket -myport 2522} msg] $msg
+} {1 {wrong # args: should be either:
+socket ?-myaddr addr? ?-myport myport? ?-async? host port
+socket -server command ?-myaddr addr? port}}
+test socket-1.8 {arg parsing for socket command} {
+    list [catch {socket -froboz} msg] $msg
+} {1 {bad option "-froboz", must be -async, -myaddr, -myport, or -server}}
+test socket-1.9 {arg parsing for socket command} {
+    list [catch {socket -server foo -myport 2521 3333} msg] $msg
+} {1 {Option -myport is not valid for servers}}
+test socket-1.10 {arg parsing for socket command} {
+    list [catch {socket host 2528 -junk} msg] $msg
+} {1 {wrong # args: should be either:
+socket ?-myaddr addr? ?-myport myport? ?-async? host port
+socket -server command ?-myaddr addr? port}}
+test socket-1.11 {arg parsing for socket command} {
+    list [catch {socket -server callback 2520 --} msg] $msg
+} {1 {wrong # args: should be either:
+socket ?-myaddr addr? ?-myport myport? ?-async? host port
+socket -server command ?-myaddr addr? port}}
+test socket-1.12 {arg parsing for socket command} {
+    list [catch {socket foo badport} msg] $msg
+} {1 {expected integer but got "badport"}}
+
+test socket-2.1 {tcp connection} {stdio} {
+    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
+	    set x done
+            close $file
+	}
+	puts ready
+	vwait x
+	after cancel $timer
+	close $f
+	puts $x
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f x
+    if {[catch {socket localhost 2828} msg]} {
+        set x $msg
+    } else {
+        lappend x [gets $f]
+        close $msg
+    }
+    lappend x [gets $f]
+    close $f
+    set x
+} {ready done {}}
+
+if [info exists port] {
+    incr port
+} else { 
+    set port [expr 2048 + [pid]%1024]
+}
+test socket-2.2 {tcp connection with client port specified} {stdio} {
+    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
+            puts "[gets $file] $port"
+            close $file
+            set x done
+	}
+	puts ready
+	vwait x
+	after cancel $timer
+	close $f
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f x
+    global port
+    if {[catch {socket -myport $port localhost 2828} sock]} {
+        set x $sock
+	close [socket localhost 2828]
+	puts stderr $sock
+    } else {
+        puts $sock hello
+	flush $sock
+        lappend x [gets $f]
+        close $sock
+    }
+    close $f
+    set x
+} [list ready "hello $port"]
+test socket-2.3 {tcp connection with client interface specified} {stdio} {
+    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
+            puts "[gets $file] $addr"
+            close $file
+            set x done
+	}
+	puts ready
+	vwait x
+	after cancel $timer
+	close $f
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f x
+    if {[catch {socket -myaddr localhost localhost 2828} sock]} {
+        set x $sock
+    } else {
+        puts $sock hello
+	flush $sock
+        lappend x [gets $f]
+        close $sock
+    }
+    close $f
+    set x
+} {ready {hello 127.0.0.1}}
+test socket-2.4 {tcp connection with server interface specified} {stdio} {
+    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
+            puts "[gets $file]"
+            close $file
+            set x done
+	}
+	puts ready
+	vwait x
+	after cancel $timer
+	close $f
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f x
+    if {[catch {socket [info hostname] 2828} sock]} {
+        set x $sock
+    } else {
+        puts $sock hello
+	flush $sock
+        lappend x [gets $f]
+        close $sock
+    }
+    close $f
+    set x
+} {ready hello}
+test socket-2.5 {tcp connection with redundant server port} {stdio} {
+    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
+            puts "[gets $file]"
+            close $file
+            set x done
+	}
+	puts ready
+	vwait x
+	after cancel $timer
+	close $f
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f x
+    if {[catch {socket localhost 2828} sock]} {
+        set x $sock
+    } else {
+        puts $sock hello
+	flush $sock
+        lappend x [gets $f]
+        close $sock
+    }
+    close $f
+    set x
+} {ready hello}
+test socket-2.6 {tcp connection} {} {
+    set status ok
+    if {![catch {set sock [socket localhost 2828]}]} {
+	if {![catch {gets $sock}]} {
+	    set status broken
+	}
+	close $sock
+    }
+    set status
+} ok
+test socket-2.7 {echo server, one line} {stdio} {
+    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]
+             if {[eof $s]} {
+                 global x
+                 close $s
+                 set x done
+             } else {
+                 puts $s $l
+             }
+	}
+	puts ready
+	vwait x
+	after cancel $timer
+	close $f
+	puts done
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f
+    set s [socket localhost 2828]
+    fconfigure $s -buffering line -translation lf
+    puts $s "hello abcdefghijklmnop"
+    set x [gets $s]
+    close $s
+    set y [gets $f]
+    close $f
+    list $x $y
+} {{hello abcdefghijklmnop} done}
+test socket-2.8 {echo server, loop 50 times, single connection} {stdio} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	set f [socket -server accept 2828]
+	proc accept {s a p} {
+            fileevent $s readable [list echo $s]
+            fconfigure $s -buffering line
+        }
+	proc echo {s} {
+	     global i
+             set l [gets $s]
+             if {[eof $s]} {
+                 global x
+                 close $s
+                 set x done
+             } else { 
+	         incr i
+                 puts $s $l
+             }
+	}
+	set i 0
+	puts ready
+	set timer [after 20000 "set x done"]
+	vwait x
+	after cancel $timer
+	close $f
+	puts "done $i"
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f
+    set s [socket localhost 2828]
+    fconfigure $s -buffering line
+    for {set x 0} {$x < 50} {incr x} {
+        puts $s "hello abcdefghijklmnop"
+        gets $s
+    }
+    close $s
+    set x [gets $f]
+    close $f
+    set x
+} {done 50}
+test socket-2.9 {socket conflict} {stdio} {
+    set s [socket -server accept 2828]
+    removeFile script
+    set f [open script w]
+    puts $f {set f [socket -server accept 2828]}
+    close $f
+    set f [open "|[list $tcltest script]" r]
+    gets $f
+    after 100
+    set x [list [catch {close $f} msg] $msg]
+    close $s
+    set x
+} {1 {couldn't open socket: address already in use
+    while executing
+"socket -server accept 2828"
+    (file "script" line 1)}}
+test socket-2.10 {close on accept, accepted socket lives} {
+    set done 0
+    set timer [after 20000 "set done timed_out"]
+    set ss [socket -server accept 2830]
+    proc accept {s a p} {
+	global ss
+	close $ss
+	fileevent $s readable "readit $s"
+	fconfigure $s -trans lf
+    }
+    proc readit {s} {
+	global done
+	gets $s
+	close $s
+	set done 1
+    }
+    set cs [socket [info hostname] 2830]
+    puts $cs hello
+    close $cs
+    vwait done
+    after cancel $timer
+    set done
+} 1
+test socket-2.11 {detecting new data} {
+    proc accept {s a p} {
+	global sock
+	set sock $s
+    }
+
+    set s [socket -server accept 2400]
+    set sock ""
+    set s2 [socket localhost 2400]
+    vwait sock
+    puts $s2 one
+    flush $s2
+    after 500
+    fconfigure $sock -blocking 0
+    set result [gets $sock]
+    lappend result [gets $sock]
+    fconfigure $sock -blocking 1
+    puts $s2 two
+    flush $s2
+    fconfigure $sock -blocking 0
+    lappend result [gets $sock]
+    fconfigure $sock -blocking 1
+    close $s2
+    close $s
+    close $sock
+    set result
+} {one {} two}
+
+
+test socket-3.1 {socket conflict} {stdio} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	set f [socket -server accept 2828]
+	puts ready
+	gets stdin
+	close $f
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r+]
+    gets $f
+    set x [list [catch {socket -server accept 2828} msg] \
+		$msg]
+    puts $f bye
+    close $f
+    set x
+} {1 {couldn't open socket: address already in use}}
+test socket-3.2 {server with several clients} {stdio} {
+    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} {
+	    fileevent $s readable [list echo $s]
+	    fconfigure $s -buffering line
+	}
+	proc echo {s} {
+	     global x
+             set l [gets $s]
+             if {[eof $s]} {
+                 close $s
+                 set x done
+             } else {
+                 puts $s $l
+             }
+	}
+	puts ready
+	vwait x
+	after cancel $t1
+	vwait x
+	after cancel $t2
+	vwait x
+	after cancel $t3
+	close $s
+	puts $x
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r+]
+    set x [gets $f]
+    set s1 [socket localhost 2828]
+    fconfigure $s1 -buffering line
+    set s2 [socket localhost 2828]
+    fconfigure $s2 -buffering line
+    set s3 [socket localhost 2828]
+    fconfigure $s3 -buffering line
+    for {set i 0} {$i < 100} {incr i} {
+	puts $s1 hello,s1
+	gets $s1
+	puts $s2 hello,s2
+	gets $s2
+	puts $s3 hello,s3
+	gets $s3
+    }
+    close $s1
+    close $s2
+    close $s3
+    lappend x [gets $f]
+    close $f
+    set x
+} {ready done}
+
+test socket-4.1 {server with several clients} {stdio} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	gets stdin
+	set s [socket localhost 2828]
+	fconfigure $s -buffering line
+	for {set i 0} {$i < 100} {incr i} {
+	    puts $s hello
+	    gets $s
+	}
+	close $s
+	puts bye
+	gets stdin
+    }
+    close $f
+    set p1 [open "|[list $tcltest script]" r+]
+    fconfigure $p1 -buffering line
+    set p2 [open "|[list $tcltest script]" r+]
+    fconfigure $p2 -buffering line
+    set p3 [open "|[list $tcltest script]" r+]
+    fconfigure $p3 -buffering line
+    proc accept {s a p} {
+	fconfigure $s -buffering line
+	fileevent $s readable [list echo $s]
+    }
+    proc echo {s} {
+	global x
+        set l [gets $s]
+        if {[eof $s]} {
+            close $s
+            set x done
+        } else {
+            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
+    puts $p3 open
+    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] $x]
+    lappend l [list p2 [gets $p2] $x]
+    lappend l [list p3 [gets $p3] $x]
+    puts $p1 bye
+    puts $p2 bye
+    puts $p3 bye
+    close $p1
+    close $p2
+    close $p3
+    set l
+} {{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]} {
+	set x $msg
+    } else {
+	close $msg
+    }
+    set x
+} ok
+
+test socket-5.1 {byte order problems, socket numbers, htons} {unixOnly} {
+    #
+    # THIS TEST WILL FAIL if you are running as superuser.
+    #
+    set x {couldn't open socket: not owner}
+    if {![catch {socket -server dodo 0x1} msg]} {
+        set x {htons problem, should be disallowed, are you running as SU?}
+	close $msg
+    }
+    set x
+} {couldn't open socket: not owner}
+test socket-5.2 {byte order problems, socket numbers, htons} {
+    set x {couldn't open socket: port number too high}
+    if {![catch {socket -server dodo 0x10000} msg]} {
+	set x {port resolution problem, should be disallowed}
+	close $msg
+    }
+    set x
+} {couldn't open socket: port number too high}
+test socket-5.3 {byte order problems, socket numbers, htons} {unixOnly} {
+    #
+    # THIS TEST WILL FAIL if you are running as superuser.
+    #
+    set x {couldn't open socket: not owner}
+    if {![catch {socket -server dodo 21} msg]} {
+	set x {htons problem, should be disallowed, are you running as SU?}
+	close $msg
+    }
+    set x
+} {couldn't open socket: not owner}
+
+test socket-6.1 {accept callback error} {stdio} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	gets stdin
+	socket localhost 2848
+    }
+    close $f
+    set f [open "|[list $tcltest script]" r+]
+    proc bgerror args {
+	global x
+	set x $args
+    }
+    proc accept {s a p} {expr 10 / 0}
+    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
+} {{divide by zero}}
+
+test socket-7.1 {testing socket specific options} {stdio} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	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 "|[list $tcltest script]" r]
+    gets $f
+    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] 2820]
+    lappend l [llength $p]
+} {0 0 3}
+test socket-7.2 {testing socket specific options} {stdio} {
+    removeFile script
+    set f [open script w]
+    puts $f {
+	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 "|[list $tcltest script]" r]
+    gets $f
+    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] == 2821]
+} {3 127.0.0.1 0}
+test socket-7.3 {testing socket specific options} {
+    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 2823]
+    proc accept {s a p} {
+	global x
+	set x [fconfigure $s -sockname]
+	close $s
+    }
+    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]
+} {2823 3}
+test socket-7.5 {testing socket specific options} {unixOrPc} {
+    set s [socket -server accept 2829]
+    proc accept {s a p} {
+	global x
+	set x [fconfigure $s -sockname]
+	close $s
+    }
+    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 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,
+    # check that you have these patches installed (using showrev -p):
+    #
+    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
+    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
+    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
+    # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01,
+    # 101878-03, 101879-01, 101880-03, 101933-01, 101950-01, 102030-01,
+    # 102057-08, 102140-01, 101920-02, 101921-09, 101922-07, 101923-03
+    #
+    # If after installing these patches you are still experiencing a
+    # 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 2830]
+    proc accept {s a p} {
+	global x
+	puts $s bye
+	close $s
+	set x done
+    }
+    set s1 [socket -async [info hostname] 2830]
+    vwait x
+    set z [gets $s1]
+    close $s
+    close $s1
+    set z
+} bye
+
+test socket-9.1 {testing spurious events} {
+    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]
+	}
+    }
+    proc accept {s a p} {
+	fconfigure $s -buffering none -blocking off
+	fileevent $s readable [list readlittle $s]
+    }
+    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}
+test socket-9.2 {testing async write, fileevents, flush on close} {} {
+    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 2832]
+    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 [info hostname] 2832]
+    fconfigure $s -blocking 0 -trans lf -buffering line
+    set count 0
+    puts $s hello
+    proc readit {s} {
+	global count done
+	set l [read $s]
+	incr count [string length $l]
+	if {[eof $s]} {
+	    close $s
+	    set done 1
+	}
+    }
+    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}
+
+test socket-10.1 {testing socket accept callback error handling} {
+    set goterror 0
+    proc bgerror args {global goterror; set goterror 1}
+    set s [socket -server accept 2898]
+    proc accept {s a p} {close $s; error}
+    set c [socket localhost 2898]
+    vwait goterror
+    close $s
+    close $c
+    set goterror
+} 1
+
+removeFile script
+
+#
+# The rest of the tests are run only if we are doing testing against
+# a remote server.
+#
+
+if {$doTestsWithRemoteServer == 0} {
+    return
+}
+
+test socket-11.1 {tcp connection} {
+    sendCommand {
+	set socket9_1_test_server [socket -server accept 2834]
+	proc accept {s a p} {
+	    puts $s done
+	    close $s
+	}
+    }
+    set s [socket $remoteServerIP 2834]
+    set r [gets $s]
+    close $s
+    sendCommand {close $socket9_1_test_server}
+    set r
+} done
+test socket-11.2 {client specifies its port} {
+    if {[info exists port]} {
+	incr port
+    } else {
+	set port [expr 2048 + [pid]%1024]
+    }
+    sendCommand {
+	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 2835]
+    set r [gets $s]
+    close $s
+    sendCommand {close $socket9_2_test_server}
+    if {$r == $port} {
+	set result ok
+    } else {
+	set result broken
+    }
+    set result
+} ok
+test socket-11.3 {trying to connect, no server} {
+    set status ok
+    if {![catch {set s [socket $remoteServerIp 2836]}]} {
+	if {![catch {gets $s}]} {
+	    set status broken
+	}
+	close $s
+    }
+    set status
+} ok
+test socket-11.4 {remote echo, one line} {
+    sendCommand {
+	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
+	}
+	proc echo {s} {
+	    set l [gets $s]
+	    if {[eof $s]} {
+		close $s
+	    } else {
+		puts $s $l
+	    }
+	}
+    }
+    set f [socket $remoteServerIP 2836]
+    fconfigure $f -translation crlf -buffering line
+    puts $f hello
+    set r [gets $f]
+    close $f
+    sendCommand {close $socket10_6_test_server}
+    set r
+} hello
+test socket-11.5 {remote echo, 50 lines} {
+    sendCommand {
+	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
+	}
+	proc echo {s} {
+	    set l [gets $s]
+	    if {[eof $s]} {
+		close $s
+	    } else {
+		puts $s $l
+	    }
+	}
+    }
+    set f [socket $remoteServerIP 2836]
+    fconfigure $f -translation crlf -buffering line
+    for {set cnt 0} {$cnt < 50} {incr cnt} {
+	puts $f "hello, $cnt"
+	if {[string compare [gets $f] "hello, $cnt"] != 0} {
+	    break
+	}
+    }
+    close $f
+    sendCommand {close $socket10_7_test_server}
+    set cnt
+} 50
+# Macintosh sockets can have more than one server per port
+if {$tcl_platform(platform) == "macintosh"} {
+    set conflictResult {0 2836}
+} else {
+    set conflictResult {1 {couldn't open socket: address already in use}}
+}
+test socket-11.6 {socket conflict} {
+    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]]
+	close $s2
+    }
+    close $s1
+    set result
+} $conflictResult
+test socket-11.7 {server with several clients} {
+    sendCommand {
+	set socket10_9_test_server [socket -server accept 2836]
+	proc accept {s a p} {
+	    fconfigure $s -buffering line
+	    fileevent $s readable [list echo $s]
+	}
+	proc echo {s} {
+	    set l [gets $s]
+	    if {[eof $s]} {
+		close $s
+	    } else {
+		puts $s $l
+	    }
+	}
+    }
+    set s1 [socket $remoteServerIP 2836]
+    fconfigure $s1 -buffering line
+    set s2 [socket $remoteServerIP 2836]
+    fconfigure $s2 -buffering line
+    set s3 [socket $remoteServerIP 2836]
+    fconfigure $s3 -buffering line
+    for {set i 0} {$i < 100} {incr i} {
+	puts $s1 hello,s1
+	gets $s1
+	puts $s2 hello,s2
+	gets $s2
+	puts $s3 hello,s3
+	gets $s3
+    }
+    close $s1
+    close $s2
+    close $s3
+    sendCommand {close $socket10_9_test_server}
+    set i
+} 100    
+test socket-11.8 {client with several servers} {
+    sendCommand {
+	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 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]
+    close $s1
+    close $s2
+    close $s3
+    sendCommand {
+	close $s1
+	close $s2
+	close $s3
+    }
+    set l
+} {4003 {} 1 4004 {} 1 4005 {} 1}
+test socket-11.9 {accept callback error} {
+    set s [socket -server accept 2836]
+    proc accept {s a p} {expr 10 / 0}
+    proc bgerror args {
+	global x
+	set x $args
+    }
+    if {[catch {sendCommand {
+	    set peername [fconfigure $callerSocket -peername]
+	    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-11.10 {testing socket specific options} {
+    sendCommand {
+	set socket10_12_test_server [socket -server accept 2836]
+	proc accept {s a p} {close $s}
+    }
+    set s [socket $remoteServerIP 2836]
+    set p [fconfigure $s -peername]
+    set n [fconfigure $s -sockname]
+    set l ""
+    lappend l [lindex $p 2] [llength $p] [llength $p]
+    close $s
+    sendCommand {close $socket10_12_test_server}
+    set l
+} {2836 3 3}
+test socket-11.11 {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-11.12 {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-11.13 {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 {[string match sock* $commandSocket] == 1} {
+   puts $commandSocket exit
+   flush $commandSocket
+}
+catch {close $commandSocket}
+catch {close $remoteProcChan}
+
+set x ""
+unset x
diff --git a/tcl/tests/source.test b/tcl/tests/source.test
new file mode 100644
index 00000000000..383e02c5376
--- /dev/null
+++ b/tcl/tests/source.test
@@ -0,0 +1,187 @@
+# Commands covered:  source
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test source-1.1 {source command} {
+    set x "old x value"
+    set y "old y value"
+    set z "old z value"
+    makeFile {
+	set x 22
+	set y 33
+	set z 44
+    } source.file
+    source source.file
+    list $x $y $z
+} {22 33 44}
+test source-1.2 {source command} {
+    makeFile {list result} source.file
+    source source.file
+} result
+
+# The mac version of source returns a different result for
+# the next two tests.
+
+if {$tcl_platform(platform) == "macintosh"} {
+    set retMsg1 {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+    set retMsg2 {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+} else {
+    set retMsg1 {1 {wrong # args: should be "source fileName"}}
+    set retMsg2 {1 {wrong # args: should be "source fileName"}}
+}
+test source-2.1 {source error conditions} {
+    list [catch {source} msg] $msg
+} $retMsg1
+test source-2.2 {source error conditions} {
+    list [catch {source a b} msg] $msg
+} $retMsg2
+test source-2.3 {source error conditions} {
+    makeFile {
+	set x 146
+	error "error in sourced file"
+	set y $x
+    } source.file
+    list [catch {source source.file} msg] $msg $errorInfo
+} {1 {error in sourced file} {error in sourced file
+    while executing
+"error "error in sourced file""
+    (file "source.file" line 3)
+    invoked from within
+"source source.file"}}
+test source-2.4 {source error conditions} {
+    makeFile {break} source.file
+    catch {source source.file}
+} 3
+test source-2.5 {source error conditions} {
+    makeFile {continue} source.file
+    catch {source source.file}
+} 4
+test source-2.6 {source error conditions} {
+    normalizeMsg [list [catch {source _non_existent_} msg] $msg $errorCode]
+} {1 {couldn't read file "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
+
+test source-3.1 {return in middle of source file} {
+    makeFile {
+	set x new-x
+	return allDone
+	set y new-y
+    } source.file
+    set x old-x
+    set y old-y
+    set z [source source.file]
+    list $x $y $z
+} {new-x old-y allDone}
+test source-3.2 {return with special code etc.} {
+    makeFile {
+	set x new-x
+	return -code break "Silly result"
+	set y new-y
+    } source.file
+    list [catch {source source.file} msg] $msg
+} {3 {Silly result}}
+test source-3.3 {return with special code etc.} {
+    makeFile {
+	set x new-x
+	return -code error "Simulated error"
+	set y new-y
+    } source.file
+    list [catch {source source.file} msg] $msg $errorInfo $errorCode
+} {1 {Simulated error} {Simulated error
+    while executing
+"source source.file"} NONE}
+test source-3.4 {return with special code etc.} {
+    makeFile {
+	set x new-x
+	return -code error -errorinfo "Simulated errorInfo stuff"
+	set y new-y
+    } source.file
+    list [catch {source source.file} msg] $msg $errorInfo $errorCode
+} {1 {} {Simulated errorInfo stuff
+    invoked from within
+"source source.file"} NONE}
+test source-3.5 {return with special code etc.} {
+    makeFile {
+	set x new-x
+	return -code error -errorinfo "Simulated errorInfo stuff" \
+		-errorcode {a b c}
+	set y new-y
+    } source.file
+    list [catch {source source.file} msg] $msg $errorInfo $errorCode
+} {1 {} {Simulated errorInfo stuff
+    invoked from within
+"source source.file"} {a b c}}
+
+# Test for the Macintosh specfic features of the source command
+test source-4.1 {source error conditions} {macOnly} {
+    list [catch {source -rsrc _no_exist_} msg] $msg
+} [list 1 "The resource \"_no_exist_\" could not be loaded from application."]
+test source-4.2 {source error conditions} {macOnly} {
+    list [catch {source -rsrcid bad_id} msg] $msg
+} [list 1 "expected integer but got \"bad_id\""]
+test source-4.3 {source error conditions} {macOnly} {
+    list [catch {source -rsrc rsrcName fileName extra} msg] $msg
+} $retMsg1
+test source-4.4 {source error conditions} {macOnly} {
+    list [catch {source non_switch rsrcName} msg] $msg
+} $retMsg2
+test source-4.5 {source error conditions} {macOnly} {
+    list [catch {source -bad_switch argument} msg] $msg
+} $retMsg2
+test source-5.1 {source resource files} {macOnly} {
+    list [catch {source -rsrc rsrcName bad_file} msg] $msg
+} [list 1 "Error finding the file: \"bad_file\"."]
+test source-5.2 {source resource files} {macOnly} {
+    makeFile {return} source.file
+    list [catch {source -rsrc rsrcName source.file} msg] $msg
+} [list 1 "Error reading the file: \"source.file\"."]
+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]
+    removeFile rsrc.file
+    list $msg2 $result $msg
+} [list ok 0 {}]
+test source-5.4 {source resource files} {macOnly} {
+    catch {unset msg2}
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file {set msg2 ok; return}
+    source -rsrc fileRsrcName rsrc.file
+    set result [catch {source -rsrc fileRsrcName} msg]    
+    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]
+    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]
+    removeFile rsrc.file
+    list $msg2 $result $msg
+} [list hello 1 bad]
+
+test source-6.1 {source is binary ok} {
+    set x {}
+    makeFile [list set x "a b\0c"] source.file
+    source source.file
+    string length $x
+} 5
+
+catch {removeFile source.file}
+
+# Generate null final value
+
+concat {}
diff --git a/tcl/tests/split.test b/tcl/tests/split.test
new file mode 100644
index 00000000000..7a1cd45c5d1
--- /dev/null
+++ b/tcl/tests/split.test
@@ -0,0 +1,65 @@
+# Commands covered:  split
+#
+# 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-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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test split-1.1 {basic split commands} {
+    split "a\n b\t\r c\n "
+} {a {} b {} {} c {} {}}
+test split-1.2 {basic split commands} {
+    split "word 1xyzword 2zword 3" xyz
+} {{word 1} {} {} {word 2} {word 3}}
+test split-1.3 {basic split commands} {
+    split "12345" {}
+} {1 2 3 4 5}
+test split-1.4 {basic split commands} {
+    split "a\}b\[c\{\]\$"
+} "a\\}b\\\[c\\{\\\]\\\$"
+test split-1.5 {basic split commands} {
+    split {} {}
+} {}
+test split-1.6 {basic split commands} {
+    split {}
+} {}
+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-1.9 {basic split commands} {
+    proc foo {} {
+        set x ab\000c
+        set y [split $x {}]
+        return $y
+    }
+    foo
+} "a b \000 c"
+test split-1.10 {basic split commands} {
+    split "a0ab1b2bbb3\000c4" ab\000c
+} {{} 0 {} 1 2 {} {} 3 {} 4}
+
+test split-2.1 {split errors} {
+    list [catch split msg] $msg $errorCode
+} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test split-2.2 {split errors} {
+    list [catch {split a b c} msg] $msg $errorCode
+} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
diff --git a/tcl/tests/stack.test b/tcl/tests/stack.test
new file mode 100644
index 00000000000..58b2c4ad23e
--- /dev/null
+++ b/tcl/tests/stack.test
@@ -0,0 +1,23 @@
+# Tests that the stack size is big enough for the application.
+#
+# 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) 1998 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Note that a failure in this test results in a crash of the executable.
+
+test stack-1.1 {maxNestingDepth reached on infinite recursion} {
+    proc recurse {} { return [recurse] }
+    catch {recurse} rv
+    rename recurse {}
+    set rv
+} {too many nested calls to Tcl_EvalObj (infinite loop?)}
diff --git a/tcl/tests/string.test b/tcl/tests/string.test
new file mode 100644
index 00000000000..253852450df
--- /dev/null
+++ b/tcl/tests/string.test
@@ -0,0 +1,384 @@
+# Commands covered:  string
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test string-1.1 {string compare} {
+    string compare abcde abdef
+} -1
+test string-1.2 {string compare} {
+    string c abcde ABCDE
+} 1
+test string-1.3 {string compare} {
+    string compare abcde abcde
+} 0
+test string-1.4 {string compare} {
+    list [catch {string compare a} msg] $msg
+} {1 {wrong # args: should be "string compare string1 string2"}}
+test string-1.5 {string compare} {
+    list [catch {string compare a b c} msg] $msg
+} {1 {wrong # args: should be "string compare string1 string2"}}
+
+test string-2.1 {string first} {
+    string first bq abcdefgbcefgbqrs
+} 12
+test string-2.2 {string first} {
+    string fir bcd abcdefgbcefgbqrs
+} 1
+test string-2.3 {string first} {
+    string f b abcdefgbcefgbqrs
+} 1
+test string-2.4 {string first} {
+    string first xxx x123xx345xxx789xxx012
+} 9
+test string-2.5 {string first} {
+    string first "" x123xx345xxx789xxx012
+} -1
+test string-2.6 {string first} {
+    list [catch {string first a} msg] $msg
+} {1 {wrong # args: should be "string first string1 string2"}}
+test string-2.7 {string first} {
+    list [catch {string first a b c} msg] $msg
+} {1 {wrong # args: should be "string first string1 string2"}}
+
+test string-3.1 {string index} {
+    string index abcde 0
+} a
+test string-3.2 {string index} {
+    string i abcde 4
+} e
+test string-3.3 {string index} {
+    string index abcde 5
+} {}
+test string-3.4 {string index} {
+    list [catch {string index abcde -10} msg] $msg
+} {0 {}}
+test string-3.5 {string index} {
+    list [catch {string index} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test string-3.6 {string index} {
+    list [catch {string index a b c} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test string-3.7 {string index} {
+    list [catch {string index a xyz} msg] $msg
+} {1 {expected integer but got "xyz"}}
+
+test string-4.1 {string last} {
+    string la xxx xxxx123xx345x678
+} 1
+test string-4.2 {string last} {
+    string last xx xxxx123xx345x678
+} 7
+test string-4.3 {string last} {
+    string las x xxxx123xx345x678
+} 12
+test string-4.4 {string last} {
+    list [catch {string last a} msg] $msg
+} {1 {wrong # args: should be "string last string1 string2"}}
+test string-4.5 {string last} {
+    list [catch {string last a b c} msg] $msg
+} {1 {wrong # args: should be "string last string1 string2"}}
+
+test string-5.1 {string length} {
+    string length "a little string"
+} 15
+test string-5.2 {string length} {
+    string le ""
+} 0
+test string-5.3 {string length} {
+    list [catch {string length} msg] $msg
+} {1 {wrong # args: should be "string length string"}}
+test string-5.4 {string length} {
+    list [catch {string length a b} msg] $msg
+} {1 {wrong # args: should be "string length string"}}
+
+test string-6.1 {string match} {
+    string match abc abc
+} 1
+test string-6.2 {string match} {
+    string m abc abd
+} 0
+test string-6.3 {string match} {
+    string match ab*c abc
+} 1
+test string-6.4 {string match} {
+    string match ab**c abc
+} 1
+test string-6.5 {string match} {
+    string match ab* abcdef
+} 1
+test string-6.6 {string match} {
+    string match *c abc
+} 1
+test string-6.7 {string match} {
+    string match *3*6*9 0123456789
+} 1
+test string-6.8 {string match} {
+    string match *3*6*9 01234567890
+} 0
+test string-6.9 {string match} {
+    string match a?c abc
+} 1
+test string-6.10 {string match} {
+    string match a??c abc
+} 0
+test string-6.11 {string match} {
+    string match ?1??4???8? 0123456789
+} 1
+test string-6.12 {string match} {
+    string match {[abc]bc} abc
+} 1
+test string-6.13 {string match} {
+    string match {a[abc]c} abc
+} 1
+test string-6.14 {string match} {
+    string match {a[xyz]c} abc
+} 0
+test string-6.15 {string match} {
+    string match {12[2-7]45} 12345
+} 1
+test string-6.16 {string match} {
+    string match {12[ab2-4cd]45} 12345
+} 1
+test string-6.17 {string match} {
+    string match {12[ab2-4cd]45} 12b45
+} 1
+test string-6.18 {string match} {
+    string match {12[ab2-4cd]45} 12d45
+} 1
+test string-6.19 {string match} {
+    string match {12[ab2-4cd]45} 12145
+} 0
+test string-6.20 {string match} {
+    string match {12[ab2-4cd]45} 12545
+} 0
+test string-6.21 {string match} {
+    string match {a\*b} a*b
+} 1
+test string-6.22 {string match} {
+    string match {a\*b} ab
+} 0
+test string-6.23 {string match} {
+    string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
+} 1
+test string-6.24 {string match} {
+    string match ** ""
+} 1
+test string-6.25 {string match} {
+    string match *. ""
+} 0
+test string-6.26 {string match} {
+    string match "" ""
+} 1
+test string-6.27 {string match} {
+    string match \[a a
+} 1
+test string-6.28 {string match} {
+    list [catch {string match a} msg] $msg
+} {1 {wrong # args: should be "string match pattern string"}}
+test string-6.29 {string match} {
+    list [catch {string match a b c} msg] $msg
+} {1 {wrong # args: should be "string match pattern string"}}
+
+test string-7.1 {string range} {
+    string range abcdefghijklmnop 2 14
+} {cdefghijklmno}
+test string-7.2 {string range} {
+    string range abcdefghijklmnop 7 1000
+} {hijklmnop}
+test string-7.3 {string range} {
+    string range abcdefghijklmnop 10 e
+} {klmnop}
+test string-7.4 {string range} {
+    string range abcdefghijklmnop 10 9
+} {}
+test string-7.5 {string range} {
+    string range abcdefghijklmnop -3 2
+} {abc}
+test string-7.6 {string range} {
+    string range abcdefghijklmnop -3 -2
+} {}
+test string-7.7 {string range} {
+    string range abcdefghijklmnop 1000 1010
+} {}
+test string-7.8 {string range} {
+    string range abcdefghijklmnop -100 end
+} {abcdefghijklmnop}
+test string-7.9 {string range} {
+    list [catch {string range} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test string-7.10 {string range} {
+    list [catch {string range a 1} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test string-7.11 {string range} {
+    list [catch {string range a 1 2 3} msg] $msg
+} {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 {bad index "abc": must be integer or "end"}}
+test string-7.13 {string range} {
+    list [catch {string range abc 1 eof} msg] $msg
+} {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      "
+} {XYZ}
+test string-8.2 {string trim} {
+    string trim "\t\nXYZ\t\n\r\n"
+} {XYZ}
+test string-8.3 {string trim} {
+    string trim "  A XYZ A    "
+} {A XYZ A}
+test string-8.4 {string trim} {
+    string trim "XXYYZZABC XXYYZZ" ZYX
+} {ABC }
+test string-8.5 {string trim} {
+    string trim "    \t\r      "
+} {}
+test string-8.6 {string trim} {
+    string trim {abcdefg} {}
+} {abcdefg}
+test string-8.7 {string trim} {
+    string trim {}
+} {}
+test string-8.8 {string trim} {
+    string trim ABC DEF
+} {ABC}
+test string-8.9 {string trim} {
+    list [catch {string trim} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+test string-8.10 {string trim} {
+    list [catch {string trim a b c} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+
+test string-9.1 {string trimleft} {
+    string trimleft "    XYZ      "
+} {XYZ      }
+test string-9.2 {string trimleft} {
+    list [catch {string trimleft} msg] $msg
+} {1 {wrong # args: should be "string trimleft string ?chars?"}}
+
+test string-10.1 {string trimright} {
+    string trimright "    XYZ      "
+} {    XYZ}
+test string-10.2 {string trimright} {
+    string trimright "   "
+} {}
+test string-10.3 {string trimright} {
+    string trimright ""
+} {}
+test string-10.4 {string trimright errors} {
+    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": 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
+} {abcdef}
+test string-11.2 {string tolower} {
+    string tolower "ABC  XyZ"
+} {abc  xyz}
+test string-11.3 {string tolower} {
+    string tolower {123#$&*()}
+} {123#$&*()}
+test string-11.4 {string tolower} {
+    list [catch {string tolower} msg] $msg
+} {1 {wrong # args: should be "string tolower string"}}
+test string-11.5 {string tolower} {
+    list [catch {string tolower a b} msg] $msg
+} {1 {wrong # args: should be "string tolower string"}}
+
+test string-12.1 {string toupper} {
+    string toupper abCDEf
+} {ABCDEF}
+test string-12.2 {string toupper} {
+    string toupper "abc xYz"
+} {ABC XYZ}
+test string-12.3 {string toupper} {
+    string toupper {123#$&*()}
+} {123#$&*()}
+test string-12.4 {string toupper} {
+    list [catch {string toupper} msg] $msg
+} {1 {wrong # args: should be "string toupper string"}}
+test string-12.5 {string toupper} {
+    list [catch {string toupper a b} msg] $msg
+} {1 {wrong # args: should be "string toupper string"}}
+
+test string-13.1 {string wordend} {
+    list [catch {string wordend a} msg] $msg
+} {1 {wrong # args: should be "string wordend string index"}}
+test string-13.2 {string wordend} {
+    list [catch {string wordend a b c} msg] $msg
+} {1 {wrong # args: should be "string wordend string index"}}
+test string-13.3 {string wordend} {
+    list [catch {string wordend a gorp} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test string-13.4 {string wordend} {
+    string wordend abc. -1
+} 3
+test string-13.5 {string wordend} {
+    string wordend abc. 100
+} 4
+test string-13.6 {string wordend} {
+    string wordend "word_one two three" 2
+} 8
+test string-13.7 {string wordend} {
+    string wordend "one .&# three" 5
+} 6
+test string-13.8 {string wordend} {
+    string worde "x.y" 0
+} 1
+
+test string-14.1 {string wordstart} {
+    list [catch {string word a} msg] $msg
+} {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"}}
+test string-14.3 {string wordstart} {
+    list [catch {string wordstart a b c} msg] $msg
+} {1 {wrong # args: should be "string wordstart string index"}}
+test string-14.4 {string wordstart} {
+    list [catch {string wordstart a gorp} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test string-14.5 {string wordstart} {
+    string wordstart "one two three_words" 400
+} 8
+test string-14.6 {string wordstart} {
+    string wordstart "one two three_words" 2
+} 0
+test string-14.7 {string wordend} {
+    string wordstart "one two three_words" -2
+} 0
+test string-14.8 {string wordend} {
+    string wordstart "one .*&^ three" 6
+} 6
+test string-14.9 {string wordend} {
+    string wordstart "one two three" 4
+} 4
+
+test string-15.1 {error conditions} {
+    list [catch {string gorp a b} msg] $msg
+} {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/tcl/tests/stringObj.test b/tcl/tests/stringObj.test
new file mode 100644
index 00000000000..d906d3d66fd
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/subst.test b/tcl/tests/subst.test
new file mode 100644
index 00000000000..79067adb904
--- /dev/null
+++ b/tcl/tests/subst.test
@@ -0,0 +1,106 @@
+# Commands covered:  subst
+#
+# 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) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test subst-1.1 {basics} {
+    list [catch {subst} msg] $msg
+} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
+test subst-1.2 {basics} {
+    list [catch {subst a b c} msg] $msg
+} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
+
+test subst-2.1 {simple strings} {
+    subst {}
+} {}
+test subst-2.2 {simple strings} {
+    subst a
+} a
+test subst-2.3 {simple strings} {
+    subst abcdefg
+} abcdefg
+
+test subst-3.1 {backslash substitutions} {
+    subst {\x\$x\[foo bar]\\}
+} "x\$x\[foo bar]\\"
+
+test subst-4.1 {variable substitutions} {
+    set a 44
+    subst {$a}
+} {44}
+test subst-4.2 {variable substitutions} {
+    set a 44
+    subst {x$a.y{$a}.z}
+} {x44.y{44}.z}
+test subst-4.3 {variable substitutions} {
+    catch {unset a}
+    set a(13) 82
+    set i 13
+    subst {x.$a($i)}
+} {x.82}
+catch {unset a}
+set long {This is a very long string, intentionally made so long that it
+	will overflow the static character size for dstrings, so that
+	additional memory will have to be allocated by subst.  That way,
+	if the subst procedure forgets to free up memory while returning
+	an error, there will be memory that isn't freed (this will be
+	detected when the tests are run under a checking memory allocator
+	such as Purify).}
+test subst-4.4 {variable substitutions} {
+    list [catch {subst {$long $a}} msg] $msg
+} {1 {can't read "a": no such variable}}
+
+test subst-5.1 {command substitutions} {
+    subst {[concat {}]}
+} {}
+test subst-5.2 {command substitutions} {
+    subst {[concat A test string]}
+} {A test string}
+test subst-5.3 {command substitutions} {
+    subst {x.[concat foo].y.[concat bar].z}
+} {x.foo.y.bar.z}
+test subst-5.4 {command substitutions} {
+    list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
+} {1 {invalid command name "bogus_command"}}
+
+test subst-6.1 {clear the result after command substitution} {
+    catch {unset a}
+    list [catch {subst {[concat foo] $a}} msg] $msg
+} {1 {can't read "a": no such variable}}
+
+test subst-7.1 {switches} {
+    list [catch {subst foo bar} msg] $msg
+} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
+test subst-7.2 {switches} {
+    list [catch {subst -no bar} msg] $msg
+} {1 {bad switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
+test subst-7.3 {switches} {
+    list [catch {subst -bogus bar} msg] $msg
+} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
+test subst-7.4 {switches} {
+    set x 123
+    subst -nobackslashes {abc $x [expr 1+2] \\\x41}
+} {abc 123 3 \\\x41}
+test subst-7.5 {switches} {
+    set x 123
+    subst -nocommands {abc $x [expr 1+2] \\\x41}
+} {abc 123 [expr 1+2] \A}
+test subst-7.6 {switches} {
+    set x 123
+    subst -novariables {abc $x [expr 1+2] \\\x41}
+} {abc $x 3 \A}
+test subst-7.7 {switches} {
+    set x 123
+    subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
+} {abc $x [expr 1+2] \\\x41}
diff --git a/tcl/tests/switch.test b/tcl/tests/switch.test
new file mode 100644
index 00000000000..2041dc31e19
--- /dev/null
+++ b/tcl/tests/switch.test
@@ -0,0 +1,179 @@
+# Commands covered:  switch
+#
+# 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) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test switch-1.1 {simple patterns} {
+    switch a a {format 1} b {format 2} c {format 3} default {format 4}
+} 1
+test switch-1.2 {simple patterns} {
+    switch b a {format 1} b {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.3 {simple patterns} {
+    switch x a {format 1} b {format 2} c {format 3} default {format 4}
+} 4
+test switch-1.4 {simple patterns} {
+    switch x a {format 1} b {format 2} c {format 3}
+} {}
+test switch-1.5 {simple pattern matches many times} {
+    switch b a {format 1} b {format 2} b {format 3} b {format 4}
+} 2
+test switch-1.6 {simple patterns} {
+    switch default a {format 1} default {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.7 {simple patterns} {
+    switch x a {format 1} default {format 2} c {format 3} default {format 4}
+} 4
+
+test switch-2.1 {single-argument form for pattern/command pairs} {
+    switch b {
+	a {format 1}
+	b {format 2}
+	default {format 6}
+    }
+} {2}
+test switch-2.2 {single-argument form for pattern/command pairs} {
+    list [catch {switch z {a 2 b}} msg] $msg
+} {1 {extra switch pattern with no body}}
+
+test switch-3.1 {-exact vs. -glob vs. -regexp} {
+    switch -exact aaaab {
+	^a*b$	{concat regexp}
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }
+} exact
+test switch-3.2 {-exact vs. -glob vs. -regexp} {
+    switch -exact -regexp aaaab {
+	^a*b$	{concat regexp}
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }
+} regexp
+test switch-3.3 {-exact vs. -glob vs. -regexp} {
+    switch -glob aaaab {
+	^a*b$	{concat regexp}
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }
+} glob
+test switch-3.4 {-exact vs. -glob vs. -regexp} {
+    switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
+	    aaaab {concat exact} default {concat none}
+} exact
+test switch-3.5 {-exact vs. -glob vs. -regexp} {
+    switch -- -glob {
+	^g.*b$	{concat regexp}
+	-*	{concat glob}
+	-glob	{concat exact}
+	default {concat none}
+    }
+} exact
+test switch-3.6 {-exact vs. -glob vs. -regexp} {
+    list [catch {switch -foo a b c} msg] $msg
+} {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] \
+	    $msg $errorInfo
+} {1 {Just a test} {Just a test
+    while executing
+"error "Just a test""
+    ("a" arm line 1)
+    invoked from within
+"switch a a {error "Just a test"} default {format 1}"}}
+test switch-4.2 {error: not enough args} {
+    list [catch {switch} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-4.3 {error: pattern with no body} {
+    list [catch {switch a b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-4.4 {error: pattern with no body} {
+    list [catch {switch a b {format 1} c} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-4.5 {error in default command} {
+    list [catch {switch foo a {error switch1} b {error switch 3} \
+	    default {error switch2}} msg] $msg $errorInfo
+} {1 switch2 {switch2
+    while executing
+"error switch2"
+    ("default" arm line 1)
+    invoked from within
+"switch foo a {error switch1} b {error switch 3}  default {error switch2}"}}
+
+test switch-5.1 {errors in -regexp matching} {
+    list [catch {switch -regexp aaaab {
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }} msg] $msg
+} {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
+
+test switch-6.1 {backslashes in patterns} {
+    switch -exact {\a\$\.\[} {
+	\a\$\.\[	{concat first}
+	\a\\$\.\\[	{concat second}
+	\\a\\$\\.\\[	{concat third}
+	{\a\\$\.\\[}	{concat fourth}
+	{\\a\\$\\.\\[}	{concat fifth}
+	default		{concat none}
+    }
+} third
+test switch-6.2 {backslashes in patterns} {
+    switch -exact {\a\$\.\[} {
+	\a\$\.\[	{concat first}
+	{\a\$\.\[}	{concat second}
+	{{\a\$\.\[}}	{concat third}
+	default		{concat none}
+    }
+} second
+
+test switch-7.1 {"-" bodies} {
+    switch a {
+	a -
+	b -
+	c {concat 1}
+	default {concat 2}
+    }
+} 1
+test switch-7.2 {"-" bodies} {
+    list [catch {
+	switch a {
+	    a -
+	    b -
+	    c -
+	}
+    } msg] $msg
+} {1 {no body specified for pattern "a"}}
+test switch-7.3 {"-" bodies} {
+    list [catch {
+	switch a {
+	    a -
+	    b -foo
+	    c -
+	}
+    } 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/tcl/tests/timer.test b/tcl/tests/timer.test
new file mode 100644
index 00000000000..5d803746555
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/trace.test b/tcl/tests/trace.test
new file mode 100644
index 00000000000..43773571df1
--- /dev/null
+++ b/tcl/tests/trace.test
@@ -0,0 +1,966 @@
+# Commands covered:  trace
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+proc traceScalar {name1 name2 op} {
+    global info
+    set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
+}
+proc traceScalarAppend {name1 name2 op} {
+    global info
+    lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
+}
+proc traceArray {name1 name2 op} {
+    global info
+    set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
+}
+proc traceArray2 {name1 name2 op} {
+    global info
+    set info [list $name1 $name2 $op]
+}
+proc traceProc {name1 name2 op} {
+    global info
+    set info [concat $info [list $name1 $name2 $op]]
+}
+proc traceTag {tag args} {
+    global info
+    set info [concat $info $tag]
+}
+proc traceError {args} {
+    error "trace returned error"
+}
+proc traceCheck {cmd args} {
+    global info
+    set info [list [catch $cmd msg] $msg]
+}
+proc traceCrtElement {value name1 name2 op} {
+    uplevel set ${name1}($name2) $value
+}
+
+# Read-tracing on variables
+
+test trace-1.1 {trace variable reads} {
+    catch {unset x}
+    set info {}
+    trace var x r traceScalar
+    list [catch {set x} msg] $msg $info
+} {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
+test trace-1.2 {trace variable reads} {
+    catch {unset x}
+    set x 123
+    set info {}
+    trace var x r traceScalar
+    list [catch {set x} msg] $msg $info
+} {0 123 {x {} r 0 123}}
+test trace-1.3 {trace variable reads} {
+    catch {unset x}
+    set info {}
+    trace var x r traceScalar
+    set x 123
+    set info
+} {}
+test trace-1.4 {trace array element reads} {
+    catch {unset x}
+    set info {}
+    trace var x(2) r traceArray
+    list [catch {set x(2)} msg] $msg $info
+} {1 {can't read "x(2)": no such element in array} {x 2 r 1 {can't read "x(2)": no such element in array}}}
+test trace-1.5 {trace array element reads} {
+    catch {unset x}
+    set x(2) zzz
+    set info {}
+    trace var x(2) r traceArray
+    list [catch {set x(2)} msg] $msg $info
+} {0 zzz {x 2 r 0 zzz}}
+test trace-1.6 {trace array element reads} {
+    catch {unset x}
+    set info {}
+    trace variable x r traceArray2
+    proc p {} {
+        global x
+        set x(2) willi
+        return $x(2)
+    }
+    list [catch {p} msg] $msg $info
+} {0 willi {x 2 r}}
+test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
+    catch {unset x}
+    set info {}
+    trace variable x r q
+    proc q {name1 name2 op} {
+        global info
+        set info [list $name1 $name2 $op]
+        global $name1
+        set ${name1}($name2) wolf
+    }
+    proc p {} {
+        global x
+        set x(X) willi
+        return $x(Y)
+    }
+    list [catch {p} msg] $msg $info
+} {0 wolf {x Y r}}
+test trace-1.8 {trace reads on whole arrays} {
+    catch {unset x}
+    set info {}
+    trace var x r traceArray
+    list [catch {set x(2)} msg] $msg $info
+} {1 {can't read "x(2)": no such variable} {}}
+test trace-1.9 {trace reads on whole arrays} {
+    catch {unset x}
+    set x(2) zzz
+    set info {}
+    trace var x r traceArray
+    list [catch {set x(2)} msg] $msg $info
+} {0 zzz {x 2 r 0 zzz}}
+test trace-1.10 {trace variable reads} {
+    catch {unset x}
+    set x 444
+    set info {}
+    trace var x r traceScalar
+    unset x
+    set info
+} {}
+
+# Basic write-tracing on variables
+
+test trace-2.1 {trace variable writes} {
+    catch {unset x}
+    set info {}
+    trace var x w traceScalar
+    set x 123
+    set info
+} {x {} w 0 123}
+test trace-2.2 {trace writes to array elements} {
+    catch {unset x}
+    set info {}
+    trace var x(33) w traceArray
+    set x(33) 444
+    set info
+} {x 33 w 0 444}
+test trace-2.3 {trace writes on whole arrays} {
+    catch {unset x}
+    set info {}
+    trace var x w traceArray
+    set x(abc) qq
+    set info
+} {x abc w 0 qq}
+test trace-2.4 {trace variable writes} {
+    catch {unset x}
+    set x 1234
+    set info {}
+    trace var x w traceScalar
+    set x
+    set info
+} {}
+test trace-2.5 {trace variable writes} {
+    catch {unset x}
+    set x 1234
+    set info {}
+    trace var x w traceScalar
+    unset x
+    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 {}
+    trace var x r traceScalarAppend
+    append x 123
+    append x 456
+    lappend x 789
+    set info
+} {x {} r 0 123456}
+test trace-3.2 {trace variable read-modify-writes} {
+    catch {unset x}
+    set info {}
+    trace var x rw traceScalarAppend
+    append x 123
+    lappend x 456
+    set info
+} {x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
+
+# Basic unset-tracing on variables
+
+test trace-4.1 {trace variable unsets} {
+    catch {unset x}
+    set info {}
+    trace var x u traceScalar
+    catch {unset x}
+    set info
+} {x {} u 1 {can't read "x": no such variable}}
+test trace-4.2 {variable mustn't exist during unset trace} {
+    catch {unset x}
+    set x 1234
+    set info {}
+    trace var x u traceScalar
+    unset x
+    set info
+} {x {} u 1 {can't read "x": no such variable}}
+test trace-4.3 {unset traces mustn't be called during reads and writes} {
+    catch {unset x}
+    set info {}
+    trace var x u traceScalar
+    set x 44
+    set x
+    set info
+} {}
+test trace-4.4 {trace unsets on array elements} {
+    catch {unset x}
+    set x(0) 18
+    set info {}
+    trace var x(1) u traceArray
+    catch {unset x(1)}
+    set info
+} {x 1 u 1 {can't read "x(1)": no such element in array}}
+test trace-4.5 {trace unsets on array elements} {
+    catch {unset x}
+    set x(1) 18
+    set info {}
+    trace var x(1) u traceArray
+    unset x(1)
+    set info
+} {x 1 u 1 {can't read "x(1)": no such element in array}}
+test trace-4.6 {trace unsets on array elements} {
+    catch {unset x}
+    set x(1) 18
+    set info {}
+    trace var x(1) u traceArray
+    unset x
+    set info
+} {x 1 u 1 {can't read "x(1)": no such variable}}
+test trace-4.7 {trace unsets on whole arrays} {
+    catch {unset x}
+    set x(1) 18
+    set info {}
+    trace var x u traceProc
+    catch {unset x(0)}
+    set info
+} {}
+test trace-4.8 {trace unsets on whole arrays} {
+    catch {unset x}
+    set x(1) 18
+    set x(2) 144
+    set x(3) 14
+    set info {}
+    trace var x u traceProc
+    unset x(1)
+    set info
+} {x 1 u}
+test trace-4.9 {trace unsets on whole arrays} {
+    catch {unset x}
+    set x(1) 18
+    set x(2) 144
+    set x(3) 14
+    set info {}
+    trace var x u traceProc
+    unset x
+    set info
+} {x {} u}
+
+# Trace multiple trace types at once.
+
+test trace-5.1 {multiple ops traced at once} {
+    catch {unset x}
+    set info {}
+    trace var x rwu traceProc
+    catch {set x}
+    set x 22
+    set x
+    set x 33
+    unset x
+    set info
+} {x {} r x {} w x {} r x {} w x {} u}
+test trace-5.2 {multiple ops traced on array element} {
+    catch {unset x}
+    set info {}
+    trace var x(0) rwu traceProc
+    catch {set x(0)}
+    set x(0) 22
+    set x(0)
+    set x(0) 33
+    unset x(0)
+    unset x
+    set info
+} {x 0 r x 0 w x 0 r x 0 w x 0 u}
+test trace-5.3 {multiple ops traced on whole array} {
+    catch {unset x}
+    set info {}
+    trace var x rwu traceProc
+    catch {set x(0)}
+    set x(0) 22
+    set x(0)
+    set x(0) 33
+    unset x(0)
+    unset x
+    set info
+} {x 0 w x 0 r x 0 w x 0 u x {} u}
+
+# Check order of invocation of traces
+
+test trace-6.1 {order of invocation of traces} {
+    catch {unset x}
+    set info {}
+    trace var x r "traceTag 1"
+    trace var x r "traceTag 2"
+    trace var x r "traceTag 3"
+    catch {set x}
+    set x 22
+    set x
+    set info
+} {3 2 1 3 2 1}
+test trace-6.2 {order of invocation of traces} {
+    catch {unset x}
+    set x(0) 44
+    set info {}
+    trace var x(0) r "traceTag 1"
+    trace var x(0) r "traceTag 2"
+    trace var x(0) r "traceTag 3"
+    set x(0)
+    set info
+} {3 2 1}
+test trace-6.3 {order of invocation of traces} {
+    catch {unset x}
+    set x(0) 44
+    set info {}
+    trace var x(0) r "traceTag 1"
+    trace var x r "traceTag A1"
+    trace var x(0) r "traceTag 2"
+    trace var x r "traceTag A2"
+    trace var x(0) r "traceTag 3"
+    trace var x r "traceTag A3"
+    set x(0)
+    set info
+} {A3 A2 A1 3 2 1}
+
+# Check effects of errors in trace procedures
+
+test trace-7.1 {error returns from traces} {
+    catch {unset x}
+    set x 123
+    set info {}
+    trace var x r "traceTag 1"
+    trace var x r traceError
+    list [catch {set x} msg] $msg $info
+} {1 {can't read "x": trace returned error} {}}
+test trace-7.2 {error returns from traces} {
+    catch {unset x}
+    set x 123
+    set info {}
+    trace var x w "traceTag 1"
+    trace var x w traceError
+    list [catch {set x 44} msg] $msg $info
+} {1 {can't set "x": trace returned error} {}}
+test trace-7.3 {error returns from traces} {
+    catch {unset x}
+    set x 123
+    set info {}
+    trace var x w traceError
+    list [catch {append x 44} msg] $msg $info
+} {1 {can't set "x": trace returned error} {}}
+test trace-7.4 {error returns from traces} {
+    catch {unset x}
+    set x 123
+    set info {}
+    trace var x u "traceTag 1"
+    trace var x u traceError
+    list [catch {unset x} msg] $msg $info
+} {0 {} 1}
+test trace-7.5 {error returns from traces} {
+    catch {unset x}
+    set x(0) 123
+    set info {}
+    trace var x(0) r "traceTag 1"
+    trace var x r "traceTag 2"
+    trace var x r traceError
+    trace var x r "traceTag 3"
+    list [catch {set x(0)} msg] $msg $info
+} {1 {can't read "x(0)": trace returned error} 3}
+test trace-7.6 {error returns from traces} {
+    catch {unset x}
+    set x 123
+    trace var x u traceError
+    list [catch {unset x} msg] $msg
+} {0 {}}
+test trace-7.7 {error returns from traces} {
+    # This test just makes sure that the memory for the error message
+    # gets deallocated correctly when the trace is invoked again or
+    # when the trace is deleted.
+    catch {unset x}
+    set x 123
+    trace var x r traceError
+    catch {set x}
+    catch {set x}
+    trace vdelete x r traceError
+} {}
+
+# Check to see that variables are expunged before trace
+# procedures are invoked, so trace procedure can even manipulate
+# a new copy of the variables.
+
+test trace-8.1 {be sure variable is unset before trace is called} {
+    catch {unset x}
+    set x 33
+    set info {}
+    trace var x u {traceCheck {uplevel set x}}
+    unset x
+    set info
+} {1 {can't read "x": no such variable}}
+test trace-8.2 {be sure variable is unset before trace is called} {
+    catch {unset x}
+    set x 33
+    set info {}
+    trace var x u {traceCheck {uplevel set x 22}}
+    unset x
+    concat $info [list [catch {set x} msg] $msg]
+} {0 22 0 22}
+test trace-8.3 {be sure traces are cleared before unset trace called} {
+    catch {unset x}
+    set x 33
+    set info {}
+    trace var x u {traceCheck {uplevel trace vinfo x}}
+    unset x
+    set info
+} {0 {}}
+test trace-8.4 {set new trace during unset trace} {
+    catch {unset x}
+    set x 33
+    set info {}
+    trace var x u {traceCheck {global x; trace var x u traceProc}}
+    unset x
+    concat $info [trace vinfo x]
+} {0 {} {u traceProc}}
+
+test trace-9.1 {make sure array elements are unset before traces are called} {
+    catch {unset x}
+    set x(0) 33
+    set info {}
+    trace var x(0) u {traceCheck {uplevel set x(0)}}
+    unset x(0)
+    set info
+} {1 {can't read "x(0)": no such element in array}}
+test trace-9.2 {make sure array elements are unset before traces are called} {
+    catch {unset x}
+    set x(0) 33
+    set info {}
+    trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
+    unset x(0)
+    concat $info [list [catch {set x(0)} msg] $msg]
+} {0 zzz 0 zzz}
+test trace-9.3 {array elements are unset before traces are called} {
+    catch {unset x}
+    set x(0) 33
+    set info {}
+    trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
+    unset x(0)
+    set info
+} {0 {}}
+test trace-9.4 {set new array element trace during unset trace} {
+    catch {unset x}
+    set x(0) 33
+    set info {}
+    trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
+    catch {unset x(0)}
+    concat $info [trace vinfo x(0)]
+} {0 {} {r {}}}
+
+test trace-10.1 {make sure arrays are unset before traces are called} {
+    catch {unset x}
+    set x(0) 33
+    set info {}
+    trace var x u {traceCheck {uplevel set x(0)}}
+    unset x
+    set info
+} {1 {can't read "x(0)": no such variable}}
+test trace-10.2 {make sure arrays are unset before traces are called} {
+    catch {unset x}
+    set x(y) 33
+    set info {}
+    trace var x u {traceCheck {uplevel set x(y) 22}}
+    unset x
+    concat $info [list [catch {set x(y)} msg] $msg]
+} {0 22 0 22}
+test trace-10.3 {make sure arrays are unset before traces are called} {
+    catch {unset x}
+    set x(y) 33
+    set info {}
+    trace var x u {traceCheck {uplevel array exists x}}
+    unset x
+    set info
+} {0 0}
+test trace-10.4 {make sure arrays are unset before traces are called} {
+    catch {unset x}
+    set x(y) 33
+    set info {}
+    set cmd {traceCheck {uplevel {trace vinfo x}}}
+    trace var x u $cmd
+    unset x
+    set info
+} {0 {}}
+test trace-10.5 {set new array trace during unset trace} {
+    catch {unset x}
+    set x(y) 33
+    set info {}
+    trace var x u {traceCheck {global x; trace var x r {}}}
+    unset x
+    concat $info [trace vinfo x]
+} {0 {} {r {}}}
+test trace-10.6 {create scalar during array unset trace} {
+    catch {unset x}
+    set x(y) 33
+    set info {}
+    trace var x u {traceCheck {global x; set x 44}}
+    unset x
+    concat $info [list [catch {set x} msg] $msg]
+} {0 44 0 44}
+
+# Check special conditions (e.g. errors) in Tcl_TraceVar2.
+
+test trace-11.1 {creating array when setting variable traces} {
+    catch {unset x}
+    set info {}
+    trace var x(0) w traceProc
+    list [catch {set x 22} msg] $msg
+} {1 {can't set "x": variable is array}}
+test trace-11.2 {creating array when setting variable traces} {
+    catch {unset x}
+    set info {}
+    trace var x(0) w traceProc
+    list [catch {set x(0)} msg] $msg
+} {1 {can't read "x(0)": no such element in array}}
+test trace-11.3 {creating array when setting variable traces} {
+    catch {unset x}
+    set info {}
+    trace var x(0) w traceProc
+    set x(0) 22
+    set info
+} {x 0 w}
+test trace-11.4 {creating variable when setting variable traces} {
+    catch {unset x}
+    set info {}
+    trace var x w traceProc
+    list [catch {set x} msg] $msg
+} {1 {can't read "x": no such variable}}
+test trace-11.5 {creating variable when setting variable traces} {
+    catch {unset x}
+    set info {}
+    trace var x w traceProc
+    set x 22
+    set info
+} {x {} w}
+test trace-11.6 {creating variable when setting variable traces} {
+    catch {unset x}
+    set info {}
+    trace var x w traceProc
+    set x(0) 22
+    set info
+} {x 0 w}
+test trace-11.7 {create array element during read trace} {
+    catch {unset x}
+    set x(2) zzz
+    trace var x r {traceCrtElement xyzzy}
+    list [catch {set x(3)} msg] $msg
+} {0 xyzzy}
+test trace-11.8 {errors when setting variable traces} {
+    catch {unset x}
+    set x 44
+    list [catch {trace var x(0) w traceProc} msg] $msg
+} {1 {can't trace "x(0)": variable isn't array}}
+
+# Check deleting one trace from another.
+
+test trace-12.1 {delete one trace from another} {
+    proc delTraces {args} {
+	global x
+	trace vdel x r {traceTag 2}
+	trace vdel x r {traceTag 3}
+	trace vdel x r {traceTag 4}
+    }
+    catch {unset x}
+    set x 44
+    set info {}
+    trace var x r {traceTag 1}
+    trace var x r {traceTag 2}
+    trace var x r {traceTag 3}
+    trace var x r {traceTag 4}
+    trace var x r delTraces 
+    trace var x r {traceTag 5}
+    set x
+    set info
+} {5 1}
+
+# Check operation and syntax of "trace" command.
+
+test trace-13.1 {trace command (overall)} {
+    list [catch {trace} msg] $msg
+} {1 {too few args: should be "trace option [arg arg ...]"}}
+test trace-13.2 {trace command (overall)} {
+    list [catch {trace gorp} msg] $msg
+} {1 {bad option "gorp": should be variable, vdelete, or vinfo}}
+test trace-13.3 {trace command ("variable" option)} {
+    list [catch {trace variable x y} msg] $msg
+} {1 {wrong # args: should be "trace variable name ops command"}}
+test trace-13.4 {trace command ("variable" option)} {
+    list [catch {trace var x y z z2} msg] $msg
+} {1 {wrong # args: should be "trace variable name ops command"}}
+test trace-13.5 {trace command ("variable" option)} {
+    list [catch {trace var x y z} msg] $msg
+} {1 {bad operations "y": should be one or more of rwu}}
+test trace-13.6 {trace command ("vdelete" option)} {
+    list [catch {trace vdelete x y} msg] $msg
+} {1 {wrong # args: should be "trace vdelete name ops command"}}
+test trace-13.7 {trace command ("vdelete" option)} {
+    list [catch {trace vdelete x y z foo} msg] $msg
+} {1 {wrong # args: should be "trace vdelete name ops command"}}
+test trace-13.8 {trace command ("vdelete" option)} {
+    list [catch {trace vdelete x y z} msg] $msg
+} {1 {bad operations "y": should be one or more of rwu}}
+test trace-13.9 {trace command ("vdelete" option)} {
+    catch {unset x}
+    set info {}
+    trace var x w traceProc
+    trace vdelete x w traceProc
+} {}
+test trace-13.10 {trace command ("vdelete" option)} {
+    catch {unset x}
+    set info {}
+    trace var x w traceProc
+    trace vdelete x w traceProc
+    set x 12345
+    set info
+} {}
+test trace-13.11 {trace command ("vdelete" option)} {
+    catch {unset x}
+    set info {}
+    trace var x w {traceTag 1}
+    trace var x w traceProc
+    trace var x w {traceTag 2}
+    set x yy
+    trace vdelete x w traceProc
+    set x 12345
+    trace vdelete x w {traceTag 1}
+    set x foo
+    trace vdelete x w {traceTag 2}
+    set x gorp
+    set info
+} {2 x {} w 1 2 1 2}
+test trace-13.12 {trace command ("vdelete" option)} {
+    catch {unset x}
+    set info {}
+    trace var x w {traceTag 1}
+    trace vdelete x w non_existent
+    set x 12345
+    set info
+} {1}
+test trace-13.13 {trace command ("vinfo" option)} {
+    list [catch {trace vinfo} msg] $msg]
+} {1 {wrong # args: should be "trace vinfo name"]}}
+test trace-13.14 {trace command ("vinfo" option)} {
+    list [catch {trace vinfo x y} msg] $msg]
+} {1 {wrong # args: should be "trace vinfo name"]}}
+test trace-13.15 {trace command ("vinfo" option)} {
+    catch {unset x}
+    trace var x w {traceTag 1}
+    trace var x w traceProc
+    trace var x w {traceTag 2}
+    trace vinfo x
+} {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
+test trace-13.16 {trace command ("vinfo" option)} {
+    catch {unset x}
+    trace vinfo x
+} {}
+test trace-13.17 {trace command ("vinfo" option)} {
+    catch {unset x}
+    trace vinfo x(0)
+} {}
+test trace-13.18 {trace command ("vinfo" option)} {
+    catch {unset x}
+    set x 44
+    trace vinfo x(0)
+} {}
+test trace-13.19 {trace command ("vinfo" option)} {
+    catch {unset x}
+    set x 44
+    trace var x w {traceTag 1}
+    proc check {} {global x; trace vinfo x}
+    check
+} {{w {traceTag 1}}}
+
+# Check fancy trace commands (long ones, weird arguments, etc.)
+
+test trace-14.1 {long trace command} {
+    catch {unset x}
+    set info {}
+    trace var x w {traceTag {This is a very very long argument.  It's \
+	designed to test out the facilities of TraceVarProc for dealing \
+	with such long arguments by malloc-ing space.  One possibility \
+	is that space doesn't get freed properly.  If this happens, then \
+	invoking this test over and over again will eventually leak memory.}}
+    set x 44
+    set info
+} {This is a very very long argument.  It's \
+	designed to test out the facilities of TraceVarProc for dealing \
+	with such long arguments by malloc-ing space.  One possibility \
+	is that space doesn't get freed properly.  If this happens, then \
+	invoking this test over and over again will eventually leak memory.}
+test trace-14.2 {long trace command result to ignore} {
+    proc longResult {args} {return "quite a bit of text, designed to
+	generate a core leak if this command file is invoked over and over again
+	and memory isn't being recycled correctly"}
+    catch {unset x}
+    trace var x w longResult
+    set x 44
+    set x 5
+    set x abcde
+} abcde
+test trace-14.3 {special list-handling in trace commands} {
+    catch {unset "x y z"}
+    set "x y z(a\n\{)" 44
+    set info {}
+    trace var "x y z(a\n\{)" w traceProc
+    set "x y z(a\n\{)" 33
+    set info
+} "{x y z} a\\n\\{ w"
+
+# Check for proper handling of unsets during traces.
+
+proc traceUnset {unsetName args} {
+    global info
+    upvar $unsetName x
+    lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
+}
+proc traceReset {unsetName resetName args} {
+    global info
+    upvar $unsetName x $resetName y
+    lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
+}
+proc traceReset2 {unsetName resetName args} {
+    global info
+    lappend info [catch {uplevel unset $unsetName} msg] $msg \
+	    [catch {uplevel set $resetName xyzzy} msg] $msg
+}
+proc traceAppend {string name1 name2 op} {
+    global info
+    lappend info $string
+}
+
+test trace-15.1 {unsets during read traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y r {traceUnset y}
+    trace var y u {traceAppend unset}
+    lappend info [catch {set y} msg] $msg
+} {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
+test trace-15.2 {unsets during read traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) r {traceUnset y(0)}
+    lappend info [catch {set y(0)} msg] $msg
+} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
+test trace-15.3 {unsets during read traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) r {traceUnset y}
+    lappend info [catch {set y(0)} msg] $msg
+} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
+test trace-15.4 {unsets during read traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y r {traceReset y y}
+    lappend info [catch {set y} msg] $msg
+} {0 {} 0 xyzzy 0 xyzzy}
+test trace-15.5 {unsets during read traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) r {traceReset y(0) y(0)}
+    lappend info [catch {set y(0)} msg] $msg
+} {0 {} 0 xyzzy 0 xyzzy}
+test trace-15.6 {unsets during read traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) r {traceReset y y(0)}
+    lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
+} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
+test trace-15.7 {unsets during read traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) r {traceReset2 y y(0)}
+    lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
+} {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
+test trace-15.8 {unsets during write traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y w {traceUnset y}
+    trace var y u {traceAppend unset}
+    lappend info [catch {set y xxx} msg] $msg
+} {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
+test trace-15.9 {unsets during write traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) w {traceUnset y(0)}
+    lappend info [catch {set y(0) xxx} msg] $msg
+} {0 {} 1 {can't read "x": no such variable} 0 {}}
+test trace-15.10 {unsets during write traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) w {traceUnset y}
+    lappend info [catch {set y(0) xxx} msg] $msg
+} {0 {} 1 {can't read "x": no such variable} 0 {}}
+test trace-15.11 {unsets during write traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y w {traceReset y y}
+    lappend info [catch {set y xxx} msg] $msg
+} {0 {} 0 xyzzy 0 xyzzy}
+test trace-15.12 {unsets during write traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) w {traceReset y(0) y(0)}
+    lappend info [catch {set y(0) xxx} msg] $msg
+} {0 {} 0 xyzzy 0 xyzzy}
+test trace-15.13 {unsets during write traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) w {traceReset y y(0)}
+    lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
+} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
+test trace-15.14 {unsets during write traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) w {traceReset2 y y(0)}
+    lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
+} {0 {} 0 xyzzy 0 {} 0 xyzzy}
+test trace-15.15 {unsets during unset traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y u {traceUnset y}
+    lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
+} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
+test trace-15.16 {unsets during unset traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) u {traceUnset y(0)}
+    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
+} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
+test trace-15.17 {unsets during unset traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) u {traceUnset y}
+    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
+} {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
+test trace-15.18 {unsets during unset traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y u {traceReset2 y y}
+    lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
+} {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
+test trace-15.19 {unsets during unset traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) u {traceReset2 y(0) y(0)}
+    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
+} {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
+test trace-15.20 {unsets during unset traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) u {traceReset2 y y(0)}
+    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
+} {0 {} 0 xyzzy 0 {} 0 xyzzy}
+test trace-15.21 {unsets cancelling traces} {
+    catch {unset y}
+    set y 1234
+    set info {}
+    trace var y r {traceAppend first}
+    trace var y r {traceUnset y}
+    trace var y r {traceAppend third}
+    trace var y u {traceAppend unset}
+    lappend info [catch {set y} msg] $msg
+} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
+test trace-15.22 {unsets cancelling traces} {
+    catch {unset y}
+    set y(0) 1234
+    set info {}
+    trace var y(0) r {traceAppend first}
+    trace var y(0) r {traceUnset y}
+    trace var y(0) r {traceAppend third}
+    trace var y(0) u {traceAppend unset}
+    lappend info [catch {set y(0)} msg] $msg
+} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
+
+# Check various non-interference between traces and other things.
+
+test trace-16.1 {trace doesn't prevent unset errors} {
+    catch {unset x}
+    set info {}
+    trace var x u {traceProc}
+    list [catch {unset x} msg] $msg $info
+} {1 {can't unset "x": no such variable} {x {} u}}
+test trace-16.2 {traced variables must survive procedure exits} {
+    catch {unset x}
+    proc p1 {} {global x; trace var x w traceProc}
+    p1
+    trace vinfo x
+} {{w traceProc}}
+test trace-16.3 {traced variables must survive procedure exits} {
+    catch {unset x}
+    set info {}
+    proc p1 {} {global x; trace var x w traceProc}
+    p1
+    set x 44
+    set info
+} {x {} w}
+
+# Be sure that procedure frames are released before unset traces
+# are invoked.
+
+test trace-17.1 {unset traces on procedure returns} {
+    proc p1 {x y} {set a 44; p2 14}
+    proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
+    set info {}
+    p1 foo bar
+    set info
+} {0 {a x y}}
+
+# Delete arrays when done, so they can be re-used as scalars
+# elsewhere.
+
+catch {unset x}
+catch {unset y}
+concat {}
diff --git a/tcl/tests/unixFCmd.test b/tcl/tests/unixFCmd.test
new file mode 100644
index 00000000000..02288a46f8a
--- /dev/null
+++ b/tcl/tests/unixFCmd.test
@@ -0,0 +1,270 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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} {
+    cleanup
+    file mkdir foo/bar
+    file attr foo -perm 040555
+    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
+    set a1 {1 {can't unlink "foo/bar": permission denied}}
+    set result [expr {$msg == $a1}]
+    catch {file delete /tmp/bar}
+    catch {file attr foo -perm 040777}
+    catch {file delete -force foo}
+    set result
+} {1}
+test unixFCmd-1.8 {Checking EINTR Bug} nonPortable {
+    testalarm 
+    after 2000
+    list [testgotsig] [testgotsig]
+} {1 0}
+test unixFCmd-1.9 {Checking EINTR Bug} nonPortable {
+    cleanup
+    set f [open tfalarm w]
+    puts $f {
+	after 2000
+	puts "hello world"
+	exit 0
+    }
+    close $f
+    testalarm 
+    set pipe [open "|[info nameofexecutable] tfalarm" r+]
+    set line [read $pipe 1]
+    catch {close $pipe}
+    list $line [testgotsig]
+} {h 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"} {}}
+test unixFCmd-18.1 {Unix pwd} {nonPortable} {
+    # This test is nonportable because SunOS generates a weird error
+    # message when the current directory isn't readable.
+    set cd [pwd]
+    set nd $cd/tstdir
+    file mkdir $nd
+    cd $nd
+    exec chmod 000 $nd
+    set r [list [catch {pwd} res] [string range $res 0 36]];
+    cd $cd;
+    exec chmod 755 $nd
+    file delete $nd
+    set r
+} {1 {error getting working directory name:}}
+
+cleanup
diff --git a/tcl/tests/unixFile.test b/tcl/tests/unixFile.test
new file mode 100644
index 00000000000..cecaedc1c4b
--- /dev/null
+++ b/tcl/tests/unixFile.test
@@ -0,0 +1,66 @@
+# This file contains tests for the routines in the file tclUnixFile.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) 1998 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+ 
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {[info commands testobj] == {}} {
+    puts "This application hasn't been compiled with the \"testfindexecutable\""
+    puts "command, so I can't test the Tcl_FindExecutable function"
+    return
+}
+
+if {$tcl_platform(platform) != "unix"} {
+    return
+}
+
+
+set oldPath $env(PATH)
+close [open junk w]
+file attributes junk -perm 0777
+
+set absPath [file join [pwd] junk]
+test unixFile-1.1 {Tcl_FindExecutable} {
+    set env(PATH) ""
+    testfindexecutable junk
+} $absPath
+test unixFile-1.2 {Tcl_FindExecutable} {
+    set env(PATH) "/dummy"
+    testfindexecutable junk
+} {}
+test unixFile-1.3 {Tcl_FindExecutable} {
+    set env(PATH) "/dummy:[pwd]"
+    testfindexecutable junk
+} $absPath
+test unixFile-1.4 {Tcl_FindExecutable} {
+    set env(PATH) "/dummy:"
+    testfindexecutable junk
+} $absPath
+test unixFile-1.5 {Tcl_FindExecutable} {
+    set env(PATH) "/dummy:/dummy"
+    testfindexecutable junk
+} {}
+test unixFile-1.6 {Tcl_FindExecutable} {
+    set env(PATH) "/dummy::/dummy"
+    testfindexecutable junk
+} $absPath
+test unixFile-1.7 {Tcl_FindExecutable} {
+    set env(PATH) ":/dummy"
+    testfindexecutable junk
+} $absPath
+
+
+
+
+set env(PATH) $oldPath
+file delete junk
diff --git a/tcl/tests/unixNotfy.test b/tcl/tests/unixNotfy.test
new file mode 100644
index 00000000000..79d59b7d46d
--- /dev/null
+++ b/tcl/tests/unixNotfy.test
@@ -0,0 +1,50 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+if {$tcl_platform(platform) != "unix"} {
+    return
+}
+
+# The tests should not be run if you have a notifier which is unable to
+# detect infinite vwaits, as the tests below will hang. The presence of
+# the "testeventloop" command indicates that this is the case.
+
+if {"[info commands testeventloop]" == "testeventloop"} {
+    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
+file delete foo2
diff --git a/tcl/tests/unknown.test b/tcl/tests/unknown.test
new file mode 100644
index 00000000000..d769c315694
--- /dev/null
+++ b/tcl/tests/unknown.test
@@ -0,0 +1,61 @@
+# Commands covered:  unknown
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+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} {
+    list [catch {_non-existent_ foo bar} msg] $msg
+} {1 {invalid command name "_non-existent_"}}
+
+proc unknown {args} {
+    global x
+    set x $args
+}
+
+test unknown-2.1 {calling "unknown" command} {
+    foobar x y z
+    set x
+} {foobar x y z}
+test unknown-2.2 {calling "unknown" command with lots of args} {
+    foobar 1 2 3 4 5 6 7
+    set x
+} {foobar 1 2 3 4 5 6 7}
+test unknown-2.3 {calling "unknown" command with lots of args} {
+    foobar 1 2 3 4 5 6 7 8
+    set x
+} {foobar 1 2 3 4 5 6 7 8}
+test unknown-2.4 {calling "unknown" command with lots of args} {
+    foobar 1 2 3 4 5 6 7 8 9
+    set x
+} {foobar 1 2 3 4 5 6 7 8 9}
+
+test unknown-3.1 {argument quoting in calls to "unknown"} {
+    foobar \{ \} a\{b \; "\\" \$a a\[b \]
+    set x
+} "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
+
+proc unknown args {
+    error "unknown failed"
+}
+
+test unknown-4.1 {errors in "unknown" procedure} {
+    list [catch {non-existent a b} msg] $msg $errorCode
+} {1 {unknown failed} NONE}
+
+catch {rename unknown {}}
+catch {rename unknown.old unknown}
+return {}
diff --git a/tcl/tests/uplevel.test b/tcl/tests/uplevel.test
new file mode 100644
index 00000000000..986cd147443
--- /dev/null
+++ b/tcl/tests/uplevel.test
@@ -0,0 +1,109 @@
+# Commands covered:  uplevel
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+proc a {x y} {
+    newset z [expr $x+$y]
+    return $z
+}
+proc newset {name value} {
+    uplevel set $name $value
+    uplevel 1 {uplevel 1 {set xyz 22}}
+}
+
+test uplevel-1.1 {simple operation} {
+    set xyz 0
+    a 22 33
+} 55
+test uplevel-1.2 {command is another uplevel command} {
+    set xyz 0
+    a 22 33
+    set xyz
+} 22
+
+proc a1 {} {
+    b1
+    global a a1
+    set a $x
+    set a1 $y
+}
+proc b1 {} {
+    c1
+    global b b1
+    set b $x
+    set b1 $y
+}
+proc c1 {} {
+    uplevel 1 set x 111
+    uplevel #2 set y 222
+    uplevel 2 set x 333
+    uplevel #1 set y 444
+    uplevel 3 set x 555
+    uplevel #0 set y 666
+}
+a1
+test uplevel-2.1 {relative and absolute uplevel} {set a} 333
+test uplevel-2.2 {relative and absolute uplevel} {set a1} 444
+test uplevel-2.3 {relative and absolute uplevel} {set b} 111
+test uplevel-2.4 {relative and absolute uplevel} {set b1} 222
+test uplevel-2.5 {relative and absolute uplevel} {set x} 555
+test uplevel-2.6 {relative and absolute uplevel} {set y} 666
+
+test uplevel-3.1 {uplevel to same level} {
+    set x 33
+    uplevel #0 set x 44
+    set x
+} 44
+test uplevel-3.2 {uplevel to same level} {
+    set x 33
+    uplevel 0 set x
+} 33
+test uplevel-3.3 {uplevel to same level} {
+    set y xxx
+    proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
+    a1
+} 66
+test uplevel-3.4 {uplevel to same level} {
+    set y zzz
+    proc a1 {} {set y 55; uplevel #1 set y}
+    a1
+} 55
+
+test uplevel-4.1 {error: non-existent level} {
+    list [catch c1 msg] $msg
+} {1 {bad level "#2"}}
+test uplevel-4.2 {error: non-existent level} {
+    proc c2 {} {uplevel 3 {set a b}}
+    list [catch c2 msg] $msg
+} {1 {bad level "3"}}
+test uplevel-4.3 {error: not enough args} {
+    list [catch uplevel msg] $msg
+} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
+test uplevel-4.4 {error: not enough args} {
+    proc upBug {} {uplevel 1}
+    list [catch upBug msg] $msg
+} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
+
+proc a2 {} {
+    uplevel a3
+}
+proc a3 {} {
+    global x y
+    set x [info level]
+    set y [info level 1]
+}
+a2
+test uplevel-5.1 {info level} {set x} 1
+test uplevel-5.2 {info level} {set y} a3
diff --git a/tcl/tests/upvar.test b/tcl/tests/upvar.test
new file mode 100644
index 00000000000..e4ab63bcc60
--- /dev/null
+++ b/tcl/tests/upvar.test
@@ -0,0 +1,399 @@
+# Commands covered:  upvar
+#
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test upvar-1.1 {reading variables with upvar} {
+    proc p1 {a b} {set c 22; set d 33; p2}
+    proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
+    p1 foo bar
+} {foo bar 22 33 abc}
+test upvar-1.2 {reading variables with upvar} {
+    proc p1 {a b} {set c 22; set d 33; p2}
+    proc p2 {} {p3}
+    proc p3 {} {upvar 2 a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
+    p1 foo bar
+} {foo bar 22 33 abc}
+test upvar-1.3 {reading variables with upvar} {
+    proc p1 {a b} {set c 22; set d 33; p2}
+    proc p2 {} {p3}
+    proc p3 {} {
+	upvar #1 a x1 b x2 c x3 d x4
+	set a abc
+	list $x1 $x2 $x3 $x4 $a
+    }
+    p1 foo bar
+} {foo bar 22 33 abc}
+test upvar-1.4 {reading variables with upvar} {
+    set x1 44
+    set x2 55
+    proc p1 {} {p2}
+    proc p2 {} {
+	upvar 2 x1 x1 x2 a
+	upvar #0 x1 b
+	set c $b
+	incr b 3
+	list $x1 $a $b
+    }
+    p1
+} {47 55 47}
+test upvar-1.5 {reading array elements with upvar} {
+    proc p1 {} {set a(0) zeroth; set a(1) first; p2}
+    proc p2 {} {upvar a(0) x; set x}
+    p1
+} {zeroth}
+
+test upvar-2.1 {writing variables with upvar} {
+    proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d}
+    proc p2 {} {
+	upvar a x1 b x2 c x3 d x4
+	set x1 14
+	set x4 88
+    }
+    p1 foo bar
+} {14 bar 22 88}
+test upvar-2.2 {writing variables with upvar} {
+    set x1 44
+    set x2 55
+    proc p1 {x1 x2} {
+	upvar #0 x1 a
+	upvar x2 b
+	set a $x1
+	set b $x2
+    }
+    p1 newbits morebits
+    list $x1 $x2
+} {newbits morebits}
+test upvar-2.3 {writing variables with upvar} {
+    catch {unset x1}
+    catch {unset x2}
+    proc p1 {x1 x2} {
+	upvar #0 x1 a
+	upvar x2 b
+	set a $x1
+	set b $x2
+    }
+    p1 newbits morebits
+    list [catch {set x1} msg] $msg [catch {set x2} msg] $msg
+} {0 newbits 0 morebits}
+test upvar-2.4 {writing array elements with upvar} {
+    proc p1 {} {set a(0) zeroth; set a(1) first; list [p2] $a(0)}
+    proc p2 {} {upvar a(0) x; set x xyzzy}
+    p1
+} {xyzzy xyzzy}
+
+test upvar-3.1 {unsetting variables with upvar} {
+    proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]}
+    proc p2 {} {
+	upvar 1 a x1 d x2
+	unset x1 x2
+    }
+    p1 foo bar
+} {b c}
+test upvar-3.2 {unsetting variables with upvar} {
+    proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]}
+    proc p2 {} {
+	upvar 1 a x1 d x2
+	unset x1 x2
+	set x2 28
+    }
+    p1 foo bar
+} {b c d}
+test upvar-3.3 {unsetting variables with upvar} {
+    set x1 44
+    set x2 55
+    proc p1 {} {p2}
+    proc p2 {} {
+	upvar 2 x1 a
+	upvar #0 x2 b
+	unset a b
+    }
+    p1
+    list [info exists x1] [info exists x2]
+} {0 0}
+test upvar-3.4 {unsetting variables with upvar} {
+    set x1 44
+    set x2 55
+    proc p1 {} {
+	upvar x1 a x2 b
+	unset a b
+	set b 118
+    }
+    p1
+    list [info exists x1] [catch {set x2} msg] $msg
+} {0 0 118}
+test upvar-3.5 {unsetting array elements with upvar} {
+    proc p1 {} {
+	set a(0) zeroth
+	set a(1) first
+	set a(2) second
+	p2
+	array names a
+    }
+    proc p2 {} {upvar a(0) x; unset x}
+    p1
+} {1 2}
+test upvar-3.6 {unsetting then resetting array elements with upvar} {
+    proc p1 {} {
+	set a(0) zeroth
+	set a(1) first
+	set a(2) second
+	p2
+	list [array names a] [catch {set a(0)} msg] $msg
+    }
+    proc p2 {} {upvar a(0) x; unset x; set x 12345}
+    p1
+} {{0 1 2} 0 12345}
+
+test upvar-4.1 {nested upvars} {
+    set x1 88
+    proc p1 {a b} {set c 22; set d 33; p2}
+    proc p2 {} {global x1; upvar c x2; p3}
+    proc p3 {} {
+	upvar x1 a x2 b
+	list $a $b
+    }
+    p1 14 15
+} {88 22}
+test upvar-4.2 {nested upvars} {
+    set x1 88
+    proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d}
+    proc p2 {} {global x1; upvar c x2; p3}
+    proc p3 {} {
+	upvar x1 a x2 b
+	set a foo
+	set b bar
+    }
+    list [p1 14 15] $x1
+} {{14 15 bar 33} foo}
+
+proc tproc {args} {global x; set x [list $args [uplevel info vars]]}
+test upvar-5.1 {traces involving upvars} {
+    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
+    proc p2 {} {upvar c x1; set x1 22}
+    set x ---
+    p1 foo bar
+    set x
+} {{x1 {} w} x1}
+test upvar-5.2 {traces involving upvars} {
+    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
+    proc p2 {} {upvar c x1; set x1}
+    set x ---
+    p1 foo bar
+    set x
+} {{x1 {} r} x1}
+test upvar-5.3 {traces involving upvars} {
+    proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2}
+    proc p2 {} {upvar c x1; unset x1}
+    set x ---
+    p1 foo bar
+    set x
+} {{x1 {} u} x1}
+
+test upvar-6.1 {retargeting an upvar} {
+    proc p1 {} {
+	set a(0) zeroth
+	set a(1) first
+	set a(2) second
+	p2
+    }
+    proc p2 {} {
+	upvar a x
+	set result {}
+	foreach i [array names x] {
+	    upvar a($i) x
+	    lappend result $x
+	}
+	lsort $result
+    }
+    p1
+} {first second zeroth}
+test upvar-6.2 {retargeting an upvar} {
+    set x 44
+    set y abcde
+    proc p1 {} {
+	global x
+	set result $x
+	upvar y x
+	lappend result $x
+    }
+    p1
+} {44 abcde}
+test upvar-6.3 {retargeting an upvar} {
+    set x 44
+    set y abcde
+    proc p1 {} {
+	upvar y x
+	lappend result $x
+	global x
+	lappend result $x
+    }
+    p1
+} {abcde 44}
+
+test upvar-7.1 {upvar to same level} {
+    set x 44
+    set y 55
+    catch {unset uv}
+    upvar #0 x uv
+    set uv abc
+    upvar 0 y uv
+    set uv xyzzy
+    list $x $y
+} {abc xyzzy}
+test upvar-7.2 {upvar to same level} {
+    set x 1234
+    set y 4567
+    proc p1 {x y} {
+	upvar 0 x uv
+	set uv $y
+	return "$x $y"
+    }
+    p1 44 89
+} {89 89}
+test upvar-7.3 {upvar to same level} {
+    set x 1234
+    set y 4567
+    proc p1 {x y} {
+	upvar #1 x uv
+	set uv $y
+	return "$x $y"
+    }
+    p1 xyz abc
+} {abc abc}
+test upvar-7.4 {upvar to same level: tricky problems when deleting variable table} {
+    proc tt {} {upvar #1 toto loc;  return $loc}
+    list [catch tt msg] $msg
+} {1 {can't read "loc": no such variable}}
+test upvar-7.5 {potential memory leak when deleting variable table} {
+    proc leak {} {
+	array set foo {1 2 3 4}
+	upvar 0 foo(1) bar
+    }
+    leak
+} {}
+
+test upvar-8.1 {errors in upvar command} {
+    list [catch upvar msg] $msg
+} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
+test upvar-8.2 {errors in upvar command} {
+    list [catch {upvar 1} msg] $msg
+} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
+test upvar-8.3 {errors in upvar command} {
+    proc p1 {} {upvar a b c}
+    list [catch p1 msg] $msg
+} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
+test upvar-8.4 {errors in upvar command} {
+    proc p1 {} {upvar 0 b b}
+    list [catch p1 msg] $msg
+} {1 {can't upvar from variable to itself}}
+test upvar-8.5 {errors in upvar command} {
+    proc p1 {} {upvar 0 a b; upvar 0 b a}
+    list [catch p1 msg] $msg
+} {1 {can't upvar from variable to itself}}
+test upvar-8.6 {errors in upvar command} {
+    proc p1 {} {set a 33; upvar b a}
+    list [catch p1 msg] $msg
+} {1 {variable "a" already exists}}
+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}}
+test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename MakeLink ""}
+    namespace eval ::test_ns_1 {}
+    proc MakeLink {a} {
+        namespace eval ::test_ns_1 {
+	    upvar a a
+        }
+        unset ::test_ns_1::a
+    }
+    list [catch {MakeLink 1} msg] $msg
+} {1 {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}}
+test upvar-8.10 {upvar will create element alias for new array element} {
+    catch {unset upvarArray}
+    array set upvarArray {}
+    catch {upvar 0 upvarArray(elem) upvarArrayElemAlias}
+} {0}
+
+if {[info commands testupvar] != {}} {
+    test upvar-9.1 {Tcl_UpVar2 procedure} {
+	list [catch {testupvar xyz a {} x global} msg] $msg
+    } {1 {bad level "xyz"}}
+    test upvar-9.2 {Tcl_UpVar2 procedure} {
+	catch {unset a}
+	catch {unset x}
+	set a 44
+	list [catch {testupvar #0 a 1 x global} msg] $msg
+    } {1 {can't access "a(1)": variable isn't array}}
+    test upvar-9.3 {Tcl_UpVar2 procedure} {
+	proc foo {} {
+	    testupvar 1 a {} x local
+	    set x
+	}
+	catch {unset a}
+	catch {unset x}
+	set a 44
+	foo
+    } {44}
+    test upvar-9.4 {Tcl_UpVar2 procedure} {
+	proc foo {} {
+	    testupvar 1 a {} _up_ global
+	    list [catch {set x} msg] $msg
+	}
+	catch {unset a}
+	catch {unset _up_}
+	set a 44
+	concat [foo] $_up_
+    } {1 {can't read "x": no such variable} 44}
+    test upvar-9.5 {Tcl_UpVar2 procedure} {
+	proc foo {} {
+	    testupvar 1 a b x local
+	    set x
+	}
+	catch {unset a}
+	catch {unset x}
+	set a(b) 1234
+	foo
+    } {1234}
+    test upvar-9.6 {Tcl_UpVar procedure} {
+	proc foo {} {
+	    testupvar 1 a x local
+	    set x
+	}
+	catch {unset a}
+	catch {unset x}
+	set a xyzzy
+	foo
+    } {xyzzy}
+    test upvar-9.7 {Tcl_UpVar procedure} {
+	proc foo {} {
+	    testupvar #0 a(b) x local
+	    set x
+	}
+	catch {unset a}
+	catch {unset x}
+	set a(b) 1234
+	foo
+    } {1234}
+}
+catch {unset a}
+
+concat
diff --git a/tcl/tests/util.test b/tcl/tests/util.test
new file mode 100644
index 00000000000..e7548f56711
--- /dev/null
+++ b/tcl/tests/util.test
@@ -0,0 +1,132 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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_ConcatObj - backslash-space at end of argument} {
+    concat a {b\ } c
+} {a b\  c}
+test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b\   } c
+} {a b\  c}
+test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b\\   } c
+} {a b\\  c}
+test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b } c
+} {a b c}
+test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a { } c
+} {a c}
+
+test util-5.1 {Tcl_SetObjErrorCode - one arg} {
+    catch {testsetobjerrorcode 1}
+    list [set errorCode]
+} {1}
+test util-5.2 {Tcl_SetObjErrorCode - two args} {
+    catch {testsetobjerrorcode 1 2}
+    list [set errorCode]
+} {{1 2}}
+test util-5.3 {Tcl_SetObjErrorCode - three args} {
+    catch {testsetobjerrorcode 1 2 3}
+    list [set errorCode]
+} {{1 2 3}}
+test util-5.4 {Tcl_SetObjErrorCode - four args} {
+    catch {testsetobjerrorcode 1 2 3 4}
+    list [set errorCode]
+} {{1 2 3 4}}
+test util-5.5 {Tcl_SetObjErrorCode - five args} {
+    catch {testsetobjerrorcode 1 2 3 4 5}
+    list [set errorCode]
+} {{1 2 3 4 5}}
+
+test util-6.1 {Tcl_PrintDouble - using tcl_precision} {
+    concat x[expr 1.4]
+} {x1.4}
+test util-6.2 {Tcl_PrintDouble - using tcl_precision} {
+    concat x[expr 1.39999999999]
+} {x1.39999999999}
+test util-6.3 {Tcl_PrintDouble - using tcl_precision} {
+    concat x[expr 1.399999999999]
+} {x1.4}
+test util-6.4 {Tcl_PrintDouble - using tcl_precision} {
+    set tcl_precision 5
+    concat x[expr 1.123412341234]
+} {x1.1234}
+set tcl_precision 12
+test util-6.4 {Tcl_PrintDouble - make sure there's a decimal point} {
+    concat x[expr 2.0]
+} {x2.0}
+test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} {
+    concat x[expr 3.0e98]
+} {x3e+98}
+
+test util-7.1 {TclPrecTraceProc - unset callbacks} {
+    set tcl_precision 7
+    set x $tcl_precision
+    unset tcl_precision
+    list $x $tcl_precision
+} {7 7}
+test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} {
+    set tcl_precision 12
+    interp create child
+    set x [child eval set tcl_precision]
+    child eval {set tcl_precision 6}
+    interp delete child
+    list $x $tcl_precision
+} {12 6}
+test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} {
+    set tcl_precision 12
+    interp create -safe child
+    set x [child eval {
+	list [catch {set tcl_precision 8} msg] $msg
+    }]
+    interp delete child
+    list $x $tcl_precision
+} {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}
+test util-7.3 {TclPrecTraceProc - write traces, bogus values} {
+    set tcl_precision 12
+    list [catch {set tcl_precision abc} msg] $msg $tcl_precision
+} {1 {can't set "tcl_precision": improper value for precision} 12}
+
+set tcl_precision 12
+concat ""
diff --git a/tcl/tests/var.test b/tcl/tests/var.test
new file mode 100644
index 00000000000..608e6b9e90e
--- /dev/null
+++ b/tcl/tests/var.test
@@ -0,0 +1,472 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+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 exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
+} {0 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, mark as namespace var so var persists until namespace is destroyed or var is unset} {
+    catch {namespace delete test_ns_var2}
+    set a ""
+    namespace eval test_ns_var2 {
+        variable x 123
+        variable y
+        variable z
+    }
+    lappend a [info vars test_ns_var2::*]
+    lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
+        [info exists test_ns_var2::z]
+    lappend a [list [catch {set test_ns_var2::y} msg] $msg]
+    lappend a [info vars test_ns_var2::*]
+    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
+    lappend a [set test_ns_var2::y hello]
+    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
+    lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
+    lappend a [info vars test_ns_var2::*]
+    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
+    lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
+    lappend a [namespace delete test_ns_var2]
+    set a
+} {{::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z} 1 0 0\
+{1 {can't read "test_ns_var2::y": no such variable}}\
+{::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z} 0 0\
+hello 1 0\
+{0 {}}\
+{::test_ns_var2::x ::test_ns_var2::z} 0 0\
+{1 {can't unset "test_ns_var2::z": no such variable}}\
+{}}
+test var-7.10 {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.11 {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.12 {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}}
+
+if {[info commands testsetnoerr] == {}} {
+    puts "This application hasn't been compiled with the \"testsetnoerr\""
+    puts "command, so I can't test TclSetVar etc."
+} else {
+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.7 {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.8 {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.9 {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 {namespace delete test_ns_var2}
+catch {unset xx}
+catch {unset x}
+catch {unset y}
+catch {unset i}
+catch {unset a}
+catch {unset xxxxx}
+catch {unset aaaaa}
+
diff --git a/tcl/tests/while-old.test b/tcl/tests/while-old.test
new file mode 100644
index 00000000000..084903654c5
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/while.test b/tcl/tests/while.test
new file mode 100644
index 00000000000..1b54c3adcd7
--- /dev/null
+++ b/tcl/tests/while.test
@@ -0,0 +1,319 @@
+# Commands covered:  while
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# 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 {$i<}"}
+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
+} {2}
+test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
+    set value 1
+    while {"true"} {
+	incr value;
+	if {$value > 5} {
+	    break;
+	}
+    }
+    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 {$i < 5} {set}"}
+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}
+
+# 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 a
+} {1 3}
+
+# Check "while", "break", "continue" and computed command names.
+
+test while-4.1 {while and computed command names} {
+    set i 0
+    set z while
+    $z {$i < 10} {
+        incr i
+    }
+    set i
+} 10
+
+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-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/tcl/tests/winFCmd.test b/tcl/tests/winFCmd.test
new file mode 100644
index 00000000000..7c27221b718
--- /dev/null
+++ b/tcl/tests/winFCmd.test
@@ -0,0 +1,979 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+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(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
+    }
+}
+
+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} {!$testConfig(win32s) || ("[lindex [file split [pwd]] end]" == "C:/")} {
+    # Don't run this test under Win32s on a drive mounted from an NT 
+    # machine; it causes the NT machine to die.
+
+    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 tf1} msg] $msg
+} {1 EACCES}
+# under 95, this would actually succed and move the current dir out from 
+# under yourself.
+test winFCmd-1.20 {TclpRenameFile: src is dir} {!95} {
+    cleanup
+    file delete /tf1
+    list [catch {testfile mv [pwd] /tf1} msg] $msg
+} {1 EACCES}
+test winFCmd-1.21 {TclpRenameFile: obscenely long src} {!win32s} {
+    # Really long file names cause all the file system calls to lock up,
+    # endlessly throwing an access violation and retrying the operation.
+
+    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} {!$testConfig(win32s) || ("[lindex [file split [pwd]] end]" == "C:/")} {
+    # Don't run this test under Win32s on a drive mounted from an NT 
+    # machine; it causes the NT machine to die.
+
+    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} {!nt} {
+    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} {!nt} {
+    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} {!nt} {
+    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} {!nt} {
+    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} {!nt && 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} {!nt} {
+    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 {string tolower [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 {string tolower [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 {string tolower [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 {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup]
+} {0 ./td1 {}}
+test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {
+    list [file attributes / -longname] [file attributes \\ -longname]
+} {/ /}
+test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {
+    catch {file delete -force -- c:/td1}
+    close [open c:/td1 w]
+    list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1]
+} {0 c:/td1 {}}
+test winFCmd-12.7 {ConvertFileNameFormat} {UNCPath} {
+    catch {file delete -force -- //bisque/icepick/test/td1}
+    close [open //bisque/icepick/test/td1 w]
+    list [catch {string tolower [file attributes //bisque/icepick/test/td1 -longname]} msg] $msg [file delete -force -- //bisque/icepick/test/td1]
+} {0 //bisque/icepick/test/td1 {}}
+test winFCmd-12.8 {ConvertFileNameFormat} {longFileNames} {
+    cleanup
+    close [open td1 w]
+    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
+} {0 td1 {}}
+test winFCmd-12.9 {ConvertFileNameFormat} {win32s} {
+    cleanup
+    close [open td1 w]
+    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
+} {0 td1 {}}
+test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames} {
+    cleanup
+    close [open td1td1td1 w]
+    list [catch {file attributes td1td1td1 -shortname}] [cleanup]
+} {0 {}}
+test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames} {
+    cleanup
+    close [open td1 w]
+    list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
+} {0 td1 {}}
+
+test winFCmd-13.1 {GetWinFileLongName} {
+    cleanup
+    close [open td1 w]
+    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
+} {0 td1 {}}
+
+test winFCmd-14.1 {GetWinFileShortName} {
+    cleanup
+    close [open td1 w]
+    list [catch {string tolower [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/tcl/tests/winNotify.test b/tcl/tests/winNotify.test
new file mode 100644
index 00000000000..5eb3a2769e3
--- /dev/null
+++ b/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.
+#
+# RCS: @(#) $Id$
+
+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/tcl/tests/winPipe.test b/tcl/tests/winPipe.test
new file mode 100644
index 00000000000..8cf3f09adf6
--- /dev/null
+++ b/tcl/tests/winPipe.test
@@ -0,0 +1,371 @@
+# 
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {$tcl_platform(platform) != "windows"} {
+    return
+}
+
+set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
+set cat16 [file join  $bindir cat16.exe]
+set cat32 [file join $bindir 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 {$testConfig(stdio) && [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"
+}
+
+set stderr16 "stderr16"
+if {$tcl_platform(os) == "Win32s"} {
+    set stderr16 "{}"
+}
+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
+} [lindex $stderr16 0]
+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} {!win32s} {
+    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-4.1 {Tcl_WaitPid} {nt} {
+    proc readResults {f} {
+	global x result
+	if { [eof $f] } {
+	    close $f
+	    set x 1
+	} else {
+	    set line [read $f ]
+	    set result "$result$line"
+	}
+    }
+
+    set f [open "|$cat32 < big 2> stderr" r]
+    fconfigure $f  -buffering none -blocking 0
+    fileevent $f readable "readResults $f"
+    set x 0
+    set result ""
+    vwait x
+    list $result $x [contents stderr]
+} "{$big} 1 stderr32"
+
+close [open nothing w]
+
+catch {set env_tmp $env(TMP)}
+catch {set env_temp $env(TEMP)}
+
+set env(TMP) c:/
+set env(TEMP) c:/
+
+test winpipe-3.1 {TclpCreateTempFile: cleanup temp files} {
+    set x {}
+    set existing [glob -nocomplain c:/tcl*.tmp]
+    exec $tcltest < nothing 
+    foreach p [glob -nocomplain c:/tcl*.tmp] {
+	if {[lsearch $existing $p] != -1} {
+	    lappend x $p
+	}
+    }
+    set x
+} {}
+test winpipe-3.2 {TclpCreateTempFile: TMP and TEMP not defined} {
+    set tmp $env(TMP)
+    set temp $env(TEMP)
+    unset env(TMP)
+    unset env(TEMP)
+    exec $tcltest < nothing
+    set env(TMP) $tmp
+    set env(TEMP) $temp
+    set x {}
+} {}
+test winpipe-3.3 {TclpCreateTempFile: TMP specifies non-existent directory} {
+    set tmp $env(TMP)
+    set env(TMP) snarky
+    exec $tcltest < nothing
+    set env(TMP) $tmp
+    set x {}
+} {}
+test winpipe-3.3 {TclpCreateTempFile: TEMP specifies non-existent directory} {
+    set tmp $env(TMP)
+    set temp $env(TEMP)
+    unset env(TMP)
+    set env(TEMP) snarky
+    exec $tcltest < nothing
+    set env(TMP) $tmp
+    set env(TEMP) $temp
+    set x {}
+} {}
+
+makeFile {
+    puts "[list $argv0 $argv]"
+} echoArgs.tcl
+
+test winpipe-4.1 {BuildCommandLine: null arguments} {
+    exec $tcltest echoArgs.tcl foo "" bar
+} {echoArgs.tcl {foo {} bar}}
+test winpipe-4.1 {BuildCommandLine: null arguments} {
+    exec $tcltest echoArgs.tcl foo \" bar
+} {echoArgs.tcl {foo {"} bar}}
+
+# restore old values fro env(TMP) and env(TEMP)
+
+if {[catch {set env(TMP) $env_tmp}]} {
+    unset $env(TMP)
+}
+if {[catch {set env(TEMP) $env_temp}]} {
+    unset $env(TEMP)
+}
+
+file delete big little stdout stderr nothing dummy.tcl
diff --git a/tcl/testsuite/ChangeLog b/tcl/testsuite/ChangeLog
new file mode 100644
index 00000000000..8586800827f
--- /dev/null
+++ b/tcl/testsuite/ChangeLog
@@ -0,0 +1,72 @@
+Mon Mar 17 13:22:08 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* tcl.tests/tcl-test.exp: Use more precise regexp for finding test
+	case errors.
+
+Mon Aug 19 13:40:21 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* config/default.exp (tcl_load): Use "verbose", not "$verbose".
+
+Tue Jul 30 15:05:42 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tcl.tests/tcl-test.exp: Don't set srcdir in test program (done
+	elsewhere).
+
+	* config/default.exp (tcl_start): Set srcdir before sourcing
+	"defs".
+
+Thu Jun 20 15:56:04 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tcl.tests/tcl-test.exp: Don't use lindex to extract name of
+	test.
+
+Thu Feb 29 13:57:58 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tcl.tests/tcl-test.exp: Don't cd to srcdir when testing; instead
+	run in current directory and have Tcl read tests from srcdir.
+
+Fri Jan 19 10:40:53 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* config/default.exp (testdrv): Test program is unix/tcltest.
+
+Tue Dec 19 18:03:16 1995  Rob Savoye  <rob@chinadoll.cygnus.co>
+
+	* tcl.tests/tcl-test.exp: Make sure the test case sources
+	actually exist before sourcing them.
+
+Tue May 17 15:46:42 1994  Bill Cox  (bill@rtl.cygnus.com)
+
+	* config/default.exp, tcl.tests/tcl-test.exp: Replace error
+	  proc calls with perror calls.
+
+Sun Aug  1 17:37:04 1993  Rob Savoye  (rob@darkstar.cygnus.com)
+
+	* config/unix-tcl.exp: Check to see if "defs" exists.
+	* tcl.tests/tcl-test.exp: Tweak a few patterns.
+
+Tue Apr 27 07:34:17 1993  Mike Werner  (mtw@deneb.cygnus.com)
+
+	* config/unix-tcl.exp:
+	  In "tcl_version", initialized version to a null string.
+
+Mon Apr 12 14:32:14 1993  Rob Savoye  (rob@cygnus.com)
+
+	* tcl.tests/*.test, defs.tcl: Removed. Now tcl-test.exp sources
+	them from the tcl/tests directory.
+
+Mon Feb 22 07:54:03 1993  Mike Werner  (mtw@poseidon.cygnus.com)
+
+        * tcl/testsuite: made modifications to testcases, etc., to allow
+        them to work properly  given the reorganization of deja-gnu and the
+        relocation of the testcases from deja-gnu to a "tool" subdirectory.
+
+Sun Feb 21 10:55:55 1993  Mike Werner  (mtw@poseidon.cygnus.com)
+
+	* tcl/testsuite: Initial creation of tcl/testsuite.
+	Migrated dejagnu testcases and support files for testing nm to
+	tcl/testsuite from deja-gnu.  These files were moved "as is"
+	with no modifications.  This migration is part of a major overhaul
+	of dejagnu.  The modifications to these testcases, etc., which
+	will allow them to work with the new version of dejagnu will be
+	made in a future update.
+
diff --git a/tcl/testsuite/config/default.exp b/tcl/testsuite/config/default.exp
new file mode 100644
index 00000000000..2ffcc5572da
--- /dev/null
+++ b/tcl/testsuite/config/default.exp
@@ -0,0 +1,157 @@
+#   Copyright (C) 1988, 1990, 1991, 1992, 1996, 1997 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-dejagnu@prep.ai.mit.edu
+
+# This file was written by Rob Savoye. (rob@cygnus.com)
+
+set testdrv "unix/tcltest"
+set tprompt "%"
+
+#
+# tcl_version -- extract and print the version number of tcl
+#
+proc tcl_version { } {
+    global testdrv
+
+    set version ""
+    catch "exec echo puts \[info tclversion\] > x"
+    catch "exec $testdrv x" tmp
+    catch "exec rm -f x"
+    regexp "\[0-9\]\.\[0-9\.\]+" $tmp version
+    clone_output "Tcl library is version\t$version\n"
+    unset tmp
+    unset version
+}
+
+#
+# tcl_load -- loads the program. For tcl, we just execute it
+#
+proc tcl_load { arg } {
+    global subdir
+    global testdrv
+    global spawn_id
+
+    if ![file exists $arg] then {
+        perror "$arg does not exist."
+	return -1
+    }
+
+    verbose "Sourcing $arg..."
+    send "source $arg\n"
+    return 0
+}
+
+#
+# tcl_exit -- exit the test driver for tcl
+#
+proc tcl_exit {} {
+}
+
+#
+# tcl_start -- start the test driver for tcl
+#
+proc tcl_start { } {
+    global testdrv
+    global objdir
+    global subdir
+    global srcdir
+    global verbose
+    global spawn_id
+    global tprompt
+    
+    set testdrv "$objdir/$testdrv"
+    set defs	"$srcdir/../tests/defs"
+    set timeout 100
+    set timetol 0
+
+    spawn $testdrv
+
+    if ![file exists ${srcdir}/../tests] {
+	perror "The source for the test cases is missing." 0
+	return -1
+    }
+
+    send "[list set srcdir ${srcdir}/../tests]\r"
+    expect {
+	-re "set VERBOSE 1\[\r\n\]*1\[\r\n\]*%" {
+	    verbose "Set verbose flag for tests"
+	    exp_continue
+	}
+	-re "${srcdir}/../tests\[\r\n\]*$tprompt" {
+	    verbose "Set srcdir to $srcdir/../tests" 2
+	}
+	-re "no files matched glob pattern" {
+	    warning "Didn't set srcdir to $srcdir/../tests"
+	}
+	timeout {
+	    perror "Couldn't set srcdir"
+	    return -1
+	}
+    }
+
+    if ![file exists $defs] then {
+        perror "$defs does not exist."
+        return -1
+    }
+
+    verbose "Sourcing $defs..."
+    send "source $defs\r\n"
+       
+    expect {
+	-re ".*source $defs.*$" {
+	    verbose "Sourced $defs"
+	    }
+	"Error: couldn't read file*" {
+	    perror "Couldn't source $defs"
+	    return -1
+	}
+	"%" {
+	    verbose "Got prompt, sourced $defs"
+	    }
+	timeout {
+	    warning "Timed out sourcing $defs."
+	    if { $timetol <= 3 } {
+		incr timetol
+		exp_continue
+	    } else {
+		return -1
+	    }
+	}
+    }
+
+    set timetol 0
+    sleep 2
+    send "set VERBOSE 1\n"
+    expect {
+	-re "% 1.*%" {
+	    verbose "Set verbose flag for tests"
+	}
+	-re "set VERBOSE 1.*1.*%" {
+	    verbose "Set verbose flag for tests"
+	}
+	timeout {
+	    perror "Timed out setting verbose flag."
+	    if { $timetol <= 3 } {
+		exp_continue
+	    } else {
+		return -1
+	    }
+	}
+    }
+    return $spawn_id
+}
diff --git a/tcl/testsuite/tcl.tests/tcl-test.exp b/tcl/testsuite/tcl.tests/tcl-test.exp
new file mode 100644
index 00000000000..b116d3810a6
--- /dev/null
+++ b/tcl/testsuite/tcl.tests/tcl-test.exp
@@ -0,0 +1,98 @@
+#   Copyright (C) 1988, 1990, 1991, 1992, 1996, 1997 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-dejagnu@prep.ai.mit.edu
+
+# This file was written by Rob Savoye. (rob@cygnus.com)
+
+#
+# the initial work on the version of these tests from the tcl release was done
+# by Mary Ann May-Pumphrey of Sun Microsystems.
+#
+if $tracelevel then {
+    strace $tracelevel
+}
+
+expect_before buffer_full { perror "Buffer full" }
+if { [tcl_start] == "-1" } {
+    perror "Couldn't start the Tcl test shell" 0
+    return -1
+}
+
+set timeoutmsg "Timed out: Never got started, "
+set timeout 100
+set file all
+set timetol 0
+
+#
+# change to the dir where all the test live
+#
+
+set timetol 0
+if ![file exists ${srcdir}/../tests/${file}] {
+    perror "The source for the test case \"$file\" is missing" 0
+    return -1
+}
+send "source \$srcdir/${file}\n"
+expect {
+    -re "source \$srcdir/$file\[\r\n\]+\[$tprompt\]*" {
+	verbose "Sourced test $file ..."
+	set timeoutmsg "Never got to the end of "
+	exp_continue
+    }
+    "install Tcl or set your TCL_LIBRARY environment variable" {
+	perror "You need to set the TCL_LIBRARY environment variable"
+	return -1
+    }
+    -re "\[\r\n\]*\\+\\+\\+\\+ (\[a-z\]*-\[.0-9\]*) PASSED\[\r\n\]*" {
+	pass $expect_out(1,string)
+	set timetol 0
+	exp_continue
+    }
+    -re "\[\r\n\]*\\+* (\[a-z\]*-\[.0-9\]*) FAILED\[\r\n\]*" {
+	fail $expect_out(1,string)
+	exp_continue
+    }
+    -re "\[x\]+ \[a-i\]+ \[A-K\]+ \[0-9\]+ " {
+	verbose "Got standard output message from exec 8.1 test." 3
+	exp_continue
+    }
+    -re "Test generated error:\[\r\n\]*(\[^\r\n\]*)\[\r\n\]*" {
+	perror "Got a test case bug \"$expect_out(1,string)\""
+	exp_continue
+    }
+    "Tests all done" {
+	verbose "Done" 2
+    }
+    "*Error: bad option *" {
+	fail "Got a bad option"
+    }
+    eof {
+	verbose "Done" 2
+    }
+    timeout {
+	warning "Timed out executing test case"
+	if { $timetol <= 2 } {
+	    incr timetol
+	    exp_continue
+	} else {
+	    return -1
+	}
+    }
+}
+
+catch close
diff --git a/tcl/unix/ChangeLog b/tcl/unix/ChangeLog
new file mode 100644
index 00000000000..99b6db47f45
--- /dev/null
+++ b/tcl/unix/ChangeLog
@@ -0,0 +1,388 @@
+Wed Oct 20 20:15:36 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* configure.in: Handle hpux11.
+	* configure: Rebuilt.
+
+Fri Mar 19 09:29:42 1999  Michael Tiemann  <tiemann@holodeck.cygnus.com>
+
+	* configure.in, configure (IRIX64-6.*): Use -n32 instead of -32
+	for SHLIB_LD.
+
+1999-01-30  Brendan Kehoe  <brendan@cygnus.com>
+
+	* Makefile.in ($(UNIX_DIR)/configure): Comment out dependency and
+	running autoconf to regenerate it.
+
+Fri Apr 10 16:52:30 1998  Ian Lance Taylor  <ian@cygnus.com>
+
+	* configure.in: Remove test for DOS_PATHNAMES.
+	* configure: Rebuild.
+
+	* configure.in: Remove call to CY_AC_C_WORKS.
+	* aclocal.m4: Remove CY_AC_C_WORKS.
+	* configure: Rebuild.
+
+Tue Mar 24 17:28:53 1998  Stu Grossman  <grossman@bhuna.cygnus.co.uk>
+
+	* dltest/configure:  Regenerate with autoconf 2.12.1 to fix shell
+	issues for NT native builds.
+
+Mon Nov 17 09:02:23 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* configure: Rebuilt.
+	* configure.in (TCL_SHARED_LIB_FILE, TCL_UNSHARED_LIB_FILE):
+	Define with dummy values to avoid Makefile syntax errors.
+
+Tue Oct 28 16:31:58 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* Makefile.in (install-minimal): New target.
+
+Tue Aug  5 13:25:58 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* configure: Rebuilt.
+	* configure.in: Preserved local changes.
+	* mkLinks: Preserved local changes.
+
+Mon Aug  4 16:24:25 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* tclAppInit.c (main): Don't handle -h or -v arguments.
+
+Tue Jul  1 22:09:28 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* configure.in: Fix -lnsl test.
+	* configure: Rebuild.
+
+Mon Jun 30 13:31:28 1997  Ian Lance Taylor  <ian@cygnus.com>
+
+	* configure.in: Rework check for socket libraries to use a cache
+	variable and to not set ac_cv_func cache variables
+	inappropriately.
+	* configure: Rebuild.
+
+Mon Mar 17 11:36:55 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* configure: Regenerated.
+	* configure.in (have_timezone): HPUX sys/time.h has whitespace
+	before timezone decl.
+
+Thu Mar 13 14:38:31 1997  Tom Tromey  <tromey@cygnus.com>
+
+	* tclUnixTime.c (TclpGetTimeZone): Declare timezone if not
+	declared in header.
+
+	* configure.in (have_timezone): Check for timezone decl in
+	time.h.
+
+Fri Nov 22 11:02:08 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* configure.in: Use AC_STRUCT_ST_BLKSIZE, not hand-written code.
+
+	* tclUnixFCmd.c (CopyFile): Use BUFSIZ, not mythical BLKSIZE.
+
+Thu Nov 21 10:53:19 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* tclUnixFCmd.c (CopyFile): Check HAVE_ST_BLKSIZE.
+
+	* configure.in: Remove check for realpath; don't define
+	HAVE_GETCWD.
+	Check for st_blksize in struct stat.
+
+Wed Nov 20 14:07:31 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* Makefile.in (GENERIC_OBJS): Removed tclAlloc.o.
+	(GENERIC_SRCS): Removed tclAlloc.c.
+	(tclAlloc.o): Removed.
+
+Thu Oct  3 17:18:42 1996  Ian Lance Taylor  <ian@cygnus.com>
+
+	* Makefile.in (mostlyclean): New target.
+
+Thu Oct  3 11:38:41 1996  Tom Tromey  <tromey@cygnus.com>
+
+	* dltest/Makefile.in (distclean): Remove configure-generated files
+	here.
+
+Mon Aug 26 09:38:22 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in: Use TCL_SHARED_LIB_FILE, TCL_UNSHARED_LIB_FILE.
+	* configure: Regenerated.
+	* configure.in: Introduce TCL_SHARED_LIB_FILE and
+	TCL_UNSHARED_LIB_FILE.
+
+	* configure: Regenerated.
+	* configure.in (HP-UX): Make sure test for GNU ld fails with HPUX
+	linker.
+
+Wed Aug 14 09:20:54 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (install-man): Man page permissions are 644, not
+	444.
+
+Tue Aug 13 11:49:08 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: On IRIX 6.2 timezone is a time_t, not a long.
+
+Mon Aug  5 10:35:17 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (configure): Don't depend on configure.in.  Work
+	when not in srcdir.
+
+	* configure: Regenerated.
+	* configure.in: Don't hard-code `gcc'; use $CC instead.
+	[ULTRIX-4*] Don't pass -D 08000000 to GNU ld.
+
+	* Makefile.in (Makefile): Depend on config.status.
+	(config.status): New target.
+
+	* configure: Regenerated.
+	* configure.in: Use -fPIC, not -fpic, when using gcc.
+
+Fri Aug  2 10:33:52 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: Don't put body of HP-UX case in AC_CHECK_LIB;
+	instead do check separately.
+
+	* tclUnixInit.c: Don't include <sys/utsname.h>; that is done by
+	tclUnixPort.h.
+
+	* configure: Regenerated.
+	* configure.in: Check for -ldld before using it.
+
+Mon Jul 22 17:19:10 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tclUnixInit.c (initScript): Handle location independence.
+
+Sun Jul 14 14:46:51 1996  Michael Meissner  <meissner@tiktok.cygnus.com>
+
+	* tclUnixStr.c (Tcl_Errno{Id,Msg}): Handle new versions of Linux
+	that define EDEADLK and EDEADLOCK as the same.
+
+Wed Jun 26 12:37:05 1996  Jason Molenda  (crash@godzilla.cygnus.co.jp)
+
+	* Makefile.in (TCL_LIBRARY, LIB_INSTALL_DIR, BIN_INSTALL_DIR,
+	INCLUDE_INSTALL_DIR, MAN_INSTALL_DIR, INSTALL_PROGRAM,
+	INSTALL_DATA): Use autoconf-set values.
+	(install-libraries): Use @datadir@ instead of hard-coding dirname.
+	* configure.in (AC_PREREQ): autoconf 2.5 or higher.
+	(AC_PROG_INSTALL): Add.
+	* configure: Rebuilt.
+	* dltest/configure.in (AC_PREREQ): autoconf 2.5 or higher.
+	* dltest/configure: Rebuilt.
+
+Mon Jun 10 16:21:21 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (install-binaries): Don't add version info to
+	installed tclsh.
+
+Tue Jun  4 17:57:10 1996  Gordon Irlam  <gordoni@snuffle.cygnus.com>
+
+	* install-sh: Add MIT copyright.
+
+Tue May 21 10:13:37 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure: Regenerated.
+	* aclocal.m4: Typo fix.
+
+Thu May 16 09:50:12 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure: Regenerated.
+	* configure.in: Removed AC_CANONICAL_SYSTEM, AC_CONFIG_AUX_DIR.
+	Use CY_AC_C_WORKS instead of CY_AC_C_CROSS.
+	* aclocal.m4: Replaced CY_AC_C_CROSS with CY_AC_C_WORKS.
+
+Thu May  9 10:01:31 1996  Tom Tromey  <tromey@snuffle.cygnus.com>
+
+	* Makefile.in (CFLAGS): Set to @CFLAGS@.
+
+Mon May  6 20:54:10 1996  Fred Fish  <fnf@cygnus.com>
+
+	* findself.c (find_self): Test argv0 for NULL before
+	dereferencing it.
+
+Mon May  6 11:27:52 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* Makefile.in (install-man): Install man pages in section 3, not
+	section n.
+
+	* mkLinks: Use cp, not ln.
+
+Mon May  6 11:27:52 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* findself.c (find_self_base): Changed expected location of
+	arch-specific info.
+
+Fri May  3 08:36:01 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* Makefile.in: Moved html generation into devo/inet.
+
+Thu May  2 23:47:32 1996  Michael Meissner  <meissner@tiktok.cygnus.com>
+
+	* Makefile.in (install-html): Create html directory if it isn't
+	already created.
+
+Thu May  2 10:09:25 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* findself.c (cache_valid): New global.
+	(find_self_base): Allow caching of NULL.  Ensure that stripped
+	components have correct names for scheme.
+
+	* findself.c: Don't include <stdlib.h> in Tcl case.
+
+Wed May  1 12:51:50 1996  Tom Tromey  <tromey@lisa.cygnus.com>
+
+	* Makefile.in (html): New target.
+	(install-html): New target.
+	(install): Depend on install-html.
+	(stamp-html): new target.
+	(all): Depend on html.
+	(TCL_HTML_DIR): New macro.
+	(install-html): Use it.
+
+Wed May  1 09:09:13 1996  Tom Tromey  <tromey@snuffle.cygnus.com>
+
+	* findself.c: Include <stdlib.h> whenever possible.
+	(find_self): Cast result of realpath.
+
+Tue Apr 30 13:39:48 1996  Tom Tromey  <tromey@snuffle.cygnus.com>
+
+	* findself.c (find_self_base): Strip new "arch" directory from
+	prefix.
+
+	* tclAppInit.c (main): Removed "-inet-1.0".
+
+Mon Apr 29 16:57:10 1996  Tom Tromey  <tromey@snuffle.cygnus.com>
+
+	* Makefile.in (install): Install man pages again.
+
+	* tclAppInit.c (main): Print version number.
+
+	* findself.c (find_self): Now static.
+	(find_self): Removed defines.
+	(cached_name): Removed.
+	(resolved): New static global.
+	(find_self_base): Look for INETHOME environment variable.
+
+Tue Apr 23 10:13:32 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (UNIX_SRCS): Added findself.c.
+	(UNIX_OBJS): Added findself.o.
+
+	* configure: Regenerated.
+	* configure.in: Look for realpath().  Always define HAVE_GETCWD.
+
+	* Makefile.in (TCL_LIB_TRAILER): New macro.
+	(CC_SWITCHES): Define TCL_LIB_TRAILER.
+
+	* tclUnixInit.c (TclPlatformInit): Handle location independence.
+
+	* Makefile.in: Add explicit .c.o dependencies for Sun's VPATH.
+	From Doug Evans <dje@cygnus.com>.
+
+Mon Apr  1 23:05:49 1996  Fred Fish  <fnf@cygnus.com>
+
+	* configure.in (case $system): For HP-UX test $have_dl before
+	setting SHLIB_CFLAGS, SHLIB_LD, SHLIB_SUFFIX, DL_OBJS, and DL_LIBS
+	* configure: Regenerate.
+	
+Fri Mar 29 08:23:00 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* mkLinks: Exit with status 0.
+
+Mon Mar 25 17:01:01 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: Changed most "ac_cv" variables to "tcl_cv";
+	otherwise Tcl-specific tests could clobber values in a global
+	cache file.
+
+Fri Mar 15 09:03:31 1996  Fred Fish  <fnf@cygnus.com>
+
+	* configure.in: Some UNIX_SV* systems have linkers that
+ 	don't grok the -Bexport option.  Test that it does before
+	adding to LD_FLAGS.
+	* configure: Regenerated.
+
+Thu Mar 14 14:25:17 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: Check for GNU ld in HP-UX case.
+
+Fri Mar  1 11:45:23 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure: Regenerated.
+	* configure.in: Use AC_CANONICAL_SYSTEM.  Look in Cygnus build
+	tree for config.sub and config.guess.
+
+Thu Feb 29 09:06:59 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (test): Define srcdir in test environment.
+
+Tue Feb 13 13:22:23 1996  Ian Lance Taylor  <ian@cygnus.com>
+
+	* configure.in: On Solaris, put -export-dynamic in LD_FLAGS if the
+	linker supports it.
+	* configure: Regenerated.
+
+Thu Feb  1 09:57:19 1996  Tom Tromey  (tromey@gerbil.cygnus.com)
+
+	* configure.in: Test $CC against *gcc*, not just gcc.
+	For now, can't handle dynamic linking on HPUX.
+	* configure: Regenerated.
+
+Wed Jan 24 09:41:19 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* dltest/Makefile.in (distclean): Remove config.log, config.cache,
+	and config.status here, not in distclean.
+	(mostlyclean, maintainer-clean): New targets.
+
+	* Makefile.in: Replaced realclean with maintainer-clean.
+	(clean): Make clean in dltest directory.
+
+Mon Jan 22 10:08:38 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: Use $?, not $status, to see if uname failed.
+	File is named "tclLoadAout.o", not "tclLoadAOut.o".
+
+Fri Jan 19 10:34:22 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (loadTests): Use $(MAKE), not make.
+	(distclean): Ditto.
+
+	* dltest/Makefile.in (.c.o): New target.
+	(VPATH): New macro.
+
+	* Makefile.in (check installcheck): Removed.
+	(tclTestInit.o): Bug fix.
+
+Wed Jan 17 11:36:40 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (check): Tests are in ../testsuite.
+
+Sat Jan 13 18:41:26 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* tclUnixUtil.c (Tcl_DeleteFileTable): Undid change of Jan 11.
+	Added comment explaining why.
+
+Thu Jan 11 14:18:34 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* Makefile.in (tclTestInit.o): Find tclAppInit.c in $(srcdir).
+
+	* tclUnixUtil.c (Tcl_DeleteFileTable): Use Tcl_NextHashEntry to
+	fetch next element from hash.
+
+Wed Jan 10 10:39:15 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: Instead of giving warning, default to most
+	conservative option when cross-compiling.
+
+	* Makefile.in (loadTests): Don't depend on dltest/Makefile.  Use
+	"&&", not ";".
+	(dltest/Makefile): Removed.
+
+	* configure.in: Always allow use of gcc.
+	Create dltest/Makefile.in.
+	Cache check for DOS pathnames.
+
+Tue Jan  9 14:29:53 1996  Tom Tromey  <tromey@creche.cygnus.com>
+
+	* configure.in: Handle Linux machine with no dld.h and no -ldl.
+
+	* See ../ChangeLog for entries before this date.
diff --git a/tcl/unix/Makefile.in b/tcl/unix/Makefile.in
new file mode 100644
index 00000000000..8fbb88cbc96
--- /dev/null
+++ b/tcl/unix/Makefile.in
@@ -0,0 +1,1089 @@
+#
+# This file is a Makefile for Tcl.  If it has the name "Makefile.in"
+# then it is a template for a Makefile;  to generate the actual Makefile,
+# run "./configure", which is a configuration script generated by the
+# "autoconf" program (constructs like "@foo@" will get replaced in the
+# actual Makefile.
+#
+# SCCS: @(#) Makefile.in 1.190 97/11/05 10:57:38
+
+# Current Tcl version;  used in various names.
+
+VERSION = @TCL_VERSION@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix).  The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix =	@prefix@
+exec_prefix =	@exec_prefix@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication.  It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time.  INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of Tcl
+# scripts (note: you can set the TCL_LIBRARY environment variable at
+# run-time to override this value):
+TCL_LIBRARY =	@datadir@/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)
+
+# Directory in which to install libtcl.so or libtcl.a:
+LIB_INSTALL_DIR =	$(INSTALL_ROOT)@libdir@
+
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR =	@libdir@
+
+# Directory in which to install the program tclsh:
+BIN_INSTALL_DIR =	$(INSTALL_ROOT)@bindir@
+
+# Directory in which to install the include file tcl.h:
+INCLUDE_INSTALL_DIR =	$(INSTALL_ROOT)@includedir@
+
+# Top-level directory in which to install manual entries:
+MAN_INSTALL_DIR =	$(INSTALL_ROOT)@mandir@
+
+# Directory in which to install manual entry for tclsh:
+MAN1_INSTALL_DIR =	$(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for Tcl's C library
+# procedures:
+MAN3_INSTALL_DIR =	$(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands:
+MANN_INSTALL_DIR =	$(MAN_INSTALL_DIR)/mann
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+#CFLAGS = -O
+
+# CYGNUS LOCAL: Set CFLAGS from configure script.
+CFLAGS = @CFLAGS@
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# Mathematical functions like sin and atan2 are enabled for expressions
+# by default.  To disable them, reverse the comment characters on the
+# following pairs of lines:
+MATH_FLAGS =
+#MATH_FLAGS = -DTCL_NO_MATH
+MATH_LIBS = @MATH_LIBS@
+#MATH_LIBS =
+
+# If you use the setenv, putenv, or unsetenv procedures to modify
+# environment variables in your application and you'd like those
+# modifications to appear in the "env" Tcl variable, switch the
+# comments on the two lines below so that Tcl provides these
+# procedures instead of your standard C library.
+
+ENV_FLAGS =
+#ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv
+
+# To compile for non-UNIX systems (so that only the non-UNIX-specific
+# commands are available), reverse the comment characters on the
+# following pairs of lines.  In addition, you'll have to provide your
+# own replacement for the "panic" procedure (see panic.c for what
+# the current one does).
+GENERIC_FLAGS =
+#GENERIC_FLAGS = -DTCL_GENERIC_ONLY
+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
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+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 = @SHELL@
+
+# Tcl used to let the configure script choose which program to use
+# for installing, but there are just too many different versions of
+# "install" around;  better to use the install-sh script that comes
+# with the distribution, which is slower but guaranteed to work.
+
+INSTALL =		@srcdir@/install-sh -c
+INSTALL_PROGRAM =	@INSTALL_PROGRAM@
+INSTALL_DATA =		@INSTALL_DATA@
+
+# The following symbol defines additional compiler flags to enable
+# Tcl itself to be a shared library.  If Tcl isn't going to be a
+# shared library then the symbol has an empty definition.
+
+TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
+#TCL_SHLIB_CFLAGS =
+
+# The symbols below provide support for dynamic loading and shared
+# libraries.  See configure.in for a description of what the
+# symbols mean.  The values of the symbols are normally set by the
+# configure script.  You shouldn't normally need to modify any of
+# these definitions by hand.
+
+SHLIB_LD = @SHLIB_LD@
+
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+#SHLIB_SUFFIX =
+
+TCL_SHARED_LIB_SUFFIX = @TCL_SHARED_LIB_SUFFIX@
+TCL_UNSHARED_LIB_SUFFIX = @TCL_UNSHARED_LIB_SUFFIX@
+TCL_SHARED_LIB_FILE = @TCL_SHARED_LIB_FILE@
+TCL_UNSHARED_LIB_FILE = @TCL_UNSHARED_LIB_FILE@
+
+DLTEST_TARGETS = dltest/pkg5${SHLIB_SUFFIX} dltest/Makefile
+
+# The following symbol is defined to "$(DLTEST_TARGETS)" if dynamic
+# loading is available;  this causes everything in the "dltest"
+# subdirectory to be built when making "tcltest.  If dynamic loading
+# isn't available, configure defines this symbol to an empty string,
+# in which case the shared libraries aren't built.
+BUILD_DLTEST = @BUILD_DLTEST@
+#BUILD_DLTEST =
+
+TCL_LIB_FILE = @TCL_LIB_FILE@
+#TCL_LIB_FILE = libtcl.a
+
+TCL_LIB_FLAG = @TCL_LIB_FLAG@
+#TCL_LIB_FLAG = -ltcl
+
+#----------------------------------------------------------------
+# The information below is modified by the configure script when
+# Makefile is generated from Makefile.in.  You shouldn't normally
+# modify any of this stuff by hand.
+#----------------------------------------------------------------
+
+COMPAT_OBJS =		@LIBOBJS@
+
+AC_FLAGS =		@DEFS@
+RANLIB =		@RANLIB@
+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@
+
+#----------------------------------------------------------------
+# The information below should be usable as is.  The configure
+# script won't modify it and you shouldn't need to modify it
+# either.
+#----------------------------------------------------------------
+
+
+CC_SWITCHES =	${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
+-I${GENERIC_DIR} -I${SRC_DIR} \
+${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
+${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
+
+LIBS =		@DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc
+
+DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
+${AC_FLAGS} ${MATH_FLAGS} \
+${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
+-DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
+
+TCLSH_OBJS = tclAppInit.o
+
+TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o \
+               tclTestProcBodyObj.o tclUnixTest.o
+
+XTTEST_OBJS = tclTest.o tclTestObj.o tclTestProcBodyObj.o \
+        tclUnixTest.o tclXtNotify.o \
+	tclXtTest.o xtTestInit.o
+
+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 \
+	tclResolve.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)/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)/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)/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)/tclTestProcBodyObj.c \
+	$(GENERIC_DIR)/tclResolve.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
+
+UNIX_HDRS = \
+	$(UNIX_DIR)/tclUnixPort.h
+
+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 \
+	$(UNIX_DIR)/tclUnixSock.c \
+	$(UNIX_DIR)/tclUnixTest.c \
+	$(UNIX_DIR)/tclUnixTime.c \
+	$(UNIX_DIR)/tclUnixInit.c
+
+DL_SRCS = \
+	$(UNIX_DIR)/tclLoadAix.c \
+	$(UNIX_DIR)/tclLoadAout.c \
+	$(UNIX_DIR)/tclLoadDl.c \
+	$(UNIX_DIR)/tclLoadDl2.c \
+	$(UNIX_DIR)/tclLoadDld.c \
+	$(GENERIC_DIR)/tclLoadNone.c \
+	$(UNIX_DIR)/tclLoadOSF.c \
+	$(UNIX_DIR)/tclLoadShl.c
+
+# Note: don't include DL_SRCS in SRCS:  most of those files won't
+# compile on the current machine, and they will cause problems for
+# things like "make depend".
+
+SRCS = $(GENERIC_SRCS) $(UNIX_SRCS)
+
+all: ${TCL_LIB_FILE} tclsh
+
+# CYGNUS LOCAL
+
+# The shared- and unshared-library cases are separate, so that RANLIB
+# can unconditionally work.
+
+${TCL_SHARED_LIB_FILE}: ${OBJS}
+	rm -f ${TCL_LIB_FILE}
+	@MAKE_LIB@
+
+${TCL_UNSHARED_LIB_FILE}: ${OBJS}
+	rm -f ${TCL_LIB_FILE}
+	@MAKE_LIB@
+	$(RANLIB) ${TCL_LIB_FILE}
+
+# END CYGNUS LOCAL
+
+# Make target which outputs the list of the .o contained in the Tcl lib
+# usefull to build a single big shared library containing Tcl and other
+# extensions.  used for the Tcl Plugin.  -- dl
+# The dependency on OBJS is not there because we just want the list
+# of objects here, not actually building them
+tclLibObjs:
+	@echo ${OBJS}
+# This targets actually build the objects needed for the lib in the above
+# case
+objs: ${OBJS}
+
+
+tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
+	${CC} @LD_FLAGS@ ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+		@TCL_LD_SEARCH_FLAGS@ -o tclsh
+
+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.
+
+test: tcltest
+	LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+	TCL_LIBRARY=${TOP_DIR}/library; export TCL_LIBRARY; \
+	( echo cd $(TOP_DIR)/tests\; source all ) | ./tcltest
+
+# Useful target to launch a built tcltest with the proper path,...
+runtest:
+	LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+	TCL_LIBRARY=${TOP_DIR}/library; export TCL_LIBRARY; \
+	./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:
+	@cd $(TOP_DIR); pwd
+
+# The following target generates the file generic/tclDate.c 
+# from the yacc grammar found in generic/tclGetDate.y.  This is
+# only run by hand as yacc is not available in all environments.
+# The name of the .c file is different than the name of the .y file
+# so that make doesn't try to automatically regenerate the .c file.
+
+gendate:
+	yacc -l $(GENERIC_DIR)/tclGetDate.y
+	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
+	    -e 's/SCCSID/%Z\% %M\% %I\% %E\% %U\%/g' \
+	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
+	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
+	    <y.tab.c >$(GENERIC_DIR)/tclDate.c
+	rm y.tab.c
+
+# The following targets generate the shared libraries in dltest that
+# are used for testing;  they are included as part of the "tcltest"
+# target (via the BUILD_DLTEST variable) if dynamic loading is supported
+# on this platform. The ".." environment variable stuff is needed
+# because on some platforms tclsh scripts will be executed as part of
+# building the shared libraries, and they need to be able to use the
+# uninstalled tclsh that is present in this directory.  The "make tclsh"
+# 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
+	libdir=`cd $(TOP_DIR)/library && pwd`; cd dltest; \
+	PATH=..:${PATH} TCL_LIBRARY=$$libdir $(MAKE)
+
+dltest/Makefile: $(DLTEST_DIR)/configure $(DLTEST_DIR)/Makefile.in tclConfig.sh
+	if test ! -d dltest; then mkdir dltest; else true; fi
+	dldir=`cd $(DLTEST_DIR) && pwd`; cd dltest; \
+	if test -f configure; then ./configure; else $$dldir/configure; fi
+
+install: install-binaries install-libraries install-man
+
+# Note: before running ranlib below, must cd to target directory because
+# some ranlibs write to current directory, and this might not always be
+# possible (e.g. if installing as root).
+
+install-binaries: $(TCL_LIB_FILE) tclsh
+	@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@echo "Installing $(TCL_LIB_FILE)"
+	@$(INSTALL_DATA) $(TCL_LIB_FILE) $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
+	@(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TCL_LIB_FILE))
+	@chmod 555 $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
+	@echo "Installing tclsh"
+	@$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh
+	@echo "Installing tclConfig.sh"
+	@$(INSTALL_DATA) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+
+install-libraries:
+	@for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
+		$(SCRIPT_INSTALL_DIR) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@for i in http2.0 http1.0 opt0.1; \
+	    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 $(UNIX_DIR)/ldAix; \
+	    do \
+	    echo "Installing $$i"; \
+	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+	    done;
+	@for i in http2.0 http1.0 opt0.1; \
+	    do \
+	    for j in $(TOP_DIR)/library/$$i/*.tcl ; \
+		do \
+		echo "Installing $$j"; \
+		$(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
+		done; \
+	    done;
+
+# CYGNUS LOCAL: install-minimal target.
+install-minimal:
+	@for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
+		$(SCRIPT_INSTALL_DIR) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@for i in http2.0 http1.0 opt0.1; \
+	    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;
+	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/ldAix; \
+	    do \
+	    echo "Installing $$i"; \
+	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+	    done;
+	@for i in http2.0 http1.0 opt0.1; \
+	    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) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@cd $(TOP_DIR)/doc; for i in *.1; \
+	    do \
+	    echo "Installing doc/$$i"; \
+	    rm -f $(MAN1_INSTALL_DIR)/$$i; \
+	    sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+		    $$i > $(MAN1_INSTALL_DIR)/$$i; \
+	    chmod 644 $(MAN1_INSTALL_DIR)/$$i; \
+	    done;
+	$(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+	@cd $(TOP_DIR)/doc; for i in *.3; \
+	    do \
+	    echo "Installing doc/$$i"; \
+	    rm -f $(MAN3_INSTALL_DIR)/$$i; \
+	    sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+		    $$i > $(MAN3_INSTALL_DIR)/$$i; \
+	    chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
+	    done;
+	@cd $(TOP_DIR)/doc; for i in *.n; \
+	    do \
+	    echo "Installing doc/$$i"; \
+	    name=`echo $$i | sed -e 's/n$$/3/'`; \
+	    rm -f $(MAN3_INSTALL_DIR)/$$name; \
+	    sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+		    $$i > $(MAN3_INSTALL_DIR)/$$name; \
+	    chmod 644 $(MAN3_INSTALL_DIR)/$$name; \
+	    done;
+	$(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+
+Makefile: $(UNIX_DIR)/Makefile.in config.status
+	$(SHELL) config.status
+
+config.status: $(UNIX_DIR)/configure
+	./config.status --recheck
+
+mostlyclean: clean
+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
+
+distclean: clean
+	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)
+
+bp: $(UNIX_DIR)/bp.c
+	$(CC) $(CC_SWITCHES) $(UNIX_DIR)/bp.c -o bp
+
+# 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 \
+	    rm -f tclAppInit.sav; \
+	    mv tclAppInit.o tclAppInit.sav; \
+	fi;
+	$(CC) -c $(CC_SWITCHES) -DTCL_TEST $(UNIX_DIR)/tclAppInit.c
+	rm -f tclTestInit.o
+	mv tclAppInit.o tclTestInit.o
+	@if test -f tclAppInit.sav ; then \
+	    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
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/panic.c
+
+regexp.o: $(GENERIC_DIR)/regexp.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regexp.c
+
+tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
+
+tclAsync.o: $(GENERIC_DIR)/tclAsync.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+tclClock.o: $(GENERIC_DIR)/tclClock.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c
+
+tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c
+
+tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c
+
+tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+tclExecute.o: $(GENERIC_DIR)/tclExecute.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.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
+
+tclGet.o: $(GENERIC_DIR)/tclGet.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclGet.c
+
+tclHash.o: $(GENERIC_DIR)/tclHash.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+tclIO.o: $(GENERIC_DIR)/tclIO.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIO.c
+
+tclIOCmd.o: $(GENERIC_DIR)/tclIOCmd.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOCmd.c
+
+tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOSock.c
+
+tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAix.c
+
+tclLoadAout.o: $(UNIX_DIR)/tclLoadAout.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAout.c
+
+tclLoadDl.o: $(UNIX_DIR)/tclLoadDl.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl.c
+
+tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl2.c
+
+tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c
+
+tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c
+
+tclLoadOSF.o: $(UNIX_DIR)/tclLoadOSF.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadOSF.c
+
+tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadShl.c
+
+tclMain.o: $(GENERIC_DIR)/tclMain.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c
+
+tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c
+
+tclProc.o: $(GENERIC_DIR)/tclProc.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
+
+tclResolve.o: $(GENERIC_DIR)/tclResolve.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.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
+
+tclVar.o: $(GENERIC_DIR)/tclVar.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.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
+
+tclUnixNotfy.o: $(UNIX_DIR)/tclUnixNotfy.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixNotfy.c
+
+tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c
+
+tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c
+
+tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c
+
+tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
+	$(CC) -c $(CC_SWITCHES) $(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
+
+fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
+
+getcwd.o: $(COMPAT_DIR)/getcwd.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/getcwd.c
+
+opendir.o: $(COMPAT_DIR)/opendir.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/opendir.c
+
+strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c
+
+strstr.o: $(COMPAT_DIR)/strstr.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strstr.c
+
+strtod.o: $(COMPAT_DIR)/strtod.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtod.c
+
+strtol.o: $(COMPAT_DIR)/strtol.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtol.c
+
+strtoul.o: $(COMPAT_DIR)/strtoul.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtoul.c
+
+tmpnam.o: $(COMPAT_DIR)/tmpnam.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c
+
+waitpid.o: $(COMPAT_DIR)/waitpid.c
+	$(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
+
+.c.o:
+	$(CC) -c $(CC_SWITCHES) $<
+
+#
+# Target to check for proper usage of UCHAR macro.
+#
+
+checkuchar:
+	-egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR
+
+#
+# Target to make sure that only symbols with "Tcl" prefixes are
+# exported.
+#
+
+checkexports: $(TCL_LIB_FILE)
+	-nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]cl'
+
+#
+# Target to create a proper Tcl distribution from information in the
+# master source directory.  DISTDIR must be defined to indicate where
+# to put the distribution.
+#
+
+DISTNAME =	tcl@TCL_VERSION@@TCL_PATCH_LEVEL@
+ZIPNAME =	tcl@TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@@TCL_PATCH_LEVEL@.zip
+DISTDIR =	$(DISTROOT)/$(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 $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
+	chmod 664 $(DISTDIR)/unix/Makefile.in
+	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 $(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 $(TOP_DIR)/changes $(TOP_DIR)/README* $(TOP_DIR)/license.terms \
+		$(DISTDIR)
+	mkdir $(DISTDIR)/library
+	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
+		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
+	for i in http2.0 http1.0 opt0.1; \
+	    do \
+		mkdir $(DISTDIR)/library/$$i ;\
+		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
+	    done;
+	mkdir $(DISTDIR)/doc
+	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
+		$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
+	mkdir $(DISTDIR)/compat
+	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 $(TOP_DIR)/license.terms $(DISTDIR)/tests
+	cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
+		$(TOP_DIR)/tests/all $(TOP_DIR)/tests/*.tcl \
+		$(TOP_DIR)/tests/defs $(DISTDIR)/tests
+	mkdir $(DISTDIR)/win
+	cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(TOP_DIR)/win/*.rc \
+		$(DISTDIR)/win
+	cp -p $(TOP_DIR)/win/*.bat $(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 $(TOP_DIR)/mac/tclMacProjects.sea.hqx
+	cp -p tclMacProjects.sea.hqx $(DISTDIR)/mac
+	sccs unedit $(TOP_DIR)/mac/tclMacProjects.sea.hqx
+	rm -f tclMacProjects.sea.hqx
+	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)/mac/*.html $(DISTDIR)/mac
+	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac
+	mkdir $(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
+
+#
+# The following target can only be used for non-patch releases.  Use
+# the "allpatch" target below for patch releases.
+#
+
+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 -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
+		compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME)
+
+#
+# The target below is similar to "alldist" except it works for patch
+# releases.  It is needed because patch releases are peculiar: the
+# patch designation appears in the name of the compressed file
+# (e.g. tcl8.0p1.tar.gz) but the extracted source directory doesn't
+# include the patch designation (e.g. tcl8.0).
+#
+
+allpatch: dist
+	rm -f $(DISTROOT)/$(DISTNAME).tar.Z \
+		$(DISTROOT)/$(DISTNAME).tar.gz \
+		$(DISTROOT)/$(ZIPNAME)
+	mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/old
+	mv $(DISTROOT)/$(DISTNAME) $(DISTROOT)/tcl${VERSION}
+	cd $(DISTROOT); tar cf $(DISTNAME).tar tcl${VERSION}; \
+		gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
+		compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) tcl${VERSION}
+	mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/$(DISTNAME)
+	mv $(DISTROOT)/old $(DISTROOT)/tcl${VERSION}
+
+#
+# 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 group's tool workspace.
+#
+
+macdist: dist
+	rm -f $(DISTDIR)/mac/tclMacProjects.sea.hqx
+	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 $(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 $(PACKAGE).sun4 and
+# $(PACKAGE).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=SCRPtcl
+
+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/$(PACKAGE)/$(VERSION) \
+		--exec_prefix=/opt/$(PACKAGE)/$(VERSION)/`arch` \
+		--enable-shared
+	mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)
+	mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`
+
+#
+# Build and install the architecture independent files in the dist directory.
+#
+
+package-common:
+	cd $(DISTDIR)/unix/`arch`;\
+	$(MAKE); \
+	$(MAKE) prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \
+		exec_prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch` \
+		install-libraries install-man
+	mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin
+	sed -e "s/TCLVERSION/$(VERSION)/g" < $(UNIX_DIR)/tclsh.sh \
+		> $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin/tclsh$(VERSION)
+	chmod 755 $(DISTDIR)/$(PACKAGE)/$(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)/$(PACKAGE)/$(VERSION) \
+		exec_prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`
+
+#
+# Generate a package from the installed files in the dist directory for the
+# current architecture.
+#
+
+package-generate:
+	pkgproto $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin=bin \
+		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/include=include \
+		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/lib=lib \
+		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/man=man \
+		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`=`arch` \
+	| tclsh $(UNIX_DIR)/mkProto.tcl \
+		$(VERSION) $(UNIX_DIR) > prototype
+	pkgmk -o -d . -f prototype -a `arch`
+	pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE)
+	rm -rf $(PACKAGE)
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/tcl/unix/README b/tcl/unix/README
new file mode 100644
index 00000000000..8f817e9bee6
--- /dev/null
+++ b/tcl/unix/README
@@ -0,0 +1,110 @@
+This is the directory where you configure, compile, test, and install
+UNIX versions of Tcl.  This directory also contains source files for Tcl
+that are specific to UNIX.  Some of the files in this directory are
+used on the PC or Mac platform too, but they all depend on UNIX
+(POSIX/ANSI C) interfaces and some of them only make sense under UNIX.
+
+The rest of this file contains instructions on how to do this.  The
+release should compile and run either "out of the box" or with trivial
+changes on any UNIX-like system that approximates POSIX, BSD, or System
+V.  We know that it runs on workstations from Sun, H-P, DEC, IBM, and
+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.
+
+RCS: @(#) $Id$
+
+How To Compile And Install Tcl:
+-------------------------------
+
+(a) Check for patches as described in ../README.
+
+(b) If you have already compiled Tcl once in this directory and are now
+    preparing to compile again in the same directory but for a different
+    platform, or if you have applied patches, type "make distclean" to
+    discard all the configuration information computed previously.
+
+(c) Type "./configure".  This runs a configuration script created by GNU
+    autoconf, which configures Tcl for your system and creates a
+    Makefile.  The configure script allows you to customize the Tcl
+    configuration for your site; for details on how you can do this,
+    type "./configure -help" or refer to the autoconf documentation (not
+    included here).  Tcl's "configure" supports the following special
+    switches in addition to the standard ones:
+	--enable-gcc		If this switch is set, Tcl will configure
+				itself to use gcc if it is available on your
+				system.  Note:  it is not safe to modify the
+				Makefile to use gcc after configure is run;
+				if you do this, then information related to
+				dynamic linking will be incorrect.
+	--disable-load		If this switch is specified then Tcl will
+				configure itself not to allow dynamic loading,
+				even if your system appears to support it.
+				Normally you can leave this switch out and
+				Tcl will build itself for dynamic loading
+				if your system supports it.
+	--enable-shared		If this switch is specified, Tcl will compile
+				itself as a shared library if it can figure
+				out how to do that on this platform.
+    Note: be sure to use only absolute path names (those starting with "/")
+    in the --prefix and --exec_prefix options.
+
+(d) Type "make".  This will create a library archive called "libtcl.a"
+    or "libtcl.so" and an interpreter application called "tclsh" that
+    allows you to type Tcl commands interactively or execute script files.
+
+(e) If the make fails then you'll have to personalize the Makefile
+    for your site or possibly modify the distribution in other ways.
+    First check the file "porting.notes" to see if there are hints
+    for compiling on your system.  Then look at the porting Web page
+    described later in this file.  If you need to modify Makefile, there
+    are comments at the beginning of it that describe the things you
+    might want to change and how to change them.
+
+(f) Type "make install" to install Tcl binaries and script files in
+    standard places.  You'll need write permission on the installation
+    directories to do this.  The installation directories are
+    determined by the "configure" script and may be specified with
+    the --prefix and --exec_prefix options to "configure".  See the
+    Makefile for information on what directories were chosen; you
+    can override these choices by modifying the "prefix" and
+    "exec_prefix" variables in the Makefile.
+
+(g) At this point you can play with Tcl by invoking the "tclsh"
+    program and typing Tcl commands.  However, if you haven't installed
+    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 "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 "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.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
+be happy to receive new information to add to "porting.notes".  You can
+also make a new entry into the on-line Web database.  We're also interested
+in hearing how to change the configuration setup so that Tcl compiles out
+of the box on more platforms.
+
+Test suite
+----------
+
+There is a relatively complete test suite for all of the Tcl core in
+the subdirectory "tests".  To use it just type "make test" in this
+directory.  You should then see a printout of the test files processed.
+If any errors occur, you'll see a much more substantial printout for
+each error.  See the README file in the "tests" directory for more
+information on the test suite.  Note: don't run the tests as superuser:
+this will cause several of them to fail.
+
+The Tcl test suite is very sensitive to proper implementation of
+ANSI C library procedures such as sprintf and sscanf.  If the test
+suite generates errors, most likely they are due to non-conformance
+of your system's ANSI C library;  such problems are unlikely to
+affect any real applications so it's probably safe to ignore them.
diff --git a/tcl/unix/aclocal.m4 b/tcl/unix/aclocal.m4
new file mode 100644
index 00000000000..7bb84600904
--- /dev/null
+++ b/tcl/unix/aclocal.m4
@@ -0,0 +1,535 @@
+dnl written by Rob Savoye <rob@cygnus.com> for Cygnus Support
+dnl CYGNUS LOCAL: This gets the right posix flag for gcc
+AC_DEFUN(CY_AC_TCL_LYNX_POSIX,
+[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP])
+AC_MSG_CHECKING([to see if this is LynxOS])
+AC_CACHE_VAL(ac_cv_os_lynx,
+[AC_EGREP_CPP(yes,
+[/*
+ * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
+ */
+#if defined(__Lynx__) || defined(Lynx)
+yes
+#endif
+], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)])
+#
+if test "$ac_cv_os_lynx" = "yes" ; then
+  AC_MSG_RESULT(yes)
+  AC_DEFINE(LYNX)
+  AC_MSG_CHECKING([whether -mposix or -X is available])
+  AC_CACHE_VAL(ac_cv_c_posix_flag,
+  [AC_TRY_COMPILE(,[
+  /*
+   * This flag varies depending on how old the compiler is.
+   * -X is for the old "cc" and "gcc" (based on 1.42).
+   * -mposix is for the new gcc (at least 2.5.8).
+   */
+  #if defined(__GNUC__) && __GNUC__ >= 2
+  choke me
+  #endif
+  ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")])
+  CC="$CC $ac_cv_c_posix_flag"
+  AC_MSG_RESULT($ac_cv_c_posix_flag)
+  else
+  AC_MSG_RESULT(no)
+fi
+])
+
+AC_DEFUN(CY_AC_PATH_TCLH, [
+#
+# Ok, lets find the tcl source trees so we can use the headers
+# Warning: transition of version 9 to 10 will break this algorithm
+# because 10 sorts before 9. We also look for just tcl. We have to
+# be careful that we don't match stuff like tclX by accident.
+# the alternative search directory is involked by --with-tclinclude
+#
+no_tcl=true
+AC_MSG_CHECKING(for Tcl private headers)
+AC_ARG_WITH(tclinclude, [  --with-tclinclude       directory where tcl private headers are], with_tclinclude=${withval})
+AC_CACHE_VAL(ac_cv_c_tclh,[
+# first check to see if --with-tclinclude was specified
+if test x"${with_tclinclude}" != x ; then
+  if test -f ${with_tclinclude}/tclInt.h ; then
+    ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
+  else
+    AC_MSG_ERROR([${with_tclinclude} directory doesn't contain private headers])
+  fi
+fi
+# next check in private source directory
+#
+# since ls returns lowest version numbers first, reverse its output
+if test x"${ac_cv_c_tclh}" = x ; then
+  for i in \
+		${srcdir}/../tcl \
+		`ls -dr ${srcdir}/../tcl[[0-9]]* 2>/dev/null` \
+		${srcdir}/../../tcl \
+		`ls -dr ${srcdir}/../../tcl[[0-9]]* 2>/dev/null` \
+		${srcdir}/../../../tcl \
+		`ls -dr ${srcdir}/../../../tcl[[0-9]]* 2>/dev/null ` ; do
+    if test -f $i/tclInt.h ; then
+      ac_cv_c_tclh=`(cd $i; pwd)`
+      break
+    fi
+  done
+fi
+# finally check in a few common install locations
+#
+# since ls returns lowest version numbers first, reverse its output
+if test x"${ac_cv_c_tclh}" = x ; then
+  for i in \
+		`ls -dr /usr/local/src/tcl[[0-9]]* 2>/dev/null` \
+		`ls -dr /usr/local/lib/tcl[[0-9]]* 2>/dev/null` \
+		/usr/local/src/tcl \
+		/usr/local/lib/tcl \
+		${prefix}/include ; do
+    if test -f $i/tclInt.h ; then
+      ac_cv_c_tclh=`(cd $i; pwd)`
+      break
+    fi
+  done
+fi
+# see if one is installed
+if test x"${ac_cv_c_tclh}" = x ; then
+   AC_HEADER_CHECK(tclInt.h, ac_cv_c_tclh=installed, ac_cv_c_tclh="")
+fi
+])
+if test x"${ac_cv_c_tclh}" = x ; then
+  TCLHDIR="# no Tcl private headers found"
+  AC_MSG_ERROR([Can't find Tcl private headers])
+fi
+if test x"${ac_cv_c_tclh}" != x ; then
+  no_tcl=""
+  if test x"${ac_cv_c_tkh}" = x"installed" ; then
+    AC_MSG_RESULT([is installed])
+    TCLHDIR=""
+  else
+    AC_MSG_RESULT([found in ${ac_cv_c_tclh}])
+    # this hack is cause the TCLHDIR won't print if there is a "-I" in it.
+    TCLHDIR="-I${ac_cv_c_tclh}"
+  fi
+fi
+
+AC_MSG_CHECKING([Tcl version])
+rm -rf tclmajor tclminor
+orig_includes="$CPPFLAGS"
+
+if test x"${TCLHDIR}" != x ; then
+  CPPFLAGS="$CPPFLAGS $TCLHDIR"
+fi
+
+AC_TRY_RUN([
+#include <stdio.h>
+#include "tcl.h"
+main() {
+	FILE *maj = fopen("tclmajor","w");
+	FILE *min = fopen("tclminor","w");
+	fprintf(maj,"%d",TCL_MAJOR_VERSION);
+	fprintf(min,"%d",TCL_MINOR_VERSION);
+	fclose(maj);
+	fclose(min);
+	return 0;
+}],
+	tclmajor=`cat tclmajor`
+	tclminor=`cat tclminor`
+	tclversion=$tclmajor.$tclminor
+	AC_MSG_RESULT($tclversion)
+	rm -f tclmajor tclminor
+,
+	AC_MSG_RESULT([can't happen])
+,
+	AC_MSG_ERROR([can't be cross compiled])
+)
+CPPFLAGS="${orig_includes}"
+
+AC_PROVIDE([$0])
+AC_SUBST(TCLHDIR)
+])
+AC_DEFUN(CY_AC_PATH_TCLLIB, [
+#
+# Ok, lets find the tcl library
+# First, look for one uninstalled.  
+# the alternative search directory is invoked by --with-tcllib
+#
+
+if test $tclmajor -ge 7 -a $tclminor -ge 4 ; then
+  installedtcllibroot=tcl$tclversion
+else
+  installedtcllibroot=tcl
+fi
+
+if test x"${no_tcl}" = x ; then
+  # we reset no_tcl incase something fails here
+  no_tcl=true
+  AC_ARG_WITH(tcllib, [  --with-tcllib           directory where the tcl library is],
+         with_tcllib=${withval})
+  AC_MSG_CHECKING([for Tcl library])
+  AC_CACHE_VAL(ac_cv_c_tcllib,[
+  # First check to see if --with-tcllib was specified.
+  # This requires checking for both the installed and uninstalled name-styles
+  # since we have no idea if it's installed or not.
+  if test x"${with_tcllib}" != x ; then
+    if test -f "${with_tcllib}/lib$installedtcllibroot.so" ; then
+      ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.so
+    elif test -f "${with_tcllib}/libtcl.so" ; then
+      ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.so
+    # then look for a freshly built statically linked library
+    # if Makefile exists we assume its configured and libtcl will be built first.
+    elif test -f "${with_tcllib}/lib$installedtcllibroot.a" ; then
+      ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.a
+    elif test -f "${with_tcllib}/libtcl.a" ; then
+      ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.a
+    else
+      AC_MSG_ERROR([${with_tcllib} directory doesn't contain libraries])
+    fi
+  fi
+  # then check for a private Tcl library
+  # Since these are uninstalled, use the simple lib name root.
+  if test x"${ac_cv_c_tcllib}" = x ; then
+    for i in \
+		../tcl \
+		`ls -dr ../tcl[[0-9]]* 2>/dev/null` \
+		../../tcl \
+		`ls -dr ../../tcl[[0-9]]* 2>/dev/null` \
+		../../../tcl \
+		`ls -dr ../../../tcl[[0-9]]* 2>/dev/null` ; do
+      # first look for a freshly built dynamically linked library
+      if test -f "$i/libtcl.so" ; then
+        ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so
+	break
+      # then look for a freshly built statically linked library
+      # if Makefile exists we assume its configured and libtcl will be built first.
+      elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then
+        ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a
+	break
+      fi
+    done
+  fi
+  # check in a few common install locations
+  if test x"${ac_cv_c_tcllib}" = x ; then
+    for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do
+      # first look for a freshly built dynamically linked library
+      if test -f "$i/lib$installedtcllibroot.so" ; then
+        ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.so
+	break
+      # then look for a freshly built statically linked library
+      # if Makefile exists we assume its configured and libtcl will be built first.
+      elif test -f "$i/lib$installedtcllibroot.a" -o -f "$i/Makefile" ; then
+        ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.a
+	break
+      fi
+    done
+  fi
+  # check in a few other private locations
+  if test x"${ac_cv_c_tcllib}" = x ; then
+    for i in \
+		${srcdir}/../tcl \
+		`ls -dr ${srcdir}/../tcl[[0-9]]* 2>/dev/null` ; do
+      # first look for a freshly built dynamically linked library
+      if test -f "$i/libtcl.so" ; then
+        ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so
+	break
+      # then look for a freshly built statically linked library
+      # if Makefile exists we assume its configured and libtcl will be built first.
+      elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then
+        ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a
+	break
+      fi
+    done
+  fi
+
+  # see if one is conveniently installed with the compiler
+  if test x"${ac_cv_c_tcllib}" = x ; then	
+    orig_libs="$LIBS"
+    LIBS="$LIBS -l$installedtcllibroot -lm"    
+    AC_TRY_RUN([
+    Tcl_AppInit()
+    { exit(0); }], ac_cv_c_tcllib="-l$installedtcllibroot", ac_cv_c_tcllib=""
+    , ac_cv_c_tclib="-l$installedtcllibroot")
+    LIBS="${orig_libs}"
+   fi
+  ])
+  if test x"${ac_cv_c_tcllib}" = x ; then
+    TCLLIB="# no Tcl library found"
+    AC_MSG_WARN(Can't find Tcl library)
+  else
+    TCLLIB=${ac_cv_c_tcllib}
+    AC_MSG_RESULT(found $TCLLIB)
+    no_tcl=
+  fi
+fi
+
+AC_PROVIDE([$0])
+AC_SUBST(TCLLIB)
+])
+AC_DEFUN(CY_AC_PATH_TKH, [
+#
+# Ok, lets find the tk source trees so we can use the headers
+# If the directory (presumably symlink) named "tk" exists, use that one
+# in preference to any others.  Same logic is used when choosing library
+# and again with Tcl. The search order is the best place to look first, then in
+# decreasing significance. The loop breaks if the trigger file is found.
+# Note the gross little conversion here of srcdir by cd'ing to the found
+# directory. This converts the path from a relative to an absolute, so
+# recursive cache variables for the path will work right. We check all
+# the possible paths in one loop rather than many seperate loops to speed
+# things up.
+# the alternative search directory is invoked by --with-tkinclude
+#
+AC_MSG_CHECKING(for Tk private headers)
+AC_ARG_WITH(tkinclude, [  --with-tkinclude        directory where the tk private headers are],
+            with_tkinclude=${withval})
+no_tk=true
+AC_CACHE_VAL(ac_cv_c_tkh,[
+# first check to see if --with-tkinclude was specified
+if test x"${with_tkinclude}" != x ; then
+  if test -f ${with_tkinclude}/tk.h ; then
+    ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
+  else
+    AC_MSG_ERROR([${with_tkinclude} directory doesn't contain private headers])
+  fi
+fi
+# next check in private source directory
+#
+# since ls returns lowest version numbers first, reverse the entire list
+# and search for the worst fit, overwriting it with better fits as we find them
+if test x"${ac_cv_c_tkh}" = x ; then
+  for i in \
+		${srcdir}/../tk \
+		`ls -dr ${srcdir}/../tk[[0-9]]* 2>/dev/null` \
+		${srcdir}/../../tk \
+		`ls -dr ${srcdir}/../../tk[[0-9]]* 2>/dev/null` \
+		${srcdir}/../../../tk \
+		`ls -dr ${srcdir}/../../../tk[[0-9]]* 2>/dev/null ` ; do
+    if test -f $i/tk.h ; then
+      ac_cv_c_tkh=`(cd $i; pwd)`
+      break
+    fi
+  done
+fi
+# finally check in a few common install locations
+#
+# since ls returns lowest version numbers first, reverse the entire list
+# and search for the worst fit, overwriting it with better fits as we find them
+if test x"${ac_cv_c_tkh}" = x ; then
+  for i in \
+		`ls -dr /usr/local/src/tk[[0-9]]* 2>/dev/null` \
+		`ls -dr /usr/local/lib/tk[[0-9]]* 2>/dev/null` \
+		/usr/local/src/tk \
+		/usr/local/lib/tk \
+		${prefix}/include ; do
+    if test -f $i/tk.h ; then
+      ac_cv_c_tkh=`(cd $i; pwd)`
+      break
+    fi
+  done
+fi
+# see if one is installed
+if test x"${ac_cv_c_tkh}" = x ; then
+  AC_HEADER_CHECK(tk.h, ac_cv_c_tkh=installed)
+fi
+])
+if test x"${ac_cv_c_tkh}" != x ; then
+  no_tk=""
+  if test x"${ac_cv_c_tkh}" = x"installed" ; then
+    AC_MSG_RESULT([is installed])
+    TKHDIR=""
+  else
+    AC_MSG_RESULT([found in $ac_cv_c_tkh])
+    # this hack is cause the TKHDIR won't print if there is a "-I" in it.
+    TKHDIR="-I${ac_cv_c_tkh}"
+  fi
+else
+  TKHDIR="# no Tk directory found"
+  AC_MSG_WARN([Can't find Tk private headers])
+  no_tk=true
+fi
+
+# if Tk is installed, extract the major/minor version
+if test x"${no_tk}" = x ; then
+AC_MSG_CHECKING([Tk version])
+rm -rf tkmajor tkminor
+orig_includes="$CPPFLAGS"
+
+if test x"${TCLHDIR}" != x ; then
+  CPPFLAGS="$CPPFLAGS $TCLHDIR"
+fi
+if test x"${TKHDIR}" != x ; then
+  CPPFLAGS="$CPPFLAGS $TKHDIR"
+fi
+if test x"${x_includes}" != x -a x"${x_includes}" != xNONE ; then
+  CPPFLAGS="$CPPFLAGS -I$x_includes"
+fi
+
+AC_TRY_RUN([
+#include <stdio.h>
+#include "tk.h"
+  main() {
+	FILE *maj = fopen("tkmajor","w");
+	FILE *min = fopen("tkminor","w");
+	fprintf(maj,"%d",TK_MAJOR_VERSION);
+	fprintf(min,"%d",TK_MINOR_VERSION);
+	fclose(maj);
+	fclose(min);
+	return 0;
+}],
+	tkmajor=`cat tkmajor`
+	tkminor=`cat tkminor`
+	tkversion=$tkmajor.$tkminor
+	AC_MSG_RESULT($tkversion)
+	rm -f tkmajor tkminor
+,
+	AC_MSG_ERROR([
+cannot compile a simple X program - suspect your xmkmf is
+misconfigured and is incorrectly reporting the location of your X
+include or libraries - report this to your system admin]) ,
+	AC_MSG_ERROR([can't be cross compiled])
+)
+CPPFLAGS="${orig_includes}"
+fi
+
+AC_PROVIDE([$0])
+AC_SUBST(TKHDIR)
+])
+dnl for some reason, AC_REQUIRE() seems to choke autoconf
+AC_DEFUN(CY_AC_PATH_TKLIB, [
+dnl AC_REQUIRE(CY_AC_PATH_TCL)
+#
+# Ok, lets find the tk library
+# First, look for the latest private (uninstalled) copy
+# Notice that the destinations in backwards priority since the tests have
+# no break.
+# Then we look for either .a, .so, or Makefile.  A Makefile is acceptable
+# is it indicates the target has been configured and will (probably)
+# soon be built.  This allows an entire tree of Tcl software to be
+# configured at once and then built.
+# the alternative search directory is invoked by --with-tklib
+#
+
+if test x"${no_tk}" = x ; then
+  # reset no_tk incase something fails here
+  no_tk="true"
+
+  if test $tkmajor -ge 4 ; then
+    installedtklibroot=tk$tkversion
+  else
+    installedtkllibroot=tk
+  fi
+
+  AC_ARG_WITH(tklib, [  --with-tklib            directory where the tk library is],
+              with_tklib=${withval})
+  AC_MSG_CHECKING([for Tk library])
+  AC_CACHE_VAL(ac_cv_c_tklib,[
+  # first check to see if --with-tklib was specified
+  # This requires checking for both the installed and uninstalled name-styles
+  # since we have no idea if it's installed or not.
+  if test x"${with_tklib}" != x ; then
+    if test -f "${with_tklib}/lib$installedtklibroot.so" ; then
+      ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.so
+      no_tk=""
+    elif test -f "${with_tklib}/libtk.so" ; then
+      ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.so
+      no_tk=""
+    # then look for a freshly built statically linked library
+    # if Makefile exists we assume its configured and libtk will be built
+    elif test -f "${with_tklib}/lib$installedtklibroot.a" ; then
+      ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.a
+      no_tk=""
+    elif test -f "${with_tklib}/libtk.a" ; then
+      ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.a
+      no_tk=""
+    else
+      AC_MSG_ERROR([${with_tklib} directory doesn't contain libraries])
+    fi
+  fi
+  # then check for a private Tk library
+  # Since these are uninstalled, use the simple lib name root.
+  if test x"${ac_cv_c_tklib}" = x ; then
+    for i in \
+		../tk \
+		`ls -dr ../tk[[0-9]]* 2>/dev/null` \
+		../../tk \
+		`ls -dr ../../tk[[0-9]]* 2>/dev/null` \
+		../../../tk \
+		`ls -dr ../../../tk[[0-9]]* 2>/dev/null` ; do
+      # first look for a freshly built dynamically linked library
+      if test -f "$i/libtk.so" ; then
+        ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so
+        no_tk=
+	break
+      # then look for a freshly built statically linked library
+      # if Makefile exists we assume its configured and libtk will be built 
+      elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then
+        ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a
+        no_tk=""
+ 	break
+      fi
+    done
+  fi
+  # finally check in a few common install locations
+  if test x"${ac_cv_c_tklib}" = x ; then
+    for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do
+      # first look for a freshly built dynamically linked library
+      if test -f "$i/lib$installedtklibroot.so" ; then
+        ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.so
+        no_tk=""
+	break
+      # then look for a freshly built statically linked library
+      # if Makefile exists, we assume it's configured and libtcl will be built 
+      elif test -f "$i/lib$installedtklibroot.a" -o -f "$i/Makefile" ; then
+        ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.a
+        no_tk=""
+ 	break
+      fi
+    done
+  fi
+  # check in a few other private locations
+  if test x"${ac_cv_c_tklib}" = x ; then
+    for i in \
+		${srcdir}/../tk \
+		`ls -dr ${srcdir}/../tk[[0-9]]* 2>/dev/null` ; do
+      # first look for a freshly built dynamically linked library
+      if test -f "$i/libtk.so" ; then
+        ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so
+        no_tk=""
+	break
+      # then look for a freshly built statically linked library
+      # if Makefile exists, we assume it's configured and libtcl will be built 
+      elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then
+        ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a
+        no_tk=""
+ 	break
+      fi
+    done
+  fi
+  # see if one is conveniently installed with the compiler
+  if test x"${ac_cv_c_tklib}" = x ; then
+dnl       AC_REQUIRE(AC_PATH_X)
+       orig_libs="$LIBS"
+       LIBS="$LIBS -l$installedtklibroot $x_libraries $ac_cv_c_tcllib -lm"    
+       AC_TRY_RUN([
+       Tcl_AppInit()
+       { exit(0); }], ac_cv_c_tklib="-l$installedtklibroot", ac_cv_c_tklib=""
+       , ac_cv_c_tklib="-l$installedtklibroot")
+       LIBS="${orig_libs}"
+   fi
+  ])
+  if test x"${ac_cv_c_tklib}" = x ; then
+    TKLIB="# no Tk library found"
+    AC_MSG_WARN(Can't find Tk library)
+  else
+    TKLIB=$ac_cv_c_tklib
+    AC_MSG_RESULT(found $TKLIB)
+    no_tk=
+  fi
+fi
+AC_PROVIDE([$0])
+AC_SUBST(TKLIB)
+])
+AC_DEFUN(CY_AC_PATH_TK, [
+  CY_AC_PATH_TKH
+  CY_AC_PATH_TKLIB
+])
+AC_DEFUN(CY_AC_PATH_TCL, [
+  CY_AC_PATH_TCLH
+  CY_AC_PATH_TCLLIB
+])
diff --git a/tcl/unix/configure b/tcl/unix/configure
new file mode 100755
index 00000000000..4f5601eb879
--- /dev/null
+++ b/tcl/unix/configure
@@ -0,0 +1,5649 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+  --disable-load          disallow dynamic loading and "load" command"
+ac_help="$ac_help
+  --enable-shared         build libtcl as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.13"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set.  These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/tcl.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+  if test "x$prefix" != xNONE; then
+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+  else
+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+  fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+# SCCS: @(#) configure.in 1.18 98/08/12 17:29:39
+
+TCL_VERSION=8.0
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL=".3"
+VERSION=${TCL_VERSION}
+
+if test "${prefix}" = "NONE"; then
+    prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+    exec_prefix=$prefix
+fi
+TCL_SRC_DIR=`cd $srcdir/..; pwd`
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:548: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_RANLIB="ranlib"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ac_t""$RANLIB" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:578: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="gcc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:608: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_prog_rejected=no
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+        ac_prog_rejected=yes
+	continue
+      fi
+      ac_cv_prog_CC="cc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# -gt 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    set dummy "$ac_dir/$ac_word" "$@"
+    shift
+    ac_cv_prog_CC="$@"
+  fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  if test -z "$CC"; then
+    case "`uname -s`" in
+    *win32* | *WIN32*)
+      # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:659: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="cl"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+ ;;
+    esac
+  fi
+  test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:691: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 702 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:707: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  ac_cv_prog_cc_works=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    ac_cv_prog_cc_cross=no
+  else
+    ac_cv_prog_cc_cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+  { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:733: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:738: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.c <<EOF
+#ifdef __GNUC__
+  yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:747: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+  ac_cv_prog_gcc=yes
+else
+  ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:766: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+  ac_cv_prog_cc_g=yes
+else
+  ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+
+
+# CYGNUS LOCAL
+# dje/win32
+AR=${AR-ar}
+# We need this for substitutions in Makefile.in.
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+  if test -f $ac_dir/install-sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f $ac_dir/install.sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program.  We prefer a C program (faster),
+# so one script is as good as another.  But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:833: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+    IFS="${IFS= 	}"; ac_save_IFS="$IFS"; IFS=":"
+  for ac_dir in $PATH; do
+    # Account for people who put trailing slashes in PATH elements.
+    case "$ac_dir/" in
+    /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+    *)
+      # OSF1 and SCO ODT 3.0 have their own names for install.
+      # Don't use installbsd from OSF since it installs stuff as root
+      # by default.
+      for ac_prog in ginstall scoinst install; do
+        if test -f $ac_dir/$ac_prog; then
+	  if test $ac_prog = install &&
+            grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+	    # AIX install.  It has an incompatible calling convention.
+	    :
+	  else
+	    ac_cv_path_install="$ac_dir/$ac_prog -c"
+	    break 2
+	  fi
+	fi
+      done
+      ;;
+    esac
+  done
+  IFS="$ac_save_IFS"
+
+fi
+  if test "${ac_cv_path_install+set}" = set; then
+    INSTALL="$ac_cv_path_install"
+  else
+    # As a last resort, use the slow shell script.  We don't cache a
+    # path for INSTALL within a source directory, because that will
+    # break other packages using the cache if that directory is
+    # removed, or if the path is relative.
+    INSTALL="$ac_install_sh"
+  fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# CYGNUS LOCAL:
+# This is for LynxOS, which needs a flag to force true POSIX when
+# building. It's weirder than that, cause the flag varies depending
+# how old the compiler is. So...
+# -X is for the old "cc" and "gcc" (based on 1.42)
+# -mposix is for the new gcc (at least 2.5.8)
+# This modifies the value of $CC to have the POSIX flag added
+# so everything will configure correctly.
+#--------------------------------------------------------------------
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:898: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+    # This must be in double quotes, not single quotes, because CPP may get
+  # substituted into the Makefile and "${CC-cc}" will confuse make.
+  CPP="${CC-cc} -E"
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp.
+  cat > conftest.$ac_ext <<EOF
+#line 913 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:919: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP="${CC-cc} -E -traditional-cpp"
+  cat > conftest.$ac_ext <<EOF
+#line 930 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:936: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP="${CC-cc} -nologo -E"
+  cat > conftest.$ac_ext <<EOF
+#line 947 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:953: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+  ac_cv_prog_CPP="$CPP"
+fi
+  CPP="$ac_cv_prog_CPP"
+else
+  ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+
+echo $ac_n "checking to see if this is LynxOS""... $ac_c" 1>&6
+echo "configure:979: checking to see if this is LynxOS" >&5
+if eval "test \"`echo '$''{'ac_cv_os_lynx'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 984 "configure"
+#include "confdefs.h"
+/*
+ * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
+ */
+#if defined(__Lynx__) || defined(Lynx)
+yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_os_lynx=yes
+else
+  rm -rf conftest*
+  ac_cv_os_lynx=no
+fi
+rm -f conftest*
+
+fi
+
+#
+if test "$ac_cv_os_lynx" = "yes" ; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define LYNX 1
+EOF
+
+  echo $ac_n "checking whether -mposix or -X is available""... $ac_c" 1>&6
+echo "configure:1014: checking whether -mposix or -X is available" >&5
+  if eval "test \"`echo '$''{'ac_cv_c_posix_flag'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1019 "configure"
+#include "confdefs.h"
+
+int main() {
+
+  /*
+   * This flag varies depending on how old the compiler is.
+   * -X is for the old "cc" and "gcc" (based on 1.42).
+   * -mposix is for the new gcc (at least 2.5.8).
+   */
+  #if defined(__GNUC__) && __GNUC__ >= 2
+  choke me
+  #endif
+  
+; return 0; }
+EOF
+if { (eval echo configure:1035: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_c_posix_flag=" -mposix"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_c_posix_flag=" -X"
+fi
+rm -f conftest*
+fi
+
+  CC="$CC $ac_cv_c_posix_flag"
+  echo "$ac_t""$ac_cv_c_posix_flag" 1>&6
+  else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+# set the warning flags depending on whether or not we are using gcc
+if test "${GCC}" = "yes" ; then
+    CFLAGS_WARNING="-Wall -Wconversion"
+else
+    CFLAGS_WARNING=""
+fi
+
+#--------------------------------------------------------------------
+#	Supply substitutes for missing POSIX library procedures, or
+#	set flags so Tcl uses alternate procedures.
+#--------------------------------------------------------------------
+
+# Check if Posix compliant getcwd exists, if not we'll use getwd.
+for ac_func in getcwd
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1070: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1075 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1098: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define USEGETWD 1
+EOF
+
+fi
+done
+
+# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
+# define USEGETWD even if the posix getcwd exists. Add a test ?
+
+for ac_func in opendir strstr
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1132: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1137 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1160: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+LIBOBJS="$LIBOBJS ${ac_func}.${ac_objext}"
+fi
+done
+
+
+
+for ac_func in strtol tmpnam waitpid
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1190: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1195 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1218: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+LIBOBJS="$LIBOBJS ${ac_func}.${ac_objext}"
+fi
+done
+
+
+echo $ac_n "checking for strerror""... $ac_c" 1>&6
+echo "configure:1245: checking for strerror" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strerror'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1250 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char strerror(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strerror();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_strerror) || defined (__stub___strerror)
+choke me
+#else
+strerror();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1273: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_strerror=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_strerror=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strerror`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_STRERROR 1
+EOF
+
+fi
+
+echo $ac_n "checking for getwd""... $ac_c" 1>&6
+echo "configure:1297: checking for getwd" >&5
+if eval "test \"`echo '$''{'ac_cv_func_getwd'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1302 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char getwd(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char getwd();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_getwd) || defined (__stub___getwd)
+choke me
+#else
+getwd();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1325: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_getwd=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_getwd=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'getwd`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_GETWD 1
+EOF
+
+fi
+
+echo $ac_n "checking for wait3""... $ac_c" 1>&6
+echo "configure:1349: checking for wait3" >&5
+if eval "test \"`echo '$''{'ac_cv_func_wait3'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1354 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char wait3(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char wait3();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_wait3) || defined (__stub___wait3)
+choke me
+#else
+wait3();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1377: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_wait3=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_wait3=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'wait3`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_WAIT3 1
+EOF
+
+fi
+
+echo $ac_n "checking for uname""... $ac_c" 1>&6
+echo "configure:1401: checking for uname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_uname'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1406 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char uname(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char uname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_uname) || defined (__stub___uname)
+choke me
+#else
+uname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1429: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_uname=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_uname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'uname`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_UNAME 1
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+#	On a few very rare systems, all of the libm.a stuff is
+#	already in libc.a.  Set compiler flags accordingly.
+#	Also, Linux requires the "ieee" library for math to work
+#	right (and it must appear before "-lm").
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:1461: checking for sin" >&5
+if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1466 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char sin(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char sin();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_sin) || defined (__stub___sin)
+choke me
+#else
+sin();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1489: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_sin=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_sin=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  MATH_LIBS=""
+else
+  echo "$ac_t""no" 1>&6
+MATH_LIBS="-lm"
+fi
+
+echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
+echo "configure:1510: checking for main in -lieee" >&5
+ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lieee  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1518 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1525: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  MATH_LIBS="-lieee $MATH_LIBS"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+#--------------------------------------------------------------------
+#       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
+    echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
+echo "configure:1556: checking for gettimeofday in -lbsd" >&5
+ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lbsd  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1564 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char gettimeofday();
+
+int main() {
+gettimeofday()
+; return 0; }
+EOF
+if { (eval echo configure:1575: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  libbsd=yes
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+    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
+#	      strtod insome versions of SunOS
+#	    - some versions of string.h don't declare procedures such
+#	      as strstr
+#--------------------------------------------------------------------
+
+echo $ac_n "checking dirent.h""... $ac_c" 1>&6
+echo "configure:1610: checking dirent.h" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1612 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <dirent.h>
+int main() {
+
+#ifndef _POSIX_SOURCE
+#   ifdef __Lynx__
+	/*
+	 * Generate compilation error to make the test fail:  Lynx headers
+	 * are only valid if really in the POSIX environment.
+	 */
+
+	missing_procedure();
+#   endif
+#endif
+DIR *d;
+struct dirent *entryPtr;
+char *p;
+d = opendir("foobar");
+entryPtr = readdir(d);
+p = entryPtr->d_name;
+closedir(d);
+
+; return 0; }
+EOF
+if { (eval echo configure:1638: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  tcl_ok=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=no
+fi
+rm -f conftest*
+if test $tcl_ok = no; then
+    cat >> confdefs.h <<\EOF
+#define NO_DIRENT_H 1
+EOF
+
+fi
+echo "$ac_t""$tcl_ok" 1>&6
+ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for errno.h""... $ac_c" 1>&6
+echo "configure:1657: checking for errno.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1662 "configure"
+#include "confdefs.h"
+#include <errno.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1667: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_ERRNO_H 1
+EOF
+
+fi
+
+ac_safe=`echo "float.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for float.h""... $ac_c" 1>&6
+echo "configure:1694: checking for float.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1699 "configure"
+#include "confdefs.h"
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1704: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_FLOAT_H 1
+EOF
+
+fi
+
+ac_safe=`echo "values.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for values.h""... $ac_c" 1>&6
+echo "configure:1731: checking for values.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1736 "configure"
+#include "confdefs.h"
+#include <values.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1741: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_VALUES_H 1
+EOF
+
+fi
+
+ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for limits.h""... $ac_c" 1>&6
+echo "configure:1768: checking for limits.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1773 "configure"
+#include "confdefs.h"
+#include <limits.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1778: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_LIMITS_H 1
+EOF
+
+fi
+
+ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6
+echo "configure:1805: checking for stdlib.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1810 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1815: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+cat > conftest.$ac_ext <<EOF
+#line 1838 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "strtol" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  tcl_ok=0
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1852 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "strtoul" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  tcl_ok=0
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1866 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "strtod" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  tcl_ok=0
+fi
+rm -f conftest*
+
+if test $tcl_ok = 0; then
+    cat >> confdefs.h <<\EOF
+#define NO_STDLIB_H 1
+EOF
+
+fi
+ac_safe=`echo "string.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for string.h""... $ac_c" 1>&6
+echo "configure:1887: checking for string.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1892 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1897: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+cat > conftest.$ac_ext <<EOF
+#line 1920 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "strstr" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  tcl_ok=0
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1934 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "strerror" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  tcl_ok=0
+fi
+rm -f conftest*
+
+if test $tcl_ok = 0; then
+    cat >> confdefs.h <<\EOF
+#define NO_STRING_H 1
+EOF
+
+fi
+ac_safe=`echo "sys/wait.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for sys/wait.h""... $ac_c" 1>&6
+echo "configure:1955: checking for sys/wait.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1960 "configure"
+#include "confdefs.h"
+#include <sys/wait.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1965: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_SYS_WAIT_H 1
+EOF
+
+fi
+
+ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
+echo "configure:1992: checking for dlfcn.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1997 "configure"
+#include "confdefs.h"
+#include <dlfcn.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2002: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_DLFCN_H 1
+EOF
+
+fi
+
+for ac_hdr in unistd.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2031: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2036 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2041: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+
+#---------------------------------------------------------------------------
+#	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.
+#---------------------------------------------------------------------------
+
+echo $ac_n "checking termios vs. termio vs. sgtty""... $ac_c" 1>&6
+echo "configure:2075: checking termios vs. termio vs. sgtty" >&5
+if test "$cross_compiling" = yes; then
+  tk_ok=no
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2080 "configure"
+#include "confdefs.h"
+
+#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;
+}
+EOF
+if { (eval echo configure:2096: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  tk_ok=termios
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tk_ok=no
+fi
+rm -fr conftest*
+fi
+
+if test $tk_ok = termios; then
+    cat >> confdefs.h <<\EOF
+#define USE_TERMIOS 1
+EOF
+
+else
+if test "$cross_compiling" = yes; then
+  tk_ok=no
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2118 "configure"
+#include "confdefs.h"
+
+#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;
+}
+EOF
+if { (eval echo configure:2133: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  tk_ok=termio
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tk_ok=no
+fi
+rm -fr conftest*
+fi
+
+if test $tk_ok = termio; then
+    cat >> confdefs.h <<\EOF
+#define USE_TERMIO 1
+EOF
+
+else
+if test "$cross_compiling" = yes; then
+  tk_ok=none
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2155 "configure"
+#include "confdefs.h"
+
+#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;
+}
+EOF
+if { (eval echo configure:2171: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  tk_ok=sgtty
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tk_ok=none
+fi
+rm -fr conftest*
+fi
+
+if test $tk_ok = sgtty; then
+    cat >> confdefs.h <<\EOF
+#define USE_SGTTY 1
+EOF
+
+fi
+fi
+fi
+echo "$ac_t""$tk_ok" 1>&6
+
+#--------------------------------------------------------------------
+#	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.
+#	This appears to be true only on the RS/6000 under AIX.  Some
+#	systems like OSF/1 have a sys/select.h that's of no use, and
+#	other systems like SCO UNIX have a sys/select.h that's
+#	pernicious.  If "fd_set" isn't defined anywhere then set a
+#	special flag.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6
+echo "configure:2204: checking fd_set and sys/select" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2206 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+int main() {
+fd_set readMask, writeMask;
+; return 0; }
+EOF
+if { (eval echo configure:2213: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tk_ok=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tk_ok=no
+fi
+rm -f conftest*
+if test $tk_ok = no; then
+    cat > conftest.$ac_ext <<EOF
+#line 2225 "configure"
+#include "confdefs.h"
+#include <sys/select.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "fd_mask" >/dev/null 2>&1; then
+  rm -rf conftest*
+  tk_ok=yes
+fi
+rm -f conftest*
+
+    if test $tk_ok = yes; then
+	cat >> confdefs.h <<\EOF
+#define HAVE_SYS_SELECT_H 1
+EOF
+
+    fi
+fi
+echo "$ac_t""$tk_ok" 1>&6
+if test $tk_ok = no; then
+    cat >> confdefs.h <<\EOF
+#define NO_FD_SET 1
+EOF
+
+fi
+
+#------------------------------------------------------------------------------
+#       Find out all about time handling differences.
+#------------------------------------------------------------------------------
+
+for ac_hdr in sys/time.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2259: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2264 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2269: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:2296: checking whether time.h and sys/time.h may both be included" >&5
+if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2301 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:2310: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_header_time=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_header_time=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_header_time" 1>&6
+if test $ac_cv_header_time = yes; then
+  cat >> confdefs.h <<\EOF
+#define TIME_WITH_SYS_TIME 1
+EOF
+
+fi
+
+echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
+echo "configure:2331: checking whether struct tm is in sys/time.h or time.h" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2336 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:2344: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_tm=time.h
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_tm=sys/time.h
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_tm" 1>&6
+if test $ac_cv_struct_tm = sys/time.h; then
+  cat >> confdefs.h <<\EOF
+#define TM_IN_SYS_TIME 1
+EOF
+
+fi
+
+echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
+echo "configure:2365: checking for tm_zone in struct tm" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2370 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <$ac_cv_struct_tm>
+int main() {
+struct tm tm; tm.tm_zone;
+; return 0; }
+EOF
+if { (eval echo configure:2378: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_tm_zone=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_tm_zone=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6
+if test "$ac_cv_struct_tm_zone" = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_TM_ZONE 1
+EOF
+
+else
+  echo $ac_n "checking for tzname""... $ac_c" 1>&6
+echo "configure:2398: checking for tzname" >&5
+if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2403 "configure"
+#include "confdefs.h"
+#include <time.h>
+#ifndef tzname /* For SGI.  */
+extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
+#endif
+int main() {
+atoi(*tzname);
+; return 0; }
+EOF
+if { (eval echo configure:2413: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  ac_cv_var_tzname=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_var_tzname=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_var_tzname" 1>&6
+  if test $ac_cv_var_tzname = yes; then
+    cat >> confdefs.h <<\EOF
+#define HAVE_TZNAME 1
+EOF
+
+  fi
+fi
+
+
+echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
+echo "configure:2436: checking tm_tzadj in struct tm" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2438 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+struct tm tm; tm.tm_tzadj;
+; return 0; }
+EOF
+if { (eval echo configure:2445: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  cat >> confdefs.h <<\EOF
+#define HAVE_TM_TZADJ 1
+EOF
+
+         echo "$ac_t""yes" 1>&6
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
+echo "configure:2461: checking tm_gmtoff in struct tm" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2463 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+struct tm tm; tm.tm_gmtoff;
+; return 0; }
+EOF
+if { (eval echo configure:2470: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  cat >> confdefs.h <<\EOF
+#define HAVE_TM_GMTOFF 1
+EOF
+
+         echo "$ac_t""yes" 1>&6
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+#
+# Its important to include time.h in this check, as some systems (like convex)
+# have timezone functions, etc.
+#
+have_timezone=no
+echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
+echo "configure:2491: checking long timezone variable" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2493 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+extern long timezone;
+         timezone += 1;
+         exit (0);
+; return 0; }
+EOF
+if { (eval echo configure:2502: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  have_timezone=yes
+	 cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_VAR 1
+EOF
+
+         echo "$ac_t""yes" 1>&6
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+#
+# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+#
+if test "$have_timezone" = no; then
+   echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
+echo "configure:2523: checking time_t timezone variable" >&5
+   cat > conftest.$ac_ext <<EOF
+#line 2525 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+extern time_t timezone;
+         timezone += 1;
+         exit (0);
+; return 0; }
+EOF
+if { (eval echo configure:2534: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  have_timezone=yes
+	 cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_VAR 1
+EOF
+
+         echo "$ac_t""yes" 1>&6
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+fi
+
+#
+# On some systems (eg Solaris 2.5.1, timezone is not declared in
+# time.h unless you jump through hoops.  Instead of that, we just
+# declare it ourselves when necessary.
+#
+if test "$have_timezone" = yes; then
+   echo $ac_n "checking for timezone declaration""... $ac_c" 1>&6
+echo "configure:2558: checking for timezone declaration" >&5
+   
+   tzrx='^[ 	]*extern.*timezone'
+   
+   cat > conftest.$ac_ext <<EOF
+#line 2563 "configure"
+#include "confdefs.h"
+#include <time.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "$tzrx" >/dev/null 2>&1; then
+  rm -rf conftest*
+  
+     cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_DECL 1
+EOF
+
+     echo "$ac_t""found" 1>&6
+else
+  rm -rf conftest*
+  echo "$ac_t""missing" 1>&6
+fi
+rm -f conftest*
+
+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
+    cat >> confdefs.h <<\EOF
+#define USE_DELTA_FOR_TZ 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+#	Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
+#	in struct stat.
+#--------------------------------------------------------------------
+echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
+echo "configure:2602: checking for st_blksize in struct stat" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2607 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_blksize;
+; return 0; }
+EOF
+if { (eval echo configure:2615: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_blksize=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_st_blksize=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6
+if test $ac_cv_struct_st_blksize = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_BLKSIZE 1
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+#	On some systems strstr is broken: it returns a pointer even
+#	even if the original string is empty.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking proper strstr implementation""... $ac_c" 1>&6
+echo "configure:2642: checking proper strstr implementation" >&5
+if test "$cross_compiling" = yes; then
+  tcl_ok=no
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2647 "configure"
+#include "confdefs.h"
+
+extern int strstr();
+int main()
+{
+    exit(strstr("\0test", "test") ? 1 : 0);
+}
+
+EOF
+if { (eval echo configure:2657: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  tcl_ok=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tcl_ok=no
+fi
+rm -fr conftest*
+fi
+
+if test $tcl_ok = yes; then
+    echo "$ac_t""yes" 1>&6
+else
+    echo "$ac_t""broken, using substitute" 1>&6
+    LIBOBJS="$LIBOBJS strstr.o"
+fi
+
+#--------------------------------------------------------------------
+#	Check for strtoul function.  This is tricky because under some
+#	versions of AIX strtoul returns an incorrect terminator
+#	pointer for the string "0".
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strtoul""... $ac_c" 1>&6
+echo "configure:2683: checking for strtoul" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtoul'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2688 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char strtoul(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strtoul();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_strtoul) || defined (__stub___strtoul)
+choke me
+#else
+strtoul();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2711: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_strtoul=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_strtoul=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strtoul`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$cross_compiling" = yes; then
+  tcl_ok=0
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2735 "configure"
+#include "confdefs.h"
+
+extern int strtoul();
+int main()
+{
+    char *string = "0";
+    char *term;
+    int value;
+    value = strtoul(string, &term, 0);
+    if ((value != 0) || (term != (string+1))) {
+        exit(1);
+    }
+    exit(0);
+}
+EOF
+if { (eval echo configure:2751: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  :
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tcl_ok=0
+fi
+rm -fr conftest*
+fi
+
+if test "$tcl_ok" = 0; then
+    test -n "$verbose" && echo "	Adding strtoul.o."
+    LIBOBJS="$LIBOBJS strtoul.o"
+fi
+
+#--------------------------------------------------------------------
+#	Check for the strtod function.  This is tricky because in some
+#	versions of Linux strtod mis-parses strings starting with "+".
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:2774: checking for strtod" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2779 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char strtod(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strtod();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_strtod) || defined (__stub___strtod)
+choke me
+#else
+strtod();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2802: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_strtod=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_strtod=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$cross_compiling" = yes; then
+  tcl_ok=0
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2826 "configure"
+#include "confdefs.h"
+
+extern double strtod();
+int main()
+{
+    char *string = " +69";
+    char *term;
+    double value;
+    value = strtod(string, &term);
+    if ((value != 69) || (term != (string+4))) {
+	exit(1);
+    }
+    exit(0);
+}
+EOF
+if { (eval echo configure:2842: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  :
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tcl_ok=0
+fi
+rm -fr conftest*
+fi
+
+if test "$tcl_ok" = 0; then
+    test -n "$verbose" && echo "	Adding strtod.o."
+    LIBOBJS="$LIBOBJS strtod.o"
+fi
+
+#--------------------------------------------------------------------
+#	Under Solaris 2.4, strtod returns the wrong value for the
+#	terminating character under some conditions.  Check for this
+#	and if the problem exists use a substitute procedure
+#	"fixstrtod" that corrects the error.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:2867: checking for strtod" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2872 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char strtod(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strtod();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_strtod) || defined (__stub___strtod)
+choke me
+#else
+strtod();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2895: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_strtod=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_strtod=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_strtod=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_strtod=0
+fi
+
+if test "$tcl_strtod" = 1; then
+    echo $ac_n "checking for Solaris strtod bug""... $ac_c" 1>&6
+echo "configure:2917: checking for Solaris strtod bug" >&5
+    if test "$cross_compiling" = yes; then
+  tcl_ok=0
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2922 "configure"
+#include "confdefs.h"
+
+extern double strtod();
+int main()
+{
+    char *string = "NaN";
+    char *term;
+    strtod(string, &term);
+    if ((term != string) && (term[-1] == 0)) {
+	exit(1);
+    }
+    exit(0);
+}
+EOF
+if { (eval echo configure:2937: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  tcl_ok=1
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tcl_ok=0
+fi
+rm -fr conftest*
+fi
+
+    if test $tcl_ok = 1; then
+	echo "$ac_t""ok" 1>&6
+    else
+	echo "$ac_t""buggy" 1>&6
+	LIBOBJS="$LIBOBJS fixstrtod.o"
+	cat >> confdefs.h <<\EOF
+#define strtod fixstrtod
+EOF
+
+    fi
+fi
+
+#--------------------------------------------------------------------
+#	Check for various typedefs and provide substitutes if
+#	they don't exist.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:2967: checking for ANSI C header files" >&5
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 2972 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2980: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  ac_cv_header_stdc=yes
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 2997 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "memchr" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 3015 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "free" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+  :
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3036 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:3047: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  :
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+  cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:3071: checking for mode_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3076 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_mode_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+  cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+
+fi
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:3104: checking for pid_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3109 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_pid_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+  cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:3137: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3142 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_size_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+  cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+echo "configure:3170: checking for uid_t in sys/types.h" >&5
+if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3175 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "uid_t" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_uid_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+  cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+
+  cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+#	If a system doesn't have an opendir function (man, that's old!)
+#	then we have to supply a different version of dirent.h which
+#	is compatible with the substitute version of opendir that's
+#	provided.  This version only works with V7-style directories.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for opendir""... $ac_c" 1>&6
+echo "configure:3212: checking for opendir" >&5
+if eval "test \"`echo '$''{'ac_cv_func_opendir'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3217 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char opendir(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char opendir();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_opendir) || defined (__stub___opendir)
+choke me
+#else
+opendir();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3240: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_opendir=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_opendir=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'opendir`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define USE_DIRENT2_H 1
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+#	The check below checks whether <sys/wait.h> defines the type
+#	"union wait" correctly.  It's needed because of weirdness in
+#	HP-UX where "union wait" is defined in both the BSD and SYS-V
+#	environments.  Checking the usability of WIFEXITED seems to do
+#	the trick.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking union wait""... $ac_c" 1>&6
+echo "configure:3273: checking union wait" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3275 "configure"
+#include "confdefs.h"
+#include <sys/types.h> 
+#include <sys/wait.h>
+int main() {
+
+union wait x;
+WIFEXITED(x);		/* Generates compiler error if WIFEXITED
+			 * uses an int. */
+
+; return 0; }
+EOF
+if { (eval echo configure:3287: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  tcl_ok=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=no
+fi
+rm -f conftest*
+echo "$ac_t""$tcl_ok" 1>&6
+if test $tcl_ok = no; then
+    cat >> confdefs.h <<\EOF
+#define NO_UNION_WAIT 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+#	Check to see whether the system supports the matherr function
+#	and its associated type "struct exception".
+#--------------------------------------------------------------------
+
+echo $ac_n "checking matherr support""... $ac_c" 1>&6
+echo "configure:3311: checking matherr support" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3313 "configure"
+#include "confdefs.h"
+#include <math.h>
+int main() {
+
+struct exception x;
+x.type = DOMAIN;
+x.type = SING;
+
+; return 0; }
+EOF
+if { (eval echo configure:3324: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tcl_ok=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=no
+fi
+rm -f conftest*
+echo "$ac_t""$tcl_ok" 1>&6
+if test $tcl_ok = yes; then
+    cat >> confdefs.h <<\EOF
+#define NEED_MATHERR 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+#	Check to see whether the system provides a vfork kernel call.
+#	If not, then use fork instead.  Also, check for a problem with
+#	vforks and signals that can cause core dumps if a vforked child
+#	resets a signal handler.  If the problem exists, then use fork
+#	instead of vfork.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
+echo "configure:3351: checking return type of signal handlers" >&5
+if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3356 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#ifdef signal
+#undef signal
+#endif
+#ifdef __cplusplus
+extern "C" void (*signal (int, void (*)(int)))(int);
+#else
+void (*signal ()) ();
+#endif
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:3373: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_type_signal=void
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_type_signal=int
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_type_signal" 1>&6
+cat >> confdefs.h <<EOF
+#define RETSIGTYPE $ac_cv_type_signal
+EOF
+
+
+echo $ac_n "checking for vfork""... $ac_c" 1>&6
+echo "configure:3392: checking for vfork" >&5
+if eval "test \"`echo '$''{'ac_cv_func_vfork'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3397 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char vfork(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char vfork();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_vfork) || defined (__stub___vfork)
+choke me
+#else
+vfork();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3420: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_vfork=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_vfork=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'vfork`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$tcl_ok" = 1; then
+    echo $ac_n "checking vfork/signal bug""... $ac_c" 1>&6
+echo "configure:3442: checking vfork/signal bug" >&5;
+    if test "$cross_compiling" = yes; then
+  tcl_ok=0
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3447 "configure"
+#include "confdefs.h"
+
+#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);
+}
+EOF
+if { (eval echo configure:3475: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  tcl_ok=1
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  tcl_ok=0
+fi
+rm -fr conftest*
+fi
+
+    if test "$tcl_ok" = 1; then
+	echo "$ac_t""ok" 1>&6
+    else
+	echo "$ac_t""buggy, using fork instead" 1>&6
+    fi
+fi
+rm -f core
+if test "$tcl_ok" = 0; then
+    cat >> confdefs.h <<\EOF
+#define vfork fork
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+#	Check whether there is an strncasecmp function on this system.
+#	This is a bit tricky because under SCO it's in -lsocket and
+#	under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strncasecmp""... $ac_c" 1>&6
+echo "configure:3508: checking for strncasecmp" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strncasecmp'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3513 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char strncasecmp(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strncasecmp();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_strncasecmp) || defined (__stub___strncasecmp)
+choke me
+#else
+strncasecmp();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3536: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_strncasecmp=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_strncasecmp=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strncasecmp`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$tcl_ok" = 0; then
+    echo $ac_n "checking for strncasecmp in -lsocket""... $ac_c" 1>&6
+echo "configure:3558: checking for strncasecmp in -lsocket" >&5
+ac_lib_var=`echo socket'_'strncasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lsocket  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3566 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strncasecmp();
+
+int main() {
+strncasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:3577: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+    echo $ac_n "checking for strncasecmp in -linet""... $ac_c" 1>&6
+echo "configure:3601: checking for strncasecmp in -linet" >&5
+ac_lib_var=`echo inet'_'strncasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-linet  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3609 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char strncasecmp();
+
+int main() {
+strncasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:3620: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=1
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+    LIBOBJS="$LIBOBJS strncasecmp.o"
+fi
+
+#--------------------------------------------------------------------
+#	The code below deals with several issues related to gettimeofday:
+#	1. Some systems don't provide a gettimeofday function at all
+#	   (set NO_GETTOD if this is the case).
+#	2. SGI systems don't use the BSD form of the gettimeofday function,
+#	   but they have a BSDgettimeofday function that can be used instead.
+#	3. See if gettimeofday is declared in the <sys/time.h> header file.
+#	   if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
+#	   declare it.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6
+echo "configure:3658: checking for BSDgettimeofday" >&5
+if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3663 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char BSDgettimeofday(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char BSDgettimeofday();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_BSDgettimeofday) || defined (__stub___BSDgettimeofday)
+choke me
+#else
+BSDgettimeofday();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3686: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_BSDgettimeofday=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_BSDgettimeofday=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'BSDgettimeofday`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define HAVE_BSDGETTIMEOFDAY 1
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6
+echo "configure:3707: checking for gettimeofday" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3712 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char gettimeofday(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char gettimeofday();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_gettimeofday) || defined (__stub___gettimeofday)
+choke me
+#else
+gettimeofday();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3735: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_gettimeofday=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_gettimeofday=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gettimeofday`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_GETTOD 1
+EOF
+
+fi
+
+fi
+
+echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6
+echo "configure:3761: checking for gettimeofday declaration" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3763 "configure"
+#include "confdefs.h"
+#include <sys/time.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "gettimeofday" >/dev/null 2>&1; then
+  rm -rf conftest*
+  echo "$ac_t""present" 1>&6
+else
+  rm -rf conftest*
+  
+    echo "$ac_t""missing" 1>&6
+    cat >> confdefs.h <<\EOF
+#define GETTOD_NOT_DECLARED 1
+EOF
+
+
+fi
+rm -f conftest*
+
+
+#--------------------------------------------------------------------
+#	Interactive UNIX requires -linet instead of -lsocket, plus it
+#	needs net/errno.h to define the socket-related error codes.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for main in -linet""... $ac_c" 1>&6
+echo "configure:3790: checking for main in -linet" >&5
+ac_lib_var=`echo inet'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-linet  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3798 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:3805: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  LIBS="$LIBS -linet"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+ac_safe=`echo "net/errno.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for net/errno.h""... $ac_c" 1>&6
+echo "configure:3827: checking for net/errno.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3832 "configure"
+#include "confdefs.h"
+#include <net/errno.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:3837: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define HAVE_NET_ERRNO_H 1
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+#--------------------------------------------------------------------
+#	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.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
+echo "configure:3869: checking whether char is unsigned" >&5
+if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test "$GCC" = yes; then
+  # GCC predefines this symbol on systems where it applies.
+cat > conftest.$ac_ext <<EOF
+#line 3876 "configure"
+#include "confdefs.h"
+#ifdef __CHAR_UNSIGNED__
+  yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_c_char_unsigned=yes
+else
+  rm -rf conftest*
+  ac_cv_c_char_unsigned=no
+fi
+rm -f conftest*
+
+else
+if test "$cross_compiling" = yes; then
+    { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3898 "configure"
+#include "confdefs.h"
+/* volatile prevents gcc2 from optimizing the test away on sparcs.  */
+#if !defined(__STDC__) || __STDC__ != 1
+#define volatile
+#endif
+main() {
+  volatile char c = 255; exit(c < 0);
+}
+EOF
+if { (eval echo configure:3908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+  ac_cv_c_char_unsigned=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  ac_cv_c_char_unsigned=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_char_unsigned" 1>&6
+if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then
+  cat >> confdefs.h <<\EOF
+#define __CHAR_UNSIGNED__ 1
+EOF
+
+fi
+
+echo $ac_n "checking signed char declarations""... $ac_c" 1>&6
+echo "configure:3932: checking signed char declarations" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3934 "configure"
+#include "confdefs.h"
+
+int main() {
+
+signed char *p;
+p = 0;
+
+; return 0; }
+EOF
+if { (eval echo configure:3944: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tcl_ok=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=no
+fi
+rm -f conftest*
+echo "$ac_t""$tcl_ok" 1>&6
+if test $tcl_ok = yes; then
+    cat >> confdefs.h <<\EOF
+#define HAVE_SIGNED_CHAR 1
+EOF
+
+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
+#	special considerations:
+#	1. Use "connect" and "accept" to check for -lsocket, and
+#	   "gethostbyname" to check for -lnsl.
+#	2. Use each function name only once:  can't redo a check because
+#	   autoconf caches the results of the last check and won't redo it.
+#	3. Use -lnsl and -lsocket only if they supply procedures that
+#	   aren't already present in the normal libraries.  This is because
+#	   IRIX 5.2 has libraries, but they aren't needed and they're
+#	   bogus:  they goof up name resolution if used.
+#	4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+#	   To get around this problem, check for both libraries together
+#	   if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+# mess up the cache values of the functions we check for.
+echo $ac_n "checking for socket libraries""... $ac_c" 1>&6
+echo "configure:3983: checking for socket libraries" >&5
+if eval "test \"`echo '$''{'tcl_cv_lib_sockets'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  tcl_cv_lib_sockets=
+  tcl_checkBoth=0
+  unset ac_cv_func_connect
+  echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:3991: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3996 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char connect(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:4019: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_connect=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_checkSocket=0
+else
+  echo "$ac_t""no" 1>&6
+tcl_checkSocket=1
+fi
+
+  if test "$tcl_checkSocket" = 1; then
+      unset ac_cv_func_connect
+      echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:4042: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lsocket  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4050 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4057: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_cv_lib_sockets="-lsocket"
+else
+  echo "$ac_t""no" 1>&6
+tcl_checkBoth=1
+fi
+
+  fi
+  if test "$tcl_checkBoth" = 1; then
+      tcl_oldLibs=$LIBS
+      LIBS="$LIBS -lsocket -lnsl"
+      unset ac_cv_func_accept
+      echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:4084: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 4089 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char accept(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:4112: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_accept=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_checkNsl=0
+		     tcl_cv_lib_sockets="-lsocket -lnsl"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+      unset ac_cv_func_accept
+      LIBS=$tcl_oldLibs
+  fi
+  unset ac_cv_func_gethostbyname
+  tcl_oldLibs=$LIBS
+  LIBS="$LIBS $tcl_cv_lib_sockets"
+  echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:4139: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 4144 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char gethostbyname(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:4167: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_gethostbyname=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:4185: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lnsl  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4193 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4200: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+  unset ac_cv_func_gethostbyname
+  LIBS=$tcl_oldLIBS
+
+fi
+
+echo "$ac_t""$tcl_cv_lib_sockets" 1>&6
+test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+#--------------------------------------------------------------------
+#	The statements below define a collection of symbols related to
+#	dynamic loading and shared libraries:
+#
+#	DL_OBJS -	Name of the object file that implements dynamic
+#			loading for Tcl on this system.
+#	DL_LIBS -	Library file(s) to include in tclsh and other base
+#			applications in order for the "load" command to work.
+#	LD_FLAGS -	Flags to pass to the compiler when linking object
+#			files into an executable application binary such
+#			as tclsh.
+#	LD_SEARCH_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.  Depends on
+#			the variable LIB_RUNTIME_DIR in the Makefile.
+#	MAKE_LIB -	Command to execute to build the Tcl library;
+#			differs depending on whether or not Tcl is being
+#			compiled as a shared library.
+#	SHLIB_CFLAGS -	Flags to pass to cc when compiling the components
+#			of a shared library (may request position-independent
+#			code, among other things).
+#	SHLIB_LD -	Base command to use for combining object files
+#			into a shared library.
+#	SHLIB_LD_LIBS -	Dependent libraries for the linker to scan when
+#			creating shared libraries.  This symbol typically
+#			goes at the end of the "ld" commands that build
+#			shared libraries. The value of the symbol is
+#			"${LIBS}" if all of the dependent libraries should
+#			be specified when creating a shared library.  If
+#			dependent libraries should not be specified (as on
+#			SunOS 4.x, where they cause the link to fail, or in
+#			general if Tcl and Tk aren't themselves shared
+#			libraries), then this symbol has an empty string
+#			as its value.
+#	SHLIB_SUFFIX -	Suffix to use for the names of dynamically loadable
+#			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.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
+#			by platforms that need non-standard library names.
+#			Examples:  ${VERSION}.so.1.1 on NetBSD, since it needs
+#			to have a version after the .so, and ${VERSION}.a
+#			on AIX, since the Tcl shared library needs to have
+#			a .a extension whereas shared objects for loadable
+#			extensions have a .so extension.  Defaults to
+#			${VERSION}${SHLIB_SUFFIX}.
+#--------------------------------------------------------------------
+
+# Step 1: set the variable "system" to hold the name and version number
+# for the system.  This can usually be done via the "uname" command, but
+# there are a few systems, like Next, where this doesn't work.
+
+echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6
+echo "configure:4286: checking system version (for dynamic loading)" >&5
+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
+	echo "$ac_t""unknown (can't find uname command)" 1>&6
+	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
+	echo "$ac_t""$system" 1>&6
+    fi
+fi
+
+# Step 2: check for existence of -ldl library.  This is needed because
+# Linux can use either -ldl or -ldld for dynamic loading.
+
+echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
+echo "configure:4312: checking for dlopen in -ldl" >&5
+ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-ldl  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4320 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char dlopen();
+
+int main() {
+dlopen()
+; return 0; }
+EOF
+if { (eval echo configure:4331: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  have_dl=yes
+else
+  echo "$ac_t""no" 1>&6
+have_dl=no
+fi
+
+
+# Step 3: set configuration options based on system name and version.
+
+fullSrcDir=`cd $srcdir; pwd`
+TCL_SHARED_LIB_SUFFIX=""
+TCL_UNSHARED_LIB_SUFFIX=""
+TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
+ECHO_VERSION='`echo ${VERSION}`'
+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 -bnoentry"
+	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 -bnoentry"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o tclLoadAix.o"
+	DL_LIBS="-lld"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	;;
+    BSD/OS-2.1*|BSD/OS-3*)
+	SHLIB_CFLAGS=""
+	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"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+        # CYGNUS LOCAL: Handle gcc and versions of HP-UX that can't
+        # do dynamic linking.
+        echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
+echo "configure:4409: checking for shl_load in -ldld" >&5
+ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-ldld  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4417 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char shl_load();
+
+int main() {
+shl_load()
+; return 0; }
+EOF
+if { (eval echo configure:4428: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  tcl_ok=yes
+else
+  echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+        if test "$tcl_ok" = "yes"; then
+	   if test "$GCC" = yes; then
+	      SHLIB_CFLAGS="-fPIC"
+	      SHLIB_LD="$CC -shared -fPIC"
+	   else
+	      SHLIB_CFLAGS="+z"
+	      SHLIB_LD="ld -b"
+	   fi
+
+	   SHLIB_LD_LIBS=""
+	   SHLIB_SUFFIX=".sl"
+	   DL_OBJS="tclLoadShl.o"
+	   DL_LIBS="-ldld"
+
+	   # The GNU linker requires the -export-dynamic
+	   # option to make all symbols visible in the dynamic symbol
+	   # table.  Note that the HP linker will give errors
+	   # -export-dynamic, but will still exit successfully.
+	   # Adding a -L option will make it fail.
+	   hold_ldflags=$LDFLAGS
+	   echo $ac_n "checking for the ld -export-dynamic flag""... $ac_c" 1>&6
+echo "configure:4470: checking for the ld -export-dynamic flag" >&5
+	   LDFLAGS="${LDFLAGS} -Wl,-export-dynamic -L`pwd`"
+	   cat > conftest.$ac_ext <<EOF
+#line 4473 "configure"
+#include "confdefs.h"
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:4480: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  found=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  found=no
+fi
+rm -f conftest*
+	   LDFLAGS=$hold_ldflags
+	   echo "$ac_t""$found" 1>&6
+	   if test $found = yes; then
+	      LD_FLAGS="-Wl,-export-dynamic"
+	      LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	   else
+	      LD_FLAGS="-Wl,-E"
+	      LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+	   fi
+	fi
+	# END CYGNUS LOCAL
+	;;
+    IRIX-4.*)
+	SHLIB_CFLAGS="-G 0"
+	SHLIB_SUFFIX=".a"
+	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+	SHLIB_LD_LIBS='${LIBS}'
+	DL_OBJS="tclLoadAout.o"
+	DL_LIBS=""
+	LD_FLAGS="-Wl,-D,08000000"
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	;;
+    IRIX-5.*|IRIX-6.*)
+	SHLIB_CFLAGS=""
+	SHLIB_LD="ld -shared -rdata_shared"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	;;
+    IRIX64-6.*)
+	SHLIB_CFLAGS=""
+	SHLIB_LD="ld -n32 -shared -rdata_shared -rpath /usr/local/lib"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	;;
+    Linux*)
+	SHLIB_CFLAGS="-fPIC"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	if test "$have_dl" = yes; then
+	    SHLIB_LD="${CC} -shared"
+	    DL_OBJS="tclLoadDl.o"
+	    DL_LIBS="-ldl"
+	    LD_FLAGS="-rdynamic"
+	    LD_SEARCH_FLAGS=""
+	else
+	    ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dld.h""... $ac_c" 1>&6
+echo "configure:4546: checking for dld.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 4551 "configure"
+#include "confdefs.h"
+#include <dld.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4556: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  
+		SHLIB_LD="ld -shared"
+		DL_OBJS="tclLoadDld.o"
+		DL_LIBS="-ldld"
+		LD_FLAGS=""
+		LD_SEARCH_FLAGS=""
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+	fi
+	;;
+    MP-RAS-02*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    MP-RAS-*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS="-Wl,-Bexport"
+	LD_SEARCH_FLAGS=""
+	;;
+    NetBSD-*|FreeBSD-*|OpenBSD-*)
+	# Not available on all versions:  check for include file.
+	ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
+echo "configure:4608: checking for dlfcn.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 4613 "configure"
+#include "confdefs.h"
+#include <dlfcn.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4618: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  
+	    SHLIB_CFLAGS="-fpic"
+	    SHLIB_LD="ld -Bshareable -x"
+	    SHLIB_LD_LIBS=""
+	    SHLIB_SUFFIX=".so"
+	    DL_OBJS="tclLoadDl.o"
+	    DL_LIBS=""
+	    LD_FLAGS=""
+	    LD_SEARCH_FLAGS=""
+	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
+	
+else
+  echo "$ac_t""no" 1>&6
+
+	    SHLIB_CFLAGS=""
+	    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='-L${LIB_RUNTIME_DIR}'
+	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+	
+fi
+
+
+	# FreeBSD doesn't handle version numbers with dots.
+
+	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+	TCL_LIB_VERSIONS_OK=nodots
+	;;
+    NEXTSTEP-*)
+	SHLIB_CFLAGS=""
+	SHLIB_LD="cc -nostdlib -r"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadNext.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    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
+	SHLIB_LD='ld -R -export $@:'
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadOSF.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    OSF1-1.*)
+	# OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+	SHLIB_CFLAGS="-fpic"
+	SHLIB_LD="ld -shared"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    OSF1-V*)
+        # Digital OSF/1
+	SHLIB_CFLAGS=""
+	SHLIB_LD='ld -shared -expect_unresolved "*"'
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	;;
+    RISCos-*)
+	SHLIB_CFLAGS="-G 0"
+	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".a"
+	DL_OBJS="tclLoadAout.o"
+	DL_LIBS=""
+	LD_FLAGS="-Wl,-D,08000000"
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	;;
+    SCO_SV-3.2*)
+        # Note, dlopen is available only on SCO 3.2.5 and greater.  However,
+        # this test works, since "uname -s" was non-standard in 3.2.4 and
+        # below.
+	SHLIB_CFLAGS="-Kpic -belf"
+	SHLIB_LD="ld -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS="-belf -Wl,-Bexport"
+	LD_SEARCH_FLAGS=""
+	;;
+     SINIX*5.4*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    SunOS-4*)
+        # CYGNUS LOCAL: gcc uses a different option than native cc.
+        if test "$GCC" = yes; then
+	   SHLIB_CFLAGS="-fPIC"
+	   SHLIB_LD="$CC -shared -fPIC"
+	else
+	   SHLIB_CFLAGS="-PIC"
+	   SHLIB_LD="ld"
+	fi
+	# END CYGNUS LOCAL
+
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+
+	# SunOS can't handle version numbers with dots in them in library
+	# specs, like -ltcl7.5, so use -ltcl75 instead.  Also, it
+	# requires an extra version number at the end of .so file names.
+	# So, the library has to have a name like libtcl75.so.1.0
+
+	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
+	;;
+    SunOS-5*)
+        # CYGNUS LOCAL: gcc uses a different option than native cc.
+        if test "$GCC" = yes; then
+	   SHLIB_CFLAGS="-fPIC"
+	   SHLIB_LD="$CC -shared -fPIC"
+	else
+	   SHLIB_CFLAGS="-KPIC"
+	   SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+	fi
+	# END CYGNUS LOCAL
+
+	# 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"
+	DL_LIBS="-ldl"
+	# CYGNUS LOCAL: The GNU linker requires the -export-dynamic
+	# option to make all symbols visible in the dynamic symbol
+	# table.
+	hold_ldflags=$LDFLAGS
+	echo $ac_n "checking for the ld -export-dynamic flag""... $ac_c" 1>&6
+echo "configure:4793: checking for the ld -export-dynamic flag" >&5
+	LDFLAGS="${LDFLAGS} -Wl,-export-dynamic"
+	cat > conftest.$ac_ext <<EOF
+#line 4796 "configure"
+#include "confdefs.h"
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:4803: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  found=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  found=no
+fi
+rm -f conftest*
+	LDFLAGS=$hold_ldflags
+	echo "$ac_t""$found" 1>&6
+	if test $found = yes; then
+	   LD_FLAGS="-Wl,-export-dynamic"
+	   LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	else
+	   LD_FLAGS=""
+	   LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+	fi
+	# END CYGNUS LOCAL
+	;;
+    ULTRIX-4.*)
+	SHLIB_CFLAGS="-G 0"
+	SHLIB_SUFFIX=".a"
+	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+	SHLIB_LD_LIBS='${LIBS}'
+	DL_OBJS="tclLoadAout.o"
+	DL_LIBS=""
+	# CYGNUS LOCAL: The GNU linker doesn't accept `-D 08000000'.  It
+	# doesn't appear to be needed, either.
+	hold_ldflags="$LDFLAGS"
+	echo $ac_n "checking whether ld accepts -D 08000000""... $ac_c" 1>&6
+echo "configure:4835: checking whether ld accepts -D 08000000" >&5
+	LD_FLAGS="-Wl,-D,08000000"
+	LDFLAGS="${LDFLAGS} -Wl,-D,08000000"
+	cat > conftest.$ac_ext <<EOF
+#line 4839 "configure"
+#include "confdefs.h"
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:4846: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  found=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  found=no
+fi
+rm -f conftest*
+	LDFLAGS=$hold_ldflags
+	echo "$ac_t""$found" 1>&6
+	if test $found = yes; then
+	   LD_FLAGS="-Wl,-D,08000000"
+	else
+	   LD_FLAGS=""
+	fi
+	# END CYGNUS LOCAL
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	;;
+    UNIX_SV* | UnixWare-5*)
+	SHLIB_CFLAGS="-KPIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	# 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
+	echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6
+echo "configure:4877: checking for ld accepts -Bexport flag" >&5
+	LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+	cat > conftest.$ac_ext <<EOF
+#line 4880 "configure"
+#include "confdefs.h"
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:4887: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  found=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  found=no
+fi
+rm -f conftest*
+	LDFLAGS=$hold_ldflags
+	echo "$ac_t""$found" 1>&6
+	if test $found = yes; then
+	  LD_FLAGS="-Wl,-Bexport"
+	else
+	  LD_FLAGS=""
+	fi
+	LD_SEARCH_FLAGS=""
+	;;
+esac
+
+# 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
+#	- The `struct exec' must contain a_magic, a_text, a_data, a_bss
+#	  and a_entry fields.
+# The following compilation should succeed if and only if either sys/exec.h
+# or a.out.h is usable for the purpose.
+#
+# Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+# `struct exec' includes a second header that contains information that
+# duplicates the v7 fields that are needed.
+
+if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+    echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6
+echo "configure:4929: checking sys/exec.h" >&5
+    cat > conftest.$ac_ext <<EOF
+#line 4931 "configure"
+#include "confdefs.h"
+#include <sys/exec.h>
+int main() {
+
+	struct exec foo;
+	unsigned long seek;
+	int flag;
+#if defined(__mips) || defined(mips)
+	seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+	seek = N_TXTOFF (foo);
+#endif
+	flag = (foo.a_magic == OMAGIC);
+	return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+
+; return 0; }
+EOF
+if { (eval echo configure:4949: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tcl_ok=usable
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=unusable
+fi
+rm -f conftest*
+    echo "$ac_t""$tcl_ok" 1>&6
+    if test $tcl_ok = usable; then
+	cat >> confdefs.h <<\EOF
+#define USE_SYS_EXEC_H 1
+EOF
+
+    else
+	echo $ac_n "checking a.out.h""... $ac_c" 1>&6
+echo "configure:4967: checking a.out.h" >&5
+	cat > conftest.$ac_ext <<EOF
+#line 4969 "configure"
+#include "confdefs.h"
+#include <a.out.h>
+int main() {
+
+	    struct exec foo;
+	    unsigned long seek;
+	    int flag;
+#if defined(__mips) || defined(mips)
+	    seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+	    seek = N_TXTOFF (foo);
+#endif
+	    flag = (foo.a_magic == OMAGIC);
+	    return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+	
+; return 0; }
+EOF
+if { (eval echo configure:4987: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tcl_ok=usable
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=unusable
+fi
+rm -f conftest*
+	echo "$ac_t""$tcl_ok" 1>&6
+	if test $tcl_ok = usable; then
+	    cat >> confdefs.h <<\EOF
+#define USE_A_OUT_H 1
+EOF
+
+	else
+	    echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6
+echo "configure:5005: checking sys/exec_aout.h" >&5
+	    cat > conftest.$ac_ext <<EOF
+#line 5007 "configure"
+#include "confdefs.h"
+#include <sys/exec_aout.h>
+int main() {
+
+		struct exec foo;
+		unsigned long seek;
+		int flag;
+#if defined(__mips) || defined(mips)
+		seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+		seek = N_TXTOFF (foo);
+#endif
+		flag = (foo.a_midmag == OMAGIC);
+		return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+	    
+; return 0; }
+EOF
+if { (eval echo configure:5025: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  tcl_ok=usable
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  tcl_ok=unusable
+fi
+rm -f conftest*
+	    echo "$ac_t""$tcl_ok" 1>&6
+	    if test $tcl_ok = usable; then
+		cat >> confdefs.h <<\EOF
+#define USE_SYS_EXEC_AOUT_H 1
+EOF
+
+	    else
+		DL_OBJS=""
+	    fi
+	fi
+    fi
+fi
+
+# Step 5: disable dynamic loading if requested via a command-line switch.
+
+# Check whether --enable-load or --disable-load was given.
+if test "${enable_load+set}" = set; then
+  enableval="$enable_load"
+  tcl_ok=$enableval
+else
+  tcl_ok=yes
+fi
+
+if test "$tcl_ok" = "no"; then
+    DL_OBJS=""
+fi
+
+if test "x$DL_OBJS" != "x" ; then
+    BUILD_DLTEST="\$(DLTEST_TARGETS)"
+else
+    echo "Can't figure out how to do dynamic loading or shared libraries"
+    echo "on this system."
+    SHLIB_CFLAGS=""
+    SHLIB_LD=""
+    SHLIB_SUFFIX=""
+    DL_OBJS="tclLoadNone.o"
+    DL_LIBS=""
+    LD_FLAGS=""
+    LD_SEARCH_FLAGS=""
+    BUILD_DLTEST=""
+fi
+
+# If we're running gcc, then change the C flags for compiling shared
+# libraries to the right flags for gcc, instead of those for the
+# standard manufacturer compiler.
+
+if test "$DL_OBJS" != "tclLoadNone.o" ; then
+    if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+	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.
+#--------------------------------------------------------------------
+
+for ac_hdr in sys/ioctl.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:5114: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 5119 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:5124: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_hdr in sys/filio.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:5154: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 5159 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:5164: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6
+echo "configure:5191: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
+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*)
+	cat >> confdefs.h <<\EOF
+#define USE_FIONBIO 1
+EOF
+
+	echo "$ac_t""FIONBIO" 1>&6
+	;;
+    SunOS-4*)
+	cat >> confdefs.h <<\EOF
+#define USE_FIONBIO 1
+EOF
+
+	echo "$ac_t""FIONBIO" 1>&6
+	;;
+    ULTRIX-4.*)
+	cat >> confdefs.h <<\EOF
+#define USE_FIONBIO 1
+EOF
+
+	echo "$ac_t""FIONBIO" 1>&6
+	;;
+    *)
+	echo "$ac_t""O_NONBLOCK" 1>&6
+	;;
+esac
+
+#--------------------------------------------------------------------
+#	The statements below define a collection of symbols related to
+#	building libtcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+realRanlib=$RANLIB
+if test "$TCL_SHARED_LIB_SUFFIX" = "" ; then
+    TCL_SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
+fi
+if test "$TCL_UNSHARED_LIB_SUFFIX" = "" ; then
+    TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'
+fi
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+  enableval="$enable_shared"
+  tcl_ok=$enableval
+else
+  tcl_ok=no
+fi
+
+# CYGNUS LOCAL: need extra variables for this information.
+TCL_SHARED_LIB_FILE=dummy1
+TCL_UNSHARED_LIB_FILE=dummy2
+# END CYGNUS LOCAL
+if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" ; then
+    TCL_SHARED_BUILD=1
+    TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+    TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+    eval "TCL_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}"
+    TCL_SHARED_LIB_FILE="$TCL_LIB_FILE"
+    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
+    TCL_SHARED_BUILD=0
+    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}"
+    TCL_UNSHARED_LIB_FILE="$TCL_LIB_FILE"
+    MAKE_LIB="$AR cr ${TCL_LIB_FILE} \${OBJS}"
+fi
+
+# Note:  in the following variable, it's important to use the absolute
+# path name of the Tcl directory rather than "..":  this is because
+# AIX remembers this path and will attempt to use it at run-time to look
+# up the Tcl library.
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}"
+    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}"
+else
+    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
+    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+fi
+
+TCL_LIB_FULL_PATH="`pwd`/${TCL_LIB_FILE}"
+
+#--------------------------------------------------------------------
+#	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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# CYGNUS LOCAL
+
+
+# END CYGNUS LOCAL
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  case `(ac_space=' '; set | grep ac_space) 2>&1` in
+  *ac_space=\ *)
+    # `set' does not quote correctly, so add quotes (double-quote substitution
+    # turns \\\\ into \\, and sed turns \\ into \).
+    sed -n \
+      -e "s/'/'\\\\''/g" \
+      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+    ;;
+  *)
+    # `set' quotes correctly as required by POSIX, so do not add quotes.
+    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+    ;;
+  esac >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ 	`~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.13"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile tclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@CPP@%$CPP%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@BUILD_DLTEST@%$BUILD_DLTEST%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@DL_OBJS@%$DL_OBJS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
+s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
+s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
+s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
+s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
+s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
+s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
+s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_SHARED_LIB_FILE@%$TCL_SHARED_LIB_FILE%g
+s%@TCL_UNSHARED_LIB_FILE@%$TCL_UNSHARED_LIB_FILE%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+  if test $ac_beg -gt 1; then
+    sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+  else
+    sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+  fi
+  if test ! -s conftest.s$ac_file; then
+    ac_more_lines=false
+    rm -f conftest.s$ac_file
+  else
+    if test -z "$ac_sed_cmds"; then
+      ac_sed_cmds="sed -f conftest.s$ac_file"
+    else
+      ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+    fi
+    ac_file=`expr $ac_file + 1`
+    ac_beg=$ac_end
+    ac_end=`expr $ac_end + $ac_max_sed_cmds`
+  fi
+done
+if test -z "$ac_sed_cmds"; then
+  ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile tclConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+  case "$ac_given_INSTALL" in
+  [/$]*) INSTALL="$ac_given_INSTALL" ;;
+  *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+  esac
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tcl/unix/configure.in b/tcl/unix/configure.in
new file mode 100755
index 00000000000..a00c889d270
--- /dev/null
+++ b/tcl/unix/configure.in
@@ -0,0 +1,1388 @@
+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.
+
+# CYGNUS LOCAL, need 2.5 or higher for --bindir et al
+AC_PREREQ(2.5)
+# END CYGNUS LOCAL
+
+AC_INIT(../generic/tcl.h)
+# SCCS: @(#) configure.in 1.18 98/08/12 17:29:39
+
+TCL_VERSION=8.0
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL=".3"
+VERSION=${TCL_VERSION}
+
+if test "${prefix}" = "NONE"; then
+    prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+    exec_prefix=$prefix
+fi
+TCL_SRC_DIR=`cd $srcdir/..; pwd`
+
+AC_PROG_RANLIB
+dnl CYGNUS LOCAL: allow gcc without a special flag
+dnl AC_ARG_ENABLE(gcc, [  --enable-gcc            allow use of gcc if available],
+dnl    [tcl_ok=$enableval], [tcl_ok=no])
+dnl if test "$tcl_ok" = "yes"; then
+    AC_PROG_CC
+dnl else
+dnl    CC=${CC-cc}
+dnl AC_SUBST(CC)
+dnl fi
+dnl END CYGNUS LOCAL
+
+# CYGNUS LOCAL
+# dje/win32
+AR=${AR-ar}
+# We need this for substitutions in Makefile.in.
+AC_PROG_INSTALL
+# END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# CYGNUS LOCAL:
+# This is for LynxOS, which needs a flag to force true POSIX when
+# building. It's weirder than that, cause the flag varies depending
+# how old the compiler is. So...
+# -X is for the old "cc" and "gcc" (based on 1.42)
+# -mposix is for the new gcc (at least 2.5.8)
+# This modifies the value of $CC to have the POSIX flag added
+# so everything will configure correctly.
+#--------------------------------------------------------------------
+CY_AC_TCL_LYNX_POSIX
+
+# set the warning flags depending on whether or not we are using gcc
+if test "${GCC}" = "yes" ; then
+    CFLAGS_WARNING="-Wall -Wconversion"
+else
+    CFLAGS_WARNING=""
+fi
+
+#--------------------------------------------------------------------
+#	Supply substitutes for missing POSIX library procedures, or
+#	set flags so Tcl uses alternate procedures.
+#--------------------------------------------------------------------
+
+# Check if Posix compliant getcwd exists, if not we'll use getwd.
+AC_CHECK_FUNCS(getcwd, , AC_DEFINE(USEGETWD))
+# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
+# define USEGETWD even if the posix getcwd exists. Add a test ?
+
+AC_REPLACE_FUNCS(opendir strstr)
+
+AC_REPLACE_FUNCS(strtol tmpnam waitpid)
+AC_CHECK_FUNC(strerror, , AC_DEFINE(NO_STRERROR))
+AC_CHECK_FUNC(getwd, , AC_DEFINE(NO_GETWD))
+AC_CHECK_FUNC(wait3, , AC_DEFINE(NO_WAIT3))
+AC_CHECK_FUNC(uname, , AC_DEFINE(NO_UNAME))
+
+#--------------------------------------------------------------------
+#	On a few very rare systems, all of the libm.a stuff is
+#	already in libc.a.  Set compiler flags accordingly.
+#	Also, Linux requires the "ieee" library for math to work
+#	right (and it must appear before "-lm").
+#--------------------------------------------------------------------
+
+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
+#	      strtod insome versions of SunOS
+#	    - some versions of string.h don't declare procedures such
+#	      as strstr
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING(dirent.h)
+AC_TRY_LINK([#include <sys/types.h>
+#include <dirent.h>], [
+#ifndef _POSIX_SOURCE
+#   ifdef __Lynx__
+	/*
+	 * Generate compilation error to make the test fail:  Lynx headers
+	 * are only valid if really in the POSIX environment.
+	 */
+
+	missing_procedure();
+#   endif
+#endif
+DIR *d;
+struct dirent *entryPtr;
+char *p;
+d = opendir("foobar");
+entryPtr = readdir(d);
+p = entryPtr->d_name;
+closedir(d);
+], tcl_ok=yes, tcl_ok=no)
+if test $tcl_ok = no; then
+    AC_DEFINE(NO_DIRENT_H)
+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)
+AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
+AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
+if test $tcl_ok = 0; then
+    AC_DEFINE(NO_STDLIB_H)
+fi
+AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
+AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
+AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)
+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.
+#	This appears to be true only on the RS/6000 under AIX.  Some
+#	systems like OSF/1 have a sys/select.h that's of no use, and
+#	other systems like SCO UNIX have a sys/select.h that's
+#	pernicious.  If "fd_set" isn't defined anywhere then set a
+#	special flag.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([fd_set and sys/select])
+AC_TRY_COMPILE([#include <sys/types.h>],
+	[fd_set readMask, writeMask;], tk_ok=yes, tk_ok=no)
+if test $tk_ok = no; then
+    AC_HEADER_EGREP(fd_mask, sys/select.h, tk_ok=yes)
+    if test $tk_ok = yes; then
+	AC_DEFINE(HAVE_SYS_SELECT_H)
+    fi
+fi
+AC_MSG_RESULT($tk_ok)
+if test $tk_ok = no; then
+    AC_DEFINE(NO_FD_SET)
+fi
+
+#------------------------------------------------------------------------------
+#       Find out all about time handling differences.
+#------------------------------------------------------------------------------
+
+AC_CHECK_HEADERS(sys/time.h)
+AC_HEADER_TIME
+AC_STRUCT_TIMEZONE
+
+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_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))
+
+#
+# Its important to include time.h in this check, as some systems (like convex)
+# have timezone functions, etc.
+#
+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);],
+        [have_timezone=yes
+	 AC_DEFINE(HAVE_TIMEZONE_VAR)
+         AC_MSG_RESULT(yes)],
+         AC_MSG_RESULT(no))
+fi
+
+#
+# On some systems (eg Solaris 2.5.1, timezone is not declared in
+# time.h unless you jump through hoops.  Instead of that, we just
+# declare it ourselves when necessary.
+#
+if test "$have_timezone" = yes; then
+   AC_MSG_CHECKING(for timezone declaration)
+   changequote(<<,>>)
+   tzrx='^[ 	]*extern.*timezone'
+   changequote([,])
+   AC_EGREP_HEADER($tzrx, time.h, [
+     AC_DEFINE(HAVE_TIMEZONE_DECL)
+     AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
+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
+
+#--------------------------------------------------------------------
+#	Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
+#	in struct stat.
+#--------------------------------------------------------------------
+AC_STRUCT_ST_BLKSIZE
+
+#--------------------------------------------------------------------
+#	On some systems strstr is broken: it returns a pointer even
+#	even if the original string is empty.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([proper strstr implementation])
+AC_TRY_RUN([
+extern int strstr();
+int main()
+{
+    exit(strstr("\0test", "test") ? 1 : 0);
+}
+], tcl_ok=yes, tcl_ok=no, tcl_ok=no)
+if test $tcl_ok = yes; then
+    AC_MSG_RESULT(yes)
+else
+    AC_MSG_RESULT([broken, using substitute])
+    LIBOBJS="$LIBOBJS strstr.o"
+fi
+
+#--------------------------------------------------------------------
+#	Check for strtoul function.  This is tricky because under some
+#	versions of AIX strtoul returns an incorrect terminator
+#	pointer for the string "0".
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtoul, tcl_ok=1, tcl_ok=0)
+AC_TRY_RUN([
+extern int strtoul();
+int main()
+{
+    char *string = "0";
+    char *term;
+    int value;
+    value = strtoul(string, &term, 0);
+    if ((value != 0) || (term != (string+1))) {
+        exit(1);
+    }
+    exit(0);
+}], , tcl_ok=0, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+    test -n "$verbose" && echo "	Adding strtoul.o."
+    LIBOBJS="$LIBOBJS strtoul.o"
+fi
+
+#--------------------------------------------------------------------
+#	Check for the strtod function.  This is tricky because in some
+#	versions of Linux strtod mis-parses strings starting with "+".
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtod, tcl_ok=1, tcl_ok=0)
+AC_TRY_RUN([
+extern double strtod();
+int main()
+{
+    char *string = " +69";
+    char *term;
+    double value;
+    value = strtod(string, &term);
+    if ((value != 69) || (term != (string+4))) {
+	exit(1);
+    }
+    exit(0);
+}], , tcl_ok=0, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+    test -n "$verbose" && echo "	Adding strtod.o."
+    LIBOBJS="$LIBOBJS strtod.o"
+fi
+
+#--------------------------------------------------------------------
+#	Under Solaris 2.4, strtod returns the wrong value for the
+#	terminating character under some conditions.  Check for this
+#	and if the problem exists use a substitute procedure
+#	"fixstrtod" that corrects the error.
+#--------------------------------------------------------------------
+
+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)
+    if test $tcl_ok = 1; then
+	AC_MSG_RESULT(ok)
+    else
+	AC_MSG_RESULT(buggy)
+	LIBOBJS="$LIBOBJS fixstrtod.o"
+	AC_DEFINE(strtod, fixstrtod)
+    fi
+fi
+
+#--------------------------------------------------------------------
+#	Check for various typedefs and provide substitutes if
+#	they don't exist.
+#--------------------------------------------------------------------
+
+AC_TYPE_MODE_T
+AC_TYPE_PID_T
+AC_TYPE_SIZE_T
+AC_TYPE_UID_T
+
+#--------------------------------------------------------------------
+#	If a system doesn't have an opendir function (man, that's old!)
+#	then we have to supply a different version of dirent.h which
+#	is compatible with the substitute version of opendir that's
+#	provided.  This version only works with V7-style directories.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(opendir, , AC_DEFINE(USE_DIRENT2_H))
+
+#--------------------------------------------------------------------
+#	The check below checks whether <sys/wait.h> defines the type
+#	"union wait" correctly.  It's needed because of weirdness in
+#	HP-UX where "union wait" is defined in both the BSD and SYS-V
+#	environments.  Checking the usability of WIFEXITED seems to do
+#	the trick.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([union wait])
+AC_TRY_LINK([#include <sys/types.h> 
+#include <sys/wait.h>], [
+union wait x;
+WIFEXITED(x);		/* Generates compiler error if WIFEXITED
+			 * uses an int. */
+], tcl_ok=yes, tcl_ok=no)
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = no; then
+    AC_DEFINE(NO_UNION_WAIT)
+fi
+
+#--------------------------------------------------------------------
+#	Check to see whether the system supports the matherr function
+#	and its associated type "struct exception".
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([matherr support])
+AC_TRY_COMPILE([#include <math.h>], [
+struct exception x;
+x.type = DOMAIN;
+x.type = SING;
+], tcl_ok=yes, tcl_ok=no)
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = yes; then
+    AC_DEFINE(NEED_MATHERR)
+fi
+
+#--------------------------------------------------------------------
+#	Check to see whether the system provides a vfork kernel call.
+#	If not, then use fork instead.  Also, check for a problem with
+#	vforks and signals that can cause core dumps if a vforked child
+#	resets a signal handler.  If the problem exists, then use fork
+#	instead of vfork.
+#--------------------------------------------------------------------
+
+AC_TYPE_SIGNAL()
+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)
+    if test "$tcl_ok" = 1; then
+	AC_MSG_RESULT(ok)
+    else
+	AC_MSG_RESULT([buggy, using fork instead])
+    fi
+fi
+rm -f core
+if test "$tcl_ok" = 0; then
+    AC_DEFINE(vfork, fork)
+fi
+
+#--------------------------------------------------------------------
+#	Check whether there is an strncasecmp function on this system.
+#	This is a bit tricky because under SCO it's in -lsocket and
+#	under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strncasecmp, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+    AC_CHECK_LIB(socket, strncasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+    AC_CHECK_LIB(inet, strncasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+    LIBOBJS="$LIBOBJS strncasecmp.o"
+fi
+
+#--------------------------------------------------------------------
+#	The code below deals with several issues related to gettimeofday:
+#	1. Some systems don't provide a gettimeofday function at all
+#	   (set NO_GETTOD if this is the case).
+#	2. SGI systems don't use the BSD form of the gettimeofday function,
+#	   but they have a BSDgettimeofday function that can be used instead.
+#	3. See if gettimeofday is declared in the <sys/time.h> header file.
+#	   if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
+#	   declare it.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(BSDgettimeofday, AC_DEFINE(HAVE_BSDGETTIMEOFDAY),
+	AC_CHECK_FUNC(gettimeofday, , AC_DEFINE(NO_GETTOD)))
+AC_MSG_CHECKING([for gettimeofday declaration])
+AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [
+    AC_MSG_RESULT(missing)
+    AC_DEFINE(GETTOD_NOT_DECLARED)
+])
+
+#--------------------------------------------------------------------
+#	Interactive UNIX requires -linet instead of -lsocket, plus it
+#	needs net/errno.h to define the socket-related error codes.
+#--------------------------------------------------------------------
+
+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
+#	special considerations:
+#	1. Use "connect" and "accept" to check for -lsocket, and
+#	   "gethostbyname" to check for -lnsl.
+#	2. Use each function name only once:  can't redo a check because
+#	   autoconf caches the results of the last check and won't redo it.
+#	3. Use -lnsl and -lsocket only if they supply procedures that
+#	   aren't already present in the normal libraries.  This is because
+#	   IRIX 5.2 has libraries, but they aren't needed and they're
+#	   bogus:  they goof up name resolution if used.
+#	4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+#	   To get around this problem, check for both libraries together
+#	   if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+# mess up the cache values of the functions we check for.
+AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
+ [tcl_cv_lib_sockets=
+  tcl_checkBoth=0
+  unset ac_cv_func_connect
+  AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+  if test "$tcl_checkSocket" = 1; then
+      unset ac_cv_func_connect
+      AC_CHECK_LIB(socket, main, tcl_cv_lib_sockets="-lsocket",
+		   tcl_checkBoth=1)
+  fi
+  if test "$tcl_checkBoth" = 1; then
+      tcl_oldLibs=$LIBS
+      LIBS="$LIBS -lsocket -lnsl"
+      unset ac_cv_func_accept
+      AC_CHECK_FUNC(accept,
+		    [tcl_checkNsl=0
+		     tcl_cv_lib_sockets="-lsocket -lnsl"])
+      unset ac_cv_func_accept
+      LIBS=$tcl_oldLibs
+  fi
+  unset ac_cv_func_gethostbyname
+  tcl_oldLibs=$LIBS
+  LIBS="$LIBS $tcl_cv_lib_sockets"
+  AC_CHECK_FUNC(gethostbyname, ,
+		[AC_CHECK_LIB(nsl, main,
+			      [tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"])])
+  unset ac_cv_func_gethostbyname
+  LIBS=$tcl_oldLIBS
+])
+test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+#--------------------------------------------------------------------
+#	The statements below define a collection of symbols related to
+#	dynamic loading and shared libraries:
+#
+#	DL_OBJS -	Name of the object file that implements dynamic
+#			loading for Tcl on this system.
+#	DL_LIBS -	Library file(s) to include in tclsh and other base
+#			applications in order for the "load" command to work.
+#	LD_FLAGS -	Flags to pass to the compiler when linking object
+#			files into an executable application binary such
+#			as tclsh.
+#	LD_SEARCH_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.  Depends on
+#			the variable LIB_RUNTIME_DIR in the Makefile.
+#	MAKE_LIB -	Command to execute to build the Tcl library;
+#			differs depending on whether or not Tcl is being
+#			compiled as a shared library.
+#	SHLIB_CFLAGS -	Flags to pass to cc when compiling the components
+#			of a shared library (may request position-independent
+#			code, among other things).
+#	SHLIB_LD -	Base command to use for combining object files
+#			into a shared library.
+#	SHLIB_LD_LIBS -	Dependent libraries for the linker to scan when
+#			creating shared libraries.  This symbol typically
+#			goes at the end of the "ld" commands that build
+#			shared libraries. The value of the symbol is
+#			"${LIBS}" if all of the dependent libraries should
+#			be specified when creating a shared library.  If
+#			dependent libraries should not be specified (as on
+#			SunOS 4.x, where they cause the link to fail, or in
+#			general if Tcl and Tk aren't themselves shared
+#			libraries), then this symbol has an empty string
+#			as its value.
+#	SHLIB_SUFFIX -	Suffix to use for the names of dynamically loadable
+#			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.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
+#			by platforms that need non-standard library names.
+#			Examples:  ${VERSION}.so.1.1 on NetBSD, since it needs
+#			to have a version after the .so, and ${VERSION}.a
+#			on AIX, since the Tcl shared library needs to have
+#			a .a extension whereas shared objects for loadable
+#			extensions have a .so extension.  Defaults to
+#			${VERSION}${SHLIB_SUFFIX}.
+#--------------------------------------------------------------------
+
+# Step 1: set the variable "system" to hold the name and version number
+# for the system.  This can usually be done via the "uname" command, but
+# there are a few systems, like Next, where this doesn't work.
+
+AC_MSG_CHECKING([system version (for dynamic loading)])
+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
+	AC_MSG_RESULT([unknown (can't find uname command)])
+	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
+	AC_MSG_RESULT($system)
+    fi
+fi
+
+# Step 2: check for existence of -ldl library.  This is needed because
+# Linux can use either -ldl or -ldld for dynamic loading.
+
+AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
+
+# Step 3: set configuration options based on system name and version.
+
+fullSrcDir=`cd $srcdir; pwd`
+TCL_SHARED_LIB_SUFFIX=""
+TCL_UNSHARED_LIB_SUFFIX=""
+TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
+ECHO_VERSION='`echo ${VERSION}`'
+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 -bnoentry"
+	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 -bnoentry"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o tclLoadAix.o"
+	DL_LIBS="-lld"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	;;
+    BSD/OS-2.1*|BSD/OS-3*)
+	SHLIB_CFLAGS=""
+	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"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+        # CYGNUS LOCAL: Handle gcc and versions of HP-UX that can't
+        # do dynamic linking.
+        AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
+        if test "$tcl_ok" = "yes"; then
+	   if test "$GCC" = yes; then
+	      SHLIB_CFLAGS="-fPIC"
+	      SHLIB_LD="$CC -shared -fPIC"
+	   else
+	      SHLIB_CFLAGS="+z"
+	      SHLIB_LD="ld -b"
+	   fi
+
+	   SHLIB_LD_LIBS=""
+	   SHLIB_SUFFIX=".sl"
+	   DL_OBJS="tclLoadShl.o"
+	   DL_LIBS="-ldld"
+
+	   # The GNU linker requires the -export-dynamic
+	   # option to make all symbols visible in the dynamic symbol
+	   # table.  Note that the HP linker will give errors
+	   # -export-dynamic, but will still exit successfully.
+	   # Adding a -L option will make it fail.
+	   hold_ldflags=$LDFLAGS
+	   AC_MSG_CHECKING(for the ld -export-dynamic flag)
+	   LDFLAGS="${LDFLAGS} -Wl,-export-dynamic -L`pwd`"
+	   AC_TRY_LINK(, [int i;], found=yes, found=no)
+	   LDFLAGS=$hold_ldflags
+	   AC_MSG_RESULT($found)
+	   if test $found = yes; then
+	      LD_FLAGS="-Wl,-export-dynamic"
+	      LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	   else
+	      LD_FLAGS="-Wl,-E"
+	      LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+	   fi
+	fi
+	# END CYGNUS LOCAL
+	;;
+    IRIX-4.*)
+	SHLIB_CFLAGS="-G 0"
+	SHLIB_SUFFIX=".a"
+	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+	SHLIB_LD_LIBS='${LIBS}'
+	DL_OBJS="tclLoadAout.o"
+	DL_LIBS=""
+	LD_FLAGS="-Wl,-D,08000000"
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	;;
+    IRIX-5.*|IRIX-6.*)
+	SHLIB_CFLAGS=""
+	SHLIB_LD="ld -n32 -shared -rdata_shared"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	;;
+    IRIX64-6.*)
+	SHLIB_CFLAGS=""
+	SHLIB_LD="ld -n32 -shared -rdata_shared -rpath /usr/local/lib"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	;;
+    Linux*)
+	SHLIB_CFLAGS="-fPIC"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	if test "$have_dl" = yes; then
+	    SHLIB_LD="${CC} -shared"
+	    DL_OBJS="tclLoadDl.o"
+	    DL_LIBS="-ldl"
+	    LD_FLAGS="-rdynamic"
+	    LD_SEARCH_FLAGS=""
+	else
+	    AC_CHECK_HEADER(dld.h, [
+		SHLIB_LD="ld -shared"
+		DL_OBJS="tclLoadDld.o"
+		DL_LIBS="-ldld"
+		LD_FLAGS=""
+		LD_SEARCH_FLAGS=""])
+	fi
+	;;
+    MP-RAS-02*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    MP-RAS-*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS="-Wl,-Bexport"
+	LD_SEARCH_FLAGS=""
+	;;
+    NetBSD-*|FreeBSD-*|OpenBSD-*)
+	# Not available on all versions:  check for include file.
+	AC_CHECK_HEADER(dlfcn.h, [
+	    SHLIB_CFLAGS="-fpic"
+	    SHLIB_LD="ld -Bshareable -x"
+	    SHLIB_LD_LIBS=""
+	    SHLIB_SUFFIX=".so"
+	    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"
+	    SHLIB_LD_LIBS='${LIBS}'
+	    SHLIB_SUFFIX=".a"
+	    DL_OBJS="tclLoadAout.o"
+	    DL_LIBS=""
+	    LD_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.
+
+	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+	TCL_LIB_VERSIONS_OK=nodots
+	;;
+    NEXTSTEP-*)
+	SHLIB_CFLAGS=""
+	SHLIB_LD="cc -nostdlib -r"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadNext.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    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
+	SHLIB_LD='ld -R -export $@:'
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadOSF.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    OSF1-1.*)
+	# OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+	SHLIB_CFLAGS="-fpic"
+	SHLIB_LD="ld -shared"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    OSF1-V*)
+        # Digital OSF/1
+	SHLIB_CFLAGS=""
+	SHLIB_LD='ld -shared -expect_unresolved "*"'
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	;;
+    RISCos-*)
+	SHLIB_CFLAGS="-G 0"
+	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+	SHLIB_LD_LIBS='${LIBS}'
+	SHLIB_SUFFIX=".a"
+	DL_OBJS="tclLoadAout.o"
+	DL_LIBS=""
+	LD_FLAGS="-Wl,-D,08000000"
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	;;
+    SCO_SV-3.2*)
+        # Note, dlopen is available only on SCO 3.2.5 and greater.  However,
+        # this test works, since "uname -s" was non-standard in 3.2.4 and
+        # below.
+	SHLIB_CFLAGS="-Kpic -belf"
+	SHLIB_LD="ld -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS=""
+	LD_FLAGS="-belf -Wl,-Bexport"
+	LD_SEARCH_FLAGS=""
+	;;
+     SINIX*5.4*)
+	SHLIB_CFLAGS="-K PIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS=""
+	;;
+    SunOS-4*)
+        # CYGNUS LOCAL: gcc uses a different option than native cc.
+        if test "$GCC" = yes; then
+	   SHLIB_CFLAGS="-fPIC"
+	   SHLIB_LD="$CC -shared -fPIC"
+	else
+	   SHLIB_CFLAGS="-PIC"
+	   SHLIB_LD="ld"
+	fi
+	# END CYGNUS LOCAL
+
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	LD_FLAGS=""
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+
+	# SunOS can't handle version numbers with dots in them in library
+	# specs, like -ltcl7.5, so use -ltcl75 instead.  Also, it
+	# requires an extra version number at the end of .so file names.
+	# So, the library has to have a name like libtcl75.so.1.0
+
+	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
+	;;
+    SunOS-5*)
+        # CYGNUS LOCAL: gcc uses a different option than native cc.
+        if test "$GCC" = yes; then
+	   SHLIB_CFLAGS="-fPIC"
+	   SHLIB_LD="$CC -shared -fPIC"
+	else
+	   SHLIB_CFLAGS="-KPIC"
+	   SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+	fi
+	# END CYGNUS LOCAL
+
+	# 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"
+	DL_LIBS="-ldl"
+	# CYGNUS LOCAL: The GNU linker requires the -export-dynamic
+	# option to make all symbols visible in the dynamic symbol
+	# table.
+	hold_ldflags=$LDFLAGS
+	AC_MSG_CHECKING(for the ld -export-dynamic flag)
+	LDFLAGS="${LDFLAGS} -Wl,-export-dynamic"
+	AC_TRY_LINK(, [int i;], found=yes, found=no)
+	LDFLAGS=$hold_ldflags
+	AC_MSG_RESULT($found)
+	if test $found = yes; then
+	   LD_FLAGS="-Wl,-export-dynamic"
+	   LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+	else
+	   LD_FLAGS=""
+	   LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+	fi
+	# END CYGNUS LOCAL
+	;;
+    ULTRIX-4.*)
+	SHLIB_CFLAGS="-G 0"
+	SHLIB_SUFFIX=".a"
+	SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+	SHLIB_LD_LIBS='${LIBS}'
+	DL_OBJS="tclLoadAout.o"
+	DL_LIBS=""
+	# CYGNUS LOCAL: The GNU linker doesn't accept `-D 08000000'.  It
+	# doesn't appear to be needed, either.
+	hold_ldflags="$LDFLAGS"
+	AC_MSG_CHECKING(whether ld accepts -D 08000000)
+	LD_FLAGS="-Wl,-D,08000000"
+	LDFLAGS="${LDFLAGS} -Wl,-D,08000000"
+	AC_TRY_LINK(, [int i;], found=yes, found=no)
+	LDFLAGS=$hold_ldflags
+	AC_MSG_RESULT($found)
+	if test $found = yes; then
+	   LD_FLAGS="-Wl,-D,08000000"
+	else
+	   LD_FLAGS=""
+	fi
+	# END CYGNUS LOCAL
+	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+	;;
+    UNIX_SV* | UnixWare-5*)
+	SHLIB_CFLAGS="-KPIC"
+	SHLIB_LD="cc -G"
+	SHLIB_LD_LIBS=""
+	SHLIB_SUFFIX=".so"
+	DL_OBJS="tclLoadDl.o"
+	DL_LIBS="-ldl"
+	# 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
+
+# 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
+#	- The `struct exec' must contain a_magic, a_text, a_data, a_bss
+#	  and a_entry fields.
+# The following compilation should succeed if and only if either sys/exec.h
+# or a.out.h is usable for the purpose.
+#
+# Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+# `struct exec' includes a second header that contains information that
+# duplicates the v7 fields that are needed.
+
+if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+    AC_MSG_CHECKING(sys/exec.h)
+    AC_TRY_COMPILE([#include <sys/exec.h>],[
+	struct exec foo;
+	unsigned long seek;
+	int flag;
+#if defined(__mips) || defined(mips)
+	seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+	seek = N_TXTOFF (foo);
+#endif
+	flag = (foo.a_magic == OMAGIC);
+	return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+], tcl_ok=usable, tcl_ok=unusable)
+    AC_MSG_RESULT($tcl_ok)
+    if test $tcl_ok = usable; then
+	AC_DEFINE(USE_SYS_EXEC_H)
+    else
+	AC_MSG_CHECKING(a.out.h)
+	AC_TRY_COMPILE([#include <a.out.h>],[
+	    struct exec foo;
+	    unsigned long seek;
+	    int flag;
+#if defined(__mips) || defined(mips)
+	    seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+	    seek = N_TXTOFF (foo);
+#endif
+	    flag = (foo.a_magic == OMAGIC);
+	    return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+	], tcl_ok=usable, tcl_ok=unusable)
+	AC_MSG_RESULT($tcl_ok)
+	if test $tcl_ok = usable; then
+	    AC_DEFINE(USE_A_OUT_H)
+	else
+	    AC_MSG_CHECKING(sys/exec_aout.h)
+	    AC_TRY_COMPILE([#include <sys/exec_aout.h>],[
+		struct exec foo;
+		unsigned long seek;
+		int flag;
+#if defined(__mips) || defined(mips)
+		seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+		seek = N_TXTOFF (foo);
+#endif
+		flag = (foo.a_midmag == OMAGIC);
+		return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+	    ], tcl_ok=usable, tcl_ok=unusable)
+	    AC_MSG_RESULT($tcl_ok)
+	    if test $tcl_ok = usable; then
+		AC_DEFINE(USE_SYS_EXEC_AOUT_H)
+	    else
+		DL_OBJS=""
+	    fi
+	fi
+    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
+    echo "Can't figure out how to do dynamic loading or shared libraries"
+    echo "on this system."
+    SHLIB_CFLAGS=""
+    SHLIB_LD=""
+    SHLIB_SUFFIX=""
+    DL_OBJS="tclLoadNone.o"
+    DL_LIBS=""
+    LD_FLAGS=""
+    LD_SEARCH_FLAGS=""
+    BUILD_DLTEST=""
+fi
+
+# If we're running gcc, then change the C flags for compiling shared
+# libraries to the right flags for gcc, instead of those for the
+# standard manufacturer compiler.
+
+if test "$DL_OBJS" != "tclLoadNone.o" ; then
+    if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+	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.
+#--------------------------------------------------------------------
+
+realRanlib=$RANLIB
+if test "$TCL_SHARED_LIB_SUFFIX" = "" ; then
+    TCL_SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
+fi
+if test "$TCL_UNSHARED_LIB_SUFFIX" = "" ; then
+    TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'
+fi
+AC_ARG_ENABLE(shared,
+    [  --enable-shared         build libtcl as a shared library],
+    [tcl_ok=$enableval], [tcl_ok=no])
+# CYGNUS LOCAL: need extra variables for this information.
+TCL_SHARED_LIB_FILE=dummy1
+TCL_UNSHARED_LIB_FILE=dummy2
+# END CYGNUS LOCAL
+if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" ; then
+    TCL_SHARED_BUILD=1
+    TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+    TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+    eval "TCL_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}"
+    TCL_SHARED_LIB_FILE="$TCL_LIB_FILE"
+    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
+    TCL_SHARED_BUILD=0
+    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}"
+    TCL_UNSHARED_LIB_FILE="$TCL_LIB_FILE"
+    MAKE_LIB="$AR cr ${TCL_LIB_FILE} \${OBJS}"
+fi
+
+# Note:  in the following variable, it's important to use the absolute
+# path name of the Tcl directory rather than "..":  this is because
+# AIX remembers this path and will attempt to use it at run-time to look
+# up the Tcl library.
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}"
+    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}"
+else
+    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
+    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+fi
+
+TCL_LIB_FULL_PATH="`pwd`/${TCL_LIB_FILE}"
+
+#--------------------------------------------------------------------
+#	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)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(MAKE_LIB)
+AC_SUBST(MATH_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LD_SEARCH_FLAGS)
+AC_SUBST(TCL_LIB_FILE)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(TCL_LIB_FLAG)
+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_SHARED_BUILD)
+AC_SUBST(TCL_SHLIB_CFLAGS)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
+AC_SUBST(TCL_VERSION)
+# CYGNUS LOCAL
+AC_SUBST(TCL_SHARED_LIB_FILE)
+AC_SUBST(TCL_UNSHARED_LIB_FILE)
+# END CYGNUS LOCAL
+
+AC_OUTPUT(Makefile tclConfig.sh)
diff --git a/tcl/unix/dltest/Makefile.in b/tcl/unix/dltest/Makefile.in
new file mode 100644
index 00000000000..c7b74715e0e
--- /dev/null
+++ b/tcl/unix/dltest/Makefile.in
@@ -0,0 +1,45 @@
+# 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.12 97/02/22 14:13:54
+
+CC = @CC@
+LIBS =			@TCL_BUILD_LIB_SPEC@ @TCL_LIBS@ -lc
+SHLIB_CFLAGS =		@SHLIB_CFLAGS@
+SHLIB_LD =		@SHLIB_LD@
+SHLIB_SUFFIX =		@SHLIB_SUFFIX@
+SHLIB_VERSION =		@SHLIB_VERSION@
+SRC_DIR =		@srcdir@
+TCL_VERSION=		@TCL_VERSION@
+
+CFLAGS = -g
+CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
+	${SHLIB_CFLAGS}
+
+all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX}
+
+pkga${SHLIB_SUFFIX}: $(SRC_DIR)/pkga.c
+	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c
+	${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} -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} -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} -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} -o pkge${SHLIB_SUFFIX} pkge.o @SHLIB_LD_LIBS@
+
+clean:
+	rm -f *.o *${SHLIB_SUFFIX} lib.exp
+
+distclean: clean
+	rm -f Makefile config.cache config.log config.status
diff --git a/tcl/unix/dltest/README b/tcl/unix/dltest/README
new file mode 100644
index 00000000000..f4e54d4ff42
--- /dev/null
+++ b/tcl/unix/dltest/README
@@ -0,0 +1,12 @@
+This directory contains several files for testing Tcl's dynamic
+loading capabilities.  If this directory is present and the files
+in here have been compiled, then the "load" test will use the shared
+libraries present here to run a series of tests.  To compile the
+shared libraries, first type "./configure".  This will read
+configuration information created when Tcl was configured and
+create Makefile from Makefile.in.  Be sure that you have configured
+Tcl before configuring here, since information learned during Tcl's
+configure is needed here.  Then type "make" to create the shared
+libraries.
+
+sccsid: @(#) README 1.2 95/08/22 08:13:23
diff --git a/tcl/unix/dltest/configure b/tcl/unix/dltest/configure
new file mode 100755
index 00000000000..973f6b5503a
--- /dev/null
+++ b/tcl/unix/dltest/configure
@@ -0,0 +1,804 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12.1 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.12.1"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set.  These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=pkga.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+  if test "x$prefix" != xNONE; then
+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+  else
+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+  fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+# SCCS: @(#) configure.in 1.9 96/04/15 09:50:20
+
+# Recover information that Tcl computed with its configure script.
+
+. ../tclConfig.sh
+
+CC=$TCL_CC
+
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+
+SHLIB_LD=$TCL_SHLIB_LD
+
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+
+SHLIB_VERSION=$TCL_SHLIB_VERSION
+
+
+TCL_LIBS=$TCL_LIBS
+
+TCL_VERSION=$TCL_VERSION
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+  *ac_space=\ *)
+    # `set' does not quote correctly, so add quotes (double-quote substitution
+    # turns \\\\ into \\, and sed turns \\ into \).
+    sed -n \
+      -e "s/'/'\\\\''/g" \
+      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+    ;;
+  *)
+    # `set' quotes correctly as required by POSIX, so do not add quotes.
+    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+    ;;
+  esac >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ 	`~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.12.1"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+  if test $ac_beg -gt 1; then
+    sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+  else
+    sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+  fi
+  if test ! -s conftest.s$ac_file; then
+    ac_more_lines=false
+    rm -f conftest.s$ac_file
+  else
+    if test -z "$ac_sed_cmds"; then
+      ac_sed_cmds="sed -f conftest.s$ac_file"
+    else
+      ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+    fi
+    ac_file=`expr $ac_file + 1`
+    ac_beg=$ac_end
+    ac_end=`expr $ac_end + $ac_max_sed_cmds`
+  fi
+done
+if test -z "$ac_sed_cmds"; then
+  ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tcl/unix/dltest/configure.in b/tcl/unix/dltest/configure.in
new file mode 100644
index 00000000000..6356137bbd1
--- /dev/null
+++ b/tcl/unix/dltest/configure.in
@@ -0,0 +1,34 @@
+dnl	This file is an input file used by the GNU "autoconf" program to
+dnl	generate the file "configure", which is run to configure the
+dnl	Makefile in this directory.
+
+dnl CYGNUS LOCAL, need 2.5 or higher for --bindir et al
+AC_PREREQ(2.5)
+dnl END CYGNUS LOCAL
+
+AC_INIT(pkga.c)
+# SCCS: @(#) configure.in 1.9 96/04/15 09:50:20
+
+# Recover information that Tcl computed with its configure script.
+
+. ../tclConfig.sh
+
+CC=$TCL_CC
+AC_SUBST(CC)
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+AC_SUBST(SHLIB_CFLAGS)
+SHLIB_LD=$TCL_SHLIB_LD
+AC_SUBST(SHLIB_LD)
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+AC_SUBST(SHLIB_LD_LIBS)
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+AC_SUBST(SHLIB_SUFFIX)
+SHLIB_VERSION=$TCL_SHLIB_VERSION
+AC_SUBST(SHLIB_VERSION)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+TCL_LIBS=$TCL_LIBS
+AC_SUBST(TCL_LIBS)
+TCL_VERSION=$TCL_VERSION
+AC_SUBST(TCL_VERSION)
+
+AC_OUTPUT(Makefile)
diff --git a/tcl/unix/dltest/pkga.c b/tcl/unix/dltest/pkga.c
new file mode 100644
index 00000000000..ab485229b41
--- /dev/null
+++ b/tcl/unix/dltest/pkga.c
@@ -0,0 +1,130 @@
+/* 
+ * pkga.c --
+ *
+ *	This file contains a simple Tcl package "pkga" that is intended
+ *	for testing the Tcl dynamic loading facilities.
+ *
+ * Copyright (c) 1995 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: @(#) pkga.c 1.4 96/02/15 12:30:35
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int	Pkga_EqCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+static int	Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkga_EqCmd --
+ *
+ *	This procedure is invoked to process the "pkga_eq" Tcl command.
+ *	It expects two arguments and returns 1 if they are the same,
+ *	0 if they are different.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkga_EqCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" string1 string2\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[1], argv[2]) == 0) {
+	interp->result = "1";
+    } else {
+	interp->result = "0";
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkga_quoteCmd --
+ *
+ *	This procedure is invoked to process the "pkga_quote" Tcl command.
+ *	It expects one argument, which it returns as result.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkga_QuoteCmd(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],
+		" value\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    strcpy(interp->result, argv[1]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkga_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkga_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    int code;
+
+    code = Tcl_PkgProvide(interp, "Pkga", "1.0");
+    if (code != TCL_OK) {
+	return code;
+    }
+    Tcl_CreateCommand(interp, "pkga_eq", Pkga_EqCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "pkga_quote", Pkga_QuoteCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
diff --git a/tcl/unix/dltest/pkgb.c b/tcl/unix/dltest/pkgb.c
new file mode 100644
index 00000000000..1da95755cbd
--- /dev/null
+++ b/tcl/unix/dltest/pkgb.c
@@ -0,0 +1,153 @@
+/* 
+ * pkgb.c --
+ *
+ *	This file contains a simple Tcl package "pkgb" that is intended
+ *	for testing the Tcl dynamic loading facilities.  It can be used
+ *	in both safe and unsafe interpreters.
+ *
+ * Copyright (c) 1995 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: @(#) pkgb.c 1.4 96/02/15 12:30:34
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int	Pkgb_SubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+static int	Pkgb_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_SubCmd --
+ *
+ *	This procedure is invoked to process the "pkgb_sub" Tcl command.
+ *	It expects two arguments and returns their difference.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgb_SubCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int first, second;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" num num\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
+	    || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+	return TCL_ERROR;
+    }
+    sprintf(interp->result, "%d", first - second);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_UnsafeCmd --
+ *
+ *	This procedure is invoked to process the "pkgb_unsafe" Tcl command.
+ *	It just returns a constant string.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgb_UnsafeCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    interp->result = "unsafe command invoked";
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgb_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    int code;
+
+    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
+    if (code != TCL_OK) {
+	return code;
+    }
+    Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "pkgb_unsafe", Pkgb_UnsafeCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_SafeInit --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgb_SafeInit(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
diff --git a/tcl/unix/dltest/pkgc.c b/tcl/unix/dltest/pkgc.c
new file mode 100644
index 00000000000..c35189a30a6
--- /dev/null
+++ b/tcl/unix/dltest/pkgc.c
@@ -0,0 +1,153 @@
+/* 
+ * pkgc.c --
+ *
+ *	This file contains a simple Tcl package "pkgc" that is intended
+ *	for testing the Tcl dynamic loading facilities.  It can be used
+ *	in both safe and unsafe interpreters.
+ *
+ * Copyright (c) 1995 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: @(#) pkgc.c 1.4 96/02/15 12:30:35
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int	Pkgc_SubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+static int	Pkgc_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_SubCmd --
+ *
+ *	This procedure is invoked to process the "pkgc_sub" Tcl command.
+ *	It expects two arguments and returns their difference.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgc_SubCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int first, second;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" num num\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
+	    || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+	return TCL_ERROR;
+    }
+    sprintf(interp->result, "%d", first - second);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_UnsafeCmd --
+ *
+ *	This procedure is invoked to process the "pkgc_unsafe" Tcl command.
+ *	It just returns a constant string.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgc_UnsafeCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    interp->result = "unsafe command invoked";
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgc_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    int code;
+
+    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
+    if (code != TCL_OK) {
+	return code;
+    }
+    Tcl_CreateCommand(interp, "pkgc_sub", Pkgc_SubCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "pkgc_unsafe", Pkgc_UnsafeCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_SafeInit --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgc_SafeInit(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    Tcl_CreateCommand(interp, "pkgc_sub", Pkgc_SubCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
diff --git a/tcl/unix/dltest/pkgd.c b/tcl/unix/dltest/pkgd.c
new file mode 100644
index 00000000000..56821cc30be
--- /dev/null
+++ b/tcl/unix/dltest/pkgd.c
@@ -0,0 +1,154 @@
+/* 
+ * pkgd.c --
+ *
+ *	This file contains a simple Tcl package "pkgd" that is intended
+ *	for testing the Tcl dynamic loading facilities.  It can be used
+ *	in both safe and unsafe interpreters.
+ *
+ * Copyright (c) 1995 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: @(#) pkgd.c 1.4 96/02/15 12:30:32
+ */
+
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int	Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+static int	Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_SubCmd --
+ *
+ *	This procedure is invoked to process the "pkgd_sub" Tcl command.
+ *	It expects two arguments and returns their difference.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgd_SubCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    int first, second;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" num num\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
+	    || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+	return TCL_ERROR;
+    }
+    sprintf(interp->result, "%d", first - second);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_UnsafeCmd --
+ *
+ *	This procedure is invoked to process the "pkgd_unsafe" Tcl command.
+ *	It just returns a constant string.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgd_UnsafeCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    interp->result = "unsafe command invoked";
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgd_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    int code;
+
+    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
+    if (code != TCL_OK) {
+	return code;
+    }
+    Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "pkgd_unsafe", Pkgd_UnsafeCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_SafeInit --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgd_SafeInit(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
diff --git a/tcl/unix/dltest/pkge.c b/tcl/unix/dltest/pkge.c
new file mode 100644
index 00000000000..1d585cae3da
--- /dev/null
+++ b/tcl/unix/dltest/pkge.c
@@ -0,0 +1,49 @@
+/* 
+ * pkge.c --
+ *
+ *	This file contains a simple Tcl package "pkge" that is intended
+ *	for testing the Tcl dynamic loading facilities.  Its Init
+ *	procedure returns an error in order to test how this is handled.
+ *
+ * Copyright (c) 1995 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: @(#) pkge.c 1.5 96/03/07 09:34:27
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int	Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+static int	Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkge_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	Returns TCL_ERROR and leaves an error message in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkge_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    return Tcl_Eval(interp, "if 44 {open non_existent}");
+}
diff --git a/tcl/unix/dltest/pkgf.c b/tcl/unix/dltest/pkgf.c
new file mode 100644
index 00000000000..d7c641aeb52
--- /dev/null
+++ b/tcl/unix/dltest/pkgf.c
@@ -0,0 +1,49 @@
+/* 
+ * pkgf.c --
+ *
+ *	This file contains a simple Tcl package "pkgf" that is intended
+ *	for testing the Tcl dynamic loading facilities.  Its Init
+ *	procedure returns an error in order to test how this is handled.
+ *
+ * Copyright (c) 1995 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: @(#) pkgf.c 1.2 96/02/15 12:30:32
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int	Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+static int	Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgf_Init --
+ *
+ *	This is a package initialization procedure, which is called
+ *	by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	Returns TCL_ERROR and leaves an error message in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgf_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter in which the package is
+				 * to be made available. */
+{
+    return Tcl_Eval(interp, "if 44 {open non_existent}");
+}
diff --git a/tcl/unix/install-sh b/tcl/unix/install-sh
new file mode 100755
index 00000000000..0ff4b6a08e8
--- /dev/null
+++ b/tcl/unix/install-sh
@@ -0,0 +1,119 @@
+#!/bin/sh
+
+#
+# install - install a program, script, or datafile
+# This comes from X11R5; it is not part of GNU.
+#
+# $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+#
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+
+instcmd="$mvprog"
+chmodcmd=""
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+
+while [ x"$1" != x ]; do
+    case $1 in
+	-c) instcmd="$cpprog"
+	    shift
+	    continue;;
+
+	-m) chmodcmd="$chmodprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-o) chowncmd="$chownprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-g) chgrpcmd="$chgrpprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-s) stripcmd="$stripprog"
+	    shift
+	    continue;;
+
+	*)  if [ x"$src" = x ]
+	    then
+		src=$1
+	    else
+		dst=$1
+	    fi
+	    shift
+	    continue;;
+    esac
+done
+
+if [ x"$src" = x ]
+then
+	echo "install:  no input file specified"
+	exit 1
+fi
+
+if [ x"$dst" = x ]
+then
+	echo "install:  no destination specified"
+	exit 1
+fi
+
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+if [ -d $dst ]
+then
+	dst="$dst"/`basename $src`
+fi
+
+# Make a temp file name in the proper directory.
+
+dstdir=`dirname $dst`
+dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+$doit $instcmd $src $dsttmp
+
+# and set any options; do chmod last to preserve setuid bits
+
+if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi
+if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi
+if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi
+if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi
+
+# Now rename the file to the real destination.
+
+$doit $rmcmd $dst
+$doit $mvcmd $dsttmp $dst
+
+
+exit 0
diff --git a/tcl/unix/ldAix b/tcl/unix/ldAix
new file mode 100755
index 00000000000..15818eb6082
--- /dev/null
+++ b/tcl/unix/ldAix
@@ -0,0 +1,72 @@
+#!/bin/sh
+#
+# ldAix ldCmd ldArg ldArg ...
+#
+# This shell script provides a wrapper for ld under AIX in order to
+# create the .exp file required for linking.  Its arguments consist
+# of the name and arguments that would normally be provided to the
+# ld command.  This script extracts the names of the object files
+# from the argument list, creates a .exp file describing all of the
+# symbols exported by those files, and then invokes "ldCmd" to
+# perform the real link.
+#
+# RCS: @(#) $Id$
+
+# Extract from the arguments the names of all of the object files.
+
+args=$*
+ofiles=""
+for i do
+    x=`echo $i | grep '[^.].o$'`
+    if test "$x" != ""; then
+	ofiles="$ofiles $i"
+    fi
+done
+
+# Create the export file from all of the object files, using nm followed
+# by sed editing.  Here are some tricky aspects of this:
+#
+# 1. Nm produces different output under AIX 4.1 than under AIX 3.2.5;
+#    the following statements handle both versions.
+# 2. Use the -g switch to nm instead of -e under 4.1 (this shows just
+#    externals, not statics;  -g isn't available under 3.2.5, though).
+# 3. Eliminate lines that end in ":": these are the names of object
+#    files (relevant in 4.1 only).
+# 4. Eliminate entries with the "U" key letter;  these are undefined
+#    symbols (relevant in 4.1 only).
+# 5. Eliminate lines that contain the string "0|extern" preceded by space;
+#    in 3.2.5, these are undefined symbols (address 0).
+# 6. Eliminate lines containing the "unamex" symbol.  In 3.2.5, these
+#    are also undefined symbols.
+# 7. If a line starts with ".", delete the leading ".", since this will
+#    just cause confusion later.
+# 8. Eliminate everything after the first field in a line, so that we're
+#    left with just the symbol name.
+
+nmopts="-g -C"
+osver=`uname -v`
+if test $osver -eq 3; then
+  nmopts="-e"
+fi
+rm -f lib.exp
+echo "#! " >lib.exp
+/usr/ccs/bin/nm $nmopts -h $ofiles | sed -e '/:$/d' -e '/ U /d' -e '/[ 	]0|extern/d' -e '/unamex/d' -e 's/^\.//' -e 's/[ 	|].*//' | sort | uniq >>lib.exp
+
+# Extract the name of the object file that we're linking.  If it's a .a
+# file, then link all the objects together into a single file "shr.o"
+# and then put that into the archive.  Otherwise link the object files
+# directly into the .a file.
+
+outputFile=`echo $args | sed -e 's/.*-o \([^ ]*\).*/\1/'`
+noDotA=`echo $outputFile | sed -e '/\.a$/d'`
+echo "noDotA=\"$noDotA\""
+if test "$noDotA" = "" ; then
+    linkArgs=`echo $args | sed -e 's/-o .*\.a /-o shr.o /'`
+    echo $linkArgs
+    eval $linkArgs
+    echo ar cr $outputFile shr.o
+    ar cr $outputFile shr.o
+    rm -f shr.o
+else
+    eval $args
+fi
diff --git a/tcl/unix/mkLinks b/tcl/unix/mkLinks
new file mode 100755
index 00000000000..23afaabcae1
--- /dev/null
+++ b/tcl/unix/mkLinks
@@ -0,0 +1,1011 @@
+#!/bin/sh
+# This script is invoked when installing manual entries.  It generates
+# additional links to manual entries, corresponding to the procedure
+# and command names described by the manual entry.  For example, the
+# Tcl manual entry Hash.3 describes procedures Tcl_InitHashTable,
+# Tcl_CreateHashEntry, and many more.  This script will make hard
+# links so that Tcl_InitHashTable.3, Tcl_CreateHashEntry.3, and so
+# on all refer to Hash.3 in the installed directory.
+#
+# Because of the length of command and procedure names, this mechanism
+# only works on machines that support file names longer than 14 characters.
+# This script checks to see if long file names are supported, and it
+# doesn't make any links if they are not.
+#
+# The script takes one argument, which is the name of the directory
+# where the manual entries have been installed.
+
+if test $# != 1; then
+    echo "Usage: mkLinks dir"
+    exit 1
+fi
+
+cd $1
+echo foo > xyzzyTestingAVeryLongFileName.foo
+x=`echo xyzzyTe*`
+rm xyzzyTe*
+if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
+    exit
+fi
+
+if test -r AddErrInfo.3; then
+    rm -f Tcl_AddObjErrorInfo.3
+    ln AddErrInfo.3 Tcl_AddObjErrorInfo.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_SetErrorCode.3
+    ln AddErrInfo.3 Tcl_SetErrorCode.3
+fi
+if test -r AddErrInfo.3; then
+    rm -f Tcl_PosixError.3
+    ln AddErrInfo.3 Tcl_PosixError.3
+fi
+if test -r Alloc.3; then
+    rm -f Tcl_Alloc.3
+    ln Alloc.3 Tcl_Alloc.3
+fi
+if test -r Alloc.3; then
+    rm -f Tcl_Free.3
+    ln Alloc.3 Tcl_Free.3
+fi
+if test -r Alloc.3; then
+    rm -f Tcl_Realloc.3
+    ln Alloc.3 Tcl_Realloc.3
+fi
+if test -r AllowExc.3; then
+    rm -f Tcl_AllowExceptions.3
+    ln AllowExc.3 Tcl_AllowExceptions.3
+fi
+if test -r AppInit.3; then
+    rm -f Tcl_AppInit.3
+    ln AppInit.3 Tcl_AppInit.3
+fi
+if test -r AssocData.3; then
+    rm -f Tcl_GetAssocData.3
+    ln AssocData.3 Tcl_GetAssocData.3
+fi
+if test -r AssocData.3; then
+    rm -f Tcl_SetAssocData.3
+    ln AssocData.3 Tcl_SetAssocData.3
+fi
+if test -r AssocData.3; then
+    rm -f Tcl_DeleteAssocData.3
+    ln AssocData.3 Tcl_DeleteAssocData.3
+fi
+if test -r Async.3; then
+    rm -f Tcl_AsyncCreate.3
+    ln Async.3 Tcl_AsyncCreate.3
+fi
+if test -r Async.3; then
+    rm -f Tcl_AsyncMark.3
+    ln Async.3 Tcl_AsyncMark.3
+fi
+if test -r Async.3; then
+    rm -f Tcl_AsyncInvoke.3
+    ln Async.3 Tcl_AsyncInvoke.3
+fi
+if test -r Async.3; then
+    rm -f Tcl_AsyncDelete.3
+    ln Async.3 Tcl_AsyncDelete.3
+fi
+if test -r BackgdErr.3; then
+    rm -f Tcl_BackgroundError.3
+    ln BackgdErr.3 Tcl_BackgroundError.3
+fi
+if test -r Backslash.3; then
+    rm -f Tcl_Backslash.3
+    ln Backslash.3 Tcl_Backslash.3
+fi
+if test -r BoolObj.3; then
+    rm -f Tcl_NewBooleanObj.3
+    ln BoolObj.3 Tcl_NewBooleanObj.3
+fi
+if test -r BoolObj.3; then
+    rm -f Tcl_SetBooleanObj.3
+    ln BoolObj.3 Tcl_SetBooleanObj.3
+fi
+if test -r BoolObj.3; then
+    rm -f Tcl_GetBooleanFromObj.3
+    ln BoolObj.3 Tcl_GetBooleanFromObj.3
+fi
+if test -r CallDel.3; then
+    rm -f Tcl_CallWhenDeleted.3
+    ln CallDel.3 Tcl_CallWhenDeleted.3
+fi
+if test -r CallDel.3; then
+    rm -f Tcl_DontCallWhenDeleted.3
+    ln CallDel.3 Tcl_DontCallWhenDeleted.3
+fi
+if test -r CmdCmplt.3; then
+    rm -f Tcl_CommandComplete.3
+    ln CmdCmplt.3 Tcl_CommandComplete.3
+fi
+if test -r Concat.3; then
+    rm -f Tcl_Concat.3
+    ln Concat.3 Tcl_Concat.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_CreateChannel.3
+    ln CrtChannel.3 Tcl_CreateChannel.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_GetChannelType.3
+    ln CrtChannel.3 Tcl_GetChannelType.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_GetChannelName.3
+    ln CrtChannel.3 Tcl_GetChannelName.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_GetChannelHandle.3
+    ln CrtChannel.3 Tcl_GetChannelHandle.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_GetChannelBufferSize.3
+    ln CrtChannel.3 Tcl_GetChannelBufferSize.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_SetDefaultTranslation.3
+    ln CrtChannel.3 Tcl_SetDefaultTranslation.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_SetChannelBufferSize.3
+    ln CrtChannel.3 Tcl_SetChannelBufferSize.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_NotifyChannel.3
+    ln CrtChannel.3 Tcl_NotifyChannel.3
+fi
+if test -r CrtChannel.3; then
+    rm -f Tcl_BadChannelOption.3
+    ln CrtChannel.3 Tcl_BadChannelOption.3
+fi
+if test -r CrtChnlHdlr.3; then
+    rm -f Tcl_CreateChannelHandler.3
+    ln CrtChnlHdlr.3 Tcl_CreateChannelHandler.3
+fi
+if test -r CrtChnlHdlr.3; then
+    rm -f Tcl_DeleteChannelHandler.3
+    ln CrtChnlHdlr.3 Tcl_DeleteChannelHandler.3
+fi
+if test -r CrtCloseHdlr.3; then
+    rm -f Tcl_CreateCloseHandler.3
+    ln CrtCloseHdlr.3 Tcl_CreateCloseHandler.3
+fi
+if test -r CrtCloseHdlr.3; then
+    rm -f Tcl_DeleteCloseHandler.3
+    ln CrtCloseHdlr.3 Tcl_DeleteCloseHandler.3
+fi
+if test -r CrtCommand.3; then
+    rm -f Tcl_CreateCommand.3
+    ln CrtCommand.3 Tcl_CreateCommand.3
+fi
+if test -r CrtFileHdlr.3; then
+    rm -f Tcl_CreateFileHandler.3
+    ln CrtFileHdlr.3 Tcl_CreateFileHandler.3
+fi
+if test -r CrtFileHdlr.3; then
+    rm -f Tcl_DeleteFileHandler.3
+    ln CrtFileHdlr.3 Tcl_DeleteFileHandler.3
+fi
+if test -r CrtInterp.3; then
+    rm -f Tcl_CreateInterp.3
+    ln CrtInterp.3 Tcl_CreateInterp.3
+fi
+if test -r CrtInterp.3; then
+    rm -f Tcl_DeleteInterp.3
+    ln CrtInterp.3 Tcl_DeleteInterp.3
+fi
+if test -r CrtInterp.3; then
+    rm -f Tcl_InterpDeleted.3
+    ln CrtInterp.3 Tcl_InterpDeleted.3
+fi
+if test -r CrtMathFnc.3; then
+    rm -f Tcl_CreateMathFunc.3
+    ln CrtMathFnc.3 Tcl_CreateMathFunc.3
+fi
+if test -r CrtObjCmd.3; then
+    rm -f Tcl_CreateObjCommand.3
+    ln CrtObjCmd.3 Tcl_CreateObjCommand.3
+fi
+if test -r CrtObjCmd.3; then
+    rm -f 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 CrtObjCmd.3; then
+    rm -f Tcl_GetCommandInfo.3
+    ln CrtObjCmd.3 Tcl_GetCommandInfo.3
+fi
+if test -r CrtObjCmd.3; then
+    rm -f Tcl_SetCommandInfo.3
+    ln CrtObjCmd.3 Tcl_SetCommandInfo.3
+fi
+if test -r CrtObjCmd.3; then
+    rm -f Tcl_GetCommandName.3
+    ln CrtObjCmd.3 Tcl_GetCommandName.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_IsSafe.3
+    ln CrtSlave.3 Tcl_IsSafe.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_MakeSafe.3
+    ln CrtSlave.3 Tcl_MakeSafe.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_CreateSlave.3
+    ln CrtSlave.3 Tcl_CreateSlave.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_GetMaster.3
+    ln CrtSlave.3 Tcl_GetMaster.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_GetInterpPath.3
+    ln CrtSlave.3 Tcl_GetInterpPath.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 CrtSlave.3; then
+    rm -f Tcl_GetAlias.3
+    ln CrtSlave.3 Tcl_GetAlias.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_GetAliasObj.3
+    ln CrtSlave.3 Tcl_GetAliasObj.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_ExposeCommand.3
+    ln CrtSlave.3 Tcl_ExposeCommand.3
+fi
+if test -r CrtSlave.3; then
+    rm -f Tcl_HideCommand.3
+    ln CrtSlave.3 Tcl_HideCommand.3
+fi
+if test -r CrtTimerHdlr.3; then
+    rm -f Tcl_CreateTimerHandler.3
+    ln CrtTimerHdlr.3 Tcl_CreateTimerHandler.3
+fi
+if test -r CrtTimerHdlr.3; then
+    rm -f Tcl_DeleteTimerHandler.3
+    ln CrtTimerHdlr.3 Tcl_DeleteTimerHandler.3
+fi
+if test -r CrtTrace.3; then
+    rm -f Tcl_CreateTrace.3
+    ln CrtTrace.3 Tcl_CreateTrace.3
+fi
+if test -r CrtTrace.3; then
+    rm -f Tcl_DeleteTrace.3
+    ln CrtTrace.3 Tcl_DeleteTrace.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringInit.3
+    ln DString.3 Tcl_DStringInit.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringAppend.3
+    ln DString.3 Tcl_DStringAppend.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringAppendElement.3
+    ln DString.3 Tcl_DStringAppendElement.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringStartSublist.3
+    ln DString.3 Tcl_DStringStartSublist.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringEndSublist.3
+    ln DString.3 Tcl_DStringEndSublist.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringLength.3
+    ln DString.3 Tcl_DStringLength.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringValue.3
+    ln DString.3 Tcl_DStringValue.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringSetLength.3
+    ln DString.3 Tcl_DStringSetLength.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringFree.3
+    ln DString.3 Tcl_DStringFree.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringResult.3
+    ln DString.3 Tcl_DStringResult.3
+fi
+if test -r DString.3; then
+    rm -f Tcl_DStringGetResult.3
+    ln DString.3 Tcl_DStringGetResult.3
+fi
+if test -r DetachPids.3; then
+    rm -f Tcl_DetachPids.3
+    ln DetachPids.3 Tcl_DetachPids.3
+fi
+if test -r DetachPids.3; then
+    rm -f Tcl_ReapDetachedProcs.3
+    ln DetachPids.3 Tcl_ReapDetachedProcs.3
+fi
+if test -r DoOneEvent.3; then
+    rm -f Tcl_DoOneEvent.3
+    ln DoOneEvent.3 Tcl_DoOneEvent.3
+fi
+if test -r DoWhenIdle.3; then
+    rm -f Tcl_DoWhenIdle.3
+    ln DoWhenIdle.3 Tcl_DoWhenIdle.3
+fi
+if test -r DoWhenIdle.3; then
+    rm -f Tcl_CancelIdleCall.3
+    ln DoWhenIdle.3 Tcl_CancelIdleCall.3
+fi
+if test -r DoubleObj.3; then
+    rm -f Tcl_NewDoubleObj.3
+    ln DoubleObj.3 Tcl_NewDoubleObj.3
+fi
+if test -r DoubleObj.3; then
+    rm -f Tcl_SetDoubleObj.3
+    ln DoubleObj.3 Tcl_SetDoubleObj.3
+fi
+if test -r DoubleObj.3; then
+    rm -f Tcl_GetDoubleFromObj.3
+    ln DoubleObj.3 Tcl_GetDoubleFromObj.3
+fi
+if test -r Eval.3; then
+    rm -f Tcl_Eval.3
+    ln Eval.3 Tcl_Eval.3
+fi
+if test -r Eval.3; then
+    rm -f Tcl_VarEval.3
+    ln Eval.3 Tcl_VarEval.3
+fi
+if test -r Eval.3; then
+    rm -f Tcl_EvalFile.3
+    ln Eval.3 Tcl_EvalFile.3
+fi
+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_EvalObj.3
+    ln EvalObj.3 Tcl_EvalObj.3
+fi
+if test -r EvalObj.3; then
+    rm -f Tcl_GlobalEvalObj.3
+    ln EvalObj.3 Tcl_GlobalEvalObj.3
+fi
+if test -r Exit.3; then
+    rm -f Tcl_Exit.3
+    ln Exit.3 Tcl_Exit.3
+fi
+if test -r Exit.3; then
+    rm -f Tcl_Finalize.3
+    ln Exit.3 Tcl_Finalize.3
+fi
+if test -r Exit.3; then
+    rm -f Tcl_CreateExitHandler.3
+    ln Exit.3 Tcl_CreateExitHandler.3
+fi
+if test -r Exit.3; then
+    rm -f Tcl_DeleteExitHandler.3
+    ln Exit.3 Tcl_DeleteExitHandler.3
+fi
+if test -r ExprLong.3; then
+    rm -f Tcl_ExprLong.3
+    ln ExprLong.3 Tcl_ExprLong.3
+fi
+if test -r ExprLong.3; then
+    rm -f Tcl_ExprDouble.3
+    ln ExprLong.3 Tcl_ExprDouble.3
+fi
+if test -r ExprLong.3; then
+    rm -f Tcl_ExprBoolean.3
+    ln ExprLong.3 Tcl_ExprBoolean.3
+fi
+if test -r ExprLong.3; then
+    rm -f Tcl_ExprString.3
+    ln ExprLong.3 Tcl_ExprString.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_ExprDoubleObj.3
+    ln ExprLongObj.3 Tcl_ExprDoubleObj.3
+fi
+if test -r ExprLongObj.3; then
+    rm -f Tcl_ExprBooleanObj.3
+    ln ExprLongObj.3 Tcl_ExprBooleanObj.3
+fi
+if test -r ExprLongObj.3; then
+    rm -f Tcl_ExprObj.3
+    ln ExprLongObj.3 Tcl_ExprObj.3
+fi
+if test -r FindExec.3; then
+    rm -f Tcl_FindExecutable.3
+    ln FindExec.3 Tcl_FindExecutable.3
+fi
+if test -r FindExec.3; then
+    rm -f Tcl_GetNameOfExecutable.3
+    ln FindExec.3 Tcl_GetNameOfExecutable.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 GetInt.3; then
+    rm -f Tcl_GetDouble.3
+    ln GetInt.3 Tcl_GetDouble.3
+fi
+if test -r GetInt.3; then
+    rm -f Tcl_GetBoolean.3
+    ln GetInt.3 Tcl_GetBoolean.3
+fi
+if test -r GetOpnFl.3; then
+    rm -f Tcl_GetOpenFile.3
+    ln GetOpnFl.3 Tcl_GetOpenFile.3
+fi
+if test -r GetStdChan.3; then
+    rm -f Tcl_GetStdChannel.3
+    ln GetStdChan.3 Tcl_GetStdChannel.3
+fi
+if test -r GetStdChan.3; then
+    rm -f Tcl_SetStdChannel.3
+    ln GetStdChan.3 Tcl_SetStdChannel.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_InitHashTable.3
+    ln Hash.3 Tcl_InitHashTable.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_DeleteHashTable.3
+    ln Hash.3 Tcl_DeleteHashTable.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_CreateHashEntry.3
+    ln Hash.3 Tcl_CreateHashEntry.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_DeleteHashEntry.3
+    ln Hash.3 Tcl_DeleteHashEntry.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_FindHashEntry.3
+    ln Hash.3 Tcl_FindHashEntry.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_GetHashValue.3
+    ln Hash.3 Tcl_GetHashValue.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_SetHashValue.3
+    ln Hash.3 Tcl_SetHashValue.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_GetHashKey.3
+    ln Hash.3 Tcl_GetHashKey.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_FirstHashEntry.3
+    ln Hash.3 Tcl_FirstHashEntry.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_NextHashEntry.3
+    ln Hash.3 Tcl_NextHashEntry.3
+fi
+if test -r Hash.3; then
+    rm -f Tcl_HashStats.3
+    ln Hash.3 Tcl_HashStats.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_NewIntObj.3
+    ln IntObj.3 Tcl_NewIntObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_NewLongObj.3
+    ln IntObj.3 Tcl_NewLongObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_SetIntObj.3
+    ln IntObj.3 Tcl_SetIntObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_SetLongObj.3
+    ln IntObj.3 Tcl_SetLongObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_GetIntFromObj.3
+    ln IntObj.3 Tcl_GetIntFromObj.3
+fi
+if test -r IntObj.3; then
+    rm -f Tcl_GetLongFromObj.3
+    ln IntObj.3 Tcl_GetLongFromObj.3
+fi
+if test -r Interp.3; then
+    rm -f Tcl_Interp.3
+    ln Interp.3 Tcl_Interp.3
+fi
+if test -r LinkVar.3; then
+    rm -f Tcl_LinkVar.3
+    ln LinkVar.3 Tcl_LinkVar.3
+fi
+if test -r LinkVar.3; then
+    rm -f Tcl_UnlinkVar.3
+    ln LinkVar.3 Tcl_UnlinkVar.3
+fi
+if test -r LinkVar.3; then
+    rm -f Tcl_UpdateLinkedVar.3
+    ln LinkVar.3 Tcl_UpdateLinkedVar.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_ListObjAppendElement.3
+    ln ListObj.3 Tcl_ListObjAppendElement.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_NewListObj.3
+    ln ListObj.3 Tcl_NewListObj.3
+fi
+if test -r ListObj.3; then
+    rm -f Tcl_SetListObj.3
+    ln ListObj.3 Tcl_SetListObj.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_ListObjLength.3
+    ln ListObj.3 Tcl_ListObjLength.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_ListObjReplace.3
+    ln ListObj.3 Tcl_ListObjReplace.3
+fi
+if test -r Notifier.3; then
+    rm -f Tcl_CreateEventSource.3
+    ln Notifier.3 Tcl_CreateEventSource.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_SetMaxBlockTime.3
+    ln Notifier.3 Tcl_SetMaxBlockTime.3
+fi
+if test -r Notifier.3; then
+    rm -f Tcl_QueueEvent.3
+    ln Notifier.3 Tcl_QueueEvent.3
+fi
+if test -r Notifier.3; then
+    rm -f Tcl_DeleteEvents.3
+    ln Notifier.3 Tcl_DeleteEvents.3
+fi
+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_SetTimer.3
+    ln Notifier.3 Tcl_SetTimer.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 Notifier.3; then
+    rm -f Tcl_GetServiceMode.3
+    ln Notifier.3 Tcl_GetServiceMode.3
+fi
+if test -r Notifier.3; then
+    rm -f Tcl_SetServiceMode.3
+    ln Notifier.3 Tcl_SetServiceMode.3
+fi
+if test -r ObjSetVar.3; then
+    rm -f Tcl_ObjSetVar2.3
+    ln ObjSetVar.3 Tcl_ObjSetVar2.3
+fi
+if test -r ObjSetVar.3; then
+    rm -f Tcl_ObjGetVar2.3
+    ln ObjSetVar.3 Tcl_ObjGetVar2.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_NewObj.3
+    ln Object.3 Tcl_NewObj.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_DuplicateObj.3
+    ln Object.3 Tcl_DuplicateObj.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_IncrRefCount.3
+    ln Object.3 Tcl_IncrRefCount.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_DecrRefCount.3
+    ln Object.3 Tcl_DecrRefCount.3
+fi
+if test -r Object.3; then
+    rm -f Tcl_IsShared.3
+    ln Object.3 Tcl_IsShared.3
+fi
+if test -r ObjectType.3; then
+    rm -f Tcl_RegisterObjType.3
+    ln ObjectType.3 Tcl_RegisterObjType.3
+fi
+if test -r ObjectType.3; then
+    rm -f Tcl_GetObjType.3
+    ln ObjectType.3 Tcl_GetObjType.3
+fi
+if test -r ObjectType.3; then
+    rm -f Tcl_AppendAllObjTypes.3
+    ln ObjectType.3 Tcl_AppendAllObjTypes.3
+fi
+if test -r ObjectType.3; then
+    rm -f Tcl_ConvertToType.3
+    ln ObjectType.3 Tcl_ConvertToType.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_OpenFileChannel.3
+    ln OpenFileChnl.3 Tcl_OpenFileChannel.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_OpenCommandChannel.3
+    ln OpenFileChnl.3 Tcl_OpenCommandChannel.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_MakeFileChannel.3
+    ln OpenFileChnl.3 Tcl_MakeFileChannel.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_GetChannel.3
+    ln OpenFileChnl.3 Tcl_GetChannel.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_RegisterChannel.3
+    ln OpenFileChnl.3 Tcl_RegisterChannel.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_UnregisterChannel.3
+    ln OpenFileChnl.3 Tcl_UnregisterChannel.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Close.3
+    ln OpenFileChnl.3 Tcl_Close.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Read.3
+    ln OpenFileChnl.3 Tcl_Read.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Gets.3
+    ln OpenFileChnl.3 Tcl_Gets.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Write.3
+    ln OpenFileChnl.3 Tcl_Write.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Flush.3
+    ln OpenFileChnl.3 Tcl_Flush.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Seek.3
+    ln OpenFileChnl.3 Tcl_Seek.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Tell.3
+    ln OpenFileChnl.3 Tcl_Tell.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_Eof.3
+    ln OpenFileChnl.3 Tcl_Eof.3
+fi
+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 OpenFileChnl.3; then
+    rm -f Tcl_GetChannelOption.3
+    ln OpenFileChnl.3 Tcl_GetChannelOption.3
+fi
+if test -r OpenFileChnl.3; then
+    rm -f Tcl_SetChannelOption.3
+    ln OpenFileChnl.3 Tcl_SetChannelOption.3
+fi
+if test -r OpenTcp.3; then
+    rm -f Tcl_OpenTcpClient.3
+    ln OpenTcp.3 Tcl_OpenTcpClient.3
+fi
+if test -r OpenTcp.3; then
+    rm -f Tcl_MakeTcpClientChannel.3
+    ln OpenTcp.3 Tcl_MakeTcpClientChannel.3
+fi
+if test -r OpenTcp.3; then
+    rm -f Tcl_OpenTcpServer.3
+    ln OpenTcp.3 Tcl_OpenTcpServer.3
+fi
+if test -r PkgRequire.3; then
+    rm -f Tcl_PkgRequire.3
+    ln PkgRequire.3 Tcl_PkgRequire.3
+fi
+if test -r PkgRequire.3; then
+    rm -f Tcl_PkgProvide.3
+    ln PkgRequire.3 Tcl_PkgProvide.3
+fi
+if test -r Preserve.3; then
+    rm -f Tcl_Preserve.3
+    ln Preserve.3 Tcl_Preserve.3
+fi
+if test -r Preserve.3; then
+    rm -f Tcl_Release.3
+    ln Preserve.3 Tcl_Release.3
+fi
+if test -r Preserve.3; then
+    rm -f Tcl_EventuallyFree.3
+    ln Preserve.3 Tcl_EventuallyFree.3
+fi
+if test -r PrintDbl.3; then
+    rm -f Tcl_PrintDouble.3
+    ln PrintDbl.3 Tcl_PrintDouble.3
+fi
+if test -r RecEvalObj.3; then
+    rm -f Tcl_RecordAndEvalObj.3
+    ln RecEvalObj.3 Tcl_RecordAndEvalObj.3
+fi
+if test -r RecordEval.3; then
+    rm -f Tcl_RecordAndEval.3
+    ln RecordEval.3 Tcl_RecordAndEval.3
+fi
+if test -r RegExp.3; then
+    rm -f Tcl_RegExpMatch.3
+    ln RegExp.3 Tcl_RegExpMatch.3
+fi
+if test -r RegExp.3; then
+    rm -f Tcl_RegExpCompile.3
+    ln RegExp.3 Tcl_RegExpCompile.3
+fi
+if test -r RegExp.3; then
+    rm -f Tcl_RegExpExec.3
+    ln RegExp.3 Tcl_RegExpExec.3
+fi
+if test -r RegExp.3; then
+    rm -f Tcl_RegExpRange.3
+    ln RegExp.3 Tcl_RegExpRange.3
+fi
+if test -r SetErrno.3; then
+    rm -f Tcl_SetErrno.3
+    ln SetErrno.3 Tcl_SetErrno.3
+fi
+if test -r SetErrno.3; then
+    rm -f Tcl_GetErrno.3
+    ln SetErrno.3 Tcl_GetErrno.3
+fi
+if test -r SetRecLmt.3; then
+    rm -f Tcl_SetRecursionLimit.3
+    ln SetRecLmt.3 Tcl_SetRecursionLimit.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_SetObjResult.3
+    ln SetResult.3 Tcl_SetObjResult.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_GetObjResult.3
+    ln SetResult.3 Tcl_GetObjResult.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_SetResult.3
+    ln SetResult.3 Tcl_SetResult.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_GetStringResult.3
+    ln SetResult.3 Tcl_GetStringResult.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_AppendResult.3
+    ln SetResult.3 Tcl_AppendResult.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_AppendElement.3
+    ln SetResult.3 Tcl_AppendElement.3
+fi
+if test -r SetResult.3; then
+    rm -f Tcl_ResetResult.3
+    ln SetResult.3 Tcl_ResetResult.3
+fi
+if test -r SetVar.3; then
+    rm -f Tcl_SetVar.3
+    ln SetVar.3 Tcl_SetVar.3
+fi
+if test -r SetVar.3; then
+    rm -f Tcl_SetVar2.3
+    ln SetVar.3 Tcl_SetVar2.3
+fi
+if test -r SetVar.3; then
+    rm -f Tcl_GetVar.3
+    ln SetVar.3 Tcl_GetVar.3
+fi
+if test -r SetVar.3; then
+    rm -f Tcl_GetVar2.3
+    ln SetVar.3 Tcl_GetVar2.3
+fi
+if test -r SetVar.3; then
+    rm -f Tcl_UnsetVar.3
+    ln SetVar.3 Tcl_UnsetVar.3
+fi
+if test -r SetVar.3; then
+    rm -f Tcl_UnsetVar2.3
+    ln SetVar.3 Tcl_UnsetVar2.3
+fi
+if test -r Sleep.3; then
+    rm -f Tcl_Sleep.3
+    ln Sleep.3 Tcl_Sleep.3
+fi
+if test -r SplitList.3; then
+    rm -f Tcl_SplitList.3
+    ln SplitList.3 Tcl_SplitList.3
+fi
+if test -r SplitList.3; then
+    rm -f Tcl_Merge.3
+    ln SplitList.3 Tcl_Merge.3
+fi
+if test -r SplitList.3; then
+    rm -f Tcl_ScanElement.3
+    ln SplitList.3 Tcl_ScanElement.3
+fi
+if test -r SplitList.3; then
+    rm -f Tcl_ConvertElement.3
+    ln SplitList.3 Tcl_ConvertElement.3
+fi
+if test -r SplitPath.3; then
+    rm -f Tcl_SplitPath.3
+    ln SplitPath.3 Tcl_SplitPath.3
+fi
+if test -r SplitPath.3; then
+    rm -f Tcl_JoinPath.3
+    ln SplitPath.3 Tcl_JoinPath.3
+fi
+if test -r SplitPath.3; then
+    rm -f Tcl_GetPathType.3
+    ln SplitPath.3 Tcl_GetPathType.3
+fi
+if test -r StaticPkg.3; then
+    rm -f Tcl_StaticPackage.3
+    ln StaticPkg.3 Tcl_StaticPackage.3
+fi
+if test -r StrMatch.3; then
+    rm -f Tcl_StringMatch.3
+    ln StrMatch.3 Tcl_StringMatch.3
+fi
+if test -r StringObj.3; then
+    rm -f Tcl_NewStringObj.3
+    ln StringObj.3 Tcl_NewStringObj.3
+fi
+if test -r StringObj.3; then
+    rm -f Tcl_SetStringObj.3
+    ln StringObj.3 Tcl_SetStringObj.3
+fi
+if test -r StringObj.3; then
+    rm -f Tcl_GetStringFromObj.3
+    ln StringObj.3 Tcl_GetStringFromObj.3
+fi
+if test -r StringObj.3; then
+    rm -f Tcl_AppendToObj.3
+    ln StringObj.3 Tcl_AppendToObj.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_SetObjLength.3
+    ln StringObj.3 Tcl_SetObjLength.3
+fi
+if test -r StringObj.3; then
+    rm -f TclConcatObj.3
+    ln StringObj.3 TclConcatObj.3
+fi
+if test -r TraceVar.3; then
+    rm -f Tcl_TraceVar.3
+    ln TraceVar.3 Tcl_TraceVar.3
+fi
+if test -r TraceVar.3; then
+    rm -f Tcl_TraceVar2.3
+    ln TraceVar.3 Tcl_TraceVar2.3
+fi
+if test -r TraceVar.3; then
+    rm -f Tcl_UntraceVar.3
+    ln TraceVar.3 Tcl_UntraceVar.3
+fi
+if test -r TraceVar.3; then
+    rm -f Tcl_UntraceVar2.3
+    ln TraceVar.3 Tcl_UntraceVar2.3
+fi
+if test -r TraceVar.3; then
+    rm -f Tcl_VarTraceInfo.3
+    ln TraceVar.3 Tcl_VarTraceInfo.3
+fi
+if test -r TraceVar.3; then
+    rm -f Tcl_VarTraceInfo2.3
+    ln TraceVar.3 Tcl_VarTraceInfo2.3
+fi
+if test -r Translate.3; then
+    rm -f Tcl_TranslateFileName.3
+    ln Translate.3 Tcl_TranslateFileName.3
+fi
+if test -r UpVar.3; then
+    rm -f Tcl_UpVar.3
+    ln UpVar.3 Tcl_UpVar.3
+fi
+if test -r UpVar.3; then
+    rm -f Tcl_UpVar2.3
+    ln UpVar.3 Tcl_UpVar2.3
+fi
+if test -r WrongNumArgs.3; then
+    rm -f Tcl_WrongNumArgs.3
+    ln WrongNumArgs.3 Tcl_WrongNumArgs.3
+fi
+if test -r http.n; then
+    rm -f Http.n
+    ln http.n Http.n
+fi
+if test -r pkgMkIndex.n; then
+    rm -f pkg_mkIndex.n
+    ln pkgMkIndex.n pkg_mkIndex.n
+fi
+if test -r safe.n; then
+    rm -f SafeBase.n
+    ln safe.n SafeBase.n
+fi
+exit 0
diff --git a/tcl/unix/tclAppInit.c b/tcl/unix/tclAppInit.c
new file mode 100644
index 00000000000..99abc5eb4f2
--- /dev/null
+++ b/tcl/unix/tclAppInit.c
@@ -0,0 +1,143 @@
+/* 
+ * tclAppInit.c --
+ *
+ *	Provides a default version of the main program and Tcl_AppInit
+ *	procedure for Tcl applications (without Tk).
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifdef TCL_XT_TEST
+#include <X11/Intrinsic.h>
+#endif
+
+#include "tcl.h"
+
+/*
+ * The following variable is a special hack that is needed in order for
+ * Sun shared libraries to be used for Tcl.
+ */
+
+extern int matherr();
+int *tclDummyMathPtr = (int *) matherr;
+
+
+#ifdef TCL_TEST
+EXTERN int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+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
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	This is the main program for the application.
+ *
+ * Results:
+ *	None: Tcl_Main never returns here, so this procedure never
+ *	returns either.
+ *
+ * Side effects:
+ *	Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ *	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
+Tcl_AppInit(interp)
+    Tcl_Interp *interp;		/* Interpreter for application. */
+{
+    if (Tcl_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+#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;
+    }
+    if (Procbodytest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
+            Procbodytest_SafeInit);
+#endif /* TCL_TEST */
+
+    /*
+     * Call the init procedures for included packages.  Each call should
+     * look like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module.
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if
+     * they weren't already created by the init procedures called above.
+     */
+
+    /*
+     * Specify a user-specific startup file to invoke if the application
+     * is run interactively.  Typically the startup file is "~/.apprc"
+     * where "app" is the name of the application.  If this line is deleted
+     * then no user-specific startup file will be run under any conditions.
+     */
+
+    Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
+    return TCL_OK;
+}
diff --git a/tcl/unix/tclConfig.sh.in b/tcl/unix/tclConfig.sh.in
new file mode 100644
index 00000000000..c005c2e9995
--- /dev/null
+++ b/tcl/unix/tclConfig.sh.in
@@ -0,0 +1,133 @@
+# tclConfig.sh --
+# 
+# This shell script (for sh) is generated automatically by Tcl's
+# configure script.  It will create shell variables for most of
+# the configuration options discovered by the configure script.
+# This script is intended to be included by the configure scripts
+# for Tcl extensions so that they don't have to figure this all
+# out for themselves.
+#
+# The information in this file is specific to a single platform.
+#
+# RCS: @(#) $Id$
+
+# 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@'
+
+# -D flags for use with the C compiler.
+TCL_DEFS='@DEFS@'
+
+# If TCL was built with debugging symbols, generated libraries contain
+# this string at the end of the library name (before the extension).
+TCL_DBGX=@TCL_DBGX@
+
+# Default flags used in an optimized and debuggable build, respectively.
+TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
+TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'
+
+# Flag, 1: we built a shared lib, 0 we didn't
+TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
+
+# The name of the Tcl library (may be either a .a file or a shared library):
+TCL_LIB_FILE='@TCL_LIB_FILE@'
+
+# The fullpath of the Tcl library (used for dependency checking)
+TCL_LIB_FULL_PATH='@TCL_LIB_FULL_PATH@'
+
+# Additional libraries to use when linking Tcl.
+TCL_LIBS='@DL_LIBS@ @LIBS@ @MATH_LIBS@'
+
+# Top-level directory in which Tcl's platform-independent files are
+# installed.
+TCL_PREFIX='@prefix@'
+
+# Top-level directory in which Tcl's platform-specific files (e.g.
+# executables) are installed.
+TCL_EXEC_PREFIX='@exec_prefix@'
+
+# Flags to pass to cc when compiling the components of a shared library:
+TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@'
+
+# Extra flags to pass to cc:
+TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@'
+
+# Base command to use for combining object files into a shared library:
+TCL_SHLIB_LD='@SHLIB_LD@'
+
+# Either '$LIBS' (if dependent libraries should be included when linking
+# shared libraries) or an empty string.  See Tcl's configure.in for more
+# explanation.
+TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
+
+# Suffix to use for the name of a shared library.
+TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
+
+# Library file(s) to include in tclsh and other base applications
+# in order to provide facilities needed by DLOBJ above.
+TCL_DL_LIBS='@DL_LIBS@'
+
+# Flags to pass to the compiler when linking object files into
+# an executable tclsh or tcltest binary.
+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_RUNTIME_DIR" defined in the Makefile.
+TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
+
+# Additional object files linked with Tcl to provide compatibility
+# with standard facilities from ANSI C or POSIX.
+TCL_COMPAT_OBJS='@LIBOBJS@'
+
+# Name of the ranlib program to use.
+TCL_RANLIB='@RANLIB@'
+
+# -l flag to pass to the linker to pick up the Tcl library
+TCL_LIB_FLAG='@TCL_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tcl library from its
+# build directory.
+TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tcl library from its
+# installed directory.
+TCL_LIB_SPEC='@TCL_LIB_SPEC@'
+
+# Indicates whether a version numbers should be used in -l switches
+# ("ok" means it's safe to use switches like -ltcl7.5;  "nodots" means
+# use switches like -ltcl75).  SunOS and FreeBSD require "nodots", for
+# example.
+TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@'
+
+# String that can be evaluated to generate the part of a shared library
+# name that comes after the "libxxx" (includes version number, if any,
+# extension, and anything else needed).  May depend on the variables
+# VERSION and SHLIB_SUFFIX.  On most UNIX systems this is
+# ${VERSION}${SHLIB_SUFFIX}.
+TCL_SHARED_LIB_SUFFIX='@TCL_SHARED_LIB_SUFFIX@'
+
+# String that can be evaluated to generate the part of an unshared library
+# name that comes after the "libxxx" (includes version number, if any,
+# 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/tcl/unix/tclLoadAix.c b/tcl/unix/tclLoadAix.c
new file mode 100644
index 00000000000..5d55f5a474e
--- /dev/null
+++ b/tcl/unix/tclLoadAix.c
@@ -0,0 +1,549 @@
+/* 
+ * tclLoadAix.c --
+ *
+ *	This file implements the dlopen and dlsym APIs under the
+ *	AIX operating system, to enable the Tcl "load" command to
+ *	work.  This code was provided by Jens-Uwe Mager.
+ *
+ *	This file is subject to the following copyright notice, which is
+ *	different from the notice used elsewhere in Tcl.  The file has
+ *	been modified to incorporate the file dlfcn.h in-line.
+ *
+ *	Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH
+ *	Not derived from licensed software.
+
+ *	Permission is granted to freely use, copy, modify, and redistribute
+ *	this software, provided that the author is not construed to be liable
+ *	for any results of using the software, alterations are clearly marked
+ *	as such, and this notice is not modified.
+ *
+ * RCS: @(#) $Id$
+ *
+ * Note:  this file has been altered from the original in a few
+ * ways in order to work properly with Tcl.
+ */
+
+/*
+ * @(#)dlfcn.c	1.7 revision of 95/08/14  19:08:38
+ * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
+ * 30159 Hannover, Germany
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/ldr.h>
+#include <a.out.h>
+#include <ldfcn.h>
+#include "../compat/dlfcn.h"
+
+/*
+ * We simulate dlopen() et al. through a call to load. Because AIX has
+ * no call to find an exported symbol we read the loader section of the
+ * loaded module and build a list of exported symbols and their virtual
+ * address.
+ */
+
+typedef struct {
+	char		*name;		/* the symbols's name */
+	void		*addr;		/* its relocated virtual address */
+} Export, *ExportPtr;
+
+/*
+ * xlC uses the following structure to list its constructors and
+ * destructors. This is gleaned from the output of munch.
+ */
+typedef struct {
+	void (*init)(void);		/* call static constructors */
+	void (*term)(void);		/* call static destructors */
+} Cdtor, *CdtorPtr;
+
+/*
+ * The void * handle returned from dlopen is actually a ModulePtr.
+ */
+typedef struct Module {
+	struct Module	*next;
+	char		*name;		/* module name for refcounting */
+	int		refCnt;		/* the number of references */
+	void		*entry;		/* entry point from load */
+	struct dl_info	*info;		/* optional init/terminate functions */
+	CdtorPtr	cdtors;		/* optional C++ constructors */
+	int		nExports;	/* the number of exports found */
+	ExportPtr	exports;	/* the array of exports */
+} Module, *ModulePtr;
+
+/*
+ * We keep a list of all loaded modules to be able to call the fini
+ * handlers and destructors at atexit() time.
+ */
+static ModulePtr modList;
+
+/*
+ * The last error from one of the dl* routines is kept in static
+ * variables here. Each error is returned only once to the caller.
+ */
+static char errbuf[BUFSIZ];
+static int errvalid;
+
+static void caterr(char *);
+static int readExports(ModulePtr);
+static void terminate(void);
+static void *findMain(void);
+
+VOID *dlopen(const char *path, int mode)
+{
+	register ModulePtr mp;
+	static void *mainModule;
+
+	/*
+	 * Upon the first call register a terminate handler that will
+	 * close all libraries. Also get a reference to the main module
+	 * for use with loadbind.
+	 */
+	if (!mainModule) {
+		if ((mainModule = findMain()) == NULL)
+			return NULL;
+		atexit(terminate);
+	}
+	/*
+	 * Scan the list of modules if we have the module already loaded.
+	 */
+	for (mp = modList; mp; mp = mp->next)
+		if (strcmp(mp->name, path) == 0) {
+			mp->refCnt++;
+			return (VOID *) mp;
+		}
+	if ((mp = (ModulePtr)calloc(1, sizeof(*mp))) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "calloc: ");
+		strcat(errbuf, strerror(errno));
+		return (VOID *) NULL;
+	}
+	mp->name = malloc((unsigned) (strlen(path) + 1));
+	strcpy(mp->name, path);
+	/*
+	 * load should be declared load(const char *...). Thus we
+	 * cast the path to a normal char *. Ugly.
+	 */
+	if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
+		free(mp->name);
+		free(mp);
+		errvalid++;
+		strcpy(errbuf, "dlopen: ");
+		strcat(errbuf, path);
+		strcat(errbuf, ": ");
+		/*
+		 * If AIX says the file is not executable, the error
+		 * can be further described by querying the loader about
+		 * the last error.
+		 */
+		if (errno == ENOEXEC) {
+			char *tmp[BUFSIZ/sizeof(char *)];
+			if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
+				strcpy(errbuf, strerror(errno));
+			else {
+				char **p;
+				for (p = tmp; *p; p++)
+					caterr(*p);
+			}
+		} else
+			strcat(errbuf, strerror(errno));
+		return (VOID *) NULL;
+	}
+	mp->refCnt = 1;
+	mp->next = modList;
+	modList = mp;
+	if (loadbind(0, mainModule, mp->entry) == -1) {
+		dlclose(mp);
+		errvalid++;
+		strcpy(errbuf, "loadbind: ");
+		strcat(errbuf, strerror(errno));
+		return (VOID *) NULL;
+	}
+	/*
+	 * If the user wants global binding, loadbind against all other
+	 * loaded modules.
+	 */
+	if (mode & RTLD_GLOBAL) {
+		register ModulePtr mp1;
+		for (mp1 = mp->next; mp1; mp1 = mp1->next)
+			if (loadbind(0, mp1->entry, mp->entry) == -1) {
+				dlclose(mp);
+				errvalid++;
+				strcpy(errbuf, "loadbind: ");
+				strcat(errbuf, strerror(errno));
+				return (VOID *) NULL;
+			}
+	}
+	if (readExports(mp) == -1) {
+		dlclose(mp);
+		return (VOID *) NULL;
+	}
+	/*
+	 * If there is a dl_info structure, call the init function.
+	 */
+	if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) {
+		if (mp->info->init)
+			(*mp->info->init)();
+	} else
+		errvalid = 0;
+	/*
+	 * If the shared object was compiled using xlC we will need
+	 * to call static constructors (and later on dlclose destructors).
+	 */
+	if (mp->cdtors = (CdtorPtr)dlsym(mp, "__cdtors")) {
+		while (mp->cdtors->init) {
+			(*mp->cdtors->init)();
+			mp->cdtors++;
+		}
+	} else
+		errvalid = 0;
+	return (VOID *) mp;
+}
+
+/*
+ * Attempt to decipher an AIX loader error message and append it
+ * to our static error message buffer.
+ */
+static void caterr(char *s)
+{
+	register char *p = s;
+
+	while (*p >= '0' && *p <= '9')
+		p++;
+	switch(atoi(s)) {
+	case L_ERROR_TOOMANY:
+		strcat(errbuf, "to many errors");
+		break;
+	case L_ERROR_NOLIB:
+		strcat(errbuf, "can't load library");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_UNDEF:
+		strcat(errbuf, "can't find symbol");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_RLDBAD:
+		strcat(errbuf, "bad RLD");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_FORMAT:
+		strcat(errbuf, "bad exec format in");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_ERRNO:
+		strcat(errbuf, strerror(atoi(++p)));
+		break;
+	default:
+		strcat(errbuf, s);
+		break;
+	}
+}
+
+VOID *dlsym(void *handle, const char *symbol)
+{
+	register ModulePtr mp = (ModulePtr)handle;
+	register ExportPtr ep;
+	register int i;
+
+	/*
+	 * Could speed up the search, but I assume that one assigns
+	 * the result to function pointers anyways.
+	 */
+	for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
+		if (strcmp(ep->name, symbol) == 0)
+			return ep->addr;
+	errvalid++;
+	strcpy(errbuf, "dlsym: undefined symbol ");
+	strcat(errbuf, symbol);
+	return NULL;
+}
+
+char *dlerror(void)
+{
+	if (errvalid) {
+		errvalid = 0;
+		return errbuf;
+	}
+	return NULL;
+}
+
+int dlclose(void *handle)
+{
+	register ModulePtr mp = (ModulePtr)handle;
+	int result;
+	register ModulePtr mp1;
+
+	if (--mp->refCnt > 0)
+		return 0;
+	if (mp->info && mp->info->fini)
+		(*mp->info->fini)();
+	if (mp->cdtors)
+		while (mp->cdtors->term) {
+			(*mp->cdtors->term)();
+			mp->cdtors++;
+		}
+	result = unload(mp->entry);
+	if (result == -1) {
+		errvalid++;
+		strcpy(errbuf, strerror(errno));
+	}
+	if (mp->exports) {
+		register ExportPtr ep;
+		register int i;
+		for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
+			if (ep->name)
+				free(ep->name);
+		free(mp->exports);
+	}
+	if (mp == modList)
+		modList = mp->next;
+	else {
+		for (mp1 = modList; mp1; mp1 = mp1->next)
+			if (mp1->next == mp) {
+				mp1->next = mp->next;
+				break;
+			}
+	}
+	free(mp->name);
+	free(mp);
+	return result;
+}
+
+static void terminate(void)
+{
+	while (modList)
+		dlclose(modList);
+}
+
+/*
+ * Build the export table from the XCOFF .loader section.
+ */
+static int readExports(ModulePtr mp)
+{
+	LDFILE *ldp = NULL;
+	SCNHDR sh, shdata;
+	LDHDR *lhp;
+	char *ldbuf;
+	LDSYM *ls;
+	int i;
+	ExportPtr ep;
+
+	if ((ldp = ldopen(mp->name, ldp)) == NULL) {
+		struct ld_info *lp;
+		char *buf;
+		int size = 4*1024;
+		if (errno != ENOENT) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strcat(errbuf, strerror(errno));
+			return -1;
+		}
+		/*
+		 * The module might be loaded due to the LIBPATH
+		 * environment variable. Search for the loaded
+		 * module using L_GETINFO.
+		 */
+		if ((buf = malloc(size)) == NULL) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strcat(errbuf, strerror(errno));
+			return -1;
+		}
+		while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+			free(buf);
+			size += 4*1024;
+			if ((buf = malloc(size)) == NULL) {
+				errvalid++;
+				strcpy(errbuf, "readExports: ");
+				strcat(errbuf, strerror(errno));
+				return -1;
+			}
+		}
+		if (i == -1) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strcat(errbuf, strerror(errno));
+			free(buf);
+			return -1;
+		}
+		/*
+		 * Traverse the list of loaded modules. The entry point
+		 * returned by load() does actually point to the data
+		 * segment origin.
+		 */
+		lp = (struct ld_info *)buf;
+		while (lp) {
+			if (lp->ldinfo_dataorg == mp->entry) {
+				ldp = ldopen(lp->ldinfo_filename, ldp);
+				break;
+			}
+			if (lp->ldinfo_next == 0)
+				lp = NULL;
+			else
+				lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
+		}
+		free(buf);
+		if (!ldp) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strcat(errbuf, strerror(errno));
+			return -1;
+		}
+	}
+	if (TYPE(ldp) != U802TOCMAGIC) {
+		errvalid++;
+		strcpy(errbuf, "readExports: bad magic");
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	/*
+	 * Get the padding for the data section. This is needed for
+	 * AIX 4.1 compilers. This is used when building the final
+	 * function pointer to the exported symbol.
+	 */
+	if (ldnshread(ldp, _DATA, &shdata) != SUCCESS) {
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot read data section header");
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot read loader section header");
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	/*
+	 * We read the complete loader section in one chunk, this makes
+	 * finding long symbol names residing in the string table easier.
+	 */
+	if ((ldbuf = (char *)malloc(sh.s_size)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "readExports: ");
+		strcat(errbuf, strerror(errno));
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot seek to loader section");
+		free(ldbuf);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot read loader section");
+		free(ldbuf);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	lhp = (LDHDR *)ldbuf;
+	ls = (LDSYM *)(ldbuf+LDHDRSZ);
+	/*
+	 * Count the number of exports to include in our export table.
+	 */
+	for (i = lhp->l_nsyms; i; i--, ls++) {
+		if (!LDR_EXPORT(*ls))
+			continue;
+		mp->nExports++;
+	}
+	if ((mp->exports = (ExportPtr)calloc(mp->nExports, sizeof(*mp->exports))) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "readExports: ");
+		strcat(errbuf, strerror(errno));
+		free(ldbuf);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	/*
+	 * Fill in the export table. All entries are relative to
+	 * the entry point we got from load.
+	 */
+	ep = mp->exports;
+	ls = (LDSYM *)(ldbuf+LDHDRSZ);
+	for (i = lhp->l_nsyms; i; i--, ls++) {
+		char *symname;
+		char tmpsym[SYMNMLEN+1];
+		if (!LDR_EXPORT(*ls))
+			continue;
+		if (ls->l_zeroes == 0)
+			symname = ls->l_offset+lhp->l_stoff+ldbuf;
+		else {
+			/*
+			 * The l_name member is not zero terminated, we
+			 * must copy the first SYMNMLEN chars and make
+			 * sure we have a zero byte at the end.
+			 */
+			strncpy(tmpsym, ls->l_name, SYMNMLEN);
+			tmpsym[SYMNMLEN] = '\0';
+			symname = tmpsym;
+		}
+		ep->name = malloc((unsigned) (strlen(symname) + 1));
+		strcpy(ep->name, symname);
+		ep->addr = (void *)((unsigned long)mp->entry +
+					ls->l_value - shdata.s_vaddr);
+		ep++;
+	}
+	free(ldbuf);
+	while(ldclose(ldp) == FAILURE)
+		;
+	return 0;
+}
+
+/*
+ * Find the main modules entry point. This is used as export pointer
+ * for loadbind() to be able to resolve references to the main part.
+ */
+static void * findMain(void)
+{
+	struct ld_info *lp;
+	char *buf;
+	int size = 4*1024;
+	int i;
+	void *ret;
+
+	if ((buf = malloc(size)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strcat(errbuf, strerror(errno));
+		return NULL;
+	}
+	while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+		free(buf);
+		size += 4*1024;
+		if ((buf = malloc(size)) == NULL) {
+			errvalid++;
+			strcpy(errbuf, "findMain: ");
+			strcat(errbuf, strerror(errno));
+			return NULL;
+		}
+	}
+	if (i == -1) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strcat(errbuf, strerror(errno));
+		free(buf);
+		return NULL;
+	}
+	/*
+	 * The first entry is the main module. The entry point
+	 * returned by load() does actually point to the data
+	 * segment origin.
+	 */
+	lp = (struct ld_info *)buf;
+	ret = lp->ldinfo_dataorg;
+	free(buf);
+	return ret;
+}
+
diff --git a/tcl/unix/tclLoadAout.c b/tcl/unix/tclLoadAout.c
new file mode 100644
index 00000000000..b10b3394f13
--- /dev/null
+++ b/tcl/unix/tclLoadAout.c
@@ -0,0 +1,470 @@
+/* 
+ * tclLoadAout.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that
+ *	provides pseudo-static linking using version-7 compatible
+ *	a.out files described in either sys/exec.h or sys/a.out.h.
+ *
+ * Copyright (c) 1995, by General Electric Company. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This work was supported in part by the ARPA Manufacturing Automation
+ * and Design Engineering (MADE) Initiative through ARPA contract
+ * F33615-94-C-4400.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include <fcntl.h>
+#ifdef HAVE_EXEC_AOUT_H
+#   include <sys/exec_aout.h>
+#endif
+
+/*
+ * Some systems describe the a.out header in sys/exec.h, and some in
+ * a.out.h.
+ */
+
+#ifdef USE_SYS_EXEC_H
+#include <sys/exec.h>
+#endif
+#ifdef USE_A_OUT_H
+#include <a.out.h>
+#endif
+#ifdef USE_SYS_EXEC_AOUT_H
+#include <sys/exec_aout.h>
+#define a_magic a_midmag
+#endif
+
+/*
+ * TCL_LOADSHIM is the amount by which to shim the break when loading
+ */
+
+#ifndef TCL_LOADSHIM
+#define TCL_LOADSHIM 0x4000L
+#endif
+
+/*
+ * TCL_LOADALIGN must be a power of 2, and is the alignment to which
+ * to force the origin of load modules
+ */
+
+#ifndef TCL_LOADALIGN
+#define TCL_LOADALIGN 0x4000L
+#endif
+
+/*
+ * TCL_LOADMAX is the maximum size of a load module, and is used as
+ * a sanity check when loading
+ */
+
+#ifndef TCL_LOADMAX
+#define TCL_LOADMAX 2000000L
+#endif
+
+/*
+ * Kernel calls that appear to be missing from the system .h files:
+ */
+
+extern char * brk _ANSI_ARGS_((char *));
+extern char * sbrk _ANSI_ARGS_((size_t));
+
+/*
+ * The static variable SymbolTableFile contains the file name where the
+ * result of the last link was stored.  The file is kept because doing so
+ * allows one load module to use the symbols defined in another.
+ */
+
+static char * SymbolTableFile = NULL;
+
+/*
+ * Type of the dictionary function that begins each load module.
+ */
+
+typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((char * symbol));
+
+/*
+ * Prototypes for procedures referenced only in this file:
+ */
+
+static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, char * fileName,
+				      Tcl_DString * buf));
+static void UnlinkSymbolTable _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
+ *	are filled in with the addresses of the symbols given by
+ *	*sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *
+ * Bugs:
+ *	This function does not attempt to handle the case where the
+ *	BSS segment is not executable.  It will therefore fail on
+ *	Encore Multimax, Pyramid 90x, and similar machines.  The
+ *	reason is that the mprotect() kernel call, which would
+ *	otherwise be employed to mark the newly-loaded text segment
+ *	executable, results in a system crash on BSD/386.
+ *
+ *	In an effort to make it fast, this function eschews the
+ *	technique of linking the load module once, reading its header
+ *	to determine its size, allocating memory for it, and linking
+ *	it again.  Instead, it `shims out' memory allocation by
+ *	placing the module TCL_LOADSHIM bytes beyond the break,
+ *	and assuming that any malloc() calls required to run the
+ *	linker will not advance the break beyond that point.  If
+ *	the break is advanced beyonnd that point, the load will
+ *	fail with an `inconsistent memory allocation' error.
+ *	It perhaps ought to retry the link, but the failure has
+ *	not been observed in two years of daily use of this function.
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+  char * inputSymbolTable;	/* Name of the file containing the 
+				 * symbol table from the last link. */
+  Tcl_DString linkCommandBuf;	/* Command to do the run-time relocation
+				 * of the module.*/
+  char * linkCommand;
+  char relocatedFileName [L_tmpnam];
+				/* Name of the file holding the relocated */
+				/* text of the module */
+  int relocatedFd;		/* File descriptor of the file holding
+				 * relocated text */
+  struct exec relocatedHead;	/* Header of the relocated text */
+  unsigned long relocatedSize;	/* Size of the relocated text */
+  char * startAddress;		/* Starting address of the module */
+  DictFn dictionary;		/* Dictionary function in the load module */
+  int status;			/* Status return from Tcl_ calls */
+  char * p;
+
+  /* Find the file that contains the symbols for the run-time link. */
+
+  if (SymbolTableFile != NULL) {
+    inputSymbolTable = SymbolTableFile;
+  } else if (tclExecutableName == NULL) {
+    Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC);
+    return TCL_ERROR;
+  } else {
+    inputSymbolTable = tclExecutableName;
+  }
+
+  /* Construct the `ld' command that builds the relocated module */
+
+  tmpnam (relocatedFileName);
+  Tcl_DStringInit (&linkCommandBuf);
+  Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);
+  Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);
+#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);
+  Tcl_DStringAppend (&linkCommandBuf, fileName, -1);
+  Tcl_DStringAppend (&linkCommandBuf, " ", -1);
+  if (FindLibraries (interp, fileName, &linkCommandBuf) != TCL_OK) {
+    Tcl_DStringFree (&linkCommandBuf);
+    return TCL_ERROR;
+  }
+  linkCommand = Tcl_DStringValue (&linkCommandBuf);
+
+  /* Determine the starting address, and plug it into the command */
+  
+  startAddress = (char *) (((unsigned long) sbrk (0)
+			    + TCL_LOADSHIM + TCL_LOADALIGN - 1)
+			   & (- TCL_LOADALIGN));
+  p = strstr (linkCommand, "-T") + 3;
+  sprintf (p, "%08lx", (long) startAddress);
+  p [8] = ' ';
+
+  /* Run the linker */
+
+  status = Tcl_Eval (interp, linkCommand);
+  Tcl_DStringFree (&linkCommandBuf);
+  if (status != 0) {
+    return TCL_ERROR;
+  }
+
+  /* Open the linker's result file and read the header */
+
+  relocatedFd = open (relocatedFileName, O_RDONLY);
+  if (relocatedFd < 0) {
+    goto ioError;
+  }
+  status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);
+  if (status < sizeof relocatedHead) {
+    goto ioError;
+  }
+
+  /* Check the magic number */
+
+  if (relocatedHead.a_magic != OMAGIC) {
+    Tcl_AppendResult (interp, "bad magic number in intermediate file \"",
+		      relocatedFileName, "\"", (char *) NULL);
+    goto failure;
+  }
+
+  /* Make sure that memory allocation is still consistent */
+
+  if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {
+    Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.",
+		   TCL_STATIC);
+    goto failure;
+  }
+
+  /* Make sure that the relocated module's size is reasonable */
+
+  relocatedSize = relocatedHead.a_text + relocatedHead.a_data
+    + relocatedHead.a_bss;
+  if (relocatedSize > TCL_LOADMAX) {
+    Tcl_SetResult (interp, "module too big to load", TCL_STATIC);
+    goto failure;
+  }
+
+  /* Advance the break to protect the loaded module */
+
+  (void) brk (startAddress + relocatedSize);
+
+  /* Seek to the start of the module's text */
+
+#if defined(__mips) || defined(mips)
+  status = lseek (relocatedFd,
+		  N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
+		  SEEK_SET);
+#else
+  status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);
+#endif
+  if (status < 0) {
+    goto ioError;
+  }
+
+  /* Read in the module's text and data */
+
+  relocatedSize = relocatedHead.a_text + relocatedHead.a_data;
+  if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {
+    brk (startAddress);
+  ioError:
+    Tcl_AppendResult (interp, "error on intermediate file \"",
+		      relocatedFileName, "\": ", Tcl_PosixError (interp),
+		      (char *) NULL);
+  failure:
+    (void) unlink (relocatedFileName);
+    return TCL_ERROR;
+  }
+
+  /* Close the intermediate file. */
+
+  (void) close (relocatedFd);
+
+  /* Arrange things so that intermediate symbol tables eventually get
+   * deleted. */
+
+  if (SymbolTableFile != NULL) {
+    UnlinkSymbolTable ();
+  } else {
+    atexit (UnlinkSymbolTable);
+  }
+  SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
+  strcpy (SymbolTableFile, relocatedFileName);
+  
+  /* Look up the entry points in the load module's dictionary. */
+
+  dictionary = (DictFn) startAddress;
+  *proc1Ptr = dictionary (sym1);
+  *proc2Ptr = dictionary (sym2);
+
+  return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * FindLibraries --
+ *
+ *	Find the libraries needed to link a load module at run time.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs,
+ *	an error message is left in interp->result.  The -l and -L flags
+ *	are concatenated onto the dynamic string `buf'.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static int
+FindLibraries (interp, fileName, buf)
+     Tcl_Interp * interp;	/* Used for error reporting */
+     char * fileName;		/* Name of the load module */
+     Tcl_DString * buf;		/* Buffer where the -l an -L flags */
+{
+  FILE * f;			/* The load module */
+  int c;			/* Byte from the load module */
+  char * p;
+
+  /* Open the load module */
+
+  if ((f = fopen (fileName, "rb")) == NULL) {
+    Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ",
+		      Tcl_PosixError (interp), (char *) NULL);
+    return TCL_ERROR;
+  }
+
+  /* Search for the library list in the load module */
+
+  p = "@LIBS: ";
+  while (*p != '\0' && (c = getc (f)) != EOF) {
+    if (c == *p) {
+      ++p;
+    }
+    else {
+      p = "@LIBS: ";
+      if (c == *p) {
+	++p;
+      }
+    }
+  }
+
+  /* No library list -- this must be an ill-formed module */
+
+  if (c == EOF) {
+    Tcl_AppendResult (interp, "File \"", fileName,
+		      "\" is not a Tcl load module.", (char *) NULL);
+    (void) fclose (f);
+    return TCL_ERROR;
+  }
+
+  /* Accumulate the library list */
+
+  while ((c = getc (f)) != '\0' && c != EOF) {
+    char cc = c;
+    Tcl_DStringAppend (buf, &cc, 1);
+  }
+  (void) fclose (f);
+
+  if (c == EOF) {
+    Tcl_AppendResult (interp, "Library directory in \"", fileName,
+		      "\" ends prematurely.", (char *) NULL);
+    return TCL_ERROR;
+  }
+
+  return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * UnlinkSymbolTable --
+ *
+ *	Remove the symbol table file from the last dynamic link.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The symbol table file from the last dynamic link is removed.
+ *	This function is called when (a) a new symbol table is present
+ *	because another dynamic link is complete, or (b) the process
+ *	is exiting.
+ *------------------------------------------------------------------------
+ */
+
+static void
+UnlinkSymbolTable ()
+{
+  (void) unlink (SymbolTableFile);
+  ckfree (SymbolTableFile);
+  SymbolTableFile = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    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/tcl/unix/tclLoadDl.c b/tcl/unix/tclLoadDl.c
new file mode 100644
index 00000000000..af6cc57f4f0
--- /dev/null
+++ b/tcl/unix/tclLoadDl.c
@@ -0,0 +1,135 @@
+/* 
+ * tclLoadDl.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that
+ *	works with the "dlopen" and "dlsym" library procedures for
+ *	dynamic loading.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#ifdef NO_DLFCN_H
+#   include "../compat/dlfcn.h"
+#else
+#   include <dlfcn.h>
+#endif
+
+/*
+ * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
+ * and this argument to dlopen must always be 1.  The RTLD_GLOBAL
+ * flag is needed on some systems (e.g. SCO and UnixWare) but doesn't
+ * exist on others;  if it doesn't exist, set it to 0 so it has no effect.
+ */
+
+#ifndef RTLD_NOW
+#   define RTLD_NOW 1
+#endif
+
+#ifndef RTLD_GLOBAL
+#   define RTLD_GLOBAL 0
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
+ *	are filled in with the addresses of the symbols given by
+ *	*sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    VOID *handle;
+    Tcl_DString newName;
+
+    handle = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
+    if (handle == NULL) {
+	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+		"\": ", dlerror(), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /* 
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/unix/tclLoadDld.c b/tcl/unix/tclLoadDld.c
new file mode 100644
index 00000000000..584e07ed11d
--- /dev/null
+++ b/tcl/unix/tclLoadDld.c
@@ -0,0 +1,125 @@
+/* 
+ * tclLoadDld.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that
+ *	works with the "dld_link" and "dld_get_func" library procedures
+ *	for dynamic loading.  It has been tested on Linux 1.1.95 and
+ *	dld-3.2.7.  This file probably isn't needed anymore, since it
+ *	makes more sense to use "dl_open" etc.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "dld.h"
+
+/*
+ * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
+ * and this argument to dlopen must always be 1.
+ */
+
+#ifndef RTLD_NOW
+#   define RTLD_NOW 1
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
+ *	are filled in with the addresses of the symbols given by
+ *	*sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    static int firstTime = 1;
+    int returnCode;
+
+    /*
+     *  The dld package needs to know the pathname to the tcl binary.
+     *  If that's not know, return an error.
+     */
+
+    if (firstTime) {
+	if (tclExecutableName == NULL) {
+	    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);
+	if (returnCode != 0) {
+	    Tcl_AppendResult(interp,
+		    "initialization failed for dynamic loader: ",
+		    dld_strerror(returnCode), (char *) NULL);
+	    return TCL_ERROR;
+	}
+	firstTime = 0;
+    }
+
+    if ((returnCode = dld_link(fileName)) != 0) {
+	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+	    "\": ", dld_strerror(returnCode), (char *) NULL);
+	return TCL_ERROR;
+    }
+    *proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
+    *proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/unix/tclLoadNext.c b/tcl/unix/tclLoadNext.c
new file mode 100644
index 00000000000..fb7fa8b8601
--- /dev/null
+++ b/tcl/unix/tclLoadNext.c
@@ -0,0 +1,111 @@
+/* 
+ * tclLoadNext.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that
+ *	works with NeXTs rld_* dynamic loading.  This file provided
+ *	by Pedja Bogdanovich.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include <mach-o/rld.h>
+#include <streams/streams.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
+ *	are filled in with the addresses of the symbols given by
+ *	*sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+  struct mach_header *header;
+  char *data;
+  int len, maxlen;
+  char *files[]={fileName,NULL};
+  NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
+
+  if(!rld_load(errorStream,&header,files,NULL)) {
+    NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
+    Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
+    NXCloseMemory(errorStream,NX_FREEBUFFER);
+    return TCL_ERROR;
+  }
+  NXCloseMemory(errorStream,NX_FREEBUFFER);
+
+  *proc1Ptr=NULL;
+  if(sym1) {
+    char sym[strlen(sym1)+2];
+    sym[0]='_'; sym[1]=0; strcat(sym,sym1);
+    rld_lookup(NULL,sym,(unsigned long *)proc1Ptr);
+  }
+
+  *proc2Ptr=NULL;
+  if(sym2) {
+    char sym[strlen(sym2)+2];
+    sym[0]='_'; sym[1]=0; strcat(sym,sym2);
+    rld_lookup(NULL,sym,(unsigned long *)proc2Ptr);
+  }
+
+  return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/unix/tclLoadOSF.c b/tcl/unix/tclLoadOSF.c
new file mode 100644
index 00000000000..91be3f693bf
--- /dev/null
+++ b/tcl/unix/tclLoadOSF.c
@@ -0,0 +1,128 @@
+/* 
+ * tclLoadOSF.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that works
+ *	under OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1
+ *	/sbin/loader and /usr/include/loader.h.  OSF/1 versions from 1.3 and
+ *	on use ELF, rtld, and dlopen()[/usr/include/ldfcn.h].
+ *
+ *	This is useful for:
+ *		OSF/1 1.0, 1.1, 1.2 (from OSF)
+ *			includes: MK4 and AD1 (from OSF RI)
+ *		OSF/1 1.3 (from OSF) using ROSE
+ *		HP OSF/1 1.0 ("Acorn") using COFF
+ *
+ *	This is likely to be useful for:
+ *		Paragon OSF/1 (from Intel) 
+ *		HI-OSF/1 (from Hitachi) 
+ *
+ *	This is NOT to be used on:
+ *		Digitial Alpha OSF/1 systems
+ *		OSF/1 1.3 or later (from OSF) using ELF
+ *			includes: MK6, MK7, AD2, AD3 (from OSF RI)
+ *
+ *	This approach to things was utter @&^#; thankfully,
+ * 	OSF/1 eventually supported dlopen().
+ *
+ *	John Robert LoVerso <loverso@freebsd.osf.org>
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include <sys/types.h>
+#include <loader.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
+ *	are filled in with the addresses of the symbols given by
+ *	*sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    ldr_module_t lm;
+    char *pkg;
+
+    lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS);
+    if (lm == LDR_NULL_MODULE) {
+	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+	    "\": ", Tcl_PosixError (interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * My convention is to use a [OSF loader] package name the same as shlib,
+     * since the idiots never implemented ldr_lookup() and it is otherwise
+     * impossible to get a package name given a module.
+     *
+     * I build loadable modules with a makefile rule like 
+     *		ld ... -export $@: -o $@ $(OBJS)
+     */
+    if ((pkg = strrchr(fileName, '/')) == NULL)
+	pkg = fileName;
+    else
+	pkg++;
+    *proc1Ptr = ldr_lookup_package(pkg, sym1);
+    *proc2Ptr = ldr_lookup_package(pkg, sym2);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/unix/tclLoadShl.c b/tcl/unix/tclLoadShl.c
new file mode 100644
index 00000000000..ba527df3ba4
--- /dev/null
+++ b/tcl/unix/tclLoadShl.c
@@ -0,0 +1,129 @@
+/* 
+ * tclLoadShl.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that works
+ *	with the "shl_load" and "shl_findsym" library procedures for
+ *	dynamic loading (e.g. for HP machines).
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <dl.h>
+
+/*
+ * On some HP machines, dl.h defines EXTERN; remove that definition.
+ */
+
+#ifdef EXTERN
+#   undef EXTERN
+#endif
+
+#include "tcl.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
+ *	are filled in with the addresses of the symbols given by
+ *	*sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    shl_t handle;
+    Tcl_DString newName;
+
+    handle = shl_load(fileName, BIND_IMMEDIATE, 0L);
+    if (handle == NULL) {
+	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Some versions of the HP system software still use "_" at the
+     * beginning of exported symbols while others don't;  try both
+     * forms of each name.
+     */
+
+    if (shl_findsym(&handle, sym1, (short) TYPE_PROCEDURE, (void *) proc1Ptr)
+	    != 0) {
+	Tcl_DStringInit(&newName);
+	Tcl_DStringAppend(&newName, "_", 1);
+	Tcl_DStringAppend(&newName, sym1, -1);
+	if (shl_findsym(&handle, Tcl_DStringValue(&newName),
+		(short) TYPE_PROCEDURE, (void *) proc1Ptr) != 0) {
+	    *proc1Ptr = NULL;
+	}
+	Tcl_DStringFree(&newName);
+    }
+    if (shl_findsym(&handle, sym2, (short) TYPE_PROCEDURE, (void *) proc2Ptr)
+	    != 0) {
+	Tcl_DStringInit(&newName);
+	Tcl_DStringAppend(&newName, "_", 1);
+	Tcl_DStringAppend(&newName, sym2, -1);
+	if (shl_findsym(&handle, Tcl_DStringValue(&newName),
+		(short) TYPE_PROCEDURE, (void *) proc2Ptr) != 0) {
+	    *proc2Ptr = NULL;
+	}
+	Tcl_DStringFree(&newName);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/unix/tclMtherr.c b/tcl/unix/tclMtherr.c
new file mode 100644
index 00000000000..77c2d88685d
--- /dev/null
+++ b/tcl/unix/tclMtherr.c
@@ -0,0 +1,86 @@
+/* 
+ * tclMatherr.c --
+ *
+ *	This function provides a default implementation of the
+ *	"matherr" function, for SYS-V systems where it's needed.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include <math.h>
+
+#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 EDOM 33
+#define ERANGE 34
+#endif
+
+/*
+ * The following variable is secretly shared with Tcl so we can
+ * tell if expression evaluation is in progress.  If not, matherr
+ * just emulates the default behavior, which includes printing
+ * a message.
+ */
+
+extern int tcl_MathInProgress;
+
+/*
+ * The following definitions allow matherr to compile on systems
+ * that don't really support it.  The compiled procedure is bogus,
+ * but it will never be executed on these systems anyway.
+ */
+
+#ifndef NEED_MATHERR
+struct exception {
+    int type;
+};
+#define DOMAIN 0
+#define SING 0
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * matherr --
+ *
+ *	This procedure is invoked on Sys-V systems when certain
+ *	errors occur in mathematical functions.  Type "man matherr"
+ *	for more information on how this function works.
+ *
+ * Results:
+ *	Returns 1 to indicate that we've handled the error
+ *	locally.
+ *
+ * Side effects:
+ *	Sets errno based on what's in xPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+matherr(xPtr)
+    struct exception *xPtr;	/* Describes error that occurred. */
+{
+    if (!tcl_MathInProgress) {
+	return 0;
+    }
+    if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
+	errno = EDOM;
+    } else {
+	errno = ERANGE;
+    }
+    return 1;
+}
diff --git a/tcl/unix/tclUnixChan.c b/tcl/unix/tclUnixChan.c
new file mode 100644
index 00000000000..410c199f987
--- /dev/null
+++ b/tcl/unix/tclUnixChan.c
@@ -0,0 +1,2573 @@
+/* 
+ * tclUnixChan.c
+ *
+ *	Common channel driver for Unix channels based on files, command
+ *	pipes and TCP sockets.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include	"tclInt.h"	/* Internal definitions for Tcl. */
+#include	"tclPort.h"	/* Portability features for Tcl. */
+
+/*
+ * 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 */
+
+/*
+ * 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 {
+    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;
+
+/*
+ * These bits may be ORed together into the "flags" field of a TcpState
+ * structure.
+ */
+
+#define TCP_ASYNC_SOCKET	(1<<0)	/* Asynchronous socket. */
+#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
+
+/*
+ * The following defines the maximum length of the listen queue. This is
+ * the number of outstanding yet-to-be-serviced requests for a connection
+ * on a server socket, more than this number of outstanding requests and
+ * the connection request will fail.
+ */
+
+#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
+ * for a socket.
+ */
+
+#define SOCKET_BUFSIZE	4096
+
+/*
+ * Static routines for this file:
+ */
+
+static TcpState *	CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
+			    int port, char *host, int server,
+			    char *myaddr, int myport, int async));
+static int		CreateSocketAddress _ANSI_ARGS_(
+			    (struct sockaddr_in *sockaddrPtr,
+			    char *host, int port));
+static int		FileBlockModeProc _ANSI_ARGS_((
+    			    ClientData instanceData, int mode));
+static int		FileCloseProc _ANSI_ARGS_((ClientData instanceData,
+			    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,
+			    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,
+        		    int mode));
+static int		TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp));
+static int		TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static int		TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp, char *optionName,
+			    Tcl_DString *dsPtr));
+static int		TcpInputProc _ANSI_ARGS_((ClientData instanceData,
+		            char *buf, int toRead,  int *errorCode));
+static int		TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
+		            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,
+		            int *errorCodePtr));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType fileChannelType = {
+    "file",				/* Type name. */
+    FileBlockModeProc,			/* Set blocking/nonblocking mode.*/
+    FileCloseProc,			/* Close 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 serial IO.
+ * Note that this type is a subclass of the "file" type.
+ */
+
+static Tcl_ChannelType ttyChannelType = {
+    "tty",				/* Type name. */
+    FileBlockModeProc,			/* Set blocking/nonblocking mode.*/
+    FileCloseProc,			/* Close proc. */
+    FileInputProc,			/* Input proc. */
+    FileOutputProc,			/* Output proc. */
+    NULL,				/* Seek proc. */
+    TtySetOptionProc,			/* Set option proc. */
+    TtyGetOptionProc,			/* Get option proc. */
+    FileWatchProc,			/* Initialize notifier. */
+    FileGetHandleProc,			/* Get OS handles out of channel. */
+};
+
+/*
+ * This structure describes the channel type structure for TCP socket
+ * based IO:
+ */
+
+static Tcl_ChannelType tcpChannelType = {
+    "tcp",				/* Type name. */
+    TcpBlockModeProc,			/* Set blocking/nonblocking mode.*/
+    TcpCloseProc,			/* Close proc. */
+    TcpInputProc,			/* Input proc. */
+    TcpOutputProc,			/* Output proc. */
+    NULL,				/* Seek proc. */
+    NULL,				/* Set option proc. */
+    TcpGetOptionProc,			/* Get option proc. */
+    TcpWatchProc,			/* Initialize notifier. */
+    TcpGetHandleProc,			/* Get OS handles out of channel. */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockModeProc --
+ *
+ *	Helper procedure to set blocking and nonblocking modes on a
+ *	file 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+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;
+
+#ifndef USE_FIONBIO
+    curStatus = fcntl(fsPtr->fd, F_GETFL);
+    if (mode == TCL_MODE_BLOCKING) {
+	curStatus &= (~(O_NONBLOCK));
+    } else {
+	curStatus |= O_NONBLOCK;
+    }
+    if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) {
+	return errno;
+    }
+    curStatus = fcntl(fsPtr->fd, F_GETFL);
+#else
+    if (mode == TCL_MODE_BLOCKING) {
+	curStatus = 0;
+    } else {
+	curStatus = 1;
+    }
+    if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
+	return errno;
+    }
+#endif
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInputProc --
+ *
+ *	This procedure is invoked from the generic IO level to read
+ *	input from a file 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
+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. */
+{
+    FileState *fsPtr = (FileState *) instanceData;
+    int bytesRead;			/* How many bytes were actually
+                                         * read from the input device? */
+
+    *errorCodePtr = 0;
+    
+    /*
+     * 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.
+     */
+
+    bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
+    if (bytesRead > -1) {
+        return bytesRead;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileOutputProc--
+ *
+ *	This procedure is invoked from the generic IO level to write
+ *	output to a file 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
+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;
+
+    *errorCodePtr = 0;
+    written = write(fsPtr->fd, buf, (size_t) toWrite);
+    if (written > -1) {
+        return written;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCloseProc --
+ *
+ *	This procedure is called from the generic IO level to perform
+ *	channel-type-specific cleanup when a file based channel is closed.
+ *
+ * Results:
+ *	0 if successful, errno if failed.
+ *
+ * Side effects:
+ *	Closes the device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileCloseProc(instanceData, interp)
+    ClientData instanceData;	/* File state. */
+    Tcl_Interp *interp;		/* For error reporting - unused. */
+{
+    FileState *fsPtr = (FileState *) instanceData;
+    FileState **nextPtrPtr;
+    int errorCode = 0;
+
+    Tcl_DeleteFileHandler(fsPtr->fd);
+    if (!TclInExit()
+	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
+	if (close(fsPtr->fd) < 0) {
+	    errorCode = errno;
+	}
+    }
+    for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	if ((*nextPtrPtr) == fsPtr) {
+	    (*nextPtrPtr) = fsPtr->nextPtr;
+	    break;
+	}
+    }
+    ckfree((char *) fsPtr);
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeekProc --
+ *
+ *	This procedure is called by the generic IO level to move the
+ *	access point in a file based channel.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. An output
+ *	argument contains the POSIX error code if an error occurred,
+ *	or zero.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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
+                                                 * one of SEEK_START,
+                                                 * SEEK_SET or SEEK_END. */
+    int *errorCodePtr;				/* To store error code. */
+{
+    FileState *fsPtr = (FileState *) instanceData;
+    int newLoc;
+
+    newLoc = lseek(fsPtr->fd, offset, mode);
+
+    *errorCodePtr = (newLoc == -1) ? errno : 0;
+    return newLoc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWatchProc --
+ *
+ *	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
+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. */
+{
+    FileState *fsPtr = (FileState *) instanceData;
+
+    /*
+     * 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.
+     */
+
+    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;
+
+    if (direction & fsPtr->validMask) {
+	*handlePtr = (ClientData) fsPtr->fd;
+	return TCL_OK;
+    } else {
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtyGetOptionProc --
+ *
+ *	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:
+ *	A standard Tcl result. Also sets the supplied DString to the
+ *	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.
+ *      Sets Error message if needed (by calling Tcl_BadChannelOption).
+ *
+ *----------------------------------------------------------------------
+ */
+
+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). */
+{
+    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;
+	}
+    }
+    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;
+
+    tcgetattr(fd, &termios);
+    ttyPtr->baud = TtyGetBaud(cfgetospeed(&termios));
+    
+    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;
+    }
+
+    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;
+	}
+    }
+    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;
+    }
+    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;
+    }
+    *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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFileChannel --
+ *
+ *	Open an file based channel on Unix systems.
+ *
+ * Results:
+ *	The new channel or NULL. If NULL, the output argument
+ *	errorCodePtr is set to a POSIX error and an error message is
+ *	left in interp->result if interp is not NULL.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the
+ *	file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpOpenFileChannel(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;			/* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;			/* Name of file to open. */
+    char *modeString;			/* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;			/* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    int fd, seekFlag, mode, channelPermissions;
+    FileState *fsPtr;
+    char *nativeName, channelName[20];
+    Tcl_DString buffer;
+    Tcl_ChannelType *channelTypePtr;
+
+    mode = TclGetOpenMode(interp, modeString, &seekFlag);
+    if (mode == -1) {
+        return NULL;
+    }
+    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+	case O_RDONLY:
+	    channelPermissions = TCL_READABLE;
+	    break;
+	case O_WRONLY:
+	    channelPermissions = TCL_WRITABLE;
+	    break;
+	case O_RDWR:
+	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+	    break;
+	default:
+            /*
+             * This may occurr if modeString was "", for example.
+             */
+	    panic("TclpOpenFileChannel: invalid mode value");
+	    return NULL;
+    }
+
+    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+    if (nativeName == NULL) {
+	return NULL;
+    }
+    fd = open(nativeName, mode, permissions);
+
+    /*
+     * If nativeName is not NULL, the buffer is valid and we must free
+     * the storage.
+     */
+    
+    Tcl_DStringFree(&buffer);
+
+    if (fd < 0) {
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+                    Tcl_PosixError(interp), (char *) NULL);
+        }
+        return NULL;
+    }
+
+    /*
+     * Set close-on-exec flag on the fd so that child processes will not
+     * inherit this fd.
+     */
+  
+    fcntl(fd, F_SETFD, FD_CLOEXEC);
+    
+    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(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), NULL);
+            }
+            Tcl_Close(NULL, fsPtr->channel);
+            return NULL;
+        }
+    }
+
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeFileChannel --
+ *
+ *	Makes a Tcl_Channel from an existing OS level file handle.
+ *
+ * Results:
+ *	The Tcl_Channel created around the preexisting OS level file handle.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeFileChannel(handle, mode)
+    ClientData handle;		/* OS level handle. */
+    int mode;			/* ORed combination of TCL_READABLE and
+                                 * TCL_WRITABLE to indicate file mode. */
+{
+    FileState *fsPtr;
+    char channelName[20];
+    int fd = (int) handle;
+
+    if (mode == 0) {
+        return NULL;
+    }
+
+    sprintf(channelName, "file%d", fd);
+
+    /*
+     * 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.
+     */
+    
+    for (fsPtr = firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
+	if (fsPtr->fd == fd) {
+	    return (mode == fsPtr->validMask) ? fsPtr->channel : NULL;
+	}
+    }
+
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpBlockModeProc --
+ *
+ *	This procedure is invoked by the generic IO level to set blocking
+ *	and nonblocking mode on a TCP socket based channel.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or nonblocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TcpBlockModeProc(instanceData, mode)
+    ClientData instanceData;		/* Socket state. */
+    int mode;				/* The mode to set. Can be one of
+                                         * TCL_MODE_BLOCKING or
+                                         * TCL_MODE_NONBLOCKING. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+    int setting;
+    
+#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;
+    }
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForConnect --
+ *
+ *	Waits for a connection on an asynchronously opened socket to
+ *	be completed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The socket is connected after this function returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForConnect(statePtr, errorCodePtr)
+    TcpState *statePtr;		/* State of the socket. */
+    int *errorCodePtr;		/* Where to store errors? */
+{
+    int timeOut;		/* How long to wait. */
+    int state;			/* Of calling TclWaitForFile. */
+    int flags;			/* fcntl flags for the socket. */
+
+    /*
+     * If an asynchronous connect is in progress, attempt to wait for it
+     * to complete before reading.
+     */
+    
+    if (statePtr->flags & TCP_ASYNC_CONNECT) {
+        if (statePtr->flags & TCP_ASYNC_SOCKET) {
+            timeOut = 0;
+        } else {
+            timeOut = -1;
+        }
+        errno = 0;
+        state = TclUnixWaitForFile(statePtr->fd,
+		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
+        if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
+#ifndef	USE_FIONBIO
+            flags = fcntl(statePtr->fd, F_GETFL);
+            flags &= (~(O_NONBLOCK));
+            (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;
+        }
+        if (state & TCL_WRITABLE) {
+            statePtr->flags &= (~(TCP_ASYNC_CONNECT));
+        } else if (timeOut == 0) {
+            *errorCodePtr = errno = EWOULDBLOCK;
+            return -1;
+        }
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpInputProc --
+ *
+ *	This procedure is invoked by the generic IO level to read input
+ *	from a TCP socket based channel.
+ *
+ *	NOTE: We cannot share code with FilePipeInputProc because here
+ *	we must use recv to obtain the input from the channel, not read.
+ *
+ * Results:
+ *	The number of bytes read is returned or -1 on error. An output
+ *	argument contains the POSIX error code on error, or zero if no
+ *	error occurred.
+ *
+ * Side effects:
+ *	Reads input from the input device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
+    ClientData instanceData;		/* Socket state. */
+    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 = (TcpState *) instanceData;
+    int bytesRead, state;
+
+    *errorCodePtr = 0;
+    state = WaitForConnect(statePtr, errorCodePtr);
+    if (state != 0) {
+        return -1;
+    }
+    bytesRead = recv(statePtr->fd, buf, bufSize, 0);
+    if (bytesRead > -1) {
+        return bytesRead;
+    }
+    if (errno == ECONNRESET) {
+
+        /*
+         * Turn ECONNRESET into a soft EOF condition.
+         */
+        
+        return 0;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpOutputProc --
+ *
+ *	This procedure is invoked by the generic IO level to write output
+ *	to a TCP socket based channel.
+ *
+ *	NOTE: We cannot share code with FilePipeOutputProc because here
+ *	we must use send, not write, to get reliable error reporting.
+ *
+ * Results:
+ *	The number of bytes written is returned. An output argument is
+ *	set to a POSIX error code if an error occurred, or zero.
+ *
+ * Side effects:
+ *	Writes output on the output device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;		/* Socket state. */
+    char *buf;				/* The data buffer. */
+    int toWrite;			/* How many bytes to write? */
+    int *errorCodePtr;			/* Where to store error code. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+    int written;
+    int state;				/* Of waiting for connection. */
+
+    *errorCodePtr = 0;
+    state = WaitForConnect(statePtr, errorCodePtr);
+    if (state != 0) {
+        return -1;
+    }
+    written = send(statePtr->fd, buf, toWrite, 0);
+    if (written > -1) {
+        return written;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpCloseProc --
+ *
+ *	This procedure is invoked by the generic IO level to perform
+ *	channel-type-specific cleanup when a TCP socket based channel
+ *	is closed.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the socket of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TcpCloseProc(instanceData, interp)
+    ClientData instanceData;	/* The socket to close. */
+    Tcl_Interp *interp;		/* For error reporting - unused. */
+{
+    TcpState *statePtr = (TcpState *) instanceData;
+    int errorCode = 0;
+
+    /*
+     * Delete a file handler that may be active for this socket if this
+     * is a server socket - the file handler was created automatically
+     * by Tcl as part of the mechanism to accept new client connections.
+     * Channel handlers are already deleted in the generic IO channel
+     * closing code that called this function, so we do not have to
+     * delete them here.
+     */
+    
+    Tcl_DeleteFileHandler(statePtr->fd);
+
+    if (close(statePtr->fd) < 0) {
+	errorCode = errno;
+    }
+    ckfree((char *) statePtr);
+
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetOptionProc --
+ *
+ *	Computes an option value for a TCP socket based channel, or a
+ *	list of all options and their values.
+ *
+ *	Note: This code is based on code contributed by John Haxby.
+ *
+ * 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. Sets Error message if needed.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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 *) instanceData;
+    struct sockaddr_in sockname;
+    struct sockaddr_in peername;
+    struct hostent *hostEntPtr;
+    int size = sizeof(struct sockaddr_in);
+    size_t len = 0;
+    char buf[128];
+
+    if (optionName != (char *) NULL) {
+        len = strlen(optionName);
+    }
+
+    if ((len == 0) ||
+            ((len > 1) && (optionName[1] == 'p') &&
+                    (strncmp(optionName, "-peername", len) == 0))) {
+        if (getpeername(statePtr->fd, (struct sockaddr *) &peername, &size)
+		>= 0) {
+            if (len == 0) {
+                Tcl_DStringAppendElement(dsPtr, "-peername");
+                Tcl_DStringStartSublist(dsPtr);
+            }
+            Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+            hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
+                    sizeof(peername.sin_addr), AF_INET);
+            if (hostEntPtr != (struct hostent *) NULL) {
+                Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+            } else {
+                Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+            }
+            sprintf(buf, "%d", ntohs(peername.sin_port));
+            Tcl_DStringAppendElement(dsPtr, buf);
+            if (len == 0) {
+                Tcl_DStringEndSublist(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(statePtr->fd, (struct sockaddr *) &sockname, &size)
+		>= 0) {
+            if (len == 0) {
+                Tcl_DStringAppendElement(dsPtr, "-sockname");
+                Tcl_DStringStartSublist(dsPtr);
+            }
+            Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+            hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
+                    sizeof(sockname.sin_addr), AF_INET);
+            if (hostEntPtr != (struct hostent *) NULL) {
+                Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+            } else {
+                Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+            }
+            sprintf(buf, "%d", ntohs(sockname.sin_port));
+            Tcl_DStringAppendElement(dsPtr, buf);
+            if (len == 0) {
+                Tcl_DStringEndSublist(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) {
+        return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+    /*
+     * Make sure we don't mess with server sockets since they will never
+     * be readable or writable at the Tcl level.  This keeps Tcl scripts
+     * from interfering with the -accept behavior.
+     */
+
+    if (!statePtr->acceptProc) {
+	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
+ *	and initializes the TcpState structure.
+ *
+ * Results:
+ *	Returns a new TcpState, or NULL with an error in interp->result,
+ *	if interp is not NULL.
+ *
+ * Side effects:
+ *	Opens a socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TcpState *
+CreateSocket(interp, port, host, server, myaddr, myport, async)
+    Tcl_Interp *interp;		/* For error reporting; can be NULL. */
+    int port;			/* Port number to open. */
+    char *host;			/* Name of host on which to open port.
+				 * NULL implies INADDR_ANY */
+    int server;			/* 1 if socket should be a server socket,
+				 * else 0 for a client socket. */
+    char *myaddr;		/* Optional client-side address */
+    int myport;			/* Optional client-side port */
+    int async;			/* If nonzero and creating a client socket,
+                                 * attempt to do an async connect. Otherwise
+                                 * do a synchronous connect or bind. */
+{
+    int status, sock, asyncConnect, curState, origState;
+    struct sockaddr_in sockaddr;	/* socket address */
+    struct sockaddr_in mysockaddr;	/* Socket address for client */
+    TcpState *statePtr;
+
+    sock = -1;
+    origState = 0;
+    if (! CreateSocketAddress(&sockaddr, host, port)) {
+	goto addressError;
+    }
+    if ((myaddr != NULL || myport != 0) &&
+	    ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+	goto addressError;
+    }
+
+    sock = socket(AF_INET, SOCK_STREAM, 0);
+    if (sock < 0) {
+	goto addressError;
+    }
+
+    /*
+     * 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
+     */
+
+    TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
+
+    asyncConnect = 0;
+    status = 0;
+    if (server) {
+
+	/*
+	 * Set up to reuse server addresses automatically and bind to the
+	 * specified port.
+	 */
+    
+	status = 1;
+	(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
+		sizeof(status));
+	status = bind(sock, (struct sockaddr *) &sockaddr,
+                sizeof(struct sockaddr));
+	if (status != -1) {
+	    status = listen(sock, SOMAXCONN);
+	} 
+    } else {
+	if (myaddr != NULL || myport != 0) { 
+	    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) {
+		goto bindError;
+	    }
+	}
+
+	/*
+	 * Attempt to connect. The connect may fail at present with an
+	 * EINPROGRESS but at a later time it will complete. The caller
+	 * will set up a file handler on the socket if she is interested in
+	 * being informed when the connect completes.
+	 */
+
+        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;
+        }
+        if (status > -1) {
+            status = connect(sock, (struct sockaddr *) &sockaddr,
+                    sizeof(sockaddr));
+            if (status < 0) {
+                if (errno == EINPROGRESS) {
+                    asyncConnect = 1;
+                    status = 0;
+                }
+            }
+        }
+    }
+
+bindError:
+    if (status < 0) {
+        if (interp != NULL) {
+            Tcl_AppendResult(interp, "couldn't open socket: ",
+                    Tcl_PosixError(interp), (char *) NULL);
+        }
+        if (sock != -1) {
+            close(sock);
+        }
+        return NULL;
+    }
+
+    /*
+     * Allocate a new TcpState for this socket.
+     */
+
+    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+    statePtr->flags = 0;
+    if (asyncConnect) {
+        statePtr->flags = TCP_ASYNC_CONNECT;
+    }
+    statePtr->fd = sock;
+    
+    return statePtr;
+
+addressError:
+    if (sock != -1) {
+        close(sock);
+    }
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "couldn't open socket: ",
+		Tcl_PosixError(interp), (char *) NULL);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocketAddress --
+ *
+ *	This function initializes a sockaddr structure for a host and port.
+ *
+ * Results:
+ *	1 if the host was valid, 0 if the host could not be converted to
+ *	an IP address.
+ *
+ * Side effects:
+ *	Fills in the *sockaddrPtr structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateSocketAddress(sockaddrPtr, host, port)
+    struct sockaddr_in *sockaddrPtr;	/* Socket address */
+    char *host;				/* Host.  NULL implies INADDR_ANY */
+    int port;				/* Port number */
+{
+    struct hostent *hostent;		/* Host database entry */
+    struct in_addr addr;		/* For 64/32 bit madness */
+
+    (void) memset((VOID *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
+    sockaddrPtr->sin_family = AF_INET;
+    sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
+    if (host == NULL) {
+	addr.s_addr = INADDR_ANY;
+    } else {
+        addr.s_addr = inet_addr(host);
+        if (addr.s_addr == -1) {
+            hostent = gethostbyname(host);
+            if (hostent != NULL) {
+                memcpy((VOID *) &addr,
+                        (VOID *) hostent->h_addr_list[0],
+                        (size_t) hostent->h_length);
+            } else {
+#ifdef	EHOSTUNREACH
+                errno = EHOSTUNREACH;
+#else
+#ifdef ENXIO
+                errno = ENXIO;
+#endif
+#endif
+                return 0;	/* error */
+            }
+        }
+    }
+        
+    /*
+     * NOTE: On 64 bit machines the assignment below is rumored to not
+     * do the right thing. Please report errors related to this if you
+     * observe incorrect behavior on 64 bit machines such as DEC Alphas.
+     * Should we modify this code to do an explicit memcpy?
+     */
+
+    sockaddrPtr->sin_addr.s_addr = addr.s_addr;
+    return 1;	/* Success. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpClient --
+ *
+ *	Opens a TCP client socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed.  An error message is returned
+ *	in the interpreter on failure.
+ *
+ * Side effects:
+ *	Opens a client socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
+    Tcl_Interp *interp;			/* For error reporting; can be NULL. */
+    int port;				/* Port number to open. */
+    char *host;				/* Host on which to open port. */
+    char *myaddr;			/* Client-side address */
+    int myport;				/* Client-side port */
+    int async;				/* If nonzero, attempt to do an
+                                         * asynchronous connect. Otherwise
+                                         * we do a blocking connect. */
+{
+    TcpState *statePtr;
+    char channelName[20];
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
+    if (statePtr == NULL) {
+	return NULL;
+    }
+
+    statePtr->acceptProc = NULL;
+    statePtr->acceptProcData = (ClientData) NULL;
+
+    sprintf(channelName, "sock%d", statePtr->fd);
+
+    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 statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeTcpClientChannel --
+ *
+ *	Creates a Tcl_Channel from an existing client TCP socket.
+ *
+ * Results:
+ *	The Tcl_Channel wrapped around the preexisting TCP socket.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeTcpClientChannel(sock)
+    ClientData sock;		/* The socket to wrap up into a channel. */
+{
+    TcpState *statePtr;
+    char channelName[20];
+
+    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+    statePtr->fd = (int) sock;
+    statePtr->acceptProc = NULL;
+    statePtr->acceptProcData = (ClientData) NULL;
+
+    sprintf(channelName, "sock%d", statePtr->fd);
+    
+    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 statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ *	Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed. If an error occurred, an
+ *	error message is left in interp->result if interp is
+ *	not NULL.
+ *
+ * Side effects:
+ *	Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
+    Tcl_Interp *interp;			/* For error reporting - may be
+                                         * NULL. */
+    int port;				/* Port number to open. */
+    char *myHost;			/* Name of local host. */
+    Tcl_TcpAcceptProc *acceptProc;	/* Callback for accepting connections
+                                         * from new clients. */
+    ClientData acceptProcData;		/* Data for the callback. */
+{
+    TcpState *statePtr;
+    char channelName[20];
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
+    if (statePtr == NULL) {
+	return NULL;
+    }
+
+    statePtr->acceptProc = acceptProc;
+    statePtr->acceptProcData = acceptProcData;
+
+    /*
+     * Set up the callback mechanism for accepting connections
+     * from new clients.
+     */
+
+    Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
+            (ClientData) statePtr);
+    sprintf(channelName, "sock%d", statePtr->fd);
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+            (ClientData) statePtr, 0);
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpAccept --
+ *	Accept a TCP socket connection.  This is called by the event loop.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new connection socket. Calls the registered callback
+ *	for the connection acceptance mechanism.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+TcpAccept(data, mask)
+    ClientData data;			/* Callback token. */
+    int mask;				/* Not used. */
+{
+    TcpState *sockState;		/* Client data of server socket. */
+    int newsock;			/* The new client socket */
+    TcpState *newSockState;		/* State for new socket. */
+    struct sockaddr_in addr;		/* The remote address */
+    int len;				/* For accept interface */
+    char channelName[20];
+
+    sockState = (TcpState *) data;
+
+    len = sizeof(struct sockaddr_in);
+    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);
+    
+    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", 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));
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetDefaultStdChannel --
+ *
+ *	Creates channels for standard input, standard output or standard
+ *	error output if they do not already exist.
+ *
+ * Results:
+ *	Returns the specified default standard channel, or NULL.
+ *
+ * Side effects:
+ *	May cause the creation of a standard channel and the underlying
+ *	file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclGetDefaultStdChannel(type)
+    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    Tcl_Channel channel = NULL;
+    int fd = 0;			/* Initializations needed to prevent */
+    int mode = 0;		/* compiler warning (used before set). */
+    char *bufMode = NULL;
+
+    switch (type) {
+        case TCL_STDIN:
+            if ((lseek(0, (off_t) 0, SEEK_CUR) == -1) &&
+                    (errno == EBADF)) {
+                return (Tcl_Channel) NULL;
+            }
+	    fd = 0;
+	    mode = TCL_READABLE;
+            bufMode = "line";
+            break;
+        case TCL_STDOUT:
+            if ((lseek(1, (off_t) 0, SEEK_CUR) == -1) &&
+                    (errno == EBADF)) {
+                return (Tcl_Channel) NULL;
+            }
+	    fd = 1;
+	    mode = TCL_WRITABLE;
+            bufMode = "line";
+            break;
+        case TCL_STDERR:
+            if ((lseek(2, (off_t) 0, SEEK_CUR) == -1) &&
+                    (errno == EBADF)) {
+                return (Tcl_Channel) NULL;
+            }
+	    fd = 2;
+	    mode = TCL_WRITABLE;
+	    bufMode = "none";
+            break;
+	default:
+	    panic("TclGetDefaultStdChannel: Unexpected channel type");
+	    break;
+    }
+
+    channel = Tcl_MakeFileChannel((ClientData) fd, mode);
+
+    /*
+     * Set up the normal channel options for stdio handles.
+     */
+
+    Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
+    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
+    return channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetOpenFile --
+ *
+ *	Given a name of a channel registered in the given interpreter,
+ *	returns a FILE * for it.
+ *
+ * Results:
+ *	A standard Tcl result. If the channel is registered in the given
+ *	interpreter and it is managed by the "file" channel driver, and
+ *	it is open for the requested mode, then the output parameter
+ *	filePtr is set to a FILE * for the underlying file. On error, the
+ *	filePtr is not set, TCL_ERROR is returned and an error message is
+ *	left in interp->result.
+ *
+ * Side effects:
+ *	May invoke fdopen to create the FILE * for the requested file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
+    Tcl_Interp *interp;		/* Interpreter in which to find file. */
+    char *string;		/* String that identifies file. */
+    int forWriting;		/* 1 means the file is going to be used
+				 * for writing, 0 means for reading. */
+    int checkUsage;		/* 1 means verify that the file was opened
+				 * in a mode that allows the access specified
+				 * by "forWriting". Ignored, we always
+                                 * check that the channel is open for the
+                                 * requested mode. */
+    ClientData *filePtr;	/* Store pointer to FILE structure here. */
+{
+    Tcl_Channel chan;
+    int chanMode;
+    Tcl_ChannelType *chanTypePtr;
+    ClientData data;
+    int fd;
+    FILE *f;
+    
+    chan = Tcl_GetChannel(interp, string, &chanMode);
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+    if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
+        Tcl_AppendResult(interp,
+                "\"", string, "\" wasn't opened for writing", (char *) NULL);
+        return TCL_ERROR;
+    } else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) {
+        Tcl_AppendResult(interp,
+                "\"", string, "\" wasn't opened for reading", (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * We allow creating a FILE * out of file based, pipe based and socket
+     * based channels. We currently do not allow any other channel types,
+     * because it is likely that stdio will not know what to do with them.
+     */
+
+    chanTypePtr = Tcl_GetChannelType(chan);
+    if ((chanTypePtr == &fileChannelType) || (chanTypePtr == &tcpChannelType)
+	    || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
+        if (Tcl_GetChannelHandle(chan,
+		(forWriting ? TCL_WRITABLE : TCL_READABLE),
+		(ClientData*) &data) == TCL_OK) {
+	    fd = (int) data;
+
+	    /*
+	     * 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;
+	}
+    }
+
+    Tcl_AppendResult(interp, "\"", string,
+            "\" 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/tcl/unix/tclUnixEvent.c b/tcl/unix/tclUnixEvent.c
new file mode 100644
index 00000000000..2a2a67bab2d
--- /dev/null
+++ b/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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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/tcl/unix/tclUnixFCmd.c b/tcl/unix/tclUnixFCmd.c
new file mode 100644
index 00000000000..a58ac031bff
--- /dev/null
+++ b/tcl/unix/tclUnixFCmd.c
@@ -0,0 +1,1226 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ *
+ * 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);
+
+#ifndef __CYGWIN__
+        case S_IFIFO:
+	    if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
+		return TCL_ERROR;
+	    }
+	    return CopyFileAtts(src, dst, &srcStatBuf);
+#endif
+
+        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;
+    }
+
+#if HAVE_ST_BLKSIZE
+    blockSize = srcStatBufPtr->st_blksize;
+#else
+    blockSize = 4096;
+#endif
+
+    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 (TclStat(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) {
+	*attributePtrPtr = Tcl_NewIntObj(statBuf.st_gid);
+    } else {
+	*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 (TclStat(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) {
+	*attributePtrPtr = Tcl_NewIntObj(statBuf.st_uid);
+    } else {
+	*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 (TclStat(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/tcl/unix/tclUnixFile.c b/tcl/unix/tclUnixFile.c
new file mode 100644
index 00000000000..d563f696127
--- /dev/null
+++ b/tcl/unix/tclUnixFile.c
@@ -0,0 +1,537 @@
+/* 
+ * tclUnixFile.c --
+ *
+ *      This file contains wrappers around UNIX file handling functions.
+ *      These wrappers mask differences between Windows and UNIX.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The variable below caches the name of the current working directory
+ * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
+ * NULL means the cache needs to be refreshed.
+ */
+
+static char *currentDir =  NULL;
+static int currentDirExitHandlerSet = 0;
+
+/*
+ * The variable below is set if the exit routine for deleting the string
+ * containing the executable name has been registered.
+ */
+
+static int executableNameExitHandlerSet = 0;
+
+extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
+
+/*
+ * Static routines for this file:
+ */
+
+static void	FreeCurrentDir _ANSI_ARGS_((ClientData clientData));
+static void	FreeExecutableName _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCurrentDir --
+ *
+ *	Frees the string stored in the currentDir variable. This routine
+ *	is registered as an exit handler and will be called during shutdown.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees the memory occuppied by the currentDir value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+FreeCurrentDir(clientData)
+    ClientData clientData;	/* Not used. */
+{
+    if (currentDir != (char *) NULL) {
+        ckfree(currentDir);
+        currentDir = (char *) NULL;
+        currentDirExitHandlerSet = 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeExecutableName --
+ *
+ *	Frees the string stored in the tclExecutableName variable. This
+ *	routine is registered as an exit handler and will be called
+ *	during shutdown.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees the memory occuppied by the tclExecutableName value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+FreeExecutableName(clientData)
+    ClientData clientData;	/* Not used. */
+{
+    if (tclExecutableName != (char *) NULL) {
+        ckfree(tclExecutableName);
+        tclExecutableName = (char *) NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChdir --
+ *
+ *	Change the current working directory.
+ *
+ * Results:
+ *	The result is a standard Tcl result.  If an error occurs and 
+ *	interp isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The working directory for this application is changed.  Also
+ *	the cache maintained used by TclGetCwd is deallocated and
+ *	set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChdir(interp, dirName)
+    Tcl_Interp *interp;		/* If non NULL, used for error reporting. */
+    char *dirName;     		/* Path to new working directory. */
+{
+    if (currentDir != NULL) {
+	ckfree(currentDir);
+	currentDir = NULL;
+    }
+    if (chdir(dirName) != 0) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
+		    dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCwd --
+ *
+ *	Return the path name of the current working directory.
+ *
+ * Results:
+ *	The result is the full path name of the current working
+ *	directory, or NULL if an error occurred while figuring it out.
+ *	The returned string is owned by the TclGetCwd routine and must
+ *	not be freed by the caller.  If an error occurs and interp
+ *	isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The path name is cached to avoid having to recompute it
+ *	on future calls;  if it is already cached, the cached
+ *	value is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetCwd(interp)
+    Tcl_Interp *interp;		/* If non NULL, used for error reporting. */
+{
+    char buffer[MAXPATHLEN+1];
+
+    if (currentDir == NULL) {
+        if (!currentDirExitHandlerSet) {
+            currentDirExitHandlerSet = 1;
+            Tcl_CreateExitHandler(FreeCurrentDir, (ClientData) NULL);
+        }
+#ifdef USEGETWD
+	if ((int)getwd(buffer) == (int)NULL) {
+	    if (interp != NULL) {
+		Tcl_AppendResult(interp,
+			"error getting working directory name: ",
+			buffer, (char *)NULL);
+	    }
+	    return NULL;
+	}
+#else
+	if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
+	    if (interp != NULL) {
+		if (errno == ERANGE) {
+		    Tcl_SetResult(interp,
+			    "working directory name is too long",
+		            TCL_STATIC);
+		} else {
+		    Tcl_AppendResult(interp,
+			    "error getting working directory name: ",
+			    Tcl_PosixError(interp), (char *) NULL);
+		}
+	    }
+	    return NULL;
+	}
+#endif
+	currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
+	strcpy(currentDir, buffer);
+    }
+    return currentDir;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindExecutable --
+ *
+ *	This procedure computes the absolute path name of the current
+ *	application, given its argv[0] value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The variable tclExecutableName gets filled in with the file
+ *	name for the application, if we figured it out.  If we couldn't
+ *	figure it out, Tcl_FindExecutable is set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FindExecutable(argv0)
+    char *argv0;		/* The value of the application's argv[0]. */
+{
+    char *name, *p, *cwd;
+    Tcl_DString buffer;
+    int length;
+    struct stat statBuf;
+
+    Tcl_DStringInit(&buffer);
+    if (tclExecutableName != NULL) {
+	ckfree(tclExecutableName);
+	tclExecutableName = NULL;
+    }
+
+    name = argv0;
+    for (p = name; *p != 0; p++) {
+	if (*p == '/') {
+	    /*
+	     * The name contains a slash, so use the name directly
+	     * without doing a path search.
+	     */
+
+	    goto gotName;
+	}
+    }
+
+    p = getenv("PATH");
+    if (p == NULL) {
+	/*
+	 * There's no PATH environment variable; use the default that
+	 * is used by sh.
+	 */
+
+	p = ":/bin:/usr/bin";
+    } else if (*p == '\0') {
+	/*
+	 * An empty path is equivalent to ".".
+	 */
+
+	p = "./";
+    }
+
+    /*
+     * Search through all the directories named in the PATH variable
+     * to see if argv[0] is in one of them.  If so, use that file
+     * name.
+     */
+
+    while (*p != 0) {
+	while (isspace(UCHAR(*p))) {
+	    p++;
+	}
+	name = p;
+	while ((*p != ':') && (*p != 0)) {
+	    p++;
+	}
+	Tcl_DStringSetLength(&buffer, 0);
+	if (p != name) {
+	    Tcl_DStringAppend(&buffer, name, p-name);
+	    if (p[-1] != '/') {
+		Tcl_DStringAppend(&buffer, "/", 1);
+	    }
+	}
+	Tcl_DStringAppend(&buffer, argv0, -1);
+	if ((TclAccess(Tcl_DStringValue(&buffer), X_OK) == 0)
+		&& (TclStat(Tcl_DStringValue(&buffer), &statBuf) == 0)
+		&& S_ISREG(statBuf.st_mode)) {
+	    name = Tcl_DStringValue(&buffer);
+	    goto gotName;
+	}
+	if (*p == 0) {
+	    break;
+	} else if (*(p+1) == 0) {
+	    p = "./";
+	} else {
+	    p++;
+	}
+    }
+    goto done;
+
+    /*
+     * If the name starts with "/" then just copy it to tclExecutableName.
+     */
+
+    gotName:
+    if (name[0] == '/')  {
+	tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
+	strcpy(tclExecutableName, name);
+	goto done;
+    }
+
+    /*
+     * The name is relative to the current working directory.  First
+     * strip off a leading "./", if any, then add the full path name of
+     * the current working directory.
+     */
+
+    if ((name[0] == '.') && (name[1] == '/')) {
+	name += 2;
+    }
+    cwd = TclGetCwd((Tcl_Interp *) NULL);
+    if (cwd == NULL) {
+	tclExecutableName = NULL;
+	goto done;
+    }
+    length = strlen(cwd);
+    tclExecutableName = (char *) ckalloc((unsigned)
+	    (length + strlen(name) + 2));
+    strcpy(tclExecutableName, cwd);
+    tclExecutableName[length] = '/';
+    strcpy(tclExecutableName + length + 1, name);
+
+    done:
+    Tcl_DStringFree(&buffer);
+
+    if (!executableNameExitHandlerSet) {
+        executableNameExitHandlerSet = 1;
+        Tcl_CreateExitHandler(FreeExecutableName, (ClientData) NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetUserHome --
+ *
+ *	This function takes the passed in user name and finds the
+ *	corresponding home directory specified in the password file.
+ *
+ * Results:
+ *	The result is a pointer to a static string containing
+ *	the new name.  If there was an error in processing the
+ *	user name then the return value is NULL.  Otherwise the
+ *	result is stored in bufferPtr, and the caller must call
+ *	Tcl_DStringFree(bufferPtr) to free the result.
+ *
+ * Side effects:
+ *	Information may be left in bufferPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetUserHome(name, bufferPtr)
+    char *name;			/* User name to use to find home directory. */
+    Tcl_DString *bufferPtr;	/* May be used to hold result.  Must not hold
+				 * anything at the time of the call, and need
+				 * not even be initialized. */
+{
+    struct passwd *pwPtr;
+
+    pwPtr = getpwnam(name);
+    if (pwPtr == NULL) {
+	endpwent();
+	return NULL;
+    }
+    Tcl_DStringInit(bufferPtr);
+    Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
+    endpwent();
+    return bufferPtr->string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMatchFiles --
+ *
+ *	This routine is used by the globbing code to search a
+ *	directory for all files which match a given pattern.
+ *
+ * Results: 
+ *	If the tail argument is NULL, then the matching files are
+ *	added to the interp->result.  Otherwise, TclDoGlob is called
+ *	recursively for each matching subdirectory.  The return value
+ *	is a standard Tcl result indicating whether an error occurred
+ *	in globbing.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMatchFiles(interp, separators, dirPtr, pattern, tail)
+    Tcl_Interp *interp;		/* Interpreter to receive results. */
+    char *separators;		/* Path separators to pass to TclDoGlob. */
+    Tcl_DString *dirPtr;	/* Contains path to directory to search. */
+    char *pattern;		/* Pattern to match against. */
+    char *tail;			/* Pointer to end of pattern. */
+{
+    char *dirName, *patternEnd = tail;
+    char savedChar = 0;		/* Initialization needed only to prevent
+				 * compiler warning from gcc. */
+    DIR *d;
+    struct stat statBuf;
+    struct dirent *entryPtr;
+    int matchHidden;
+    int result = TCL_OK;
+    int baseLength = Tcl_DStringLength(dirPtr);
+
+    /*
+     * Make sure that the directory part of the name really is a
+     * directory.  If the directory name is "", use the name "."
+     * instead, because some UNIX systems don't treat "" like "."
+     * automatically.  Keep the "" for use in generating file names,
+     * otherwise "glob foo.c" would return "./foo.c".
+     */
+
+    if (dirPtr->string[0] == '\0') {
+	dirName = ".";
+    } else {
+	dirName = dirPtr->string;
+    }
+    if ((TclStat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
+	return TCL_OK;
+    }
+
+    /*
+     * Check to see if the pattern needs to compare with hidden files.
+     */
+
+    if ((pattern[0] == '.')
+	    || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+	matchHidden = 1;
+    } else {
+	matchHidden = 0;
+    }
+
+    /*
+     * Now open the directory for reading and iterate over the contents.
+     */
+
+    d = opendir(dirName);
+    if (d == NULL) {
+	Tcl_ResetResult(interp);
+
+	/*
+	 * Strip off a trailing '/' if necessary, before reporting the error.
+	 */
+
+	if (baseLength > 0) {
+	    savedChar = dirPtr->string[baseLength-1];
+	    if (savedChar == '/') {
+		dirPtr->string[baseLength-1] = '\0';
+	    }
+	}
+	Tcl_AppendResult(interp, "couldn't read directory \"",
+		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	if (baseLength > 0) {
+	    dirPtr->string[baseLength-1] = savedChar;
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Clean up the end of the pattern and the tail pointer.  Leave
+     * the tail pointing to the first character after the path separator
+     * following the pattern, or NULL.  Also, ensure that the pattern
+     * is null-terminated.
+     */
+
+    if (*tail == '\\') {
+	tail++;
+    }
+    if (*tail == '\0') {
+	tail = NULL;
+    } else {
+	tail++;
+    }
+    savedChar = *patternEnd;
+    *patternEnd = '\0';
+
+    while (1) {
+	entryPtr = readdir(d);
+	if (entryPtr == NULL) {
+	    break;
+	}
+
+	/*
+	 * Don't match names starting with "." unless the "." is
+	 * present in the pattern.
+	 */
+
+	if (!matchHidden && (*entryPtr->d_name == '.')) {
+	    continue;
+	}
+
+	/*
+	 * Now check to see if the file matches.  If there are more
+	 * characters to be processed, then ensure matching files are
+	 * directories before calling TclDoGlob. Otherwise, just add
+	 * the file to the result.
+	 */
+
+	if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
+	    Tcl_DStringSetLength(dirPtr, baseLength);
+	    Tcl_DStringAppend(dirPtr, entryPtr->d_name, -1);
+	    if (tail == NULL) {
+		Tcl_AppendElement(interp, dirPtr->string);
+	    } else if ((TclStat(dirPtr->string, &statBuf) == 0)
+		    && S_ISDIR(statBuf.st_mode)) {
+		Tcl_DStringAppend(dirPtr, "/", 1);
+		result = TclDoGlob(interp, separators, dirPtr, tail);
+		if (result != TCL_OK) {
+		    break;
+		}
+	    }
+	}
+    }
+    *patternEnd = savedChar;
+
+    closedir(d);
+    return result;
+}
diff --git a/tcl/unix/tclUnixInit.c b/tcl/unix/tclUnixInit.c
new file mode 100644
index 00000000000..81217250d38
--- /dev/null
+++ b/tcl/unix/tclUnixInit.c
@@ -0,0 +1,282 @@
+/* 
+ * tclUnixInit.c --
+ *
+ *	Contains the Unix-specific interpreter initialization functions.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#if defined(__FreeBSD__)
+#   include <floatingpoint.h>
+#endif
+#if defined(__bsdi__)
+#   include <sys/param.h>
+#   if _BSDI_VERSION > 199501
+#	include <dlfcn.h>
+#   endif
+#endif
+
+/*
+ * Default directory in which to look for Tcl library scripts.  The
+ * symbol is defined by Makefile.
+ */
+
+static char defaultLibraryDir[sizeof(TCL_LIBRARY)+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[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
+
+/*
+ * Is this module initialized?
+ */
+
+static int initialized = 0;
+
+/*
+ * The Init script, tclPreInitScript variable, and the routine
+ * TclSetPreInitScript (common to Windows and Unix platforms) are defined
+ * in generic/tclInitScript.h.
+ */
+
+#include "tclInitScript.h"
+
+/*
+ * 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. */
+{
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPlatformInit --
+ *
+ *	Performs Unix-specific interpreter initialization related to the
+ *      tcl_library and tcl_platform variables, and other platform-
+ *	specific things.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets "tcl_library" and "tcl_platform" Tcl variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPlatformInit(interp)
+    Tcl_Interp *interp;
+{
+#ifndef NO_UNAME
+    struct utsname name;
+#endif
+    int unameOK;
+
+    tclPlatform = TCL_PLATFORM_UNIX;
+    Tcl_SetVar(interp, "tclDefaultLibrary", 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
+    if (uname(&name) >= 0) {
+	unameOK = 1;
+	Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
+		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(UCHAR(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);
+    }
+#endif
+    if (!unameOK) {
+	Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
+	Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
+	Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
+    }
+
+    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
+	 * die if they create child processes (e.g. using "exec" or
+	 * "open") that terminate prematurely.  The signal handler
+	 * is only set up when the first interpreter is created;
+	 * after this the application can override the handler with
+	 * a different one of its own, if it wants.
+	 */
+    
+#ifdef SIGPIPE
+	(void) signal(SIGPIPE, SIG_IGN);
+#endif /* SIGPIPE */
+
+#ifdef __FreeBSD__
+	fpsetround(FP_RN);
+	fpsetmask(0L);
+#endif
+
+#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
+	/*
+	 * Find local symbols. Don't report an error if we fail.
+	 */
+	(void) dlopen (NULL, RTLD_NOW);
+#endif
+	initialized = 1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Init --
+ *
+ *	This procedure is typically invoked by Tcl_AppInit procedures
+ *	to perform additional initialization for a Tcl interpreter,
+ *	such as sourcing the "init.tcl" script.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code and sets interp->result
+ *	if there is an error.
+ *
+ * Side effects:
+ *	Depends on what's in the init.tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter to initialize. */
+{
+    if (tclPreInitScript != NULL) {
+	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
+	    return (TCL_ERROR);
+	};
+    }
+    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/tcl/unix/tclUnixNotfy.c b/tcl/unix/tclUnixNotfy.c
new file mode 100644
index 00000000000..b2f163cb01f
--- /dev/null
+++ b/tcl/unix/tclUnixNotfy.c
@@ -0,0 +1,518 @@
+/*
+ * tclUnixNotify.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-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <signal.h> 
+
+/*
+ * 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.
+ */
+
+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_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. */
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_CreateFileHandler --
+ *
+ *	This procedure registers a file handler with the Xt notifier.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new file handler structure and registers one or more
+ *	input procedures with Xt.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+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 under which
+				 * proc should be called. */
+    Tcl_FileProc *proc;		/* Procedure to call for each
+				 * selected event. */
+    ClientData clientData;	/* Arbitrary data to pass to proc. */
+{
+    FileHandler *filePtr;
+    int index, bit;
+    
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+	    filePtr = filePtr->nextPtr) {
+	if (filePtr->fd == fd) {
+	    break;
+	}
+    }
+    if (filePtr == NULL) {
+	filePtr = (FileHandler*) ckalloc(sizeof(FileHandler)); /* MLK */
+	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) {
+	notifier.checkMasks[index] |= bit;
+    } else {
+	notifier.checkMasks[index] &= ~bit;
+    } 
+    if (mask & TCL_WRITABLE) {
+	(notifier.checkMasks+MASK_SIZE)[index] |= bit;
+    } else {
+	(notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
+    }
+    if (mask & TCL_EXCEPTION) {
+	(notifier.checkMasks+2*(MASK_SIZE))[index] |= bit;
+    } else {
+	(notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+    }
+    if (notifier.numFdBits <= fd) {
+	notifier.numFdBits = fd+1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fd)
+    int fd;		/* Stream id for which to remove callback procedure. */
+{
+    FileHandler *filePtr, *prevPtr;
+    int index, bit, i;
+    unsigned long flags;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    /*
+     * 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)));
+
+    if (filePtr->mask & TCL_READABLE) {
+	notifier.checkMasks[index] &= ~bit;
+    }
+    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--) {
+	    flags = notifier.checkMasks[index]
+		| (notifier.checkMasks+MASK_SIZE)[index]
+		| (notifier.checkMasks+2*(MASK_SIZE))[index];
+	    if (flags) {
+		for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) {
+		    if (flags & (((unsigned long)1) << (i-1))) {
+			break;
+		    }
+		}
+		notifier.numFdBits = index * (NBBY*sizeof(fd_mask)) + i;
+		break;
+	    }
+	}
+    }
+
+    /*
+     * Clean up information in the callback record.
+     */
+
+    if (prevPtr == NULL) {
+	notifier.firstFileHandlerPtr = filePtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = filePtr->nextPtr;
+    }
+    ckfree((char *) filePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileHandlerEventProc --
+ *
+ *	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:
+ *	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 = 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 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ *	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:
+ *	Returns -1 if the select would block forever, otherwise
+ *	returns 0.
+ *
+ * Side effects:
+ *	Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(timePtr)
+    Tcl_Time *timePtr;		/* Maximum block time, or NULL. */
+{
+    FileHandler *filePtr;
+    FileHandlerEvent *fileEvPtr;
+    struct timeval timeout, *timeoutPtr;
+    int bit, index, mask, numFound;
+
+    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;
+    }
+
+    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
+     * we have to do it here.
+     */
+
+    if (numFound == -1) {
+	memset((VOID *) notifier.readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+    }
+
+    /*
+     * Queue all detected file events before returning.
+     */
+
+    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;
+
+	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;
+	}
+
+	if (!mask) {
+	    continue;
+	} else {
+	    numFound--;
+	}
+
+	/*
+	 * Don't bother to queue an event if the mask was previously
+	 * non-zero since an event must still be on the queue.
+	 */
+
+	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);
+	}
+	filePtr->readyMask = mask;
+    }
+    return 0;
+}
diff --git a/tcl/unix/tclUnixPipe.c b/tcl/unix/tclUnixPipe.c
new file mode 100644
index 00000000000..2b71b9e51f6
--- /dev/null
+++ b/tcl/unix/tclUnixPipe.c
@@ -0,0 +1,1149 @@
+/* 
+ * 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-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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)(((int)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 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. */
+{
+    ClientData data;
+
+    if (Tcl_GetChannelHandle(channel, direction, (ClientData *) &data)
+	    == TCL_OK) {
+	return MakeFile((int)data);
+    } 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RestoreSignals --
+ *
+ *      This procedure is invoked in a forked child process just before
+ *      exec-ing a new program to restore all signals to their default
+ *      settings.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Signal settings get changed.
+ *
+ *----------------------------------------------------------------------
+ */
+ 
+static void
+RestoreSignals()
+{
+#ifdef SIGABRT
+    signal(SIGABRT, SIG_DFL);
+#endif
+#ifdef SIGALRM
+    signal(SIGALRM, SIG_DFL);
+#endif
+#ifdef SIGFPE
+    signal(SIGFPE, SIG_DFL);
+#endif
+#ifdef SIGHUP
+    signal(SIGHUP, SIG_DFL);
+#endif
+#ifdef SIGILL
+    signal(SIGILL, SIG_DFL);
+#endif
+#ifdef SIGINT
+    signal(SIGINT, SIG_DFL);
+#endif
+#ifdef SIGPIPE
+    signal(SIGPIPE, SIG_DFL);
+#endif
+#ifdef SIGQUIT
+    signal(SIGQUIT, SIG_DFL);
+#endif
+#ifdef SIGSEGV
+    signal(SIGSEGV, SIG_DFL);
+#endif
+#ifdef SIGTERM
+    signal(SIGTERM, SIG_DFL);
+#endif
+#ifdef SIGUSR1
+    signal(SIGUSR1, SIG_DFL);
+#endif
+#ifdef SIGUSR2
+    signal(SIGUSR2, SIG_DFL);
+#endif
+#ifdef SIGCHLD
+    signal(SIGCHLD, SIG_DFL);
+#endif
+#ifdef SIGCONT
+    signal(SIGCONT, SIG_DFL);
+#endif
+#ifdef SIGTSTP
+    signal(SIGTSTP, SIG_DFL);
+#endif
+#ifdef SIGTTIN
+    signal(SIGTTIN, SIG_DFL);
+#endif
+#ifdef SIGTTOU
+    signal(SIGTTOU, SIG_DFL);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupStdFile --
+ *
+ *	Set up stdio file handles for the child process, using the
+ *	current standard channels if no other files are specified.
+ *	If no standard channel is defined, or if no file is associated
+ *	with the channel, then the corresponding standard fd is closed.
+ *
+ * Results:
+ *	Returns 1 on success, or 0 on failure.
+ *
+ * Side effects:
+ *	Replaces stdio fds.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetupStdFile(file, type)
+    TclFile file;		/* File to dup, or NULL. */
+    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR */
+{
+    Tcl_Channel channel;
+    int fd;
+    int targetFd = 0;		/* Initializations here needed only to */
+    int direction = 0;		/* prevent warnings about using uninitialized
+				 * variables. */
+
+    switch (type) {
+	case TCL_STDIN:
+	    targetFd = 0;
+	    direction = TCL_READABLE;
+	    break;
+	case TCL_STDOUT:
+	    targetFd = 1;
+	    direction = TCL_WRITABLE;
+	    break;
+	case TCL_STDERR:
+	    targetFd = 2;
+	    direction = TCL_WRITABLE;
+	    break;
+    }
+
+    if (!file) {
+	channel = Tcl_GetStdChannel(type);
+	if (channel) {
+	    file = TclpMakeFile(channel, direction);
+	}
+    }
+    if (file) {
+	fd = GetFd(file);
+	if (fd != targetFd) {
+	    if (dup2(fd, targetFd) == -1) {
+		return 0;
+	    }
+
+            /*
+             * Must clear the close-on-exec flag for the target FD, since
+             * some systems (e.g. Ultrix) do not clear the CLOEXEC flag on
+             * the target FD.
+             */
+            
+            fcntl(targetFd, F_SETFD, 0);
+	} else {
+	    int result;
+
+	    /*
+	     * Since we aren't dup'ing the file, we need to explicitly clear
+	     * the close-on-exec flag.
+	     */
+
+	    result = fcntl(fd, F_SETFD, 0);
+	}
+    } else {
+	close(targetFd);
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateCommandChannel --
+ *
+ *	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
+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;
+
+    statePtr->inFile = readFile;
+    statePtr->outFile = writeFile;
+    statePtr->errorFile = errorFile;
+    statePtr->numPids = numPids;
+    statePtr->pidPtr = pidPtr;
+    statePtr->isNonBlocking = 0;
+
+    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.
+     */
+
+    if (readFile) {
+	channelId = GetFd(readFile);
+    } else if (writeFile) {
+	channelId = GetFd(writeFile);
+    } else if (errorFile) {
+	channelId = GetFd(errorFile);
+    } 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);
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclGetAndDetachPids(interp, chan)
+    Tcl_Interp *interp;
+    Tcl_Channel chan;
+{
+    PipeState *pipePtr;
+    Tcl_ChannelType *chanTypePtr;
+    int i;
+    char buf[20];
+
+    /*
+     * Punt if the channel is not a command channel.
+     */
+
+    chanTypePtr = Tcl_GetChannelType(chan);
+    if (chanTypePtr != &pipeChannelType) {
+        return;
+    }
+
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* 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;
+
+#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 */
+
+#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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* 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;
+
+    errorCode = 0;
+    result = 0;
+    pipePtr = (PipeState *) instanceData;
+    if (pipePtr->inFile) {
+	if (TclpCloseFile(pipePtr->inFile) < 0) {
+	    errorCode = errno;
+	}
+    }
+    if (pipePtr->outFile) {
+	if ((TclpCloseFile(pipePtr->outFile) < 0) && (errorCode == 0)) {
+	    errorCode = errno;
+	}
+    }
+
+    if (pipePtr->isNonBlocking || TclInExit()) {
+    
+	/*
+         * 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 {
+        
+	/*
+         * Wrap the error file into a channel and give it to the cleanup
+         * routine.
+         */
+
+        if (pipePtr->errorFile) {
+	    errChan = Tcl_MakeFileChannel(
+		(ClientData) GetFd(pipePtr->errorFile), TCL_READABLE);
+        } else {
+            errChan = NULL;
+        }
+        result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
+                errChan);
+    }
+
+    if (pipePtr->numPids != 0) {
+        ckfree((char *) pipePtr->pidPtr);
+    }
+    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;
+    
+    /*
+     * 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.
+     */
+
+    bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead);
+    if (bytesRead > -1) {
+        return bytesRead;
+    }
+    *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;
+    }
+    *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 (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));
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeGetHandleProc --
+ *
+ *	Called from Tcl_GetChannelHandle to retrieve OS handles from
+ *	inside a command pipeline 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
+PipeGetHandleProc(instanceData, direction, handlePtr)
+    ClientData instanceData;	/* The pipe state. */
+    int direction;		/* TCL_READABLE or TCL_WRITABLE */
+    ClientData *handlePtr;	/* Where to store the handle.  */
+{
+    PipeState *psPtr = (PipeState *) instanceData;
+
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Pid
+Tcl_WaitPid(pid, statPtr, options)
+    Tcl_Pid 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 (Tcl_Pid) result;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PidObjCmd --
+ *
+ *	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_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_Channel chan;
+    Tcl_ChannelType *chanTypePtr;
+    PipeState *pipePtr;
+    int i;
+    Tcl_Obj *resultPtr, *longObjPtr;
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
+	return TCL_ERROR;
+    }
+    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;
+	}
+	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 TCL_OK;
+}
diff --git a/tcl/unix/tclUnixPort.h b/tcl/unix/tclUnixPort.h
new file mode 100644
index 00000000000..fb9152f3e13
--- /dev/null
+++ b/tcl/unix/tclUnixPort.h
@@ -0,0 +1,494 @@
+/*
+ * tclUnixPort.h --
+ *
+ *	This header file handles porting issues that occur because
+ *	of differences between systems.  It reads in UNIX-related
+ *	header files and sets up UNIX-related macros for Tcl's UNIX
+ *	core.  It should be the only file that contains #ifdefs to
+ *	handle different flavors of UNIX.  This file sets up the
+ *	union of all UNIX-related things needed by any of the Tcl
+ *	core files.  This file depends on configuration #defines such
+ *	as NO_DIRENT_H that are set up by the "configure" script.
+ *
+ *	Much of the material in this file was originally contributed
+ *	by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLUNIXPORT
+#define _TCLUNIXPORT
+
+#ifndef _TCLINT
+#   include "tclInt.h"
+#endif
+#include <errno.h>
+#include <fcntl.h>
+#ifdef HAVE_NET_ERRNO_H
+#   include <net/errno.h>
+#endif
+#include <pwd.h>
+#include <signal.h>
+#include <sys/param.h>
+#include <sys/types.h>
+#ifdef USE_DIRENT2_H
+#   include "../compat/dirent2.h"
+#else
+#   ifdef NO_DIRENT_H
+#	include "../compat/dirent.h"
+#   else
+#	include <dirent.h>
+#   endif
+#endif
+#include <sys/file.h>
+#ifdef HAVE_SYS_SELECT_H
+#   include <sys/select.h>
+#endif
+#include <sys/stat.h>
+#if TIME_WITH_SYS_TIME
+#   include <sys/time.h>
+#   include <time.h>
+#else
+#   if HAVE_SYS_TIME_H
+#       include <sys/time.h>
+#   else
+#       include <time.h>
+#   endif
+#endif
+#ifndef NO_SYS_WAIT_H
+#   include <sys/wait.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#   include <unistd.h>
+#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
+ * each system.
+ */
+
+#include <sys/socket.h>		/* struct sockaddr, SOCK_STREAM, ... */
+#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.
+ */
+
+#ifndef O_NONBLOCK
+#   define O_NONBLOCK 0x80
+#endif
+
+/*
+ * HPUX needs the flag O_NONBLOCK to get the right non-blocking I/O
+ * semantics, while most other systems need O_NDELAY.  Define the
+ * constant NBIO_FLAG to be one of these
+ */
+
+#ifdef HPUX
+#  define NBIO_FLAG O_NONBLOCK
+#else
+#  define NBIO_FLAG O_NDELAY
+#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:
+ */
+
+#define	TCL_PLATFORM_TRANSLATION	TCL_TRANSLATE_LF
+
+/*
+ * Not all systems declare the errno variable in errno.h. so this
+ * file does it explicitly.  The list of system error messages also
+ * isn't generally declared in a header file anywhere.
+ */
+
+extern int errno;
+
+/*
+ * The type of the status returned by wait varies from UNIX system
+ * to UNIX system.  The macro below defines it:
+ */
+
+#ifdef _AIX
+#   define WAIT_STATUS_TYPE pid_t
+#else
+#ifndef NO_UNION_WAIT
+#   define WAIT_STATUS_TYPE union wait
+#else
+#   define WAIT_STATUS_TYPE int
+#endif
+#endif
+
+/*
+ * Supply definitions for macros to query wait status, if not already
+ * defined in header files above.
+ */
+
+#ifndef WIFEXITED
+#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
+#endif
+
+#ifndef WEXITSTATUS
+#   define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+#endif
+
+#ifndef WIFSIGNALED
+#   define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
+#endif
+
+#ifndef WTERMSIG
+#   define WTERMSIG(stat)    ((*((int *) &(stat))) & 0x7f)
+#endif
+
+#ifndef WIFSTOPPED
+#   define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
+#endif
+
+#ifndef WSTOPSIG
+#   define WSTOPSIG(stat)    (((*((int *) &(stat))) >> 8) & 0xff)
+#endif
+
+/*
+ * Define constants for waitpid() system call if they aren't defined
+ * by a system header file.
+ */
+
+#ifndef WNOHANG
+#   define WNOHANG 1
+#endif
+#ifndef WUNTRACED
+#   define WUNTRACED 2
+#endif
+
+/*
+ * Supply macros for seek offsets, if they're not already provided by
+ * an include file.
+ */
+
+#ifndef SEEK_SET
+#   define SEEK_SET 0
+#endif
+
+#ifndef SEEK_CUR
+#   define SEEK_CUR 1
+#endif
+
+#ifndef SEEK_END
+#   define SEEK_END 2
+#endif
+
+/*
+ * The stuff below is needed by the "time" command.  If this
+ * system has no gettimeofday call, then must use times and the
+ * CLK_TCK #define (from sys/param.h) to compute elapsed time.
+ * Unfortunately, some systems only have HZ and no CLK_TCK, and
+ * some might not even have HZ.
+ */
+
+#ifdef NO_GETTOD
+#   include <sys/times.h>
+#   include <sys/param.h>
+#   ifndef CLK_TCK
+#       ifdef HZ
+#           define CLK_TCK HZ
+#       else
+#           define CLK_TCK 60
+#       endif
+#   endif
+#else
+#   ifdef HAVE_BSDGETTIMEOFDAY
+#	define gettimeofday BSDgettimeofday
+#   endif
+#endif
+
+#ifdef GETTOD_NOT_DECLARED
+EXTERN int		gettimeofday _ANSI_ARGS_((struct timeval *tp,
+			    struct timezone *tzp));
+#endif
+
+/*
+ * Define access mode constants if they aren't already defined.
+ */
+
+#ifndef F_OK
+#    define F_OK 00
+#endif
+#ifndef X_OK
+#    define X_OK 01
+#endif
+#ifndef W_OK
+#    define W_OK 02
+#endif
+#ifndef R_OK
+#    define R_OK 04
+#endif
+
+/*
+ * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't
+ * already defined.
+ */
+
+#ifndef FD_CLOEXEC
+#   define FD_CLOEXEC 1
+#endif
+
+/*
+ * On UNIX, there's no platform specific implementation of "TclpStat(...)"
+ * or "TclpAccess(...)".  Simply call "stat(...)' and "access(...)"
+ * respectively.
+ */
+
+#define TclpStat	stat
+#define TclpAccess	access
+
+/*
+ * On systems without symbolic links (i.e. S_IFLNK isn't defined)
+ * define "lstat" to use "stat" instead.
+ */
+
+#ifndef S_IFLNK
+#   define lstat stat
+#endif
+
+/*
+ * Define macros to query file type bits, if they're not already
+ * defined.
+ */
+
+#ifndef S_ISREG
+#   ifdef S_IFREG
+#       define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+#   else
+#       define S_ISREG(m) 0
+#   endif
+# endif
+#ifndef S_ISDIR
+#   ifdef S_IFDIR
+#       define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+#   else
+#       define S_ISDIR(m) 0
+#   endif
+# endif
+#ifndef S_ISCHR
+#   ifdef S_IFCHR
+#       define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
+#   else
+#       define S_ISCHR(m) 0
+#   endif
+# endif
+#ifndef S_ISBLK
+#   ifdef S_IFBLK
+#       define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
+#   else
+#       define S_ISBLK(m) 0
+#   endif
+# endif
+#ifndef S_ISFIFO
+#   ifdef S_IFIFO
+#       define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+#   else
+#       define S_ISFIFO(m) 0
+#   endif
+# endif
+#ifndef S_ISLNK
+#   ifdef S_IFLNK
+#       define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+#   else
+#       define S_ISLNK(m) 0
+#   endif
+# endif
+#ifndef S_ISSOCK
+#   ifdef S_IFSOCK
+#       define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
+#   else
+#       define S_ISSOCK(m) 0
+#   endif
+# endif
+
+/*
+ * Make sure that MAXPATHLEN is defined.
+ */
+
+#ifndef MAXPATHLEN
+#   ifdef PATH_MAX
+#       define MAXPATHLEN PATH_MAX
+#   else
+#       define MAXPATHLEN 2048
+#   endif
+#endif
+
+/*
+ * Make sure that L_tmpnam is defined.
+ */
+
+#ifndef L_tmpnam
+#   define L_tmpnam 100
+#endif
+
+/*
+ * The following macro defines the type of the mask arguments to
+ * select:
+ */
+
+#ifndef NO_FD_SET
+#   define SELECT_MASK fd_set
+#else
+#   ifndef _AIX
+	typedef long fd_mask;
+#   endif
+#   if defined(_IBMR2)
+#	define SELECT_MASK void
+#   else
+#	define SELECT_MASK int
+#   endif
+#endif
+
+/*
+ * Define "NBBY" (number of bits per byte) if it's not already defined.
+ */
+
+#ifndef NBBY
+#   define NBBY 8
+#endif
+
+/*
+ * The following macro defines the number of fd_masks in an fd_set:
+ */
+
+#ifndef FD_SETSIZE
+#   ifdef OPEN_MAX
+#	define FD_SETSIZE OPEN_MAX
+#   else
+#	define FD_SETSIZE 256
+#   endif
+#endif
+#if !defined(howmany)
+#   define howmany(x, y) (((x)+((y)-1))/(y))
+#endif
+#ifndef NFDBITS
+#   define NFDBITS NBBY*sizeof(fd_mask)
+#endif
+#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+
+/*
+ * The following implements the Unix method for exiting the process.
+ */
+#define TclPlatformExit(status) exit(status)
+
+/*
+ * The following functions always succeeds under Unix.
+ */
+
+#define TclHasSockets(interp) (TCL_OK)
+
+/*
+ * Variables provided by the C library:
+ */
+
+#if defined(_sgi) || defined(__sgi)
+#define environ _environ
+#endif
+extern char **environ;
+
+/*
+ * At present (12/91) not all stdlib.h implementations declare strtod.
+ * The declaration below is here to ensure that it's declared, so that
+ * the compiler won't take the default approach of assuming it returns
+ * an int.  There's no ANSI prototype for it because there would end
+ * up being too many conflicts with slightly-different prototypes.
+ */
+
+extern double strtod();
+
+/*
+ * The following macros define time related functions in terms of
+ * standard Unix routines.
+ */
+
+#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)	
+
+/*
+ * TclpFinalize is a noop on Unix systems.
+ */
+
+#define TclpFinalize()
+
+/*
+ * 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/tcl/unix/tclUnixSock.c b/tcl/unix/tclUnixSock.c
new file mode 100644
index 00000000000..7f9597905d9
--- /dev/null
+++ b/tcl/unix/tclUnixSock.c
@@ -0,0 +1,100 @@
+/* 
+ * tclUnixSock.c --
+ *
+ *	This file contains Unix-specific socket related code.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include "tclPort.h"
+
+/*
+ * There is no portable macro for the maximum length
+ * of host names returned by gethostbyname().  We should only
+ * trust SYS_NMLN if it is at least 255 + 1 bytes to comply with DNS
+ * host name limits.
+ *
+ * Note:  SYS_NMLN is a restriction on "uname" not on gethostbyname!
+ *
+ * For example HP-UX 10.20 has SYS_NMLN == 9,  while gethostbyname()
+ * can return a fully qualified name from DNS of up to 255 bytes.
+ *
+ * Fix suggested by Viktor Dukhovni (viktor@esm.com)
+ */
+
+#if defined(SYS_NMLN) && SYS_NMLEN >= 256
+#define TCL_HOSTNAME_LEN SYS_NMLEN
+#else
+#define TCL_HOSTNAME_LEN 256
+#endif
+
+
+/*
+ * The following variable holds the network name of this host.
+ */
+
+static char hostname[TCL_HOSTNAME_LEN + 1];
+static int  hostnameInited = 0;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetHostName --
+ *
+ *	Returns the name of the local host.
+ *
+ * Results:
+ *	A string containing the network name for this machine, or
+ *	an empty string if we can't figure out the name.  The caller 
+ *	must not modify or free this string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetHostName()
+{
+#ifndef NO_UNAME
+    struct utsname u;
+    struct hostent *hp;
+#endif
+
+    if (hostnameInited) {
+        return hostname;
+    }
+
+#ifndef NO_UNAME
+    (VOID *) memset((VOID *) &u, (int) 0, sizeof(struct utsname));
+    if (uname(&u) > -1) {
+        hp = gethostbyname(u.nodename);
+        if (hp != NULL) {
+            strcpy(hostname, hp->h_name);
+        } else {
+            strcpy(hostname, u.nodename);
+        }
+        hostnameInited = 1;
+        return hostname;
+    }
+#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/tcl/unix/tclUnixTest.c b/tcl/unix/tclUnixTest.c
new file mode 100644
index 00000000000..d731e5530ee
--- /dev/null
+++ b/tcl/unix/tclUnixTest.c
@@ -0,0 +1,607 @@
+/* 
+ * tclUnixTest.c --
+ *
+ *	Contains platform specific test commands for the Unix platform.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The headers are needed for the testalarm command that verifies the
+ * use of SA_RESTART in signal handlers.
+ */
+
+#include <signal.h>
+#include <sys/resource.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 {
+    TclFile readFile;		/* File handle for reading from the
+				 * pipe.  NULL means pipe doesn't exist yet. */
+    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
+				 * was readable. */
+    int writeCount;		/* Number of times the file handler for
+				 * this file has triggered and the file
+				 * was writable. */
+} Pipe;
+
+#define MAX_PIPES 10
+static Pipe testPipes[MAX_PIPES];
+
+/*
+ * The stuff below is used by the testalarm and testgotsig ommands.
+ */
+
+static char *gotsig = "0";
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+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		TestfindexecutableCmd _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));
+static int		TestalarmCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestgotsigCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static void 		AlarmHandler _ANSI_ARGS_(());
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclplatformtestInit --
+ *
+ *	Defines commands that test platform specific functionality for
+ *	Unix platforms.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclplatformtestInit(interp)
+    Tcl_Interp *interp;		/* Interpreter to add commands to. */
+{
+    Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestfilehandlerCmd --
+ *
+ *	This procedure implements the "testfilehandler" command. It is
+ *	used to test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and
+ *	TclWaitForFile.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfilehandlerCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Pipe *pipePtr;
+    int i, mask, timeout;
+    static int initialized = 0;
+    char buffer[4000];
+    TclFile file;
+
+    /*
+     * NOTE: When we make this code work on Windows also, the following
+     * variable needs to be made Unix-only.
+     */
+    
+    if (!initialized) {
+	for (i = 0; i < MAX_PIPES; i++) {
+	    testPipes[i].readFile = NULL;
+	}
+	initialized = 1;
+    }
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " option ... \"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    pipePtr = NULL;
+    if (argc >= 3) {
+	if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (i >= MAX_PIPES) {
+	    Tcl_AppendResult(interp, "bad index ", argv[2], (char *) NULL);
+	    return TCL_ERROR;
+	}
+	pipePtr = &testPipes[i];
+    }
+
+    if (strcmp(argv[1], "close") == 0) {
+	for (i = 0; i < MAX_PIPES; i++) {
+	    if (testPipes[i].readFile != NULL) {
+		TclpCloseFile(testPipes[i].readFile);
+		testPipes[i].readFile = NULL;
+		TclpCloseFile(testPipes[i].writeFile);
+		testPipes[i].writeFile = NULL;
+	    }
+	}
+    } else if (strcmp(argv[1], "clear") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+                    argv[0], " clear index\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	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(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 \"",
+                    argv[0], " create index readMode writeMode\"",
+                    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (pipePtr->readFile == NULL) {
+	    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(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
+	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
+#else
+	    Tcl_SetResult(interp, "can't make pipes non-blocking",
+		    TCL_STATIC);
+	    return TCL_ERROR;
+#endif
+	}
+	pipePtr->readCount = 0;
+	pipePtr->writeCount = 0;
+
+	if (strcmp(argv[3], "readable") == 0) {
+	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
+		    TestFileHandlerProc, (ClientData) pipePtr);
+	} else if (strcmp(argv[3], "off") == 0) {
+	    Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
+	} else if (strcmp(argv[3], "disabled") == 0) {
+	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
+		    TestFileHandlerProc, (ClientData) pipePtr);
+	} else {
+	    Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (strcmp(argv[4], "writable") == 0) {
+	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
+		    TestFileHandlerProc, (ClientData) pipePtr);
+	} else if (strcmp(argv[4], "off") == 0) {
+	    Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
+	} else if (strcmp(argv[4], "disabled") == 0) {
+	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
+		    TestFileHandlerProc, (ClientData) pipePtr);
+	} else {
+	    Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+    } else if (strcmp(argv[1], "empty") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+                    argv[0], " empty index\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+
+        while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
+            /* Empty loop body. */
+        }
+    } else if (strcmp(argv[1], "fill") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+                    argv[0], " empty index\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+
+	memset((VOID *) buffer, 'a', 4000);
+        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;
+	}
+
+	memset((VOID *) buffer, 'b', 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) {
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+                    argv[0], " wait index readable/writable timeout\"",
+                    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (pipePtr->readFile == NULL) {
+	    Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (strcmp(argv[3], "readable") == 0) {
+	    mask = TCL_READABLE;
+	    file = pipePtr->readFile;
+	} else {
+	    mask = TCL_WRITABLE;
+	    file = pipePtr->writeFile;
+	}
+	if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	i = TclUnixWaitForFile(GetFd(file), mask, timeout);
+	if (i & TCL_READABLE) {
+	    Tcl_AppendElement(interp, "readable");
+	}
+	if (i & TCL_WRITABLE) {
+	    Tcl_AppendElement(interp, "writable");
+	}
+    } else if (strcmp(argv[1], "windowevent") == 0) {
+	Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be close, clear, counts, create, empty, fill, ",
+		"fillpartial, oneevent, wait, or windowevent",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+static void TestFileHandlerProc(clientData, mask)
+    ClientData clientData;	/* Points to a Pipe structure. */
+    int mask;			/* Indicates which events happened:
+				 * TCL_READABLE or TCL_WRITABLE. */
+{
+    Pipe *pipePtr = (Pipe *) clientData;
+
+    if (mask & TCL_READABLE) {
+	pipePtr->readCount++;
+    }
+    if (mask & TCL_WRITABLE) {
+	pipePtr->writeCount++;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    ClientData data;
+
+    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*) &data) != TCL_OK) {
+	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+	return TCL_ERROR;
+    }
+    fd = (int) data;
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestfindexecutableCmd --
+ *
+ *	This procedure implements the "testfindexecutable" command. It is
+ *	used to test Tcl_FindExecutable.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfindexecutableCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    char *oldName;
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" argv0\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+    oldName = tclExecutableName;
+    tclExecutableName = NULL;
+    Tcl_FindExecutable(argv[1]);
+    if (tclExecutableName != NULL) {
+	Tcl_SetResult(interp, tclExecutableName, TCL_VOLATILE);
+	ckfree(tclExecutableName);
+    }
+    tclExecutableName = oldName;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetopenfileCmd --
+ *
+ *	This procedure implements the "testgetopenfile" command. It is
+ *	used to get a FILE * value from a registered channel.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetopenfileCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    ClientData filePtr;
+
+    if (argc != 3) {
+        Tcl_AppendResult(interp,
+                "wrong # args: should be \"", argv[0],
+                " channelName forWriting\"",
+                (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
+            == TCL_ERROR) {
+        return TCL_ERROR;
+    }
+    if (filePtr == (ClientData) NULL) {
+        Tcl_AppendResult(interp,
+                "Tcl_GetOpenFile succeeded but FILE * NULL!", (char *) NULL);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TestalarmCmd --
+ *
+ *	Test that EINTR is handled correctly by generating and
+ *	handling a signal.  This requires using the SA_RESTART
+ *	flag when registering the signal handler.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	Sets up an signal and async handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestalarmCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+#ifdef SA_RESTART
+    unsigned int sec;
+    struct sigaction action;
+
+    if (argc > 1) {
+	Tcl_GetInt(interp, argv[1], (int *)&sec);
+    } else {
+	sec = 1;
+    }
+
+    /*
+     * Setup the signal handling that automatically retries
+     * any interupted I/O system calls.
+     */
+    action.sa_handler = AlarmHandler;
+    memset((void *)&action.sa_mask, 0, sizeof(sigset_t));
+    action.sa_flags = SA_RESTART;
+
+    if (sigaction(SIGALRM, &action, NULL) < 0) {
+	Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
+	return TCL_ERROR;
+    }
+    if (alarm(sec) < 0) {
+	Tcl_AppendResult(interp, "alarm: ", Tcl_PosixError(interp), NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+#else
+    Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL);
+    return TCL_ERROR;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AlarmHandler --
+ *
+ *	Signal handler for the alarm command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ * 	Calls the Tcl Async handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AlarmHandler()
+{
+    gotsig = "1";
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TestgotsigCmd --
+ *
+ * 	Verify the signal was handled after the testalarm command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	Resets the value of gotsig back to '0'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgotsigCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    Tcl_AppendResult(interp, gotsig, (char *) NULL);
+    gotsig = "0";
+    return TCL_OK;
+}
diff --git a/tcl/unix/tclUnixTime.c b/tcl/unix/tclUnixTime.c
new file mode 100644
index 00000000000..17ceba1cde9
--- /dev/null
+++ b/tcl/unix/tclUnixTime.c
@@ -0,0 +1,236 @@
+/* 
+ * tclUnixTime.c --
+ *
+ *	Contains Unix specific versions of Tcl functions that
+ *	obtain time values from the operating system.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpGetSeconds --
+ *
+ *	This procedure returns the number of seconds from the epoch.  On
+ *	most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ *
+ * Results:
+ *	Number of seconds from the epoch.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetSeconds()
+{
+    return time((time_t *) NULL);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpGetClicks --
+ *
+ *	This procedure returns a value that represents the highest resolution
+ *	clock available on the system.  There are no garantees on what the
+ *	resolution will be.  In Tcl we will call this value a "click".  The
+ *	start time is also system dependant.
+ *
+ * Results:
+ *	Number of clicks from some start time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetClicks()
+{
+    unsigned long now;
+#ifdef NO_GETTOD
+    struct tms dummy;
+#else
+    struct timeval date;
+    struct timezone tz;
+#endif
+
+#ifdef NO_GETTOD
+    now = (unsigned long) times(&dummy);
+#else
+    gettimeofday(&date, &tz);
+    now = date.tv_sec*1000000 + date.tv_usec;
+#endif
+
+    return now;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTimeZone --
+ *
+ *	Determines the current timezone.  The method varies wildly
+ *	between different platform implementations, so its hidden in
+ *	this function.
+ *
+ * Results:
+ *	The return value is the local time zone, measured in
+ *	minutes away from GMT (-ve for east, +ve for west).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetTimeZone (currentTime)
+    unsigned long  currentTime;
+{
+    /*
+     * Determine how a timezone is obtained from "struct tm".  If there is no
+     * time zone in this struct (very lame) then use the timezone variable.
+     * This is done in a way to make the timezone variable the method of last
+     * resort, as some systems have it in addition to a field in "struct tm".
+     * The gettimeofday system call can also be used to determine the time
+     * zone.
+     */
+    
+#if defined(HAVE_TM_TZADJ)
+#   define TCL_GOT_TIMEZONE
+    time_t      curTime = (time_t) currentTime;
+    struct tm  *timeDataPtr = localtime(&curTime);
+    int         timeZone;
+
+    timeZone = timeDataPtr->tm_tzadj  / 60;
+    if (timeDataPtr->tm_isdst) {
+        timeZone += 60;
+    }
+    
+    return timeZone;
+#endif
+
+#if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
+#   define TCL_GOT_TIMEZONE
+    time_t     curTime = (time_t) currentTime;
+    struct tm *timeDataPtr = localtime(&curTime);
+    int        timeZone;
+
+    timeZone = -(timeDataPtr->tm_gmtoff / 60);
+    if (timeDataPtr->tm_isdst) {
+        timeZone += 60;
+    }
+    
+    return timeZone;
+#endif
+
+#if defined(USE_DELTA_FOR_TZ)
+#define TCL_GOT_TIMEZONE 1
+    /*
+     * This hack replaces using global var timezone or gettimeofday
+     * in situations where they are buggy such as on AIX when libbsd.a
+     * is linked in.
+     */
+
+    int timeZone;
+    time_t tt;
+    struct tm *stm;
+    tt = 849268800L;      /*    1996-11-29 12:00:00  GMT */
+    stm = localtime(&tt); /* eg 1996-11-29  6:00:00  CST6CDT */
+    /* The calculation below assumes a max of +12 or -12 hours from GMT */
+    timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
+    return timeZone;  /* eg +360 for CST6CDT */
+#endif
+
+    /*
+     * Must prefer timezone variable over gettimeofday, as gettimeofday does
+     * not return timezone information on many systems that have moved this
+     * information outside of the kernel.
+     */
+    
+#if defined(HAVE_TIMEZONE_VAR) && !defined (TCL_GOT_TIMEZONE)
+#   define TCL_GOT_TIMEZONE
+    static int setTZ = 0;
+    int        timeZone;
+
+    if (!setTZ) {
+        tzset();
+        setTZ = 1;
+    }
+
+    /*
+     * Note: this is not a typo in "timezone" below!  See tzset
+     * documentation for details.
+     */
+
+    timeZone = timezone / 60;
+
+    return timeZone;
+#endif
+
+#if !defined(NO_GETTOD) && !defined (TCL_GOT_TIMEZONE)
+#   define TCL_GOT_TIMEZONE
+    struct timeval  tv;
+    struct timezone tz;
+    int timeZone;
+
+    gettimeofday(&tv, &tz);
+    timeZone = tz.tz_minuteswest;
+    if (tz.tz_dsttime) {
+        timeZone += 60;
+    }
+    
+    return timeZone;
+#endif
+
+#ifndef TCL_GOT_TIMEZONE
+    /*
+     * Cause compile error, we don't know how to get timezone.
+     */
+    error: autoconf did not figure out how to determine the timezone. 
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTime --
+ *
+ *	Gets the current system time in seconds and microseconds
+ *	since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ *	Returns the current time in timePtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpGetTime(timePtr)
+    Tcl_Time *timePtr;		/* Location to store time information. */
+{
+    struct timeval tv;
+    struct timezone tz;
+    
+    (void) gettimeofday(&tv, &tz);
+    timePtr->sec = tv.tv_sec;
+    timePtr->usec = tv.tv_usec;
+}
diff --git a/tcl/unix/tclXtNotify.c b/tcl/unix/tclXtNotify.c
new file mode 100644
index 00000000000..4730cdd104f
--- /dev/null
+++ b/tcl/unix/tclXtNotify.c
@@ -0,0 +1,656 @@
+/* 

+ * tclXtNotify.c --

+ *

+ *	This file contains the notifier driver implementation for the

+ *	Xt intrinsics.

+ *

+ * 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.

+ *

+ * RCS: @(#) $Id$
+ */

+

+#include <X11/Intrinsic.h>

+#include <tclInt.h>

+

+/*

+ * 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;		/* Events that have been seen since the

+				   last time FileHandlerEventProc was called

+				   for this file. */

+    XtInputId read;		/* Xt read callback handle. */

+    XtInputId write;		/* Xt write callback handle. */

+    XtInputId except;		/* Xt exception callback handle. */

+    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.

+ */

+

+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

+ * Xt based implementation of the Tcl notifier.

+ */

+

+static struct NotifierState {

+    XtAppContext appContext;		/* The context used by the Xt

+                                         * notifier. Can be set with

+                                         * TclSetAppContext. */

+    int appContextCreated;		/* Was it created by us? */

+    XtIntervalId currentTimeout;	/* Handle of current timer. */

+    FileHandler *firstFileHandlerPtr;	/* Pointer to head of file handler

+					 * list. */

+} notifier;

+

+/*

+ * The following static indicates whether this module has been initialized.

+ */

+

+static int initialized = 0;

+

+/*

+ * Static routines defined in this file.

+ */

+

+static int		FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,

+			    int flags));

+static void		FileProc _ANSI_ARGS_((caddr_t clientData,

+			    int *source, XtInputId *id));

+static void		InitNotifier _ANSI_ARGS_((void));

+static void		NotifierExitHandler _ANSI_ARGS_((

+			    ClientData clientData));

+static void		TimerProc _ANSI_ARGS_((caddr_t clientData,

+			    XtIntervalId *id));

+

+/*

+ * Functions defined in this file for use by users of the Xt Notifier:

+ */

+

+EXTERN XtAppContext	TclSetAppContext _ANSI_ARGS_((XtAppContext ctx));

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * TclSetAppContext --

+ *

+ *	Set the notifier application context.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Sets the application context used by the notifier. Panics if

+ *	the context is already set when called.

+ *

+ *----------------------------------------------------------------------

+ */

+

+XtAppContext

+TclSetAppContext(appContext)

+    XtAppContext	appContext;

+{

+    if (!initialized) {

+        InitNotifier();

+    }

+

+    /*

+     * If we already have a context we check whether we were asked to set a

+     * new context. If so, we panic because we try to prevent switching

+     * contexts by mistake. Otherwise, we return the one we have.

+     */

+    

+    if (notifier.appContext != NULL) {

+        if (appContext != NULL) {

+

+	    /*

+             * We already have a context. We do not allow switching contexts

+             * after initialization, so we panic.

+             */

+        

+            panic("TclSetAppContext:  multiple application contexts");

+

+        }

+    } else {

+

+        /*

+         * If we get here we have not yet gotten a context, so either create

+         * one or use the one supplied by our caller.

+         */

+

+        if (appContext == NULL) {

+

+	    /*

+             * We must create a new context and tell our caller what it is, so

+             * she can use it too.

+             */

+    

+            notifier.appContext = XtCreateApplicationContext();

+            notifier.appContextCreated = 1;

+        } else {

+

+	    /*

+             * Otherwise we remember the context that our caller gave us

+             * and use it.

+             */

+    

+            notifier.appContextCreated = 0;

+            notifier.appContext = appContext;

+        }

+    }

+    

+    return notifier.appContext;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * InitNotifier --

+ *

+ *	Initializes the notifier state.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Creates a new exit handler.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+InitNotifier(void)

+{

+    /*

+     * Only reinitialize if we are not in exit handling. The notifier

+     * can get reinitialized after its own exit handler has run, because

+     * of exit handlers for the I/O and timer sub-systems (order dependency).

+     */

+

+    if (TclInExit()) {

+        return;

+    }

+

+    /*

+     * DO NOT create the application context yet; doing so would prevent

+     * external applications from setting it for us to their own ones.

+     */

+    

+    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)	/* Not used. */

+{

+    if (notifier.currentTimeout != 0) {

+        XtRemoveTimeOut(notifier.currentTimeout);

+    }

+    for (; notifier.firstFileHandlerPtr != NULL; ) {

+        Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);

+    }

+    if (notifier.appContextCreated) {

+        XtDestroyApplicationContext(notifier.appContext);

+        notifier.appContextCreated = 0;

+        notifier.appContext = NULL;

+    }

+    initialized = 0;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_SetTimer --

+ *

+ *	This procedure sets the current notifier timeout value.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Replaces any previous timer.

+ *

+ *----------------------------------------------------------------------

+ */

+

+void

+Tcl_SetTimer(timePtr)

+    Tcl_Time *timePtr;		/* Timeout value, may be NULL. */

+{

+    long timeout;

+

+    if (!initialized) {

+	InitNotifier();

+    }

+

+    TclSetAppContext(NULL);

+    if (notifier.currentTimeout != 0) {

+	XtRemoveTimeOut(notifier.currentTimeout);

+    }

+    if (timePtr) {

+	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;

+	notifier.currentTimeout =

+            XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout,

+                    TimerProc, NULL);

+    } else {

+	notifier.currentTimeout = 0;

+    }

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * TimerProc --

+ *

+ *	This procedure is the XtTimerCallbackProc used to handle

+ *	timeouts.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *      Processes all queued events.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+TimerProc(data, id)

+    caddr_t data;		/* Not used. */

+    XtIntervalId *id;

+{

+    if (*id != notifier.currentTimeout) {

+	return;

+    }

+    notifier.currentTimeout = 0;

+

+    Tcl_ServiceAll();

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_CreateFileHandler --

+ *

+ *	This procedure registers a file handler with the Xt notifier.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Creates a new file handler structure and registers one or more

+ *	input procedures with Xt.

+ *

+ *----------------------------------------------------------------------

+ */

+

+void

+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 under which

+				 * proc should be called. */

+    Tcl_FileProc *proc;		/* Procedure to call for each

+				 * selected event. */

+    ClientData clientData;	/* Arbitrary data to pass to proc. */

+{

+    FileHandler *filePtr;

+

+    if (!initialized) {

+	InitNotifier();

+    }

+

+    TclSetAppContext(NULL);

+

+    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->read = 0;

+	filePtr->write = 0;

+	filePtr->except = 0;

+	filePtr->readyMask = 0;

+	filePtr->mask = 0;

+	filePtr->nextPtr = notifier.firstFileHandlerPtr;

+	notifier.firstFileHandlerPtr = filePtr;

+    }

+    filePtr->proc = proc;

+    filePtr->clientData = clientData;

+

+    /*

+     * Register the file with the Xt notifier, if it hasn't been done yet.

+     */

+

+    if (mask & TCL_READABLE) {

+	if (!(filePtr->mask & TCL_READABLE)) {

+	    filePtr->read =

+                XtAppAddInput(notifier.appContext, fd, XtInputReadMask,

+                        FileProc, filePtr);

+	}

+    } else {

+	if (filePtr->mask & TCL_READABLE) {

+	    XtRemoveInput(filePtr->read);

+	}

+    }

+    if (mask & TCL_WRITABLE) {

+	if (!(filePtr->mask & TCL_WRITABLE)) {

+	    filePtr->write =

+                XtAppAddInput(notifier.appContext, fd, XtInputWriteMask,

+                        FileProc, filePtr);

+	}

+    } else {

+	if (filePtr->mask & TCL_WRITABLE) {

+	    XtRemoveInput(filePtr->write);

+	}

+    }

+    if (mask & TCL_EXCEPTION) {

+	if (!(filePtr->mask & TCL_EXCEPTION)) {

+	    filePtr->except =

+                XtAppAddInput(notifier.appContext, fd, XtInputExceptMask,

+                        FileProc, filePtr);

+	}

+    } else {

+	if (filePtr->mask & TCL_EXCEPTION) {

+	    XtRemoveInput(filePtr->except);

+	}

+    }

+    filePtr->mask = mask;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * 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(fd)

+    int fd;			/* Stream id for which to remove

+				 * callback procedure. */

+{

+    FileHandler *filePtr, *prevPtr;

+

+    if (!initialized) {

+	InitNotifier();

+    }

+

+    TclSetAppContext(NULL);

+

+    /*

+     * 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;

+	}

+    }

+

+    /*

+     * Clean up information in the callback record.

+     */

+

+    if (prevPtr == NULL) {

+	notifier.firstFileHandlerPtr = filePtr->nextPtr;

+    } else {

+	prevPtr->nextPtr = filePtr->nextPtr;

+    }

+    if (filePtr->mask & TCL_READABLE) {

+	XtRemoveInput(filePtr->read);

+    }

+    if (filePtr->mask & TCL_WRITABLE) {

+	XtRemoveInput(filePtr->write);

+    }

+    if (filePtr->mask & TCL_EXCEPTION) {

+	XtRemoveInput(filePtr->except);

+    }

+    ckfree((char *) filePtr);

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * FileProc --

+ *

+ *	These procedures are called by Xt when a file becomes readable,

+ *	writable, or has an exception.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Makes an entry on the Tcl event queue if the event is

+ *	interesting.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+FileProc(clientData, fd, id)

+    caddr_t clientData;

+    int *fd;

+    XtInputId *id;

+{

+    FileHandler *filePtr = (FileHandler *)clientData;

+    FileHandlerEvent *fileEvPtr;

+    int mask = 0;

+

+    /*

+     * Determine which event happened.

+     */

+

+    if (*id == filePtr->read) {

+	mask = TCL_READABLE;

+    } else if (*id == filePtr->write) {

+	mask = TCL_WRITABLE;

+    } else if (*id == filePtr->except) {

+	mask = TCL_EXCEPTION;

+    }

+

+    /*

+     * Ignore unwanted or duplicate events.

+     */

+

+    if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {

+	return;

+    }

+    

+    /*

+     * This is an interesting event, so put it onto the event queue.

+     */

+

+    filePtr->readyMask |= mask;

+    fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));

+    fileEvPtr->header.proc = FileHandlerEventProc;

+    fileEvPtr->fd = filePtr->fd;

+    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);

+

+    /*

+     * Process events on the Tcl event queue before returning to Xt.

+     */

+

+    Tcl_ServiceAll();

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * FileHandlerEventProc --

+ *

+ *	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:

+ *	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 = 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 1;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_WaitForEvent --

+ *

+ *	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:

+ *	Returns 1 if an event was found, else 0.  This ensures that

+ *	Tcl_DoOneEvent will return 1, even if the event is handled

+ *	by non-Tcl code.

+ *

+ * Side effects:

+ *	Queues file events that are detected by the select.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_WaitForEvent(

+    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */

+{

+    int timeout;

+

+    if (!initialized) {

+	InitNotifier();

+    }

+

+    TclSetAppContext(NULL);

+

+    if (timePtr) {

+        timeout = timePtr->sec * 1000 + timePtr->usec / 1000;

+        if (timeout == 0) {

+            if (XtAppPending(notifier.appContext)) {

+                goto process;

+            } else {

+                return 0;

+            }

+        } else {

+            Tcl_SetTimer(timePtr);

+        }

+    }

+process:

+    XtAppProcessEvent(notifier.appContext, XtIMAll);

+    return 1;

+}

diff --git a/tcl/unix/tclXtTest.c b/tcl/unix/tclXtTest.c
new file mode 100644
index 00000000000..bc6046f8473
--- /dev/null
+++ b/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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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) {
+	    XtAppProcessEvent(TclSetAppContext(NULL), 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;
+}
diff --git a/tcl/win/Makefile.in b/tcl/win/Makefile.in
new file mode 100644
index 00000000000..d3f6d191e59
--- /dev/null
+++ b/tcl/win/Makefile.in
@@ -0,0 +1,626 @@
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+
+# This file is CYGNUS LOCAL.  It is a copy of makefile.vc from the
+# standard tcl distribution, modified to work with cygwin and an
+# autoconf configure script.  I have chosen to minimize the number of
+# changes, so the comments continue to refer to Visual C++ and the
+# like.  This should make it easier to merge in a new version if that
+# is necessary.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+VPATH = @srcdir@:@srcdir@/../generic:@srcdir@/../compat
+srcdir = @srcdir@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+NM = @NM@
+AS = @AS@
+LD = @LD@
+DLLTOOL = @DLLTOOL@
+WINDRES = @WINDRES@
+
+DLL_LDFLAGS = @DLL_LDFLAGS@
+DLL_LDLIBS = @DLL_LDLIBS@
+TCL_ALLOC_OBJ = @TCL_ALLOC_OBJ@
+
+OBJEXT=@OBJEXT@
+
+# Current Tcl version;  used in various names.
+
+DIRVERSION = @TCL_VERSION@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication.  It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time.  INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of Tcl
+# scripts (note: you can set the TCL_LIBRARY environment variable at
+# run-time to override this value):
+TCL_LIBRARY =	@datadir@/tcl$(DIRVERSION)
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR =	$(INSTALL_ROOT)$(TCL_LIBRARY)
+
+# Directory in which to install libtcl.so or libtcl.a:
+LIB_INSTALL_DIR =	$(INSTALL_ROOT)@libdir@
+
+# Directory in which to install the program tclsh:
+BIN_INSTALL_DIR =	$(INSTALL_ROOT)@bindir@
+
+# Directory in which to install the include file tcl.h:
+INCLUDE_INSTALL_DIR =	$(INSTALL_ROOT)@includedir@
+
+#
+# Visual C++ 2.x and 4.0 makefile
+#
+# Does not depend on the presence of any environment variables in
+# order to compile tcl; all needed information is derived from 
+# location of the compiler directories.
+
+#
+# Project directories
+#
+# ROOT    = top of source tree
+#
+# TMPDIR  = location where .obj files should be stored during build
+#
+# TOOLS32 = location of VC++ 32-bit development tools. Note that the
+#	    VC++ 2.0 header files are broken, so you need to use the
+#	    ones that come with the developer network CD's, or later
+#	    versions of VC++.
+#
+# TOOLS16 = location of VC++ 1.5 16-bit tools, needed to build thunking
+#	    library.  This information is optional; if the 16-bit compiler
+#	    is not available, then the 16-bit code will not be built.  
+#	    Tcl will still run without the 16-bit code, but...
+#		A. Under Windows 3.X you will any calls to the exec command
+#	           will return an error.
+#		B. A 16-bit program to test the behavior of the exec
+#		   command under NT and 95 will not be built.
+#
+
+ROOT		= $(srcdir)/..
+TMPDIR		= .
+TOOLS32		= c:\msdev
+TOOLS16		= c:\msvc
+
+# Set this to the appropriate value of /MACHINE: for your platform
+MACHINE	= IX86
+
+# Comment the following line to compile with symbols
+NODEBUG=1
+
+# uncomment one of the following lines to compile with TCL_MEM_DEBUG, 
+# TCL_MEM_DEBUG, or TCL_COMPILE_DEBUG
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_STATS
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+VERSION = 80
+
+TCLLIB		= libtcl$(VERSION).a
+TCLDLL		= cygtcl$(VERSION).dll
+TCLPLUGINLIB	= libtcl$(VERSION)p.a
+TCLPLUGINDLL	= cygtcl$(VERSION)p.dll
+TCL16DLL	= # tcl16$(VERSION).dll
+TCLSH		= cygtclsh$(VERSION).exe
+TCLSHP		= cygtclshp$(VERSION).exe
+TCLTEST		= tcltest.exe
+DUMPEXTS	= # $(TMPDIR)\dumpexts.exe
+TCLPIPEDLL	= cygtclpip$(VERSION).dll
+TCLREGDLL	= cygtclreg$(VERSION).dll
+CAT16		= # cat16.exe
+CAT32		= cat32.exe
+
+ifeq ($(OBJEXT),obj)
+
+TCL_ALLOC_OBJ=$(TMPDIR)/tclAlloc.$(OBJEXT)
+
+endif
+
+TCLSHOBJS = \
+	$(TMPDIR)/tclAppInit.$(OBJEXT)
+
+TCLTESTOBJS = \
+	$(TMPDIR)/tclTest.$(OBJEXT) \
+	$(TMPDIR)/tclTestObj.$(OBJEXT) \
+        $(TMPDIR)/tclTestProcBodyObj.$(OBJEXT) \
+	$(TMPDIR)/tclWinTest.$(OBJEXT) \
+	$(TMPDIR)/testMain.$(OBJEXT)
+
+TCLOBJS = \
+	$(TMPDIR)/panic.$(OBJEXT) \
+	$(TMPDIR)/regexp.$(OBJEXT) \
+	$(TMPDIR)/strftime.$(OBJEXT) \
+	$(TCL_ALLOC_OBJ) \
+	$(TMPDIR)/tclAsync.o \
+	$(TMPDIR)/tclBasic.o \
+	$(TMPDIR)/tclBinary.o \
+	$(TMPDIR)/tclCkalloc.o \
+	$(TMPDIR)/tclClock.o \
+	$(TMPDIR)/tclCmdAH.o \
+	$(TMPDIR)/tclCmdIL.o \
+	$(TMPDIR)/tclCmdMZ.o \
+	$(TMPDIR)/tclCompExpr.o \
+	$(TMPDIR)/tclCompile.o \
+	$(TMPDIR)/tclDate.o \
+	$(TMPDIR)/tclEnv.o \
+	$(TMPDIR)/tclEvent.o \
+	$(TMPDIR)/tclExecute.o \
+	$(TMPDIR)/tclFCmd.o \
+	$(TMPDIR)/tclFileName.o \
+	$(TMPDIR)/tclGet.o \
+	$(TMPDIR)/tclHash.o \
+	$(TMPDIR)/tclHistory.o \
+	$(TMPDIR)/tclIndexObj.o \
+	$(TMPDIR)/tclInterp.o \
+	$(TMPDIR)/tclIO.o \
+	$(TMPDIR)/tclIOCmd.o \
+	$(TMPDIR)/tclIOSock.o \
+	$(TMPDIR)/tclIOUtil.o \
+	$(TMPDIR)/tclLink.o \
+	$(TMPDIR)/tclListObj.o \
+	$(TMPDIR)/tclLoad.o \
+	$(TMPDIR)/tclMain.o \
+	$(TMPDIR)/tclNamesp.o \
+	$(TMPDIR)/tclNotify.o \
+	$(TMPDIR)/tclObj.o \
+	$(TMPDIR)/tclParse.o \
+	$(TMPDIR)/tclPipe.o \
+	$(TMPDIR)/tclPkg.o \
+	$(TMPDIR)/tclPosixStr.o \
+	$(TMPDIR)/tclPreserve.o \
+	$(TMPDIR)/tclProc.o \
+        $(TMPDIR)/tclResolve.o \
+	$(TMPDIR)/tclStringObj.o \
+	$(TMPDIR)/tclTimer.o \
+	$(TMPDIR)/tclUtil.o \
+	$(TMPDIR)/tclVar.o \
+	$(TMPDIR)/tclWin32Dll.o \
+	$(TMPDIR)/tclWinChan.o \
+	$(TMPDIR)/tclWinError.o \
+	$(TMPDIR)/tclWinFCmd.o \
+	$(TMPDIR)/tclWinFile.o \
+	$(TMPDIR)/tclWinInit.o \
+	$(TMPDIR)/tclWinLoad.o \
+	$(TMPDIR)/tclWinMtherr.o \
+	$(TMPDIR)/tclWinNotify.o \
+	$(TMPDIR)/tclWinPipe.o \
+	$(TMPDIR)/tclWinSock.o \
+	$(TMPDIR)/tclWinTime.o 
+
+cc32		= $(TOOLS32)\bin\cl.exe
+link32		= $(TOOLS32)\bin\link.exe
+rc32		= $(TOOLS32)\bin\rc.exe
+include32	= -I$(TOOLS32)\include
+
+cc16		= $(TOOLS16)\bin\cl.exe
+link16		= $(TOOLS16)\bin\link.exe
+rc16		= $(TOOLS16)\bin\rc.exe
+include16	= -I$(TOOLS16)\include
+
+WINDIR          = $(ROOT)/win
+GENERICDIR	= $(ROOT)/generic
+
+TCL_INCLUDES	= -I$(WINDIR) -I$(GENERICDIR)
+TCL_DEFINES	= -D__WIN32__ $(DEBUGDEFINES)
+
+TCL_CFLAGS	= $(cdebug) $(cflags) $(cvarsdll) \
+			$(TCL_INCLUDES) $(TCL_DEFINES) $(CFLAGS)
+CON_CFLAGS	= $(cdebug) $(cflags) $(cvars) -DCONSOLE
+DOS_CFLAGS	= $(cdebug) $(cflags) $(include16) -AL 
+DLL16_CFLAGS	= $(cdebug) $(cflags) $(include16) -ALw
+
+linkdebug =
+conlflags = -Wl,--subsystem,console -mwindows
+conlibsdll =
+
+######################################################################
+# Link flags
+######################################################################
+
+#!IFDEF NODEBUG
+#ldebug = /RELEASE
+#!ELSE
+#ldebug = -debug:full -debugtype:cv
+#!ENDIF
+
+# declarations common to all linker options
+lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
+
+# declarations for use on Intel i386, i486, and Pentium systems
+#!IF "$(MACHINE)" == "IX86"
+#DLLENTRY = @12
+#lflags   = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
+#!ELSE
+#lflags   = $(lcommon) /MACHINE:$(MACHINE)
+#!ENDIF
+
+conlflags = -Wl,--subsystem,console -mwindows
+guilflags = -mwindows
+dlllflags =
+
+#!IF "$(MACHINE)" == "PPC"
+#libc = libc.lib
+#libcdll = crtdll.lib
+#!ELSE
+#libc = libc.lib oldnames.lib
+#libcdll = msvcrt.lib oldnames.lib
+#!ENDIF
+
+ifeq ($(OBJEXT),o)
+
+baselibs   = -lkernel32 $(optlibs) -ladvapi32 -luser32
+winlibs    = $(baselibs) -lgdi32 -lcomdlg32 -lwinspool
+
+else
+
+baselibs   = kernel32.lib $(optlibs) advapi32.lib user32.lib
+winlibs    = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
+libcdll    = msvcrt.lib oldnames.lib
+
+endif
+
+guilibs	   = $(libc) $(winlibs)
+conlibs	   = $(libc) $(baselibs)
+guilibsdll = $(libcdll) $(winlibs)
+conlibsdll = $(libcdll) $(baselibs)
+
+######################################################################
+# Compile flags
+######################################################################
+
+#!IFDEF NODEBUG
+#cdebug = -Ox
+#!ELSE
+#cdebug = -Z7 -Od -WX
+#!ENDIF
+
+# declarations common to all compiler options
+ccommon = -c -W3 -nologo -YX -Dtry=__try -Dexcept=__except
+
+#!IF "$(MACHINE)" == "IX86"
+#cflags = $(ccommon) -D_X86_=1
+#!ELSE
+#!IF "$(MACHINE)" == "MIPS"
+#cflags = $(ccommon) -D_MIPS_=1
+#!ELSE
+#!IF "$(MACHINE)" == "PPC"
+#cflags = $(ccommon) -D_PPC_=1
+#!ELSE
+#!IF "$(MACHINE)" == "ALPHA"
+#cflags = $(ccommon) -D_ALPHA_=1
+#!ENDIF
+#!ENDIF
+#!ENDIF
+#!ENDIF
+
+cvars      = -DWIN32 -D_WIN32
+cvarsmt    = $(cvars) -D_MT
+cvarsdll   = $(cvarsmt) -D_DLL
+
+######################################################################
+# Project specific targets
+######################################################################
+
+release:    $(TCLSH) dlls $(TCLLIB)
+dlls:	    $(TCLDLL) $(TCLPIPEDLL) $(TCLREGDLL)
+all:	    $(TCLSH) dlls $(CAT16) $(CAT32) $(TCLLIB)
+tcltest:    $(TCLTEST) dlls $(CAT16) $(CAT32)
+plugin:	    $(TCLPLUGINDLL) $(TCLSHP)
+test:	    $(TCLTEST) dlls $(CAT16) $(CAT32) 
+	( echo cd $(ROOT)/tests\; source all ) | $(TCLTEST)
+
+install: install-binaries install-libraries
+
+install-binaries: $(TCLDLL) $(TCLLIB) $(TCLSH) $(TCLPIPEDLL)
+	@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@echo "Installing $(TCLLIB)"
+	@$(INSTALL_DATA) $(TCLLIB) $(LIB_INSTALL_DIR)/$(TCLLIB)
+	@chmod 555 $(LIB_INSTALL_DIR)/$(TCLLIB)
+	@echo "Installing tclsh"
+	@$(INSTALL_PROGRAM) $(TCLSH) $(BIN_INSTALL_DIR)/$(TCLSH)
+	@echo "Installing tclConfig.sh"
+	@$(INSTALL_DATA) ../unix/tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+
+install-libraries:
+	@echo "Installing DLL"
+	@$(INSTALL_DATA) $(TCLDLL) $(BIN_INSTALL_DIR)/$(TCLDLL)
+	@$(INSTALL_DATA) $(TCLPIPEDLL) $(BIN_INSTALL_DIR)/$(TCLPIPEDLL)
+	@$(INSTALL_DATA) $(TCLREGDLL) $(BIN_INSTALL_DIR)/$(TCLREGDLL)
+	@for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
+		$(SCRIPT_INSTALL_DIR) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@for i in http2.0 http1.0 opt0.1 ; \
+	    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) $(GENERICDIR)/tcl.h $(INCLUDE_INSTALL_DIR)/tcl.h
+	@for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(WINDIR)/tclAppInit.c; \
+	    do \
+	    echo "Installing $$i"; \
+	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+	    done;
+	@for i in http2.0 http1.0 opt0.1 ; \
+	    do \
+	    for j in $(ROOT)/library/$$i/*.tcl ; \
+		do \
+		echo "Installing $$j"; \
+		$(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
+		done; \
+	    done;
+
+install-minimal:
+	@echo "Installing DLL"
+	@$(INSTALL_DATA) $(TCLDLL) $(BIN_INSTALL_DIR)/$(TCLDLL)
+	@$(INSTALL_DATA) $(TCLPIPEDLL) $(BIN_INSTALL_DIR)/$(TCLPIPEDLL)
+	@$(INSTALL_DATA) $(TCLREGDLL) $(BIN_INSTALL_DIR)/$(TCLREGDLL)
+	@for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) ; \
+	    do \
+	    if [ ! -d $$i ] ; then \
+		echo "Making directory $$i"; \
+		mkdir $$i; \
+		chmod 755 $$i; \
+		else true; \
+		fi; \
+	    done;
+	@for i in http2.0 http1.0 opt0.1 ; \
+	    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;
+	@for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex; \
+	    do \
+	    echo "Installing $$i"; \
+	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+	    done;
+	@for i in http2.0 http1.0 opt0.1 ; \
+	    do \
+	    for j in $(ROOT)/library/$$i/*.tcl ; \
+		do \
+		echo "Installing $$j"; \
+		$(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
+		done; \
+	    done;
+
+# $(DUMPEXTS): $(WINDIR)/winDumpExts.c
+# 	$(CC) -c $(CON_CFLAGS) $?
+# 	$(CC) $(linkdebug) $(conlflags) -o $@ $(TMPDIR)/winDumpExts.$(OBJEXT)bj $(guilibs)
+
+
+ifeq ($(OBJEXT),o)
+
+$(TCLDLL): $(TCLOBJS) tclres.$(OBJEXT) $(TMPDIR)/tclcyg.def
+	$(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tcl.base -o $(TCLDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66000000
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLDLL) --def $(TMPDIR)/tclcyg.def --base-file tcl.base --output-exp tcl.exp
+	$(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tcl.base,tcl.exp -o $(TCLDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66000000
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLDLL) --def $(TMPDIR)/tclcyg.def --base-file tcl.base --output-exp tcl.exp
+	$(CC) $(DLL_LDFLAGS) -Wl,tcl.exp -o $(TCLDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66000000
+
+else
+
+$(TCLDLL): $(TCLOBJS) $(TMPDIR)/tclcyg.def tclres.$(OBJEXT)
+	link.exe $(ldebug) $(dlllflags) -dll -def:$(TMPDIR)/tclcyg.def -NODEFAULTLIB \
+		-out:$(TCLDLL) tclres.$(OBJEXT) $(guilibsdll) $(TCLOBJS) \
+		-entry:_DllMainCRTStartup@12
+	mv cygtcl80.lib $(TCLLIB)
+endif
+
+
+ifeq ($(OBJEXT),o)
+
+$(TCLLIB): $(TMPDIR)/tclcyg.def 
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLDLL) --def $(TMPDIR)/tclcyg.def --output-lib $(TCLLIB)
+
+else
+
+$(TCLLIB): $(TCLDLL)
+
+endif
+
+$(TCLPLUGINLIB): $(TMPDIR)/plugin.def
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLPLUGINDLL) --def $(TMPDIR)/plugin.def --output-lib $(TCLPLUGINLIB)
+
+$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)/plugin.def tclres.$(OBJEXT)
+	$(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclplugin.base -o $(TCLPLUGINDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tclplugin.base --output-exp tcl.exp
+	$(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclplugin.base -Wl,tcl.exp -o $(TCLPLUGINDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tclplugin.base --output-exp tcl.exp
+	$(CC) $(DLL_LDFLAGS) -Wl,tcl.exp -o $(TCLPLUGINDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+
+ifeq ($(OBJEXT),o)
+
+$(TCLSH): $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
+	$(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
+		-o $@ $(conlibsdll) $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
+
+else
+
+$(TCLSH): $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
+	link $(linkdebug) $(conlflags) $(tclsh_flags) -NODEFAULTLIB -subsystem:console -entry:mainCRTStartup \
+		-out:$@ $(conlibsdll) $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
+
+endif
+
+$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) tclshres.$(OBJEXT)
+	$(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
+		-o $@ $(conlibsdll) $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLPLUGINLIB)
+
+$(TCLTEST): $(TCLTESTOBJS) tclshres.$(OBJEXT) $(TCLLIB)
+	$(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
+		 -o $@ $(conlibsdll) $(TCLTESTOBJS) tclshres.$(OBJEXT) $(TCLLIB)
+
+# $(TCL16DLL):  $(WINDIR)\tcl16.rc $(WINDIR)\tclWin16.c
+# 	if exist $(cc16) $(cc16) @<<
+# $(DLL16_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\tclWin16.c
+# <<                         
+# 	@copy << $(TMPDIR)\tclWin16.def > nul
+# LIBRARY $(@B);dll
+# EXETYPE WINDOWS
+# CODE PRELOAD MOVEABLE DISCARDABLE
+# DATA PRELOAD MOVEABLE SINGLE
+# HEAPSIZE 1024 
+# EXPORTS
+# 	WEP @1 RESIDENTNAME
+# 	UTPROC @2 
+# << 
+# 	if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOE @<<
+# $(TMPDIR)\tclWin16.obj
+# $@
+# nul
+# $(TOOLS16)\lib\ ldllcew oldnames libw toolhelp
+# $(TMPDIR)\tclWin16.def
+# <<
+# 	if exist $(cc16) $(rc16) -i $(GENERICDIR) $(TCL_DEFINES) $(WINDIR)\tcl16.rc $@
+
+ifeq ($(OBJEXT),o)
+
+$(TCLPIPEDLL): $(WINDIR)/stub16.c
+	$(CC) -c $(CON_CFLAGS) $(WINDIR)/stub16.c
+	$(CC) $(linkdebug) $(conlflags) -o $@ $(TMPDIR)/stub16.$(OBJEXT) $(guilibs)
+else
+
+$(TCLPIPEDLL): $(WINDIR)/stub16.c
+	$(CC) -c $(CON_CFLAGS) -Fo$(TMPDIR)/ $(WINDIR)/stub16.c
+	link $(ldebug) $(conlflags) -out:$@ $(TMPDIR)/stub16.obj $(guilibsdll)
+endif
+
+ifeq ($(OBJEXT),o)
+
+$(TCLREGDLL): $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB)
+	echo EXPORTS > $(TMPDIR)/tclreg.def
+	echo Registry_Init >> $(TMPDIR)/tclreg.def
+	$(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclreg.base -o $(TCLREGDLL) $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB) $(DLL_LDLIBS) -ladvapi32 -mwindows -Wl,-e,_DllEntryPoint@12 -Wl,--image-base,0x66200000
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLREGDLL) --def $(TMPDIR)/tclreg.def --base-file tclreg.base --output-exp tclreg.exp
+	$(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclreg.base -Wl,tclreg.exp -o $(TCLREGDLL) $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB) $(DLL_LDLIBS) -ladvapi32 -mwindows -Wl,-e,_DllEntryPoint@12 -Wl,--image-base,0x66200000
+	$(DLLTOOL) --as=$(AS) --dllname $(TCLREGDLL) --def $(TMPDIR)/tclreg.def --base-file tclreg.base --output-exp tclreg.exp
+	$(CC) $(DLL_LDFLAGS) -Wl,tclreg.exp -o $(TCLREGDLL) $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB) $(DLL_LDLIBS) -ladvapi32 -mwindows -Wl,-e,_DllEntryPoint@12 -Wl,--image-base,0x66200000
+	rm -f $(TMPDIR)/tclreg.def
+else
+$(TCLREGDLL): $(TMPDIR)/tclWinReg.obj
+	link $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)/tclWinReg.obj \
+		$(conlibsdll) $(TCLLIB) -entry:_DllMainCRTStartup@12
+endif
+
+ifeq ($(OBJEXT),o)
+
+$(CAT32): $(WINDIR)/cat.c
+	$(CC) -c $(CON_CFLAGS) $?
+	$(CC) -o $@ -Wl,-stack,16384 $(TMPDIR)/cat.$(OBJEXT) $(conlibs)
+
+else
+
+$(CAT32): $(WINDIR)/cat.c
+	$(CC) $(CON_CFLAGS) -Fo$(TMPDIR)/ $(WINDIR)/cat.c
+	link -subsystem:console -entry:mainCRTStartup -out:$@ -stack:16384 $(TMPDIR)/cat.obj $(conlibs)
+endif
+
+# $(CAT16): $(WINDIR)\cat.c
+# 	if exist $(cc16) $(cc16) $(DOS_CFLAGS) -Fo$(TMPDIR)\ $?
+# 	set LIB=$(TOOLS16)\lib
+# 	if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOI /STACK:16384 \
+# 		$(TMPDIR)\cat.obj,$@,nul,llibce.lib,nul
+
+$(TMPDIR)/tclcyg.def: $(DUMPEXTS) $(TCLOBJS)
+	echo 'EXPORTS' > tmp.def
+	-for o in $(TCLOBJS); do \
+	  $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+	done
+	mv tmp.def $(TMPDIR)/tclcyg.def
+
+$(TMPDIR)/plugin.def: $(DUMPEXTS) $(TCLOBJS)
+	echo 'EXPORTS' > tmp.def
+	-for o in $(TCLOBJS); do \
+	  $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+	done
+	mv tmp.def $(TMPDIR)/plugin.def
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)/testMain.$(OBJEXT): $(WINDIR)/tclAppInit.c
+	$(CC) -c -o $(TMPDIR)/testMain.$(OBJEXT) $(TCL_CFLAGS) -DTCL_TEST $?
+
+#
+# Implicit rules
+#
+
+.SUFFIXES: .S .c .o .obj .s
+ifeq ($(OBJEXT),o)
+.c.$(OBJEXT):
+	$(CC) -c $(TCL_CFLAGS) $<
+else
+.c.$(OBJEXT):
+	$(CC) -c $(TCL_CFLAGS) -Dtry=__try -Dexcept=__except $<
+endif
+
+ifeq ($(OBJEXT),o)
+
+tclres.$(OBJEXT): $(srcdir)/tcl.rc
+	$(WINDRES) --include $(GENERICDIR) --include $(WINDIR) --define __WIN32__ --define VS_VERSION_INFO=1 $(srcdir)/tcl.rc tclres.$(OBJEXT)
+
+tclshres.$(OBJEXT): $(srcdir)/tclsh.rc
+	$(WINDRES) --include $(GENERICDIR) --include $(WINDIR) --define __WIN32__ --define VS_VERSION_INFO=1 $(srcdir)/tclsh.rc tclshres.$(OBJEXT)
+
+else
+
+tclres.$(OBJEXT): $(srcdir)/tcl.rc
+	rc -i$(GENERICDIR) -i$(WINDIR) -d__WIN32__ -dVS_VERSION_INFO=1 -fotclres.$(OBJEXT) $(srcdir)/tcl.rc 
+
+tclshres.$(OBJEXT): $(srcdir)/tclsh.rc
+	rc -i$(GENERICDIR) -i$(WINDIR) -d__WIN32__ -dVS_VERSION_INFO=1 -fotclshres.$(OBJEXT) $(srcdir)/tclsh.rc 
+
+endif
+
+#{$(WINDIR)}.rc{$(TMPDIR)}.res:
+#	$(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \
+#		$(TCL_DEFINES) $<
+
+clean:
+	rm -f *.exp *.a *.dll *.exe $(TMPDIR)/*.$(OBJEXT) *.res *.def
+	rm -f tcl.base tclreg.base tclplugin.base
+
+Makefile: $(WINDIR)/Makefile.in config.status
+	$(SHELL) config.status
+
+config.status: $(WINDIR)/configure
+	./config.status --recheck
diff --git a/tcl/win/README b/tcl/win/README
new file mode 100644
index 00000000000..156743ea7e9
--- /dev/null
+++ b/tcl/win/README
@@ -0,0 +1,192 @@
+Tcl 8.0.4 for Windows
+
+by Scott Stanton
+Scriptics Corporation
+scott.stanton@scriptics.com
+
+RCS: @(#) $Id$
+
+1. Introduction
+---------------
+
+This is the directory where you configure and compile the Windows
+version of Tcl.  This directory also contains source files for Tcl
+that are specific to Microsoft Windows.  The rest of this file
+contains information specific to the Windows version of Tcl.
+
+2. Distribution notes
+---------------------
+
+Tcl 8.0 for Windows is distributed in binary form in addition to the
+common source release.  The binary distribution is a self-extracting
+archive with a built-in installation script.
+
+Look for the binary release in the same location as the source release
+(ftp.scriptics.com:/pub/tcl or any of the mirror sites).  For most users,
+the binary release will be much easier to install and use.  You only
+need the source release if you plan to modify the core of Tcl, or if
+you need to compile with a different compiler.  With the addition of
+the dynamic loading interface, it is no longer necessary to have the
+source distribution in order to build and use extensions.
+
+3. Compiling Tcl
+----------------
+
+In order to compile Tcl for Windows, you need the following items:
+
+	Tcl 8.0 Source Distribution (plus any patches)
+
+	Borland C++ 4.52 (both 16-bit and 32-bit compilers)
+	  or
+	Visual C++ 2.x/4.x/5.x
+	Visual C++ 1.5 (to build tcl1680.dll for Win32s support of exec)
+
+In practice, the 8.0.4 release is built with Visual C++ 5.0
+
+In the "win" subdirectory of the source release, you will find two
+files called "makefile.bc" and "makefile.vc".  These are the makefiles
+for the Borland and Visual C++ compilers respectively.  You should
+copy the appropriate one to "makefile" and update the paths at the
+top of the file to reflect your system configuration.  Now you can use
+"make" (or "nmake" for VC++) to build the tcl libraries and the tclsh
+executable.
+
+In order to use the binaries generated by these makefiles, you will
+need to place the Tcl script library files someplace where Tcl can
+find them.  Tcl looks in one of three places for the library files:
+
+	1) The path specified in the environment variable "TCL_LIBRARY".
+
+	2) In the lib\tcl8.0 directory under the installation directory
+	   as specified in the registry:
+
+		For Windows NT & 95:
+		    HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.0
+
+		For Win32s:
+		    HKEY_CLASSES_ROOT\SOFTWARE\Scriptics\Tcl\8.0\
+
+	3) Relative to the directory containing the current .exe.
+	    Tcl will look for a directory "..\lib\tcl8.0" relative to the
+	    directory containing the currently running .exe.
+
+Note that in order to run tclsh80.exe, you must ensure that tcl80.dll
+and tclpip80.dll (plus tcl1680.dll under Win32s) are on your path, in
+the system directory, or in the directory containing tclsh80.exe.
+
+4. Building Extensions
+----------------------
+
+With the Windows compilers you have to worry about how you export symbols
+from DLLs.  tcl.h defines a few macros to help solve this problem:
+EXTERN - all Tcl_ function prototypes use this macro, which implies
+	they are exported.  You'll see this used in tcl.h and tk.h.
+	You should use this in your exported procedures.
+	However, this is not the whole story.
+TCL_STORAGE_CLASS - this is really an import/export flag, depending on if you are
+	importing symbols from a DLL (i.e., a user of the DLL), or if
+	you are exporting symbols from the DLL (i.e., you are building it.)
+	The EXTERN macro includes TCL_STORAGE_CLASS.
+	TCL_STORAGE_CLASS is defined to be either DLLIMPORT or DLLEXPORT as
+	described below.
+STATIC_BUILD - define this if you are *not* building a DLL
+	(e.g., a main program)
+DLL_BUILD - define this if you *are* building a DLL
+DLLIMPORT - If STATIC_BUILD is defined, this becomes nothing.
+	(On UNIX, DLLIMPORT is defined to be empty)
+	Otherwise, this this expands to __declspec(dllimport)
+DLLEXPORT - If STATIC_BUILD is defined, this becomes nothing.
+	(On UNIX, DLLEXPORT is defined to be empty)
+	Otherwise, this this expands to __declspec(dllexport)
+
+EXPORT(type, func)
+	For the Borland compiler, you need to export functions differently.
+	The DLLEXPORT macro is empty, and instead you need to use
+	EXPORT because they had a different order.  Your declaration will
+	look like
+	EXTERN EXPORT(int, Foo_Init)(Tcl_Interp *interp);
+We have not defined EXPORT anywhere.  You can paste this into your C file:
+#ifndef STATIC_BUILD
+#if defined(_MSC_VER)
+#   define EXPORT(a,b) __declspec(dllexport) a b
+#   define DllEntryPoint DllMain
+#else
+#   if defined(__BORLANDC__)
+#       define EXPORT(a,b) a _export b
+#   else
+#       define EXPORT(a,b) a b
+#   endif
+#endif
+#endif
+
+
+How to use these:
+
+Assume your extension is named Foo.  In its Makefile, define
+BUILD_Foo so that you know you are building Foo and not using it.
+Then, in your main header file, foo.h, conditionally define
+EXPORT to be either DLLIMPORT or DLLEXPORT based on the
+presense of BUILD_Foo, like this:
+
+#ifndef _FOO
+#define _FOO
+#include "tcl.h"
+/* Additional includes go here */
+/*
+ * if the BUILD_foo macro is defined, the assumption is that we are
+ * building the dynamic library.
+ */
+#ifdef BUILD_Foo
+#  undef TCL_STORAGE_CLASS
+#  define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+/*
+ * Function prototypes for this module.
+ */
+EXTERN int Foo_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Foo_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+/* Additional prototypes go here */
+/*
+ * end of foo.h
+ * reset TCL_STORAGE_CLASS to DLLIMPORT.
+ */
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+#endif /* _FOO */
+
+In your C file, put EXTERN before then functions you need to export.
+If you use Borland, you'll need to use the old EXPORT macro, too.
+
+5. Test suite
+-------------
+
+This distribution contains an extensive test suite for Tcl.  Some of
+the tests are timing dependent and will fail from time to time.  If a
+test is failing consistently, please send us a bug report with as much
+detail as you can manage.
+
+In order to run the test suite, you build the "test" target using the
+appropriate makefile for your compiler.
+
+
+6. Known Bugs
+-------------
+
+Here is the current list of known bugs/missing features for the
+Windows version of Tcl:
+
+- Blocking "after" commands (e.g. "after 3000") don't work on Win32s.
+- Clock command fails to handle daylight savings time boundaries for
+  things like "last week".
+- Background processes aren't properly detached on NT.
+- File events only work on sockets.
+- Pipes/files/console/serial ports don't support nonblocking I/O.
+- The library cannot be used by two processes at the same time under
+  Win32s.
+
+If you have comments or bug reports for the Windows version of Tcl,
+please direct them to:
+
+<bugs@scriptics.com>
+
+or post them to the comp.lang.tcl newsgroup.
diff --git a/tcl/win/cat.c b/tcl/win/cat.c
new file mode 100644
index 00000000000..ff57a0e569f
--- /dev/null
+++ b/tcl/win/cat.c
@@ -0,0 +1,37 @@
+/*
+ * cat.c --
+ *
+ *	Program used when testing tclWinPipe.c
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include <io.h>
+#include <string.h>
+
+int
+main()
+{   
+    char buf[1024];
+    int n;
+    char *err;
+
+    while (1) {
+	n = read(0, buf, sizeof(buf));
+	if (n <= 0) {
+	    break;
+	}
+        write(1, buf, n);
+    }
+    err = (sizeof(int) == 2) ? "stderr16" : "stderr32";
+    write(2, err, strlen(err));
+
+    return 0;
+}
+	
diff --git a/tcl/win/configure b/tcl/win/configure
new file mode 100755
index 00000000000..1cbdab3be0f
--- /dev/null
+++ b/tcl/win/configure
@@ -0,0 +1,1666 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+sitefile=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --site-file=FILE        use FILE as the site file
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -site-file | --site-file | --site-fil | --site-fi | --site-f)
+    ac_prev=sitefile ;;
+  -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+    sitefile="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.13"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set.  These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/tcl.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$sitefile"; then
+  if test -z "$CONFIG_SITE"; then
+    if test "x$prefix" != xNONE; then
+      CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+    else
+      CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+    fi
+  fi
+else
+  CONFIG_SITE="$sitefile"
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+if test "${prefix}" = "NONE"; then
+    prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+    exec_prefix=$prefix
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+  if test -f $ac_dir/install-sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f $ac_dir/install.sh; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:570: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+  case $nonopt in
+  NONE)
+    if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+    else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+    fi ;;
+  *) host_alias=$nonopt ;;
+  esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:594: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="gcc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:624: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_prog_rejected=no
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+        ac_prog_rejected=yes
+	continue
+      fi
+      ac_cv_prog_CC="cc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# -gt 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    set dummy "$ac_dir/$ac_word" "$@"
+    shift
+    ac_cv_prog_CC="$@"
+  fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  if test -z "$CC"; then
+    case "`uname -s`" in
+    *win32* | *WIN32*)
+      # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:675: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="cl"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+ ;;
+    esac
+  fi
+  test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:707: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 718 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:723: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  ac_cv_prog_cc_works=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    ac_cv_prog_cc_cross=no
+  else
+    ac_cv_prog_cc_cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+  { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:749: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:754: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.c <<EOF
+#ifdef __GNUC__
+  yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:763: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+  ac_cv_prog_gcc=yes
+else
+  ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:782: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+  ac_cv_prog_cc_g=yes
+else
+  ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:814: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:820: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  for ac_file in conftest.*; do
+    case $ac_file in
+    *.c) ;;
+    *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+    esac
+  done
+else
+  { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+echo $ac_n "checking build system type""... $ac_c" 1>&6
+echo "configure:838: checking build system type" >&5
+
+build_alias=$build
+case "$build_alias" in
+NONE)
+  case $nonopt in
+  NONE) build_alias=$host_alias ;;
+  *) build_alias=$nonopt ;;
+  esac ;;
+esac
+
+build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias`
+build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$build" 1>&6
+
+if test $host != $build; then
+  ac_tool_prefix=${host_alias}-
+else
+  ac_tool_prefix=
+fi
+
+# Extract the first word of "${ac_tool_prefix}nm", so it can be a program name with args.
+set dummy ${ac_tool_prefix}nm; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:864: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$NM"; then
+  ac_cv_prog_NM="$NM" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_NM="${ac_tool_prefix}nm"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+NM="$ac_cv_prog_NM"
+if test -n "$NM"; then
+  echo "$ac_t""$NM" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_NM"; then
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "nm", so it can be a program name with args.
+set dummy nm; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:896: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$NM"; then
+  ac_cv_prog_NM="$NM" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_NM="nm"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_NM" && ac_cv_prog_NM="nm"
+fi
+fi
+NM="$ac_cv_prog_NM"
+if test -n "$NM"; then
+  echo "$ac_t""$NM" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+else
+  NM="nm"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args.
+set dummy ${ac_tool_prefix}as; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:932: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$AS"; then
+  ac_cv_prog_AS="$AS" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_AS="${ac_tool_prefix}as"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+AS="$ac_cv_prog_AS"
+if test -n "$AS"; then
+  echo "$ac_t""$AS" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_AS"; then
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "as", so it can be a program name with args.
+set dummy as; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:964: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$AS"; then
+  ac_cv_prog_AS="$AS" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_AS="as"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_AS" && ac_cv_prog_AS="as"
+fi
+fi
+AS="$ac_cv_prog_AS"
+if test -n "$AS"; then
+  echo "$ac_t""$AS" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+else
+  AS="as"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}ld", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ld; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1000: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$LD"; then
+  ac_cv_prog_LD="$LD" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_LD="${ac_tool_prefix}ld"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+LD="$ac_cv_prog_LD"
+if test -n "$LD"; then
+  echo "$ac_t""$LD" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_LD"; then
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "ld", so it can be a program name with args.
+set dummy ld; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1032: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$LD"; then
+  ac_cv_prog_LD="$LD" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_LD="ld"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_LD" && ac_cv_prog_LD="ld"
+fi
+fi
+LD="$ac_cv_prog_LD"
+if test -n "$LD"; then
+  echo "$ac_t""$LD" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+else
+  LD="ld"
+fi
+fi
+
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1068: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_RANLIB="ranlib"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ac_t""$RANLIB" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+# Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args.
+set dummy ${ac_tool_prefix}dlltool; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1098: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$DLLTOOL"; then
+  ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+DLLTOOL="$ac_cv_prog_DLLTOOL"
+if test -n "$DLLTOOL"; then
+  echo "$ac_t""$DLLTOOL" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_DLLTOOL"; then
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "dlltool", so it can be a program name with args.
+set dummy dlltool; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1130: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$DLLTOOL"; then
+  ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_DLLTOOL="dlltool"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_DLLTOOL" && ac_cv_prog_DLLTOOL="dlltool"
+fi
+fi
+DLLTOOL="$ac_cv_prog_DLLTOOL"
+if test -n "$DLLTOOL"; then
+  echo "$ac_t""$DLLTOOL" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+else
+  DLLTOOL="dlltool"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1166: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$WINDRES"; then
+  ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_WINDRES="${ac_tool_prefix}windres"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+WINDRES="$ac_cv_prog_WINDRES"
+if test -n "$WINDRES"; then
+  echo "$ac_t""$WINDRES" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_WINDRES"; then
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1198: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$WINDRES"; then
+  ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
+  ac_dummy="$PATH"
+  for ac_dir in $ac_dummy; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_WINDRES="windres"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_WINDRES" && ac_cv_prog_WINDRES="windres"
+fi
+fi
+WINDRES="$ac_cv_prog_WINDRES"
+if test -n "$WINDRES"; then
+  echo "$ac_t""$WINDRES" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+else
+  WINDRES="windres"
+fi
+fi
+
+
+# Find a good install program.  We prefer a C program (faster),
+# so one script is as good as another.  But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:1243: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+    IFS="${IFS= 	}"; ac_save_IFS="$IFS"; IFS=":"
+  for ac_dir in $PATH; do
+    # Account for people who put trailing slashes in PATH elements.
+    case "$ac_dir/" in
+    /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+    *)
+      # OSF1 and SCO ODT 3.0 have their own names for install.
+      # Don't use installbsd from OSF since it installs stuff as root
+      # by default.
+      for ac_prog in ginstall scoinst install; do
+        if test -f $ac_dir/$ac_prog; then
+	  if test $ac_prog = install &&
+            grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+	    # AIX install.  It has an incompatible calling convention.
+	    :
+	  else
+	    ac_cv_path_install="$ac_dir/$ac_prog -c"
+	    break 2
+	  fi
+	fi
+      done
+      ;;
+    esac
+  done
+  IFS="$ac_save_IFS"
+
+fi
+  if test "${ac_cv_path_install+set}" = set; then
+    INSTALL="$ac_cv_path_install"
+  else
+    # As a last resort, use the slow shell script.  We don't cache a
+    # path for INSTALL within a source directory, because that will
+    # break other packages using the cache if that directory is
+    # removed, or if the path is relative.
+    INSTALL="$ac_install_sh"
+  fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+	TCL_ALLOC_OBJ=
+	DLL_LDLIBS=-lcygwin
+	DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+	;;
+*-*-mingw32*)
+	TCL_ALLOC_OBJ='$(TMPDIR)/tclAlloc.o'
+	DLL_LDLIBS=
+	DLL_LDFLAGS='-mdll'
+	;;
+esac
+
+
+
+
+
+# The following variables are just for tclConfig.sh, not for Makefile. 
+LIBOBJS=
+
+TCL_VERSION=8.0
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL=p2
+VERSION=${TCL_VERSION}
+DL_LIBS=
+MATH_LIBS=-lm
+SHLIB_CFLAGS=
+SHLIB_LD=
+SHLIB_LD_LIBS=
+SHLIB_SUFFIX=
+LD_FLAGS=
+TCL_LD_SEARCH_FLAGS=
+TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
+TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+TCL_LIB_VERSIONS_OK=nodots
+TCL_SHARED_LIB_SUFFIX=
+TCL_UNSHARED_LIB_SUFFIX="`echo ${VERSION} | tr -d .`.a"
+eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
+TCL_SRC_DIR=`cd $srcdir/..; pwd`
+if test "$prefix" != "$exec_prefix"; then
+    TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+else
+    TCL_PACKAGE_PATH="${prefix}/lib"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  case `(ac_space=' '; set | grep ac_space) 2>&1` in
+  *ac_space=\ *)
+    # `set' does not quote correctly, so add quotes (double-quote substitution
+    # turns \\\\ into \\, and sed turns \\ into \).
+    sed -n \
+      -e "s/'/'\\\\''/g" \
+      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+    ;;
+  *)
+    # `set' quotes correctly as required by POSIX, so do not add quotes.
+    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+    ;;
+  esac >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ 	`~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.13"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile ../unix/tclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@CC@%$CC%g
+s%@OBJEXT@%$OBJEXT%g
+s%@build@%$build%g
+s%@build_alias@%$build_alias%g
+s%@build_cpu@%$build_cpu%g
+s%@build_vendor@%$build_vendor%g
+s%@build_os@%$build_os%g
+s%@NM@%$NM%g
+s%@AS@%$AS%g
+s%@LD@%$LD%g
+s%@RANLIB@%$RANLIB%g
+s%@DLLTOOL@%$DLLTOOL%g
+s%@WINDRES@%$WINDRES%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@TCL_ALLOC_OBJ@%$TCL_ALLOC_OBJ%g
+s%@DLL_LDFLAGS@%$DLL_LDFLAGS%g
+s%@DLL_LDLIBS@%$DLL_LDLIBS%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
+s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
+s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
+s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
+s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
+s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
+s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+  if test $ac_beg -gt 1; then
+    sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+  else
+    sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+  fi
+  if test ! -s conftest.s$ac_file; then
+    ac_more_lines=false
+    rm -f conftest.s$ac_file
+  else
+    if test -z "$ac_sed_cmds"; then
+      ac_sed_cmds="sed -f conftest.s$ac_file"
+    else
+      ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+    fi
+    ac_file=`expr $ac_file + 1`
+    ac_beg=$ac_end
+    ac_end=`expr $ac_end + $ac_max_sed_cmds`
+  fi
+done
+if test -z "$ac_sed_cmds"; then
+  ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../unix/tclConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+  case "$ac_given_INSTALL" in
+  [/$]*) INSTALL="$ac_given_INSTALL" ;;
+  *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+  esac
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tcl/win/configure.in b/tcl/win/configure.in
new file mode 100755
index 00000000000..d7d94737fb8
--- /dev/null
+++ b/tcl/win/configure.in
@@ -0,0 +1,104 @@
+dnl	The file is CYGNUS LOCAL.  It is used for cygwin.
+
+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_PREREQ(2.5)
+
+AC_INIT(../generic/tcl.h)
+
+if test "${prefix}" = "NONE"; then
+    prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+    exec_prefix=$prefix
+fi
+
+AC_CANONICAL_HOST
+
+AC_PROG_CC
+AC_OBJEXT
+AC_CHECK_TOOL(NM, nm, nm)
+AC_SUBST(NM)
+AC_CHECK_TOOL(AS, as, as)
+AC_SUBST(AS)
+AC_CHECK_TOOL(LD, ld, ld)
+AC_SUBST(LD)
+AC_PROG_RANLIB
+AC_CHECK_TOOL(DLLTOOL, dlltool, dlltool)
+AC_SUBST(DLLTOOL)
+AC_CHECK_TOOL(WINDRES, windres, windres)
+AC_SUBST(WINDRES)
+AC_PROG_INSTALL
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+	TCL_ALLOC_OBJ=
+	DLL_LDLIBS=-lcygwin
+	DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+	;;
+*-*-mingw32*)
+	TCL_ALLOC_OBJ='$(TMPDIR)/tclAlloc.o'
+	DLL_LDLIBS=
+	DLL_LDFLAGS='-mdll'
+	;;
+esac
+
+AC_SUBST(TCL_ALLOC_OBJ)
+AC_SUBST(DLL_LDFLAGS)
+AC_SUBST(DLL_LDLIBS)
+
+# The following variables are just for tclConfig.sh, not for Makefile. 
+LIBOBJS=
+AC_SUBST(LIBOBJS)
+TCL_VERSION=8.0
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL=p2
+VERSION=${TCL_VERSION}
+DL_LIBS=
+MATH_LIBS=-lm
+SHLIB_CFLAGS=
+SHLIB_LD=
+SHLIB_LD_LIBS=
+SHLIB_SUFFIX=
+LD_FLAGS=
+TCL_LD_SEARCH_FLAGS=
+TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
+TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+TCL_LIB_VERSIONS_OK=nodots
+TCL_SHARED_LIB_SUFFIX=
+TCL_UNSHARED_LIB_SUFFIX="`echo ${VERSION} | tr -d .`.a"
+eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
+TCL_SRC_DIR=`cd $srcdir/..; pwd`
+if test "$prefix" != "$exec_prefix"; then
+    TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+else
+    TCL_PACKAGE_PATH="${prefix}/lib"
+fi
+
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(MATH_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LD_SEARCH_FLAGS)
+AC_SUBST(TCL_LIB_FILE)
+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)
+
+AC_OUTPUT(Makefile ../unix/tclConfig.sh)
diff --git a/tcl/win/license.terms b/tcl/win/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/win/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties.  The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/tcl/win/makefile.bc b/tcl/win/makefile.bc
new file mode 100644
index 00000000000..42b8101a474
--- /dev/null
+++ b/tcl/win/makefile.bc
@@ -0,0 +1,388 @@
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# RCS: @(#) $Id$
+#
+# Borland C++ 4.5 makefile
+#
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+# TMPDIR = location where .obj files should be stored during build
+# TOOLS = location of compiler and other development tools
+#
+
+ROOT	= ..
+TMPDIR	= .
+TOOLS	= c:\bc45
+
+# uncomment the following line to compile with symbols
+#DEBUG=1
+
+# uncomment one of the following lines to compile with TCL_MEM_DEBUG,
+# TCL_COMPILE_DEBUG, or TCL_COMPILE_STATS
+#DEBUGDEFINES   =TCL_MEM_DEBUG 
+#DEBUGDEFINES   =TCL_MEM_DEBUG;TCL_COMPILE_DEBUG
+#DEBUGDEFINES   =TCL_MEM_DEBUG;TCL_COMPILE_STATS
+#DEBUGDEFINES   =TCL_MEM_DEBUG;TCL_COMPILE_DEBUG;TCL_COMPILE_STATS
+
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+STACKSIZE = 1f0001
+
+VERSION = 80
+
+TCLLIB 		= tcl$(VERSION).lib
+TCLDLL 		= tcl$(VERSION).dll
+TCL16DLL 	= tcl16$(VERSION).dll
+TCLSH 		= tclsh$(VERSION).exe
+TCLTEST 	= tcltest.exe
+DUMPEXTS 	= dumpexts.exe
+TCLPIPEDLL 	= tclpip$(VERSION).dll
+TCLREGDLL 	= tclreg$(VERSION).dll
+CAT16 		= cat16.exe
+CAT32 		= cat32.exe
+
+TCLSHOBJS = \
+	$(TMPDIR)\tclAppInit.obj
+
+TCLTESTOBJS = \
+	$(TMPDIR)\tclTest.obj \
+	$(TMPDIR)\tclTestObj.obj \
+	$(TMPDIR)\tclWinTest.obj \
+	$(TMPDIR)\testMain.obj
+
+TCLOBJS = \
+	$(TMPDIR)\panic.obj \
+	$(TMPDIR)\regexp.obj \
+	$(TMPDIR)\strftime.obj \
+	$(TMPDIR)\tclAlloc.obj \
+	$(TMPDIR)\tclAsync.obj \
+	$(TMPDIR)\tclBasic.obj \
+	$(TMPDIR)\tclBinary.obj \
+	$(TMPDIR)\tclCkalloc.obj \
+	$(TMPDIR)\tclClock.obj \
+	$(TMPDIR)\tclCmdAH.obj \
+	$(TMPDIR)\tclCmdIL.obj \
+	$(TMPDIR)\tclCmdMZ.obj \
+	$(TMPDIR)\tclCompExpr.obj \
+	$(TMPDIR)\tclCompile.obj \
+	$(TMPDIR)\tclDate.obj \
+	$(TMPDIR)\tclEnv.obj \
+	$(TMPDIR)\tclEvent.obj \
+	$(TMPDIR)\tclExecute.obj \
+	$(TMPDIR)\tclFCmd.obj \
+	$(TMPDIR)\tclFileName.obj \
+	$(TMPDIR)\tclGet.obj \
+	$(TMPDIR)\tclHash.obj \
+	$(TMPDIR)\tclHistory.obj \
+	$(TMPDIR)\tclIndexObj.obj \
+	$(TMPDIR)\tclInterp.obj \
+	$(TMPDIR)\tclIO.obj \
+	$(TMPDIR)\tclIOCmd.obj \
+	$(TMPDIR)\tclIOSock.obj \
+	$(TMPDIR)\tclIOUtil.obj \
+	$(TMPDIR)\tclLink.obj \
+	$(TMPDIR)\tclListObj.obj \
+	$(TMPDIR)\tclLoad.obj \
+	$(TMPDIR)\tclMain.obj \
+	$(TMPDIR)\tclNamesp.obj \
+	$(TMPDIR)\tclNotify.obj \
+	$(TMPDIR)\tclObj.obj \
+	$(TMPDIR)\tclParse.obj \
+	$(TMPDIR)\tclPipe.obj \
+	$(TMPDIR)\tclPkg.obj \
+	$(TMPDIR)\tclPosixStr.obj \
+	$(TMPDIR)\tclPreserve.obj \
+	$(TMPDIR)\tclProc.obj \
+	$(TMPDIR)\tclResolve.obj \
+	$(TMPDIR)\tclStringObj.obj \
+	$(TMPDIR)\tclTimer.obj \
+	$(TMPDIR)\tclUtil.obj \
+	$(TMPDIR)\tclVar.obj \
+	$(TMPDIR)\tclWin32Dll.obj \
+	$(TMPDIR)\tclWinChan.obj \
+	$(TMPDIR)\tclWinError.obj \
+	$(TMPDIR)\tclWinFCmd.obj \
+	$(TMPDIR)\tclWinFile.obj \
+	$(TMPDIR)\tclWinInit.obj \
+	$(TMPDIR)\tclWinLoad.obj \
+	$(TMPDIR)\tclWinMtherr.obj \
+	$(TMPDIR)\tclWinNotify.obj \
+	$(TMPDIR)\tclWinPipe.obj \
+	$(TMPDIR)\tclWinSock.obj \
+	$(TMPDIR)\tclWinTime.obj
+
+cc32		= $(TOOLS)\bin\bcc32.exe
+link32		= $(TOOLS)\bin\tlink32.exe
+rc32		= $(TOOLS)\bin\brcc32.exe
+implib		= $(TOOLS)\bin\implib.exe
+
+cc16		= $(TOOLS)\bin\bcc.exe
+link16		= $(TOOLS)\bin\tlink.exe
+rc16		= $(TOOLS)\bin\brcc32.exe -31
+
+CP		= copy
+RM		= del
+
+WINDIR          = $(ROOT)\win
+GENERICDIR	= $(ROOT)\generic
+
+INCLUDES	= $(TOOLS)\include;$(WINDIR);$(GENERICDIR)
+LIBDIRS		= $(TOOLS)\lib;$(WINDIR)
+
+CON_CFLAGS	= +cfgexe.cfg -WC
+TEST_CFLAGS	= +cfgtest.cfg
+DLL16_CFLAGS	= $(PROJECTCCFLAGS) -I$(INCLUDES) -D$(DEFINES) -WD -ml -c \
+			-3 -d -w
+TCL_CFLAGS	= +cfgdll.cfg
+
+CON_LFLAGS	= -Tpe -ap -c $(DEBUGLDFLAGS) $(TOOLS)\lib\c0x32
+DLL_LFLAGS	= -Tpd -aa -c $(DEBUGLDFLAGS) $(TOOLS)\lib\c0d32
+GUI_LFLAGS	= -Tpe -aa -c $(DEBUGLDFLAGS) $(TOOLS)\lib\c0w32
+DLL16_LFLAGS	= -Twd -c -C -A=16 $(DEBUGLDFLAGS16) $(TOOLS)\lib\c0dl
+
+DLL_LIBS	= import32 cw32mti
+CON_LIBS	= $(TCLLIB) import32 cw32mti
+DLL16_LIBS	= import cwl
+
+!ifndef DEBUG
+
+# these macros cause maximum optimization and no symbols
+DEBUGLDFLAGS = 
+DEBUGCCFLAGS = -v- -vi- -O2
+DEBUGLDFLAGS16 = -Oc -Oi -Oa -Or
+!else
+
+# these macros enable debugging
+DEBUGLDFLAGS = -v
+DEBUGCCFLAGS = -k -Od -v
+DEBUGLDFLAGS16 = 
+
+!endif
+
+DEFINES = MT;_RTLDLL;$(DEBUGDEFINES)
+PROJECTCCFLAGS = $(DEBUGCCFLAGS) -w-par -w-stu
+
+
+# 
+# Global makefile settings
+#
+
+.AUTODEPEND
+.CACHEAUTODEPEND
+
+.suffixes:
+
+#.path.c=$(ROOT)\win;$(ROOT)\generic;$(ROOT)\compat
+#.path.obj=$(TMPDIR)
+#.path.dll=$(ROOT)\win
+
+#
+# Targets
+#
+
+release:    $(TCLSH) dlls
+all:	    $(TCLSH) dlls $(CAT16) $(CAT32) 
+tcltest:    $(TCLTEST) dlls $(CAT16) $(CAT32)
+dlls:	    $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL)
+
+test:	    tcltest
+	$(TCLTEST) &&|
+		cd ../tests
+		source all
+|
+
+
+$(DUMPEXTS): cfgexe.cfg $(WINDIR)\winDumpExts.c
+	$(cc32) $(CON_CFLAGS) $(WINDIR)\winDumpExts.c
+	$(link32) $(CON_LFLAGS) \
+		$(TMPDIR)\winDumpExts.obj,$@,,import32 cw32mti,,
+
+$(TCLLIB): $(TCLDLL)
+	$(implib) -c $@ $(TCLDLL)
+
+$(TCLDLL): cfgdll.cfg $(TCLOBJS) $(TMPDIR)\tcl.def $(TMPDIR)\tcl.res
+	$(link32) $(DLL_LFLAGS) @&&|
+		$(TCLOBJS)
+$@
+-x
+$(DLL_LIBS)
+|, $(TMPDIR)\tcl.def, $(TMPDIR)\tcl.res
+
+
+$(TCLSH): cfgexe.cfg $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
+	$(link32) -S:$(STACKSIZE) $(CON_LFLAGS) @&&|
+		$(TCLSHOBJS)
+$@
+-x
+$(CON_LIBS)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|, $(TMPDIR)\tclsh.res
+
+$(TCLTEST): cfgtest.cfg $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
+	$(link32) -S:$(STACKSIZE) $(CON_LFLAGS) @&&|
+		$(TCLTESTOBJS)
+$@
+-x
+$(CON_LIBS)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|, $(TMPDIR)\tclsh.res
+
+
+$(TCL16DLL): tcl16.rc $(ROOT)\win\tclWin16.c
+	$(cc16) @&&|
+$(DLL16_CFLAGS) -n$(TMPDIR) 
+| $(ROOT)\win\tclWin16.c
+	$(rc16) @&&|
+-i$(INCLUDES) -d__WIN32__;$(DEFINES) -fo$(TMPDIR)\tcl16.res
+| tcl16.rc
+	@copy >nul &&|
+LIBRARY $&;dll
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE SINGLE
+HEAPSIZE 1024
+EXPORTS
+	WEP @1 RESIDENTNAME
+	UTPROC @2 
+| $(TMPDIR)\tclWin16.def
+	$(link16) $(DLL16_LFLAGS) @&&|
+$(TMPDIR)\tclWin16.obj
+$@
+nul
+$(DLL16_LIBS)
+$(TMPDIR)\tclWin16.def
+|
+	$(TOOLS)\bin\rlink $(TMPDIR)\tcl16.res $@
+
+$(TCLPIPEDLL): cfgexe.cfg stub16.c
+	$(cc32) -c -tWC stub16.c
+	$(link32) $(CON_LFLAGS) -L$(TOOLS)\lib \
+		stub16.obj,$@,,import32 cw32,,
+
+$(TCLREGDLL): extdll.cfg $(TMPDIR)\tclWinReg.obj
+	$(link32) $(DLL_LFLAGS) @&&|
+		$(TMPDIR)\tclWinReg.obj
+$@
+-x
+$(DLL_LIBS) $(TCLLIB)
+|,,
+
+#
+# Special test targets
+#
+
+$(CAT32): cat.c
+	$(cc32) -c -Ox -tWC -ocat32.obj cat.c
+	$(link32) $(CON_LFLAGS) -L$(TOOLS)\lib \
+		cat32.obj,$@,,import32 cw32,,
+
+$(CAT16): cat.c
+	$(cc16) -W- -ml -Ox -c -ocat16.obj cat.c
+	$(link16) -Tde -c -L$(TOOLS)\lib $(TOOLS)\lib\c0l.obj cat16.obj,cat16.exe,,cl.lib,,
+
+#######################################################################
+# Implicit Targets
+#######################################################################
+
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+	@$(cc32) $(TCL_CFLAGS) {$< }
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+	@$(cc32) $(TCL_CFLAGS) {$< }
+
+{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
+	@$(cc32) $(TCL_CFLAGS) {$< }
+
+{$(WINDIR)}.rc{$(TMPDIR)}.res:
+	$(rc32) -i$(INCLUDES) -fo$@ @&&|
+-d__WIN32__;$(DEFINES) $<
+|
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\tclWinReg.obj : extdll.cfg $(ROOT)\win\tclWinReg.c
+	$(cc32) +extdll.cfg -o$@ $(ROOT)\win\tclWinReg.c
+
+$(TMPDIR)\tclAppInit.obj : cfgexe.cfg $(ROOT)\win\tclAppInit.c
+	$(cc32) $(CON_CFLAGS) -o$@ $(ROOT)\win\tclAppInit.c
+
+$(TMPDIR)\testMain.obj : cfgexe.cfg $(ROOT)\win\tclAppInit.c
+	$(cc32) $(TEST_CFLAGS) -o$@ $(ROOT)\win\tclAppInit.c
+
+$(TMPDIR)\tclWin16.obj : $(ROOT)\win\tclWin16.c
+	$(cc16) $(DLL16_CFLAGS) -o$@ $(ROOT)\win\tclWin16.c
+
+#
+# Configuration file targets - these files are implicitly used by the compiler
+#
+
+cfgdll.cfg:
+	@$(CP) &&|
+		-n$(TMPDIR) -I$(INCLUDES) -c -WM
+		-D$(DEFINES) -3 -d -w $(PROJECTCCFLAGS)
+| cfgdll.cfg >NUL
+
+extdll.cfg:
+	@$(CP) &&|
+		-n$(TMPDIR) -I$(INCLUDES) -c -WD
+		-D_RTLDLL;$(DEBUGDEFINES) -3 -d -w $(PROJECTCCFLAGS)
+| extdll.cfg >NUL
+
+cfgexe.cfg:
+	@$(CP) &&|
+		-n$(TMPDIR) -I$(INCLUDES) -c -W
+		-D$(DEFINES) -3 -d -w $(PROJECTCCFLAGS)
+| cfgexe.cfg >NUL
+
+cfgtest.cfg:
+	@$(CP) &&|
+		-n$(TMPDIR) -I$(INCLUDES) -c -W
+		-D$(DEFINES);TCL_TEST -3 -d -w $(PROJECTCCFLAGS)
+| cfgtest.cfg >NUL
+
+cfgcln:
+	-@$(RM) *.cfg
+
+
+# The following rule automatically generates a tcl.def file containing
+# an export entry for every public symbol in the tcl.dll library.
+
+$(TMPDIR)\tcl.def: $(TCLOBJS) $(DUMPEXTS)
+	$(DUMPEXTS) -o $(TMPDIR)\tcl.def $(TCLDLL) @&&|
+		$(TCLOBJS)
+|
+
+
+# the following two rules are a hack to get around the fact that the
+# 16-bit compiler doesn't handle long file names :-(
+
+$(ROOT)\win\tclWinIn.h: $(ROOT)\win\tclWinInt.h
+	$(CP) $(ROOT)\win\tclWinInt.h $(ROOT)\win\tclWinIn.h
+
+$(ROOT)\win\tclWin16.c: $(ROOT)\win\tclWinIn.h
+
+# remove all generated files
+
+clean:
+	-@$(RM) *.exe
+	-@$(RM) *.lib
+	-@$(RM) *.dll
+	-@$(RM) $(TMPDIR)\*.res
+	-@$(RM) $(TMPDIR)\*.def
+	-@$(RM) $(TMPDIR)\*.obj
+	-@$(RM) $(TMPDIR)\*.cfg
+	-@$(RM) $(ROOT)\win\tclWinIn.h
diff --git a/tcl/win/makefile.vc b/tcl/win/makefile.vc
new file mode 100644
index 00000000000..50ab3631e64
--- /dev/null
+++ b/tcl/win/makefile.vc
@@ -0,0 +1,478 @@
+# Visual C++ 2.x and 4.0 makefile
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# RCS: @(#) $Id$
+
+# Does not depend on the presence of any environment variables in
+# order to compile tcl; all needed information is derived from 
+# location of the compiler directories.
+
+#
+# Project directories
+#
+# ROOT    = top of source tree
+#
+# TMPDIR  = location where .obj files should be stored during build
+#
+# TOOLS32 = location of VC++ 32-bit development tools. Note that the
+#	    VC++ 2.0 header files are broken, so you need to use the
+#	    ones that come with the developer network CD's, or later
+#	    versions of VC++.
+#
+# TOOLS16 = location of VC++ 1.5 16-bit tools, needed to build thunking
+#	    library.  This information is optional; if the 16-bit compiler
+#	    is not available, then the 16-bit code will not be built.  
+#	    Tcl will still run without the 16-bit code, but...
+#		A. Under Windows 3.X you will any calls to the exec command
+#	           will return an error.
+#		B. A 16-bit program to test the behavior of the exec
+#		   command under NT and 95 will not be built.
+# INSTALLDIR = where the install- targets should copy the binaries and
+#	    support files
+#
+
+ROOT		= ..
+TOOLS32		= c:\progra~1\devstudio\vc
+TOOLS32_rc	= c:\progra~1\devstudio\sharedide
+TOOLS16		= c:\msvc
+
+INSTALLDIR	= c:\progra~1\Tcl
+
+# Set this to the appropriate value of /MACHINE: for your platform
+MACHINE	= IX86
+
+# Set NODEBUG to 0 to compile with symbols
+NODEBUG = 1
+
+# uncomment one of the following lines to compile with TCL_MEM_DEBUG, 
+# TCL_MEM_DEBUG, or TCL_COMPILE_DEBUG
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_STATS
+#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+NAMEPREFIX = tcl
+DOTVERSION = 8.0
+VERSION = 80
+
+BINROOT		= .
+!IF "$(NODEBUG)" == "1"
+TMPDIRNAME	= Release
+DBGX		=
+!ELSE
+TMPDIRNAME	= Debug
+DBGX		= d
+!ENDIF
+TMPDIR		= $(BINROOT)\$(TMPDIRNAME)
+OUTDIRNAME	= $(TMPDIRNAME)
+OUTDIR		= $(TMPDIR)
+
+TCLLIB		= $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
+TCLDLLNAME	= $(NAMEPREFIX)$(VERSION)$(DBGX).dll
+TCLDLL		= $(OUTDIR)\$(TCLDLLNAME)
+TCLPLUGINLIB	= $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
+TCLPLUGINDLLNAME= $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
+TCLPLUGINDLL	= $(OUTDIR)\$(TCLPLUGINDLLNAME)
+TCL16DLL	= $(OUTDIR)\$(NAMEPREFIX)16$(VERSION)$(DBGX).dll
+TCLSH		= $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
+TCLSHP		= $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
+TCLPIPEDLLNAME	= $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
+TCLPIPEDLL	= $(OUTDIR)\$(TCLPIPEDLLNAME)
+TCLREGDLLNAME	= $(NAMEPREFIX)reg$(VERSION)$(DBGX).dll
+TCLREGDLL	= $(OUTDIR)\$(TCLREGDLLNAME)
+TCLTEST		= $(OUTDIR)\$(NAMEPREFIX)test.exe
+DUMPEXTS	= $(TMPDIR)\dumpexts.exe
+CAT16		= $(TMPDIR)\cat16.exe
+CAT32		= $(TMPDIR)\cat32.exe
+
+LIB_INSTALL_DIR	= $(INSTALLDIR)\lib
+BIN_INSTALL_DIR	= $(INSTALLDIR)\bin
+SCRIPT_INSTALL_DIR	= $(INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR	= $(INSTALLDIR)\include
+
+TCLSHOBJS = \
+	$(TMPDIR)\tclAppInit.obj
+
+TCLTESTOBJS = \
+	$(TMPDIR)\tclTest.obj \
+	$(TMPDIR)\tclTestObj.obj \
+	$(TMPDIR)\tclTestProcBodyObj.obj \
+	$(TMPDIR)\tclWinTest.obj \
+	$(TMPDIR)\testMain.obj
+
+TCLOBJS = \
+	$(TMPDIR)\panic.obj \
+	$(TMPDIR)\regexp.obj \
+	$(TMPDIR)\strftime.obj \
+	$(TMPDIR)\tclAlloc.obj \
+	$(TMPDIR)\tclAsync.obj \
+	$(TMPDIR)\tclBasic.obj \
+	$(TMPDIR)\tclBinary.obj \
+	$(TMPDIR)\tclCkalloc.obj \
+	$(TMPDIR)\tclClock.obj \
+	$(TMPDIR)\tclCmdAH.obj \
+	$(TMPDIR)\tclCmdIL.obj \
+	$(TMPDIR)\tclCmdMZ.obj \
+	$(TMPDIR)\tclCompExpr.obj \
+	$(TMPDIR)\tclCompile.obj \
+	$(TMPDIR)\tclDate.obj \
+	$(TMPDIR)\tclEnv.obj \
+	$(TMPDIR)\tclEvent.obj \
+	$(TMPDIR)\tclExecute.obj \
+	$(TMPDIR)\tclFCmd.obj \
+	$(TMPDIR)\tclFileName.obj \
+	$(TMPDIR)\tclGet.obj \
+	$(TMPDIR)\tclHash.obj \
+	$(TMPDIR)\tclHistory.obj \
+	$(TMPDIR)\tclIndexObj.obj \
+	$(TMPDIR)\tclInterp.obj \
+	$(TMPDIR)\tclIO.obj \
+	$(TMPDIR)\tclIOCmd.obj \
+	$(TMPDIR)\tclIOSock.obj \
+	$(TMPDIR)\tclIOUtil.obj \
+	$(TMPDIR)\tclLink.obj \
+	$(TMPDIR)\tclListObj.obj \
+	$(TMPDIR)\tclLoad.obj \
+	$(TMPDIR)\tclMain.obj \
+	$(TMPDIR)\tclNamesp.obj \
+	$(TMPDIR)\tclNotify.obj \
+	$(TMPDIR)\tclObj.obj \
+	$(TMPDIR)\tclParse.obj \
+	$(TMPDIR)\tclPipe.obj \
+	$(TMPDIR)\tclPkg.obj \
+	$(TMPDIR)\tclPosixStr.obj \
+	$(TMPDIR)\tclPreserve.obj \
+	$(TMPDIR)\tclResolve.obj \
+	$(TMPDIR)\tclProc.obj \
+	$(TMPDIR)\tclStringObj.obj \
+	$(TMPDIR)\tclTimer.obj \
+	$(TMPDIR)\tclUtil.obj \
+	$(TMPDIR)\tclVar.obj \
+	$(TMPDIR)\tclWin32Dll.obj \
+	$(TMPDIR)\tclWinChan.obj \
+	$(TMPDIR)\tclWinError.obj \
+	$(TMPDIR)\tclWinFCmd.obj \
+	$(TMPDIR)\tclWinFile.obj \
+	$(TMPDIR)\tclWinInit.obj \
+	$(TMPDIR)\tclWinLoad.obj \
+	$(TMPDIR)\tclWinMtherr.obj \
+	$(TMPDIR)\tclWinNotify.obj \
+	$(TMPDIR)\tclWinPipe.obj \
+	$(TMPDIR)\tclWinSock.obj \
+	$(TMPDIR)\tclWinTime.obj 
+
+cc32		= $(TOOLS32)\bin\cl.exe
+link32		= $(TOOLS32)\bin\link.exe
+rc32		= $(TOOLS32_rc)\bin\rc.exe
+include32	= -I$(TOOLS32)\include
+
+cc16		= $(TOOLS16)\bin\cl.exe
+link16		= $(TOOLS16)\bin\link.exe
+rc16		= $(TOOLS16)\bin\rc.exe
+include16	= -I$(TOOLS16)\include
+
+WINDIR          = $(ROOT)\win
+GENERICDIR	= $(ROOT)\generic
+
+TCL_INCLUDES	= -I$(WINDIR) -I$(GENERICDIR)
+TCL_DEFINES	= -D__WIN32__ $(DEBUGDEFINES)
+
+TCL_CFLAGS	= $(cdebug) $(cflags) $(cvarsdll) $(include32) \
+			$(TCL_INCLUDES) $(TCL_DEFINES)
+CON_CFLAGS	= $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE
+DOS_CFLAGS	= $(cdebug) $(cflags) $(include16) -AL 
+DLL16_CFLAGS	= $(cdebug) $(cflags) $(include16) -ALw
+
+######################################################################
+# Link flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+ldebug = /RELEASE
+!ELSE
+ldebug = -debug:full -debugtype:cv
+!ENDIF
+
+# declarations common to all linker options
+lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
+
+# declarations for use on Intel i386, i486, and Pentium systems
+!IF "$(MACHINE)" == "IX86"
+DLLENTRY = @12
+lflags   = $(lcommon) /MACHINE:$(MACHINE)
+!ELSE
+lflags   = $(lcommon) /MACHINE:$(MACHINE)
+!ENDIF
+
+conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
+guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
+dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
+
+!IF "$(MACHINE)" == "PPC"
+libc = libc$(DBGX).lib
+libcdll = crtdll$(DBGX).lib
+!ELSE
+libc = libc$(DBGX).lib oldnames.lib
+libcdll = msvcrt$(DBGX).lib oldnames.lib
+!ENDIF
+
+baselibs   = kernel32.lib $(optlibs) advapi32.lib user32.lib
+winlibs    = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
+
+guilibs	   = $(libc) $(winlibs)
+conlibs	   = $(libc) $(baselibs)
+guilibsdll = $(libcdll) $(winlibs)
+conlibsdll = $(libcdll) $(baselibs)
+
+######################################################################
+# Compile flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+!IF "$(MACHINE)" == "ALPHA"
+# MSVC on Alpha doesn't understand -Ot
+cdebug = -O2i -Gs -GD
+!ELSE
+#cdebug = -Oti -Gs -GD
+# This cranks the optimization level to maximize speed
+cdebug = -O2 -Gs -GD
+!ENDIF
+!ELSE
+cdebug = -Z7 -Od -WX
+!ENDIF
+
+# declarations common to all compiler options
+ccommon = -c -W3 -nologo -YX -Fp$(TMPDIR)\ -Dtry=__try -Dexcept=__except
+
+!IF "$(MACHINE)" == "IX86"
+cflags = $(ccommon) -D_X86_=1
+!ELSE
+!IF "$(MACHINE)" == "MIPS"
+cflags = $(ccommon) -D_MIPS_=1
+!ELSE
+!IF "$(MACHINE)" == "PPC"
+cflags = $(ccommon) -D_PPC_=1
+!ELSE
+!IF "$(MACHINE)" == "ALPHA"
+cflags = $(ccommon) -D_ALPHA_=1
+!ENDIF
+!ENDIF
+!ENDIF
+!ENDIF
+
+cvars      = -DWIN32 -D_WIN32
+cvarsmt    = $(cvars) -D_MT
+cvarsdll   = $(cvarsmt) -D_DLL
+
+!IF "$(NODEBUG)" == "1"
+cvarsdll   = $(cvars) -MD
+!ELSE
+cvarsdll   = $(cvars) -MDd
+!ENDIF
+
+######################################################################
+# Project specific targets
+######################################################################
+
+release:    setup $(TCLSH) dlls
+dlls:	    setup $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL)
+all:	    setup $(TCLSH) dlls $(CAT16) $(CAT32) 
+tcltest:    setup $(TCLTEST) dlls $(CAT16) $(CAT32)
+plugin:	    setup $(TCLPLUGINDLL) $(TCLSHP)
+install:    install-binaries install-libraries
+test:	    setup $(TCLTEST) dlls $(CAT16) $(CAT32)
+	copy $(WINDIR)\pkgIndex.tcl $(OUTDIR)
+	set TCL_LIBRARY=$(ROOT)/library
+	$(TCLTEST) <<
+		cd ../tests
+		source all
+<<
+
+setup:
+	@mkd $(TMPDIR)
+	@mkd $(OUTDIR)
+
+$(DUMPEXTS): $(WINDIR)\winDumpExts.c
+	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
+		$(TMPDIR)\winDumpExts.obj 
+
+$(TCLLIB): $(TCLDLL)
+
+$(TCLDLL): $(TCLOBJS) $(TMPDIR)\tcl.def $(TMPDIR)\tcl.res
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tcl.def \
+		-out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
+$(TCLOBJS)
+<<
+
+$(TCLPLUGINLIB): $(TCLPLUGINDLL)
+
+$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\plugin.def $(TMPDIR)\tcl.res
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\plugin.def \
+		-out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
+$(TCLOBJS)
+<<
+
+$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
+		-out:$@ $(conlibsdll) $(TCLLIB) $(TCLSHOBJS) 
+
+$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
+		-out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS) 
+
+$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
+		 -out:$@ $(conlibsdll) $(TCLLIB) $(TCLTESTOBJS)
+
+$(TCL16DLL):  $(WINDIR)\tcl16.rc $(WINDIR)\tclWin16.c
+	if exist $(cc16) $(cc16) @<<
+$(DLL16_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\tclWin16.c
+<<                         
+	@copy << $(TMPDIR)\tclWin16.def > nul
+LIBRARY $(@B);dll
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE SINGLE
+HEAPSIZE 1024 
+EXPORTS
+	WEP @1 RESIDENTNAME
+	UTPROC @2 
+<< 
+	if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOE @<<
+$(TMPDIR)\tclWin16.obj
+$@
+nul
+$(TOOLS16)\lib\ ldllcew oldnames libw toolhelp
+$(TMPDIR)\tclWin16.def
+<<
+	if exist $(cc16) $(rc16) -i $(GENERICDIR) $(TCL_DEFINES) $(WINDIR)\tcl16.rc $@
+
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\stub16.c
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(conlflags) -out:$@ $(TMPDIR)\stub16.obj $(guilibs)
+
+$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)\tclWinReg.obj \
+		$(conlibsdll) $(TCLLIB)
+
+$(CAT32): $(WINDIR)\cat.c
+	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
+	set LIB=$(TOOLS32)\lib
+	$(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
+
+$(CAT16): $(WINDIR)\cat.c
+	if exist $(cc16) $(cc16) $(DOS_CFLAGS) -Fo$(TMPDIR)\ $?
+	set LIB=$(TOOLS16)\lib
+	if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOI /STACK:16384 \
+		$(TMPDIR)\cat.obj,$@,nul,llibce.lib,nul
+
+$(TMPDIR)\tcl.def: $(DUMPEXTS) $(TCLOBJS)
+	$(DUMPEXTS) -o $@ $(TCLDLLNAME) @<<
+$(TCLOBJS)
+<<
+
+$(TMPDIR)\plugin.def: $(DUMPEXTS) $(TCLOBJS)
+	$(DUMPEXTS) -o $@ $(TCLPLUGINDLLNAME) @<<
+$(TCLOBJS)
+<<
+
+install-binaries: $(TCLSH)
+	@mkd $(BIN_INSTALL_DIR)
+	@mkd $(LIB_INSTALL_DIR)
+	@echo installing $(TCLDLLNAME)
+	@copy $(TCLDLL) $(BIN_INSTALL_DIR)
+	@echo installing $(TCLSH)
+	@copy $(TCLSH) $(BIN_INSTALL_DIR)
+
+install-libraries:
+	-@mkd $(LIB_INSTALL_DIR)
+	-@mkd $(INCLUDE_INSTALL_DIR)
+	-@mkd $(SCRIPT_INSTALL_DIR)
+	-@mkd $(SCRIPT_INSTALL_DIR)\http1.0
+	-@copy $(ROOT)\library\http1.0\http.tcl $(SCRIPT_INSTALL_DIR)\http1.0
+	-@copy $(ROOT)\library\http1.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http1.0
+	-@mkd $(SCRIPT_INSTALL_DIR)\http2.0
+	-@copy $(ROOT)\library\http2.0\http.tcl $(SCRIPT_INSTALL_DIR)\http2.0
+	-@copy $(ROOT)\library\http2.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http2.0
+	-@mkd $(SCRIPT_INSTALL_DIR)\opt0.1
+	-@copy $(ROOT)\library\opt0.1\optparse.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
+	-@copy $(ROOT)\library\opt0.1\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
+	-@copy $(GENERICDIR)\tcl.h $(INCLUDE_INSTALL_DIR)
+	-@copy $(ROOT)\library\history.tcl $(SCRIPT_INSTALL_DIR)
+	-@copy $(ROOT)\library\init.tcl $(SCRIPT_INSTALL_DIR)
+	-@copy $(ROOT)\library\ldAout.tcl $(SCRIPT_INSTALL_DIR)
+	-@copy $(ROOT)\library\parray.tcl $(SCRIPT_INSTALL_DIR)
+	-@copy $(ROOT)\library\safe.tcl $(SCRIPT_INSTALL_DIR)
+	-@copy $(ROOT)\library\tclIndex $(SCRIPT_INSTALL_DIR)
+	-@copy $(ROOT)\library\word.tcl $(SCRIPT_INSTALL_DIR)
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
+	$(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) $(EXTFLAGS) \
+		-Fo$(TMPDIR)\ $?
+
+$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -DTCL_TEST \
+		-Fo$(TMPDIR)\testMain.obj $?
+
+$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
+	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -Fo$@ $?
+
+#
+# Implicit rules
+#
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+    $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+    $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
+    $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(WINDIR)}.rc{$(TMPDIR)}.res:
+	$(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \
+		$(TCL_DEFINES) $<
+
+clean:
+        -@del $(OUTDIR)\*.exp 
+	-@del $(OUTDIR)\*.lib 
+	-@del $(OUTDIR)\*.dll 
+	-@del $(OUTDIR)\*.exe
+	-@del $(OUTDIR)\*.pdb
+	-@del $(TMPDIR)\*.pch
+        -@del $(TMPDIR)\*.obj
+        -@del $(TMPDIR)\*.res
+        -@del $(TMPDIR)\*.def
+        -@del $(TMPDIR)\*.exe
+	-@rmd $(OUTDIR)
+	-@rmd $(TMPDIR)
diff --git a/tcl/win/mkd.bat b/tcl/win/mkd.bat
new file mode 100644
index 00000000000..2bd2388394f
--- /dev/null
+++ b/tcl/win/mkd.bat
@@ -0,0 +1,21 @@
+@echo off
+rem RCS: @(#) $Id$
+
+if exist %1\tag.txt goto end
+
+if "%OS%" == "Windows_NT" goto winnt
+
+md %1
+if errorlevel 1 goto end
+
+goto success
+
+:winnt
+md %1
+if errorlevel 1 goto end
+
+:success
+echo TAG >%1\tag.txt
+echo created directory %1
+
+:end
diff --git a/tcl/win/rmd.bat b/tcl/win/rmd.bat
new file mode 100644
index 00000000000..15fd8c1fabc
--- /dev/null
+++ b/tcl/win/rmd.bat
@@ -0,0 +1,25 @@
+@echo off
+rem RCS: @(#) $Id$
+
+if not exist %1\tag.txt goto end
+
+echo Removing directory %1
+
+if "%OS%" == "Windows_NT" goto winnt
+
+cd %1
+if errorlevel 1 goto end
+del *.*
+cd ..
+rmdir %1
+if errorlevel 1 goto end
+goto success
+
+:winnt
+rmdir %1 /s /q
+if errorlevel 1 goto end
+
+:success
+echo deleted directory %1
+
+:end
diff --git a/tcl/win/stub16.c b/tcl/win/stub16.c
new file mode 100644
index 00000000000..2138d508017
--- /dev/null
+++ b/tcl/win/stub16.c
@@ -0,0 +1,198 @@
+/* 
+ * stub16.c 
+ *
+ *	A helper program used for running 16-bit DOS applications under
+ *	Windows 95.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define STRICT
+
+#include <windows.h>
+#include <stdio.h>
+
+static HANDLE		CreateTempFile(void);
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * main
+ *
+ *	Entry point for the 32-bit console mode app used by Windows 95 to
+ *	help run the 16-bit program specified on the command line.
+ *
+ *	1. EOF on a pipe that connects a detached 16-bit process and a
+ *	32-bit process is never seen.  So, this process runs the 16-bit
+ *	process _attached_, and then it is run detached from the calling
+ *	32-bit process.  
+ * 
+ *	2. If a 16-bit process blocks reading from or writing to a pipe,
+ *	it never wakes up, and eventually brings the whole system down
+ *	with it if you try to kill the process.  This app simulates
+ *	pipes.  If any of the stdio handles is a pipe, this program
+ *	accumulates information into temp files and forwards it to or
+ *	from the DOS application as appropriate.  This means that this
+ *	program must receive EOF from a stdin pipe before it will actually
+ *	start the DOS app, and the DOS app must finish generating stdout
+ *	or stderr before the data will be sent to the next stage of the
+ *	pipe.  If the stdio handles are not pipes, no accumulation occurs
+ *	and the data is passed straight through to and from the DOS
+ *	application.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The child process is created and this process waits for it to
+ *	complete.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+main()
+{
+    DWORD dwRead, dwWrite;
+    char *cmdLine;
+    HANDLE hStdInput, hStdOutput, hStdError;
+    HANDLE hFileInput, hFileOutput, hFileError;
+    STARTUPINFO si;
+    PROCESS_INFORMATION pi;
+    char buf[8192];
+    DWORD result;
+
+    hFileInput = INVALID_HANDLE_VALUE;
+    hFileOutput = INVALID_HANDLE_VALUE;
+    hFileError = INVALID_HANDLE_VALUE;
+    result = 1;
+
+    /*
+     * Don't get command line from argc, argv, because the command line
+     * tokenizer will have stripped off all the escape sequences needed
+     * for quotes and backslashes, and then we'd have to put them all
+     * back in again.  Get the raw command line and parse off what we
+     * want ourselves.  The command line should be of the form:
+     *
+     * stub16.exe program arg1 arg2 ...
+     */
+
+    cmdLine = strchr(GetCommandLine(), ' ');
+    if (cmdLine == NULL) {
+	return 1;
+    }
+    cmdLine++;
+
+    hStdInput = GetStdHandle(STD_INPUT_HANDLE);
+    hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
+    hStdError = GetStdHandle(STD_ERROR_HANDLE);
+
+    if (GetFileType(hStdInput) == FILE_TYPE_PIPE) {
+	hFileInput = CreateTempFile();
+	if (hFileInput == INVALID_HANDLE_VALUE) {
+	    goto cleanup;
+	}
+	while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+	    if (dwRead == 0) {
+		break;
+	    }
+	    if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) {
+		goto cleanup;
+	    }
+	}
+	SetFilePointer(hFileInput, 0, 0, FILE_BEGIN);
+	SetStdHandle(STD_INPUT_HANDLE, hFileInput);
+    }
+    if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) {
+	hFileOutput = CreateTempFile();
+	if (hFileOutput == INVALID_HANDLE_VALUE) {
+	    goto cleanup;
+	}
+	SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput);
+    }
+    if (GetFileType(hStdError) == FILE_TYPE_PIPE) {
+	hFileError = CreateTempFile();
+	if (hFileError == INVALID_HANDLE_VALUE) {
+	    goto cleanup;
+	}
+	SetStdHandle(STD_ERROR_HANDLE, hFileError);
+    }
+
+    ZeroMemory(&si, sizeof(si));
+    si.cb = sizeof(si);
+    if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, 
+	    &pi) == FALSE) {
+	goto cleanup;
+    }
+
+    WaitForInputIdle(pi.hProcess, 5000);
+    WaitForSingleObject(pi.hProcess, INFINITE);
+    CloseHandle(pi.hProcess);
+    CloseHandle(pi.hThread);
+    result = 0;
+
+    if (hFileOutput != INVALID_HANDLE_VALUE) {
+	SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN);
+	while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+	    if (dwRead == 0) {
+		break;
+	    }
+	    if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) {
+		break;
+	    }
+	}
+    }
+    if (hFileError != INVALID_HANDLE_VALUE) {
+	SetFilePointer(hFileError, 0, 0, FILE_BEGIN);
+	while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+	    if (dwRead == 0) {
+		break;
+	    }
+	    if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) {
+		break;
+	    }
+	}
+    }
+
+cleanup:
+    if (hFileInput != INVALID_HANDLE_VALUE) {
+	CloseHandle(hFileInput);
+    }
+    if (hFileOutput != INVALID_HANDLE_VALUE) {
+	CloseHandle(hFileOutput);
+    }
+    if (hFileError != INVALID_HANDLE_VALUE) {
+	CloseHandle(hFileError);
+    }
+    CloseHandle(hStdInput);
+    CloseHandle(hStdOutput);
+    CloseHandle(hStdError);
+    ExitProcess(result);
+    return 1;
+}
+
+static HANDLE
+CreateTempFile()
+{
+    char name[MAX_PATH];
+    SECURITY_ATTRIBUTES sa;
+
+    if (GetTempPath(sizeof(name), name) == 0) {
+	return INVALID_HANDLE_VALUE;
+    }
+    if (GetTempFileName(name, "tcl", 0, name) == 0) {
+	return INVALID_HANDLE_VALUE;
+    }
+
+    sa.nLength = sizeof(sa);
+    sa.lpSecurityDescriptor = NULL;
+    sa.bInheritHandle = TRUE;
+    return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, 
+	    CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
+	    NULL);
+}
diff --git a/tcl/win/tcl.rc b/tcl/win/tcl.rc
new file mode 100644
index 00000000000..31e70755eda
--- /dev/null
+++ b/tcl/win/tcl.rc
@@ -0,0 +1,42 @@
+// RCS: @(#) $Id$
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <tcl.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ FILEFLAGSMASK 	0x3fL
+ FILEFLAGS 	0x0L
+ FILEOS 	0x4L
+ FILETYPE 	0x2L
+ FILESUBTYPE 	0x0L
+BEGIN
+    BLOCK "StringFileInfo"
+    BEGIN
+        BLOCK "040904b0"
+        BEGIN
+            VALUE "FileDescription", "Tcl DLL\0"
+            VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".dll\0"
+            VALUE "CompanyName", "Sun Microsystems, Inc\0"
+            VALUE "FileVersion", TCL_PATCH_LEVEL
+            VALUE "LegalCopyright", "Copyright \251 1995-1997\0"
+            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
+            VALUE "ProductVersion", TCL_PATCH_LEVEL
+        END
+    END
+    BLOCK "VarFileInfo"
+    BEGIN
+        VALUE "Translation", 0x409, 1200
+    END
+END
+
+
+
+
+
+
+
diff --git a/tcl/win/tclAppInit.c b/tcl/win/tclAppInit.c
new file mode 100644
index 00000000000..1d1f970907f
--- /dev/null
+++ b/tcl/win/tclAppInit.c
@@ -0,0 +1,266 @@
+/* 
+ * tclAppInit.c --
+ *
+ *	Provides a default version of the main program and Tcl_AppInit
+ *	procedure for Tcl applications (without Tk).  Note that this
+ *	program must be built in Win32 console mode to work properly.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+#include <windows.h>
+#include <locale.h>
+
+#ifdef TCL_TEST
+EXTERN int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	This is the main program for the application.
+ *
+ * Results:
+ *	None: Tcl_Main never returns here, so this procedure never
+ *	returns either.
+ *
+ * Side effects:
+ *	Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+    int argc;			/* Number of command-line arguments. */
+    char **argv;		/* Values of command-line arguments. */
+{
+    char *p;
+    char buffer[MAX_PATH];
+
+    /*
+     * Set up the default locale to be standard "C" locale so parsing
+     * is performed correctly.
+     */
+
+    setlocale(LC_ALL, "C");
+
+    setargv(&argc, &argv);
+
+    /*
+     * Replace argv[0] with full pathname of executable, and forward
+     * slashes substituted for backslashes.
+     */
+
+    GetModuleFileName(NULL, buffer, sizeof(buffer));
+    argv[0] = buffer;
+    for (p = buffer; *p != '\0'; p++) {
+	if (*p == '\\') {
+	    *p = '/';
+	}
+    }
+
+    Tcl_Main(argc, argv, Tcl_AppInit);
+    return 0;			/* Needed only to prevent compiler warning. */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ *	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
+Tcl_AppInit(interp)
+    Tcl_Interp *interp;		/* Interpreter for application. */
+{
+    if (Tcl_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+#ifdef TCL_TEST
+    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;
+    }
+    if (Procbodytest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
+            Procbodytest_SafeInit);
+#endif /* TCL_TEST */
+
+    /*
+     * Call the init procedures for included packages.  Each call should
+     * look like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module.
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if
+     * they weren't already created by the init procedures called above.
+     */
+
+    /*
+     * Specify a user-specific startup file to invoke if the application
+     * is run interactively.  Typically the startup file is "~/.apprc"
+     * where "app" is the name of the application.  If this line is deleted
+     * then no user-specific startup file will be run under any conditions.
+     */
+
+    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * setargv --
+ *
+ *	Parse the Windows command line string into argc/argv.  Done here
+ *	because we don't trust the builtin argument parser in crt0.  
+ *	Windows applications are responsible for breaking their command
+ *	line into arguments.
+ *
+ *	2N backslashes + quote -> N backslashes + begin quoted string
+ *	2N + 1 backslashes + quote -> literal
+ *	N backslashes + non-quote -> literal
+ *	quote + quote in a quoted string -> single quote
+ *	quote + quote not in quoted string -> empty string
+ *	quote -> begin quoted string
+ *
+ * Results:
+ *	Fills argcPtr with the number of arguments and argvPtr with the
+ *	array of arguments.
+ *
+ * Side effects:
+ *	Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+static void
+setargv(argcPtr, argvPtr)
+    int *argcPtr;		/* Filled with number of argument strings. */
+    char ***argvPtr;		/* Filled with argument strings (malloc'd). */
+{
+    char *cmdLine, *p, *arg, *argSpace;
+    char **argv;
+    int argc, size, inquote, copy, slashes;
+    
+    cmdLine = GetCommandLine();
+
+    /*
+     * Precompute an overly pessimistic guess at the number of arguments
+     * in the command line by counting non-space spans.
+     */
+
+    size = 2;
+    for (p = cmdLine; *p != '\0'; p++) {
+	if (isspace(*p)) {
+	    size++;
+	    while (isspace(*p)) {
+		p++;
+	    }
+	    if (*p == '\0') {
+		break;
+	    }
+	}
+    }
+    argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *) 
+	    + strlen(cmdLine) + 1));
+    argv = (char **) argSpace;
+    argSpace += size * sizeof(char *);
+    size--;
+
+    p = cmdLine;
+    for (argc = 0; argc < size; argc++) {
+	argv[argc] = arg = argSpace;
+	while (isspace(*p)) {
+	    p++;
+	}
+	if (*p == '\0') {
+	    break;
+	}
+
+	inquote = 0;
+	slashes = 0;
+	while (1) {
+	    copy = 1;
+	    while (*p == '\\') {
+		slashes++;
+		p++;
+	    }
+	    if (*p == '"') {
+		if ((slashes & 1) == 0) {
+		    copy = 0;
+		    if ((inquote) && (p[1] == '"')) {
+			p++;
+			copy = 1;
+		    } else {
+			inquote = !inquote;
+		    }
+                }
+                slashes >>= 1;
+            }
+
+            while (slashes) {
+		*arg = '\\';
+		arg++;
+		slashes--;
+	    }
+
+	    if ((*p == '\0') || (!inquote && isspace(*p))) {
+		break;
+	    }
+	    if (copy != 0) {
+		*arg = *p;
+		arg++;
+	    }
+	    p++;
+        }
+	*arg = '\0';
+	argSpace = arg + 1;
+    }
+    argv[argc] = NULL;
+
+    *argcPtr = argc;
+    *argvPtr = argv;
+}
diff --git a/tcl/win/tclWin32Dll.c b/tcl/win/tclWin32Dll.c
new file mode 100644
index 00000000000..9f4269b8a13
--- /dev/null
+++ b/tcl/win/tclWin32Dll.c
@@ -0,0 +1,420 @@
+/* 
+ * tclWin32Dll.c --
+ *
+ *	This file contains the DLL entry point which sets up the 32-to-16-bit
+ *	thunking code for SynchSpawn if the library is running under Win32s.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+typedef DWORD (WINAPI * UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
+	LPVOID *lpTranslationList);
+
+typedef BOOL (WINAPI * PUTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
+	LPCSTR InitName, LPCSTR ProcName, UT32PROC* ThirtyTwoBitThunk,
+	FARPROC UT32Callback, LPVOID Buff);
+
+typedef VOID (WINAPI * PUTUNREGISTER)(HANDLE hModule);
+
+static PUTUNREGISTER UTUnRegister = NULL;
+static int           tclProcessesAttached = 0;
+
+/*
+ * The following data structure is used to keep track of all of the DLL's
+ * opened by Tcl so that they can be freed with the Tcl.dll is unloaded.
+ */
+
+typedef struct LibraryList {
+    HINSTANCE handle;
+    struct LibraryList *nextPtr;
+} LibraryList;
+
+static LibraryList *libraryList = NULL;	/* List of currently loaded DLL's.  */
+
+static HINSTANCE tclInstance;	/* Global library instance handle. */
+static int tclPlatformId;	/* Running under NT, 95, or Win32s? */
+
+/*
+ * Declarations for functions that are only used in this file.
+ */
+
+static void 		UnloadLibraries _ANSI_ARGS_((void));
+
+/*
+ * The following declaration is for the VC++ DLL entry point.
+ */
+
+BOOL APIENTRY		DllMain _ANSI_ARGS_((HINSTANCE hInst,
+			    DWORD reason, LPVOID reserved));
+
+#ifdef __WIN32__
+#ifndef STATIC_BUILD
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+/* cygwin32 requires an impure pointer variable, which must be
+   explicitly initialized when the DLL starts up.  */
+struct _reent *_impure_ptr;
+extern struct _reent *__imp_reent_data;
+#endif
+/* END CYGNUS LOCAL */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ *	This wrapper function is used by Borland to invoke the
+ *	initialization code for Tcl.  It simply calls the DllMain
+ *	routine.
+ *
+ * Results:
+ *	See DllMain.
+ *
+ * Side effects:
+ *	See DllMain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+    HINSTANCE hInst;		/* Library instance handle. */
+    DWORD reason;		/* Reason this function is being called. */
+    LPVOID reserved;		/* Not used. */
+{
+    return DllMain(hInst, reason, reserved);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ *	This routine is called by the VC++ C run time library init
+ *	code, or the DllEntryPoint routine.  It is responsible for
+ *	initializing various dynamically loaded libraries.
+ *
+ * Results:
+ *	TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ *	Establishes 32-to-16 bit thunk and initializes sockets library.
+ *
+ *----------------------------------------------------------------------
+ */
+BOOL APIENTRY
+DllMain(hInst, reason, reserved)
+    HINSTANCE hInst;		/* Library instance handle. */
+    DWORD reason;		/* Reason this function is being called. */
+    LPVOID reserved;		/* Not used. */
+{
+    OSVERSIONINFO os;
+
+    /* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+    /* cygwin32 requires the impure data pointer to be initialized
+       when the DLL starts up.  */
+    _impure_ptr = __imp_reent_data;
+#endif
+    /* END CYGNUS LOCAL */
+
+    switch (reason) {
+    case DLL_PROCESS_ATTACH:
+	if (tclProcessesAttached++) {
+	    return FALSE;         /* Not the first initialization. */
+	}
+
+	TclWinInit(hInst);
+	return TRUE;
+
+    case DLL_PROCESS_DETACH:
+
+	tclProcessesAttached--;
+	if (tclProcessesAttached == 0) {
+            Tcl_Finalize();
+	}
+	break;
+    }
+
+    return TRUE; 
+}
+
+#endif /* !STATIC_BUILD */
+#endif /* __WIN32__ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinInit --
+ *
+ *	This function initializes the internal state of the tcl library.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the 16-bit thunking library, and the tclPlatformId
+ *	variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinInit(hInst)
+    HINSTANCE hInst;		/* Library instance handle. */
+{
+    OSVERSIONINFO os;
+
+    tclInstance = hInst;
+    os.dwOSVersionInfoSize = sizeof(os);
+    GetVersionEx(&os);
+    tclPlatformId = os.dwPlatformId;
+
+    /*
+     * The following code stops Windows 3.x from automatically putting 
+     * up Sharing Violation dialogs, e.g, when someone tries to
+     * access a file that is locked or a drive with no disk in it.
+     * Tcl already returns the appropriate error to the caller, and they 
+     * can decide to put up their own dialog in response to that failure.  
+     *
+     * Under 95 and NT, the system doesn't automatically put up dialogs 
+     * when the above operations fail.
+     */
+
+    if (tclPlatformId == VER_PLATFORM_WIN32s) {
+	SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalize --
+ *
+ *	Clean up the Windows specific library state.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Unloads any DLLs and cleans up the thunking library, if
+ *	necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalize()
+{
+    /*
+     * Unregister the Tcl thunk.
+     */
+
+    if (UTUnRegister != NULL) {
+	UTUnRegister(tclInstance);
+	UTUnRegister = NULL;
+    }
+
+    /*
+     * Cleanup any dynamically loaded libraries.
+     */
+
+    UnloadLibraries();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinLoadLibrary --
+ *
+ *	This function is a wrapper for the system LoadLibrary.  It is
+ *	responsible for adding library handles to the library list so
+ *	the libraries can be freed when tcl.dll is unloaded.
+ *
+ * Results:
+ *	Returns the handle of the newly loaded library, or NULL on
+ *	failure.
+ *
+ * Side effects:
+ *	Loads the specified library into the process.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HINSTANCE
+TclWinLoadLibrary(name)
+    char *name;			/* Library file to load. */
+{
+    HINSTANCE handle;
+    LibraryList *ptr;
+
+    handle = LoadLibrary(name);
+    if (handle != NULL) {
+	ptr = (LibraryList*) ckalloc(sizeof(LibraryList));
+	ptr->handle = handle;
+	ptr->nextPtr = libraryList;
+	libraryList = ptr;
+    } else {
+	TclWinConvertError(GetLastError());
+    }
+    return handle;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnloadLibraries --
+ *
+ *	Frees any dynamically allocated libraries loaded by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees the libraries on the library list as well as the list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnloadLibraries()
+{
+    LibraryList *ptr;
+
+    while (libraryList != NULL) {
+	FreeLibrary(libraryList->handle);
+	ptr = libraryList->nextPtr;
+	ckfree((char*)libraryList);
+	libraryList = ptr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinSynchSpawn --
+ *
+ *	32-bit entry point to the 16-bit SynchSpawn code.
+ *
+ * Results:
+ *	1 on success, 0 on failure.
+ *
+ * Side effects:
+ *	Spawns a command and waits for it to complete.
+ *
+ *----------------------------------------------------------------------
+ */
+int 
+TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
+{
+    static UT32PROC UTProc = NULL;
+    static int utErrorCode;
+
+    if (UTUnRegister == NULL) {
+	/*
+	 * Load the Universal Thunking routines from kernel32.dll.
+	 */
+
+	HINSTANCE hKernel;
+	PUTREGISTER UTRegister;
+	char buffer[] = "TCL16xx.DLL";
+
+	hKernel = TclWinLoadLibrary("Kernel32.Dll");
+	if (hKernel == NULL) {
+	    return 0;
+	}
+
+	UTRegister = (PUTREGISTER) GetProcAddress(hKernel, "UTRegister");
+	UTUnRegister = (PUTUNREGISTER) GetProcAddress(hKernel, "UTUnRegister");
+	if (!UTRegister || !UTUnRegister) {
+	    UnloadLibraries();
+	    return 0;
+	}
+
+	/*
+	 * Construct the complete name of tcl16xx.dll.
+	 */
+
+	buffer[5] = '0' + TCL_MAJOR_VERSION;
+	buffer[6] = '0' + TCL_MINOR_VERSION;
+
+	/*
+	 * Register the Tcl thunk.
+	 */
+
+	if (UTRegister(tclInstance, buffer, NULL, "UTProc", &UTProc, NULL,
+		NULL) == FALSE) {
+	    utErrorCode = GetLastError();
+	}
+    }
+
+    if (UTProc == NULL) {
+	/*
+	 * The 16-bit thunking DLL wasn't found.  Return error code that
+	 * indicates this problem.
+	 */
+
+	SetLastError(utErrorCode);
+	return 0;
+    }
+
+    UTProc(args, type, trans);
+    *pidPtr = 0;
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetTclInstance --
+ *
+ *	Retrieves the global library instance handle.
+ *
+ * Results:
+ *	Returns the global library instance handle.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HINSTANCE
+TclWinGetTclInstance()
+{
+    return tclInstance;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetPlatformId --
+ *
+ *	Determines whether running under NT, 95, or Win32s, to allow 
+ *	runtime conditional code.
+ *
+ * Results:
+ *	The return value is one of:
+ *	    VER_PLATFORM_WIN32s		Win32s on Windows 3.1. 
+ *	    VER_PLATFORM_WIN32_WINDOWS	Win32 on Windows 95.
+ *	    VER_PLATFORM_WIN32_NT	Win32 on Windows NT
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int		
+TclWinGetPlatformId()
+{
+    return tclPlatformId;
+}
diff --git a/tcl/win/tclWinChan.c b/tcl/win/tclWinChan.c
new file mode 100644
index 00000000000..c9690a1ea2a
--- /dev/null
+++ b/tcl/win/tclWinChan.c
@@ -0,0 +1,1185 @@
+/* 
+ * tclWinChan.c
+ *
+ *	Channel drivers for Windows channels based on files, command
+ *	pipes and TCP sockets.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+/*
+ * This is the size of the channel name for File based channels
+ */
+
+#define CHANNEL_NAME_SIZE	64
+static char channelName[CHANNEL_NAME_SIZE+1];
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * State flags used in the info structures below.
+ */
+
+#define FILE_PENDING	(1<<0)	/* Message is pending in the queue. */
+#define FILE_ASYNC	(1<<1)	/* Channel is non-blocking. */
+#define FILE_APPEND	(1<<2)	/* File is in append mode. */
+
+/*
+ * The following structure contains per-instance data for a file based channel.
+ */
+
+typedef struct FileInfo {
+    Tcl_Channel channel;	/* Pointer to channel structure. */
+    int validMask;		/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which operations are valid on the file. */
+    int watchMask;		/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which events should be reported. */
+    int flags;			/* State flags, see above for a list. */
+    HANDLE handle;		/* Input/output file. */
+    struct FileInfo *nextPtr;	/* Pointer to next registered file. */
+} FileInfo;
+
+/*
+ * List of all file channels currently open.
+ */
+
+static FileInfo *firstFilePtr;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file events are generated.
+ */
+
+typedef struct FileEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    FileInfo *infoPtr;		/* Pointer to file info structure.  Note
+				 * that we still have to verify that the
+				 * file exists before dereferencing this
+				 * pointer. */
+} FileEvent;
+
+/*
+ * Static routines for this file:
+ */
+
+static int		ComGetOptionProc _ANSI_ARGS_((ClientData instanceData, 
+			    Tcl_Interp *interp, char *optionName,
+			    Tcl_DString *dsPtr));
+static int		ComInputProc _ANSI_ARGS_((ClientData instanceData,
+	            	    char *buf, int toRead, int *errorCode));
+static int		ComSetOptionProc _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp, char *optionName, 
+			    char *value));
+static int		FileBlockProc _ANSI_ARGS_((ClientData instanceData,
+			    int mode));
+static void		FileChannelExitHandler _ANSI_ARGS_((
+		            ClientData clientData));
+static void		FileCheckProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		FileCloseProc _ANSI_ARGS_((ClientData instanceData,
+		            Tcl_Interp *interp));
+static int		FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr, 
+			    int flags));
+static int		FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static void		FileInit _ANSI_ARGS_((void));
+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,
+			    long offset, int mode, int *errorCode));
+static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+
+			    
+/*
+ * This structure describes the channel type structure for file based IO.
+ */
+
+static Tcl_ChannelType fileChannelType = {
+    "file",			/* Type name. */
+    FileBlockProc,		/* Set blocking or non-blocking mode.*/
+    FileCloseProc,		/* Close proc. */
+    FileInputProc,		/* Input proc. */
+    FileOutputProc,		/* Output proc. */
+    FileSeekProc,		/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    FileWatchProc,		/* Set up the notifier to watch the channel. */
+    FileGetHandleProc,		/* Get an OS handle from channel. */
+};
+
+static Tcl_ChannelType comChannelType = {
+    "com",			/* Type name. */
+    FileBlockProc,		/* Set blocking or non-blocking mode.*/
+    FileCloseProc,		/* Close proc. */
+    ComInputProc,		/* Input proc. */
+    FileOutputProc,		/* Output proc. */
+    NULL,			/* Seek proc. */
+    ComSetOptionProc,		/* Set option proc. */
+    ComGetOptionProc,		/* Get option proc. */
+    FileWatchProc,		/* Set up notifier to watch the channel. */
+    FileGetHandleProc		/* Get an OS handle from channel. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInit --
+ *
+ *	This function creates the window used to simulate file events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new window and creates an exit handler. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileInit()
+{
+    initialized = 1;
+    firstFilePtr = NULL;
+    Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+    Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileChannelExitHandler --
+ *
+ *	This function is called to cleanup the channel driver before
+ *	Tcl is unloaded.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Destroys the communication window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileChannelExitHandler(clientData)
+    ClientData clientData;	/* Old window proc */
+{
+    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSetupProc --
+ *
+ *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ *	for an event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FileSetupProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    FileInfo *infoPtr;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Check to see if there is a ready file.  If so, poll.
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->watchMask) {
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCheckProc --
+ *
+ *	This procedure is called by Tcl_DoOneEvent to check the file
+ *	event source for events. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileCheckProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    FileEvent *evPtr;
+    FileInfo *infoPtr;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Queue events for any ready files that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
+	    infoPtr->flags |= FILE_PENDING;
+	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
+	    evPtr->header.proc = FileEventProc;
+	    evPtr->infoPtr = infoPtr;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * FileEventProc --
+ *
+ *	This function is invoked by Tcl_ServiceEvent when a file event
+ *	reaches the front of the event queue.  This procedure invokes
+ *	Tcl_NotifyChannel on the file.
+ *
+ * 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 notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileEventProc(evPtr, flags)
+    Tcl_Event *evPtr;		/* Event to service. */
+    int flags;			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    FileEvent *fileEvPtr = (FileEvent *)evPtr;
+    FileInfo *infoPtr;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Search through the list of watched files for the one whose handle
+     * matches the event.  We do this rather than simply dereferencing
+     * the handle in the event so that files can be deleted while the
+     * event is in the queue.
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (fileEvPtr->infoPtr == infoPtr) {
+	    infoPtr->flags &= ~(FILE_PENDING);
+	    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
+	    break;
+	}
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockProc --
+ *
+ *	Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileBlockProc(instanceData, mode)
+    ClientData instanceData;	/* Instance data for channel. */
+    int mode;			/* TCL_MODE_BLOCKING or
+                                 * TCL_MODE_NONBLOCKING. */
+{
+    FileInfo *infoPtr = (FileInfo *) instanceData;
+    
+    /*
+     * Files on Windows can not be switched between blocking and nonblocking,
+     * hence we have to emulate the behavior. This is done in the input
+     * function by checking against a bit in the state. We set or unset the
+     * bit here to cause the input function to emulate the correct behavior.
+     */
+
+    if (mode == TCL_MODE_NONBLOCKING) {
+	infoPtr->flags |= FILE_ASYNC;
+    } else {
+	infoPtr->flags &= ~(FILE_ASYNC);
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCloseProc --
+ *
+ *	Closes the IO channel.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the physical channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileCloseProc(instanceData, interp)
+    ClientData instanceData;	/* Pointer to FileInfo structure. */
+    Tcl_Interp *interp;		/* Not used. */
+{
+    FileInfo *fileInfoPtr = (FileInfo *) instanceData;
+    FileInfo **nextPtrPtr;
+    int errorCode = 0;
+
+    /*
+     * Remove the file from the watch list.
+     */
+
+    FileWatchProc(instanceData, 0);
+
+    if (CloseHandle(fileInfoPtr->handle) == FALSE) {
+	TclWinConvertError(GetLastError());
+	errorCode = errno;
+    }
+    for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	if ((*nextPtrPtr) == fileInfoPtr) {
+	    (*nextPtrPtr) = fileInfoPtr->nextPtr;
+	    break;
+	}
+    }
+    ckfree((char *)fileInfoPtr);
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeekProc --
+ *
+ *	Seeks on a file-based channel. Returns the new position.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. If failed, it
+ *	also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileSeekProc(instanceData, offset, mode, errorCodePtr)
+    ClientData instanceData;			/* File state. */
+    long offset;				/* Offset to seek to. */
+    int mode;					/* Relative to where
+                                                 * should we seek? */
+    int *errorCodePtr;				/* To store error code. */
+{
+    FileInfo *infoPtr = (FileInfo *) instanceData;
+    DWORD moveMethod;
+    DWORD newPos;
+
+    *errorCodePtr = 0;
+    if (mode == SEEK_SET) {
+        moveMethod = FILE_BEGIN;
+    } else if (mode == SEEK_CUR) {
+        moveMethod = FILE_CURRENT;
+    } else {
+        moveMethod = FILE_END;
+    }
+
+    newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
+    if (newPos == 0xFFFFFFFF) {
+        TclWinConvertError(GetLastError());
+        return -1;
+    }
+    return newPos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInputProc --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileInputProc(instanceData, buf, bufSize, errorCode)
+    ClientData instanceData;		/* File state. */
+    char *buf;				/* Where to store data read. */
+    int bufSize;			/* How much space is available
+                                         * in the buffer? */
+    int *errorCode;			/* Where to store error code. */
+{
+    FileInfo *infoPtr;
+    DWORD bytesRead;
+
+    *errorCode = 0;
+    infoPtr = (FileInfo *) instanceData;
+
+    /*
+     * Note that we will block on reads from a console buffer until a
+     * full line has been entered.  The only way I know of to get
+     * around this is to write a console driver.  We should probably
+     * do this at some point, but for now, we just block.  The same
+     * problem exists for files being read over the network.
+     */
+
+    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+            (LPOVERLAPPED) NULL) != FALSE) {
+	return bytesRead;
+    }
+    
+    TclWinConvertError(GetLastError());
+    *errorCode = errno;
+    if (errno == EPIPE) {
+	return 0;
+    }
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileOutputProc --
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileOutputProc(instanceData, buf, toWrite, errorCode)
+    ClientData instanceData;		/* File state. */
+    char *buf;				/* The data buffer. */
+    int toWrite;			/* How many bytes to write? */
+    int *errorCode;			/* Where to store error code. */
+{
+    FileInfo *infoPtr = (FileInfo *) instanceData;
+    DWORD bytesWritten;
+    
+    *errorCode = 0;
+
+    /*
+     * If we are writing to a file that was opened with O_APPEND, we need to
+     * seek to the end of the file before writing the current buffer.
+     */
+
+    if (infoPtr->flags & FILE_APPEND) {
+        SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
+    }
+
+    if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
+            (LPOVERLAPPED) NULL) == FALSE) {
+        TclWinConvertError(GetLastError());
+        *errorCode = errno;
+        return -1;
+    }
+    FlushFileBuffers(infoPtr->handle);
+    return bytesWritten;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWatchProc --
+ *
+ *	Called by the notifier to set up to watch for events on this
+ *	channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileWatchProc(instanceData, mask)
+    ClientData instanceData;		/* File state. */
+    int mask;				/* What events to watch for; OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+    FileInfo *infoPtr = (FileInfo *) instanceData;
+    Tcl_Time blockTime = { 0, 0 };
+
+    /*
+     * Since the file is always ready for events, we set the block time
+     * to zero so we will poll.
+     */
+
+    infoPtr->watchMask = mask & infoPtr->validMask;
+    if (infoPtr->watchMask) {
+	Tcl_SetMaxBlockTime(&blockTime);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.  */
+{
+    FileInfo *infoPtr = (FileInfo *) instanceData;
+
+    if (direction & infoPtr->validMask) {
+	*handlePtr = (ClientData) infoPtr->handle;
+	return TCL_OK;
+    } else {
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComInputProc --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComInputProc(instanceData, buf, bufSize, errorCode)
+    ClientData instanceData;	/* File state. */
+    char *buf;			/* Where to store data read. */
+    int bufSize;		/* How much space is available 
+				 * in the buffer? */
+    int *errorCode;		/* Where to store error code. */
+{
+    FileInfo *infoPtr;
+    DWORD bytesRead;
+    DWORD dw;
+    COMSTAT cs;
+
+    *errorCode = 0;
+    infoPtr = (FileInfo *) instanceData;
+
+    if (ClearCommError(infoPtr->handle, &dw, &cs)) {
+	if (dw != 0) {
+	    *errorCode = EIO;
+	    return -1;
+	}
+	if (cs.cbInQue != 0) {
+	    if ((DWORD) bufSize > cs.cbInQue) {
+		bufSize = cs.cbInQue;
+	    }
+	} else {
+	    if (infoPtr->flags & FILE_ASYNC) {
+		errno = *errorCode = EAGAIN;
+		return -1;
+	    } else {
+		bufSize = 1;
+	    }
+	}
+    }
+    
+    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+            (LPOVERLAPPED) NULL) == FALSE) {
+	TclWinConvertError(GetLastError());
+	*errorCode = errno;
+	return -1;
+    }
+    
+    return bytesRead;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComSetOptionProc --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int		
+ComSetOptionProc(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. */
+{
+    FileInfo *infoPtr;
+    DCB dcb;
+    int len;
+
+    infoPtr = (FileInfo *) instanceData;
+
+    len = strlen(optionName);
+    if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
+	if (GetCommState(infoPtr->handle, &dcb)) {
+	    if ((BuildCommDCB(value, &dcb) == FALSE) ||
+		    (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
+		/*
+		 * one should separate the 2 errors... 
+		 */
+                if (interp) {
+                    Tcl_AppendResult(interp, "bad value for -mode: should be ",
+			    "baud,parity,data,stop", NULL);
+		}
+		return TCL_ERROR;
+	    } else {
+		return TCL_OK;
+	    }
+	} else {
+	    if (interp) {
+		Tcl_AppendResult(interp, "can't get comm state", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+    } else {
+	return Tcl_BadChannelOption(interp, optionName, "mode");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComGetOptionProc --
+ *
+ *	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:
+ *	A standard Tcl result. Also sets the supplied DString to the
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int		
+ComGetOptionProc(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). */
+{
+    FileInfo *infoPtr;
+    DCB dcb;
+    int len;
+
+    infoPtr = (FileInfo *) instanceData;
+
+    if (optionName == NULL) {
+	Tcl_DStringAppendElement(dsPtr, "-mode");
+	len = 0;
+    } else {
+	len = strlen(optionName);
+    }
+    if ((len == 0) || 
+	    ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+	if (GetCommState(infoPtr->handle, &dcb) == 0) {
+	    /*
+	     * shouldn't we flag an error instead ? 
+	     */
+	    Tcl_DStringAppendElement(dsPtr, "");
+	} else {
+	    char parity;
+	    char *stop;
+	    char buf[32];
+
+	    parity = 'n';
+	    if (dcb.Parity < 4) {
+		parity = "noems"[dcb.Parity];
+	    }
+
+	    stop = (dcb.StopBits == ONESTOPBIT) ? "1" : 
+		    (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
+
+	    wsprintf(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
+		    stop);
+	    Tcl_DStringAppendElement(dsPtr, buf);
+	}
+	return TCL_OK;
+    } else {
+	return Tcl_BadChannelOption(interp, optionName, "mode");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFileChannel --
+ *
+ *	Open an File based channel on Unix systems.
+ *
+ * Results:
+ *	The new channel or NULL. If NULL, the output argument
+ *	errorCodePtr is set to a POSIX error.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the
+ *	file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpOpenFileChannel(interp, fileName, modeString, permissions)
+    Tcl_Interp *interp;			/* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName;			/* Name of file to open. */
+    char *modeString;			/* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions;			/* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    FileInfo *infoPtr;
+    int seekFlag, mode, channelPermissions;
+    DWORD accessMode, createMode, shareMode, flags;
+    char *nativeName;
+    Tcl_DString buffer;
+    DCB dcb;
+    Tcl_ChannelType *channelTypePtr;
+    HANDLE handle;
+
+    if (!initialized) {
+	FileInit();
+    }
+
+    mode = TclGetOpenMode(interp, modeString, &seekFlag);
+    if (mode == -1) {
+        return NULL;
+    }
+
+    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+    if (nativeName == NULL) {
+	return NULL;
+    }
+
+    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+	case O_RDONLY:
+	    accessMode = GENERIC_READ;
+	    channelPermissions = TCL_READABLE;
+	    break;
+	case O_WRONLY:
+	    accessMode = GENERIC_WRITE;
+	    channelPermissions = TCL_WRITABLE;
+	    break;
+	case O_RDWR:
+	    accessMode = (GENERIC_READ | GENERIC_WRITE);
+	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+	    break;
+	default:
+	    panic("TclpOpenFileChannel: invalid mode value");
+	    break;
+    }
+
+    /*
+     * Map the creation flags to the NT create mode.
+     */
+
+    switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
+	case (O_CREAT | O_EXCL):
+	case (O_CREAT | O_EXCL | O_TRUNC):
+	    createMode = CREATE_NEW;
+	    break;
+	case (O_CREAT | O_TRUNC):
+	    createMode = CREATE_ALWAYS;
+	    break;
+	case O_CREAT:
+	    createMode = OPEN_ALWAYS;
+	    break;
+	case O_TRUNC:
+	case (O_TRUNC | O_EXCL):
+	    createMode = TRUNCATE_EXISTING;
+	    break;
+	default:
+	    createMode = OPEN_EXISTING;
+	    break;
+    }
+
+    /*
+     * If the file is being created, get the file attributes from the
+     * permissions argument, else use the existing file attributes.
+     */
+
+    if (mode & O_CREAT) {
+        if (permissions & S_IWRITE) {
+            flags = FILE_ATTRIBUTE_NORMAL;
+        } else {
+            flags = FILE_ATTRIBUTE_READONLY;
+        }
+    } else {
+	flags = GetFileAttributes(nativeName);
+        if (flags == 0xFFFFFFFF) {
+	    flags = 0;
+	}
+    }
+
+    /*
+     * Set up the file sharing mode.  We want to allow simultaneous access.
+     */
+
+    shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
+
+    /*
+     * Now we get to create the file.
+     */
+
+    handle = CreateFile(nativeName, accessMode, shareMode, NULL, createMode,
+            flags, (HANDLE) NULL);
+
+    if (handle == INVALID_HANDLE_VALUE) {
+	DWORD err;
+
+	openerr:
+	err = GetLastError();
+	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
+	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
+	}
+        TclWinConvertError(err);
+	if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+                    Tcl_PosixError(interp), (char *) NULL);
+        }
+        Tcl_DStringFree(&buffer);
+        return NULL;
+    }
+
+    if (GetFileType(handle) == FILE_TYPE_CHAR) {
+	dcb.DCBlength = sizeof( DCB ) ;
+	if (GetCommState(handle, &dcb)) {
+	    /*
+	     * This is a com port.  Reopen it with the correct modes. 
+	     */
+
+	    COMMTIMEOUTS cto;
+
+	    CloseHandle(handle);
+	    handle = CreateFile(nativeName, accessMode, 0, NULL, OPEN_EXISTING,
+		    flags, NULL);
+	    if (handle == INVALID_HANDLE_VALUE) {
+		goto openerr;
+	    }
+
+	    /*
+	     * FileInit the com port.
+	     */
+
+	    SetCommMask(handle, EV_RXCHAR);
+	    SetupComm(handle, 4096, 4096);
+	    PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
+		    | PURGE_RXCLEAR);
+	    cto.ReadIntervalTimeout = MAXDWORD;
+	    cto.ReadTotalTimeoutMultiplier = 0;
+	    cto.ReadTotalTimeoutConstant = 0;
+	    cto.WriteTotalTimeoutMultiplier = 0;
+	    cto.WriteTotalTimeoutConstant = 0;
+	    SetCommTimeouts(handle, &cto);
+
+	    GetCommState(handle, &dcb);
+	    SetCommState(handle, &dcb);
+	    channelTypePtr = &comChannelType;
+	} else {
+	    channelTypePtr = &fileChannelType;
+	}
+    } else {
+	channelTypePtr = &fileChannelType;
+    }
+    Tcl_DStringFree(&buffer);
+
+    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+    infoPtr->nextPtr = firstFilePtr;
+    firstFilePtr = infoPtr;
+    infoPtr->validMask = channelPermissions;
+    infoPtr->watchMask = 0;
+    infoPtr->flags = (mode & O_APPEND) ? FILE_APPEND : 0;
+    infoPtr->handle = handle;
+   
+    sprintf(channelName, "file%d", (int) handle);
+
+    infoPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+            (ClientData) infoPtr, channelPermissions);
+
+    if (seekFlag) {
+        if (Tcl_Seek(infoPtr->channel, 0, SEEK_END) < 0) {
+            if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "could not seek to end of file on \"",
+                        channelName, "\": ", Tcl_PosixError(interp),
+                        (char *) NULL);
+            }
+            Tcl_Close(NULL, infoPtr->channel);
+            return NULL;
+        }
+    }
+
+    /*
+     * Files have default translation of AUTO and ^Z eof char, which
+     * means that a ^Z will be appended to them at close.
+     */
+    
+    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+    return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeFileChannel --
+ *
+ *	Creates a Tcl_Channel from an existing platform specific file
+ *	handle.
+ *
+ * Results:
+ *	The Tcl_Channel created around the preexisting file.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeFileChannel(handle, mode)
+    ClientData handle;		/* OS level handle */
+    int mode;			/* ORed combination of TCL_READABLE and
+                                 * TCL_WRITABLE to indicate file mode. */
+{
+    char channelName[20];
+    FileInfo *infoPtr;
+
+    if (!initialized) {
+	FileInit();
+    }
+
+    if (mode == 0) {
+	return NULL;
+    }
+
+    sprintf(channelName, "file%d", (int) handle);
+
+    /*
+     * See if a channel with this handle already exists.
+     */
+    
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->handle == (HANDLE) handle) {
+	    return (mode == infoPtr->validMask) ? infoPtr->channel : NULL;
+	}
+    }
+
+    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+    infoPtr->nextPtr = firstFilePtr;
+    firstFilePtr = infoPtr;
+    infoPtr->validMask = mode;
+    infoPtr->watchMask = 0;
+    infoPtr->flags = 0;
+    infoPtr->handle = (HANDLE) handle;
+    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
+            (ClientData) infoPtr, mode);
+
+    /*
+     * Windows files have AUTO translation mode and ^Z eof char on input.
+     */
+    
+    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+    return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetDefaultStdChannel --
+ *
+ *	Constructs a channel for the specified standard OS handle.
+ *
+ * Results:
+ *	Returns the specified default standard channel, or NULL.
+ *
+ * Side effects:
+ *	May cause the creation of a standard channel and the underlying
+ *	file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclGetDefaultStdChannel(type)
+    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    Tcl_Channel channel;
+    HANDLE handle;
+    int mode;
+    char *bufMode;
+    DWORD handleId;		/* Standard handle to retrieve. */
+
+    switch (type) {
+	case TCL_STDIN:
+	    handleId = STD_INPUT_HANDLE;
+	    mode = TCL_READABLE;
+	    bufMode = "line";
+	    break;
+	case TCL_STDOUT:
+	    handleId = STD_OUTPUT_HANDLE;
+	    mode = TCL_WRITABLE;
+	    bufMode = "line";
+	    break;
+	case TCL_STDERR:
+	    handleId = STD_ERROR_HANDLE;
+	    mode = TCL_WRITABLE;
+	    bufMode = "none";
+	    break;
+	default:
+	    panic("TclGetDefaultStdChannel: Unexpected channel type");
+	    break;
+    }
+    handle = GetStdHandle(handleId);
+
+    /*
+     * Note that we need to check for 0 because Windows will return 0 if this
+     * is not a console mode application, even though this is not a valid
+     * handle. 
+     */
+
+    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
+	return NULL;
+    }
+
+    channel = Tcl_MakeFileChannel(handle, mode);
+
+    /*
+     * Set up the normal channel options for stdio handles.
+     */
+
+    if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
+            "auto") == TCL_ERROR)
+	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
+		    "\032 {}") == TCL_ERROR)
+	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
+		    "-buffering", bufMode) == TCL_ERROR)) {
+        Tcl_Close((Tcl_Interp *) NULL, channel);
+        return (Tcl_Channel) NULL;
+    }
+    return channel;
+}
diff --git a/tcl/win/tclWinError.c b/tcl/win/tclWinError.c
new file mode 100644
index 00000000000..940343381b4
--- /dev/null
+++ b/tcl/win/tclWinError.c
@@ -0,0 +1,393 @@
+/* 
+ * tclWinError.c --
+ *
+ *	This file contains code for converting from Win32 errors to
+ *	errno errors.
+ *
+ * Copyright (c) 1995-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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following table contains the mapping from Win32 errors to
+ * errno errors.
+ */
+
+static char errorTable[] = {
+    0,
+    EINVAL,	/* ERROR_INVALID_FUNCTION	1 */
+    ENOENT,	/* ERROR_FILE_NOT_FOUND		2 */
+    ENOENT,	/* ERROR_PATH_NOT_FOUND		3 */
+    EMFILE,	/* ERROR_TOO_MANY_OPEN_FILES	4 */
+    EACCES,	/* ERROR_ACCESS_DENIED		5 */
+    EBADF,	/* ERROR_INVALID_HANDLE		6 */
+    ENOMEM,	/* ERROR_ARENA_TRASHED		7 */
+    ENOMEM,	/* ERROR_NOT_ENOUGH_MEMORY	8 */
+    ENOMEM,	/* ERROR_INVALID_BLOCK		9 */
+    E2BIG,	/* ERROR_BAD_ENVIRONMENT	10 */
+    ENOEXEC,	/* ERROR_BAD_FORMAT		11 */
+    EACCES,	/* ERROR_INVALID_ACCESS		12 */
+    EINVAL,	/* ERROR_INVALID_DATA		13 */
+    EFAULT,	/* ERROR_OUT_OF_MEMORY		14 */
+    ENOENT,	/* ERROR_INVALID_DRIVE		15 */
+    EACCES,	/* ERROR_CURRENT_DIRECTORY	16 */
+    EXDEV,	/* ERROR_NOT_SAME_DEVICE	17 */
+    ENOENT,	/* ERROR_NO_MORE_FILES		18 */
+    EROFS,	/* ERROR_WRITE_PROTECT		19 */
+    ENXIO,	/* ERROR_BAD_UNIT		20 */
+    EBUSY,	/* ERROR_NOT_READY		21 */
+    EIO,	/* ERROR_BAD_COMMAND		22 */
+    EIO,	/* ERROR_CRC			23 */
+    EIO,	/* ERROR_BAD_LENGTH		24 */
+    EIO,	/* ERROR_SEEK			25 */
+    EIO,	/* ERROR_NOT_DOS_DISK		26 */
+    ENXIO,	/* ERROR_SECTOR_NOT_FOUND	27 */
+    EBUSY,	/* ERROR_OUT_OF_PAPER		28 */
+    EIO,	/* ERROR_WRITE_FAULT		29 */
+    EIO,	/* ERROR_READ_FAULT		30 */
+    EIO,	/* ERROR_GEN_FAILURE		31 */
+    EACCES,	/* ERROR_SHARING_VIOLATION	32 */
+    EACCES,	/* ERROR_LOCK_VIOLATION		33 */
+    ENXIO,	/* ERROR_WRONG_DISK		34 */
+    ENFILE,	/* ERROR_FCB_UNAVAILABLE	35 */
+    ENFILE,	/* ERROR_SHARING_BUFFER_EXCEEDED	36 */
+    EINVAL,	/* 37 */
+    EINVAL,	/* 38 */
+    ENOSPC,	/* ERROR_HANDLE_DISK_FULL	39 */
+    EINVAL,	/* 40 */
+    EINVAL,	/* 41 */
+    EINVAL,	/* 42 */
+    EINVAL,	/* 43 */
+    EINVAL,	/* 44 */
+    EINVAL,	/* 45 */
+    EINVAL,	/* 46 */
+    EINVAL,	/* 47 */
+    EINVAL,	/* 48 */
+    EINVAL,	/* 49 */
+    ENODEV,	/* ERROR_NOT_SUPPORTED		50 */
+    EBUSY,	/* ERROR_REM_NOT_LIST		51 */
+    EEXIST,	/* ERROR_DUP_NAME		52 */
+    ENOENT,	/* ERROR_BAD_NETPATH		53 */
+    EBUSY,	/* ERROR_NETWORK_BUSY		54 */
+    ENODEV,	/* ERROR_DEV_NOT_EXIST		55 */
+    EAGAIN,	/* ERROR_TOO_MANY_CMDS		56 */
+    EIO,	/* ERROR_ADAP_HDW_ERR		57 */
+    EIO,	/* ERROR_BAD_NET_RESP		58 */
+    EIO,	/* ERROR_UNEXP_NET_ERR		59 */
+    EINVAL,	/* ERROR_BAD_REM_ADAP		60 */
+    EFBIG,	/* ERROR_PRINTQ_FULL		61 */
+    ENOSPC,	/* ERROR_NO_SPOOL_SPACE		62 */
+    ENOENT,	/* ERROR_PRINT_CANCELLED	63 */
+    ENOENT,	/* ERROR_NETNAME_DELETED	64 */
+    EACCES,	/* ERROR_NETWORK_ACCESS_DENIED	65 */
+    ENODEV,	/* ERROR_BAD_DEV_TYPE		66 */
+    ENOENT,	/* ERROR_BAD_NET_NAME		67 */
+    ENFILE,	/* ERROR_TOO_MANY_NAMES		68 */
+    EIO,	/* ERROR_TOO_MANY_SESS		69 */
+    EAGAIN,	/* ERROR_SHARING_PAUSED		70 */
+    EINVAL,	/* ERROR_REQ_NOT_ACCEP		71 */
+    EAGAIN,	/* ERROR_REDIR_PAUSED		72 */
+    EINVAL,	/* 73 */
+    EINVAL,	/* 74 */
+    EINVAL,	/* 75 */
+    EINVAL,	/* 76 */
+    EINVAL,	/* 77 */
+    EINVAL,	/* 78 */
+    EINVAL,	/* 79 */
+    EEXIST,	/* ERROR_FILE_EXISTS		80 */
+    EINVAL,	/* 81 */
+    ENOSPC,	/* ERROR_CANNOT_MAKE		82 */
+    EIO,	/* ERROR_FAIL_I24		83 */
+    ENFILE,	/* ERROR_OUT_OF_STRUCTURES	84 */
+    EEXIST,	/* ERROR_ALREADY_ASSIGNED	85 */
+    EPERM,	/* ERROR_INVALID_PASSWORD	86 */
+    EINVAL,	/* ERROR_INVALID_PARAMETER	87 */
+    EIO,	/* ERROR_NET_WRITE_FAULT	88 */
+    EAGAIN,	/* ERROR_NO_PROC_SLOTS		89 */
+    EINVAL,	/* 90 */
+    EINVAL,	/* 91 */
+    EINVAL,	/* 92 */
+    EINVAL,	/* 93 */
+    EINVAL,	/* 94 */
+    EINVAL,	/* 95 */
+    EINVAL,	/* 96 */
+    EINVAL,	/* 97 */
+    EINVAL,	/* 98 */
+    EINVAL,	/* 99 */
+    EINVAL,	/* 100 */
+    EINVAL,	/* 101 */
+    EINVAL,	/* 102 */
+    EINVAL,	/* 103 */
+    EINVAL,	/* 104 */
+    EINVAL,	/* 105 */
+    EINVAL,	/* 106 */
+    EXDEV,	/* ERROR_DISK_CHANGE		107 */
+    EAGAIN,	/* ERROR_DRIVE_LOCKED		108 */
+    EPIPE,	/* ERROR_BROKEN_PIPE		109 */
+    ENOENT,	/* ERROR_OPEN_FAILED		110 */
+    EINVAL,	/* ERROR_BUFFER_OVERFLOW	111 */
+    ENOSPC,	/* ERROR_DISK_FULL		112 */
+    EMFILE,	/* ERROR_NO_MORE_SEARCH_HANDLES	113 */
+    EBADF,	/* ERROR_INVALID_TARGET_HANDLE	114 */
+    EFAULT,	/* ERROR_PROTECTION_VIOLATION	115 */
+    EINVAL,	/* 116 */
+    EINVAL,	/* 117 */
+    EINVAL,	/* 118 */
+    EINVAL,	/* 119 */
+    EINVAL,	/* 120 */
+    EINVAL,	/* 121 */
+    EINVAL,	/* 122 */
+    ENOENT,	/* ERROR_INVALID_NAME		123 */
+    EINVAL,	/* 124 */
+    EINVAL,	/* 125 */
+    EINVAL,	/* 126 */
+    ESRCH,	/* ERROR_PROC_NOT_FOUND		127 */
+    ECHILD,	/* ERROR_WAIT_NO_CHILDREN	128 */
+    ECHILD,	/* ERROR_CHILD_NOT_COMPLETE	129 */
+    EBADF,	/* ERROR_DIRECT_ACCESS_HANDLE	130 */
+    EINVAL,	/* 131 */
+    ESPIPE,	/* ERROR_SEEK_ON_DEVICE		132 */
+    EINVAL,	/* 133 */
+    EINVAL,	/* 134 */
+    EINVAL,	/* 135 */
+    EINVAL,	/* 136 */
+    EINVAL,	/* 137 */
+    EINVAL,	/* 138 */
+    EINVAL,	/* 139 */
+    EINVAL,	/* 140 */
+    EINVAL,	/* 141 */
+    EAGAIN,	/* ERROR_BUSY_DRIVE		142 */
+    EINVAL,	/* 143 */
+    EINVAL,	/* 144 */
+    EEXIST,	/* ERROR_DIR_NOT_EMPTY		145 */
+    EINVAL,	/* 146 */
+    EINVAL,	/* 147 */
+    EINVAL,	/* 148 */
+    EINVAL,	/* 149 */
+    EINVAL,	/* 150 */
+    EINVAL,	/* 151 */
+    EINVAL,	/* 152 */
+    EINVAL,	/* 153 */
+    EINVAL,	/* 154 */
+    EINVAL,	/* 155 */
+    EINVAL,	/* 156 */
+    EINVAL,	/* 157 */
+    EACCES,	/* ERROR_NOT_LOCKED		158 */
+    EINVAL,	/* 159 */
+    EINVAL,	/* 160 */
+    ENOENT,	/* ERROR_BAD_PATHNAME	        161 */
+    EINVAL,	/* 162 */
+    EINVAL,	/* 163 */
+    EINVAL,	/* 164 */
+    EINVAL,	/* 165 */
+    EINVAL,	/* 166 */
+    EACCES,	/* ERROR_LOCK_FAILED		167 */
+    EINVAL,	/* 168 */
+    EINVAL,	/* 169 */
+    EINVAL,	/* 170 */
+    EINVAL,	/* 171 */
+    EINVAL,	/* 172 */
+    EINVAL,	/* 173 */
+    EINVAL,	/* 174 */
+    EINVAL,	/* 175 */
+    EINVAL,	/* 176 */
+    EINVAL,	/* 177 */
+    EINVAL,	/* 178 */
+    EINVAL,	/* 179 */
+    EINVAL,	/* 180 */
+    EINVAL,	/* 181 */
+    EINVAL,	/* 182 */
+    EEXIST,	/* ERROR_ALREADY_EXISTS		183 */
+    ECHILD,	/* ERROR_NO_CHILD_PROCESS	184 */
+    EINVAL,	/* 185 */
+    EINVAL,	/* 186 */
+    EINVAL,	/* 187 */
+    EINVAL,	/* 188 */
+    EINVAL,	/* 189 */
+    EINVAL,	/* 190 */
+    EINVAL,	/* 191 */
+    EINVAL,	/* 192 */
+    EINVAL,	/* 193 */
+    EINVAL,	/* 194 */
+    EINVAL,	/* 195 */
+    EINVAL,	/* 196 */
+    EINVAL,	/* 197 */
+    EINVAL,	/* 198 */
+    EINVAL,	/* 199 */
+    EINVAL,	/* 200 */
+    EINVAL,	/* 201 */
+    EINVAL,	/* 202 */
+    EINVAL,	/* 203 */
+    EINVAL,	/* 204 */
+    EINVAL,	/* 205 */
+    ENAMETOOLONG,/* ERROR_FILENAME_EXCED_RANGE	206 */
+    EINVAL,	/* 207 */
+    EINVAL,	/* 208 */
+    EINVAL,	/* 209 */
+    EINVAL,	/* 210 */
+    EINVAL,	/* 211 */
+    EINVAL,	/* 212 */
+    EINVAL,	/* 213 */
+    EINVAL,	/* 214 */
+    EINVAL,	/* 215 */
+    EINVAL,	/* 216 */
+    EINVAL,	/* 217 */
+    EINVAL,	/* 218 */
+    EINVAL,	/* 219 */
+    EINVAL,	/* 220 */
+    EINVAL,	/* 221 */
+    EINVAL,	/* 222 */
+    EINVAL,	/* 223 */
+    EINVAL,	/* 224 */
+    EINVAL,	/* 225 */
+    EINVAL,	/* 226 */
+    EINVAL,	/* 227 */
+    EINVAL,	/* 228 */
+    EINVAL,	/* 229 */
+    EPIPE,	/* ERROR_BAD_PIPE		230 */
+    EAGAIN,	/* ERROR_PIPE_BUSY		231 */
+    EPIPE,	/* ERROR_NO_DATA		232 */
+    EPIPE,	/* ERROR_PIPE_NOT_CONNECTED	233 */
+    EINVAL,	/* 234 */
+    EINVAL,	/* 235 */
+    EINVAL,	/* 236 */
+    EINVAL,	/* 237 */
+    EINVAL,	/* 238 */
+    EINVAL,	/* 239 */
+    EINVAL,	/* 240 */
+    EINVAL,	/* 241 */
+    EINVAL,	/* 242 */
+    EINVAL,	/* 243 */
+    EINVAL,	/* 244 */
+    EINVAL,	/* 245 */
+    EINVAL,	/* 246 */
+    EINVAL,	/* 247 */
+    EINVAL,	/* 248 */
+    EINVAL,	/* 249 */
+    EINVAL,	/* 250 */
+    EINVAL,	/* 251 */
+    EINVAL,	/* 252 */
+    EINVAL,	/* 253 */
+    EINVAL,	/* 254 */
+    EINVAL,	/* 255 */
+    EINVAL,	/* 256 */
+    EINVAL,	/* 257 */
+    EINVAL,	/* 258 */
+    EINVAL,	/* 259 */
+    EINVAL,	/* 260 */
+    EINVAL,	/* 261 */
+    EINVAL,	/* 262 */
+    EINVAL,	/* 263 */
+    EINVAL,	/* 264 */
+    EINVAL,	/* 265 */
+    EINVAL,	/* 266 */
+    ENOTDIR,	/* ERROR_DIRECTORY		267 */
+};
+
+static const unsigned int tableLen = sizeof(errorTable);
+
+/*
+ * The following table contains the mapping from WinSock errors to
+ * errno errors.
+ */
+
+static int wsaErrorTable[] = {
+    EWOULDBLOCK,	/* WSAEWOULDBLOCK */
+    EINPROGRESS,	/* WSAEINPROGRESS */
+    EALREADY,		/* WSAEALREADY */
+    ENOTSOCK,		/* WSAENOTSOCK */
+    EDESTADDRREQ,	/* WSAEDESTADDRREQ */
+    EMSGSIZE,		/* WSAEMSGSIZE */
+    EPROTOTYPE,		/* WSAEPROTOTYPE */
+    ENOPROTOOPT,	/* WSAENOPROTOOPT */
+    EPROTONOSUPPORT,	/* WSAEPROTONOSUPPORT */
+    ESOCKTNOSUPPORT,	/* WSAESOCKTNOSUPPORT */
+    EOPNOTSUPP,		/* WSAEOPNOTSUPP */
+    EPFNOSUPPORT,	/* WSAEPFNOSUPPORT */
+    EAFNOSUPPORT,	/* WSAEAFNOSUPPORT */
+    EADDRINUSE,		/* WSAEADDRINUSE */
+    EADDRNOTAVAIL,	/* WSAEADDRNOTAVAIL */
+    ENETDOWN,		/* WSAENETDOWN */
+    ENETUNREACH,	/* WSAENETUNREACH */
+    ENETRESET,		/* WSAENETRESET */
+    ECONNABORTED,	/* WSAECONNABORTED */
+    ECONNRESET,		/* WSAECONNRESET */
+    ENOBUFS,		/* WSAENOBUFS */
+    EISCONN,		/* WSAEISCONN */
+    ENOTCONN,		/* WSAENOTCONN */
+    ESHUTDOWN,		/* WSAESHUTDOWN */
+    ETOOMANYREFS,	/* WSAETOOMANYREFS */
+    ETIMEDOUT,		/* WSAETIMEDOUT */
+    ECONNREFUSED,	/* WSAECONNREFUSED */
+    ELOOP,		/* WSAELOOP */
+    ENAMETOOLONG,	/* WSAENAMETOOLONG */
+    EHOSTDOWN,		/* WSAEHOSTDOWN */
+    EHOSTUNREACH,	/* WSAEHOSTUNREACH */
+    ENOTEMPTY,		/* WSAENOTEMPTY */
+    EAGAIN,		/* WSAEPROCLIM */
+    EUSERS,		/* WSAEUSERS */
+    EDQUOT,		/* WSAEDQUOT */
+    ESTALE,		/* WSAESTALE */
+    EREMOTE,		/* WSAEREMOTE */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinConvertError --
+ *
+ *	This routine converts a Win32 error into an errno value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the errno global variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinConvertError(errCode)
+    DWORD errCode;		/* Win32 error code. */
+{
+    if (errCode >= tableLen) {
+	Tcl_SetErrno(EINVAL);
+    } else {
+	Tcl_SetErrno(errorTable[errCode]);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinConvertWSAError --
+ *
+ *	This routine converts a WinSock error into an errno value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets the errno global variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinConvertWSAError(errCode)
+    DWORD errCode;		/* Win32 error code. */
+{
+    if ((errCode >= WSAEWOULDBLOCK) && (errCode <= WSAEREMOTE)) {
+	Tcl_SetErrno(wsaErrorTable[errCode - WSAEWOULDBLOCK]);
+    } else {
+	Tcl_SetErrno(EINVAL);
+    }
+}
diff --git a/tcl/win/tclWinFCmd.c b/tcl/win/tclWinFCmd.c
new file mode 100644
index 00000000000..eb017e5842d
--- /dev/null
+++ b/tcl/win/tclWinFCmd.c
@@ -0,0 +1,1415 @@
+/*
+ * tclWinFCmd.c
+ *
+ *      This file implements the Windows specific 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+/*
+ * The following constants specify the type of callback when
+ * TraverseWinTree() 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		GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+static int		CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+
+/*
+ * Constants and variables necessary for file attributes subcommand.
+ */
+
+enum {
+    WIN_ARCHIVE_ATTRIBUTE,
+    WIN_HIDDEN_ATTRIBUTE,
+    WIN_LONGNAME_ATTRIBUTE,
+    WIN_READONLY_ATTRIBUTE,
+    WIN_SHORTNAME_ATTRIBUTE,
+    WIN_SYSTEM_ATTRIBUTE
+};
+
+static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
+	0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
+
+
+char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
+	"-shortname", "-system", (char *) NULL};
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+	{GetWinFileAttributes, SetWinFileAttributes},
+	{GetWinFileAttributes, SetWinFileAttributes},
+	{GetWinFileLongName, CannotSetAttribute},
+	{GetWinFileAttributes, SetWinFileAttributes},
+	{GetWinFileShortName, CannotSetAttribute},
+	{GetWinFileAttributes, SetWinFileAttributes}};
+
+/*
+ * Prototype for the TraverseWinTree callback function.
+ */
+
+typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type, 
+	Tcl_DString *errorPtr);
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static void		AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName, int getOrSet));
+static int		ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName, int longShort,
+			    Tcl_Obj **attributePtrPtr));
+static int		TraversalCopy(char *src, char *dst, DWORD attr, 
+				int type, Tcl_DString *errorPtr);
+static int		TraversalDelete(char *src, char *dst, DWORD attr,
+				int type, Tcl_DString *errorPtr);
+static int		TraverseWinTree(TraversalProc *traverseProc,
+			    Tcl_DString *sourcePtr, Tcl_DString *destPtr,
+			    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.  src or dst is "".
+ *	ENOTDIR:    src is a directory, but dst is not.  
+ *	EXDEV:	    src and dst are on different filesystems.
+ *
+ *	EACCES:     exists an open file already referring to src or dst.
+ *	EACCES:     src or dst specify the current working directory (NT).
+ *	EACCES:	    src specifies a char device (nul:, com1:, etc.) 
+ *	EEXIST:	    dst specifies a char device (nul:, com1:, etc.) (NT)
+ *	EACCES:	    dst specifies a char device (nul:, com1:, etc.) (95)
+ *	
+ * Side effects:
+ *	The implementation supports cross-filesystem renames of files,
+ *	but the caller should be prepared to emulate cross-filesystem
+ *	renames of directories if errno is EXDEV.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpRenameFile(
+    char *src,			/* Pathname of file or dir to be renamed. */ 
+    char *dst)			/* New pathname for file or directory. */
+{
+    DWORD srcAttr, dstAttr;
+    
+    /*
+     * Would throw an exception under NT if one of the arguments is a 
+     * char block device.
+     */
+
+    /* CYGNUS LOCAL */
+#ifndef __GNUC__
+    try {
+#endif
+    /* END CYGNUS LOCAL */
+	if (MoveFile(src, dst) != FALSE) {
+	    return TCL_OK;
+	}
+    /* CYGNUS LOCAL */
+#ifndef __GNUC__
+    } except (-1) {}
+#endif
+    /* END CYGNUS LOCAL */
+
+    TclWinConvertError(GetLastError());
+
+    srcAttr = GetFileAttributes(src);
+    dstAttr = GetFileAttributes(dst);
+    if (srcAttr == (DWORD) -1) {
+	srcAttr = 0;
+    }
+    if (dstAttr == (DWORD) -1) {
+	dstAttr = 0;
+    }
+
+    if (errno == EBADF) {
+	errno = EACCES;
+	return TCL_ERROR;
+    }
+    if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) {
+	if ((srcAttr != 0) && (dstAttr != 0)) {
+	    /*
+	     * Win32s reports trying to overwrite an existing file or directory
+	     * as EACCES.
+	     */
+
+	    errno = EEXIST;
+	}
+    }
+    if (errno == EACCES) {
+	decode:
+	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
+	    char srcPath[MAX_PATH], dstPath[MAX_PATH];
+	    int srcArgc, dstArgc;
+	    char **srcArgv, **dstArgv;
+	    char *srcRest, *dstRest;
+	    int size;
+
+	    size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest);
+	    if ((size == 0) || (size > sizeof(srcPath))) {
+		return TCL_ERROR;
+	    }
+	    size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest);
+	    if ((size == 0) || (size > sizeof(dstPath))) {
+		return TCL_ERROR;
+	    }
+	    if (srcRest == NULL) {
+		srcRest = srcPath + strlen(srcPath);
+	    }
+	    if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
+		/*
+		 * Trying to move a directory into itself.
+		 */
+
+		errno = EINVAL;
+		return TCL_ERROR;
+	    }
+	    Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
+	    Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
+	    if (srcArgc == 1) {
+		/*
+		 * They are trying to move a root directory.  Whether
+		 * or not it is across filesystems, this cannot be
+		 * done.
+		 */
+
+		errno = EINVAL;
+	    } else if ((srcArgc > 0) && (dstArgc > 0) &&
+		    (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
+		/*
+		 * If src is a directory and dst filesystem != src
+		 * filesystem, errno should be EXDEV.  It is very
+		 * important to get this behavior, so that the caller
+		 * can respond to a cross filesystem rename by
+		 * simulating it with copy and delete.  The MoveFile
+		 * system call already handles the case of moving a
+		 * file between filesystems.
+		 */
+
+		errno = EXDEV;
+	    }
+
+	    ckfree((char *) srcArgv);
+	    ckfree((char *) dstArgv);
+	}
+
+	/*
+	 * Other types of access failure is that dst is a read-only
+	 * filesystem, that an open file referred to src or dest, or that
+	 * src or dest specified the current working directory on the
+	 * current filesystem.  EACCES is returned for those cases.
+	 */
+
+    } else if (errno == EEXIST) {
+	/*
+	 * Reports EEXIST any time the target already exists.  If it makes
+	 * sense, remove the old file and try renaming again.
+	 */
+
+	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
+	    if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
+		/*
+		 * Overwrite empty dst directory with src directory.  The
+		 * following call will remove an empty directory.  If it
+		 * fails, it's because it wasn't empty.
+		 */
+
+		if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
+		    /*
+		     * Now that that empty directory is gone, we can try
+		     * renaming again.  If that fails, we'll put this empty
+		     * directory back, for completeness.
+		     */
+
+		    if (MoveFile(src, dst) != FALSE) {
+			return TCL_OK;
+		    }
+
+		    /*
+		     * Some new error has occurred.  Don't know what it
+		     * could be, but report this one.
+		     */
+
+		    TclWinConvertError(GetLastError());
+		    CreateDirectory(dst, NULL);
+		    SetFileAttributes(dst, dstAttr);
+		    if (errno == EACCES) {
+			/*
+			 * Decode the EACCES to a more meaningful error.
+			 */
+
+			goto decode;
+		    }
+		}
+	    } else {	/* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
+		errno = ENOTDIR;
+	    }
+	} else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
+	    if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
+		errno = EISDIR;
+	    } else {
+		/*
+		 * Overwrite existing file by:
+		 * 
+		 * 1. Rename existing file to temp name.
+		 * 2. Rename old file to new name.
+		 * 3. If success, delete temp file.  If failure,
+		 *    put temp file back to old name.
+		 */
+
+		char tempName[MAX_PATH];
+		int result, size;
+		char *rest;
+		
+		size = GetFullPathName(dst, sizeof(tempName), tempName, &rest);
+		if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) {
+		    return TCL_ERROR;
+		}
+		*rest = '\0';
+		result = TCL_ERROR;
+		if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) {
+		    /*
+		     * Strictly speaking, need the following DeleteFile and
+		     * MoveFile to be joined as an atomic operation so no
+		     * other app comes along in the meantime and creates the
+		     * same temp file.
+		     */
+		     
+		    DeleteFile(tempName);
+		    if (MoveFile(dst, tempName) != FALSE) {
+			if (MoveFile(src, dst) != FALSE) {
+			    SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL);
+			    DeleteFile(tempName);
+			    return TCL_OK;
+			} else {
+			    DeleteFile(dst);
+			    MoveFile(tempName, dst);
+			}
+		    } 
+
+		    /*
+		     * Can't backup dst file or move src file.  Return that
+		     * error.  Could happen if an open file refers to dst.
+		     */
+
+		    TclWinConvertError(GetLastError());
+		    if (errno == EACCES) {
+			/*
+			 * Decode the EACCES to a more meaningful error.
+			 */
+
+			goto decode;
+		    }
+		}
+		return result;
+	    }
+	}
+    }
+    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 "".
+ *
+ *	EACCES:     exists an open file already referring to dst (95).
+ *	EACCES:	    src specifies a char device (nul:, com1:, etc.) (NT)
+ *	ENOENT:	    src specifies a char device (nul:, com1:, etc.) (95)
+ *
+ * Side effects:
+ *	It is not an error to copy to a char device.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int 
+TclpCopyFile(
+    char *src,			/* Pathname of file to be copied. */
+    char *dst)			/* Pathname of file to copy to. */
+{
+    /*
+     * Would throw an exception under NT if one of the arguments is a char
+     * block device.
+     */
+
+    /* CYGNUS LOCAL */
+#ifndef __GNUC__
+    try {
+#endif /* __GNUC__ */
+      if (CopyFile(src, dst, 0) != FALSE) {
+	    return TCL_OK;
+	}
+    /* CYGNUS LOCAL */
+#ifndef __GNUC__
+    } except (-1) {}
+#endif /* __GNUC__ */
+
+    TclWinConvertError(GetLastError());
+    if (errno == EBADF) {
+	errno = EACCES;
+	return TCL_ERROR;
+    }
+    if (errno == EACCES) {
+	DWORD srcAttr, dstAttr;
+
+	srcAttr = GetFileAttributes(src);
+	dstAttr = GetFileAttributes(dst);
+	if (srcAttr != (DWORD) -1) {
+	    if (dstAttr == (DWORD) -1) {
+		dstAttr = 0;
+	    }
+	    if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
+		    (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
+		errno = EISDIR;
+	    }
+	    if (dstAttr & FILE_ATTRIBUTE_READONLY) {
+		SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY);
+		if (CopyFile(src, dst, 0) != FALSE) {
+		    return TCL_OK;
+		}
+		/*
+		 * Still can't copy onto dst.  Return that error, and
+		 * restore attributes of dst.
+		 */
+
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(dst, dstAttr);
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 "".
+ *
+ *	EACCES:     exists an open file already referring to path.
+ *	EACCES:	    path is a char device (nul:, com1:, etc.)
+ *
+ * Side effects:
+ *      The file is deleted, even if it is read-only.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpDeleteFile(
+    char *path)			/* Pathname of file to be removed. */
+{
+    DWORD attr;
+
+    if (DeleteFile(path) != FALSE) {
+	return TCL_OK;
+    }
+    TclWinConvertError(GetLastError());
+    if (path[0] == '\0') {
+	/*
+	 * Win32s thinks that "" is the same as "." and then reports EISDIR
+	 * instead of ENOENT.
+	 */
+
+	errno = ENOENT;
+    } else if (errno == EACCES) {
+        attr = GetFileAttributes(path);
+	if (attr != (DWORD) -1) {
+	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+		/*
+		 * Windows NT reports removing a directory as EACCES instead
+		 * of EISDIR.
+		 */
+
+		errno = EISDIR;
+	    } else if (attr & FILE_ATTRIBUTE_READONLY) {
+		SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY);
+		if (DeleteFile(path) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(path, attr);
+	    }
+	}
+    } else if (errno == ENOENT) {
+        attr = GetFileAttributes(path);
+	if (attr != (DWORD) -1) {
+	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+	    	/*
+		 * Windows 95 reports removing a directory as ENOENT instead 
+		 * of EISDIR. 
+		 */
+
+		errno = EISDIR;
+	    }
+	}
+    } else if (errno == EINVAL) {
+	/*
+	 * Windows NT reports removing a char device as EINVAL instead of
+	 * EACCES.
+	 */
+
+	errno = EACCES;
+    }
+
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpCreateDirectory(
+    char *path)			/* Pathname of directory to create */
+{
+    int error;
+
+    if (CreateDirectory(path, NULL) == 0) {
+	error = GetLastError();
+	if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
+	    if ((error == ERROR_ACCESS_DENIED) 
+		    && (GetFileAttributes(path) != (DWORD) -1)) {
+		error = ERROR_FILE_EXISTS;
+	    }
+	}
+	TclWinConvertError(error);
+	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(
+    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 = TraverseWinTree(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 root directory or current directory.
+ *	ENOENT:	    path doesn't exist or is "".
+ * 	ENOTDIR:    path is not a directory.
+ *
+ *	EACCES:	    path is a char device (nul:, com1:, etc.) (95)
+ *	EINVAL:	    path is a char device (nul:, com1:, etc.) (NT)
+ *
+ * Side effects:
+ *	Directory removed.  If an error occurs, the error will be returned
+ *	immediately, and remaining files will not be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpRemoveDirectory(
+    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;
+    DWORD attr;
+
+    if (RemoveDirectory(path) != FALSE) {
+	return TCL_OK;
+    }
+    TclWinConvertError(GetLastError());
+    if (path[0] == '\0') {
+	/*
+	 * Win32s thinks that "" is the same as "." and then reports EACCES
+	 * instead of ENOENT.
+	 */
+
+	errno = ENOENT;
+    }
+    if (errno == EACCES) {
+	attr = GetFileAttributes(path);
+	if (attr != (DWORD) -1) {
+	    if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+		/* 
+		 * Windows 95 reports calling RemoveDirectory on a file as an 
+		 * EACCES, not an ENOTDIR.
+		 */
+		
+		errno = ENOTDIR;
+		goto end;
+	    }
+
+	    if (attr & FILE_ATTRIBUTE_READONLY) {
+		attr &= ~FILE_ATTRIBUTE_READONLY;
+		if (SetFileAttributes(path, attr) == FALSE) {
+		    goto end;
+		}
+		if (RemoveDirectory(path) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY);
+	    }
+
+	    /* 
+	     * Windows 95 and Win32s report removing a non-empty directory 
+	     * as EACCES, not EEXIST.  If the directory is not empty,
+	     * change errno so caller knows what's going on.
+	     */
+
+	    if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
+		HANDLE handle;
+		WIN32_FIND_DATA data;
+		Tcl_DString buffer;
+		char *find;
+		int len;
+
+		Tcl_DStringInit(&buffer);
+		find = Tcl_DStringAppend(&buffer, path, -1);
+		len = Tcl_DStringLength(&buffer);
+		if ((len > 0) && (find[len - 1] != '\\')) {
+		    Tcl_DStringAppend(&buffer, "\\", 1);
+		}
+		find = Tcl_DStringAppend(&buffer, "*.*", 3);
+		handle = FindFirstFile(find, &data);
+		if (handle != INVALID_HANDLE_VALUE) {
+		    while (1) {
+			if ((strcmp(data.cFileName, ".") != 0)
+				&& (strcmp(data.cFileName, "..") != 0)) {
+			    /*
+			     * Found something in this directory.
+			     */
+
+			    errno = EEXIST;
+			    break;
+			}
+			if (FindNextFile(handle, &data) == FALSE) {
+			    break;
+			}
+		    }
+		    FindClose(handle);
+		}
+		Tcl_DStringFree(&buffer);
+	    }
+	}
+    }
+    if (errno == ENOTEMPTY) {
+	/* 
+	 * The caller depends on EEXIST to signify that the directory is
+	 * not empty, not ENOTEMPTY. 
+	 */
+
+	errno = EEXIST;
+    }
+    if ((recursive != 0) && (errno == EEXIST)) {
+	/*
+	 * 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 = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr);
+	Tcl_DStringFree(&buffer);
+	return result;
+    }
+
+    end:
+    if (errorPtr != NULL) {
+        Tcl_DStringAppend(errorPtr, path, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TraverseWinTree --
+ *
+ *      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 TraverseWinTree, 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 
+TraverseWinTree(
+    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. */
+{
+    DWORD sourceAttr;
+    char *source, *target, *errfile;
+    int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal;
+    HANDLE handle;
+    WIN32_FIND_DATA data;
+
+    result = TCL_OK;
+    source = Tcl_DStringValue(sourcePtr);
+    sourceLenOriginal = Tcl_DStringLength(sourcePtr);
+    if (targetPtr != NULL) {
+	target = Tcl_DStringValue(targetPtr);
+	targetLenOriginal = Tcl_DStringLength(targetPtr);
+    } else {
+	target = NULL;
+	targetLenOriginal = 0;
+    }
+
+    errfile = NULL;
+
+    sourceAttr = GetFileAttributes(source);
+    if (sourceAttr == (DWORD) -1) {
+	errfile = source;
+	goto end;
+    }
+    if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+	/*
+	 * Process the regular file
+	 */
+
+	return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr);
+    }
+
+    /*
+     * When given the pathname of the form "c:\" (one that already ends
+     * with a backslash), must make sure not to add another "\" to the end
+     * otherwise it will try to access a network drive.  
+     */
+
+    sourceLen = sourceLenOriginal;
+    if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
+	Tcl_DStringAppend(sourcePtr, "\\", 1);
+	sourceLen++;
+    }
+    source = Tcl_DStringAppend(sourcePtr, "*.*", 3); 
+    handle = FindFirstFile(source, &data);
+    Tcl_DStringSetLength(sourcePtr, sourceLen);
+    if (handle == INVALID_HANDLE_VALUE) {
+	/* 
+	 * Can't read directory
+	 */
+
+	TclWinConvertError(GetLastError());
+	errfile = source;
+	goto end;
+    }
+
+    result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr);
+    if (result != TCL_OK) {
+	FindClose(handle);
+	return result;
+    }
+
+    if (targetPtr != NULL) {
+	targetLen = targetLenOriginal;
+	if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
+	    target = Tcl_DStringAppend(targetPtr, "\\", 1);
+	    targetLen++;
+	}
+    }
+
+    while (1) {
+	if ((strcmp(data.cFileName, ".") != 0)
+	        && (strcmp(data.cFileName, "..") != 0)) {
+	    /* 
+	     * Append name after slash, and recurse on the file. 
+	     */
+
+	    Tcl_DStringAppend(sourcePtr, data.cFileName, -1);
+	    if (targetPtr != NULL) {
+		Tcl_DStringAppend(targetPtr, data.cFileName, -1);
+	    }
+	    result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, 
+		    errorPtr);
+	    if (result != TCL_OK) {
+		break;
+	    }
+
+	    /*
+	     * Remove name after slash.
+	     */
+
+	    Tcl_DStringSetLength(sourcePtr, sourceLen);
+	    if (targetPtr != NULL) {
+		Tcl_DStringSetLength(targetPtr, targetLen);
+	    }
+	}
+	if (FindNextFile(handle, &data) == FALSE) {
+	    break;
+	}
+    }
+    FindClose(handle);
+
+    /*
+     * Strip off the trailing slash we added
+     */
+
+    Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
+    source = Tcl_DStringValue(sourcePtr);
+    if (targetPtr != NULL) {
+	Tcl_DStringSetLength(targetPtr, targetLenOriginal);
+	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, sourceAttr, 
+		DOTREE_POSTD, errorPtr);
+    }
+    end:
+    if (errfile != NULL) {
+	TclWinConvertError(GetLastError());
+	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:
+ *      Depending on the value of type, src may be copied to dst.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int 
+TraversalCopy(
+    char *src,			/* Source pathname to copy. */
+    char *dst,			/* Destination pathname of copy. */
+    DWORD srcAttr,		/* File attributes for src. */
+    int type,			/* Reason for call - see TraverseWinTree() */
+    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) {
+		if (SetFileAttributes(dst, srcAttr) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+	    }
+	    break;
+
+        case DOTREE_POSTD:
+	    return TCL_OK;
+
+    }
+
+    /*
+     * 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 TraverseWinTree 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. If an
+ *      error occurs, the windows error is converted to a Posix error
+ *      and errno is set accordingly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraversalDelete( 
+    char *src,			/* Source pathname. */
+    char *ignore,		/* Destination pathname (not used). */
+    DWORD srcAttr,		/* File attributes for src (not used). */
+    int type,			/* Reason for call - see TraverseWinTree(). */
+    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
+				 * error return. */
+{
+    switch (type) {
+	case DOTREE_F:
+	    if (TclpDeleteFile(src) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+	case DOTREE_PRED:
+	    return TCL_OK;
+
+	case DOTREE_POSTD:
+	    if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+    }
+
+    if (errorPtr != NULL) {
+	Tcl_DStringAppend(errorPtr, src, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AttributesPosixError --
+ *
+ *	Sets the object result with the appropriate error.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      The interp's object result is set with an error message
+ *	based on the objIndex, fileName and errno.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AttributesPosixError(
+    Tcl_Interp *interp,		/* The interp that has the error */
+    int objIndex,		/* The attribute which caused the problem. */
+    char *fileName,		/* The name of the file which caused the 
+				 * error. */
+    int getOrSet)		/* 0 for get; 1 for set */
+{
+    TclWinConvertError(GetLastError());
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+	    "cannot ", getOrSet ? "set" : "get", " attribute \"", 
+	    tclpFileAttrStrings[objIndex], "\" for file \"", fileName, 
+	    "\": ", Tcl_PosixError(interp), (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileAttributes --
+ *
+ *      Returns a Tcl_Obj containing the value of a file attribute.
+ *	This routine gets the -hidden, -readonly or -system attribute.
+ *
+ * Results:
+ *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
+ *	will have ref count 0. If the return value is not TCL_OK,
+ *	attributePtrPtr is not touched.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWinFileAttributes(
+    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. */
+{
+    DWORD result = GetFileAttributes(fileName);
+
+    if (result == 0xFFFFFFFF) {
+	AttributesPosixError(interp, objIndex, fileName, 0);
+	return TCL_ERROR;
+    }
+
+    *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertFileNameFormat --
+ *
+ *      Returns a Tcl_Obj containing either the long or short version of the 
+ *	file name.
+ *
+ * Results:
+ *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
+ *	will have ref count 0. If the return value is not TCL_OK,
+ *	attributePtrPtr is not touched.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertFileNameFormat(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *fileName,		    /* The name of the file. */
+    int longShort,		    /* 0 to short name, 1 to long name. */
+    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
+{
+    HANDLE findHandle;
+    WIN32_FIND_DATA findData;
+    int pathArgc, i;
+    char **pathArgv, **newPathArgv;
+    char *currentElement, *resultStr;
+    Tcl_DString resultDString;
+    int result = TCL_OK;
+
+    Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
+    newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
+
+    i = 0;
+    if ((pathArgv[0][0] == '/') 
+	    || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
+	newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
+	strcpy(newPathArgv[0], pathArgv[0]);
+	i = 1;
+    } 
+    for ( ; i < pathArgc; i++) {
+	if (strcmp(pathArgv[i], ".") == 0) {
+	    currentElement = ckalloc(2);
+	    strcpy(currentElement, ".");
+	} else if (strcmp(pathArgv[i], "..") == 0) {
+	    currentElement = ckalloc(3);
+	    strcpy(currentElement, "..");
+	} else {
+	    int useLong;
+
+	    Tcl_DStringInit(&resultDString);
+	    resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
+	    findHandle = FindFirstFile(resultStr, &findData);
+	    if (findHandle == INVALID_HANDLE_VALUE) {
+		pathArgc = i - 1;
+		AttributesPosixError(interp, objIndex, fileName, 0);
+		result = TCL_ERROR;
+		Tcl_DStringFree(&resultDString);
+		goto cleanup;
+	    }
+	    if (longShort) {
+		if (findData.cFileName[0] != '\0') {
+		    useLong = 1;
+		} else {
+		    useLong = 0;
+		}
+	    } else {
+		if (findData.cAlternateFileName[0] == '\0') {
+		    useLong = 1;
+		} else {
+		    useLong = 0;
+		}
+	    }
+	    if (useLong) {
+		currentElement = ckalloc(strlen(findData.cFileName) + 1);
+		strcpy(currentElement, findData.cFileName);
+	    } else {
+		currentElement = ckalloc(strlen(findData.cAlternateFileName) 
+			+ 1);
+		strcpy(currentElement, findData.cAlternateFileName);
+	    }
+	    Tcl_DStringFree(&resultDString);
+	    FindClose(findHandle);
+	}
+	newPathArgv[i] = currentElement;
+    }
+
+    Tcl_DStringInit(&resultDString);
+    resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
+    *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
+    Tcl_DStringFree(&resultDString);
+
+cleanup:
+    for (i = 0; i < pathArgc; i++) {
+	ckfree(newPathArgv[i]);
+    }
+    ckfree((char *) newPathArgv);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileLongName --
+ *
+ *      Returns a Tcl_Obj containing the short version of the file
+ *	name.
+ *
+ * Results:
+ *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
+ *	will have ref count 0. If the return value is not TCL_OK,
+ *	attributePtrPtr is not touched.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWinFileLongName(
+    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. */
+{
+    return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileShortName --
+ *
+ *      Returns a Tcl_Obj containing the short version of the file
+ *	name.
+ *
+ * Results:
+ *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
+ *	will have ref count 0. If the return value is not TCL_OK,
+ *	attributePtrPtr is not touched.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWinFileShortName(
+    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. */
+{
+    return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWinFileAttributes --
+ *
+ *	Set the file attributes to the value given by attributePtr.
+ *	This routine sets the -hidden, -readonly, or -system attributes.
+ *
+ * Results:
+ *      Standard TCL error.
+ *
+ * Side effects:
+ *      The file's attribute is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWinFileAttributes(
+    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 new value of the attribute. */
+{
+    DWORD fileAttributes = GetFileAttributes(fileName);
+    int yesNo;
+    int result;
+
+    if (fileAttributes == 0xFFFFFFFF) {
+	AttributesPosixError(interp, objIndex, fileName, 1);
+	return TCL_ERROR;
+    }
+
+    result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    if (yesNo) {
+	fileAttributes |= (attributeArray[objIndex]);
+    } else {
+	fileAttributes &= ~(attributeArray[objIndex]);
+    }
+
+    if (!SetFileAttributes(fileName, fileAttributes)) {
+	AttributesPosixError(interp, objIndex, fileName, 1);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWinFileLongName --
+ *
+ *	The attribute in question is a readonly attribute and cannot
+ *	be set.
+ *
+ * Results:
+ *      TCL_ERROR
+ *
+ * Side effects:
+ *      The object result is set to a pertinant error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CannotSetAttribute(
+    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 new value of the attribute. */
+{
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+	    "cannot set attribute \"", tclpFileAttrStrings[objIndex],
+	    "\" for file \"", fileName, "\" : attribute is readonly", 
+	    (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpListVolumes --
+ *
+ *	Lists the currently mounted volumes
+ *
+ * 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( 
+    Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
+{
+    Tcl_Obj *resultPtr, *elemPtr;
+    char buf[4];
+    int i;
+
+    resultPtr = Tcl_GetObjResult(interp);
+
+    buf[1] = ':';
+    buf[2] = '/';
+    buf[3] = '\0';
+
+    /*
+     * On Win32s: 
+     * GetLogicalDriveStrings() isn't implemented.
+     * GetLogicalDrives() returns incorrect information.
+     */
+
+    for (i = 0; i < 26; i++) {
+        buf[0] = (char) ('a' + i);
+	if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
+		|| (GetLastError() == ERROR_NOT_READY)) {
+	    elemPtr = Tcl_NewStringObj(buf, -1);
+	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
+	}
+    }
+    return TCL_OK;	
+}
diff --git a/tcl/win/tclWinFile.c b/tcl/win/tclWinFile.c
new file mode 100644
index 00000000000..b0d9b9fc318
--- /dev/null
+++ b/tcl/win/tclWinFile.c
@@ -0,0 +1,655 @@
+/* 
+ * tclWinFile.c --
+ *
+ *      This file contains temporary wrappers around UNIX file handling
+ *      functions. These wrappers map the UNIX functions to Win32 HANDLE-style
+ *      files, which can be manipulated through the Win32 console redirection
+ *      interfaces.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+#include <sys/stat.h>
+#ifndef __CYGWIN32__
+#include <shlobj.h>
+#endif
+
+/*
+ * The variable below caches the name of the current working directory
+ * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
+ * NULL means the cache needs to be refreshed.
+ */
+
+static char *currentDir =  NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindExecutable --
+ *
+ *	This procedure computes the absolute path name of the current
+ *	application, given its argv[0] value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The variable tclExecutableName gets filled in with the file
+ *	name for the application, if we figured it out.  If we couldn't
+ *	figure it out, Tcl_FindExecutable is set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FindExecutable(argv0)
+    char *argv0;		/* The value of the application's argv[0]. */
+{
+    Tcl_DString buffer;
+    int length;
+
+    Tcl_DStringInit(&buffer);
+
+    if (tclExecutableName != NULL) {
+	ckfree(tclExecutableName);
+	tclExecutableName = NULL;
+    }
+
+    /*
+     * Under Windows we ignore argv0, and return the path for the file used to
+     * create this process.
+     */
+
+    Tcl_DStringSetLength(&buffer, MAX_PATH+1);
+    length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
+    if (length > 0) {
+	tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
+	strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
+    }
+    Tcl_DStringFree(&buffer);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMatchFiles --
+ *
+ *	This routine is used by the globbing code to search a
+ *	directory for all files which match a given pattern.
+ *
+ * Results: 
+ *	If the tail argument is NULL, then the matching files are
+ *	added to the interp->result.  Otherwise, TclDoGlob is called
+ *	recursively for each matching subdirectory.  The return value
+ *	is a standard Tcl result indicating whether an error occurred
+ *	in globbing.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------- */
+
+int
+TclMatchFiles(interp, separators, dirPtr, pattern, tail)
+    Tcl_Interp *interp;		/* Interpreter to receive results. */
+    char *separators;		/* Directory separators to pass to TclDoGlob. */
+    Tcl_DString *dirPtr;	/* Contains path to directory to search. */
+    char *pattern;		/* Pattern to match against. */
+    char *tail;			/* Pointer to end of pattern.  Tail must
+				 * point to a location in pattern. */
+{
+    char drivePattern[4] = "?:\\";
+    char *newPattern, *p, *dir, *root, c;
+    char *src, *dest;
+    int length, matchDotFiles;
+    int result = TCL_OK;
+    int baseLength = Tcl_DStringLength(dirPtr);
+    Tcl_DString buffer;
+    DWORD atts, volFlags;
+    HANDLE handle;
+    WIN32_FIND_DATA data;
+    BOOL found;
+
+    /*
+     * Convert the path to normalized form since some interfaces only
+     * accept backslashes.  Also, ensure that the directory ends with a
+     * separator character.
+     */
+
+    Tcl_DStringInit(&buffer);
+    if (baseLength == 0) {
+	Tcl_DStringAppend(&buffer, ".", 1);
+    } else {
+	Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
+		Tcl_DStringLength(dirPtr));
+    }
+    for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
+	if (*p == '/') {
+	    *p = '\\';
+	}
+    }
+    p--;
+    if (*p != '\\' && *p != ':') {
+	Tcl_DStringAppend(&buffer, "\\", 1);
+    }
+    dir = Tcl_DStringValue(&buffer);
+    
+    /*
+     * First verify that the specified path is actually a directory.
+     */
+
+    atts = GetFileAttributes(dir);
+    if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+	Tcl_DStringFree(&buffer);
+	return TCL_OK;
+    }
+
+    /*
+     * Next check the volume information for the directory to see whether
+     * comparisons should be case sensitive or not.  If the root is null, then
+     * we use the root of the current directory.  If the root is just a drive
+     * specifier, we use the root directory of the given drive.
+     */
+
+    switch (Tcl_GetPathType(dir)) {
+	case TCL_PATH_RELATIVE:
+	    found = GetVolumeInformation(NULL, NULL, 0, NULL,
+		    NULL, &volFlags, NULL, 0);
+	    break;
+	case TCL_PATH_VOLUME_RELATIVE:
+	    if (*dir == '\\') {
+		root = NULL;
+	    } else {
+		root = drivePattern;
+		*root = *dir;
+	    }
+	    found = GetVolumeInformation(root, NULL, 0, NULL,
+		    NULL, &volFlags, NULL, 0);
+	    break;
+	case TCL_PATH_ABSOLUTE:
+	    if (dir[1] == ':') {
+		root = drivePattern;
+		*root = *dir;
+		found = GetVolumeInformation(root, NULL, 0, NULL,
+			NULL, &volFlags, NULL, 0);
+	    } else if (dir[1] == '\\') {
+		p = strchr(dir+2, '\\');
+		p = strchr(p+1, '\\');
+		p++;
+		c = *p;
+		*p = 0;
+		found = GetVolumeInformation(dir, NULL, 0, NULL,
+			NULL, &volFlags, NULL, 0);
+		*p = c;
+	    }
+	    break;
+    }
+
+    if (!found) {
+	Tcl_DStringFree(&buffer);
+	TclWinConvertError(GetLastError());
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "couldn't read volume information for \"",
+		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+    
+    /*
+     * In Windows, although some volumes may support case sensitivity, Windows
+     * doesn't honor case.  So in globbing we need to ignore the case
+     * of file names.
+     */
+
+    length = tail - pattern;
+    newPattern = ckalloc(length+1);
+    for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
+	*dest = (char) tolower(*src);
+    }
+    *dest = '\0';
+    
+    /*
+     * We need to check all files in the directory, so append a *.*
+     * to the path. 
+     */
+
+
+    dir = Tcl_DStringAppend(&buffer, "*.*", 3);
+
+    /*
+     * Now open the directory for reading and iterate over the contents.
+     */
+
+    handle = FindFirstFile(dir, &data);
+    Tcl_DStringFree(&buffer);
+
+    if (handle == INVALID_HANDLE_VALUE) {
+	TclWinConvertError(GetLastError());
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "couldn't read directory \"",
+		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	ckfree(newPattern);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Clean up the tail pointer.  Leave the tail pointing to the 
+     * first character after the path separator or NULL. 
+     */
+
+    if (*tail == '\\') {
+	tail++;
+    }
+    if (*tail == '\0') {
+	tail = NULL;
+    } else {
+	tail++;
+    }
+
+    /*
+     * Check to see if the pattern needs to compare with dot files.
+     */
+
+    if ((newPattern[0] == '.')
+	    || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+        matchDotFiles = 1;
+    } else {
+        matchDotFiles = 0;
+    }
+
+    /*
+     * Now iterate over all of the files in the directory.
+     */
+
+    Tcl_DStringInit(&buffer);
+    for (found = 1; found; found = FindNextFile(handle, &data)) {
+	char *matchResult;
+
+	/*
+	 * Ignore hidden files.
+	 */
+
+	if (!matchDotFiles && (data.cFileName[0] == '.')) {
+	    continue;
+	}
+
+	/*
+	 * Check to see if the file matches the pattern.  We need to convert
+	 * the file name to lower case for comparison purposes.  Note that we
+	 * are ignoring the case sensitivity flag because Windows doesn't honor
+	 * case even if the volume is case sensitive.  If the volume also
+	 * doesn't preserve case, then we return the lower case form of the
+	 * name, otherwise we return the system form.
+	 */
+
+	matchResult = NULL;
+	Tcl_DStringSetLength(&buffer, 0);
+	Tcl_DStringAppend(&buffer, data.cFileName, -1);
+	for (p = buffer.string; *p != '\0'; p++) {
+	    *p = (char) tolower(*p);
+	}
+	if (Tcl_StringMatch(buffer.string, newPattern)) {
+	    if (volFlags & FS_CASE_IS_PRESERVED) {
+		matchResult = data.cFileName;
+	    } else {
+		matchResult = buffer.string;
+	    }	
+	}
+
+	if (matchResult == NULL) {
+	    continue;
+	}
+
+	/*
+	 * If the file matches, then we need to process the remainder of the
+	 * path.  If there are more characters to process, then ensure matching
+	 * files are directories and call TclDoGlob. Otherwise, just add the
+	 * file to the result.
+	 */
+
+	Tcl_DStringSetLength(dirPtr, baseLength);
+	Tcl_DStringAppend(dirPtr, matchResult, -1);
+	if (tail == NULL) {
+	    Tcl_AppendElement(interp, dirPtr->string);
+	} else {
+	    atts = GetFileAttributes(dirPtr->string);
+	    if (atts & FILE_ATTRIBUTE_DIRECTORY) {
+		Tcl_DStringAppend(dirPtr, "/", 1);
+		result = TclDoGlob(interp, separators, dirPtr, tail);
+		if (result != TCL_OK) {
+		    break;
+		}
+	    }
+	}
+    }
+
+    Tcl_DStringFree(&buffer);
+    FindClose(handle);
+    ckfree(newPattern);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChdir --
+ *
+ *	Change the current working directory.
+ *
+ * Results:
+ *	The result is a standard Tcl result.  If an error occurs and 
+ *	interp isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The working directory for this application is changed.  Also
+ *	the cache maintained used by TclGetCwd is deallocated and
+ *	set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChdir(interp, dirName)
+    Tcl_Interp *interp;		/* If non NULL, used for error reporting. */
+    char *dirName;     		/* Path to new working directory. */
+{
+    if (currentDir != NULL) {
+	ckfree(currentDir);
+	currentDir = NULL;
+    }
+    /* CYGNUS LOCAL: On cygwin32, we must use chdir.  Otherwise, the
+       cygwin32 notion of the current directory will get messed up.  */
+#ifdef __CYGWIN32__
+    if (chdir(dirName) < 0) {
+#else
+    if (!SetCurrentDirectory(dirName)) {
+	TclWinConvertError(GetLastError());
+#endif
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
+		    dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCwd --
+ *
+ *	Return the path name of the current working directory.
+ *
+ * Results:
+ *	The result is the full path name of the current working
+ *	directory, or NULL if an error occurred while figuring it
+ *	out.  If an error occurs and interp isn't NULL, an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	The path name is cached to avoid having to recompute it
+ *	on future calls;  if it is already cached, the cached
+ *	value is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetCwd(interp)
+    Tcl_Interp *interp;		/* If non NULL, used for error reporting. */
+{
+    static char buffer[MAXPATHLEN+1];
+    char *bufPtr, *p;
+
+    if (currentDir == NULL) {
+	if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
+	    TclWinConvertError(GetLastError());
+	    if (interp != NULL) {
+		if (errno == ERANGE) {
+		    Tcl_SetResult(interp,
+			    "working directory name is too long",
+			    TCL_STATIC);
+		} else {
+		    Tcl_AppendResult(interp,
+			    "error getting working directory name: ",
+			    Tcl_PosixError(interp), (char *) NULL);
+		}
+	    }
+	    return NULL;
+	}
+	/*
+	 * Watch for the wierd Windows '95 c:\\UNC syntax.
+	 */
+
+	if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
+		&& buffer[3] == '\\') {
+	    bufPtr = &buffer[2];
+	} else {
+	    bufPtr = buffer;
+	}
+
+	/*
+	 * Convert to forward slashes for easier use in scripts.
+	 */
+
+	for (p = bufPtr; *p != '\0'; p++) {
+	    if (*p == '\\') {
+		*p = '/';
+	    }
+	}
+    }
+    return bufPtr;
+}
+
+#if 0
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclWinResolveShortcut --
+ *
+ *	Resolve a potential Windows shortcut to get the actual file or 
+ *	directory in question.  
+ *
+ * Results:
+ *	Returns 1 if the shortcut could be resolved, or 0 if there was
+ *	an error or if the filename was not a shortcut.
+ *	If bufferPtr did hold the name of a shortcut, it is modified to
+ *	hold the resolved target of the shortcut instead.
+ *
+ * Side effects:
+ *	Loads and unloads OLE package to determine if filename refers to
+ *	a shortcut.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclWinResolveShortcut(bufferPtr)
+    Tcl_DString *bufferPtr;	/* Holds name of file to resolve.  On 
+				 * return, holds resolved file name. */
+{
+    HRESULT hres; 
+    IShellLink *psl; 
+    IPersistFile *ppf; 
+    WIN32_FIND_DATA wfd; 
+    WCHAR wpath[MAX_PATH];
+    char *path, *ext;
+    char realFileName[MAX_PATH];
+
+    /*
+     * Windows system calls do not automatically resolve
+     * shortcuts like UNIX automatically will with symbolic links.
+     */
+
+    path = Tcl_DStringValue(bufferPtr);
+    ext = strrchr(path, '.');
+    if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
+	return 0;
+    }
+
+    CoInitialize(NULL);
+    path = Tcl_DStringValue(bufferPtr);
+    realFileName[0] = '\0';
+    hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, 
+	    &IID_IShellLink, &psl); 
+    if (SUCCEEDED(hres)) { 
+	hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
+	if (SUCCEEDED(hres)) { 
+	    MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
+	    hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); 
+	    if (SUCCEEDED(hres)) {
+		hres = psl->lpVtbl->Resolve(psl, NULL, 
+			SLR_ANY_MATCH | SLR_NO_UI); 
+		if (SUCCEEDED(hres)) { 
+		    hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, 
+			    &wfd, 0);
+		} 
+	    } 
+	    ppf->lpVtbl->Release(ppf); 
+	} 
+	psl->lpVtbl->Release(psl); 
+    } 
+    CoUninitialize();
+
+    if (realFileName[0] != '\0') {
+	Tcl_DStringSetLength(bufferPtr, 0);
+	Tcl_DStringAppend(bufferPtr, realFileName, -1);
+	return 1;
+    }
+    return 0;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpStat, TclpLstat --
+ *
+ *	These functions replace the library versions of stat and lstat.
+ *
+ *	The stat and lstat functions provided by some Windows compilers 
+ *	are incomplete.  Ideally, a complete rewrite of stat would go
+ *	here; now, the only fix is that stat("c:") used to return an
+ *	error instead infor for current dir on specified drive.
+ *
+ * Results:
+ *	See stat documentation.
+ *
+ * Side effects:
+ *	See stat documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpStat(path, buf)
+    CONST char *path;		/* Path of file to stat (in current CP). */
+    struct stat *buf;		/* Filled with results of stat call. */
+{
+    char name[4];
+    int result;
+
+    if ((strlen(path) == 2) && (path[1] == ':')) {
+	strcpy(name, path);
+	name[2] = '.';
+	name[3] = '\0';
+	path = name;
+    }
+
+#undef stat
+
+    result = stat(path, buf);
+
+#if ! defined (_MSC_VER) && ! defined (__CYGWIN32__)
+
+    /*
+     * Borland's stat doesn't take into account localtime.
+     */
+
+    if ((result == 0) && (buf->st_mtime != 0)) {
+	TIME_ZONE_INFORMATION tz;
+	int time, bias;
+
+	time = GetTimeZoneInformation(&tz);
+	bias = tz.Bias;
+	if (time == TIME_ZONE_ID_DAYLIGHT) {
+	    bias += tz.DaylightBias;
+	}
+	bias *= 60;
+	buf->st_atime -= bias;
+	buf->st_ctime -= bias;
+	buf->st_mtime -= bias;
+    }
+
+#endif
+
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpAccess --
+ *
+ *	This function replaces the library version of access.
+ *
+ *	The library version of access returns that all files have execute
+ *	permission.
+ *
+ * Results:
+ *	See access documentation.
+ *
+ * Side effects:
+ *	See access documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpAccess(
+    CONST char *path,		/* Path of file to access (in current CP). */
+    int mode)			/* Permission setting. */
+{
+    int result;
+    CONST char *p;
+
+#undef access
+
+    result = access(path, mode);
+
+    if (result == 0) {
+	if (mode & 1) {
+	    if (GetFileAttributes(path) & FILE_ATTRIBUTE_DIRECTORY) {
+		/*
+		 * Directories are always executable. 
+		 */
+
+		return 0;
+	    }
+	    p = strrchr(path, '.');
+	    if (p != NULL) {
+		p++;
+		if ((stricmp(p, "exe") == 0)
+			|| (stricmp(p, "com") == 0)
+			|| (stricmp(p, "bat") == 0)) {
+		    /*
+		     * File that ends with .exe, .com, or .bat is executable.
+		     */
+
+		    return 0;
+		}
+	    }
+	    errno = EACCES;
+	    return -1;
+	}
+    }
+    return result;
+}
+
diff --git a/tcl/win/tclWinInit.c b/tcl/win/tclWinInit.c
new file mode 100644
index 00000000000..c06e8314fd7
--- /dev/null
+++ b/tcl/win/tclWinInit.c
@@ -0,0 +1,321 @@
+/* 
+ * tclWinInit.c --
+ *
+ *	Contains the Windows-specific interpreter initialization functions.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <winreg.h>
+#include <winnt.h>
+#include <winbase.h>
+
+/*
+ * The following macro can be defined at compile time to specify
+ * the root of the Tcl registry keys.
+ */
+ 
+#ifndef TCL_REGISTRY_KEY
+#define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION
+#endif
+
+/*
+ * The following declaration is a workaround for some Microsoft brain damage.
+ * The SYSTEM_INFO structure is different in various releases, even though the
+ * layout is the same.  So we overlay our own structure on top of it so we
+ * can access the interesting slots in a uniform way.
+ */
+
+typedef struct {
+    WORD wProcessorArchitecture;
+    WORD wReserved;
+} OemId;
+
+/*
+ * The following macros are missing from some versions of winnt.h.
+ */
+
+#ifndef PROCESSOR_ARCHITECTURE_INTEL
+#define PROCESSOR_ARCHITECTURE_INTEL 0
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_MIPS
+#define PROCESSOR_ARCHITECTURE_MIPS  1
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_ALPHA
+#define PROCESSOR_ARCHITECTURE_ALPHA 2
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_PPC
+#define PROCESSOR_ARCHITECTURE_PPC   3
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
+#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
+#endif
+
+/*
+ * The following arrays contain the human readable strings for the Windows
+ * platform and processor values.
+ */
+
+
+#define NUMPLATFORMS 3
+static char* platforms[NUMPLATFORMS] = {
+    "Win32s", "Windows 95", "Windows NT"
+};
+
+#define NUMPROCESSORS 4
+static char* processors[NUMPROCESSORS] = {
+    "intel", "mips", "alpha", "ppc"
+};
+
+/*
+ * The Init script, tclPreInitScript variable, and the routine
+ * TclSetPreInitScript (common to Windows and Unix platforms) are defined
+ * in generic/tclInitScript.h
+ */
+
+#include "tclInitScript.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPlatformInit --
+ *
+ *	Performs Windows-specific interpreter initialization related to the
+ *	tcl_library variable.  Also sets up the HOME environment variable
+ *	if it is not already set.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets "tcl_library" and "env(HOME)" Tcl variables
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPlatformInit(interp)
+    Tcl_Interp *interp;
+{
+    char *p;
+    char buffer[13];
+    Tcl_DString ds;
+    OSVERSIONINFO osInfo;
+    SYSTEM_INFO sysInfo;
+    int isWin32s;		/* True if we are running under Win32s. */
+    OemId *oemId;
+    HKEY key;
+    DWORD size, result, type;
+
+    tclPlatform = TCL_PLATFORM_WINDOWS;
+
+    Tcl_DStringInit(&ds);
+
+    /*
+     * Find out what kind of system we are running on.
+     */
+
+    osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+    GetVersionEx(&osInfo);
+
+    isWin32s = (osInfo.dwPlatformId == VER_PLATFORM_WIN32s);
+
+    /*
+     * Since Win32s doesn't support GetSystemInfo, we use a default value.
+     */
+
+    oemId = (OemId *) &sysInfo;
+    if (!isWin32s) {
+	GetSystemInfo(&sysInfo);
+    } else {
+	oemId->wProcessorArchitecture = PROCESSOR_ARCHITECTURE_INTEL;
+    }
+
+    /* CYGNUS LOCAL: don't set tclDefaultLibrary from the registry; instead
+       always compute it at runtime.  We do have to set it to
+       something, though, so that initScript will work correctly.  */
+    Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
+    /* ditto, but this is a hack - dj */
+    Tcl_SetVar(interp, "tcl_pkgPath", "", TCL_GLOBAL_ONLY);
+    /* END CYGNUS LOCAL */
+    
+    /*
+     * Define the tcl_platform array.
+     */
+
+    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
+	    TCL_GLOBAL_ONLY);
+    if (osInfo.dwPlatformId < NUMPLATFORMS) {
+	Tcl_SetVar2(interp, "tcl_platform", "os",
+		platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
+    }
+    sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
+    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
+    if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
+	Tcl_SetVar2(interp, "tcl_platform", "machine",
+		processors[oemId->wProcessorArchitecture],
+		TCL_GLOBAL_ONLY);
+    }
+
+#ifdef _DEBUG
+    /*
+     * The existence of the "debug" element of the tcl_platform array indicates
+     * that this particular Tcl shell has been compiled with debug information.
+     * Using "info exists tcl_platform(debug)" a Tcl script can direct the 
+     * interpreter to load debug versions of DLLs with the load command.
+     */
+
+    Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
+		TCL_GLOBAL_ONLY);
+#endif
+
+    /*
+     * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
+     * environment variables, if necessary.
+     */
+
+    p = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
+    if (p == NULL) {
+	Tcl_DStringSetLength(&ds, 0);
+	p = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
+	if (p != NULL) {
+	    Tcl_DStringAppend(&ds, p, -1);
+	}
+	p = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
+	if (p != NULL) {
+	    Tcl_DStringAppend(&ds, p, -1);
+	}
+	if (Tcl_DStringLength(&ds) > 0) {
+	    Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
+		    TCL_GLOBAL_ONLY);
+	} else {
+	    Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
+	}
+    }
+
+    Tcl_DStringFree(&ds);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Init --
+ *
+ *	This procedure is typically invoked by Tcl_AppInit procedures
+ *	to perform additional initialization for a Tcl interpreter,
+ *	such as sourcing the "init.tcl" script.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code and sets interp->result
+ *	if there is an error.
+ *
+ * Side effects:
+ *	Depends on what's in the init.tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter to initialize. */
+{
+    if (tclPreInitScript != NULL) {
+	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
+	    return (TCL_ERROR);
+	};
+    }
+    return(Tcl_Eval(interp, initScript));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetPlatform --
+ *
+ *	This is a kludge that allows the test library to get access
+ *	the internal tclPlatform variable.
+ *
+ * Results:
+ *	Returns a pointer to the tclPlatform variable.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclPlatformType *
+TclWinGetPlatform()
+{
+    return &tclPlatform;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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/tcl/win/tclWinInt.h b/tcl/win/tclWinInt.h
new file mode 100644
index 00000000000..915c3083624
--- /dev/null
+++ b/tcl/win/tclWinInt.h
@@ -0,0 +1,46 @@
+/*
+ * tclWinInt.h --
+ *
+ *	Declarations of Windows-specific shared variables and procedures.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLWININT
+#define _TCLWININT
+
+#ifndef _TCLINT
+#include "tclInt.h"
+#endif
+#ifndef _TCLPORT
+#include "tclPort.h"
+#endif
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Some versions of Borland C have a define for the OSVERSIONINFO for
+ * Win32s and for NT, but not for Windows 95.
+ */
+
+#ifndef VER_PLATFORM_WIN32_WINDOWS
+#define VER_PLATFORM_WIN32_WINDOWS 1
+#endif
+
+EXTERN int		TclWinGetPlatformId(void);
+EXTERN void		TclWinInit(HINSTANCE hInst);
+EXTERN int		TclWinSynchSpawn(void *args, int type, void **trans,
+				      Tcl_Pid *pidPtr);
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif	/* _TCLWININT */
diff --git a/tcl/win/tclWinLoad.c b/tcl/win/tclWinLoad.c
new file mode 100644
index 00000000000..9709aa9966c
--- /dev/null
+++ b/tcl/win/tclWinLoad.c
@@ -0,0 +1,114 @@
+/* 
+ * tclWinLoad.c --
+ *
+ *	This procedure provides a version of the TclLoadFile that
+ *	works with the Windows "LoadLibrary" and "GetProcAddress"
+ *	API for dynamic loading.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns
+ *	the addresses of two procedures within that file, if they
+ *	are defined.
+ *
+ * Results:
+ *	A standard Tcl completion code.  If an error occurs, an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    char *fileName;		/* Name of the file containing the desired
+				 * code. */
+    char *sym1, *sym2;		/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+{
+    HINSTANCE handle;
+    char *buffer;
+
+    handle = TclWinLoadLibrary(fileName);
+    if (handle == NULL) {
+	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * For each symbol, check for both Symbol and _Symbol, since Borland
+     * generates C symbols with a leading '_' by default.
+     */
+
+    *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
+    if (*proc1Ptr == NULL) {
+	buffer = ckalloc(strlen(sym1)+2);
+	buffer[0] = '_';
+	strcpy(buffer+1, sym1);
+	*proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, buffer);
+	ckfree(buffer);
+    }
+    
+    *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
+    if (*proc2Ptr == NULL) {
+	buffer = ckalloc(strlen(sym2)+2);
+	buffer[0] = '_';
+	strcpy(buffer+1, sym2);
+	*proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, buffer);
+	ckfree(buffer);
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ *	If the "load" command is invoked without providing a package
+ *	name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ *	Always returns 0 to indicate that we couldn't figure out a
+ *	package name;  generic code will then try to guess the package
+ *	from the file name.  A return value of 1 would have meant that
+ *	we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+    char *fileName;		/* Name of file containing package (already
+				 * translated to local form if needed). */
+    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
+				 * package name to this if possible. */
+{
+    return 0;
+}
diff --git a/tcl/win/tclWinMtherr.c b/tcl/win/tclWinMtherr.c
new file mode 100644
index 00000000000..654094a1915
--- /dev/null
+++ b/tcl/win/tclWinMtherr.c
@@ -0,0 +1,61 @@
+/* 
+ * tclWinMtherr.c --
+ *
+ *	This function provides a default implementation of the
+ *	_matherr function for Borland C++.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <math.h>
+
+/*
+ * The following variable is secretly shared with Tcl so we can
+ * tell if expression evaluation is in progress.  If not, matherr
+ * just emulates the default behavior, which includes printing
+ * a message.
+ */
+
+extern int tcl_MathInProgress;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * _matherr --
+ *
+ *	This procedure is invoked by Borland C++ when certain
+ *	errors occur in mathematical functions.  This procedure
+ *	replaces the default implementation which generates pop-up
+ *	warnings.
+ *
+ * Results:
+ *	Returns 1 to indicate that we've handled the error
+ *	locally.
+ *
+ * Side effects:
+ *	Sets errno based on what's in xPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+_matherr(xPtr)
+    struct exception *xPtr;	/* Describes error that occurred. */
+{
+    if (!tcl_MathInProgress) {
+	return 0;
+    }
+    if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
+	errno = EDOM;
+    } else {
+	errno = ERANGE;
+    }
+    return 1;
+}
diff --git a/tcl/win/tclWinNotify.c b/tcl/win/tclWinNotify.c
new file mode 100644
index 00000000000..6603bcae85b
--- /dev/null
+++ b/tcl/win/tclWinNotify.c
@@ -0,0 +1,325 @@
+/* 
+ * tclWinNotify.c --
+ *
+ *	This file contains Windows-specific procedures for the notifier,
+ *	which is the lowest-level part of the Tcl event loop.  This file
+ *	works together with ../generic/tclNotify.c.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <winsock.h>
+
+/*
+ * The follwing static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+#define INTERVAL_TIMER 1		/* Handle of interval timer. */
+
+/*
+ * The following static structure contains the state information for the
+ * Windows implementation of the Tcl notifier.
+ */
+
+static struct {
+    HWND hwnd;			/* Messaging window. */
+    int timeout;		/* Current timeout value. */
+    int timerActive;		/* 1 if interval timer is running. */
+} notifier;
+
+/*
+ * Static routines defined in this file.
+ */
+
+static void		InitNotifier(void);
+static void		NotifierExitHandler(ClientData clientData);
+static LRESULT CALLBACK	NotifierProc(HWND hwnd, UINT message,
+			    WPARAM wParam, LPARAM lParam);
+static void		UpdateTimer(int timeout);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ *	Initializes the notifier window.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new notifier window and window class.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitNotifier(void)
+{
+    WNDCLASS class;
+
+    initialized = 1;
+    notifier.timerActive = 0;
+    class.style = 0;
+    class.cbClsExtra = 0;
+    class.cbWndExtra = 0;
+    class.hInstance = TclWinGetTclInstance();
+    class.hbrBackground = NULL;
+    class.lpszMenuName = NULL;
+    class.lpszClassName = "TclNotifier";
+    class.lpfnWndProc = NotifierProc;
+    class.hIcon = NULL;
+    class.hCursor = NULL;
+
+    if (!RegisterClass(&class)) {
+	panic("Unable to register TclNotifier window class");
+    }
+    notifier.hwnd = CreateWindow("TclNotifier", "TclNotifier", WS_TILED,
+	    0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
+    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)	/* Old window proc */
+{
+    initialized = 0;
+    if (notifier.hwnd) {
+	KillTimer(notifier.hwnd, INTERVAL_TIMER);
+	DestroyWindow(notifier.hwnd);
+	UnregisterClass("TclNotifier", TclWinGetTclInstance());
+	notifier.hwnd = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateTimer --
+ *
+ *	This function starts or stops the notifier interval timer.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+UpdateTimer(
+    int timeout)		/* ms timeout, 0 means cancel timer */
+{
+    notifier.timeout = timeout;
+    if (timeout != 0) {
+	notifier.timerActive = 1;
+	SetTimer(notifier.hwnd, INTERVAL_TIMER,
+		    (unsigned long) notifier.timeout, NULL);
+    } else {
+	notifier.timerActive = 0;
+	KillTimer(notifier.hwnd, INTERVAL_TIMER);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ *	This procedure sets the current notifier timer value.  The
+ *	notifier will ensure that Tcl_ServiceAll() is called after
+ *	the specified interval, even if no events have occurred.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Replaces any previous timer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimer(
+    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
+{
+    UINT timeout;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    if (!timePtr) {
+	timeout = 0;
+    } else {
+	/*
+	 * Make sure we pass a non-zero value into the timeout argument.
+	 * Windows seems to get confused by zero length timers.
+	 */
+	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+	if (timeout == 0) {
+	    timeout = 1;
+	}
+    }
+    UpdateTimer(timeout);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierProc --
+ *
+ *	This procedure is invoked by Windows to process the timer
+ *	message whenever we are using an external dispatch loop.
+ *
+ * Results:
+ *	A standard windows result.
+ *
+ * Side effects:
+ *	Services any pending events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+NotifierProc(
+    HWND hwnd,
+    UINT message,
+    WPARAM wParam,
+    LPARAM lParam)
+{
+
+    if (message != WM_TIMER) {
+	return DefWindowProc(hwnd, message, wParam, lParam);
+    }
+	
+    /*
+     * Process all of the runnable events.
+     */
+
+    Tcl_ServiceAll();
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ *	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 the event queue without blocking.
+ *
+ * Results:
+ *	Returns -1 if a WM_QUIT message is detected, returns 1 if
+ *	a message was dispatched, otherwise returns 0.
+ *
+ * Side effects:
+ *	Dispatches a message to a window procedure, which could do
+ *	anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
+{
+    MSG msg;
+    int timeout;
+
+    if (!initialized) {
+	InitNotifier();
+    }
+
+    /*
+     * Only use the interval timer for non-zero timeouts.  This avoids
+     * generating useless messages when we really just want to poll.
+     */
+
+    if (timePtr) {
+	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+    } else {
+	timeout = 0;
+    }
+    UpdateTimer(timeout);
+	
+    if (!timePtr || (timeout != 0)
+	    || PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
+	if (!GetMessage(&msg, NULL, 0, 0)) {
+
+	    /*
+	     * The application is exiting, so repost the quit message
+	     * and start unwinding.
+	     */
+
+	    PostQuitMessage(msg.wParam);
+	    return -1;
+	}
+
+	/*
+	 * Handle timer expiration as a special case so we don't
+	 * claim to be doing work when we aren't.
+	 */
+
+	if (msg.message == WM_TIMER && msg.hwnd == notifier.hwnd) {
+	    return 0;
+	}
+
+	TranslateMessage(&msg);
+	DispatchMessage(&msg);
+	return 1;
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    Sleep(ms);
+}
diff --git a/tcl/win/tclWinPipe.c b/tcl/win/tclWinPipe.c
new file mode 100644
index 00000000000..0582e964f29
--- /dev/null
+++ b/tcl/win/tclWinPipe.c
@@ -0,0 +1,2731 @@
+/* 
+ * tclWinPipe.c --
+ *
+ *	This file implements the Windows-specific exec pipeline functions,
+ *	the "pipe" channel driver, and the "pid" Tcl command.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+/* CYGNUS LOCAL */
+#ifndef __CYGWIN32__
+#include <dos.h>
+#endif
+/* END CYGNUS LOCAL */
+#include <fcntl.h>
+#include <io.h>
+#include <sys/stat.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * The following defines identify the various types of applications that 
+ * run under windows.  There is special case code for the various types.
+ */
+
+#define APPL_NONE	0
+#define APPL_DOS	1
+#define APPL_WIN3X	2
+#define APPL_WIN32	3
+
+/*
+ * The following constants and structures are used to encapsulate the state
+ * of various types of files used in a pipeline.
+ */
+
+#define WIN32S_PIPE 1		/* Win32s emulated pipe. */
+#define WIN32S_TMPFILE 2	/* Win32s emulated temporary file. */
+#define WIN_FILE 3		/* Basic Win32 file. */
+
+/*
+ * This structure encapsulates the common state associated with all file
+ * types used in a pipeline.
+ */
+
+typedef struct WinFile {
+    int type;			/* One of the file types defined above. */
+    HANDLE handle;		/* Open file handle. */
+} WinFile;
+
+/*
+ * The following structure is used to keep track of temporary files under
+ * Win32s and delete the disk file when the open handle is closed.
+ * The type field will be WIN32S_TMPFILE.
+ */
+
+typedef struct TmpFile {
+    WinFile file;		/* Common part. */
+    char name[MAX_PATH];	/* Name of temp file. */
+} TmpFile;
+
+/*
+ * The following structure represents a synchronous pipe under Win32s.
+ * The type field will be WIN32S_PIPE.  The handle field will refer to
+ * an open file when Tcl is reading from the "pipe", otherwise it is
+ * INVALID_HANDLE_VALUE.
+ */
+
+typedef struct WinPipe {
+    WinFile file;		/* Common part. */
+    struct WinPipe *otherPtr;	/* Pointer to the WinPipe structure that
+				 * corresponds to the other end of this 
+				 * pipe. */
+    char *fileName;		/* The name of the staging file that gets 
+				 * the data written to this pipe.  Malloc'd.
+				 * and shared by both ends of the pipe.  Only
+				 * when both ends are freed will fileName be
+				 * freed and the file it refers to deleted. */
+} WinPipe;
+
+/*
+ * This list is used to map from pids to process handles.
+ */
+
+typedef struct ProcInfo {
+    HANDLE hProcess;
+    DWORD dwProcessId;
+    struct ProcInfo *nextPtr;
+} ProcInfo;
+
+static ProcInfo *procList;
+
+/*
+ * State flags used in the PipeInfo structure below.
+ */
+
+#define PIPE_PENDING	(1<<0)	/* Message is pending in the queue. */
+#define PIPE_ASYNC	(1<<1)	/* Channel is non-blocking. */
+#define PIPE_READABLE	(1<<2)	/* Pipe is readable. */
+#define PIPE_CLOSED	(1<<3)	/* Pipe is being closed. */
+#define PIPE_HAS_THREAD	(1<<4)	/* Pipe has an associated thread. */
+#define PIPE_READAHEAD	(1<<5)	/* Readahead byte is valid. */
+
+/*
+ * This structure describes per-instance data for a pipe based channel.
+ */
+
+typedef struct PipeInfo {
+    Tcl_Channel channel;	/* Pointer to channel structure. */
+    int validMask;		/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which operations are valid on the file. */
+    int watchMask;		/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+				 * which events should be reported. */
+    int flags;			/* State flags, see above for a list. */
+    TclFile readFile;		/* Output from pipe. */
+    TclFile writeFile;		/* Input from pipe. */
+    TclFile errorFile;		/* Error output from pipe. */
+    int numPids;		/* Number of processes attached to pipe. */
+    Tcl_Pid *pidPtr;		/* Pids of attached processes. */
+    struct PipeInfo *nextPtr;	/* Pointer to next registered pipe. */
+    /* CYGNUS LOCAL: Several new fields.  */
+    HANDLE flagsMutex;		/* Mutex to control access to flags. */
+    HANDLE mutex;		/* Mutex for read fields.  */
+    HANDLE tryReadEvent;	/* Event to tell thread to try a read.  */
+    char readAhead;		/* Read ahead byte.  */
+} PipeInfo;
+
+/*
+ * The following pointer refers to the head of the list of pipes
+ * that are being watched for file events.
+ */
+
+static PipeInfo *firstPipePtr;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * pipe events are generated.
+ */
+
+typedef struct PipeEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    PipeInfo *infoPtr;		/* Pointer to pipe info structure.  Note
+				 * that we still have to verify that the
+				 * pipe exists before dereferencing this
+				 * pointer. */
+} PipeEvent;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static int	ApplicationType(Tcl_Interp *interp, const char *fileName,
+		    char *fullName);
+static void	BuildCommandLine(int argc, char **argv, Tcl_DString *linePtr);
+static void	CopyChannel(HANDLE dst, HANDLE src);
+static BOOL	HasConsole(void);
+static TclFile	MakeFile(HANDLE handle);
+static char *	MakeTempFile(Tcl_DString *namePtr);
+static int	PipeBlockModeProc(ClientData instanceData, int mode);
+static void	PipeCheckProc _ANSI_ARGS_((ClientData clientData,
+		    int flags));
+static int	PipeCloseProc(ClientData instanceData, Tcl_Interp *interp);
+static int	PipeEventProc(Tcl_Event *evPtr, int flags);
+static void	PipeExitHandler(ClientData clientData);
+static int	PipeGetHandleProc(ClientData instanceData, int direction,
+		    ClientData *handlePtr);
+static void	PipeInit(void);
+static int	PipeInputProc(ClientData instanceData, char *buf, int toRead,
+		    int *errorCode);
+static int	PipeOutputProc(ClientData instanceData, char *buf, int toWrite,
+		    int *errorCode);
+static void	PipeWatchProc(ClientData instanceData, int mask);
+static void	PipeSetupProc _ANSI_ARGS_((ClientData clientData,
+		    int flags));
+static int	TempFileName(char name[MAX_PATH]);
+
+/* CYGNUS LOCAL.  */
+static int	PipeGetFlags _ANSI_ARGS_((PipeInfo *));
+static void	PipeSetFlag _ANSI_ARGS_((PipeInfo *, int));
+static void	PipeResetFlag _ANSI_ARGS_((PipeInfo *, int));
+static DWORD	PipeThread _ANSI_ARGS_((LPVOID arg));
+static LRESULT CALLBACK	PipeProc _ANSI_ARGS_((HWND hwnd, UINT message,
+			    WPARAM wParam, LPARAM lParam));
+
+/*
+ * This structure describes the channel type structure for command pipe
+ * based IO.
+ */
+
+static Tcl_ChannelType pipeChannelType = {
+    "pipe",			/* Type name. */
+    PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
+    PipeCloseProc,		/* Close proc. */
+    PipeInputProc,		/* Input proc. */
+    PipeOutputProc,		/* Output proc. */
+    NULL,			/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    PipeWatchProc,		/* Set up notifier to watch the channel. */
+    PipeGetHandleProc,		/* Get an OS handle from channel. */
+};
+
+/* CYGNUS LOCAL: Event notification window.  */
+
+static HWND pipeHwnd;
+
+#define PIPE_MESSAGE (WM_USER + 1)
+
+/* CYGNUS LOCAL: Because we use a thread that manipulates the flags
+   field, we use helper routines for the field.  */
+
+static int
+PipeGetFlags(pipe)
+    PipeInfo *pipe;
+{
+    int flags;
+
+    WaitForSingleObject(pipe->flagsMutex, INFINITE);
+    flags = pipe->flags;
+    ReleaseMutex(pipe->flagsMutex);
+    return flags;
+}
+
+static void
+PipeSetFlag(pipe, flag)
+    PipeInfo *pipe;
+    int flag;
+{
+    WaitForSingleObject(pipe->flagsMutex, INFINITE);
+    pipe->flags |= flag;
+    ReleaseMutex(pipe->flagsMutex);
+}
+
+static void
+PipeResetFlag(pipe, flag)
+    PipeInfo *pipe;
+    int flag;
+{
+    WaitForSingleObject(pipe->flagsMutex, INFINITE);
+    pipe->flags &= ~ (flag);
+    ReleaseMutex(pipe->flagsMutex);
+}
+
+/* CYGNUS LOCAL: We use a thread to detect when a pipe may be read.
+   The thread runs this function.  The argument is the pipe to read.  */
+
+static DWORD
+PipeThread(arg)
+    LPVOID arg;
+{
+    PipeInfo *pipe = (PipeInfo *) arg;
+    WinFile *file = (WinFile*) pipe->readFile;
+    HANDLE handle = file->handle;
+
+    while (1) {
+	char b;
+	DWORD got;
+
+	WaitForSingleObject(pipe->tryReadEvent, INFINITE);
+
+	if (PipeGetFlags(pipe) & PIPE_CLOSED) {
+	    break;
+	}
+
+	WaitForSingleObject(pipe->mutex, INFINITE);
+
+	if ((PipeGetFlags(pipe) & PIPE_READAHEAD) == 0) {
+	    if (ReadFile(handle, &b, 1, &got, NULL) && got == 1) {
+		pipe->readAhead = b;
+		PipeSetFlag(pipe, PIPE_READAHEAD);
+	    }
+	}
+
+	PipeSetFlag(pipe, PIPE_READABLE);
+
+	/* We've indicated that the pipe is readable, so ignore any
+           recent requests to do so.  */
+	ResetEvent(pipe->tryReadEvent);
+
+	ReleaseMutex(pipe->mutex);
+
+	if (PipeGetFlags(pipe) & PIPE_CLOSED) {
+	    break;
+	}
+
+	/* Post a message to wake up the event loop.  */
+	PostMessage(pipeHwnd, PIPE_MESSAGE, 0, (LPARAM) pipe);
+    }
+
+    /* PipeCloseProc will set PIPE_CLOSED when the pipe is ready to be
+       closed and freed.  */
+
+    CloseHandle(pipe->flagsMutex);
+    CloseHandle(pipe->tryReadEvent);
+    CloseHandle(pipe->mutex);
+    ckfree((char *)pipe);
+    return 0;
+}
+
+/* CYGNUS LOCAL: This function is called when the PipeThread posts a
+   message.  */
+
+static LRESULT CALLBACK
+PipeProc(hwnd, message, wParam, lParam)
+    HWND hwnd;
+    UINT message;
+    WPARAM wParam;
+    LPARAM lParam;
+{
+    if (message != PIPE_MESSAGE) {
+	return DefWindowProc(hwnd, message, wParam, lParam);
+    }
+
+    /* This function really only exists to wake up the event loop.  We
+       don't actually have to do anything.  */
+
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeInit --
+ *
+ *	This function initializes the static variables for this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeInit()
+{
+    WNDCLASS class;
+
+    initialized = 1;
+    firstPipePtr = NULL;
+    procList = NULL;
+    Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
+    Tcl_CreateExitHandler(PipeExitHandler, NULL);
+
+    /* CYGNUS LOCAL: Create a window for asynchronous notification.  */
+
+    class.style = 0;
+    class.cbClsExtra = 0;
+    class.cbWndExtra = 0;
+    class.hInstance = TclWinGetTclInstance();
+    class.hbrBackground = NULL;
+    class.lpszMenuName = NULL;
+    class.lpszClassName = "TclPipe";
+    class.lpfnWndProc = PipeProc;
+    class.hIcon = NULL;
+    class.hCursor = NULL;
+
+    if (RegisterClass(&class)) {
+	pipeHwnd = CreateWindow("TclPipe", "TclPipe", WS_TILED, 0, 0,
+		0, 0, NULL, NULL, class.hInstance, NULL);
+    } else {
+	pipeHwnd = NULL;
+	TclWinConvertError(GetLastError());
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeExitHandler --
+ *
+ *	This function is called to cleanup the pipe module before
+ *	Tcl is unloaded.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes the pipe event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeExitHandler(clientData)
+    ClientData clientData;	/* Old window proc */
+{
+    Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
+    initialized = 0;
+    /* CYGNUS LOCAL: Delete the window.  */
+    UnregisterClass("TclPipe", TclWinGetTclInstance());
+    if (pipeHwnd != NULL) {
+	DestroyWindow(pipeHwnd);
+	pipeHwnd = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeSetupProc --
+ *
+ *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ *	for an event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PipeSetupProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    PipeInfo *infoPtr;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Check to see if there is a watched pipe.  If so, poll.
+     */
+
+    for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	/* CYGNUS LOCAL: Only poll for a readable pipe if it really is
+           readable.  */
+	if ((infoPtr->watchMask &~ TCL_READABLE)
+	    || ((infoPtr->watchMask & TCL_READABLE)
+		&& ((PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) == 0
+		    || (PipeGetFlags(infoPtr) & PIPE_READABLE)))) {
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
+	} else if (infoPtr->watchMask & TCL_READABLE) {
+	    /* CYGNUS LOCAL: Tell the thread to try a read, and let us
+               know when it is done.  */
+	    SetEvent(infoPtr->tryReadEvent);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeCheckProc --
+ *
+ *	This procedure is called by Tcl_DoOneEvent to check the pipe
+ *	event source for events. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeCheckProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    PipeInfo *infoPtr;
+    PipeEvent *evPtr;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Queue events for any watched pipes that don't already have events
+     * queued.
+     */
+
+    for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	/* CYGNUS LOCAL: Only poll for a readable pipe if it really is
+           readable.  */
+	if (((infoPtr->watchMask &~ TCL_READABLE)
+	    || ((infoPtr->watchMask & TCL_READABLE)
+		&& ((PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) == 0
+		    || (PipeGetFlags(infoPtr) & PIPE_READABLE))))
+	    && !(PipeGetFlags(infoPtr) & PIPE_PENDING)) {
+	    PipeSetFlag(infoPtr, PIPE_PENDING);
+	    evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
+	    evPtr->header.proc = PipeEventProc;
+	    evPtr->infoPtr = infoPtr;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeFile --
+ *
+ *	This function constructs a new TclFile from a given data and
+ *	type value.
+ *
+ * Results:
+ *	Returns a newly allocated WinFile as a TclFile.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TclFile
+MakeFile(handle)
+    HANDLE handle;		/* Type-specific data. */
+{
+    WinFile *filePtr;
+
+    filePtr = (WinFile *) ckalloc(sizeof(WinFile));
+    filePtr->type = WIN_FILE;
+    filePtr->handle = handle;
+
+    return (TclFile)filePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    HANDLE handle;
+
+    if (Tcl_GetChannelHandle(channel, direction, 
+	    (ClientData *) &handle) == TCL_OK) {
+	return MakeFile(handle);
+    } else {
+	return (TclFile) NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TempFileName --
+ *
+ *	Gets a temporary file name and deals with the fact that the
+ *	temporary file path provided by Windows may not actually exist
+ *	if the TMP or TEMP environment variables refer to a 
+ *	non-existent directory.
+ *
+ * Results:    
+ *	0 if error, non-zero otherwise.  If non-zero is returned, the
+ *	name buffer will be filled with a name that can be used to 
+ *	construct a temporary file.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TempFileName(name)
+    char name[MAX_PATH];	/* Buffer in which name for temporary 
+				 * file gets stored. */
+{
+    if ((GetTempPath(MAX_PATH, name) == 0) ||
+	    (GetTempFileName(name, "TCL", 0, name) == 0)) {
+	name[0] = '.';
+	name[1] = '\0';
+	if (GetTempFileName(name, "TCL", 0, name) == 0) {
+	    return 0;
+	}
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateTempFile --
+ *
+ *	This function opens a unique file with the property that it
+ *	will be deleted when its file handle is closed.  The temporary
+ *	file is created in the system temporary directory.
+ *
+ * Results:
+ *	Returns a valid TclFile, or NULL on failure.
+ *
+ * Side effects:
+ *	Creates a new temporary file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 name[MAX_PATH];
+    HANDLE handle;
+
+    if (TempFileName(name) == 0) {
+	return NULL;
+    }
+
+    handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, NULL,
+	    CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE,
+	    NULL);
+    if (handle == INVALID_HANDLE_VALUE) {
+	goto error;
+    }
+
+    /*
+     * Write the file out, doing line translations on the way.
+     */
+
+    if (contents != NULL) {
+	DWORD result, length;
+	char *p;
+	
+	for (p = contents; *p != '\0'; p++) {
+	    if (*p == '\n') {
+		length = p - contents;
+		if (length > 0) {
+		    if (!WriteFile(handle, contents, length, &result, NULL)) {
+			goto error;
+		    }
+		}
+		if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
+		    goto error;
+		}
+		contents = p+1;
+	    }
+	}
+	length = p - contents;
+	if (length > 0) {
+	    if (!WriteFile(handle, contents, length, &result, NULL)) {
+		goto error;
+	    }
+	}
+    }
+
+    if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
+	goto error;
+    }
+
+    if (namePtr != NULL) {
+        Tcl_DStringAppend(namePtr, name, -1);
+    }
+
+    /*
+     * Under Win32s a file created with FILE_FLAG_DELETE_ON_CLOSE won't
+     * actually be deleted when it is closed, so we have to do it ourselves.
+     */
+
+    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
+	TmpFile *tmpFilePtr = (TmpFile *) ckalloc(sizeof(TmpFile));
+	tmpFilePtr->file.type = WIN32S_TMPFILE;
+	tmpFilePtr->file.handle = handle;
+	strcpy(tmpFilePtr->name, name);
+	return (TclFile)tmpFilePtr;
+    } else {
+	return MakeFile(handle);
+    }
+
+  error:
+    TclWinConvertError(GetLastError());
+    CloseHandle(handle);
+    DeleteFile(name);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFile --
+ *
+ *	This function opens files for use in a pipeline.
+ *
+ * Results:
+ *	Returns a newly allocated TclFile structure containing the
+ *	file handle.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpOpenFile(path, mode)
+    char *path;
+    int mode;
+{
+    HANDLE handle;
+    DWORD accessMode, createMode, shareMode, flags;
+    SECURITY_ATTRIBUTES sec;
+
+    /*
+     * Map the access bits to the NT access mode.
+     */
+
+    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+	case O_RDONLY:
+	    accessMode = GENERIC_READ;
+	    break;
+	case O_WRONLY:
+	    accessMode = GENERIC_WRITE;
+	    break;
+	case O_RDWR:
+	    accessMode = (GENERIC_READ | GENERIC_WRITE);
+	    break;
+	default:
+	    TclWinConvertError(ERROR_INVALID_FUNCTION);
+	    return NULL;
+    }
+
+    /*
+     * Map the creation flags to the NT create mode.
+     */
+
+    switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
+	case (O_CREAT | O_EXCL):
+	case (O_CREAT | O_EXCL | O_TRUNC):
+	    createMode = CREATE_NEW;
+	    break;
+	case (O_CREAT | O_TRUNC):
+	    createMode = CREATE_ALWAYS;
+	    break;
+	case O_CREAT:
+	    createMode = OPEN_ALWAYS;
+	    break;
+	case O_TRUNC:
+	case (O_TRUNC | O_EXCL):
+	    createMode = TRUNCATE_EXISTING;
+	    break;
+	default:
+	    createMode = OPEN_EXISTING;
+	    break;
+    }
+
+    /*
+     * If the file is not being created, use the existing file attributes.
+     */
+
+    flags = 0;
+    if (!(mode & O_CREAT)) {
+	flags = GetFileAttributes(path);
+	if (flags == 0xFFFFFFFF) {
+	    flags = 0;
+	}
+    }
+
+    /*
+     * Set up the security attributes so this file is not inherited by
+     * child processes.
+     */
+
+    sec.nLength = sizeof(sec);
+    sec.lpSecurityDescriptor = NULL;
+    sec.bInheritHandle = 0;
+
+    /*
+     * Set up the file sharing mode.  We want to allow simultaneous access.
+     */
+
+    shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
+
+    /*
+     * Now we get to create the file.
+     */
+
+    handle = CreateFile(path, accessMode, shareMode, &sec, createMode, flags,
+            (HANDLE) NULL);
+    if (handle == INVALID_HANDLE_VALUE) {
+	DWORD err = GetLastError();
+	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
+	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
+	}
+        TclWinConvertError(err);
+        return NULL;
+    }
+
+    /*
+     * Seek to the end of file if we are writing.
+     */
+
+    if (mode & O_WRONLY) {
+	SetFilePointer(handle, 0, NULL, FILE_END);
+    }
+
+    return MakeFile(handle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreatePipe --
+ *
+ *      Creates an anonymous pipe.  Under Win32s, creates a temp file
+ *	that is used to simulate a pipe.
+ *
+ * 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. */
+{
+    HANDLE readHandle, writeHandle;
+
+    if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
+	*readPipe = MakeFile(readHandle);
+	*writePipe = MakeFile(writeHandle);
+	return 1;
+    }
+
+    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
+	WinPipe *readPipePtr, *writePipePtr;
+	char buf[MAX_PATH];
+
+	if (TempFileName(buf) != 0) {
+	    readPipePtr = (WinPipe *) ckalloc(sizeof(WinPipe));
+	    writePipePtr = (WinPipe *) ckalloc(sizeof(WinPipe));
+
+	    readPipePtr->file.type = WIN32S_PIPE;
+	    readPipePtr->otherPtr = writePipePtr;
+	    readPipePtr->fileName = strcpy(ckalloc(strlen(buf) + 1), buf);
+	    readPipePtr->file.handle = INVALID_HANDLE_VALUE;
+	    writePipePtr->file.type = WIN32S_PIPE;
+	    writePipePtr->otherPtr = readPipePtr;
+	    writePipePtr->fileName = readPipePtr->fileName;
+	    writePipePtr->file.handle = INVALID_HANDLE_VALUE;
+
+	    *readPipe = (TclFile)readPipePtr;
+	    *writePipe = (TclFile)writePipePtr;
+
+	    return 1;
+	}
+    }
+
+    TclWinConvertError(GetLastError());
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCloseFile --
+ *
+ *	Closes a pipeline file handle.  These handles are created by
+ *	TclpOpenFile, TclpCreatePipe, or TclpMakeFile.
+ *
+ * Results:
+ *	0 on success, -1 on failure.
+ *
+ * Side effects:
+ *	The file is closed and deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCloseFile(file)
+    TclFile file;	/* The file to close. */
+{
+    WinFile *filePtr = (WinFile *) file;
+    WinPipe *pipePtr;
+
+    switch (filePtr->type) {
+	case WIN_FILE:
+	case WIN32S_TMPFILE:
+	    if (CloseHandle(filePtr->handle) == FALSE) {
+		TclWinConvertError(GetLastError());
+		ckfree((char *) filePtr);
+		return -1;
+	    }
+	    /*
+	     * Simulate deleting the file on close for Win32s.
+	     */
+
+	    if (filePtr->type == WIN32S_TMPFILE) {
+		DeleteFile(((TmpFile*)filePtr)->name);
+	    }
+	    break;
+
+	case WIN32S_PIPE:
+	    pipePtr = (WinPipe *) file;
+
+	    if (pipePtr->otherPtr != NULL) {
+		pipePtr->otherPtr->otherPtr = NULL;
+	    } else {
+		if (pipePtr->file.handle != INVALID_HANDLE_VALUE) {
+		    CloseHandle(pipePtr->file.handle);
+		}
+		DeleteFile(pipePtr->fileName);
+		ckfree((char *) pipePtr->fileName);
+	    }
+	    break;
+
+	default:
+	    panic("Tcl_CloseFile: unexpected file type");
+    }
+
+    ckfree((char *) filePtr);
+    return 0;
+}
+
+/*
+ *--------------------------------------------------------------------------
+ *
+ * TclpGetPid --
+ *
+ *	Given a HANDLE to a child process, return the process id for that
+ *	child process.
+ *
+ * Results:
+ *	Returns the process id for the child process.  If the pid was not 
+ *	known by Tcl, either because the pid was not created by Tcl or the 
+ *	child process has already been reaped, -1 is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetPid(pid)
+    Tcl_Pid pid;		/* The HANDLE of the child process. */
+{
+    ProcInfo *infoPtr;
+    
+    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->hProcess == (HANDLE) pid) {
+	    return infoPtr->dwProcessId;
+	}
+    }
+    return (unsigned long) -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateProcess --
+ *
+ *	Create a child process that has the specified files as its 
+ *	standard input, output, and error.  The child process runs
+ *	synchronously under Win32s and asynchronously under Windows NT
+ *	and Windows 95, and runs with the same environment variables
+ *	as the creating process.
+ *
+ *	The complete Windows search path is searched to find the specified 
+ *	executable.  If an executable by the given name is not found, 
+ *	automatically tries appending ".com", ".exe", and ".bat" to the 
+ *	executable name.
+ *
+ * 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.
+ *	
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    int result, applType, createFlags;
+    Tcl_DString cmdLine;
+    STARTUPINFO startInfo;
+    PROCESS_INFORMATION procInfo;
+    SECURITY_ATTRIBUTES secAtts;
+    HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
+    char execPath[MAX_PATH];
+    char *originalName;
+    WinFile *filePtr;
+
+    if (!initialized) {
+	PipeInit();
+    }
+
+    applType = ApplicationType(interp, argv[0], execPath);
+    if (applType == APPL_NONE) {
+	return TCL_ERROR;
+    }
+    originalName = argv[0];
+    argv[0] = execPath;
+
+    result = TCL_ERROR;
+    Tcl_DStringInit(&cmdLine);
+
+    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
+	/*
+	 * Under Win32s, there are no pipes.  In order to simulate pipe
+	 * behavior, the child processes are run synchronously and their
+	 * I/O is redirected from/to temporary files before the next 
+	 * stage of the pipeline is started.
+	 */
+
+	MSG msg;
+	DWORD status;
+	DWORD args[4];
+	void *trans[5];
+	char *inputFileName, *outputFileName;
+	Tcl_DString inputTempFile, outputTempFile;
+
+	BuildCommandLine(argc, argv, &cmdLine);
+
+	ZeroMemory(&startInfo, sizeof(startInfo));
+	startInfo.cb = sizeof(startInfo);
+
+	Tcl_DStringInit(&inputTempFile);
+	Tcl_DStringInit(&outputTempFile);
+	outputHandle = INVALID_HANDLE_VALUE;
+
+	inputFileName = NULL;
+	outputFileName = NULL;
+	if (inputFile != NULL) {
+	    filePtr = (WinFile *) inputFile;
+	    switch (filePtr->type) {
+		case WIN_FILE:
+		case WIN32S_TMPFILE: {
+		    h = INVALID_HANDLE_VALUE;
+		    inputFileName = MakeTempFile(&inputTempFile);
+		    if (inputFileName != NULL) {
+			h = CreateFile(inputFileName, GENERIC_WRITE, 0, 
+				NULL, CREATE_ALWAYS, 0, NULL);
+		    }
+		    if (h == INVALID_HANDLE_VALUE) {
+			Tcl_AppendResult(interp, "couldn't duplicate input handle: ", 
+				Tcl_PosixError(interp), (char *) NULL);
+			goto end32s;
+		    }
+		    CopyChannel(h, filePtr->handle);
+		    CloseHandle(h);
+		    break;
+		}
+		case WIN32S_PIPE: {
+		    inputFileName = ((WinPipe*)inputFile)->fileName;
+		    break;
+		}
+	    }
+	}
+	if (inputFileName == NULL) {
+	    inputFileName = "nul";
+	}
+	if (outputFile != NULL) {
+	    filePtr = (WinFile *)outputFile;
+	    if (filePtr->type == WIN_FILE) {
+		outputFileName = MakeTempFile(&outputTempFile);
+		if (outputFileName == NULL) {
+		    Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
+			    Tcl_PosixError(interp), (char *) NULL);
+		    goto end32s;
+		}
+		outputHandle = filePtr->handle;
+	    } else if (filePtr->type == WIN32S_PIPE) {
+		outputFileName = ((WinPipe*)outputFile)->fileName;
+	    }
+	}
+	if (outputFileName == NULL) {
+	    outputFileName = "nul";
+	}
+
+	if (applType == APPL_DOS) {
+	    args[0] = (DWORD) Tcl_DStringValue(&cmdLine);
+	    args[1] = (DWORD) inputFileName;
+	    args[2] = (DWORD) outputFileName;
+	    trans[0] = &args[0];
+	    trans[1] = &args[1];
+	    trans[2] = &args[2];
+	    trans[3] = NULL;
+	    if (TclWinSynchSpawn(args, 0, trans, pidPtr) != 0) {
+		result = TCL_OK;
+	    }
+	} else if (applType == APPL_WIN3X) {
+	    args[0] = (DWORD) Tcl_DStringValue(&cmdLine);
+	    trans[0] = &args[0];
+	    trans[1] = NULL;
+	    if (TclWinSynchSpawn(args, 1, trans, pidPtr) != 0) {
+		result = TCL_OK;
+	    }
+	} else {
+	    if (CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL, 
+		    FALSE, DETACHED_PROCESS, NULL, NULL, &startInfo, 
+		    &procInfo) != 0) {
+		CloseHandle(procInfo.hThread);
+		while (1) {
+		    if (GetExitCodeProcess(procInfo.hProcess, &status) == FALSE) {
+			break;
+		    }
+		    if (status != STILL_ACTIVE) {
+			break;
+		    }
+		    if (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) == TRUE) {
+			TranslateMessage(&msg);
+			DispatchMessage(&msg);
+		    }
+		}
+		*pidPtr = (Tcl_Pid) procInfo.hProcess;
+		if (*pidPtr != 0) {
+		    ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
+		    procPtr->hProcess = procInfo.hProcess;
+		    procPtr->dwProcessId = procInfo.dwProcessId;
+		    procPtr->nextPtr = procList;
+		    procList = procPtr;
+		}
+		result = TCL_OK;
+	    }
+	}
+	if (result != TCL_OK) {
+	    TclWinConvertError(GetLastError());
+	    Tcl_AppendResult(interp, "couldn't execute \"", originalName,
+		    "\": ", Tcl_PosixError(interp), (char *) NULL);
+	}
+
+	end32s:
+	if (outputHandle != INVALID_HANDLE_VALUE) {
+	    /*
+	     * Now copy stuff from temp file to actual output handle. Don't
+	     * close outputHandle because it is associated with the output
+	     * file owned by the caller.
+	     */
+
+	    h = CreateFile(outputFileName, GENERIC_READ, 0, NULL, OPEN_ALWAYS,
+		    0, NULL);
+	    if (h != INVALID_HANDLE_VALUE) {
+		CopyChannel(outputHandle, h);
+	    }
+	    CloseHandle(h);
+	}
+
+	if (inputFileName == Tcl_DStringValue(&inputTempFile)) {
+	    DeleteFile(inputFileName);
+	}
+	
+	if (outputFileName == Tcl_DStringValue(&outputTempFile)) {
+	    DeleteFile(outputFileName);
+	}
+
+	Tcl_DStringFree(&inputTempFile);
+	Tcl_DStringFree(&outputTempFile);
+        Tcl_DStringFree(&cmdLine);
+	return result;
+    }
+    hProcess = GetCurrentProcess();
+
+    /*
+     * STARTF_USESTDHANDLES must be used to pass handles to child process.
+     * Using SetStdHandle() and/or dup2() only works when a console mode 
+     * parent process is spawning an attached console mode child process.
+     */
+
+    ZeroMemory(&startInfo, sizeof(startInfo));
+    startInfo.cb = sizeof(startInfo);
+    startInfo.dwFlags   = STARTF_USESTDHANDLES;
+    startInfo.hStdInput	= INVALID_HANDLE_VALUE;
+    startInfo.hStdOutput= INVALID_HANDLE_VALUE;
+    startInfo.hStdError = INVALID_HANDLE_VALUE;
+
+    secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
+    secAtts.lpSecurityDescriptor = NULL;
+    secAtts.bInheritHandle = TRUE;
+
+    /*
+     * We have to check the type of each file, since we cannot duplicate 
+     * some file types.  
+     */
+
+    inputHandle = INVALID_HANDLE_VALUE;
+    if (inputFile != NULL) {
+	filePtr = (WinFile *)inputFile;
+	if (filePtr->type == WIN_FILE) {
+	    inputHandle = filePtr->handle;
+	}
+    }
+    outputHandle = INVALID_HANDLE_VALUE;
+    if (outputFile != NULL) {
+	filePtr = (WinFile *)outputFile;
+	if (filePtr->type == WIN_FILE) {
+	    outputHandle = filePtr->handle;
+	}
+    }
+    errorHandle = INVALID_HANDLE_VALUE;
+    if (errorFile != NULL) {
+	filePtr = (WinFile *)errorFile;
+	if (filePtr->type == WIN_FILE) {
+	    errorHandle = filePtr->handle;
+	}
+    }
+
+    /*
+     * Duplicate all the handles which will be passed off as stdin, stdout
+     * and stderr of the child process. The duplicate handles are set to
+     * be inheritable, so the child process can use them.
+     */
+
+    if (inputHandle == INVALID_HANDLE_VALUE) {
+	/* 
+	 * If handle was not set, stdin should return immediate EOF.
+	 * Under Windows95, some applications (both 16 and 32 bit!) 
+	 * cannot read from the NUL device; they read from console
+	 * instead.  When running tk, this is fatal because the child 
+	 * process would hang forever waiting for EOF from the unmapped 
+	 * console window used by the helper application.
+	 *
+	 * Fortunately, the helper application detects a closed pipe 
+	 * as an immediate EOF and can pass that information to the 
+	 * child process.
+	 */
+
+	if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
+	    CloseHandle(h);
+	}
+    } else {
+	DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
+		0, TRUE, DUPLICATE_SAME_ACCESS);
+    }
+    if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
+	TclWinConvertError(GetLastError());
+	Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
+		Tcl_PosixError(interp), (char *) NULL);
+	goto end;
+    }
+
+    if (outputHandle == INVALID_HANDLE_VALUE) {
+	/*
+	 * If handle was not set, output should be sent to an infinitely 
+	 * deep sink.  Under Windows 95, some 16 bit applications cannot
+	 * have stdout redirected to NUL; they send their output to
+	 * the console instead.  Some applications, like "more" or "dir /p", 
+	 * when outputting multiple pages to the console, also then try and
+	 * read from the console to go the next page.  When running tk, this
+	 * is fatal because the child process would hang forever waiting
+	 * for input from the unmapped console window used by the helper
+	 * application.
+	 *
+	 * Fortunately, the helper application will detect a closed pipe
+	 * as a sink.
+	 */
+
+	if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) 
+		&& (applType == APPL_DOS)) {
+	    if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
+		CloseHandle(h);
+	    }
+	} else {
+	    startInfo.hStdOutput = CreateFile("NUL:", GENERIC_WRITE, 0,
+		    &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
+	}
+    } else {
+	DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 
+		0, TRUE, DUPLICATE_SAME_ACCESS);
+    }
+    if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
+	TclWinConvertError(GetLastError());
+	Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
+		Tcl_PosixError(interp), (char *) NULL);
+	goto end;
+    }
+
+    if (errorHandle == INVALID_HANDLE_VALUE) {
+	/*
+	 * If handle was not set, errors should be sent to an infinitely
+	 * deep sink.
+	 */
+
+	startInfo.hStdError = CreateFile("NUL:", GENERIC_WRITE, 0,
+		&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+    } else {
+	DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 
+		0, TRUE, DUPLICATE_SAME_ACCESS);
+    } 
+    if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
+	TclWinConvertError(GetLastError());
+	Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
+		Tcl_PosixError(interp), (char *) NULL);
+	goto end;
+    }
+    /* 
+     * If we do not have a console window, then we must run DOS and
+     * WIN32 console mode applications as detached processes. This tells
+     * the loader that the child application should not inherit the
+     * console, and that it should not create a new console window for
+     * the child application.  The child application should get its stdio 
+     * from the redirection handles provided by this application, and run
+     * in the background.
+     *
+     * If we are starting a GUI process, they don't automatically get a 
+     * console, so it doesn't matter if they are started as foreground or
+     * detached processes.  The GUI window will still pop up to the
+     * foreground.
+     */
+
+    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+	if (HasConsole()) {
+	    createFlags = 0;
+	} else if (applType == APPL_DOS) {
+	    /*
+	     * Under NT, 16-bit DOS applications will not run unless they
+	     * can be attached to a console.  If we are running without a
+	     * console, run the 16-bit program as an normal process inside
+	     * of a hidden console application, and then run that hidden
+	     * console as a detached process.
+	     */
+
+	    startInfo.wShowWindow = SW_HIDE;
+	    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
+	    createFlags = CREATE_NEW_CONSOLE;
+	    Tcl_DStringAppend(&cmdLine, "cmd.exe /c ", -1);
+	} else {
+	    createFlags = DETACHED_PROCESS;
+	} 
+    } else {
+	if (HasConsole()) {
+	    createFlags = 0;
+	} else {
+	    createFlags = DETACHED_PROCESS;
+	}
+	
+	if (applType == APPL_DOS) {
+	    /*
+	     * Under Windows 95, 16-bit DOS applications do not work well 
+	     * with pipes:
+	     *
+	     * 1. EOF on a pipe between a detached 16-bit DOS application 
+	     * and another application is not seen at the other
+	     * end of the pipe, so the listening process blocks forever on 
+	     * reads.  This inablity to detect EOF happens when either a 
+	     * 16-bit app or the 32-bit app is the listener.  
+	     *
+	     * 2. If a 16-bit DOS application (detached or not) blocks when 
+	     * writing to a pipe, it will never wake up again, and it
+	     * eventually brings the whole system down around it.
+	     *
+	     * The 16-bit application is run as a normal process inside
+	     * of a hidden helper console app, and this helper may be run
+	     * as a detached process.  If any of the stdio handles is
+	     * a pipe, the helper application accumulates information 
+	     * into temp files and forwards it to or from the DOS 
+	     * application as appropriate.  This means that DOS apps 
+	     * must receive EOF from a stdin pipe before they will actually
+	     * begin, and must finish generating stdout or stderr before 
+	     * the data will be sent to the next stage of the pipe.
+	     *
+	     * The helper app should be located in the same directory as
+	     * the tcl dll.
+	     */
+
+	    if (createFlags != 0) {
+		startInfo.wShowWindow = SW_HIDE;
+		startInfo.dwFlags |= STARTF_USESHOWWINDOW;
+		createFlags = CREATE_NEW_CONSOLE;
+	    }
+	    /* CYGNUS LOCAL: We name the DLL cygtclpip.  */
+	    Tcl_DStringAppend(&cmdLine, "cygtclpip" STRINGIFY(TCL_MAJOR_VERSION) 
+		    STRINGIFY(TCL_MINOR_VERSION) ".dll ", -1);
+	}
+    }
+    
+    /*
+     * cmdLine gets the full command line used to invoke the executable,
+     * including the name of the executable itself.  The command line
+     * arguments in argv[] are stored in cmdLine separated by spaces. 
+     * Special characters in individual arguments from argv[] must be 
+     * quoted when being stored in cmdLine.
+     *
+     * When calling any application, bear in mind that arguments that 
+     * specify a path name are not converted.  If an argument contains 
+     * forward slashes as path separators, it may or may not be 
+     * recognized as a path name, depending on the program.  In general,
+     * most applications accept forward slashes only as option 
+     * delimiters and backslashes only as paths.
+     *
+     * Additionally, when calling a 16-bit dos or windows application, 
+     * all path names must use the short, cryptic, path format (e.g., 
+     * using ab~1.def instead of "a b.default").  
+     */
+
+    BuildCommandLine(argc, argv, &cmdLine);
+
+    if (!CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, 
+	    createFlags, NULL, NULL, &startInfo, &procInfo)) {
+	TclWinConvertError(GetLastError());
+	Tcl_AppendResult(interp, "couldn't execute \"", originalName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	goto end;
+    }
+
+    if (applType == APPL_DOS) {
+	WaitForSingleObject(hProcess, 50);
+    }
+
+    /* 
+     * "When an application spawns a process repeatedly, a new thread 
+     * instance will be created for each process but the previous 
+     * instances may not be cleaned up.  This results in a significant 
+     * virtual memory loss each time the process is spawned.  If there 
+     * is a WaitForInputIdle() call between CreateProcess() and
+     * CloseHandle(), the problem does not occur." PSS ID Number: Q124121
+     */
+
+    WaitForInputIdle(procInfo.hProcess, 5000);
+    CloseHandle(procInfo.hThread);
+
+    *pidPtr = (Tcl_Pid) procInfo.hProcess;
+    if (*pidPtr != 0) {
+	ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
+	procPtr->hProcess = procInfo.hProcess;
+	procPtr->dwProcessId = procInfo.dwProcessId;
+	procPtr->nextPtr = procList;
+	procList = procPtr;
+    }
+    result = TCL_OK;
+
+    end:
+    Tcl_DStringFree(&cmdLine);
+    if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
+        CloseHandle(startInfo.hStdInput);
+    }
+    if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
+        CloseHandle(startInfo.hStdOutput);
+    }
+    if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
+	CloseHandle(startInfo.hStdError);
+    }
+    return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HasConsole --
+ *
+ *	Determines whether the current application is attached to a
+ *	console.
+ *
+ * Results:
+ *	Returns TRUE if this application has a console, else FALSE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static BOOL
+HasConsole()
+{
+    HANDLE handle = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
+	    NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+
+    if (handle != INVALID_HANDLE_VALUE) {
+        CloseHandle(handle);
+	return TRUE;
+    } else {
+        return FALSE;
+    }
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * ApplicationType --
+ *
+ *	Search for the specified program and identify if it refers to a DOS,
+ *	Windows 3.X, or Win32 program.  Used to determine how to invoke 
+ *	a program, or if it can even be invoked.
+ *
+ *	It is possible to almost positively identify DOS and Windows 
+ *	applications that contain the appropriate magic numbers.  However, 
+ *	DOS .com files do not seem to contain a magic number; if the program 
+ *	name ends with .com and could not be identified as a Windows .com
+ *	file, it will be assumed to be a DOS application, even if it was
+ *	just random data.  If the program name does not end with .com, no 
+ *	such assumption is made.
+ *
+ *	The Win32 procedure GetBinaryType incorrectly identifies any 
+ *	junk file that ends with .exe as a dos executable and some 
+ *	executables that don't end with .exe as not executable.  Plus it 
+ *	doesn't exist under win95, so I won't feel bad about reimplementing
+ *	functionality.
+ *
+ * Results:
+ *	The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32
+ *	if the filename referred to the corresponding application type.
+ *	If the file name could not be found or did not refer to any known 
+ *	application type, APPL_NONE is returned and an error message is 
+ *	left in interp.  .bat files are identified as APPL_DOS.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ApplicationType(interp, originalName, fullPath)
+    Tcl_Interp *interp;		/* Interp, for error message. */
+    const char *originalName;	/* Name of the application to find. */
+    char fullPath[MAX_PATH];	/* Filled with complete path to 
+				 * application. */
+{
+    int applType, i;
+    HANDLE hFile;
+    char *ext, *rest;
+    char buf[2];
+    DWORD read;
+    IMAGE_DOS_HEADER header;
+    static char extensions[][5] = {"", ".com", ".exe", ".bat"};
+
+    /* Look for the program as an external program.  First try the name
+     * as it is, then try adding .com, .exe, and .bat, in that order, to
+     * the name, looking for an executable.
+     *
+     * Using the raw SearchPath() procedure doesn't do quite what is 
+     * necessary.  If the name of the executable already contains a '.' 
+     * character, it will not try appending the specified extension when
+     * searching (in other words, SearchPath will not find the program 
+     * "a.b.exe" if the arguments specified "a.b" and ".exe").   
+     * So, first look for the file as it is named.  Then manually append 
+     * the extensions, looking for a match.  
+     */
+
+    applType = APPL_NONE;
+    for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
+	lstrcpyn(fullPath, originalName, MAX_PATH - 5);
+        lstrcat(fullPath, extensions[i]);
+	
+	SearchPath(NULL, fullPath, NULL, MAX_PATH, fullPath, &rest);
+
+	/*
+	 * Ignore matches on directories or data files, return if identified
+	 * a known type.
+	 */
+
+	if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) {
+	    continue;
+	}
+
+	ext = strrchr(fullPath, '.');
+	if ((ext != NULL) && (strcmpi(ext, ".bat") == 0)) {
+	    applType = APPL_DOS;
+	    break;
+	}
+
+	hFile = CreateFile(fullPath, GENERIC_READ, FILE_SHARE_READ, NULL, 
+		OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+	if (hFile == INVALID_HANDLE_VALUE) {
+	    continue;
+	}
+
+	header.e_magic = 0;
+	ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
+	if (header.e_magic != IMAGE_DOS_SIGNATURE) {
+	    /* 
+	     * Doesn't have the magic number for relocatable executables.  If 
+	     * filename ends with .com, assume it's a DOS application anyhow.
+	     * Note that we didn't make this assumption at first, because some
+	     * supposed .com files are really 32-bit executables with all the
+	     * magic numbers and everything.  
+	     */
+
+	    CloseHandle(hFile);
+	    if ((ext != NULL) && (strcmpi(ext, ".com") == 0)) {
+		applType = APPL_DOS;
+		break;
+	    }
+	    continue;
+	}
+	if (header.e_lfarlc != sizeof(header)) {
+	    /* 
+	     * All Windows 3.X and Win32 and some DOS programs have this value
+	     * set here.  If it doesn't, assume that since it already had the 
+	     * other magic number it was a DOS application.
+	     */
+
+	    CloseHandle(hFile);
+	    applType = APPL_DOS;
+	    break;
+	}
+
+	/* 
+	 * The DWORD at header.e_lfanew points to yet another magic number.
+	 */
+
+	buf[0] = '\0';
+	SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
+	ReadFile(hFile, (void *) buf, 2, &read, NULL);
+	CloseHandle(hFile);
+
+	if ((buf[0] == 'N') && (buf[1] == 'E')) {
+	    applType = APPL_WIN3X;
+	} else if ((buf[0] == 'P') && (buf[1] == 'E')) {
+	    applType = APPL_WIN32;
+	} else {
+	    /*
+	     * Strictly speaking, there should be a test that there
+	     * is an 'L' and 'E' at buf[0..1], to identify the type as 
+	     * DOS, but of course we ran into a DOS executable that 
+	     * _doesn't_ have the magic number -- specifically, one
+	     * compiled using the Lahey Fortran90 compiler.
+	     */
+
+	    applType = APPL_DOS;
+	}
+	break;
+    }
+
+    if (applType == APPL_NONE) {
+	TclWinConvertError(GetLastError());
+	Tcl_AppendResult(interp, "couldn't execute \"", originalName,
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	return APPL_NONE;
+    }
+
+    if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
+	/* 
+	 * Replace long path name of executable with short path name for 
+	 * 16-bit applications.  Otherwise the application may not be able
+	 * to correctly parse its own command line to separate off the 
+	 * application name from the arguments.
+	 */
+
+	GetShortPathName(fullPath, fullPath, MAX_PATH);
+    }
+    return applType;
+}
+
+/*    
+ *----------------------------------------------------------------------
+ *
+ * BuildCommandLine --
+ *
+ *	The command line arguments are stored in linePtr separated
+ *	by spaces, in a form that CreateProcess() understands.  Special 
+ *	characters in individual arguments from argv[] must be quoted 
+ *	when being stored in cmdLine.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BuildCommandLine(argc, argv, linePtr)
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+    Tcl_DString *linePtr;	/* Initialized Tcl_DString that receives the
+				 * command line. */
+{
+    char *start, *special;
+    int quote, i;
+
+    for (i = 0; i < argc; i++) {
+	if (i > 0) {
+	    Tcl_DStringAppend(linePtr, " ", 1);	
+	}
+
+	quote = 0;
+	if (argv[i][0] == '\0') {
+	    quote = 1;
+	} else {
+	    for (start = argv[i]; *start != '\0'; start++) {
+		if (isspace(*start)) {
+		    quote = 1;
+		    break;
+		}
+	    }
+	}
+	if (quote) {
+	    Tcl_DStringAppend(linePtr, "\"", 1);
+	}
+
+	start = argv[i];	    
+	for (special = argv[i]; ; ) {
+	    if ((*special == '\\') && 
+		    (special[1] == '\\' || special[1] == '"')) {
+		Tcl_DStringAppend(linePtr, start, special - start);
+		start = special;
+		while (1) {
+		    special++;
+		    if (*special == '"') {
+			/* 
+			 * N backslashes followed a quote -> insert 
+			 * N * 2 + 1 backslashes then a quote.
+			 */
+
+			Tcl_DStringAppend(linePtr, start, special - start);
+			break;
+		    }
+		    if (*special != '\\') {
+			break;
+		    }
+		}
+		Tcl_DStringAppend(linePtr, start, special - start);
+		start = special;
+	    }
+	    if (*special == '"') {
+		Tcl_DStringAppend(linePtr, start, special - start);
+		Tcl_DStringAppend(linePtr, "\\\"", 2);
+		start = special + 1;
+	    }
+	    if (*special == '\0') {
+		break;
+	    }
+	    special++;
+	}
+	Tcl_DStringAppend(linePtr, start, special - start);
+	if (quote) {
+	    Tcl_DStringAppend(linePtr, "\"", 1);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeTempFile --
+ *
+ *	Helper function for TclpCreateProcess under Win32s.  Makes a 
+ *	temporary file that _won't_ go away automatically when it's file
+ *	handle is closed.  Used for simulated pipes, which are written
+ *	in one pass and reopened and read in the next pass.
+ *
+ * Results:
+ *	namePtr is filled with the name of the temporary file.
+ *
+ * Side effects:
+ *	A temporary file with the name specified by namePtr is created.  
+ *	The caller is responsible for deleting this temporary file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+MakeTempFile(namePtr)
+    Tcl_DString *namePtr;	/* Initialized Tcl_DString that is filled 
+				 * with the name of the temporary file that 
+				 * was created. */
+{
+    char name[MAX_PATH];
+
+    if (TempFileName(name) == 0) {
+	return NULL;
+    }
+
+    Tcl_DStringAppend(namePtr, name, -1);
+    return Tcl_DStringValue(namePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyChannel --
+ *
+ *	Helper function used by TclpCreateProcess under Win32s.  Copies
+ *	what remains of source file to destination file; source file 
+ *	pointer need not be positioned at the beginning of the file if
+ *	all of source file is not desired, but data is copied up to end 
+ *	of source file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CopyChannel(dst, src)
+    HANDLE dst;			/* Destination file. */
+    HANDLE src;			/* Source file. */
+{
+    char buf[8192];
+    DWORD dwRead, dwWrite;
+
+    while (ReadFile(src, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
+	if (dwRead == 0) {
+	    break;
+	}
+	if (WriteFile(dst, buf, dwRead, &dwWrite, NULL) == FALSE) {
+	    break;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateCommandChannel --
+ *
+ *	This function is called by Tcl_OpenCommandChannel 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
+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. */
+{
+    char channelName[20];
+    int channelId;
+    PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
+
+    if (!initialized) {
+	PipeInit();
+    }
+
+    infoPtr->watchMask = 0;
+    infoPtr->flags = 0;
+    infoPtr->readFile = readFile;
+    infoPtr->writeFile = writeFile;
+    infoPtr->errorFile = errorFile;
+    infoPtr->numPids = numPids;
+    infoPtr->pidPtr = pidPtr;
+
+    /* CYGNUS LOCAL: Mutex for flags.  */
+    infoPtr->flagsMutex = CreateMutex(NULL, FALSE, NULL);
+
+    /*
+     * Use one of the fds associated with the channel as the
+     * channel id.
+     */
+
+    if (readFile) {
+	WinPipe *pipePtr = (WinPipe *) readFile;
+	if (pipePtr->file.type == WIN32S_PIPE
+		&& pipePtr->file.handle == INVALID_HANDLE_VALUE) {
+	    pipePtr->file.handle = CreateFile(pipePtr->fileName, GENERIC_READ,
+		    0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
+	}
+	channelId = (int) pipePtr->file.handle;
+    } else if (writeFile) {
+	channelId = (int) ((WinFile*)writeFile)->handle;
+    } else if (errorFile) {
+	channelId = (int) ((WinFile*)errorFile)->handle;
+    } else {
+	channelId = 0;
+    }
+
+    infoPtr->validMask = 0;
+    if (readFile != NULL) {
+        infoPtr->validMask |= TCL_READABLE;
+    }
+    if (writeFile != NULL) {
+        infoPtr->validMask |= TCL_WRITABLE;
+    }
+
+    /*
+     * 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);
+    infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
+            (ClientData) infoPtr, infoPtr->validMask);
+
+    /*
+     * Pipes have AUTO translation mode on Windows and ^Z eof char, which
+     * means that a ^Z will be appended to them at close. This is needed
+     * for Windows programs that expect a ^Z at EOF.
+     */
+
+    Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
+	    "-translation", "auto");
+    Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
+	    "-eofchar", "\032 {}");
+    return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetAndDetachPids --
+ *
+ *	Stores a list of the command PIDs for a command channel in
+ *	interp->result.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Modifies interp->result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclGetAndDetachPids(interp, chan)
+    Tcl_Interp *interp;
+    Tcl_Channel chan;
+{
+    PipeInfo *pipePtr;
+    Tcl_ChannelType *chanTypePtr;
+    int i;
+    char buf[20];
+
+    /*
+     * Punt if the channel is not a command channel.
+     */
+
+    chanTypePtr = Tcl_GetChannelType(chan);
+    if (chanTypePtr != &pipeChannelType) {
+        return;
+    }
+
+    pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+    for (i = 0; i < pipePtr->numPids; i++) {
+        sprintf(buf, "%lu", 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 --
+ *
+ *	Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeBlockModeProc(instanceData, mode)
+    ClientData instanceData;	/* Instance data for channel. */
+    int mode;			/* TCL_MODE_BLOCKING or
+                                 * TCL_MODE_NONBLOCKING. */
+{
+    PipeInfo *infoPtr = (PipeInfo *) instanceData;
+    
+    /*
+     * Pipes on Windows can not be switched between blocking and nonblocking,
+     * hence we have to emulate the behavior. This is done in the input
+     * function by checking against a bit in the state. We set or unset the
+     * bit here to cause the input function to emulate the correct behavior.
+     */
+
+    if (mode == TCL_MODE_NONBLOCKING) {
+	PipeSetFlag(infoPtr, PIPE_ASYNC);
+    } else {
+	PipeResetFlag(infoPtr, PIPE_ASYNC);
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeCloseProc --
+ *
+ *	Closes a pipe based IO channel.
+ *
+ * Results:
+ *	0 on success, errno otherwise.
+ *
+ * Side effects:
+ *	Closes the physical channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeCloseProc(instanceData, interp)
+    ClientData instanceData;	/* Pointer to PipeInfo structure. */
+    Tcl_Interp *interp;		/* For error reporting. */
+{
+    PipeInfo *pipePtr = (PipeInfo *) instanceData;
+    Tcl_Channel errChan;
+    int errorCode, result;
+    PipeInfo *infoPtr, **nextPtrPtr;
+
+    /*
+     * Remove the file from the list of watched files.
+     */
+
+    for (nextPtrPtr = &firstPipePtr, infoPtr = *nextPtrPtr; infoPtr != NULL;
+	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
+	if (infoPtr == (PipeInfo *)pipePtr) {
+	    *nextPtrPtr = infoPtr->nextPtr;
+	    break;
+	}
+    }
+
+    errorCode = 0;
+    if (pipePtr->readFile != NULL) {
+	if (TclpCloseFile(pipePtr->readFile) != 0) {
+	    errorCode = errno;
+	}
+    }
+    if (pipePtr->writeFile != NULL) {
+	if (TclpCloseFile(pipePtr->writeFile) != 0) {
+	    if (errorCode == 0) {
+		errorCode = errno;
+	    }
+	}
+    }
+    
+    /*
+     * Wrap the error file into a channel and give it to the cleanup
+     * routine.  If we are running in Win32s, just delete the error file
+     * immediately, because it was never used.
+     */
+
+    if (pipePtr->errorFile) {
+	WinFile *filePtr;
+	OSVERSIONINFO os;
+
+	os.dwOSVersionInfoSize = sizeof(os);
+	GetVersionEx(&os);
+	if (os.dwPlatformId == VER_PLATFORM_WIN32s) {
+	    TclpCloseFile(pipePtr->errorFile);
+	    errChan = NULL;
+	} else {
+	    filePtr = (WinFile*)pipePtr->errorFile;
+	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
+		    TCL_READABLE);
+	}
+    } else {
+        errChan = NULL;
+    }
+    result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
+            errChan);
+    if (pipePtr->numPids > 0) {
+        ckfree((char *) pipePtr->pidPtr);
+    }
+
+    /* CYGNUS LOCAL: If the pipe has a thread, let the thread free the
+       structure.  */
+    if (PipeGetFlags(pipePtr) & PIPE_HAS_THREAD) {
+	WaitForSingleObject(pipePtr->flagsMutex, INFINITE);
+	pipePtr->flags |= PIPE_CLOSED;
+	SetEvent(pipePtr->tryReadEvent);
+	ReleaseMutex(pipePtr->flagsMutex);
+    } else {
+	CloseHandle(pipePtr->flagsMutex);
+	ckfree((char*) pipePtr);
+    }
+
+    if (errorCode == 0) {
+        return result;
+    }
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeInputProc --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeInputProc(instanceData, buf, bufSize, errorCode)
+    ClientData instanceData;		/* Pipe state. */
+    char *buf;				/* Where to store data read. */
+    int bufSize;			/* How much space is available
+                                         * in the buffer? */
+    int *errorCode;			/* Where to store error code. */
+{
+    PipeInfo *infoPtr = (PipeInfo *) instanceData;
+    WinFile *filePtr = (WinFile*) infoPtr->readFile;
+    DWORD count;
+    DWORD bytesRead;
+    int gotReadAhead = 0;
+    int origBufSize = bufSize;
+
+    /* CYGNUS LOCAL: If the pipe has a thread, lock it.  */
+    if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
+	WaitForSingleObject(infoPtr->mutex, INFINITE);
+    }
+
+    *errorCode = 0;
+    if (filePtr->type == WIN32S_PIPE) {
+	if (((WinPipe *)filePtr)->otherPtr != NULL) {
+	    panic("PipeInputProc: child process isn't finished writing");
+	}
+	if (filePtr->handle == INVALID_HANDLE_VALUE) {
+	    filePtr->handle = CreateFile(((WinPipe *)filePtr)->fileName,
+		    GENERIC_READ, 0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL,
+		    NULL);
+	}
+	if (filePtr->handle == INVALID_HANDLE_VALUE) {
+	    goto error;
+	}
+    } else {
+	/*
+	 * Pipes will block until the requested number of bytes has been
+	 * read.  To avoid blocking unnecessarily, we look ahead and only
+	 * read as much as is available.
+	 */
+
+	if (PeekNamedPipe(filePtr->handle, (LPVOID) NULL, (DWORD) 0,
+		(LPDWORD) NULL, &count, (LPDWORD) NULL) == TRUE) {
+	    if ((count != 0) && ((DWORD) bufSize > count)) {
+		bufSize = (int) count;
+
+		/*
+		 * This code is commented out because on Win95 we don't get
+		 * notifier of eof on a pipe unless we try to read it.
+		 * The correct solution is to move to threads.
+		 */
+
+/* 	    } else if ((count == 0) && (PipeGetFlags(infoPtr) & PIPE_ASYNC)) { */
+/* 		errno = *errorCode = EAGAIN; */
+/* 		return -1; */
+	    } else if ((count == 0) && !(PipeGetFlags(infoPtr) & PIPE_ASYNC)) {
+		bufSize = 1;
+	    }
+	} else {
+	    goto error;
+	}
+    }
+
+    /* CYGNUS LOCAL: Check for the readahead byte.  */
+    if (PipeGetFlags(infoPtr) & PIPE_READAHEAD) {
+	*buf++ = infoPtr->readAhead;
+	PipeResetFlag(infoPtr, PIPE_READAHEAD);
+	if (bufSize <= 1) {
+	    PipeResetFlag(infoPtr, PIPE_READABLE);
+	    ReleaseMutex(infoPtr->mutex);
+	    return 1;
+	}
+	gotReadAhead = 1;
+	if (bufSize == origBufSize) {
+	    --bufSize;
+	}
+    }
+
+    /*
+     * Note that we will block on reads from a console buffer until a
+     * full line has been entered.  The only way I know of to get
+     * around this is to write a console driver.  We should probably
+     * do this at some point, but for now, we just block.
+     */
+
+    if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+            (LPOVERLAPPED) NULL) == FALSE) {
+	goto error;
+    }
+    
+    if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
+	PipeResetFlag(infoPtr, PIPE_READABLE);
+	ReleaseMutex(infoPtr->mutex);
+    }
+
+    return bytesRead + gotReadAhead;
+
+    error:
+    TclWinConvertError(GetLastError());
+    if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
+	ReleaseMutex(infoPtr->mutex);
+    }
+    if (errno == EPIPE) {
+	return 0;
+    }
+    *errorCode = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeOutputProc --
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeOutputProc(instanceData, buf, toWrite, errorCode)
+    ClientData instanceData;		/* Pipe state. */
+    char *buf;				/* The data buffer. */
+    int toWrite;			/* How many bytes to write? */
+    int *errorCode;			/* Where to store error code. */
+{
+    PipeInfo *infoPtr = (PipeInfo *) instanceData;
+    WinFile *filePtr = (WinFile*) infoPtr->writeFile;
+    DWORD bytesWritten;
+    
+    *errorCode = 0;
+    if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
+	    &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
+        TclWinConvertError(GetLastError());
+        if (errno == EPIPE) {
+            return 0;
+        }
+        *errorCode = errno;
+        return -1;
+    }
+    return bytesWritten;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeEventProc --
+ *
+ *	This function is invoked by Tcl_ServiceEvent when a file event
+ *	reaches the front of the event queue.  This procedure invokes
+ *	Tcl_NotifyChannel on the pipe.
+ *
+ * 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 notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PipeEventProc(evPtr, flags)
+    Tcl_Event *evPtr;		/* Event to service. */
+    int flags;			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;
+    PipeInfo *infoPtr;
+    WinFile *filePtr;
+    int mask;
+/*    DWORD count;*/
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Search through the list of watched pipes for the one whose handle
+     * matches the event.  We do this rather than simply dereferencing
+     * the handle in the event so that pipes can be deleted while the
+     * event is in the queue.
+     */
+
+    for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (pipeEvPtr->infoPtr == infoPtr) {
+	    PipeResetFlag(infoPtr, PIPE_PENDING);
+	    break;
+	}
+    }
+
+    /*
+     * Remove stale events.
+     */
+
+    if (!infoPtr) {
+	return 1;
+    }
+
+    /*
+     * If we aren't on Win32s, check to see if the pipe is readable.  Note
+     * that we can't tell if a pipe is writable, so we always report it
+     * as being writable.
+     */
+
+    filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;
+    if (filePtr->type != WIN32S_PIPE) {
+
+	/* CYGNUS LOCAL: Check PIPE_READABLE if we have a thread.  */
+	if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
+	    mask = TCL_WRITABLE;
+	    if (PipeGetFlags(infoPtr) & PIPE_READABLE) {
+		mask |= TCL_READABLE;
+	    }
+	} else {
+	    mask = TCL_WRITABLE|TCL_READABLE;
+	}
+
+/* 	if (PeekNamedPipe(filePtr->handle, (LPVOID) NULL, (DWORD) 0, */
+/* 		(LPDWORD) NULL, &count, (LPDWORD) NULL) == TRUE) { */
+/* 	    if (count != 0) { */
+/* 		mask |= TCL_READABLE; */
+/* 	    } */
+/* 	} else { */
+
+	    /*
+	     * If the pipe has been closed by the other side, then 
+	     * mark the pipe as readable, but not writable.
+	     */
+
+/* 	    if (GetLastError() == ERROR_BROKEN_PIPE) { */
+/* 		mask = TCL_READABLE; */
+/* 	    } */
+/* 	} */
+    } else {
+	mask = TCL_READABLE | TCL_WRITABLE;
+    }
+
+    /*
+     * Inform the channel of the events.
+     */
+
+    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeWatchProc --
+ *
+ *	Called by the notifier to set up to watch for events on this
+ *	channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeWatchProc(instanceData, mask)
+    ClientData instanceData;		/* Pipe state. */
+    int mask;				/* What events to watch for; OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+    PipeInfo **nextPtrPtr, *ptr;
+    PipeInfo *infoPtr = (PipeInfo *) instanceData;
+    int oldMask = infoPtr->watchMask;
+
+    /*
+     * For now, we just send a message to ourselves so we can poll the
+     * channel for readable events.
+     */
+
+    infoPtr->watchMask = mask & infoPtr->validMask;
+    if (infoPtr->watchMask) {
+	Tcl_Time blockTime = { 0, 0 };
+
+	/* CYGNUS LOCAL: Set up a thread if necessary.  */
+	if ((infoPtr->watchMask & TCL_READABLE) != 0
+	    && (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) == 0) {
+	    HANDLE thread;
+	    DWORD tid;
+
+	    infoPtr->tryReadEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+	    infoPtr->mutex = CreateMutex(NULL, FALSE, NULL);
+	    PipeSetFlag(infoPtr, PIPE_HAS_THREAD);
+	    thread = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE) PipeThread, infoPtr, 0, &tid);
+	    CloseHandle(thread);
+	}
+
+	if (!oldMask) {
+	    infoPtr->nextPtr = firstPipePtr;
+	    firstPipePtr = infoPtr;
+	}
+	Tcl_SetMaxBlockTime(&blockTime);
+    } else {
+	if (oldMask) {
+	    /*
+	     * Remove the pipe from the list of watched pipes.
+	     */
+
+	    for (nextPtrPtr = &firstPipePtr, ptr = *nextPtrPtr;
+		 ptr != NULL;
+		 nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+		if (infoPtr == ptr) {
+		    *nextPtrPtr = ptr->nextPtr;
+		    break;
+		}
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeGetHandleProc --
+ *
+ *	Called from Tcl_GetChannelHandle to retrieve OS handles from
+ *	inside a command pipeline 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
+PipeGetHandleProc(instanceData, direction, handlePtr)
+    ClientData instanceData;	/* The pipe state. */
+    int direction;		/* TCL_READABLE or TCL_WRITABLE */
+    ClientData *handlePtr;	/* Where to store the handle.  */
+{
+    PipeInfo *infoPtr = (PipeInfo *) instanceData;
+    WinFile *filePtr; 
+
+    if (direction == TCL_READABLE && infoPtr->readFile) {
+	filePtr = (WinFile*) infoPtr->readFile;
+	if (filePtr->type == WIN32S_PIPE) {
+	    if (filePtr->handle == INVALID_HANDLE_VALUE) {
+		filePtr->handle = CreateFile(((WinPipe *)filePtr)->fileName,
+			GENERIC_READ, 0, NULL, OPEN_ALWAYS,
+			FILE_ATTRIBUTE_NORMAL, NULL);
+	    }
+	    if (filePtr->handle == INVALID_HANDLE_VALUE) {
+		return TCL_ERROR;
+	    }
+	}
+	*handlePtr = (ClientData) filePtr->handle;
+	return TCL_OK;
+    }
+    if (direction == TCL_WRITABLE && infoPtr->writeFile) {
+	filePtr = (WinFile*) infoPtr->writeFile;
+	*handlePtr = (ClientData) filePtr->handle;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ *	Emulates the waitpid system call.
+ *
+ * Results:
+ *	Returns 0 if the process is still alive, -1 on an error, or
+ *	the pid on a clean close.  
+ *
+ * Side effects:
+ *	Unless WNOHANG is set and the wait times out, the process
+ *	information record will be deleted and the process handle
+ *	will be closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Pid
+Tcl_WaitPid(pid, statPtr, options)
+    Tcl_Pid pid;
+    int *statPtr;
+    int options;
+{
+    ProcInfo *infoPtr, **prevPtrPtr;
+    int flags;
+    Tcl_Pid result;
+    DWORD ret;
+
+    if (!initialized) {
+	PipeInit();
+    }
+
+    /*
+     * If no pid is specified, do nothing.
+     */
+    
+    if (pid == 0) {
+	*statPtr = 0;
+	return 0;
+    }
+
+    /*
+     * Find the process on the process list.
+     */
+
+    prevPtrPtr = &procList;
+    for (infoPtr = procList; infoPtr != NULL;
+	    prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
+	 if (infoPtr->hProcess == (HANDLE) pid) {
+	    break;
+	}
+    }
+
+    /*
+     * If the pid is not one of the processes we know about (we started it)
+     * then do nothing.
+     */
+    
+    if (infoPtr == NULL) {
+        *statPtr = 0;
+	return 0;
+    }
+
+    /*
+     * Officially "wait" for it to finish. We either poll (WNOHANG) or
+     * wait for an infinite amount of time.
+     */
+    
+    if (options & WNOHANG) {
+	flags = 0;
+    } else {
+	flags = INFINITE;
+    }
+    ret = WaitForSingleObject(infoPtr->hProcess, flags);
+    if (ret == WAIT_TIMEOUT) {
+	*statPtr = 0;
+	if (options & WNOHANG) {
+	    return 0;
+	} else {
+	    result = 0;
+	}
+    } else if (ret != WAIT_FAILED) {
+	GetExitCodeProcess(infoPtr->hProcess, (DWORD*)statPtr);
+#ifdef __CYGWIN32__
+	/* A cygwin32 program that exits because of a signal will set
+           the exit status to 0x10000 | (sig << 8).  Fix that back
+           into a standard Unix wait status.  */
+	if ((*statPtr & 0x10000) != 0
+	    && (*statPtr & 0xff00) != 0
+	    && (*statPtr & ~ 0x1ff00) == 0) {
+	    *statPtr = (*statPtr >> 8) & 0xff;
+	} else
+#endif
+	*statPtr = ((*statPtr << 8) & 0xff00);
+	result = pid;
+    } else {
+	errno = ECHILD;
+        *statPtr = ECHILD;
+	result = (Tcl_Pid) -1;
+    }
+
+    /*
+     * Remove the process from the process list and close the process handle.
+     */
+
+    CloseHandle(infoPtr->hProcess);
+    *prevPtrPtr = infoPtr->nextPtr;
+    ckfree((char*)infoPtr);
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PidObjCmd --
+ *
+ *	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_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_Channel chan;
+    Tcl_ChannelType *chanTypePtr;
+    PipeInfo *pipePtr;
+    int i;
+    Tcl_Obj *resultPtr;
+    char buf[20];
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
+	return TCL_ERROR;
+    }
+    if (objc == 1) {
+	resultPtr = Tcl_GetObjResult(interp);
+	sprintf(buf, "%lu", (unsigned long) getpid());
+	Tcl_SetStringObj(resultPtr, buf, -1);
+    } else {
+        chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+		NULL);
+        if (chan == (Tcl_Channel) NULL) {
+	    return TCL_ERROR;
+	}
+	chanTypePtr = Tcl_GetChannelType(chan);
+	if (chanTypePtr != &pipeChannelType) {
+	    return TCL_OK;
+	}
+
+        pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+	resultPtr = Tcl_GetObjResult(interp);
+        for (i = 0; i < pipePtr->numPids; i++) {
+	    sprintf(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
+	    Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
+		    Tcl_NewStringObj(buf, -1));
+	}
+    }
+    return TCL_OK;
+}
diff --git a/tcl/win/tclWinPort.h b/tcl/win/tclWinPort.h
new file mode 100644
index 00000000000..3dad58381cc
--- /dev/null
+++ b/tcl/win/tclWinPort.h
@@ -0,0 +1,434 @@
+/*
+ * tclWinPort.h --
+ *
+ *	This header file handles porting issues that occur because of
+ *	differences between Windows and Unix. It should be the only
+ *	file that contains #ifdefs to handle different flavors of OS.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLWINPORT
+#define _TCLWINPORT
+
+#include <malloc.h>
+#include <stdio.h>
+
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <process.h>
+#include <signal.h>
+#include <winsock.h>
+#include <sys/stat.h>
+#include <sys/timeb.h>
+#include <time.h>
+#include <io.h>
+#include <fcntl.h>
+#include <float.h>
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+#ifdef _MSC_VER
+#define PASCAL
+#endif
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Define EINPROGRESS in terms of WSAEINPROGRESS.
+ */
+
+#ifndef	EINPROGRESS
+#define EINPROGRESS WSAEINPROGRESS
+#endif
+
+/*
+ * If ENOTSUP is not defined, define it to a value that will never occur.
+ */
+
+#ifndef ENOTSUP
+#define	ENOTSUP		-1030507
+#endif
+
+/*
+ * The following defines wrap the system memory allocation routines for
+ * use by tclAlloc.c.
+ */
+
+/* On cygwin32, we just use the supplied malloc and free, rather than
+   using tclAlloc.c.  The cygwin32 malloc is derived from the same
+   sources as tclAlloc.c, anyhow.  */
+#ifdef __CYGWIN32__
+#define TclpAlloc(size)		malloc(size)
+#define TclpFree(ptr)		free(ptr)
+#define TclpRealloc(ptr, size)	realloc(ptr, size)
+#else
+#define TclpSysAlloc(size, isBin)	((void*)HeapAlloc(GetProcessHeap(), \
+					    (DWORD)0, (DWORD)size))
+#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
+					    (DWORD)0, (HGLOBAL)ptr))
+#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
+					    (DWORD)0, (LPVOID)ptr, (DWORD)size))
+#endif
+
+/*
+ * The default platform eol translation on Windows is TCL_TRANSLATE_CRLF:
+ */
+
+#define	TCL_PLATFORM_TRANSLATION	TCL_TRANSLATE_CRLF
+
+/*
+ * Declare dynamic loading extension macro.
+ */
+
+#define TCL_SHLIB_EXT ".dll"
+
+/*
+ * Supply definitions for macros to query wait status, if not already
+ * defined in header files above.
+ */
+
+#if TCL_UNION_WAIT
+#   define WAIT_STATUS_TYPE union wait
+#else
+#   define WAIT_STATUS_TYPE int
+#endif
+
+#ifndef WIFEXITED
+#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
+#endif
+
+#ifndef WEXITSTATUS
+#   define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+#endif
+
+#ifndef WIFSIGNALED
+#   define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
+#endif
+
+#ifndef WTERMSIG
+#   define WTERMSIG(stat)    ((*((int *) &(stat))) & 0x7f)
+#endif
+
+#ifndef WIFSTOPPED
+#   define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
+#endif
+
+#ifndef WSTOPSIG
+#   define WSTOPSIG(stat)    (((*((int *) &(stat))) >> 8) & 0xff)
+#endif
+
+/*
+ * Define constants for waitpid() system call if they aren't defined
+ * by a system header file.
+ */
+
+#ifndef WNOHANG
+#   define WNOHANG 1
+#endif
+#ifndef WUNTRACED
+#   define WUNTRACED 2
+#endif
+
+/*
+ * Define MAXPATHLEN in terms of MAXPATH if available
+ */
+
+#ifndef MAXPATH
+#define MAXPATH MAX_PATH
+#endif /* MAXPATH */
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN MAXPATH
+#endif /* MAXPATHLEN */
+
+#ifndef F_OK
+#    define F_OK 00
+#endif
+#ifndef X_OK
+#    define X_OK 01
+#endif
+#ifndef W_OK
+#    define W_OK 02
+#endif
+#ifndef R_OK
+#    define R_OK 04
+#endif
+
+/*
+ * Define macros to query file type bits, if they're not already
+ * defined.
+ */
+
+#ifndef S_ISREG
+#   ifdef S_IFREG
+#       define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+#   else
+#       define S_ISREG(m) 0
+#   endif
+# endif
+#ifndef S_ISDIR
+#   ifdef S_IFDIR
+#       define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+#   else
+#       define S_ISDIR(m) 0
+#   endif
+# endif
+#ifndef S_ISCHR
+#   ifdef S_IFCHR
+#       define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
+#   else
+#       define S_ISCHR(m) 0
+#   endif
+# endif
+#ifndef S_ISBLK
+#   ifdef S_IFBLK
+#       define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
+#   else
+#       define S_ISBLK(m) 0
+#   endif
+# endif
+#ifndef S_ISFIFO
+#   ifdef S_IFIFO
+#       define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+#   else
+#       define S_ISFIFO(m) 0
+#   endif
+# endif
+
+/*
+ * Define pid_t and uid_t if they're not already defined.
+ */
+
+#if ! TCL_PID_T
+#   define pid_t int
+#endif
+#if ! TCL_UID_T
+#   define uid_t int
+#endif
+
+/*
+ * Provide a stub definition for TclGetUserHome().
+ */
+
+#define TclGetUserHome(name,bufferPtr) (NULL)
+
+/*
+ * Visual C++ has some odd names for common functions, so we need to
+ * define a few macros to handle them.  Also, it defines EDEADLOCK and
+ * EDEADLK as the same value, which confuses Tcl_ErrnoId().
+ */
+
+#ifdef _MSC_VER
+#    define environ _environ
+#    define hypot _hypot
+#    define exception _exception
+#    undef EDEADLOCK
+#endif /* _MSC_VER */
+
+/*
+ * When building DLLs using GCC on mingw32, we must import environ via 
+ * indirection. This hack will eventually go away once GCC understands 
+ * dllimport attribute and mingw32 headers are fixed.
+ */
+
+#ifdef __MINGW32__
+     extern char *** __imp__environ_dll;
+#    define environ (*__imp__environ_dll)
+#    define hypot _hypot
+#    define exception _exception
+#    undef EDEADLOCK
+#endif /* __MINGW32__ */
+
+/*
+ * The following defines redefine the Windows Socket errors as
+ * BSD errors so Tcl_PosixError can do the right thing.
+ */
+
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK             EAGAIN
+#endif
+#ifndef EALREADY
+#define EALREADY	149	/* operation already in progress */
+#endif
+#ifndef ENOTSOCK
+#define ENOTSOCK	95	/* Socket operation on non-socket */
+#endif
+#ifndef EDESTADDRREQ
+#define EDESTADDRREQ	96	/* Destination address required */
+#endif
+#ifndef EMSGSIZE
+#define EMSGSIZE	97	/* Message too long */
+#endif
+#ifndef EPROTOTYPE
+#define EPROTOTYPE	98	/* Protocol wrong type for socket */
+#endif
+#ifndef ENOPROTOOPT
+#define ENOPROTOOPT	99	/* Protocol not available */
+#endif
+#ifndef EPROTONOSUPPORT
+#define EPROTONOSUPPORT	120	/* Protocol not supported */
+#endif
+#ifndef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT	121	/* Socket type not supported */
+#endif
+#ifndef EOPNOTSUPP
+#define EOPNOTSUPP	122	/* Operation not supported on socket */
+#endif
+#ifndef EPFNOSUPPORT
+#define EPFNOSUPPORT	123	/* Protocol family not supported */
+#endif
+#ifndef EAFNOSUPPORT
+#define EAFNOSUPPORT	124	/* Address family not supported */
+#endif
+#ifndef EADDRINUSE
+#define EADDRINUSE	125	/* Address already in use */
+#endif
+#ifndef EADDRNOTAVAIL
+#define EADDRNOTAVAIL	126	/* Can't assign requested address */
+#endif
+#ifndef ENETDOWN
+#define ENETDOWN	127	/* Network is down */
+#endif
+#ifndef ENETUNREACH
+#define ENETUNREACH	128	/* Network is unreachable */
+#endif
+#ifndef ENETRESET
+#define ENETRESET	129	/* Network dropped connection on reset */
+#endif
+#ifndef ECONNABORTED
+#define ECONNABORTED	130	/* Software caused connection abort */
+#endif
+#ifndef ECONNRESET
+#define ECONNRESET	131	/* Connection reset by peer */
+#endif
+#ifndef ENOBUFS
+#define ENOBUFS		132	/* No buffer space available */
+#endif
+#ifndef EISCONN
+#define EISCONN		133	/* Socket is already connected */
+#endif
+#ifndef ENOTCONN
+#define ENOTCONN	134	/* Socket is not connected */
+#endif
+#ifndef ESHUTDOWN
+#define ESHUTDOWN	143	/* Can't send after socket shutdown */
+#endif
+#ifndef ETOOMANYREFS
+#define ETOOMANYREFS	144	/* Too many references: can't splice */
+#endif
+#ifndef ETIMEDOUT
+#define ETIMEDOUT	145	/* Connection timed out */
+#endif
+#ifndef ECONNREFUSED
+#define ECONNREFUSED	146	/* Connection refused */
+#endif
+#ifndef ELOOP
+#define ELOOP		90	/* Symbolic link loop */
+#endif
+#ifndef EHOSTDOWN
+#define EHOSTDOWN	147	/* Host is down */
+#endif
+#ifndef EHOSTUNREACH
+#define EHOSTUNREACH	148	/* No route to host */
+#endif
+#ifndef ENOTEMPTY
+#define ENOTEMPTY 	93	/* directory not empty */
+#endif
+#ifndef EUSERS
+#define EUSERS		94	/* Too many users (for UFS) */
+#endif
+#ifndef EDQUOT
+#define EDQUOT		49	/* Disc quota exceeded */
+#endif
+#ifndef ESTALE
+#define ESTALE		151	/* Stale NFS file handle */
+#endif
+#ifndef EREMOTE
+#define EREMOTE		66	/* The object is remote */
+#endif
+
+/*
+ * The following define ensures that we use the native putenv
+ * implementation to modify the environment array.  This keeps
+ * the C level environment in synch with the system level environment.
+ */
+
+#define USE_PUTENV	1
+    
+/*
+ * The following defines map from standard socket names to our internal
+ * wrappers that redirect through the winSock function table (see the
+ * file tclWinSock.c).
+ */
+
+#define getservbyname	TclWinGetServByName
+#define getsockopt	TclWinGetSockOpt
+#define ntohs		TclWinNToHS
+#define setsockopt	TclWinSetSockOpt
+
+/*
+ * The following implements the Windows method for exiting the process.
+ */
+#define TclPlatformExit(status) exit(status)
+
+
+/*
+ * The following declarations belong in tclInt.h, but depend on platform
+ * specific types (e.g. struct tm).
+ */
+
+EXTERN struct tm *	TclpGetDate _ANSI_ARGS_((const time_t *tp,
+			    int useGMT));
+EXTERN unsigned long	TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
+EXTERN size_t		TclStrftime _ANSI_ARGS_((char *s, size_t maxsize,
+			    const char *format, const struct tm *t));
+
+/*
+ * The following prototypes and defines replace the Windows versions
+ * of POSIX function that various compilier vendors didn't implement 
+ * well or consistantly.
+ */
+
+#define lstat		TclStat
+
+EXTERN int		TclpStat _ANSI_ARGS_((CONST char *path, 
+			    struct stat *buf));
+EXTERN int		TclpAccess _ANSI_ARGS_((CONST char *path, 
+			    int mode));
+
+#define TclpReleaseFile(file)	ckfree((char *) file)
+
+/*
+ * Declarations for Windows specific functions.
+ */
+
+EXTERN void		TclWinConvertError _ANSI_ARGS_((DWORD errCode));
+EXTERN void		TclWinConvertWSAError _ANSI_ARGS_((DWORD errCode));
+EXTERN struct servent * PASCAL FAR
+			TclWinGetServByName _ANSI_ARGS_((const char FAR *nm,
+		            const char FAR *proto));
+EXTERN int PASCAL FAR	TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level,
+		            int optname, char FAR * optval, int FAR *optlen));
+EXTERN HINSTANCE	TclWinGetTclInstance _ANSI_ARGS_((void));
+EXTERN HINSTANCE	TclWinLoadLibrary _ANSI_ARGS_((char *name));
+EXTERN u_short PASCAL FAR
+			TclWinNToHS _ANSI_ARGS_((u_short ns));
+EXTERN int PASCAL FAR	TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
+		            int optname, const char FAR * optval, int optlen));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLWINPORT */
diff --git a/tcl/win/tclWinReg.c b/tcl/win/tclWinReg.c
new file mode 100644
index 00000000000..de6489104a7
--- /dev/null
+++ b/tcl/win/tclWinReg.c
@@ -0,0 +1,1223 @@
+/* 
+ * tclWinReg.c --
+ *
+ *	This file contains the implementation of the "registry" Tcl
+ *	built-in command.  This command is built as a dynamically
+ *	loadable extension in a separate DLL.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <tcl.h>
+#include <stdlib.h>
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Registry_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+/*
+ * VC++ has an alternate entry point called DllMain, so we need to rename
+ * our entry point.
+ */
+
+#ifdef DLL_BUILD
+# if defined(_MSC_VER)
+#  define DllEntryPoint DllMain
+# endif
+#endif
+
+/*
+ * The following macros convert between different endian ints.
+ */
+
+#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
+#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
+ 
+/*
+ * The following flag is used in OpenKeys to indicate that the specified
+ * key should be created if it doesn't currently exist.
+ */
+
+#define REG_CREATE 1
+
+/*
+ * The following tables contain the mapping from registry root names
+ * to the system predefined keys.
+ */
+
+static char *rootKeyNames[] = {
+    "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
+    "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", NULL
+};
+
+static HKEY rootKeys[] = {
+    HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
+    HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
+};
+
+/*
+ * The following table maps from registry types to strings.  Note that
+ * the indices for this array are the same as the constants for the
+ * known registry types so we don't need a separate table to hold the
+ * mapping.
+ */
+
+static char *typeNames[] = {
+    "none", "sz", "expand_sz", "binary", "dword", 
+    "dword_big_endian", "link", "multi_sz", "resource_list", NULL
+};
+
+static DWORD lastType = REG_RESOURCE_LIST;
+
+
+/*
+ * Declarations for functions defined in this file.
+ */
+
+static void		AppendSystemError(Tcl_Interp *interp, DWORD error);
+static DWORD		ConvertDWORD(DWORD type, DWORD value);
+static int		DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
+static int		DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    Tcl_Obj *valueNameObj);
+static int		GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    Tcl_Obj *patternObj);
+static int		GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    Tcl_Obj *valueNameObj);
+static int		GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    Tcl_Obj *valueNameObj);
+static int		GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    Tcl_Obj *patternObj);
+static int		OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    REGSAM mode, int flags, HKEY *keyPtr);
+static DWORD		OpenSubKey(char *hostName, HKEY rootKey,
+			    char *keyName, REGSAM mode, int flags,
+			    HKEY *keyPtr);
+static int		ParseKeyName(Tcl_Interp *interp, char *name,
+			    char **hostNamePtr, HKEY *rootKeyPtr,
+			    char **keyNamePtr);
+static DWORD		RecursiveDeleteKey(HKEY hStartKey, LPTSTR pKeyName);
+static int		RegistryObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]);
+static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
+			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
+			    Tcl_Obj *typeObj);
+
+EXTERN int Registry_Init(Tcl_Interp *interp);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ *	This wrapper function is used by Windows to invoke the
+ *	initialization code for the DLL.  If we are compiling
+ *	with Visual C++, this routine will be renamed to DllMain.
+ *	routine.
+ *
+ * Results:
+ *	Returns TRUE;
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef __WIN32__
+#ifdef DLL_BUILD
+BOOL APIENTRY
+DllEntryPoint(
+    HINSTANCE hInst,		/* Library instance handle. */
+    DWORD reason,		/* Reason this function is being called. */
+    LPVOID reserved)		/* Not used. */
+{
+    return TRUE;
+}
+#endif
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Registry_Init --
+ *
+ *	This procedure initializes the registry command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Registry_Init(
+    Tcl_Interp *interp)
+{
+    Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
+    return Tcl_PkgProvide(interp, "registry", "1.0");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegistryObjCmd --
+ *
+ *	This function implements the Tcl "registry" command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RegistryObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj * CONST objv[])	/* Argument values. */
+{
+    int index;
+    char *errString;
+
+    static char *subcommands[] = { "delete", "get", "keys", "set", "type",
+				   "values", (char *) NULL };
+    enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx };
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch (index) {
+	case DeleteIdx:			/* delete */
+	    if (objc == 3) {
+		return DeleteKey(interp, objv[2]);
+	    } else if (objc == 4) {
+		return DeleteValue(interp, objv[2], objv[3]);
+	    }
+	    errString = "keyName ?valueName?";
+	    break;
+	case GetIdx:			/* get */
+	    if (objc == 4) {
+		return GetValue(interp, objv[2], objv[3]);
+	    }
+	    errString = "keyName valueName";
+	    break;
+	case KeysIdx:			/* keys */
+	    if (objc == 3) {
+		return GetKeyNames(interp, objv[2], NULL);
+	    } else if (objc == 4) {
+		return GetKeyNames(interp, objv[2], objv[3]);
+	    }
+	    errString = "keyName ?pattern?";
+	    break;
+	case SetIdx:			/* set */
+	    if (objc == 3) {
+		HKEY key;
+
+		/*
+		 * Create the key and then close it immediately.
+		 */
+
+		if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key)
+			!= TCL_OK) {
+		    return TCL_ERROR;
+		}
+		RegCloseKey(key);
+		return TCL_OK;
+	    } else if (objc == 5 || objc == 6) {
+		Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
+		return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
+	    }
+	    errString = "keyName ?valueName data ?type??";
+	    break;
+	case TypeIdx:			/* type */
+	    if (objc == 4) {
+		return GetType(interp, objv[2], objv[3]);
+	    }
+	    errString = "keyName valueName";
+	    break;
+	case ValuesIdx:			/* values */
+	    if (objc == 3) {
+ 		return GetValueNames(interp, objv[2], NULL);
+	    } else if (objc == 4) {
+ 		return GetValueNames(interp, objv[2], objv[3]);
+	    }
+	    errString = "keyName ?pattern?";
+	    break;
+    }
+    Tcl_WrongNumArgs(interp, 2, objv, errString);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteKey --
+ *
+ *	This function deletes a registry key.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteKey(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj)	/* Name of key to delete. */
+{
+    char *tail, *buffer, *hostName, *keyName;
+    HKEY rootKey, subkey;
+    DWORD result;
+    int length;
+    Tcl_Obj *resultPtr;
+
+    /*
+     * Find the parent of the key being deleted and open it.
+     */
+
+    keyName = Tcl_GetStringFromObj(keyNameObj, &length);
+    buffer = ckalloc(length + 1);
+    strcpy(buffer, keyName);
+
+    if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName)
+	    != TCL_OK) {
+	ckfree(buffer);
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_GetObjResult(interp);
+    if (*keyName == '\0') {
+	Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1);
+	ckfree(buffer);
+	return TCL_ERROR;
+    }
+
+    tail = strrchr(keyName, '\\');
+    if (tail) {
+	*tail++ = '\0';
+    } else {
+	tail = keyName;
+	keyName = NULL;
+    }
+
+    result = OpenSubKey(hostName, rootKey, keyName,
+	    KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
+    if (result != ERROR_SUCCESS) {
+	ckfree(buffer);
+	if (result == ERROR_FILE_NOT_FOUND) {
+	    return TCL_OK;
+	} else {
+	    Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
+	    AppendSystemError(interp, result);
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Now we recursively delete the key and everything below it.
+     */
+
+    result = RecursiveDeleteKey(subkey, tail);
+
+    if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
+	Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
+	AppendSystemError(interp, result);
+	result = TCL_ERROR;
+    } else {
+	result = TCL_OK;
+    }
+
+    RegCloseKey(subkey);
+    ckfree(buffer);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteValue --
+ *
+ *	This function deletes a value from a registry key.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteValue(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Name of key. */
+    Tcl_Obj *valueNameObj)	/* Name of value to delete. */
+{
+    HKEY key;
+    char *valueName;
+    int length;
+    DWORD result;
+    Tcl_Obj *resultPtr;
+    
+    /*
+     * Attempt to open the key for deletion.
+     */
+
+    if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_GetObjResult(interp);
+    valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+    result = RegDeleteValue(key, valueName);
+    if (result != ERROR_SUCCESS) {
+	Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",
+		Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
+		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+	AppendSystemError(interp, result);
+	result = TCL_ERROR;
+    } else {
+	result = TCL_OK;
+    }
+    RegCloseKey(key);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetKeyNames --
+ *
+ *	This function enumerates the subkeys of a given key.  If the
+ *	optional pattern is supplied, then only keys that match the
+ *	pattern will be returned.
+ *
+ * Results:
+ *	Returns the list of subkeys in the result object of the
+ *	interpreter, or an error message on failure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetKeyNames(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Key to enumerate. */
+    Tcl_Obj *patternObj)	/* Optional match pattern. */
+{
+    HKEY key;
+    DWORD index;
+    char buffer[MAX_PATH+1], *pattern;
+    Tcl_Obj *resultPtr;
+    int result = TCL_OK;
+
+    /*
+     * Attempt to open the key for enumeration.
+     */
+
+    if (OpenKey(interp, keyNameObj, KEY_ENUMERATE_SUB_KEYS, 0, &key)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (patternObj) {
+	pattern = Tcl_GetStringFromObj(patternObj, NULL);
+    } else {
+	pattern = NULL;
+    }
+
+    /*
+     * Enumerate over the subkeys until we get an error, indicating the
+     * end of the list.
+     */
+
+    resultPtr = Tcl_GetObjResult(interp);
+    for (index = 0; RegEnumKey(key, index, buffer, MAX_PATH+1)
+	     == ERROR_SUCCESS; index++) {
+	if (pattern && !Tcl_StringMatch(buffer, pattern)) {
+	    continue;
+	}
+	result = Tcl_ListObjAppendElement(interp, resultPtr,
+		Tcl_NewStringObj(buffer, -1));
+	if (result != TCL_OK) {
+	    break;
+	}
+    }
+
+    RegCloseKey(key);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetType --
+ *
+ *	This function gets the type of a given registry value and
+ *	places it in the interpreter result.
+ *
+ * Results:
+ *	Returns a normal Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetType(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Name of key. */
+    Tcl_Obj *valueNameObj)	/* Name of value to get. */
+{
+    HKEY key;
+    Tcl_Obj *resultPtr;
+    DWORD result;
+    DWORD type;
+    
+    /*
+     * Attempt to open the key for reading.
+     */
+
+    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the type of the value.
+     */
+
+    resultPtr = Tcl_GetObjResult(interp);
+
+    result = RegQueryValueEx(key, Tcl_GetStringFromObj(valueNameObj, NULL),
+	    NULL, &type, NULL, NULL);
+    RegCloseKey(key);
+
+    if (result != ERROR_SUCCESS) {
+	Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"",
+		Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
+		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+	AppendSystemError(interp, result);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set the type into the result.  Watch out for unknown types.
+     * If we don't know about the type, just use the numeric value.
+     */
+
+    if (type > lastType || type < 0) {
+	Tcl_SetIntObj(resultPtr, type);
+    } else {
+	Tcl_SetStringObj(resultPtr, typeNames[type], -1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetValue --
+ *
+ *	This function gets the contents of a registry value and places
+ *	a list containing the data and the type in the interpreter
+ *	result.
+ *
+ * Results:
+ *	Returns a normal Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetValue(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Name of key. */
+    Tcl_Obj *valueNameObj)	/* Name of value to get. */
+{
+    HKEY key;
+    char *valueName;
+    DWORD result, length, type;
+    Tcl_Obj *resultPtr;
+    Tcl_DString data;
+
+    /*
+     * Attempt to open the key for reading.
+     */
+
+    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Initialize a Dstring to maximum statically allocated size
+     * we could get one more byte by avoiding Tcl_DStringSetLength()
+     * and just setting length to TCL_DSTRING_STATIC_SIZE, but this
+     * should be safer if the implementation Dstrings changes.
+     *
+     * This allows short values to be read from the registy in one call.
+     * Longer values need a second call with an expanded DString.
+     */
+
+    Tcl_DStringInit(&data);
+    Tcl_DStringSetLength(&data, length = TCL_DSTRING_STATIC_SIZE - 1);
+
+    resultPtr = Tcl_GetObjResult(interp);
+  
+    valueName = Tcl_GetStringFromObj(valueNameObj, NULL);
+    result = RegQueryValueEx(key, valueName, NULL, &type,
+	    (LPBYTE) Tcl_DStringValue(&data), &length);
+    if (result == ERROR_MORE_DATA) {
+        Tcl_DStringSetLength(&data, length);
+        result = RegQueryValueEx(key, valueName, NULL, &type,
+                (LPBYTE) Tcl_DStringValue(&data), &length);
+    }
+    RegCloseKey(key);
+    if (result != ERROR_SUCCESS) {
+	Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
+		Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
+		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+	AppendSystemError(interp, result);
+	Tcl_DStringFree(&data);
+	return TCL_ERROR;
+    }
+
+    /*
+     * If the data is a 32-bit quantity, store it as an integer object.  If it
+     * is a multi-string, store it as a list of strings.  For null-terminated
+     * strings, append up the to first null.  Otherwise, store it as a binary
+     * string.
+     */
+
+    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
+	Tcl_SetIntObj(resultPtr, ConvertDWORD(type,
+		*((DWORD*) Tcl_DStringValue(&data))));
+    } else if (type == REG_MULTI_SZ) {
+	char *p = Tcl_DStringValue(&data);
+	char *lastChar = Tcl_DStringValue(&data) + Tcl_DStringLength(&data);
+
+	/*
+	 * Multistrings are stored as an array of null-terminated strings,
+	 * terminated by two null characters.  Also do a bounds check in
+	 * case we get bogus data.
+	 */
+
+	while (p < lastChar && *p != '\0') {
+	    Tcl_ListObjAppendElement(interp, resultPtr,
+		    Tcl_NewStringObj(p, -1));
+	    while (*p++ != '\0') {}
+	}
+    } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
+	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), -1);
+    } else {
+	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), length);
+    }
+    Tcl_DStringFree(&data);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetValueNames --
+ *
+ *	This function enumerates the values of the a given key.  If
+ *	the optional pattern is supplied, then only value names that
+ *	match the pattern will be returned.
+ *
+ * Results:
+ *	Returns the list of value names in the result object of the
+ *	interpreter, or an error message on failure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetValueNames(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Key to enumerate. */
+    Tcl_Obj *patternObj)	/* Optional match pattern. */
+{
+    HKEY key;
+    Tcl_Obj *resultPtr;
+    DWORD index, size, result;
+    Tcl_DString buffer;
+    char *pattern;
+
+    /*
+     * Attempt to open the key for enumeration.
+     */
+
+    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_GetObjResult(interp);
+
+    /*
+     * Query the key to determine the appropriate buffer size to hold the
+     * largest value name plus the terminating null.
+     */
+
+    result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL, NULL, NULL, &index,
+	&size, NULL, NULL, NULL);
+    if (result != ERROR_SUCCESS) {
+	Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
+		Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+	AppendSystemError(interp, result);
+	RegCloseKey(key);
+	result = TCL_ERROR;
+	goto done;
+    }
+    size++;
+
+
+    Tcl_DStringInit(&buffer);
+    Tcl_DStringSetLength(&buffer, size);
+    index = 0;
+    result = TCL_OK;
+
+    if (patternObj) {
+	pattern = Tcl_GetStringFromObj(patternObj, NULL);
+    } else {
+	pattern = NULL;
+    }
+
+    /*
+     * Enumerate the values under the given subkey until we get an error,
+     * indicating the end of the list.  Note that we need to reset size
+     * after each iteration because RegEnumValue smashes the old value.
+     */
+
+    while (RegEnumValue(key, index, Tcl_DStringValue(&buffer), &size, NULL,
+	    NULL, NULL, NULL) == ERROR_SUCCESS) {
+	if (!pattern || Tcl_StringMatch(Tcl_DStringValue(&buffer), pattern)) {
+	    result = Tcl_ListObjAppendElement(interp, resultPtr,
+		    Tcl_NewStringObj(Tcl_DStringValue(&buffer), size));
+	    if (result != TCL_OK) {
+		break;
+	    }
+	}
+	index++;
+	size = Tcl_DStringLength(&buffer);
+    }
+    Tcl_DStringFree(&buffer);
+
+    done:
+    RegCloseKey(key);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenKey --
+ *
+ *	This function opens the specified key.  This function is a
+ *	simple wrapper around ParseKeyName and OpenSubKey.
+ *
+ * Results:
+ *	Returns the opened key in the keyPtr argument and a Tcl
+ *	result code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+OpenKey(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Key to open. */
+    REGSAM mode,		/* Access mode. */
+    int flags,			/* 0 or REG_CREATE. */
+    HKEY *keyPtr)		/* Returned HKEY. */
+{
+    char *keyName, *buffer, *hostName;
+    int length;
+    HKEY rootKey;
+    DWORD result;
+
+    keyName = Tcl_GetStringFromObj(keyNameObj, &length);
+    buffer = ckalloc(length + 1);
+    strcpy(buffer, keyName);
+
+    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
+    if (result == TCL_OK) {
+	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
+	if (result != ERROR_SUCCESS) {
+	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+	    Tcl_AppendToObj(resultPtr, "unable to open key: ", -1);
+	    AppendSystemError(interp, result);
+	    result = TCL_ERROR;
+	} else {
+	    result = TCL_OK;
+	}
+    }
+
+    ckfree(buffer);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenSubKey --
+ *
+ *	This function opens a given subkey of a root key on the
+ *	specified host.
+ *
+ * Results:
+ *	Returns the opened key in the keyPtr and a Windows error code
+ *	as the return value.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD
+OpenSubKey(
+    char *hostName,		/* Host to access, or NULL for local. */
+    HKEY rootKey,		/* Root registry key. */
+    char *keyName,		/* Subkey name. */
+    REGSAM mode,		/* Access mode. */
+    int flags,			/* 0 or REG_CREATE. */
+    HKEY *keyPtr)		/* Returned HKEY. */
+{
+    DWORD result;
+
+    /*
+     * Attempt to open the root key on a remote host if necessary.
+     */
+
+    if (hostName) {
+	result = RegConnectRegistry(hostName, rootKey, &rootKey);
+	if (result != ERROR_SUCCESS) {
+	    return result;
+	}
+    }
+
+    /*
+     * Now open the specified key with the requested permissions.  Note
+     * that this key must be closed by the caller.
+     */
+
+    if (flags & REG_CREATE) {
+	DWORD create;
+	result = RegCreateKeyEx(rootKey, keyName, 0, "",
+		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
+    } else {
+	result = RegOpenKeyEx(rootKey, keyName, 0, mode, keyPtr);
+    }
+
+    /*
+     * Be sure to close the root key since we are done with it now.
+     */
+
+    if (hostName) {
+	RegCloseKey(rootKey);
+    }
+    return result; 
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseKeyName --
+ *
+ *	This function parses a key name into the host, root, and subkey
+ *	parts. 
+ *
+ * Results:
+ *	The pointers to the start of the host and subkey names are
+ *	returned in the hostNamePtr and keyNamePtr variables.  The
+ *	specified root HKEY is returned in rootKeyPtr.  Returns
+ *	a standard Tcl result.
+ *
+ *
+ * Side effects:
+ *	Modifies the name string by inserting nulls.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseKeyName(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    char *name,
+    char **hostNamePtr,
+    HKEY *rootKeyPtr,
+    char **keyNamePtr)
+{
+    char *rootName;
+    int result, index;
+    Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
+
+    /*
+     * Split the key into host and root portions.
+     */
+
+    *hostNamePtr = *keyNamePtr = rootName = NULL;
+    if (name[0] == '\\') {
+	if (name[1] == '\\') {
+	    *hostNamePtr = name;
+	    for (rootName = name+2; *rootName != '\0'; rootName++) {
+		if (*rootName == '\\') {
+		    *rootName++ = '\0';
+		    break;
+		}
+	    }
+	}
+    } else {
+	rootName = name;
+    }
+    if (!rootName) {
+	Tcl_AppendStringsToObj(resultPtr, "bad key \"", name,
+		"\": must start with a valid root", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Split the root into root and subkey portions.
+     */
+
+    for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) {
+	if (**keyNamePtr == '\\') {
+	    **keyNamePtr = '\0';
+	    (*keyNamePtr)++;
+	    break;
+	}
+    }
+
+    /*
+     * Look for a matching root name.
+     */
+
+    rootObj = Tcl_NewStringObj(rootName, -1);
+    result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
+	    TCL_EXACT, &index);
+    Tcl_DecrRefCount(rootObj);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+    *rootKeyPtr = rootKeys[index];
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursiveDeleteKey --
+ *
+ *	This function recursively deletes all the keys below a starting
+ *	key.  Although Windows 95 does this automatically, we still need
+ *	to do this for Windows NT.
+ *
+ * Results:
+ *	Returns a Windows error code.
+ *
+ * Side effects:
+ *	Deletes all of the keys and values below the given key.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD
+RecursiveDeleteKey(
+    HKEY startKey,		/* Parent of key to be deleted. */
+    char *keyName)		/* Name of key to be deleted. */
+{
+    DWORD result, subKeyLength;
+    Tcl_DString subkey;
+    HKEY hKey;
+
+    /*
+     * Do not allow NULL or empty key name.
+     */
+
+    if (!keyName || lstrlen(keyName) == '\0') {
+	return ERROR_BADKEY;
+    }
+
+    result = RegOpenKeyEx(startKey, keyName, 0,
+	    KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
+    if (result != ERROR_SUCCESS) {
+	return result;
+    }
+    result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL, &subKeyLength,
+	    NULL, NULL, NULL, NULL, NULL, NULL);
+    subKeyLength++;
+    if (result != ERROR_SUCCESS) {
+	return result;
+    }
+
+    Tcl_DStringInit(&subkey);
+    Tcl_DStringSetLength(&subkey, subKeyLength);
+
+    while (result == ERROR_SUCCESS) {
+	/*
+	 * Always get index 0 because key deletion changes ordering.
+	 */
+
+	subKeyLength = Tcl_DStringLength(&subkey);
+	result=RegEnumKeyEx(hKey, 0, Tcl_DStringValue(&subkey), &subKeyLength,
+		NULL, NULL, NULL, NULL);
+	if (result == ERROR_NO_MORE_ITEMS) {
+	    result = RegDeleteKey(startKey, keyName);
+	    break;
+	} else if (result == ERROR_SUCCESS) {
+	    result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
+	}
+    }
+    Tcl_DStringFree(&subkey);
+    RegCloseKey(hKey);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetValue --
+ *
+ *	This function sets the contents of a registry value.  If
+ *	the key or value does not exist, it will be created.  If it
+ *	does exist, then the data and type will be replaced.
+ *
+ * Results:
+ *	Returns a normal Tcl result.
+ *
+ * Side effects:
+ *	May create new keys or values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetValue(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *keyNameObj,	/* Name of key. */
+    Tcl_Obj *valueNameObj,	/* Name of value to set. */
+    Tcl_Obj *dataObj,		/* Data to be written. */
+    Tcl_Obj *typeObj)		/* Type of data to be written. */
+{
+    DWORD type, result;
+    HKEY key;
+    int length;
+    char *valueName;
+    Tcl_Obj *resultPtr;
+
+    if (typeObj == NULL) {
+	type = REG_SZ;
+    } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
+	    0, (int *) &type) != TCL_OK) {
+	if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_ResetResult(interp);
+    }
+    if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+    resultPtr = Tcl_GetObjResult(interp);
+
+    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
+	DWORD value;
+	if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
+	    RegCloseKey(key);
+	    return TCL_ERROR;
+	}
+
+	value = ConvertDWORD(type, value);
+	result = RegSetValueEx(key, valueName, 0, type, (BYTE*) &value,
+		sizeof(DWORD));
+    } else if (type == REG_MULTI_SZ) {
+	Tcl_DString data;
+	int objc, i;
+	Tcl_Obj **objv;
+	char *element;
+
+	if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
+	    RegCloseKey(key);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Append the elements as null terminated strings.  Note that
+	 * we must not assume the length of the string in case there are
+	 * embedded nulls, which aren't allowed in REG_MULTI_SZ values.
+	 */
+
+	Tcl_DStringInit(&data);
+	for (i = 0; i < objc; i++) {
+	    element = Tcl_GetStringFromObj(objv[i], NULL);
+	    Tcl_DStringAppend(&data, element, -1);
+	    Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
+	}
+	result = RegSetValueEx(key, valueName, 0, type,
+		(LPBYTE) Tcl_DStringValue(&data),
+		(DWORD) (Tcl_DStringLength(&data)+1));
+	Tcl_DStringFree(&data);
+    } else {
+	char *data = Tcl_GetStringFromObj(dataObj, &length);
+
+	/*
+	 * Include the null in the length if we are storing a null terminated
+	 * string.  Note that we also need to call strlen to find the first
+	 * null so we don't pass bad data to the registry.
+	 */
+
+	if (type == REG_SZ || type == REG_EXPAND_SZ) {
+	    length = strlen(data) + 1;
+	}
+
+	result = RegSetValueEx(key, valueName, 0, type, (LPBYTE)data, length);
+    }
+    RegCloseKey(key);
+    if (result != ERROR_SUCCESS) {
+	Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
+	AppendSystemError(interp, result);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendSystemError --
+ *
+ *	This routine formats a Windows system error message and places
+ *	it into the interpreter result.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendSystemError(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    DWORD error)		/* Result code from error. */
+{
+    int length;
+    char *msgbuf, id[10];
+    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+    sprintf(id, "%d", error);
+    length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
+	    | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
+	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR)&msgbuf,
+	    0, NULL);
+    if (length == 0) {
+	if (error == ERROR_CALL_NOT_IMPLEMENTED) {
+	    msgbuf = "function not supported under Win32s";
+	} else {
+	    msgbuf = id;
+	}
+    } else {
+	/*
+	 * Trim the trailing CR/LF from the system message.
+	 */
+	if (msgbuf[length-1] == '\n') {
+	    msgbuf[--length] = 0;
+	}
+	if (msgbuf[length-1] == '\r') {
+	    msgbuf[--length] = 0;
+	}
+    }
+    Tcl_SetErrorCode(interp, "WINDOWS", id, msgbuf, (char *) NULL);
+    Tcl_AppendToObj(resultPtr, msgbuf, -1);
+
+    if (length != 0) {
+	LocalFree(msgbuf);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertDWORD --
+ *
+ *	This function determines whether a DWORD needs to be byte
+ *	swapped, and returns the appropriately swapped value.
+ *
+ * Results:
+ *	Returns a converted DWORD.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD
+ConvertDWORD(
+    DWORD type,			/* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
+    DWORD value)		/* The value to be converted. */
+{
+    DWORD order = 1;
+    DWORD localType;
+
+    /*
+     * Check to see if the low bit is in the first byte.
+     */
+
+    localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+    return (type != localType) ? SWAPLONG(value) : value;
+}
diff --git a/tcl/win/tclWinSock.c b/tcl/win/tclWinSock.c
new file mode 100644
index 00000000000..55581cd22ef
--- /dev/null
+++ b/tcl/win/tclWinSock.c
@@ -0,0 +1,2178 @@
+/* 
+ * tclWinSock.c --
+ *
+ *	This file contains Windows-specific socket related code.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef _MSC_VER
+#define PASCAL
+#endif
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+static int  hostnameInitialized = 0;
+static char hostname[255];	/* This buffer should be big enough for
+                                 * hostname plus domain name. */
+
+/*
+ * The following structure contains pointers to all of the WinSock API entry
+ * points used by Tcl.  It is initialized by InitSockets.  Since we
+ * dynamically load Winsock.dll on demand, we must use this function table
+ * to refer to functions in the socket API.
+ */
+
+static struct {
+    HINSTANCE hInstance;	/* Handle to WinSock library. */
+    HWND hwnd;			/* Handle to window for socket messages. */
+    SOCKET (PASCAL FAR *accept)(SOCKET s, struct sockaddr FAR *addr,
+	    int FAR *addrlen);
+    int (PASCAL FAR *bind)(SOCKET s, const struct sockaddr FAR *addr,
+	    int namelen);
+    int (PASCAL FAR *closesocket)(SOCKET s);
+    int (PASCAL FAR *connect)(SOCKET s, const struct sockaddr FAR *name,
+	    int namelen);
+    int (PASCAL FAR *ioctlsocket)(SOCKET s, long cmd, u_long FAR *argp);
+    int (PASCAL FAR *getsockopt)(SOCKET s, int level, int optname,
+	    char FAR * optval, int FAR *optlen);
+    u_short (PASCAL FAR *htons)(u_short hostshort);
+    unsigned long (PASCAL FAR *inet_addr)(const char FAR * cp);
+    char FAR * (PASCAL FAR *inet_ntoa)(struct in_addr in);
+    int (PASCAL FAR *listen)(SOCKET s, int backlog);
+    u_short (PASCAL FAR *ntohs)(u_short netshort);
+    int (PASCAL FAR *recv)(SOCKET s, char FAR * buf, int len, int flags);
+    int (PASCAL FAR *select)(int nfds, fd_set FAR * readfds,
+	    fd_set FAR * writefds, fd_set FAR * exceptfds,
+	    const struct timeval FAR * tiemout);
+    int (PASCAL FAR *send)(SOCKET s, const char FAR * buf, int len, int flags);
+    int (PASCAL FAR *setsockopt)(SOCKET s, int level, int optname,
+	    const char FAR * optval, int optlen);
+    int (PASCAL FAR *shutdown)(SOCKET s, int how);
+    SOCKET (PASCAL FAR *socket)(int af, int type, int protocol);
+    struct hostent FAR * (PASCAL FAR *gethostbyname)(const char FAR * name);
+    struct hostent FAR * (PASCAL FAR *gethostbyaddr)(const char FAR *addr,
+            int addrlen, int addrtype);
+    int (PASCAL FAR *gethostname)(char FAR * name, int namelen);
+    int (PASCAL FAR *getpeername)(SOCKET sock, struct sockaddr FAR *name,
+            int FAR *namelen);
+    struct servent FAR * (PASCAL FAR *getservbyname)(const char FAR * name,
+	    const char FAR * proto);
+    int (PASCAL FAR *getsockname)(SOCKET sock, struct sockaddr FAR *name,
+            int FAR *namelen);
+    int (PASCAL FAR *WSAStartup)(WORD wVersionRequired, LPWSADATA lpWSAData);
+    int (PASCAL FAR *WSACleanup)(void);
+    int (PASCAL FAR *WSAGetLastError)(void);
+    int (PASCAL FAR *WSAAsyncSelect)(SOCKET s, HWND hWnd, u_int wMsg,
+	    long lEvent);
+} winSock;
+
+/*
+ * The following defines declare the messages used on socket windows.
+ */
+
+#define SOCKET_MESSAGE	WM_USER+1
+
+/*
+ * The following structure is used to store the data associated with
+ * each socket.
+ */
+
+typedef struct SocketInfo {
+    Tcl_Channel channel;	   /* Channel associated with this socket. */
+    SOCKET socket;		   /* Windows SOCKET handle. */
+    int flags;			   /* Bit field comprised of the flags
+				    * described below.  */
+    int watchEvents;		   /* OR'ed combination of FD_READ, FD_WRITE,
+                                    * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
+				    * indicate which events are interesting. */
+    int readyEvents;		   /* OR'ed combination of FD_READ, FD_WRITE,
+                                    * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
+				    * indicate which events have occurred. */
+    int selectEvents;		   /* OR'ed combination of FD_READ, FD_WRITE,
+                                    * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
+				    * indicate which events are currently
+				    * being selected. */
+    Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
+    ClientData acceptProcData;	   /* The data for the accept proc. */
+    int lastError;		   /* Error code from last message. */
+    /* CYGNUS LOCAL */
+    int clientChannel;		   /* Created by Tcp_MakeTcpClientChannel. */
+    /* END CYGNUS LOCAL */
+    struct SocketInfo *nextPtr;	   /* The next socket on the global socket
+				    * list. */
+} SocketInfo;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * a socket event occurs.
+ */
+
+typedef struct SocketEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    SOCKET socket;		/* Socket descriptor that is ready.  Used
+				 * to find the SocketInfo structure for
+				 * the file (can't point directly to the
+				 * SocketInfo structure because it could
+				 * go away while the event is queued). */
+} SocketEvent;
+
+/*
+ * This defines the minimum buffersize maintained by the kernel.
+ */
+
+#define TCP_BUFFER_SIZE 4096
+
+/*
+ * The following macros may be used to set the flags field of
+ * a SocketInfo structure.
+ */
+
+#define SOCKET_ASYNC		(1<<0)	/* The socket is in blocking mode. */
+#define SOCKET_EOF		(1<<1)	/* A zero read happened on
+					 * the socket. */
+#define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
+#define SOCKET_PENDING		(1<<3)	/* A message has been sent
+					 * for this socket */
+
+/*
+ * Every open socket has an entry on the following list.
+ */
+
+static SocketInfo *socketList;
+
+/*
+ * Static functions defined in this file.
+ */
+
+static SocketInfo *	CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
+			    int port, char *host, int server, char *myaddr,
+			    int myport, int async));
+static int		CreateSocketAddress _ANSI_ARGS_(
+			    (struct sockaddr_in *sockaddrPtr,
+			    char *host, int port));
+static void		InitSockets _ANSI_ARGS_((void));
+static SocketInfo *	NewSocketInfo _ANSI_ARGS_((SOCKET socket));
+static void		SocketCheckProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		SocketEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+			    int flags));
+static void		SocketExitHandler _ANSI_ARGS_((ClientData clientData));
+static LRESULT CALLBACK	SocketProc _ANSI_ARGS_((HWND hwnd, UINT message,
+			    WPARAM wParam, LPARAM lParam));
+static void		SocketSetupProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static void		TcpAccept _ANSI_ARGS_((SocketInfo *infoPtr));
+static int		TcpBlockProc _ANSI_ARGS_((ClientData instanceData,
+			    int mode));
+static int		TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
+	            	    Tcl_Interp *interp));
+static int		TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+		            Tcl_Interp *interp, char *optionName,
+			    Tcl_DString *optionValue));
+static int		TcpInputProc _ANSI_ARGS_((ClientData instanceData,
+	            	    char *buf, int toRead, int *errorCode));
+static int		TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
+	            	    char *buf, int toWrite, int *errorCode));
+static void		TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+static int		TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static int		WaitForSocketEvent _ANSI_ARGS_((SocketInfo *infoPtr,
+		            int events, int *errorCodePtr));
+
+/*
+ * This structure describes the channel type structure for TCP socket
+ * based IO.
+ */
+
+static Tcl_ChannelType tcpChannelType = {
+    "tcp",		/* Type name. */
+    TcpBlockProc,	/* Set socket into blocking/non-blocking mode. */
+    TcpCloseProc,	/* Close proc. */
+    TcpInputProc,	/* Input proc. */
+    TcpOutputProc,	/* Output proc. */
+    NULL,		/* Seek proc. */
+    NULL,		/* Set option proc. */
+    TcpGetOptionProc,	/* Get option proc. */
+    TcpWatchProc,	/* Initialize notifier to watch this channel. */
+    TcpGetHandleProc,	/* Get an OS handle from channel. */
+};
+
+/*
+ * Define version of Winsock required by Tcl.
+ */
+
+#define WSA_VERSION_REQD MAKEWORD(1,1)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitSockets --
+ *
+ *	Initialize the socket module.  Attempts to load the wsock32.dll
+ *	library and set up the winSock function table.  If successful,
+ *	registers the event window for the socket notifier code.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Dynamically loads wsock32.dll, and registers a new window
+ *	class and creates a window for use in asynchronous socket
+ *	notification.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitSockets()
+{
+    WSADATA wsaData;
+    OSVERSIONINFO info;
+    WNDCLASS class;
+
+    initialized = 1;
+    Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
+
+    /*
+     * Find out if we're running on Win32s.
+     */
+
+    info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+    GetVersionEx(&info);
+
+    /*
+     * Check to see if Sockets are supported on this system.  Since
+     * win32s panics if we call WSAStartup on a system that doesn't
+     * have winsock.dll, we need to look for it on the system first.
+     * If we find winsock, then load the library and initialize the
+     * stub table.
+     */
+
+    if ((info.dwPlatformId != VER_PLATFORM_WIN32s)
+	    || (SearchPath(NULL, "WINSOCK", ".DLL", 0, NULL, NULL) != 0)) {
+	winSock.hInstance = LoadLibrary("wsock32.dll");
+    } else {
+	winSock.hInstance = NULL;
+    }
+
+    /*
+     * Initialize the function table.
+     */
+
+    if (winSock.hInstance == NULL) {
+	return;
+    }
+
+/* CYGNUS LOCAL */
+#ifdef __GNUC__
+/* gcc can't handle `PASCAL FAR' in a cast.  */
+#define PASCAL_FAR
+#else
+#define PASCAL_FAR PASCAL FAR
+#endif
+
+    winSock.accept = (SOCKET (PASCAL_FAR *)(SOCKET s,
+            struct sockaddr FAR *addr, int FAR *addrlen))
+        GetProcAddress(winSock.hInstance, "accept");
+    winSock.bind = (int (PASCAL_FAR *)(SOCKET s,
+            const struct sockaddr FAR *addr, int namelen))
+        GetProcAddress(winSock.hInstance, "bind");
+    winSock.closesocket = (int (PASCAL_FAR *)(SOCKET s))
+        GetProcAddress(winSock.hInstance, "closesocket");
+    winSock.connect = (int (PASCAL_FAR *)(SOCKET s,
+            const struct sockaddr FAR *name, int namelen))
+        GetProcAddress(winSock.hInstance, "connect");
+    winSock.ioctlsocket = (int (PASCAL_FAR *)(SOCKET s, long cmd,
+            u_long FAR *argp)) GetProcAddress(winSock.hInstance, "ioctlsocket");
+    winSock.getsockopt = (int (PASCAL_FAR *)(SOCKET s,
+            int level, int optname, char FAR * optval, int FAR *optlen))
+        GetProcAddress(winSock.hInstance, "getsockopt");
+    winSock.htons = (u_short (PASCAL_FAR *)(u_short hostshort))
+        GetProcAddress(winSock.hInstance, "htons");
+    winSock.inet_addr = (unsigned long (PASCAL_FAR *)(const char FAR *cp))
+        GetProcAddress(winSock.hInstance, "inet_addr");
+    winSock.inet_ntoa = (char FAR * (PASCAL_FAR *)(struct in_addr in))
+        GetProcAddress(winSock.hInstance, "inet_ntoa");
+    winSock.listen = (int (PASCAL_FAR *)(SOCKET s, int backlog))
+        GetProcAddress(winSock.hInstance, "listen");
+    winSock.ntohs = (u_short (PASCAL_FAR *)(u_short netshort))
+        GetProcAddress(winSock.hInstance, "ntohs");
+    winSock.recv = (int (PASCAL_FAR *)(SOCKET s, char FAR * buf,
+            int len, int flags)) GetProcAddress(winSock.hInstance, "recv");
+    winSock.select = (int (PASCAL_FAR *)(int nfds, fd_set FAR * readfds,
+	    fd_set FAR * writefds, fd_set FAR * exceptfds,
+	    const struct timeval FAR * tiemout))
+	GetProcAddress(winSock.hInstance, "select");
+    winSock.send = (int (PASCAL_FAR *)(SOCKET s, const char FAR * buf,
+            int len, int flags)) GetProcAddress(winSock.hInstance, "send");
+    winSock.setsockopt = (int (PASCAL_FAR *)(SOCKET s, int level,
+            int optname, const char FAR * optval, int optlen))
+        GetProcAddress(winSock.hInstance, "setsockopt");
+    winSock.shutdown = (int (PASCAL_FAR *)(SOCKET s, int how))
+        GetProcAddress(winSock.hInstance, "shutdown");
+    winSock.socket = (SOCKET (PASCAL_FAR *)(int af, int type,
+            int protocol)) GetProcAddress(winSock.hInstance, "socket");
+    winSock.gethostbyaddr = (struct hostent FAR * (PASCAL_FAR *)
+            (const char FAR *addr, int addrlen, int addrtype))
+        GetProcAddress(winSock.hInstance, "gethostbyaddr");
+    winSock.gethostbyname = (struct hostent FAR * (PASCAL_FAR *)
+            (const char FAR *name))
+        GetProcAddress(winSock.hInstance, "gethostbyname");
+    winSock.gethostname = (int (PASCAL_FAR *)(char FAR * name,
+            int namelen)) GetProcAddress(winSock.hInstance, "gethostname");
+    winSock.getpeername = (int (PASCAL_FAR *)(SOCKET sock,
+            struct sockaddr FAR *name, int FAR *namelen))
+        GetProcAddress(winSock.hInstance, "getpeername");
+    winSock.getservbyname = (struct servent FAR * (PASCAL_FAR *)
+            (const char FAR * name, const char FAR * proto))
+        GetProcAddress(winSock.hInstance, "getservbyname");
+    winSock.getsockname = (int (PASCAL_FAR *)(SOCKET sock,
+            struct sockaddr FAR *name, int FAR *namelen))
+        GetProcAddress(winSock.hInstance, "getsockname");
+    winSock.WSAStartup = (int (PASCAL_FAR *)(WORD wVersionRequired,
+            LPWSADATA lpWSAData)) GetProcAddress(winSock.hInstance, "WSAStartup");
+    winSock.WSACleanup = (int (PASCAL_FAR *)(void))
+        GetProcAddress(winSock.hInstance, "WSACleanup");
+    winSock.WSAGetLastError = (int (PASCAL_FAR *)(void))
+        GetProcAddress(winSock.hInstance, "WSAGetLastError");
+    winSock.WSAAsyncSelect = (int (PASCAL_FAR *)(SOCKET s, HWND hWnd,
+            u_int wMsg, long lEvent))
+        GetProcAddress(winSock.hInstance, "WSAAsyncSelect");
+/* END CYGNUS LOCAL */
+
+    /*
+     * Now check that all fields are properly initialized. If not, return
+     * zero to indicate that we failed to initialize properly.
+     */
+
+    if ((winSock.hInstance == NULL) ||
+            (winSock.accept == NULL) ||
+            (winSock.bind == NULL) ||
+            (winSock.closesocket == NULL) ||
+            (winSock.connect == NULL) ||
+            (winSock.ioctlsocket == NULL) ||
+            (winSock.getsockopt == NULL) ||
+            (winSock.htons == NULL) ||
+            (winSock.inet_addr == NULL) ||
+            (winSock.inet_ntoa == NULL) ||
+            (winSock.listen == NULL) ||
+            (winSock.ntohs == NULL) ||
+            (winSock.recv == NULL) ||
+            (winSock.select == NULL) ||
+            (winSock.send == NULL) ||
+            (winSock.setsockopt == NULL) ||
+            (winSock.socket == NULL) ||
+            (winSock.gethostbyname == NULL) ||
+            (winSock.gethostbyaddr == NULL) ||
+            (winSock.gethostname == NULL) ||
+            (winSock.getpeername == NULL) ||
+            (winSock.getservbyname == NULL) ||
+            (winSock.getsockname == NULL) ||
+            (winSock.WSAStartup == NULL) ||
+            (winSock.WSACleanup == NULL) ||
+            (winSock.WSAGetLastError == NULL) ||
+            (winSock.WSAAsyncSelect == NULL)) {
+	goto unloadLibrary;
+    }
+    
+    /*
+     * Initialize the winsock library and check the version number.
+     */
+
+    if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
+	goto unloadLibrary;
+    }
+    if (wsaData.wVersion != WSA_VERSION_REQD) {
+	(*winSock.WSACleanup)();
+	goto unloadLibrary;
+    }
+
+    /*
+     * Create the async notification window with a new class.  We
+     * must create a new class to avoid a Windows 95 bug that causes
+     * us to get the wrong message number for socket events if the
+     * message window is a subclass of a static control.
+     */
+
+    class.style = 0;
+    class.cbClsExtra = 0;
+    class.cbWndExtra = 0;
+    class.hInstance = TclWinGetTclInstance();
+    class.hbrBackground = NULL;
+    class.lpszMenuName = NULL;
+    class.lpszClassName = "TclSocket";
+    class.lpfnWndProc = SocketProc;
+    class.hIcon = NULL;
+    class.hCursor = NULL;
+
+    if (RegisterClass(&class)) {
+	winSock.hwnd = CreateWindow("TclSocket", "TclSocket", WS_TILED, 0, 0,
+		0, 0, NULL, NULL, class.hInstance, NULL);
+    } else {
+	winSock.hwnd = NULL;
+    }
+    if (winSock.hwnd == NULL) {
+	TclWinConvertError(GetLastError());
+	(*winSock.WSACleanup)();
+	goto unloadLibrary;
+    }
+    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+    return;
+
+unloadLibrary:
+    FreeLibrary(winSock.hInstance);
+    winSock.hInstance = NULL;
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketExitHandler --
+ *
+ *	Callback invoked during exit clean up to delete the socket
+ *	communication window and to release the WinSock DLL.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+static void
+SocketExitHandler(clientData)
+    ClientData clientData;              /* Not used. */
+{
+    if (winSock.hInstance) {
+	DestroyWindow(winSock.hwnd);
+	UnregisterClass("TclSocket", TclWinGetTclInstance());
+	(*winSock.WSACleanup)();
+	FreeLibrary(winSock.hInstance);
+	winSock.hInstance = NULL;
+    }
+    Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
+    initialized = 0;
+    hostnameInitialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclHasSockets --
+ *
+ *	This function determines whether sockets are available on the
+ *	current system and returns an error in interp if they are not.
+ *	Note that interp may be NULL.
+ *
+ * Results:
+ *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with
+ *	an error in interp.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclHasSockets(interp)
+    Tcl_Interp *interp;
+{
+    if (!initialized) {
+	InitSockets();
+    }
+    
+    if (winSock.hInstance != NULL) {
+	return TCL_OK;
+    }
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "sockets are not available on this system",
+		NULL);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketSetupProc --
+ *
+ *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ *	for an event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+SocketSetupProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    SocketInfo *infoPtr;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Check to see if there is a ready socket.  If so, poll.
+     */
+
+    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->readyEvents & infoPtr->watchEvents) {
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketCheckProc --
+ *
+ *	This procedure is called by Tcl_DoOneEvent to check the socket
+ *	event source for events. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SocketCheckProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    SocketInfo *infoPtr;
+    SocketEvent *evPtr;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Queue events for any ready sockets that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
+
+    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if ((infoPtr->readyEvents & infoPtr->watchEvents)
+		&& !(infoPtr->flags & SOCKET_PENDING)) {
+	    infoPtr->flags |= SOCKET_PENDING;
+	    evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
+	    evPtr->header.proc = SocketEventProc;
+	    evPtr->socket = infoPtr->socket;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketEventProc --
+ *
+ *	This procedure is called by Tcl_ServiceEvent when a socket event
+ *	reaches the front of the event queue.  This procedure is
+ *	responsible for notifying the generic channel code.
+ *
+ * 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 channel callback procedures do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SocketEventProc(evPtr, flags)
+    Tcl_Event *evPtr;		/* Event to service. */
+    int flags;			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    SocketInfo *infoPtr;
+    SocketEvent *eventPtr = (SocketEvent *) evPtr;
+    int mask = 0;
+    int events;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Find the specified socket on the socket list.
+     */
+
+    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->socket == eventPtr->socket) {
+	    break;
+	}
+    }
+
+    /*
+     * Discard events that have gone stale.
+     */
+
+    if (!infoPtr) {
+	return 1;
+    }
+
+    infoPtr->flags &= ~SOCKET_PENDING;
+
+    /*
+     * Handle connection requests directly.
+     */
+
+    if (infoPtr->readyEvents & FD_ACCEPT) {
+	/* CYGNUS LOCAL: If we get an FD_ACCEPT on a client channel,
+	   don't accept it; just set TCL_READABLE.  */
+	if (infoPtr->clientChannel) {
+	    mask |= TCL_READABLE;
+	    infoPtr->readyEvents &= ~(FD_ACCEPT);
+	} else {
+	    TcpAccept(infoPtr);
+	    return 1;
+	}
+    }
+
+    /* CYGNUS LOCAL: Treat FD_CONNECT on a client channel as meaning
+       that the socket is now readable and writable.  Otherwise we
+       won't pick up a failed connect.  */
+    if ((infoPtr->readyEvents & FD_CONNECT) && infoPtr->clientChannel) {
+	mask |= TCL_READABLE | TCL_WRITABLE;
+	infoPtr->readyEvents &= ~(FD_CONNECT);
+    }
+
+    /*
+     * Mask off unwanted events and compute the read/write mask so 
+     * we can notify the channel.
+     */
+
+    events = infoPtr->readyEvents & infoPtr->watchEvents;
+
+    if (events & FD_CLOSE) {
+	/*
+	 * If the socket was closed and the channel is still interested
+	 * in read events, then we need to ensure that we keep polling
+	 * for this event until someone does something with the channel.
+	 * Note that we do this before calling Tcl_NotifyChannel so we don't
+	 * have to watch out for the channel being deleted out from under
+	 * us.  This may cause a redundant trip through the event loop, but
+	 * it's simpler than trying to do unwind protection.
+	 */
+
+	Tcl_Time blockTime = { 0, 0 };
+	Tcl_SetMaxBlockTime(&blockTime);
+	mask |= TCL_READABLE;
+
+	/* CYGNUS LOCAL: For a client channel, set TCL_WRITABLE for
+           FD_CLOSE.  Otherwise a program waiting to write will hang
+           forever.  Besides, select returns if a descriptor selected
+           for write is closed.  */
+	if (infoPtr->clientChannel) {
+	    mask |= TCL_WRITABLE;
+	}
+	/* END CYGNUS LOCAL.  */
+    } else if (events & FD_READ) {
+	fd_set readFds;
+	struct timeval timeout;
+
+	/*
+	 * We must check to see if data is really available, since someone
+	 * could have consumed the data in the meantime.  Turn off async
+	 * notification so select will work correctly.  If the socket is
+	 * still readable, notify the channel driver, otherwise reset the
+	 * async select handler and keep waiting.
+	 */
+
+	(void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd, 0, 0);
+
+	FD_ZERO(&readFds);
+	FD_SET(infoPtr->socket, &readFds);
+	timeout.tv_usec = 0;
+	timeout.tv_sec = 0;
+
+	if ((*winSock.select)(0, &readFds, NULL, NULL, &timeout) != 0) {
+	    mask |= TCL_READABLE;
+	} else {
+	    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+		    SOCKET_MESSAGE, infoPtr->selectEvents);
+	    infoPtr->readyEvents &= ~(FD_READ);
+	}
+
+    }
+    if (events & FD_WRITE) {
+	mask |= TCL_WRITABLE;
+    }
+
+    if (mask) {
+	Tcl_NotifyChannel(infoPtr->channel, mask);
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpBlockProc --
+ *
+ *	Sets a socket into blocking or non-blocking mode.
+ *
+ * Results:
+ *	0 if successful, errno if there was an error.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpBlockProc(instanceData, mode)
+    ClientData	instanceData;	/* The socket to block/un-block. */
+    int mode;			/* TCL_MODE_BLOCKING or
+                                 * TCL_MODE_NONBLOCKING. */
+{
+    SocketInfo *infoPtr = (SocketInfo *) instanceData;
+
+    if (mode == TCL_MODE_NONBLOCKING) {
+	infoPtr->flags |= SOCKET_ASYNC;
+    } else {
+	infoPtr->flags &= ~(SOCKET_ASYNC);
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpCloseProc --
+ *
+ *	This procedure is called by the generic IO level to perform
+ *	channel type specific cleanup on a socket based channel
+ *	when the channel is closed.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+    /* ARGSUSED */
+static int
+TcpCloseProc(instanceData, interp)
+    ClientData instanceData;	/* The socket to close. */
+    Tcl_Interp *interp;		/* Unused. */
+{
+    SocketInfo *infoPtr = (SocketInfo *) instanceData;
+    SocketInfo **nextPtrPtr;
+    int errorCode = 0;
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance != NULL) {
+        
+	/*
+         * Clean up the OS socket handle.  The default Windows setting
+	 * for a socket is SO_DONTLINGER, which does a graceful shutdown
+	 * in the background.
+         */
+    
+        if ((*winSock.closesocket)(infoPtr->socket) == SOCKET_ERROR) {
+            TclWinConvertWSAError((*winSock.WSAGetLastError)());
+            errorCode = Tcl_GetErrno();
+        }
+    }
+
+    /*
+     * Remove the socket from socketList.
+     */
+
+    for (nextPtrPtr = &socketList; (*nextPtrPtr) != NULL;
+	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	if ((*nextPtrPtr) == infoPtr) {
+	    (*nextPtrPtr) = infoPtr->nextPtr;
+	    break;
+	}
+    }
+    ckfree((char *) infoPtr);
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewSocketInfo --
+ *
+ *	This function allocates and initializes a new SocketInfo
+ *	structure.
+ *
+ * Results:
+ *	Returns a newly allocated SocketInfo.
+ *
+ * Side effects:
+ *	Adds the socket to the global socket list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SocketInfo *
+NewSocketInfo(socket)
+    SOCKET socket;
+{
+    SocketInfo *infoPtr;
+
+    infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
+    infoPtr->socket = socket;
+    infoPtr->flags = 0;
+    infoPtr->watchEvents = 0;
+    infoPtr->readyEvents = 0;
+    infoPtr->selectEvents = 0;
+    infoPtr->acceptProc = NULL;
+    infoPtr->lastError = 0;
+    /* CYGNUS LOCAL.  */
+    infoPtr->clientChannel = 0;
+    /* END CYGNUS LOCAL.  */
+    infoPtr->nextPtr = socketList;
+    socketList = infoPtr;
+    return infoPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocket --
+ *
+ *	This function opens a new socket and initializes the
+ *	SocketInfo structure.
+ *
+ * Results:
+ *	Returns a new SocketInfo, or NULL with an error in interp.
+ *
+ * Side effects:
+ *	Adds a new socket to the socketList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SocketInfo *
+CreateSocket(interp, port, host, server, myaddr, myport, async)
+    Tcl_Interp *interp;		/* For error reporting; can be NULL. */
+    int port;			/* Port number to open. */
+    char *host;			/* Name of host on which to open port. */
+    int server;			/* 1 if socket should be a server socket,
+				 * else 0 for a client socket. */
+    char *myaddr;		/* Optional client-side address */
+    int myport;			/* Optional client-side port */
+    int async;			/* If nonzero, connect client socket
+                                 * asynchronously. */
+{
+    u_long flag = 1;			/* Indicates nonblocking mode. */
+    int asyncConnect = 0;		/* Will be 1 if async connect is
+                                         * in progress. */
+    struct sockaddr_in sockaddr;	/* Socket address */
+    struct sockaddr_in mysockaddr;	/* Socket address for client */
+    SOCKET sock;
+    SocketInfo *infoPtr;		/* The returned value. */
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+    
+    if (winSock.hInstance == NULL) {
+        return NULL;
+    }
+    
+    if (! CreateSocketAddress(&sockaddr, host, port)) {
+	goto error;
+    }
+    if ((myaddr != NULL || myport != 0) &&
+	    ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+	goto error;
+    }
+
+    sock = (*winSock.socket)(AF_INET, SOCK_STREAM, 0);
+    if (sock == INVALID_SOCKET) {
+	goto error;
+    }
+
+    /*
+     * Set kernel space buffering
+     */
+
+    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
+
+    if (server) {
+	/*
+	 * Bind to the specified port.  Note that we must not call setsockopt
+	 * with SO_REUSEADDR because Microsoft allows addresses to be reused
+	 * even if they are still in use.
+         *
+         * Bind should not be affected by the socket having already been
+         * set into nonblocking mode. If there is trouble, this is one place
+         * to look for bugs.
+	 */
+    
+	if ((*winSock.bind)(sock, (struct sockaddr *) &sockaddr,
+		sizeof(sockaddr)) == SOCKET_ERROR) {
+            goto error;
+        }
+
+        /*
+         * Set the maximum number of pending connect requests to the
+         * max value allowed on each platform (Win32 and Win32s may be
+         * different, and there may be differences between TCP/IP stacks).
+         */
+        
+	if ((*winSock.listen)(sock, SOMAXCONN) == SOCKET_ERROR) {
+	    goto error;
+	}
+
+	/*
+	 * Add this socket to the global list of sockets.
+	 */
+
+	infoPtr = NewSocketInfo(sock);
+
+	/*
+	 * Set up the select mask for connection request events.
+	 */
+
+	infoPtr->selectEvents = FD_ACCEPT;
+	infoPtr->watchEvents |= FD_ACCEPT;
+
+    } else {
+
+        /*
+         * Try to bind to a local port, if specified.
+         */
+        
+	if (myaddr != NULL || myport != 0) { 
+	    if ((*winSock.bind)(sock, (struct sockaddr *) &mysockaddr,
+		    sizeof(struct sockaddr)) == SOCKET_ERROR) {
+		goto error;
+	    }
+	}            
+    
+	/*
+	 * Set the socket into nonblocking mode if the connect should be
+	 * done in the background.
+	 */
+    
+	if (async) {
+	    if ((*winSock.ioctlsocket)(sock, FIONBIO, &flag) == SOCKET_ERROR) {
+		goto error;
+	    }
+	}
+
+	/*
+	 * Attempt to connect to the remote socket.
+	 */
+
+	if ((*winSock.connect)(sock, (struct sockaddr *) &sockaddr,
+		sizeof(sockaddr)) == SOCKET_ERROR) {
+            TclWinConvertWSAError((*winSock.WSAGetLastError)());
+	    if (Tcl_GetErrno() != EWOULDBLOCK) {
+		goto error;
+	    }
+
+	    /*
+	     * The connection is progressing in the background.
+	     */
+
+	    asyncConnect = 1;
+        }
+
+	/*
+	 * Add this socket to the global list of sockets.
+	 */
+
+	infoPtr = NewSocketInfo(sock);
+
+	/*
+	 * Set up the select mask for read/write events.  If the connect
+	 * attempt has not completed, include connect events.
+	 */
+
+	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
+	if (asyncConnect) {
+	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+	    infoPtr->selectEvents |= FD_CONNECT;
+	}
+    }
+
+    /*
+     * Register for interest in events in the select mask.  Note that this
+     * automatically places the socket into non-blocking mode.
+     */
+
+    (*winSock.ioctlsocket)(sock, FIONBIO, &flag);
+    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+	    SOCKET_MESSAGE, infoPtr->selectEvents);
+
+    return infoPtr;
+
+error:
+    TclWinConvertWSAError((*winSock.WSAGetLastError)());
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "couldn't open socket: ",
+		Tcl_PosixError(interp), (char *) NULL);
+    }
+    if (sock != INVALID_SOCKET) {
+	(*winSock.closesocket)(sock);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocketAddress --
+ *
+ *	This function initializes a sockaddr structure for a host and port.
+ *
+ * Results:
+ *	1 if the host was valid, 0 if the host could not be converted to
+ *	an IP address.
+ *
+ * Side effects:
+ *	Fills in the *sockaddrPtr structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateSocketAddress(sockaddrPtr, host, port)
+    struct sockaddr_in *sockaddrPtr;	/* Socket address */
+    char *host;				/* Host.  NULL implies INADDR_ANY */
+    int port;				/* Port number */
+{
+    struct hostent *hostent;		/* Host database entry */
+    struct in_addr addr;		/* For 64/32 bit madness */
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        Tcl_SetErrno(EFAULT);
+        return 0;
+    }
+    
+    (void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
+    sockaddrPtr->sin_family = AF_INET;
+    sockaddrPtr->sin_port = (*winSock.htons)((short) (port & 0xFFFF));
+    if (host == NULL) {
+	addr.s_addr = INADDR_ANY;
+    } else {
+        addr.s_addr = (*winSock.inet_addr)(host);
+        if (addr.s_addr == INADDR_NONE) {
+            hostent = (*winSock.gethostbyname)(host);
+            if (hostent != NULL) {
+                memcpy((char *) &addr,
+                        (char *) hostent->h_addr_list[0],
+                        (size_t) hostent->h_length);
+            } else {
+#ifdef	EHOSTUNREACH
+                Tcl_SetErrno(EHOSTUNREACH);
+#else
+#ifdef ENXIO
+                Tcl_SetErrno(ENXIO);
+#endif
+#endif
+		return 0;	/* Error. */
+	    }
+	}
+    }
+
+    /*
+     * NOTE: On 64 bit machines the assignment below is rumored to not
+     * do the right thing. Please report errors related to this if you
+     * observe incorrect behavior on 64 bit machines such as DEC Alphas.
+     * Should we modify this code to do an explicit memcpy?
+     */
+
+    sockaddrPtr->sin_addr.s_addr = addr.s_addr;
+    return 1;	/* Success. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForSocketEvent --
+ *
+ *	Waits until one of the specified events occurs on a socket.
+ *
+ * Results:
+ *	Returns 1 on success or 0 on failure, with an error code in
+ *	errorCodePtr.
+ *
+ * Side effects:
+ *	Processes socket events off the system queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForSocketEvent(infoPtr, events, errorCodePtr)
+    SocketInfo *infoPtr;	/* Information about this socket. */
+    int events;			/* Events to look for. */
+    int *errorCodePtr;		/* Where to store errors? */
+{
+    MSG msg;
+    int result = 1;
+    int oldMode;
+
+    /*
+     * Be sure to disable event servicing so we are truly modal.
+     */
+
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+    
+    /*
+     * Reset WSAAsyncSelect so we have a fresh set of events pending.
+     */
+
+    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd, 0, 0);
+    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+	    SOCKET_MESSAGE, infoPtr->selectEvents);
+
+    while (1) {
+	/*
+	 * Process all outstanding messages on the socket window.
+	 */
+
+	while (PeekMessage(&msg, winSock.hwnd, 0, 0, PM_REMOVE)) {
+	    DispatchMessage(&msg);
+	}
+	
+	if (infoPtr->lastError) {
+	    *errorCodePtr = infoPtr->lastError;
+	    result = 0;
+	    break;
+	} else if (infoPtr->readyEvents & events) {
+	    break;
+	} else if (infoPtr->flags & SOCKET_ASYNC) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    result = 0;
+	    break;
+	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitMessage();
+    }
+    
+    (void) Tcl_SetServiceMode(oldMode);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpClient --
+ *
+ *	Opens a TCP client socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed.  An error message is returned
+ *	in the interpreter on failure.
+ *
+ * Side effects:
+ *	Opens a client socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
+    Tcl_Interp *interp;			/* For error reporting; can be NULL. */
+    int port;				/* Port number to open. */
+    char *host;				/* Host on which to open port. */
+    char *myaddr;			/* Client-side address */
+    int myport;				/* Client-side port */
+    int async;				/* If nonzero, should connect
+                                         * client socket asynchronously. */
+{
+    SocketInfo *infoPtr;
+    char channelName[20];
+
+    if (TclHasSockets(interp) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
+    if (infoPtr == NULL) {
+	return NULL;
+    }
+
+    sprintf(channelName, "sock%d", infoPtr->socket);
+
+    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
+	    "auto crlf") == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+    if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
+	    == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+    return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeTcpClientChannel --
+ *
+ *	Creates a Tcl_Channel from an existing client TCP socket.
+ *
+ * Results:
+ *	The Tcl_Channel wrapped around the preexisting TCP socket.
+ *
+ * Side effects:
+ *	None.
+ *
+ * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeTcpClientChannel(sock)
+    ClientData sock;		/* The socket to wrap up into a channel. */
+{
+    SocketInfo *infoPtr;
+    char channelName[20];
+
+    if (TclHasSockets(NULL) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Set kernel space buffering and non-blocking.
+     */
+
+    TclSockMinimumBuffers((SOCKET) sock, TCP_BUFFER_SIZE);
+
+    infoPtr = NewSocketInfo((SOCKET) sock);
+
+    /* CYGNUS LOCAL: Set clientChannel.  */
+    infoPtr->clientChannel = 1;
+
+    /*
+     * Start watching for read/write events on the socket.
+     */
+
+    /* CYGNUS LOCAL: Select for FD_ACCEPT and FD_CONNECT.  */
+    infoPtr->selectEvents = (FD_READ | FD_CLOSE | FD_WRITE
+			     | FD_ACCEPT | FD_CONNECT);
+    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+	    SOCKET_MESSAGE, infoPtr->selectEvents);
+
+    sprintf(channelName, "sock%d", infoPtr->socket);
+    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
+    return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ *	Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed.  An error message is returned
+ *	in the interpreter on failure.
+ *
+ * Side effects:
+ *	Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
+    Tcl_Interp *interp;			/* For error reporting - may be
+                                         * NULL. */
+    int port;				/* Port number to open. */
+    char *host;				/* Name of local host. */
+    Tcl_TcpAcceptProc *acceptProc;	/* Callback for accepting connections
+                                         * from new clients. */
+    ClientData acceptProcData;		/* Data for the callback. */
+{
+    SocketInfo *infoPtr;
+    char channelName[20];
+
+    if (TclHasSockets(interp) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
+    if (infoPtr == NULL) {
+	return NULL;
+    }
+
+    infoPtr->acceptProc = acceptProc;
+    infoPtr->acceptProcData = acceptProcData;
+
+    sprintf(channelName, "sock%d", infoPtr->socket);
+
+    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    (ClientData) infoPtr, 0);
+    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
+	    == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+
+    return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpAccept --
+ *	Accept a TCP socket connection.  This is called by
+ *	SocketEventProc and it in turns calls the registered accept
+ *	procedure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Invokes the accept proc which may invoke arbitrary Tcl code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TcpAccept(infoPtr)
+    SocketInfo *infoPtr;	/* Socket to accept. */
+{
+    SOCKET newSocket;
+    SocketInfo *newInfoPtr;
+    struct sockaddr_in addr;
+    int len;
+    char channelName[20];
+
+    /*
+     * Accept the incoming connection request.
+     */
+
+    len = sizeof(struct sockaddr_in);
+    newSocket = (*winSock.accept)(infoPtr->socket, (struct sockaddr *)&addr,
+	    &len);
+
+    /*
+     * Clear the ready mask so we can detect the next connection request.
+     * Note that connection requests are level triggered, so if there is
+     * a request already pending, a new event will be generated.
+     */
+
+    infoPtr->readyEvents &= ~(FD_ACCEPT);
+
+    if (newSocket == INVALID_SOCKET) {
+        return;
+    }
+
+    /*
+     * Add this socket to the global list of sockets.
+     */
+
+    newInfoPtr = NewSocketInfo(newSocket);
+
+    /*
+     * Select on read/write events and create the channel.
+     */
+
+    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
+    (void) (*winSock.WSAAsyncSelect)(newInfoPtr->socket, winSock.hwnd, 
+	    SOCKET_MESSAGE, newInfoPtr->selectEvents);
+
+    sprintf(channelName, "sock%d", newInfoPtr->socket);
+    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
+    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
+	    "auto crlf") == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
+        return;
+    }
+    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
+	    == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
+        return;
+    }
+
+    /*
+     * Invoke the accept callback procedure.
+     */
+
+    if (infoPtr->acceptProc != NULL) {
+	(infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
+		(*winSock.inet_ntoa)(addr.sin_addr),
+		(*winSock.ntohs)(addr.sin_port));
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpInputProc --
+ *
+ *	This procedure is called by the generic IO level to read data from
+ *	a socket based channel.
+ *
+ * Results:
+ *	The number of bytes read or -1 on error.
+ *
+ * Side effects:
+ *	Consumes input from the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpInputProc(instanceData, buf, toRead, errorCodePtr)
+    ClientData instanceData;		/* The socket state. */
+    char *buf;				/* Where to store data. */
+    int toRead;				/* Maximum number of bytes to read. */
+    int *errorCodePtr;			/* Where to store error codes. */
+{
+    SocketInfo *infoPtr = (SocketInfo *) instanceData;
+    int bytesRead;
+    int error;
+    
+    *errorCodePtr = 0;
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        *errorCodePtr = EFAULT;
+        return -1;
+    }
+
+    /*
+     * First check to see if EOF was already detected, to prevent
+     * calling the socket stack after the first time EOF is detected.
+     */
+
+    if (infoPtr->flags & SOCKET_EOF) {
+	return 0;
+    }
+
+    /*
+     * Check to see if the socket is connected before trying to read.
+     */
+
+    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
+	    && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
+	return -1;
+    }
+    
+    /*
+     * No EOF, and it is connected, so try to read more from the socket.
+     * Note that we clear the FD_READ bit because read events are level
+     * triggered so a new event will be generated if there is still data
+     * available to be read.  We have to simulate blocking behavior here
+     * since we are always using non-blocking sockets.
+     */
+
+    while (1) {
+	(void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+		0, 0);
+	bytesRead = (*winSock.recv)(infoPtr->socket, buf, toRead, 0);
+	infoPtr->readyEvents &= ~(FD_READ);
+
+	/*
+	 * Check for end-of-file condition or successful read.
+	 */
+
+	if (bytesRead == 0) {
+	    infoPtr->flags |= SOCKET_EOF;
+	}
+	if (bytesRead != SOCKET_ERROR) {
+	    break;
+	}
+
+	/*
+	 * If an error occurs after the FD_CLOSE has arrived,
+	 * then ignore the error and report an EOF.
+	 */
+
+	if (infoPtr->readyEvents & FD_CLOSE) {
+	    infoPtr->flags |= SOCKET_EOF;
+	    bytesRead = 0;
+	    break;
+	}
+
+	/*
+	 * Check for error condition or underflow in non-blocking case.
+	 */
+
+	error = (*winSock.WSAGetLastError)();
+	if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
+	    TclWinConvertWSAError(error);
+	    *errorCodePtr = Tcl_GetErrno();
+	    bytesRead = -1;
+	    break;
+	}
+
+	/*
+	 * In the blocking case, wait until the file becomes readable
+	 * or closed and try again.
+	 */
+
+	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
+	    bytesRead = -1;
+	    break;
+	}
+    }
+    
+    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+	    SOCKET_MESSAGE, infoPtr->selectEvents);
+    return bytesRead;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpOutputProc --
+ *
+ *	This procedure is called by the generic IO level to write data
+ *	to a socket based channel.
+ *
+ * Results:
+ *	The number of bytes written or -1 on failure.
+ *
+ * Side effects:
+ *	Produces output on the socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;		/* The socket state. */
+    char *buf;				/* Where to get data. */
+    int toWrite;			/* Maximum number of bytes to write. */
+    int *errorCodePtr;			/* Where to store error codes. */
+{
+    SocketInfo *infoPtr = (SocketInfo *) instanceData;
+    int bytesWritten;
+    int error;
+
+    *errorCodePtr = 0;
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        *errorCodePtr = EFAULT;
+        return -1;
+    }
+    
+    /*
+     * Check to see if the socket is connected before trying to write.
+     */
+    
+    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
+	    && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
+	return -1;
+    }
+
+    while (1) {
+	(void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+		0, 0);
+	bytesWritten = (*winSock.send)(infoPtr->socket, buf, toWrite, 0);
+	if (bytesWritten != SOCKET_ERROR) {
+	    /*
+	     * Since Windows won't generate a new write event until we hit
+	     * an overflow condition, we need to force the event loop to
+	     * poll until the condition changes.
+	     */
+
+	    if (infoPtr->watchEvents & FD_WRITE) {
+		Tcl_Time blockTime = { 0, 0 };
+		Tcl_SetMaxBlockTime(&blockTime);
+	    }		
+	    break;
+	}
+	
+	/*
+	 * Check for error condition or overflow.  In the event of overflow, we
+	 * need to clear the FD_WRITE flag so we can detect the next writable
+	 * event.  Note that Windows only sends a new writable event after a
+	 * send fails with WSAEWOULDBLOCK.
+	 */
+
+	error = (*winSock.WSAGetLastError)();
+	if (error == WSAEWOULDBLOCK) {
+	    infoPtr->readyEvents &= ~(FD_WRITE);
+	    if (infoPtr->flags & SOCKET_ASYNC) {
+		*errorCodePtr = EWOULDBLOCK;
+		bytesWritten = -1;
+		break;
+	    } 
+	} else {
+	    TclWinConvertWSAError(error);
+	    *errorCodePtr = Tcl_GetErrno();
+	    bytesWritten = -1;
+	    break;
+	}
+
+	/*
+	 * In the blocking case, wait until the file becomes writable
+	 * or closed and try again.
+	 */
+
+	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
+	    bytesWritten = -1;
+	    break;
+	}
+    }
+
+    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
+	    SOCKET_MESSAGE, infoPtr->selectEvents);
+    return bytesWritten;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetOptionProc --
+ *
+ *	Computes an option value for a TCP socket based channel, or a
+ *	list of all options and their values.
+ *
+ *	Note: This code is based on code contributed by John Haxby.
+ *
+ * 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.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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. */
+{
+    SocketInfo *infoPtr;
+    struct sockaddr_in sockname;
+    struct sockaddr_in peername;
+    struct hostent *hostEntPtr;
+    SOCKET sock;
+    int size = sizeof(struct sockaddr_in);
+    size_t len = 0;
+    char buf[128];
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+	if (interp) {
+	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
+	}
+        return TCL_ERROR;
+    }
+    
+    infoPtr = (SocketInfo *) instanceData;
+    sock = (int) infoPtr->socket;
+    if (optionName != (char *) NULL) {
+        len = strlen(optionName);
+    }
+
+    if ((len == 0) ||
+            ((len > 1) && (optionName[1] == 'p') &&
+                    (strncmp(optionName, "-peername", len) == 0))) {
+        if ((*winSock.getpeername)(sock, (struct sockaddr *) &peername, &size)
+                == 0) {
+            if (len == 0) {
+                Tcl_DStringAppendElement(dsPtr, "-peername");
+                Tcl_DStringStartSublist(dsPtr);
+            }
+            Tcl_DStringAppendElement(dsPtr,
+                    (*winSock.inet_ntoa)(peername.sin_addr));
+            hostEntPtr = (*winSock.gethostbyaddr)(
+                (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
+                AF_INET);
+            if (hostEntPtr != (struct hostent *) NULL) {
+                Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+            } else {
+                Tcl_DStringAppendElement(dsPtr,
+                        (*winSock.inet_ntoa)(peername.sin_addr));
+            }
+            sprintf(buf, "%d", (*winSock.ntohs)(peername.sin_port));
+            Tcl_DStringAppendElement(dsPtr, buf);
+            if (len == 0) {
+                Tcl_DStringEndSublist(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). {copied from unix/tclUnixChan.c}
+             */
+            if (len) {
+		TclWinConvertWSAError((*winSock.WSAGetLastError)());
+                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 ((*winSock.getsockname)(sock, (struct sockaddr *) &sockname, &size)
+                == 0) {
+            if (len == 0) {
+                Tcl_DStringAppendElement(dsPtr, "-sockname");
+                Tcl_DStringStartSublist(dsPtr);
+            }
+            Tcl_DStringAppendElement(dsPtr,
+                    (*winSock.inet_ntoa)(sockname.sin_addr));
+            hostEntPtr = (*winSock.gethostbyaddr)(
+                (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
+                AF_INET);
+            if (hostEntPtr != (struct hostent *) NULL) {
+                Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+            } else {
+                Tcl_DStringAppendElement(dsPtr,
+                        (*winSock.inet_ntoa)(sockname.sin_addr));
+            }
+            sprintf(buf, "%d", (*winSock.ntohs)(sockname.sin_port));
+            Tcl_DStringAppendElement(dsPtr, buf);
+            if (len == 0) {
+                Tcl_DStringEndSublist(dsPtr);
+            } else {
+                return TCL_OK;
+            }
+        } else {
+	    if (interp) {
+		TclWinConvertWSAError((*winSock.WSAGetLastError)());
+		Tcl_AppendResult(interp, "can't get sockname: ",
+				 Tcl_PosixError(interp),
+				 (char *) NULL);
+	    }
+	    return TCL_ERROR;
+	}
+    }
+
+    if (len > 0) {
+        return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpWatchProc --
+ *
+ *	Informs the channel driver of the events that the generic
+ *	channel code wishes to receive on this socket.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May cause the notifier to poll if any of the specified 
+ *	conditions are already true.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    SocketInfo *infoPtr = (SocketInfo *) instanceData;
+    
+    /*
+     * Update the watch events mask.
+     */
+    
+    infoPtr->watchEvents = 0;
+    if (mask & TCL_READABLE) {
+	infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
+    }
+    if (mask & TCL_WRITABLE) {
+	infoPtr->watchEvents |= (FD_WRITE);
+	/* CYGNUS LOCAL: For a client channel, also look for FD_CLOSE
+           when waiting for a socket to be writable.  */
+	if (infoPtr->clientChannel) {
+	    infoPtr->watchEvents |= (FD_CLOSE);
+	}
+    }
+
+    /* CYGNUS LOCAL: For a client channel, also look for FD_CONNECT
+       events.  */
+    if (infoPtr->clientChannel) {
+	infoPtr->watchEvents |= (FD_CONNECT);
+    }
+
+    /*
+     * If there are any conditions already set, then tell the notifier to poll
+     * rather than block.
+     */
+
+    if (infoPtr->readyEvents & infoPtr->watchEvents) {
+	Tcl_Time blockTime = { 0, 0 };
+	Tcl_SetMaxBlockTime(&blockTime);
+    }		
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetProc --
+ *
+ *	Called from Tcl_GetChannelFile to retrieve an OS handle from inside
+ *	a TCP socket based channel.
+ *
+ * Results:
+ *	Returns TCL_OK with the socket in handlePtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpGetHandleProc(instanceData, direction, handlePtr)
+    ClientData instanceData;	/* The socket state. */
+    int direction;		/* Not used. */
+    ClientData *handlePtr;	/* Where to store the handle.  */
+{
+    SocketInfo *statePtr = (SocketInfo *) instanceData;
+
+    *handlePtr = (ClientData) statePtr->socket;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketProc --
+ *
+ *	This function is called when WSAAsyncSelect has been used
+ *	to register interest in a socket event, and the event has
+ *	occurred.
+ *
+ * Results:
+ *	0 on success.
+ *
+ * Side effects:
+ *	The flags for the given socket are updated to reflect the
+ *	event that occured.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+SocketProc(hwnd, message, wParam, lParam)
+    HWND hwnd;
+    UINT message;
+    WPARAM wParam;
+    LPARAM lParam;
+{
+    int event, error;
+    SOCKET socket;
+    SocketInfo *infoPtr;
+
+    if (message != SOCKET_MESSAGE) {
+	return DefWindowProc(hwnd, message, wParam, lParam);
+    }
+
+    event = WSAGETSELECTEVENT(lParam);
+    error = WSAGETSELECTERROR(lParam);
+    socket = (SOCKET) wParam;
+
+    /*
+     * Find the specified socket on the socket list and update its
+     * eventState flag.
+     */
+
+    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->socket == socket) {
+	    /*
+	     * Update the socket state.
+	     */
+
+	    if (event & FD_CLOSE) {
+		infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+	    }
+	    if (event & FD_CONNECT) {
+		/*
+		 * The socket is now connected, so clear the async connect
+		 * flag.
+		 */
+
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+		/*
+		 * Remember any error that occurred so we can report
+		 * connection failures.
+		 */
+
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertWSAError(error);
+		    infoPtr->lastError = Tcl_GetErrno();
+		}
+
+	    } 
+	    infoPtr->readyEvents |= event;
+	    break;
+	}
+    }
+
+    /*
+     * Flush the Tcl event queue before returning to the event loop.
+     */
+
+    Tcl_ServiceAll();
+
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetHostName --
+ *
+ *	Returns the name of the local host.
+ *
+ * Results:
+ *	A string containing the network name for this machine, or
+ *	an empty string if we can't figure out the name.  The caller 
+ *	must not modify or free this string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetHostName()
+{
+    DWORD length;
+    char *p;
+
+    if (hostnameInitialized) {
+        return hostname;
+    }
+
+    if (TclHasSockets(NULL) == TCL_OK) {
+	if ((*winSock.gethostname)(hostname, sizeof(hostname)) == 0) {
+	    hostnameInitialized = 1;
+	    return hostname;
+	}
+    }
+    length = sizeof(hostname);
+    if (GetComputerName(hostname, &length) != 0) {
+	for (p = hostname; *p != '\0'; p++) {
+	    if (isupper(*((unsigned char *) p))) {
+		*p = (char) tolower(*((unsigned char *) p));
+	    }
+	}
+    } else {
+	hostname[0] = '\0';
+    }
+    hostnameInitialized = 1;
+    return hostname;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetSockOpt, et al. --
+ *
+ *	These functions are wrappers that let us bind the WinSock
+ *	API dynamically so we can run on systems that don't have
+ *	the wsock32.dll.  We need wrappers for these interfaces
+ *	because they are called from the generic Tcl code.
+ *
+ * Results:
+ *	As defined for each function.
+ *
+ * Side effects:
+ *	As defined for each function.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int PASCAL FAR
+TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval,
+	int FAR *optlen)
+{
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        return SOCKET_ERROR;
+    }
+    
+    return (*winSock.getsockopt)(s, level, optname, optval, optlen);
+}
+
+int PASCAL FAR
+TclWinSetSockOpt(SOCKET s, int level, int optname, const char FAR * optval,
+	int optlen)
+{
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        return SOCKET_ERROR;
+    }
+
+    return (*winSock.setsockopt)(s, level, optname, optval, optlen);
+}
+
+u_short PASCAL FAR
+TclWinNToHS(u_short netshort)
+{
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        return (u_short) -1;
+    }
+
+    return (*winSock.ntohs)(netshort);
+}
+
+struct servent FAR * PASCAL FAR
+TclWinGetServByName(const char FAR * name, const char FAR * proto)
+{
+    /*
+     * Check that WinSock is initialized; do not call it if not, to
+     * prevent system crashes. This can happen at exit time if the exit
+     * handler for WinSock ran before other exit handlers that want to
+     * use sockets.
+     */
+
+    if (winSock.hInstance == NULL) {
+        return (struct servent FAR *) NULL;
+    }
+
+    return (*winSock.getservbyname)(name, proto);
+}
diff --git a/tcl/win/tclWinTest.c b/tcl/win/tclWinTest.c
new file mode 100644
index 00000000000..bfb5d2e7152
--- /dev/null
+++ b/tcl/win/tclWinTest.c
@@ -0,0 +1,130 @@
+/* 
+ * tclWinTest.c --
+ *
+ *	Contains commands for platform specific tests on Windows.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+int			TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+static int		TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclplatformtestInit --
+ *
+ *	Defines commands that test platform specific functionality for
+ *	Unix platforms.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclplatformtestInit(interp)
+    Tcl_Interp *interp;		/* Interpreter to add commands to. */
+{
+    /*
+     * Add commands for platform specific tests for Windows here.
+     */
+
+    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;
+	MSG msg;
+	int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+
+	/*
+	 * Save the old stack frame pointer and set up the current frame.
+	 */
+
+	oldFramePtr = framePtr;
+	framePtr = &done;
+
+	/*
+	 * Enter a standard Windows event loop until the flag changes.
+	 * Note that we do not explicitly call Tcl_ServiceEvent().
+	 */
+
+	done = 0;
+	while (!done) {
+	    if (!GetMessage(&msg, NULL, 0, 0)) {
+		/*
+		 * The application is exiting, so repost the quit message
+		 * and start unwinding.
+		 */
+
+		PostQuitMessage(msg.wParam);
+		break;
+	    }
+	    TranslateMessage(&msg);
+	    DispatchMessage(&msg);
+	}
+	(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;
+}
diff --git a/tcl/win/tclWinTime.c b/tcl/win/tclWinTime.c
new file mode 100644
index 00000000000..c29a9ab9913
--- /dev/null
+++ b/tcl/win/tclWinTime.c
@@ -0,0 +1,373 @@
+/* 
+ * tclWinTime.c --
+ *
+ *	Contains Windows specific versions of Tcl functions that
+ *	obtain time values from the operating system.
+ *
+ * Copyright 1995 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#define SECSPERDAY (60L * 60L * 24L)
+#define SECSPERYEAR (SECSPERDAY * 365L)
+#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)
+
+/*
+ * The following arrays contain the day of year for the last day of
+ * each month, where index 1 is January.
+ */
+
+static int normalDays[] = {
+    -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
+};
+
+static int leapDays[] = {
+    -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
+};
+
+/*
+ * Declarations for functions defined later in this file.
+ */
+
+static struct tm *	ComputeGMT _ANSI_ARGS_((const time_t *tp));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetSeconds --
+ *
+ *	This procedure returns the number of seconds from the epoch.
+ *	On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ *
+ * Results:
+ *	Number of seconds from the epoch.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetSeconds()
+{
+    return (unsigned long) time((time_t *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetClicks --
+ *
+ *	This procedure returns a value that represents the highest
+ *	resolution clock available on the system.  There are no
+ *	guarantees on what the resolution will be.  In Tcl we will
+ *	call this value a "click".  The start time is also system
+ *	dependant.
+ *
+ * Results:
+ *	Number of clicks from some start time.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetClicks()
+{
+    return GetTickCount();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTimeZone --
+ *
+ *	Determines the current timezone.  The method varies wildly
+ *	between different Platform implementations, so its hidden in
+ *	this function.
+ *
+ * Results:
+ *	Minutes west of GMT.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetTimeZone (currentTime)
+    unsigned long  currentTime;
+{
+    int timeZone;
+
+    tzset();
+    timeZone = _timezone / 60;
+
+    return timeZone;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTime --
+ *
+ *	Gets the current system time in seconds and microseconds
+ *	since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ *	Returns the current time in timePtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpGetTime(timePtr)
+    Tcl_Time *timePtr;		/* Location to store time information. */
+{
+    struct timeb t;
+
+    ftime(&t);
+    timePtr->sec = t.time;
+    timePtr->usec = t.millitm * 1000;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTZName --
+ *
+ *	Gets the current timezone string.
+ *
+ * Results:
+ *	Returns a pointer to a static string, or NULL on failure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetTZName()
+{
+    tzset();
+    if (_daylight && _tzname[1] != NULL) {
+	return _tzname[1];
+    } else {
+	return _tzname[0];
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetDate --
+ *
+ *	This function converts between seconds and struct tm.  If
+ *	useGMT is true, then the returned date will be in Greenwich
+ *	Mean Time (GMT).  Otherwise, it will be in the local time zone.
+ *
+ * Results:
+ *	Returns a static tm structure.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+struct tm *
+TclpGetDate(tp, useGMT)
+    const time_t *tp;
+    int useGMT;
+{
+    struct tm *tmPtr;
+    long time;
+
+    if (!useGMT) {
+	tzset();
+
+	/*
+	 * If we are in the valid range, let the C run-time library
+	 * handle it.  Otherwise we need to fake it.  Note that this
+	 * algorithm ignores daylight savings time before the epoch.
+	 */
+
+	time = *tp - _timezone;
+	if (time >= 0) {
+	    return localtime(tp);
+	}
+	
+	/*
+	 * If we aren't near to overflowing the long, just add the bias and
+	 * use the normal calculation.  Otherwise we will need to adjust
+	 * the result at the end.
+	 */
+
+	if (*tp < (LONG_MAX - 2 * SECSPERDAY)
+		&& *tp > (LONG_MIN + 2 * SECSPERDAY)) {
+	    tmPtr = ComputeGMT(&time);
+	} else {
+	    tmPtr = ComputeGMT(tp);
+
+	    tzset();
+
+	    /*
+	     * Add the bias directly to the tm structure to avoid overflow.
+	     * Propagate seconds overflow into minutes, hours and days.
+	     */
+
+	    time = tmPtr->tm_sec - _timezone;
+	    tmPtr->tm_sec = (int)(time % 60);
+	    if (tmPtr->tm_sec < 0) {
+		tmPtr->tm_sec += 60;
+		time -= 60;
+	    }
+    
+	    time = tmPtr->tm_min + time/60;
+	    tmPtr->tm_min = (int)(time % 60);
+	    if (tmPtr->tm_min < 0) {
+		tmPtr->tm_min += 60;
+		time -= 60;
+	    }
+
+	    time = tmPtr->tm_hour + time/60;
+	    tmPtr->tm_hour = (int)(time % 24);
+	    if (tmPtr->tm_hour < 0) {
+		tmPtr->tm_hour += 24;
+		time -= 24;
+	    }
+
+	    time /= 24;
+	    tmPtr->tm_mday += time;
+	    tmPtr->tm_yday += time;
+	    tmPtr->tm_wday = (tmPtr->tm_wday + time) % 7;
+	}
+    } else {
+	tmPtr = ComputeGMT(tp);
+    }
+    return tmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeGMT --
+ *
+ *	This function computes GMT given the number of seconds since
+ *	the epoch (midnight Jan 1 1970).
+ *
+ * Results:
+ *	Returns a statically allocated struct tm.
+ *
+ * Side effects:
+ *	Updates the values of the static struct tm.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static struct tm *
+ComputeGMT(tp)
+    const time_t *tp;
+{
+    static struct tm tm;	  /* This should be allocated per thread.*/
+    long tmp, rem;
+    int isLeap;
+    int *days;
+
+    /*
+     * Compute the 4 year span containing the specified time.
+     */
+
+    tmp = *tp / SECSPER4YEAR;
+    rem = *tp % SECSPER4YEAR;
+
+    /*
+     * Correct for weird mod semantics so the remainder is always positive.
+     */
+
+    if (rem < 0) {
+	tmp--;
+	rem += SECSPER4YEAR;
+    }
+
+    /*
+     * Compute the year after 1900 by taking the 4 year span and adjusting
+     * for the remainder.  This works because 2000 is a leap year, and
+     * 1900/2100 are out of the range.
+     */
+
+    tmp = (tmp * 4) + 70;
+    isLeap = 0;
+    if (rem >= SECSPERYEAR) {			  /* 1971, etc. */
+	tmp++;
+	rem -= SECSPERYEAR;
+	if (rem >= SECSPERYEAR) {		  /* 1972, etc. */
+	    tmp++;
+	    rem -= SECSPERYEAR;
+	    if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */
+		tmp++;
+		rem -= SECSPERYEAR + SECSPERDAY;
+	    } else {
+		isLeap = 1;
+	    }
+	}
+    }
+    tm.tm_year = tmp;
+
+    /*
+     * Compute the day of year and leave the seconds in the current day in
+     * the remainder.
+     */
+
+    tm.tm_yday = rem / SECSPERDAY;
+    rem %= SECSPERDAY;
+    
+    /*
+     * Compute the time of day.
+     */
+
+    tm.tm_hour = rem / 3600;
+    rem %= 3600;
+    tm.tm_min = rem / 60;
+    tm.tm_sec = rem % 60;
+
+    /*
+     * Compute the month and day of month.
+     */
+
+    days = (isLeap) ? leapDays : normalDays;
+    for (tmp = 1; days[tmp] < tm.tm_yday; tmp++) {
+    }
+    tm.tm_mon = --tmp;
+    tm.tm_mday = tm.tm_yday - days[tmp];
+
+    /*
+     * Compute day of week.  Epoch started on a Thursday.
+     */
+
+    tm.tm_wday = (*tp / SECSPERDAY) + 4;
+    if ((*tp % SECSPERDAY) < 0) {
+	tm.tm_wday--;
+    }
+    tm.tm_wday %= 7;
+    if (tm.tm_wday < 0) {
+	tm.tm_wday += 7;
+    }
+
+    return &tm;
+}
diff --git a/tcl/win/tclsh.rc b/tcl/win/tclsh.rc
new file mode 100644
index 00000000000..b5e1f4e4f56
--- /dev/null
+++ b/tcl/win/tclsh.rc
@@ -0,0 +1,36 @@
+// RCS: @(#) $Id$
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <tcl.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ FILEFLAGSMASK 	0x3fL
+ FILEFLAGS 	0x0L
+ FILEOS 	0x4L
+ FILETYPE	0x1L
+ FILESUBTYPE 	0x0L
+BEGIN
+    BLOCK "StringFileInfo"
+    BEGIN
+        BLOCK "040904b0"
+        BEGIN
+            VALUE "FileDescription", "Tclsh Application\0"
+            VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".exe\0"
+            VALUE "CompanyName", "Sun Microsystems, Inc\0"
+            VALUE "FileVersion", TCL_PATCH_LEVEL
+            VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
+            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
+            VALUE "ProductVersion", TCL_PATCH_LEVEL
+        END
+    END
+    BLOCK "VarFileInfo"
+    BEGIN
+        VALUE "Translation", 0x409, 1200
+    END
+END
+