Tcl Source Code

2012-04-28  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: Properly close nonblocking channels even when
	not flushing them.

2012-05-03  Jan Nijtmans  <[email protected]>

	* compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
	will be upgraded as soon as the official build is available)

2012-05-03  Don Porter  <[email protected]>

	* tests/socket.test:	[Bug 3428754]: Test socket-14.2 tolerate
	[socket -async] connection that connects synchronously.

	                      checking for the exact error message.

2010-03-30  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput,
	(ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption,
	(ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve
	ReflectedChannel* structures across handler invokations, to avoid
	crashes when the handler implementation induces nested callbacks and
	destruction of the channel deep inside such a nesting.

2010-03-30  Don Porter  <[email protected]>

	* generic/tclObj.c (Tcl_GetCommandFromObj):     [Bug 2979402]: Reorder
	the validity tests on internal rep of a "cmdName" value to avoid

	* generic/tclBinary.c:	[Bug 2922555]: Handle completely invalid input
	* tests/binary.test:	to the decode methods.

2009-12-28  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in (trace-shell, trace-test): [FRQ 1083288]: Added
	targets to allow easier tracing of shell and test invokations.

	* unix/configure.in: [Bug 942170]:	Detect the st_blocks field of
	* generic/tclCmdAH.c (StoreStatData):	'struct stat' correctly.
	* generic/tclFileName.c (Tcl_GetBlocksFromStat):
	* generic/tclIOUtil.c (Tcl_Stat):

	* generic/tclInterp.c (TimeLimitCallback): [Bug 2891362]: Ensure that

	* tools/tclZIC.tcl
	* tools/tsdPerf.c

2009-11-17  Andreas Kupries  <[email protected]>

	* unix/tclUnixChan.c (TtyParseMode): Partial undo of Donal's tidy-up
	from a few days ago (2009-11-9, not in ChangeLog). It seems that
	strchr is apparently a macro on AIX and reacts badly to pre-processor
	directives in its arguments.

2009-11-16  Alexandre Ferrieux  <[email protected]>

	* generic/tclEncoding.c:  [Bug 2891556]: Fix and improve test to
	* generic/tclTest.c:	  detect similar manifestations in the future.
	* tests/encoding.test:    Add tcltest support for finalization.

2009-10-20  Don Porter  <[email protected]>

	* unix/Makefile.in:	Removed the long outdated and broken targets
	package-* that were for building Solaris packages.  Appears that the
	pieces needed for these targets to function have never been present in
	the current era of Tcl development and belong completely to Tcl
	pre-history.

2009-10-19  Don Porter  <[email protected]>

	* generic/tclIO.c:      [Patch 2107634]: Revised ReadChars and
	FilterInputBytes routines to permit reads to continue up to the string
	limits of Tcl values.  Before revisions, large read attempts could
	panic when as little as half the limiting value length was reached.

	customize SHLIB_VERSION on BSD-derived systems. Thanks to Stuart
	Cassoff for his help.
	* unix/configure: Autoconf 2.59

2009-01-19  David Gravereaux  <[email protected]>

	* win/build.vc.bat: Improved tools detection and error message
	* win/makefile.vc: Reorganized the $(TCLOBJ) file list into seperate
	parts for easier maintenance. Matched all sources built using -GL to
	both $(lib) and $(link) to use -LTCG and avoid a warning message.
	Addressed the over-building nature of the htmlhelp target by moving
	from a pseudo target to a real target dependent on the entire docs/
	directory contents.
	* win/nmakehlp.c: Removed -g option and GrepForDefine() func as it
	isn't being used anymore. The -V option method is much better.

	of the variable.

	* tests/autoMkindex.test:
	* tests/pkgMkIndex.test: Explicitly cd to ::tcltest::testsDirectory at
	the beginning of the test run

	* tests/basic.test: Use version information defined in tcltest instead
	of hardcoded version number

	* tests/socket.test: package require tcltest before attempting to use
	variable defined in tcltest namespace

	* tests/unixInit.test:
	* tests/unixNotfy.test: Added explicit exits needed to avoid problems
	when the tests area run in wish.

2000-11-23  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fixed memory leak from [Bug
	119398]

	* library/init.tcl (unknown): Added specific level parameters to
	all uplevel invokations to boost performance; didn't dare touch
	the "namespace inscope" stuff though, since it looks sensitive
	to me!  Should fix [Bug 123217], though testing is tricky...

2000-11-21  Andreas Kupries  <[email protected]>

	All of the changes below are described in TIP #7 ~ Specification and
	result from the application of the patch contained therein. Creator of

	* doc/tcltest2.n: Code and documentation cleanup. Modified -verbose to
	take list of keywords as well as string of letters. Removed Tcl
	version information from tcltest. Removed tcltest::grep from tcltest
	package. Added optional 3rd directory argument to
	makeFile/makeDirectory and removeFile/removeDirectory.

	* tests/basic.test: Changed references to tcltest::tclVersion to
	hardcoded numbers.
	* generic/tcl.h: Changed reference to tcltest2.tcl and tcltest.tcl in
	comments to tests/basic.test.

2000-10-06  David Gravereaux  <[email protected]>

	* win/tclWinChan.c: moved Win2K bug case test with GetStdHandle() from
	TclpGetDefaultStdChannel into Tcl_MakeFileChannel to enable a more

	* library/msgcat1.0/msgcat.tcl: Applied patches from Laurent Duperval,
	to add mcmax function, which computes the length of the longest of
	several translated strings. Bumped version number to 1.1.

2000-06-27  Eric Melski  <[email protected]>

	* tests/stringObj.test: Tweaked tests to avoid hardcoded high-ASCII
	characters (which will fail in multibyte locales); instead used \uXXXX
	syntax. [Bug: 3842].

2000-06-26  Eric Melski  <[email protected]>

	* doc/package.n: Corrected information about [package forget]
	arguments [Bug: 5418].

	Tcl_InitMemory, and Tcl_ValidateAllMemory [Bug: 1816, 1835].

	* generic/tclCkalloc.c: Fixed some function headers.

	* unix/mkLinks: Regen'd with new mkLinks.tcl.

	* unix/mkLinks.tcl: Fixed indentation, made link setup more
	intelligent (only do one existance test per man page, instead of one
	per function).

	* doc/library.n: Fixed .SH NAME macro to include each function
	documented on the page, so that mkLinks will know about the functions
	listed there, and so that the Windows help file index will get set up
	correctly [Bug: 1898, 5273].

	fixed http::ncode so that it actually gives you back the http return
	code (i.e. 200, 404, etc.) instead of the first digit of the version
	of HTTP being used (i.e. 1).

2000-04-21  Brent Welch <[email protected]>

	* library/http2.1/http.tcl: More thrashing with the "server closes
	without reading post data" scenario. Reverted to the previous filevent
	configuratiuon, which seems to work better with small amounts of post
	data.

2000-04-20  Jeff Hobbs  <[email protected]>

	* generic/tclAlloc.c: wrapped caddr_t define to not be done on Unix
	* unix/tclUnixPort.h: added Tclp*Alloc defines to allow the use of

	* tests/pkg/magicchar.tcl:
	* tests/autoMkindex.test: Test for fix for bug #2611.

	* library/auto.tcl: Fixed the regular expression that performs $
	escaping before sourcing a file to index. It was erroneously adding \
	escapes even to $'s that were already escaped, effectively
	"un-escaping" those $'s. (bug #2611).

2000-01-27  Eric Melski  <[email protected]>

	* tests/autoMkindex.test:
	* library/auto.tcl: Applied patch (with slight modification) from bug
	#2701: auto_mkIndex uses platform dependent file paths. Added test for
	fix.

	#981).

	* doc/upvar.n: Expanded explanation of upvar behavior with respect to
	variable traces. (bugs 3917 1433 2110).

	* generic/tclVar.c: Changed behavior of variable command when name
	refers to an element in an array (ie, "variable foo(x)") to always
	return an error, regardless of existance of that element in the array
	(now behavior is consistant with docs too) (bug #981).

2000-01-20  Jeff Hobbs  <[email protected]>

	* generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a string
	if the body has been bytecompiled.
	* generic/tclBasic.c (Tcl_EvalObjEx): added pedantic check for

2002-12-16  David Gravereaux  <[email protected]>

	* generic/tclPipe.c (TclCleanupChildren):
	* tests/winPipe.test:
	* win/tclWinPipe.c (Tcl_WaitPid):
	* win/tclWinTest.c:  Gave Tcl_WaitPid the ability to return a Win32
	exception code translated into a posix style SIG*. This allows [close]
	to report "CHILDKILLED" without the meaning getting lost in a
	truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get
	moved to before Tcl_WaitPid() as the the handle is removed from the
	list taking away the ability to get the process id after the wait is
	done. This shouldn't effect the unix implimentaion unless waitpid is
	called with a pid of zero, meaning "any". I don't think it is..

	* library/tcltest/tcltest.tcl: Change [configure -match] to stop
	treating an empty list as a list of the single pattern "*". Changed
	the default value to [list *] so default operation remains the same.

	* tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test.

	* library/tcltest/tcltest.tcl: restored writeability testing of
	-tmpdir, augmented by a special exception for the deafault value.

2002-07-01  Donal K. Fellows  <[email protected]>

	* doc/concat.n: Documented the *real* behaviour of [concat]!

2002-06-30  Don Porter  <[email protected]>

	* doc/tcltest.n: more work in progress updating tcltest docs.

	* tests/README:		Updated the instructions on running and
	* tests/cmdMZ.test:	adding to the test suite. Also updated
	* tests/encoding.test:	several tests, mostly to correctly create
	* tests/fCmd.test:	and destroy any temporary files in the
	* tests/info.test:	[temporaryDirectory] of tcltest.
	* tests/interp.test:

	* library/tcltest/tcltest.tcl:	Stopped checking for writeability of
	-tmpdir value because no default directory can be guaranteed to be
	writeable.

	* tests/autoMkindex.tcl: removed.
	* tests/pkg/samename.tcl: removed.
	* tests/pkg/magicchar.tcl: removed.
	* tests/pkg/magicchar2.tcl: removed.
	* tests/autoMkindex.test: Updated auto_mkIndex tests to use [makeFile]
	and [removeFile] so tests are done in [temporaryDirecotry] where write

2002-06-06  Daniel Steffen  <[email protected]>

	* unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime): added
	mutex wrapped calls to readdir, localtime & gmtime in case their
	thread-safe *_r counterparts are not available.
	* unix/tcl.m4: added configure check for readdir_r
	* unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX
	(where posix file apis expect utf-8, not iso8859-1).
	* unix/configure: regen
	* unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to
	LD_LIBRARY_PATH for MacOSX dynamic linker.
	* generic/tclEnv.c (TclSetEnv): fix env var setting on MacOSX (adapted
	from [Patch 524352] by jkbonfield).

2002-06-05  Don Porter  <[email protected]>

	* win/makefile.vc:
	* win/rules.vc:  Added a new "loimpact" option that sets the
	-ws:aggressive linker option. Off by default. It's said to keep the
	heap use low at the expense of alloc speed.

	* win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove
	the raw windows.h include. tclPort.h brings in windows.h already and
	lessens the pre-compiled-header mush and the randomly useless #pragma
	comment (lib,...) references throughout the big windows.h tree (as
	observed at high linker warning levels).

2002-02-21  Donal K. Fellows  <[email protected]>

	* generic/tcl.h: Better guessing of LP64/ILP32 architecture, but now
	sensitive to presence of (suitable) <limits.h>

	* generic/tclCmdAH.c: 64-bit handling in [file] and [format]
	commands.
	* generic/tclBasic.c: New "wordSize" entry in ::tcl_platform.
	* generic/tclFCmd.c: Large-file support (with many consequences.)
	* generic/tclIO.c: Large-file support (with many consequences.)
	* compat/strtoll.c, compat/strtoull.c: New support functions.
	* unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced
	cacheing.

	Most other changes, including all those in doc/* and test/* as well as
	the majority in the platform directories, follow on from these.

	Also coming out of the woodwork:
	* generic/tclIndex.c: Better support for Cray PVP.
	* win/tclWinMtherr.c: Better Borland support.

2003-11-17  Don Porter	<[email protected]>

	* tests/reg.test: Added tests for [Bugs 230589, 504785, 505048, 840258]
	recently fixed by 2003-11-15 commit to regcomp.c by Pavel Goran. His
	notes on the fix: This bug results from an error in code that splits
	states into "progress" and "no-progress" ones. This error causes an
	interesting situation with the pre-collected single-linked list of
	states to be splitted: many items were added to the list, but only
	several of them are accessible from the list beginning, since the
	"tmp" member of struct state (which is used here to hold a pointer to
	the next list item) gets overwritten, which results in a "looped"
	chain. As a result, not all of states are splitted, and one state is
	splitted two times, causing incorrect "no-progress" flag values.

2004-11-26  Donal K. Fellows  <[email protected]>

	* unix/configure.in: Simplify the code to check for correctness of
	strstr, strtoul and strtod.
	* unix/tcl.m4 (SC_TCL_CHECK_BROKEN_FUNC): Split a complex stanza out
	of configure.in into its own function. Also force it to do the right
	thing with cacheing of results of AC_TRY_RUN to deal with issue raised
	in [Patch 1073524]

	* doc/foreach.n: Added simple example. [FRQ 1073334]

2004-11-25  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (TclObjInterpProc):	    Make it so that only

	Mikhail Kolesnitchenko. [Patch 1018486]

2004-08-31  Vince Darley  <[email protected]>

	* doc/FileSystem.3:
	* generic/tclIOUtil.c: Clarified documentation regarding ability of a
	filesystem to say that it doesn't support a given operation using the
	EXDEV posix error code (copyFileProc, renameFileProc, etc), and
	updated one piece of code to ensure correct behaviour when an
	operation is not supported [Bug 1017072]

	* tests/fCmd.test: fix to test suite problem [Bug 1002884]

2004-08-31  Daniel Steffen  <[email protected]>

2004-07-17  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to rare 'cd' infinite loop in normalization
	with vfs [Bug 991420].
	* tests/fileSystem.test: added test for above bug.

	* doc/FileSystem.3: clarified documentation of posix error codes in
	'remove directory' FS proc - 'EEXIST' is used to signify a non-empty
	directory error (bug reported against tclvfs).

2004-07-16  Jeff Hobbs	<[email protected]>

	* unix/Makefile.in, unix/tcl.m4:     move (C|LD)FLAGS after their
	* unix/configure.in, unix/configure: _DEFAULT to allow for env setting

	* tests/winPipe.test: more pass-thru commandline verifications.
	* win/tclWinPipe.c (BuildCommandLine): Special case quoting for '{'
	not required by the c-runtimes's parse_cmdline().
	* win/tclAppInit.c: Removed our custom setargv() in favor of the work
	provided by the c-runtime. [Bug 672938]

	* win/nmakehlp.c: defensive techniques to avoid static buffer
	overflows and a couple envars upsetting invokations of cl.exe and
	link.exe. [Bug 885537]

	* tests/winPipe.test: Added proof that BuildCommandLine() is not doing
	the "N backslashes followed a quote -> insert N * 2 + 1 backslashes
	then a quote" rule needed for the crt's parse_cmdline().
	* win/tclWinPipe.c: Fixed BuildCommandLine() to pass the new cases.

	operation.

	* generic/tclCompCmds.c: Rewrote TclCompileReturnCmd() to call
	TclMergeReturnOptions() at compile time so the return options
	dictionary is computed at compile time (when it is fully known). The
	dictionary is pushed on the stack along with the result, and the code
	and level values are included in the bytecode as operands. Also
	supports optimized compilation of un-[catch]ed [return]s from procs
	with default options into the INST_DONE instruction.

	* generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve
	the code and level operands, pop the return options from the stack,
	and call TclProcessReturn() to perform the [return] operation.

	* generic/tclCompile.h:	New utilities include TclEmitInt4 macro

	since when the list of opcodes changes it is usually useful to rebuild
	everything that depends on it (but which is nonetheless a small
	fraction of the total set of Tcl source files).

	***POTENTIAL INCOMPATIBILITY*** for bytecode savers/loaders. See below

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Arrange for very simple
	[switch] invokations to be compiled into hash lookups into jump tables;
	only a very specific kind of [switch] can be safely compiled this way,
	but that happens to be the most common kind. This makes around 5-10%
	difference to the speed of execution of clock.test.
	* generic/tclExecute.c (TEBC:INST_JUMP_TABLE): New instruction to allow
	for jumps to locations looked up in a hashtable. Requires a new AuxData
	type, tclJumptableInfoType (supported by the functions DupJumptableInfo
	and FreeJumptableInfo in tclCompCmds.c) so anything that saves bytecode

	an expr syntax error (masked by a [catch]).

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added crash protection
	to handle callers other than TclCompileScript() failing to meet the
	initialization assumptions of the TIP 280 code in CompileWord().

	* generic/tclCompExpr.c:	Suppress the attempt to convert to
	numeric when pre-compiling a constant expresion indicates an error.

2007-08-22  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC): disable the new shortcut to frequent
	INSTs for debug builds. REVERTED (collision with alternative fix)

2007-08-21  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (STR_MAP): Replace ckalloc calls with
	TclStackAlloc calls.

2007-03-24  Zoran Vasiljevic <[email protected]>

	* win/tclWinThrd.c: Thread exit handler marks the current thread as
	un-initialized. This allows exit handlers that are registered later to
	re-initialize this subsystem in case they need to use some sync
	primitives (cond variables) from this file again.

2007-03-23  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (DeleteInterpProc): pop the root frame pointer
	before deleting the global namespace [Bug 1658572]

	namespace creation faster. Plus selected other minor improvements to
	code quality. [Patch 1352382]

2006-08-10  Donal K. Fellows  <[email protected]>

	Misc patches to make code more efficient. [Bug 1530474] (afredd)
	* generic/*.c, macosx/tclMacOSXNotify.c, unix/tclUnixNotfy.c,
	* win/tclWinThrd.c: Tidy up invokations of Tcl_Panic() to promote
	string constant sharing and consistent style.
	* generic/tclBasic.c (Tcl_CreateInterp): More efficient handling of
	* generic/tclClock.c (TclClockInit):	 registration of commands not
						 in global namespace.
	* generic/tclVar.c (Tcl_UnsetObjCmd): Remove unreachable clause.

2006-08-09  Don Porter	<[email protected]>

	* generic/tclExecute.c: Corrected flawed overflow detection in
	* tests/expr.test:	INST_EXPON that caused [expr 2**64] to return
	0 instead of the same value as [expr 1<<64].

2006-07-24  Don Porter	<[email protected]>

	* win/tclWinSock.c:	Correct un-initialized Tcl_DString. Thanks to
	afredd. [Bug 1518166]

2006-07-21  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:
	* tests/execute.test (execute-9.1): dgp's fix for [Bug 1522803].

	* generic/tclCompCmds.c (TclCompileEnsemble)
	* generic/tclNamesp.c (NamespaceEnsembleCmd)
	(Tcl_SetEnsembleParameterList, Tcl_GetEnsembleParameterList)
	(NsEnsembleImplementationCmdNR):
	* generic/tcl.decls, doc/Ensemble.3, doc/namespace.n
	* tests/namespace.test: Allow the handling of a (fixed) number of
	formal parameters between an ensemble's command and subcommand at
	invokation time. [Patch 1901783]

2008-09-28  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	   Fix the numLevels computations on
	* generic/tclInt.h:	   coroutine yield/resume
	* tests/unsupported.test:

	* generic/tclBinary.c: [Bug 1923966] - crash in binary format
	* tests/binary.test:   Added tests for the above crash condition.

2008-03-21  Donal K. Fellows  <[email protected]>

	* doc/switch.n: Clarified documentation in respect of two-argument
	invokation. [Bug 1899962]

	* tests/switch.test: Added more tests of regexp-mode compilation of
	the [switch] command. [Bug 1854435]

2008-03-20  Donal K. Fellows  <[email protected]>

	* generic/tcl.h, generic/tclThreadAlloc.c: Tidied up the declarations

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

    - Modifying the TclpInitLibraryPath routines.
(surles)

3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize
the location of the encoding files and libraries.  This fix included:
    - Adding the TclSetPerInitScript routine.
    - Modifying the Tcl_Init routines to evaluate the non-NULL
      pre-init script.
    - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir
      routines.
    - Modifying the TclpInitLibrary routines to append the default
      encoding dir.
(surles)

3/14/99 (feature change) Test suite now uses "test" namespace to

2007-08-14 (platform support) Darwin [load] from VFS on intel & 64bit (steffen)

2007-08-15 (bug fix)[1773127] corrected open mode "a+" (rottman,fellows)

2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter)

2007-08-16 (performance)[1564517] pre-compile constant expressions (porter)

2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to
prompt for continuation line (porter)

2007-08-25 (bug fix)[1781282] [clock scan] case senstivity (kenny)

2007-08-25 (performance)[1767293] ** on native integer types (kenny)

2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)

2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)

2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)

2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
        *** POTENTIAL INCOMPATIBILITY ***

- Add "volatile" to crc table flag declaration (for DYNAMIC_CRC_TABLE)
- Add limited multitasking protection to DYNAMIC_CRC_TABLE
- Add NO_vsnprintf for VMS in zutil.h [Mozilla]
- Don't declare strerror() under VMS [Mozilla]
- Add comment to DYNAMIC_CRC_TABLE to use get_crc_table() to initialize
- Update contrib/ada [Anisimkov]
- Update contrib/minizip [Vollant]
- Fix configure to not hardcode directories for Darwin [Peterson]
- Fix gzio.c to not return error on empty files [Brown]
- Fix indentation; update version in contrib/delphi/ZLib.pas and
  contrib/pascal/zlibpas.pas [Truta]
- Update mkasm.bat in contrib/masmx86 [Truta]
- Update contrib/untgz [Truta]
- Add projects/README.projects [Truta]
- Add project for MS Visual C++ 6.0 in projects/visualc6 [Cadieux, Truta]

  bool testb = mode & std::ios_base::binary;
  bool testi = mode & std::ios_base::in;
  bool testo = mode & std::ios_base::out;
  bool testt = mode & std::ios_base::trunc;
  bool testa = mode & std::ios_base::app;

  // Check for valid flag combinations - see [27.8.1.3.2] (Table 92)
  // Original zfstream hardcoded the compression level to maximum here...
  // Double the time for less than 1% size improvement seems
  // excessive though - keeping it at the default level
  // To change back, just append "9" to the next three mode strings
  if (!testi && testo && !testt && !testa)
    strcpy(c_mode, "w");
  if (!testi && testo && !testt && testa)
    strcpy(c_mode, "a");

.AP Tcl_Interp *interp in
Interpreter in which to cancel the script.
.AP Tcl_Obj *resultObjPtr in
Error message to use in the cancellation, or NULL to use a default message. If
not NULL, this object will have its reference count decremented before
\fBTcl_CancelEval\fR returns.
.AP int flags in
ORed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported.  For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP ClientData clientData in
Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be
the return code for that script.  This function is thread-safe and may be
called from any thread in the process.
.PP
\fBTcl_Canceled\fR checks if the script in progress has been canceled and
returns \fBTCL_ERROR\fR if it has.  Otherwise, \fBTCL_OK\fR is returned.
Extensions can use this function to check to see if they should abort a long
running command.  This function is thread sensitive and may only be called
from the thread the interpreter was created in.
.SS "FLAG BITS"
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR:
.TP 20
\fBTCL_CANCEL_UNWIND\fR
.
This flag is used by \fBTcl_CancelEval\fR and \fBTcl_Canceled\fR.
For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
is canceled and the evaluation stack for the interpreter is unwound.

but all other functions must not.
.AP "const char" *name in
The name of the ensemble command to be created.
.AP Tcl_Namespace *namespacePtr in
The namespace to which the ensemble command is to be bound, or NULL
for the current namespace.
.AP int ensFlags in
An ORed set of flag bits describing the basic configuration of the
ensemble. Currently only one bit has meaning, \fBTCL_ENSEMBLE_PREFIX\fR,
which is present when the ensemble command should also match
unambiguous prefixes of subcommands.
.AP Tcl_Obj *cmdNameObj in
A value holding the name of the ensemble command to look up.
.AP int flags in
An ORed set of flag bits controlling the behavior of
\fBTcl_FindEnsemble\fR. Currently only \fBTCL_LEAVE_ERR_MSG\fR is supported.
.AP Tcl_Command token in
A normal command token that refers to an ensemble command, or which
you wish to use for testing as an ensemble command in \fBTcl_IsEnsemble\fR.
.AP int *ensFlagsPtr out
Pointer to a variable into which to write the current ensemble flag
bits; currently only the bit \fBTCL_ENSEMBLE_PREFIX\fR is defined.

.AS Tcl_Interp **termPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the script.  The interpreter's result is
modified to hold the result or error message from the script.
.AP Tcl_Obj *objPtr in
A Tcl value containing the script to execute.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP int objc in
The number of values in the array pointed to by \fIobjv\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in

in code for string comparison, you can use
.QW \e032
or
.QW \eu001a ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
script.  The \fIobjc\fR and \fIobjv\fR arguments contain the values
of the words for the Tcl command, one word in each value in
\fIobjv\fR.  \fBTcl_EvalObjv\fR evaluates the command and returns
a completion code and result just like \fBTcl_EvalObjEx\fR.
The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the
elements of \fIobjv\fR, insuring that the values are valid until
\fBTcl_EvalObjv\fR returns.

.PP
\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
instead of taking a variable number of arguments it takes an argument
list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.

.SH "FLAG BITS"
.PP
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR:
.TP 23
\fBTCL_EVAL_DIRECT\fR
.
This flag is only used by \fBTcl_EvalObjEx\fR; it is ignored by
other procedures.  If this flag bit is set, the script is not
compiled to bytecodes; instead it is executed directly

be joined together. If negative, then all elements are joined.
.AP Tcl_Obj **errorPtr out
In the case of an error, filled with a value containing the name of
the file which caused an error in the various copy/rename operations.
.AP Tcl_Obj **objPtrRef out
Filled with a value containing the result of the operation.
.AP Tcl_Obj *resultPtr out
Pre-allocated value in which to store (using
\fBTcl_ListObjAppendElement\fR) the list of
files or directories which are successfully matched.
.AP int mode in
Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK,
W_OK and X_OK request checking whether the file exists and  has  read,
write and  execute  permissions, respectively. F_OK just requests
checking for the existence of the file.

.QW "read link"
action is performed. The result
is a Tcl_Obj specifying the contents of the symbolic link given by
\fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned
by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no
longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link
of one of the types passed in in the \fIlinkAction\fR flag. This flag is
an ORed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
Where a choice exists (i.e.\ more than one flag is passed in), the Tcl
convention is to prefer symbolic links. When a link is successfully
created, the return value should be \fItoPtr\fR (which is therefore
already owned by the caller). If unsuccessful, NULL is returned.
.PP
\fBTcl_FSLstat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
information about the specified file. You do not need any access rights to the

\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 \fInewValue\fR

.AP Tcl_Interp *interp in
Interpreter in which to execute Tcl scripts and lookup variables.  If
an error occurs, the interpreter's result is modified to hold an error
message.
.AP Tcl_Obj *objPtr in
A Tcl value containing the string to perform substitutions on.
.AP int flags in
ORed combination of flag bits that specify which substitutions to
perform.  The flags \fBTCL_SUBST_COMMANDS\fR,
\fBTCL_SUBST_VARIABLES\fR and \fBTCL_SUBST_BACKSLASHES\fR are
currently supported, and \fBTCL_SUBST_ALL\fR is provided as a
convenience for the common case where all substitutions are desired.
.BE
.SH DESCRIPTION
.PP

\e\fBv\fR
Vertical tab (Unicode U+00000B).
.TP 7
\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 is not
in braces or quotes.
.TP 7
\e\e
Backslash
.PQ \e "" .

.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
means that the command is executed by \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
means that the command is found in a pre-compiled script (loadable by
the package \fBtbcload\fR), and no further information will be
available.
.RE
.TP
\fBline\fR
.
This entry provides the number of the line the command is at inside of

Tcl began, the current packets allocated (the current
number of calls to \fBckalloc\fR not met by a corresponding call
to \fBckfree\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
\fBmemory init \fR[\fBon\fR|\fBoff\fR]
.
Turn on or off the pre-initialization of all allocated memory
with bogus bytes.  Useful for detecting the use of uninitialized
values.
.TP
\fBmemory objs \fIfile\fR
.
Causes a list of all allocated Tcl_Obj values to be written to the specified
\fIfile\fR immediately, together with where they were allocated.  Useful for

current namespace that were imported from a different namespace.
For
.QW "qualified patterns" ,
this command first finds the matching exported commands.
It then checks whether any of 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, or queries the set of imported
commands in a namespace.  When no arguments are present,
\fBnamespace import\fR returns the list of commands in
the current namespace that have been imported from other

a filter and once as a normal method.
.PP
Each filter should decide for itself whether to permit the execution to go
forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
Filters are invoked when processing an invokation of the \fBunknown\fR
method because of a failure to locate a method implementation, but \fInot\fR
when invoking either constructors or destructors. (Note however that the
\fBdestroy\fR method is a conventional method, and filters are invoked as
normal when it is called.)
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the

\fB\-lazy\fR
The generated index will manage to delay loading the package until the
use of one of the commands provided by the package, instead of loading
it immediately upon \fBpackage require\fR.  This is not compatible with
the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
current interpreter and match \fIpkgPat\fR into the child interpreter used to
generate the index.  The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
.TP 15
\fB\-verbose\fR
Generate output during the indexing process.  Output is via

way to define any conditions required for the test to be possible or
meaningful.  For example, a \fBtest\fR with \fB\-constraints unix\fR
will only be run if the constraint \fBunix\fR is true, which indicates
the test suite is being run on a Unix platform.
.PP
Each \fBtest\fR should include whatever \fB\-constraints\fR are
required to constrain it to run only where appropriate.  Several
constraints are pre-defined in the \fBtcltest\fR package, listed
below.  The registration of user-defined constraints is performed
by the \fBtestConstraint\fR command.  User-defined constraints
may appear within a test file, or within the script specified
by the \fBconfigure \-load\fR or \fBconfigure \-loadfile\fR
options.
.PP
The following is a list of constraints pre-defined by the
\fBtcltest\fR package itself:
.TP
\fIsingleTestInterp\fR
.
This test can only be run if all test files are sourced into a single
interpreter.
.TP

    victim->freechain = from->free;
    from->free = victim;
}

/*
 * changearctarget - flip an arc to have a different to state
 *
 * Caller must have verified that there is no pre-existing duplicate arc.
 *
 * Note that because we store arcs in their from state, we can't easily have
 * a similar changearcsource function.
 */
static void
changearctarget(struct arc * a, struct state * newto)
{


/*
 - pull - pull a back constraint backward past its source state
 *
 * Returns 1 if successful (which it always is unless the source is the
 * start state or we have an internal error), 0 if nothing happened.
 *
 * A significant property of this function is that it deletes no pre-existing
 * states, and no outarcs of the constraint's from state other than the given
 * constraint arc.  This makes the loops in pullback() safe, at the cost that
 * we may leave useless states behind.  Therefore, we leave it to pullback()
 * to delete such states.
 *
 * If the from state has multiple back-constraint outarcs, and/or multiple
 * compatible constraint inarcs, we only need to create one new intermediate


/*
 - push - push a forward constraint forward past its destination state
 *
 * Returns 1 if successful (which it always is unless the destination is the
 * post state or we have an internal error), 0 if nothing happened.
 *
 * A significant property of this function is that it deletes no pre-existing
 * states, and no inarcs of the constraint's to state other than the given
 * constraint arc.  This makes the loops in pushfwd() safe, at the cost that
 * we may leave useless states behind.  Therefore, we leave it to pushfwd()
 * to delete such states.
 *
 * If the to state has multiple forward-constraint inarcs, and/or multiple
 * compatible constraint outarcs, we only need to create one new intermediate

 * For each cloned successor state, we transiently create a "donemap" that is
 * a boolean array showing which source states we've already visited for this
 * clone state.  This prevents infinite recursion as well as useless repeat
 * visits to the same state subtree (which can add up fast, since typical NFAs
 * have multiple redundant arc pathways).  Each donemap is a char array
 * indexed by state number.  The donemaps are all of the same size "nstates",
 * which is nfa->nstates as of the start of the recursion.  This is enough to
 * have entries for all pre-existing states, but *not* entries for clone
 * states created during the recursion.  That's okay since we have no need to
 * mark those.
 *
 * curdonemap is NULL when recursing to a new sclone state, or sclone's
 * donemap when we are recursing without having created a new state (which we
 * do when we decide we can merge a successor state into the current clone
 * state).  outerdonemap is NULL at the top level and otherwise the parent

    }
}

/*
 - analyze - ascertain potentially-useful facts about an optimized NFA
 ^ static long analyze(struct nfa *);
 */
static long			/* re_info bits to be ORed in */
analyze(
    struct nfa *nfa)
{
    struct arc *a;
    struct arc *aa;

    if (nfa->pre->outs == NULL) {

    struct state *next;		/* chain for traversing all */
    struct state *prev;		/* back chain */
    struct arcbatch oas;	/* first arcbatch, avoid malloc in easy case */
    int noas;			/* number of arcs used in first arcbatch */
};

struct nfa {
    struct state *pre;		/* pre-initial state */
    struct state *init;		/* initial state */
    struct state *final;	/* final state */
    struct state *post;		/* post-final state */
    int nstates;		/* for numbering states */
    struct state *states;	/* state-chain header */
    struct state *slast;	/* tail of the chain */
    struct state *free;		/* free list */
    struct colormap *cm;	/* the color map */
    color bos[2];		/* colors, if any, assigned to BOS and BOL */
    color eos[2];		/* colors, if any, assigned to EOS and EOL */

    void Tcl_DbCkfree(char *ptr, const char *file, int line)
}
declare 8 {
    char *Tcl_DbCkrealloc(char *ptr, unsigned int size,
	    const char *file, int line)
}

# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
# but they are part of the old generic interface, so we include them here for
# compatibility reasons.

declare 9 unix {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    ClientData clientData)
}

static struct block *blockList;	/* Tracks the suballocated blocks. */
static struct block bigBlocks={	/* Big blocks aren't suballocated. */
    &bigBlocks, &bigBlocks
};

/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Futhermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

#ifdef TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif

 *	Attempts to get more memory from the system.
 *
 *----------------------------------------------------------------------
 */

static void
MoreCore(
    int bucket)			/* What bucket to allocat to. */
{
    union overhead *overPtr;
    long size;		/* size of desired block */
    long amount;		/* amount to allocate */
    int numBlocks;		/* how many blocks we get */
    struct block *blockPtr;

    /*
     * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
     * VAX, I think) or for a negative arg.

 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpRealloc(
    char *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    unsigned long maxSize;

	}
	memcpy(newPtr, oldPtr, numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

    /*
     * Ok, we don't have to copy, it fits as-is
     */

#ifndef NDEBUG
    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    BLOCK_END(overPtr) = RMAGIC;
#endif

    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

    /*
     * 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 function that
     * extracts strings, calls the string function, 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.
     */

                "hidden command named \"%s\" already exists",
                hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", 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 until
     * 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 = NULL;
	cmdPtr->cmdEpoch++;
    }

     * 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 Tcl_Panic
	 * than 'nicely' erroring out ?
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"trying to expose a non-global command namespace command",
		-1));
	return TCL_ERROR;

 *	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

 *	interpreter is still able to execute further commands after the
 *	cancelation is cleared (unlike if it is deleted).
 *
 * Results:
 *	The value given for the code argument.
 *
 * Side effects:
 *	Transfers a message from the cancelation message to the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
CancelEvalProc(
    ClientData clientData,	/* Interp to cancel the script in progress. */

    if (currNsPtr->unknownHandlerPtr == NULL) {
	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
    }

    /*
     * Get the list of words for the unknown handler and allocate enough space
     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);

				 * TCL_EVAL_GLOBAL is currently supported. */
    int line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set only in
				 * TclSubstTokens(), to properly handle
				 * [...]-nested commands. The 'outerScript'
				 * refers to the most-outer script containing
				 * the embedded command, which is refered to
				 * by 'script'. The 'clNextOuter' refers to
				 * the current entry in the table of
				 * continuation lines in this "main script",
				 * and the character offsets are relative to
				 * the 'outerScript' as well.
				 *
				 * If outerScript == script, then this call is

    Tcl_HashEntry *hPtr;
    CFWord *cfwPtr;

    for (i = 1; i < objc; i++) {
	/*
	 * Ignore argument words without line information (= dynamic). If they
	 * are variables they may have location information associated with
	 * that, either through globally recorded 'set' invokations, or
	 * literals in bytecode. Eitehr way there is no need to record
	 * something here.
	 */

	if (cfPtr->line[i] < 0) {
	    continue;
	}
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew);

 *----------------------------------------------------------------------
 */

int
Tcl_SetRecursionLimit(
    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;

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

/*
 * The following flags may be ORed together and returned by GetFormatSpec
 */

#define BINARY_SIGNED 0		/* Field to be read as signed data */
#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */

/*
 * The following defines the maximum number of different (integer) numbers
 * placed in the object cache by 'binary scan' before it bails out and
 * switches back to Plan A (creating a new object for each value.)
 * Theoretically, it would be possible to keep the cache about for the values
 * that are already in it, but that makes the code slower in practise when
 * overflow happens, and makes little odds the rest of the time (as measured
 * on my machine.) It is also slower (on the sample I tried at least) to grow
 * the cache to hold all items we might want to put in it; presumably the
 * extra cost of managing the memory for the enlarged table outweighs the
 * benefit from allocating fewer objects. This is probably because as the
 * number of objects increases, the likelihood of reuse of any particular one
 * drops, and there is very little gain from larger maximum cache sizes (the

	length = offset;
    }
    if (length == 0) {
	return TCL_OK;
    }

    /*
     * Prepare the result object by preallocating the caclulated number of
     * bytes and filling with nulls.
     */

    TclNewObj(resultPtr);
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);

/*
 *----------------------------------------------------------------------
 *
 * NeedReversing --
 *
 *	This routine determines, if bytes of a number need to be re-ordered,
 *	and returns a numeric code indicating the re-ordering to be done.
 *	This depends on the endiannes of the machine and the desired format.
 *	It is in effect a table (whose contents depend on the endianness of
 *	the system) describing whether a value needs reversing or not. Anyone
 *	porting the code to a big-endian platform should take care to make
 *	sure that they define WORDS_BIGENDIAN though this is already done by
 *	configure for the Unix build; little-endian platforms (including
 *	Windows) don't need to do anything.
 *


/*
 *----------------------------------------------------------------------
 *
 * 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__.

 */

typedef struct SortInfo {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
				 * holds an encoding of the indexes contained
				 * in the list supplied as an argument to
				 * that option.
				 * NULL if no indexes supplied, and points to
				 * singleIndex field when only one

	    if (match == 0) {
		/*
		 * Normally, binary search is written to stop when it finds a
		 * match. If there are duplicates of an element in the list,
		 * our first match might not be the first occurrence.
		 * Consider: 0 0 0 1 1 1 2 2 2
		 *
		 * To maintain consistancy with standard lsearch semantics, we
		 * must find the leftmost occurrence of the pattern in the
		 * list. Thus we don't just stop searching here. This
		 * variation means that a search always makes log n
		 * comparisons (normal binary search might "get lucky" with an
		 * early comparison).
		 *
		 * In bisect mode though, we want the last of equals.

	if (indices || group) {
	    elementArray[i].payload.index = idx;
	} else {
	    elementArray[i].payload.objPtr = listObjPtrs[idx];
	}

	/*
	 * Merge this element in the pre-existing sublists (and merge together
	 * sublists when we have two of the same size).
	 */

	elementArray[i].nextPtr = NULL;
	elementPtr = &elementArray[i];
	for (j=0 ; subList[j] ; j++) {
	    elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);

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

	if ((*left != '\0') && (*right != '\0')) {
	    left += TclUtfToUCS4(left, &uniLeft);
	    right += TclUtfToUCS4(right, &uniRight);

	    /*
	     * Convert both chars to lower for the comparison, because
	     * dictionary sorts are case insensitve. Covert to lower, not
	     * upper, so chars between Z and a will sort before A (where most
	     * other interesting punctuations occur).
	     */

	    uniLeftLower = TclUCS4ToLower(uniLeft);
	    uniRightLower = TclUCS4ToLower(uniRight);
	} else {

		numMatchesSaved, eflags);
	if (match < 0) {
	    return TCL_ERROR;
	}

	if (match == 0) {
	    /*
	     * We want to set the value of the intepreter result only when
	     * this is the first time through the loop.
	     */

	    if (all <= 1) {
		/*
		 * If inlining, the interpreter's object result remains an
		 * empty list, otherwise set it to an integer object w/ value

	/*
	 * Adjust the offset to the character just after the last one in the
	 * matchVar and increment all to count how many times we are making a
	 * match. We always increment the offset by at least one to prevent
	 * endless looping (as in the case: regexp -all {a*} a). Otherwise,
	 * when we match the NULL string at the end of the input string, we
	 * will loop indefinately (because the length of the match is 0, so
	 * offset never changes).
	 */

	matchLength = (info.matches[0].end - info.matches[0].start);

	offset += info.matches[0].end;

	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	char *p;

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
	return TCL_ERROR;
    }

    /*
     * Get the char length to calulate what 'end' means.
     */

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }

	    }
	}
    }

    /*
     * We get the objPtr so that we can short-cut for some classes by checking
     * the object type (int and double), but we need the string otherwise,
     * because we don't want any conversion of type occuring (as, for example,
     * Tcl_Get*FromObj would do).
     */

    objPtr = objv[objc-1];

    /*
     * When entering here, result == 1 and failat == 0.

	    }
	}
    } else {
	Tcl_UniChar **mapStrings, *u2lc = NULL;
	int *mapLens;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));

		    /*
		     * Adjust len to be full length of matched string.
		     */

		    ustring1 = p - 1;

		    /*
		     * Append the map value to the unicode string.
		     */

		    Tcl_AppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }

}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileArray*Cmd --
 *
 *	Functions called to compile "array" sucommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "array" subcommand at

     * Otherwise, compile instructions to substitute the body text before
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
     * substituted body.
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	BODY(cmdTokenPtr, 1);

}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --
 *
 *	Functions called to compile "dict" sucommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "dict" subcommand at

    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);

     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the catched return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, dictVarIndex;

    /*
     * There must be at least two argument after the command. And we impose an
     * (arbirary) safe limit; anyone exceeding it should stop worrying about
     * speed quite so much. ;-)
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords<4 || parsePtr->numWords>100) {
	return TCL_ERROR;
    }

     */

    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
	if (TclFixupForwardJumpToHere(envPtr,
		jumpEndFixupArray.fixup+jumpIndex, 127)) {
	    /*
	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
	    unsigned char opCode = *ifFalsePc;

    if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
	goto notCompilable;
    }
    Tcl_DecrRefCount(objPtr);

    /*
     * Confirmed as a literal that will not frighten the horses. Compile. Note
     * that the result needs to be list-ified.
     */

    /* TODO: Just push the known value */
    CompileWord(envPtr, tokenPtr,		interp, 1);
    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
    TclEmitOpcode(	INST_DUP,		envPtr);
    TclEmitOpcode(	INST_STR_LEN,		envPtr);

	/*
	 * Here we handle two ranges for idx. First when idx > 0, we
	 * want the first half of the split to end at index idx-1 and
	 * the second half to start at index idx.
	 * Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
	 * we want the first half of the split to end at index end-N and
	 * the second half to start at index end-N+1. We accomplish this
	 * with a pre-adjustment of the end-N value.
	 * The root of this is that the commands [lrange] and [linsert]
	 * differ in their interpretation of the "end" index.
	 */

	if (idx < TCL_INDEX_END) {
	    idx++;
	}

    Tcl_DString buffer;
    Tcl_HashEntry *hPtr;

    /*
     * Compile the switch by using a jump table, which is basically a
     * hashtable that maps from literal values to match against to the offset
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = ckalloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);

 *
 * While the parse tree is being constructed, the same memory space is used to
 * hold the p.prev field which chains together a stack of incomplete trees
 * awaiting their right operands.
 *
 * The lexeme field is filled in with the lexeme of the operator that is
 * returned by the ParseLexeme() routine. Only lexemes for unary and binary
 * operators get stored in an OpNode. Other lexmes get different treatement.
 *
 * The precedence field provides a place to store the precedence of the
 * operator, so it need not be looked up again and again.
 *
 * The mark field is use to control the traversal of the tree, so that it can
 * be done non-recursively. The mark values are:
 */

/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
				 * BINARY_PLUS according to context. */
#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
				 * BINARY_MINUS according to context. */
#define BAREWORD	3	/* Ambigous. Resolves to BOOLEAN or to
				 * FUNCTION or a parse error according to
				 * context and value. */
#define INCOMPLETE	4	/* A parse error. Used only when the single
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error. Used when any punctuation
				 * appears that's not a supported operator. */

				 * optimizations are appropriate for the two
				 * scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed

 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is writen to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static int
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */

    int cmdIdx = envPtr->numCommands;
    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
    int depth = TclGetStackDepth(envPtr);

    TclNewObj(cmdObj);
    assert (parsePtr->numWords > 0);

    /* Pre-Compile */

    envPtr->numCommands++;
    EnterCmdStartData(envPtr, cmdIdx,
	    parsePtr->commandStart - envPtr->source, startCodeOffset);

    /*
     * TIP #280. Scan the words and compute the extended location information.

    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

    /*
     * For the handling of continuation lines in literals we first check if
     * this is actually a literal. For if not we can forego the additional
     * processing. Otherwise we pre-allocate a small table to store the
     * locations of all continuation lines we find in this literal, if any.
     * The table is extended if needed.
     *
     * Note: Different to the equivalent code in function 'TclSubstTokens()'
     * (see file "tclParse.c") we do not seem to need the 'adjust' variable.
     * We also do not seem to need code which merges continuation line
     * information of multiple words which concat'd at runtime. Either that or
     * I have not managed to find a test case for these two possibilities yet.
     * It might be a difference between compile- versus run-time processing.
     */

    numCL = 0;
    maxNumCL = 0;

				 * 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 */
    const 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

 *
 * QueryConfigObjCmd --
 *
 *	Implementation of "::<package>::pkgconfig", the command to query
 *	configuration information embedded into a binary library.
 *
 * Results:
 *	A standard tcl result.
 *
 * Side effects:
 *	See the manual for what this command does.
 *
 *----------------------------------------------------------------------
 */

    { "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!) */

 *	effects (other than potential conversion of objects to dictionaries.)
 *	If the flags argument is DICT_PATH_UPDATE, the following additional
 *	side effects occur. Shared dictionaries along the path are converted
 *	into unshared objects, and a backward-pointing chain is built using
 *	the chain fields of the dictionaries (for easy invalidation of string
 *	representations using InvalidateDictChain). If the flags argument has
 *	the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
 *	non-existant keys will be inserted with a value of an empty
 *	dictionary, resulting in the path being built.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclTraceDictPath(

}

/*
 *----------------------------------------------------------------------
 *
 * InvalidateDictChain --
 *
 *	Go through a dictionary chain (built by an updating invokation of
 *	TclTraceDictPath) and invalidate the string representations of all the
 *	dictionaries on the chain.
 *
 * Results:
 *	None
 *
 * Side effects:

				 * written into when there are no further
				 * values in the dictionary, or a 0
				 * otherwise. */
{
    ChainEntry *cPtr;

    /*
     * If the searh is done; we do no work.
     */

    if (searchPtr->epoch == -1) {
	*donePtr = 1;
	return;
    }

    } else {
	allocdict = 0;
    }

    if (pathc > 0) {
	/*
	 * Want to get to the dictionary which we will update; need to do
	 * prepare-for-update de-sharing along the path *but* avoid generating
	 * an error on a non-existant path (we'll treat that the same as a
	 * non-existant variable. Luckily, the de-sharing operation isn't
	 * deeply damaging if we don't go on to update; it's just less than
	 * perfectly efficient (but no memory should be leaked).
	 */

	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
	if (leafPtr == NULL) {

}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --
 *
 *	Given an encoding, return the name that was used to constuct the
 *	encoding.
 *
 * Results:
 *	The name of the encoding.
 *
 * Side effects:
 *	None.

	    if (prefixBytes[byte]) {
		src--;
	    }
	    ch = (Tcl_UniChar) byte;
	}

	/*
	 * Special case for 1-byte utf chars for speed.
	 */

	if (ch && ch < 0x80) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}

     * number of arguments to this ensemble command), populating it and then
     * feeding it back through the main command-lookup engine. In theory, we
     * could look up the command in the namespace ourselves, as we already
     * have the namespace in which it is guaranteed to exist,
     *
     *   ((Q: That's not true if the -map option is used, is it?))
     *
     * but we don't do that (the cacheing of the command object used should
     * help with that.)
     */

    {
	Tcl_Obj *copyPtr;	/* The actual list of words to dispatch to.
				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;

}

/*
 * ----------------------------------------------------------------------
 *
 * EnsmebleUnknownCallback --
 *
 *	Helper for the ensemble engine that handles the procesing of unknown
 *	callbacks. See the user documentation of the ensemble unknown handler
 *	for details; this function is only ever called when such a function is
 *	defined, and is only ever called once per ensemble dispatch (i.e. if a
 *	reparse still fails, this isn't called again).
 *
 * Results:
 *	TCL_OK -	*prefixObjPtr contains the command words to dispatch

    char *value;

    if (assignment == NULL) {
	return 0;
    }

    /*
     * First convert the native string to UTF. Then separate the string into
     * name and value parts, and call TclSetEnv to do all of the real work.
     */

    name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
    value = (char *)strchr(name, '=');

    if ((value != NULL) && (value != name)) {

/*
 *----------------------------------------------------------------------
 *
 * BgErrorDeleteProc --
 *
 *	This function 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 canceled.

{
    if (inExit != 0) {
	Tcl_Panic("TclInitSubsystems called while exiting");
    }

    if (subsystemsInitialized == 0) {
	/*
	 * Double check inside the mutex. There are definitly calls back into
	 * this routine from some of the functions below.
	 */

	TclpInitLock();
	if (subsystemsInitialized == 0) {

		/*

	 * has to be recompiled to get the correct locations. Not doing this
	 * will execute the saved bytecode with data for a different location,
	 * causing 'info frame' to point to the wrong place in the sources.
	 *
	 * Future optimizations ...
	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
	 *     case we recompile once per location of the literal, but not
	 *     continously, because the moment we have all locations we do not
	 *     need to recompile any longer.
	 *
	 * (2) Alternative: Do not recompile, tell the execution engine the
	 *     offset between saved starting line and actual one. Then modify
	 *     the users to adjust the locations they have by this offset.
	 *
	 * (3) Alternative 2: Do not fully recompile, adjust just the location

}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObj --
 *
 *	Increment an integeral value in a Tcl_Obj by an integeral value held
 *	in another Tcl_Obj. Caller is responsible for making sure we can
 *	update the first object.
 *
 * Results:
 *	TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On
 *	error, an error message is left in the interpreter (if it is not NULL,
 *	of course).

    /*
     *	   End of INST_STORE and related instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_INCR instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to somme
     * common execution code.
     */

/*TODO: Consider more untangling here; merge with LOAD and STORE ? */

    {
	Tcl_Obj *incrPtr;

	fromIdx = TclIndexDecode(fromIdx, objc - 1);
	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (fromIdx <= toIdx) {
	    /* Construct the subsquence list */
	    /* unshared optimization */
	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	    } else {
		if (toIdx != objc - 1) {
		    Tcl_ListObjReplace(NULL, valuePtr, toIdx + 1, LIST_MAX,
			    0, NULL);

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calulate what 'end' means.
	 */

	length = Tcl_GetCharLength(valuePtr);
	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

		NEXT_INST_F(1, 0, 0);
	    } else {
		NEXT_INST_F(1, 1, 1);
	    }
	}

	/*
	 * Get the unicode representation; this is where we guarantee to lose
	 * bytearrays.
	 */

	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	length--;

	/*

	    PUSH_OBJECT(valuePtr);
	    PUSH_OBJECT(keyPtr);
	}
	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));

	/*
	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
	 * followed by a conditional jump, so we can take advantage of this to
	 * do some peephole optimization (note that we're careful to not close
	 * out someone doing something else).
	 */

	JUMP_PEEPHOLE_F(done, 5, 0);

	 * Create link from source to target.
	 */

	contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
	if (contents == NULL) {
	    /*
	     * We handle three common error cases specially, and for all other
	     * errors, we use the standard posix error message.
	     */

	    if (errno == EEXIST) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\": that path already"
			" exists", TclGetString(objv[index])));
		Tcl_PosixError(interp);

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

	}
    }

    /*
     * To process a [glob] invocation, this function may be called multiple
     * times. Each time, the previously discovered filenames are in the
     * interpreter result. We stash that away here so the result is free for
     * error messsages.
     */

    savedResultObj = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(savedResultObj);
    Tcl_ResetResult(interp);
    TclNewObj(filenamesObj);
    Tcl_IncrRefCount(filenamesObj);

 *	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(

    hTblPtr = (Tcl_HashTable *)clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
	chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

	/*
	 * Remove any fileevents registered in this interpreter.
	 */

	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
		sPtr != NULL; sPtr = nextPtr) {
	    nextPtr = sPtr->nextPtr;
	    if (sPtr->interp == interp) {
		if (prevPtr == NULL) {

Tcl_Channel
Tcl_GetChannel(
    Tcl_Interp *interp,		/* Interpreter in which to find or create the
				 * channel. */
    const 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. */
    const char *name;		/* Translated name. */

int
TclGetChannelFromObj(
    Tcl_Interp *interp,		/* Interpreter in which to find or create the
				 * channel. */
    Tcl_Obj *objPtr,
    Tcl_Channel *channelPtr,
    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. */
    int flags)
{
    ChannelState *statePtr;
    ResolvedChanName *resPtr = NULL;
    Tcl_Channel chan;

     * are not only useless but actually distorts our view of the system.
     *
     * To preserve the information without having to read them again and to
     * avoid problems with the location in the channel (seeking might be
     * impossible) we move the buffers from the common state structure into
     * the channel itself. We use the buffers in the channel below the new
     * transformation to hold the data. In the future this allows us to write
     * transformations which pre-read data and push the unused part back when
     * they are going away.
     */

    if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
	/*
	 * When statePtr->inQueueHead is not NULL, we know
	 * prevChanPtr->inQueueHead must be NULL.

 *	Unstacks an entry in the hash table for a Tcl_Channel record. This is
 *	the reverse to 'Tcl_StackChannel'.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If TCL_ERROR is returned, the posix error code will be set with
 *	Tcl_SetErrno. May leave a message in interp result as well.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UnstackChannel(

     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (chanPtr->downChanPtr != NULL) {
	/*
	 * Instead of manipulating the per-thread / per-interp list/hashtable
	 * of registered channels we wind down the state of the
	 * transformation, and then restore the state of underlying channel
	 * into the old structure.
	 *
	 * TODO: Figure out how to handle the situation where the chan
	 * operations called below by this unstacking operation cause
	 * another unstacking recursively.  In that case the downChanPtr

    if (mustDiscard) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

    /*
     * Only save buffers which have the requested buffersize for the channel.
     * This is to honor dynamic changes of the buffersize made by the user.
     */

    if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

				 * driver operations. */
    int wroteSome = 0;		/* Set to one if any data was written to the
				 * driver. */

    /*
     * 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, statePtr)) {
	return -1;
    }

	    /*
	     * Decide whether to report the error upwards or defer it.
	     */

	    if (calledFromAsyncFlush) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * When defering the error copy a message from the bypass into
		 * the unreported area. Or discard it if the new error is to
		 * be ignored in favor of an earlier defered error.
		 */

		Tcl_Obj *msg = statePtr->chanMsg;

		if (statePtr->unreportedError == 0) {
		    statePtr->unreportedError = errorCode;
		    statePtr->unreportedMsg = msg;

 * Side effects:
 *	Resets the field 'nextCSPtr' of the specified channel state to NULL.
 *
 * NOTE:
 *	The channel to cut out of the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check (despite
 *	the refcount) because the caller usually wants fiddle with the channel
 *	(like transfering it to a different thread) and thus keeps the
 *	refcount artifically high to prevent its destruction.
 *
 *----------------------------------------------------------------------
 */

static void
CutChannel(
    Tcl_Channel chan)		/* The channel being removed. Must not be

 *
 * Side effects:
 *	Nothing.
 *
 * NOTE:
 *	The channel to splice into the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check (despite
 *	the refcount) because the caller usually wants figgle with the channel
 *	(like transfering it to a different thread) and thus keeps the
 *	refcount artifically high to prevent its destruction.
 *
 *----------------------------------------------------------------------
 */

static void
SpliceChannel(
    Tcl_Channel chan)		/* The channel being added. Must not be

 *	A standard Tcl result.
 *
 * Side effects:
 *	Closes the write side of the channel.
 *
 * NOTE:
 *	CloseWrite removes the channel as far as the user is concerned.
 *	However, the ooutput data structures may continue to exist for a while
 *	longer if it has a background flush scheduled. The device itself is
 *	eventually closed and the channel structures modified, in
 *	CloseChannelPart, below.
 *
 *----------------------------------------------------------------------
 */

    if (statePtr->encoding) {
	return WriteChars(chanPtr, src, len);
    }

    /*
     * Inefficient way to convert UTF-8 to byte-array, but the code
     * parallels the way it is done for objects.  Special case for 1-byte
     * (used by eg [puts] for the \n) could be extended to more efficient
     * translation of the src string.
     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

		ReleaseChannelBuffer(bufPtr);
		return -1;
	    }
	    flushed += statePtr->bufSize;

	    /*
 	     * We just flushed.  So if we have needNlFlush set to record that
 	     * we need to flush because theres a (translated) newline in the
 	     * buffer, that's likely not true any more.  But there is a tricky
 	     * exception.  If we have saved bytes that did not really get
 	     * flushed and those bytes came from a translation of a newline as
 	     * the last thing taken from the src array, then needNlFlush needs
 	     * to remain set to flag that the next buffer still needs a
 	     * newline flush.
 	     */

	case TCL_TRANSLATE_CRLF:
	    for (eol = dst; eol < dstEnd; eol++) {
		if (*eol == '\r') {
		    eol++;

		    /*
		     * If a CR is at the end of the buffer, then check for a
		     * LF at the begining of the next buffer, unless EOF char
		     * was found already.
		     */

		    if (eol >= dstEnd) {
			int offset;

			if (eol != eof) {

	    }
	    RecycleBuffer(chanPtr->state, bufPtr, 0);
	}
    }

    /*
     * Go to the driver only if we got nothing from pushback.  Have to do it
     * this way to avoid EOF mis-timings when we consider the ability that EOF
     * may not be a permanent condition in the driver, and in that case we
     * have to synchronize.
     */

    if (copied) {
	return copied;
    }

    int charsToRead,		/* Maximum number of characters to store, or
				 * -1 to get all available characters.
				 * Characters are obtained from the first
				 * buffer in the queue -- even if this number
				 * is larger than the number of characters
				 * available in the first buffer, only the
				 * characters from the first buffer are
				 * returned. The execption is when there is
				 * not any complete character in the first
				 * buffer.  In that case, a recursive call
				 * effectively obtains chars from the
				 * second buffer. */
    int *factorPtr)		/* On input, contains a guess of how many
				 * bytes need to be allocated to hold the
				 * result of converting N source bytes to

	Tcl_SetErrno(EINVAL);
	return TCL_ERROR;
    }

    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) < 0) {
        return TCL_ERROR;
    }

    if (statePtr->unreportedError != 0) {
	Tcl_SetErrno(statePtr->unreportedError);
	statePtr->unreportedError = 0;

	/*
	 * TIP #219, Tcl Channel Reflection API.
	 * Move a defered error message back into the channel bypass.
	 */

	if (statePtr->chanMsg != NULL) {
	    TclDecrRefCount(statePtr->chanMsg);
	}
	statePtr->chanMsg = statePtr->unreportedMsg;
	statePtr->unreportedMsg = NULL;

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

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad message syntax causes a panic, because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshall the
     * information. Hence an error means that we've got serious breakage.
     */

    res = TclListObjGetElements(NULL, msg, &lc, &lv);
    if (res != TCL_OK) {
	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
    }

    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = (Tcl_Obj **)ckalloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */

    lignore = cignore = 0;
    for (i=0, j=0; i<numOptions; i+=2) {
	if (0 == strcmp(TclGetString(lv[i]), "-level")) {

				 * will be put in the buffer. */
    int nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    int bufLength;		/* How big is the buffer? */
    struct ChannelBuffer *nextPtr;
    				/* Next buffer in chain. */
    char buf[TCLFLEXARRAY];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	TclOffset(ChannelBuffer, buf)

/*

 * specific) instance data, and at a channel type structure.
 */

typedef struct ChannelState {
    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_Encoding encoding;	/* Encoding to apply when reading or writing
				 * data on this channel. NULL means no
				 * encoding is applied to data. */
    Tcl_EncodingState inputEncodingState;
				/* Current encoding state, used when
				 * converting input data bytes to UTF-8. */

    Tcl_ThreadId managingThread;/* TIP #10: Id of the thread managing this
				 * stack of channels. */

    /*
     * TIP #219 ... Info for the I/O system ...
     * Error message set by channel drivers, for the propagation of arbitrary
     * Tcl errors. This information, if present (chanMsg not NULL), takes
     * precedence over a posix error code returned by a channel operation.
     */

    Tcl_Obj* chanMsg;
    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
				 * because it happened in the background. The
				 * value is the chanMg, if any. #219's
				 * companion to 'unreportedError'. */
    int epoch;			/* Used to test validity of stored channelname
				 * lookup results. */
} ChannelState;

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

 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether the
 *	preceeding input operation on the channel would have blocked.
 *
 *---------------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FblockedObjCmd(

    }

    Tcl_IncrRefCount(command);
    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));

    /*
     * Use a byte-array to prevent the misinterpretation of binary data coming
     * through as UTF while at the tcl level.
     */

    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));

    /*
     * Step 2, execute the command at the global level of the interpreter used
     * to create the transformation. Destroy the command afterward. If an
     * error occured and the current interpreter is defined and not equal to
     * the interpreter for the callback, then copy the error message into
     * current interpreter. Don't copy if in preservation mode.
     */

    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(command);
    command = NULL;

	dataPtr->timer = NULL;
    }

    /*
     * Now flush data waiting in internal buffers to output and input. The
     * input must be done despite the fact that there is no real receiver for
     * it anymore. But the scripts might have sideeffects other parts of the
     * system rely on (f.e. signaling the close to interested parties).
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
		TRANSMIT_DOWN, P_PRESERVE);
    }

    ClientData instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occuring for this channel. We
     * are forwarding the call to the underlying channel now.
     */

    dataPtr->watchMask = mask;

    /*
     * No channel handlers any more. We will be notified automatically about

 *----------------------------------------------------------------------
 */

static int
TransformNotifyProc(
    ClientData clientData,	/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occuring events. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    /*
     * An event occured in the underlying channel. This transformation doesn't
     * process such events thus returns the incoming mask unchanged.
     */

    if (dataPtr->timer != NULL) {
	/*
	 * Delete an existing timer. It was not fired, yet we are here, so the
	 * channel below generated such an event and we don't have to. The


/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an emtpy buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *

/*
 * tclIORChan.c --
 *
 *	This file contains the implementation of Tcl's generic channel
 *	reflection code, which allows the implementation of Tcl channels in
 *	Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"

    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'rechan', 'memchan', etc.
     *
     * Here this is _not_ required. Interest in events is posted to the Tcl
     * level via 'watch'. And posting of events is possible from the Tcl level
     * as well, via 'chan postevent'. This means that the generation of all
     * events, fake or not, timer based or not, is completely in the hands of
     * the Tcl level. Therefore no timer here.
     */
} ReflectedChannel;

/*
 * Structure of the table maping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
 * is able to find them even if the actual channel was moved to a different
 * interpreter and/or thread.
 *
 * The table is reachable via the standard interpreter AssocData, the key is
 * defined below.

     * (2) Is the post event issued from the interpreter holding the handler
     *     of the reflected channel?
     *
     * A successful search answers yes to both. Because the map holds only
     * handles of reflected channels, and only of such whose handler is
     * defined in this interpreter.
     *
     * We keep the old checks for both, for paranioa, but abort now instead of
     * throwing errors, as failure now means that our internal datastructures
     * have gone seriously haywire.
     */

    chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
    chanTypePtr = Tcl_GetChannelType(chan);

    /*

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad syntax causes a panic. This is OK because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshall the
     * information; if we panic here, something has gone badly wrong already.
     */

    if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
    }
    if (interp == NULL) {

 *
 * ReflectClose/ReflectClose2 --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver specific instance data.
 *
 * Results:
 *	A posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

 *	reflected channel.
 *
 * Results:
 *	A Tcl_Obj containing the string of the new channel handle. The
 *	refcount of the returned object is -- zero --.
 *
 * Side effects:
 *	May allocate memory. Mutex protected critical section locks out other
 *	threads for a short time.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NextHandle(void)


/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invokation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:

    MethodName method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
    Tcl_Obj *cmd;

    if (rcPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

 *	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
MarkDead(

                Tcl_GetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inacessible. Afterward the
     * mode tells us which methods are still required, and these methods will
     * also be supported by the handler, by design of the check.
     */

    if (!HAS(methods, METH_READ)) {
	mode &= ~TCL_READABLE;
    }

 *
 * ReflectClose --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver specific instance data.
 *
 * Results:
 *	A posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

	    return EINVAL;
	}
	return EOK;
    }
#endif /* TCL_THREADS */

    /*
     * Do the actual invokation of "finalize" now; we're in the right thread.
     */

    result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
    if ((result != TCL_OK) && (interp != NULL)) {
	Tcl_SetChannelErrorInterp(interp, resObj);
    }

 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

 *----------------------------------------------------------------------
 */

static int
ReflectGetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of reuqested option */
    Tcl_DString *dsPtr)		/* String to place the result into */
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back

    int direction,
    ClientData *handlePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no handle of their own. As such we simply query
     * the parent channel for it. This way the qery will ripple down through
     * all transformations until reaches the base channel. Which then returns
     * its handle, or fails. The former will then ripple up the stack.
     *
     * This all happens in the thread we are in. As the Tcl level is not
     * involved no forwarding is required.
     */

ReflectNotify(
    ClientData clientData,
    int mask)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * An event occured in the underlying channel.
     *
     * We delete our timer. It was not fired, yet we are here, so the channel
     * below generated such an event and we don't have to. The renewal of the
     * interest after the execution of channel handlers will eventually cause
     * us to recreate the timer (in ReflectWatch).
     */


/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invokation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:

    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    int cmdc;			/* #words in constructed command */
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */

    if (rtPtr->dead) {
	/*
	 * The transform is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

     * NOTE (5): Decide impl. issue: Cache objects with method names?
     * Requires TSD data as reflections can be created in many different
     * threads.
     * NO: Caching of command resolutions means storage per channel.
     */

    /*
     * Insert method into the pre-allocated area, after the command prefix,
     * before the channel id.
     */

    methObj = Tcl_NewStringObj(method, -1);
    Tcl_IncrRefCount(methObj);
    rtPtr->argv[rtPtr->argc - 2] = methObj;

	if (argTwoObj) {
	    rtPtr->argv[cmdc] = argTwoObj;
	    cmdc++;
	}
    }

    /*
     * And run the handler... This is done in auch a manner which leaves any
     * existing state intact.
     */

    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
    Tcl_Preserve(rtPtr);
    Tcl_Preserve(rtPtr->interp);
    result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);


/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an emtpy buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *

	}

#   undef OUT_OF_RANGE
#   undef OUT_OF_URANGE
#endif /* !TCL_WIDE_INT_IS_LONG */

	/*
	 * Copy across all supported fields, with possible type coercions on
	 * those fields that change between the normal and lf64 versions of
	 * the stat structure (on Solaris at least). This is slow when the
	 * structure sizes coincide, but that's what you get for using an
	 * obsolete interface.
	 */

	oldStyleBuf->st_mode	= buf.st_mode;

 *
 * TclFSCwdPointerEquals --
 *
 *	Check whether the current working directory is equal to the path
 *	given.
 *
 * Results:
 *	1 (equal) or 0 (un-equal) as appropriate.
 *
 * Side effects:
 *	If the paths are equal, but are not the same object, this method will
 *	modify the given pathPtrPtr to refer to the same object. In this case
 *	the object pointed to by pathPtrPtr will have its refCount
 *	decremented, and it will be adjusted to point to the cwd (with a new
 *	refCount).

 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special notes:
 *	If the filesystem-specific normalizePathProcs can re-introduce ../, ./
 *	sequences into the path, then this function will not return the
 *	correct result. This may be possible with symbolic links on unix.
 *
 *	Important assumption: if startAt is non-zero, it must point to a
 *	directory separator that we know exists and is already normalized (so
 *	it is important not to point to the char just after the separator).
 *
 *---------------------------------------------------------------------------
 */

int
TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* The path to normalize in place. */
    int startAt)		/* Start at this char-offset. */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;

    /*
     * Call each of the "normalise path" functions in succession. This is a
     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a
     * native filesystem (i.e. '/' on unix is native).
     */

    firstFsRecPtr = FsGetFirstFilesystem();

    Claim();
    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *
 *	This function replaces the library version of stat and lsat.
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.
 *
 * Results:
 *	See stat documentation.
 *

	/*
	 * If the filesystem couldn't be found, or if no cwd function exists
	 * for this filesystem, then we simply assume the cached cwd is ok.
	 * If we do call a cwd, we must watch for errors (if the cwd returns
	 * NULL). This ensures that, say, on Unix if the permissions of the
	 * cwd change, 'pwd' does actually throw the correct error in Tcl.
	 * (This is tested for in the test suite on unix).
	 */

	if (fsPtr == NULL || fsPtr->getCwdProc == NULL) {
	    goto cdDidNotChange;
	}

	if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) {

 * Tcl_FSSplitPath --
 *
 *	This function takes the given Tcl_Obj, which should be a valid path,
 *	and returns a Tcl List object containing each segment of that path as
 *	an element.
 *
 * Results:
 *	Returns list object with refCount of zero. If the passed in lenPtr is
 *	non-NULL, we use it to return the number of elements in the returned
 *	list.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------

    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	/*
	 * We want to skip the native filesystem in this loop because
	 * otherwise we won't necessarily pass all the Tcl testsuite - this is
	 * because some of the tests artificially change the current platform
	 * (between win, unix) but the list of volumes we get by calling
	 * fsRecPtr->fsPtr->listVolumesProc will reflect the current (real)
	 * platform only and this may cause some tests to fail. In particular,
	 * on Unix '/' will match the beginning of certain absolute Windows
	 * paths starting '//' and those tests will go wrong.
	 *
	 * Besides these test-suite issues, there is one other reason to skip
	 * the native filesystem - since the tclFilename.c code has nice fast

    int objc, result, t;
    Tcl_Obj **objv;
    const char **tablePtr;

    /*
     * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
     * of the code there. This is a bit ineffiecient but simpler.
     */

    result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv);
    if (result != TCL_OK) {
	return result;
    }

 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
typedef struct NamespacePathEntry NamespacePathEntry;

/*
 * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
 * field added at the end: in this way variables can find their namespace
 * without having to copy a pointer in their struct: they can access it via
 * their hPtr->tablePtr.
 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;

				 * 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 (a) the name

    struct EnsembleConfig *next;/* The next ensemble in the linked list of
				 * ensembles associated with a namespace. If
				 * this field points to this ensemble, the
				 * structure has already been unlinked from
				 * all lists, and cannot be found by scanning
				 * the list from the namespace's ensemble
				 * field. */
    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX,
				 * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */

    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */

    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
				 * subcommands to their implementing command
				 * prefixes, or NULL if we are to build the

				 * NULL to use the default error-generating
				 * behaviour. The script execution gets all
				 * the arguments to the ensemble command
				 * (including objv[0]) and will have the
				 * results passed directly back to the caller
				 * (including the error code) unless the code
				 * is TCL_CONTINUE in which case the
				 * subcommand will be reparsed by the ensemble
				 * core, presumably because the ensemble
				 * itself has been updated. */
    Tcl_Obj *parameterList;	/* List of ensemble parameter names. */
    int numParameters;		/* Cached number of parameters. This is either
				 * 0 (if the parameterList field is NULL) or
				 * the length of the list in the parameterList
				 * field. */

				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */
    Tcl_HashEntry entry;	/* The hash table entry that refers to this
				 * variable. This is used to find the name of
				 * the variable and to delete it from its
				 * hashtable if it is no longer needed. It
				 * also holds the variable's name. */
} VarInHash;

/*
 * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
 * mutually exclusive and give the "type" of the variable. If none is set,
 * this is a scalar variable.
 *
 * 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.
 *
 * Flags that indicate the type and status of storage; none is set for
 * compiled local variables (Var structs).
 *
 * 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_DEAD_HASH		1 means that this var's entry in the hashtable
 *				has already been 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

    int pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    int word;			/* Index of word in
				 * ExtCmdLoc.loc[cmd]->line[.] */
    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
				 * CmdFrame litarg field for the list start. */
    Tcl_Obj *obj;		/* Back reference to hashtable key */
} CFWordBC;

/*
 * Structure to record the locations of invisible continuation lines in
 * literal scripts, as character offset from the beginning of the script. Both
 * compiler and direct evaluator use this information to adjust their line
 * counters when tracking through the script, because when it is invoked the
 * continuation line marker as a whole has been removed already, meaning that
 * the \n which was part of it is gone as well, breaking regular line
 * tracking.
 *
 * These structures are allocated and filled by both the function
 * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
 * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
 * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
 * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
 * released by the function TclFreeObj(), in the file "tclObj.c", and also by
 * the function TclThreadFinalizeObjects(), in the same file.
 */

#define CLL_END		(-1)

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

 * Other externals.
 */

MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment
                                         * (if changed with tcl-env). */

#endif /* _TCLINT */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa

#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */
#undef TclMacOSXGetFileAttribute /* 15 */
#undef TclMacOSXSetFileAttribute /* 16 */
#undef TclMacOSXCopyFileAttributes /* 17 */
#undef TclMacOSXMatchType /* 18 */
#undef TclMacOSXNotifierAddRunLoopMode /* 19 */
#endif

				 * handlers. */
    LimitHandler *nextPtr;	/* Next item in linked list of handlers. */
};

/*
 * Values for the LimitHandler flags field.
 *      LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
 *              processed; handlers are never to be entered reentrantly.
 *      LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
 *              should not normally be observed because when a handler is
 *              deleted it is also spliced out of the list of handlers, but
 *              even so we will be careful.
 */

#define LIMIT_HANDLER_ACTIVE    0x01

    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);
    Tcl_UnsetVar2(interp, "tcl_platform", "user", 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);

 *	interpreter through this mechanism (though as many interpreters may be
 *	limited as the programmer chooses overall).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A limit callback implemented as an invokation of a Tcl script in
 *	another interpreter is either installed or removed.
 *
 *----------------------------------------------------------------------
 */

static void
SetScriptLimitCallback(

	}
	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 interp's
     * result, since the variable access could occur when the result has been
     * partially set.
     */

    if (linkPtr->flags & LINK_READ_ONLY) {
	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),

 *	    converted to one. An error message will be left in the
 *	    interpreter's result if interp is not NULL.
 *
 * Effect
 *
 *	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
 *	Appending the new element may cause the the array of element pointers
 *	in 'listObj' to grow.  Any preexisting string representation of
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */

int

 *	    'index' is out of range, NULL is stored in 'objPtrPtr'.  This
 *	    object should be treated as readonly and its 'refCount' is _not_
 *	    incremented. The caller must do that if it holds on to the
 *	    reference.
 *
 * 	TCL_ERROR
 *
 * 	    'listPtr' is not a valid list. An an error message is left in the
 * 	    interpreter's result if 'interp' is not NULL.
 *
 *  Effect
 *
 * 	If 'listPtr' is not already of type 'tclListType', it is converted.
 *
 *----------------------------------------------------------------------

	}
    }

    /*
     * Note that when count == 0 and objc == 0, this routine is logically a
     * no-op, removing and adding no elements to the list. However, by flowing
     * through this routine anyway, we get the important side effect that the
     * resulting listPtr is a list in canoncial form. This is important.
     * Resist any temptation to optimize this case.
     */

    listRepPtr = ListRepPtr(listPtr);
    elemPtrs = &listRepPtr->elements;
    numElems = listRepPtr->elemCount;

	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
    }
    TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);

    /*
     * Let TclLsetFlat handle the actual lset'ting.
     */

    retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);

    Tcl_DecrRefCount(indexListCopy);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object.
 *
 *	Any previously-exising string representation is not invalidated, so
 *	storage is lost if this has not been taken care of.
 *
 * Effect
 *
 *	The string representation of 'listPtr' is set to the resulting string.
 *	This string will be empty if the list has no elements. It is assumed
 *	that the list internal representation is not NULL.

				 * array. */
    int length,			/* Number of bytes in the string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;

	    return objIndex;
	}
    }

    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * sharing it accross namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.
     */

    if ((flags & LITERAL_CMD_NAME)) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;


/*
 *----------------------------------------------------------------------
 *
 * TclGetLoadedPackages --
 *
 *	This function 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 the interp's 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.

 *
 * Results:
 *	nothing
 *
 * Side effects:
 *	Increments the command reference epoch in each namespace whose path
 *	includes the given namespace. This causes any cached resolved names
 *	whose root cacheing context starts at that namespace to be recomputed
 *	the next time they are used.
 *
 *----------------------------------------------------------------------
 */

void
TclInvalidateNsPath(

    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;

 *	    namespace upvar ns otherVar myVar ?otherVar myVar ...?
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Creates new variables in the current scope, linked to the
 *	corresponding variables in the stipulated nmamespace. If anything goes
 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceUpvarCmd(

	    }
	}
	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) {

	 * this guard could be removed.
	 */
	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */
    oPtr->flags |= OBJECT_DESTRUCTING;

    /*
     * Let the dominoes fall!
     */

     * still exists) because otherwise its pointer to the object points into
     * freed memory.
     */

    if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */

    AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
		NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
		NULL, 0, NULL);

#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"

/*
 * Structure used to help delay computing names of objects or classes for
 * [info frame] until needed, making invokation faster in the normal case.
 */

struct PNI {
    Tcl_Interp *interp;		/* Interpreter in which to compute the name of
				 * a method. */
    Tcl_Method method;		/* Method to compute the name of. */
};

 * The structure defined below is used in this file only.
 */

typedef struct ThreadSpecificData {
    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
                                 * generated by a call to the function
                                 * TclSubstTokens() from a literal text
                                 * where bs+nl sequences occured in it, if
                                 * any. I.e. this table keeps track of
                                 * invisible and stripped continuation lines.
                                 * Its keys are Tcl_Obj pointers, the values
                                 * are ContLineLoc pointers. See the file
                                 * tclCompile.h for the definition of this
                                 * structure, and for references to all
                                 * related places in the core. */

 * structure; every thread will have its own structure instance. The purpose
 * of this structure is to allow deeply nested collections of Tcl_Objs to be
 * freed without taking a vast depth of C stack (which could cause all sorts
 * of breakage.)
 */

typedef struct PendingObjData {
    int deletionCount;		/* Count of the number of invokations of
				 * TclFreeObj() are on the stack (at least
				 * conceptually; many are actually expanded
				 * macros). */
    Tcl_Obj *deletionStack;	/* Stack of objects that have had TclFreeObj()
				 * invoked upon them but which can't be
				 * deleted yet because they are in a nested
				 * invokation of TclFreeObj(). By postponing
				 * this way, we limit the maximum overall C
				 * stack depth when deleting a complex object.
				 * The down-side is that we alter the overall
				 * behaviour by altering the order in which
				 * objects are deleted, and we change the
				 * order in which the string rep and the
				 * internal rep of an object are deleted. Note

	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for
	 * example test info-30.19 where the action (code) for all branches of
	 * the switch command is identical, mapping them all to the same
	 * literal. An interesting result of this is that the number and
	 * locations (offset) of invisible continuation lines in the literal
	 * are the same for all occurences.
	 *
	 * Note that while reusing the existing entry is possible it requires
	 * the same actions as for a new entry because we have to copy the
	 * incoming num/loc data even so. Because we are called from
	 * TclContinuationsEnterDerived for this case, which modified the
	 * stored locations (Rebased to the proper relative offset). Just
	 * returning the stored entry would rebase them a second time, or

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

 *	the object if necessary.
 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared. If conversion fails, an the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *	It is expected that the caller will NOT have invoked mp_init on the
 *	bignum value before passing it in. Tcl will initialize the mp_int as
 *	it sets the value. The value is transferred from the internals of
 *	objPtr to the caller, passing responsibility of the caller to call

 *
 *----------------------------------------------------------------------
 */

/* ARGSUSED */

/*
 * The following comment is here so that Coverity's static analizer knows that
 * a Tcl_Panic() call can never return and avoids lots of false positives.
 */

/* coverity[+kill] */
void
Tcl_Panic(
    const char *format,

 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a a
				 * backslash sequence. */
    int numBytes,		/* Max number of bytes to scan. */
    int *readPtr,		/* NULL, or points to storage where the number
				 * of bytes scanned should be written. */
    char *dst)			/* NULL, or points to buffer where the UTF-8
				 * encoding of the backslash sequence is to be
				 * written. At most TCL_UTF_MAX bytes will be

     * Tcl_Obj creation if possible, to aid performance and limit shimmering.
     *
     * Further optimization opportunities might be to check for the equivalent
     * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
     */

    /*
     * For the handling of continuation lines in literals we first check if
     * this is actually a literal. For if not we can forego the additional
     * processing. Otherwise we pre-allocate a small table to store the
     * locations of all continuation lines we find in this literal, if any.
     * The table is extended if needed.
     */

    numCL = 0;
    maxNumCL = 0;
    isLiteral = 1;

}

Tcl_Obj *
TclJoinPath(
    int elements,		/* Number of elements to use (-1 = all) */
    Tcl_Obj * const objv[],	/* Path elements to join */
    int forceRelative)		/* If non-zero, assume all more paths are
				 * relative (e. g. simple normalization) */
{
    Tcl_Obj *res = NULL;
    int i;
    const Tcl_Filesystem *fsPtr = NULL;

    assert ( elements >= 0 );

		     * the base itself is just fine!
		     */

		    return elt;
		}

		/*
		 * If it doesn't begin with '.' and is a unix path or it a
		 * windows path without backslashes, then we can be very
		 * efficient here. (In fact even a windows path with
		 * backslashes can be joined efficiently, but the path object
		 * would not have forward slashes only, and this would
		 * therefore contradict our 'file join' documentation).
		 */

 *	None.
 *
 *----------------------------------------------------------------------
 */

static TclFile
FileForRedirect(
    Tcl_Interp *interp,		/* Intepreter to use for error reporting. */
    const char *spec,		/* Points to character just after redirection
				 * character. */
    int atOK,			/* Non-zero means that '@' notation can be
				 * used to specify a channel, zero means that
				 * it isn't. */
    const char *arg,		/* Pointer to entire argument containing spec:
				 * used for error reporting. */

				 * 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 overridden 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

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

static int
CompareVersions(
    char *v1, char *v2,		/* Versions strings, of form 2.1.3 (any number
				 * of version numbers). */
    int *isMajorPtr)		/* If non-null, the word pointed to is filled
				 * in with a 0/1 value. 1 means that the
				 * difference occured in the first element. */
{
    int thisIsMajor, res, flip;
    char *s1, *e1, *s2, *e2, o1, o2;

    /*
     * Each iteration of the following loop processes one number from each
     * string, terminated by a " " (space). If those numbers don't match then

	ckfree(min);
	ckfree(buf);
	return satisfied;
    }

    /*
     * We have both min and max, and generate their internal reps. When
     * identical we compare as is, otherwise we pad with 'a0' to ove the range
     * a bit.
     */

    CheckVersionAndConvert(NULL, buf, &min, NULL);
    CheckVersionAndConvert(NULL, dash, &max, NULL);

    if (CompareVersions(min, max, NULL) == 0) {

			((Tcl_WideInt)significand / pow10vals[-exponent]);
		goto returnValue;
	    }
	}
    }

    /*
     * All the easy cases have failed. Promote ths significand to bignum and
     * call MakeHighPrecisionDouble to do it the hard way.
     */

    TclBNInitBignumFromWideUInt(&significandBig, significand);
    retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
	    exponent);
    mp_clear(&significandBig);

	    mp_mul(&twoMv, pow5+i, &twoMv);
	}
    }

    /*
     * Compute twoMd as 2*M*d, where d is the exact value.
     * This is done by multiplying by 5**(M5+exponent) and then multiplying
     * by 2**(M5+exponent+1), which is, of couse, a left shift.
     */

    mp_init_copy(&twoMd, exactSignificand);
    for (i=0; i<=8; ++i) {
	if ((M5 + exponent) & (1 << i)) {
	    mp_mul(&twoMd, pow5+i, &twoMd);
	}

}

/*
 *----------------------------------------------------------------------
 *
 * RequiredPrecision --
 *
 *	Determines the number of bits needed to hold an intger.
 *
 * Results:
 *	Returns the position of the most significant bit (0 - 63).  Returns 0
 *	if the number is zero.
 *
 *----------------------------------------------------------------------
 */

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    int needed,
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    int needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     *	needed < STRING_MAXCHARS
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    int attempt;

 *----------------------------------------------------------------------
 *
 * Tcl_GetCharLength --
 *
 *	Get the length of the Unicode string from the Tcl object.
 *
 * Results:
 *	Pointer to unicode string representing the unicode object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
	return objPtr->length;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object;
     * we don't need to convert to a string to perform the get-length operation.
     *
     * NOTE that we do not need the bytearray to be "pure".  A ByteArray value
     * with a string rep cannot be trusted to represent the same value as the
     * string rep, but it *can* be trusted to have the same character length
     * as the string rep, which is all this routine cares about.
     */

    if (objPtr->typePtr == &tclByteArrayType) {
	int length;

	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;

#if COMPAT
	if (numChars < objPtr->length) {
	    /*
	     * Since we've just computed the number of chars, and not all UTF
	     * chars are 1-byte long, go ahead and populate the unicode
	     * string.
	     */

	    FillUnicodeRep(objPtr);
	}
#endif
    }

    int length;

    if (index < 0) {
	return 0xFFFD;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return 0xFFFD;

    }
    return stringPtr->unicode[index];
}

#if TCL_UTF_MAX == 4
int
TclGetUCS4(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    int index)			/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch, length;

    if (index < 0) {
	return -1;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;

 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_GetUnicode(
    Tcl_Obj *objPtr)		/* The object to find the unicode string
				 * for. */
{
    return Tcl_GetUnicodeFromObj(objPtr, NULL);
}

/*
 *----------------------------------------------------------------------

 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    int *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    int length;

    if (first < 0) {
	first = 0;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last < 0 || last >= length) {

	if (length > stringPtr->maxChars) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string
	 */

	stringPtr->numChars = length;
	stringPtr->unicode[length] = 0;
	stringPtr->hasUnicode = 1;

	/*

	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > STRING_MAXCHARS) {
	    return 0;
	}
	if (length > stringPtr->maxChars) {
	    stringPtr = stringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string.
	 */

	stringPtr->unicode[length] = 0;
	stringPtr->numChars = length;
	stringPtr->hasUnicode = 1;

	/*

 *
 *---------------------------------------------------------------------------
 */

void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeIntRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);

    stringCheckLimits(numChars);
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    int length)			/* Number of chars in "unicode". */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }

    if (length == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If objPtr has a valid Unicode rep, then append the "unicode" to the
     * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
     * objPtr's string rep.
     */

    if (stringPtr->hasUnicode
#if COMPAT
		&& stringPtr->numChars > 0
#endif
	    ) {
	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
    } else {
	AppendUnicodeToUtfRep(objPtr, unicode, length);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToObj --
 *
 *	This function appends the string rep of one object to another.
 *	"objPtr" cannot be a shared object.

     */

    if (appendObjPtr->bytes == tclEmptyStringRep) {
	return;
    }

    /*
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects don't have string reps; if
     * it did, then appending the byte arrays together could well lose
     * information; this is a special-case optimization only.
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
	    && TclIsPureByteArray(appendObjPtr)) {

}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUnicodeRep --
 *
 *	This function appends the contents of "unicode" to the Unicode rep of
 *	"objPtr". objPtr must already have a valid Unicode rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	objPtr's internal rep is reallocated.
 *

	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If not enough space has been allocated for the unicode rep, reallocate
     * the internal rep object with additional space. First try to double the
     * required allocation; if that fails, try a more modest increase. See the
     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;
    stringCheckLimits(numChars);

    if (numChars > stringPtr->maxChars) {
	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset >= 0) {
	    unicode = stringPtr->unicode + offset;
	}
    }

 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    int numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != -1) {
	stringPtr->numChars += numChars;
    }

#if COMPAT
    /*
     * Invalidate the unicode rep.
     */

    stringPtr->hasUnicode = 0;
#endif
}

/*

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars;
	Tcl_UniChar *to;

	if (Tcl_IsShared(objPtr)) {
	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = Tcl_GetUnicode(objPtr);
	    while (--src >= from) {
#if TCL_UTF_MAX <= 4

 *	Update the string representation for an object whose internal
 *	representation is "String".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string may be set by converting its Unicode represention
 *	to UTF format.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfString(

static int
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    int numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    int i, origLength, size = 0;
    char *dst, buf[4] = "";
    String *stringPtr = GET_STRING(objPtr);

    if (numChars < 0) {

				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

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

 *	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 interpreter,
 *	variable "x" in that interpreter is set to "loaded".
 *
 *----------------------------------------------------------------------
 */

static int
TeststaticpkgCmd(

/*
 *----------------------------------------------------------------------
 *
 * TestconcatobjCmd --
 *
 *	This procedure implements the "testconcatobj" command. It is used
 *	to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all
 *	cases and thet it never corrupts its arguments. In other words, that
 *	[Bug 1447328] was fixed properly.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.

    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    /*
     * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
     * that its address is different for each index object. If we accidently
     * allocate a table at the same address as that cached in the index
     * object, clear out the object's cached state.
     */

    if (objv[3]->typePtr != NULL
	    && !strcmp("index", objv[3]->typePtr->name)) {
	indexRep = objv[3]->internalRep.twoPtrValue.ptr1;

    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    int n;

    /*
     * First, atttempt to move blocks from the shared cache. Note the
     * potentially dirty read of numFree before acquiring the lock which is a
     * slight performance enhancement. The value is verified after the lock is
     * actually acquired.
     */

    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) {
	LockBucket(cachePtr, bucket);

}

/*
 *----------------------------------------------------------------------
 *
 * TclRememberJoinableThread --
 *
 *	This procedure remebers a thread as joinable. Only a call to
 *	TclJoinThread will remove the structre created (and initialized) here.
 *	IOW, not waiting upon a joinable thread will cause memory leaks.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory, adds it to the global list of all joinable threads.

    if (!found) {
	Tcl_MutexUnlock(&threadMutex);
	Tcl_AppendResult(interp, "invalid thread id", NULL);
	return TCL_ERROR;
    }

    /*
     * Short circut sends to ourself. Ought to do something with -async, like
     * run in an idle handler.
     */

    if (threadId == Tcl_GetCurrentThread()) {
	Tcl_MutexUnlock(&threadMutex);
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

 *	function to be invoked.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the command given by cmdName, such that future
 *	changes to the command will be intermediated by proc. See the manual
 *	entry for complete details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TraceCommand(

    const 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, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;

ClientData
Tcl_VarTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *varName,	/* Name of variable; may end with "(index)" to
				 * signify an array reference. */
    int flags,			/* OR-ed combo or TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY (can be 0). */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, 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, NULL, flags, proc,
	    prevClientData);

    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *part1,		/* Name of variable or array. */
    const 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. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;

 *	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.
 *     The variable's flags are updated.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_TraceVar

 *	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. The variable's flags are updated.
 *
 *----------------------------------------------------------------------
 */

int

 *	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 the
 *	traceProc listed in tracePtr. See the manual entry for complete
 *	details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

static int

 *----------------------------------------------------------------------
 */

int
Tcl_UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {

#if COMPAT
	if (preferEscape && !preferBrace) {
	    /*
	     * If we are quoting solely due to ] or internal " characters use
	     * the CONVERT_MASK mode where we escape all special characters
	     * except for braces. "extra" counted space needed to escape
	     * braces too, so substract "braceCount" to get our actual needs.
	     */

	    bytesNeeded += (extra - braceCount);
	    /* Make room to escape leading #, if needed. */
	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }

    }

  slow:
    /*
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to pre-allocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = TclGetStringFromObj(objv[i], &elemLength);
	bytesNeeded += elemLength;
	if (bytesNeeded < 0) {
	    break;

		goto donePart1;
	    }
	}
	goto doneParsing;
    }

    /*
     * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
     * parts.
     */

    if (typePtr == &tclParsedVarNameType) {
	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
	    if (part2Ptr != NULL) {
		/*

 *
 *	If the current CallFrame corresponds to a proc and the variable found
 *	is one of the compiledLocals, its index is placed in *indexPtr.
 *	Otherwise, *indexPtr will be set to (according to the needs of
 *	TclObjLookupVar):
 *	    -1 a global reference
 *	    -2 a reference to a namespace variable
 *	    -3 a non-cachable reference, i.e., one of:
 *		. non-indexed local var
 *		. a reference of unknown origin;
 *		. resolution by a namespace or interp resolver
 *
 *	If the variable isn't found and creation wasn't specified, or some
 *	other error occurs, NULL is returned and the corresponding error
 *	message is left in *errMsgPtr.

    }

    if (e != Z_OK) {
	goto error;
    }

    /*
     * Reduce the bytearray length to the actual data length produced by
     * deflate.
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

	if {0} {
	    lappend dirs [file join $grandParentDir library]
	    lappend dirs [file join $grandParentDir $basename$patch library]
	    lappend dirs [file join [file dirname $grandParentDir] \
			      $basename$patch library]
	}
    }
    # uniquify $dirs in order
    array set seen {}
    foreach i $dirs {
	# Make sure $i is unique under normalization. Avoid repeated [source].
	if {[interp issafe]} {
	    # Safe interps have no [file normalize].
	    set norm $i
	} else {

	    # 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 {} {

    } on ok {} {
	if {[namespace which -command tbcload::bcproc] eq ""} {
	    auto_load tbcload::bcproc
	}
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given pre-compiled
	# procedure name.

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    indexEntry $name
	}
    }
}

		catch {
		    set name [dict get [lrange $args 1 end] -command]
		    if {![string match ::* $name]} {
			set name ::[join [lreverse $contextStack] ::]$name
		    }
		    regsub -all ::+ $name :: name
		}
		# create artifical proc to force an entry in the tclIndex
		$parser eval [list ::proc $name {} {}]
	    }
	}
    }
}

# AUTO MKINDEX:  oo::class create name ?definition?

# Parameters:
#	locale -- Desired locale
#
# Results:
#	Returns the locale that was previously current.
#
# Side effects:
#	Does [mclocale].  If necessary, loades the designated locale's files.
#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale } {
    if { $locale eq {system} } {
	if { $::tcl_platform(platform) ne {windows} } {
	    # On a non-windows platform, the 'system' locale is the same as

#
# ParseStarDate --
#
#	Parses a StarDate
#
# Parameters:
#	year - Year from the Roddenberry epoch
#	fractYear - Fraction of a year specifiying the day of year.
#	fractDay - Fraction of a day
#
# Results:
#	Returns a count of seconds from the Posix epoch.
#
# Side effects:
#	None.

# Parameters:
#	None.
#
# Results:
#	Returns the system time zone.
#
# Side effects:
#	Stores the sustem time zone in the 'CachedSystemTimeZone'
#	variable, since determining it may be an expensive process.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetSystemTimeZone {} {
    variable CachedSystemTimeZone
    variable TimeZoneBad

    set f [open $fname r]
    fconfigure $f -translation binary
    set d [read $f]
    close $f

    # The file begins with a magic number, sixteen reserved bytes, and then
    # six 4-byte integers giving counts of fileds in the file.

    binary scan $d a4a1x15IIIIII \
	magic version nIsGMT nIsStd nLeap nTime nType nChar
    set seek 44
    set ilen 4
    set iformat I
    if { $magic != {TZif} } {

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

#
#	Garbage collect the state associated with a transaction
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state]} {
	unset state
    }
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

# http::CopyDone
#
#	fcopy completion callback
#
# Arguments
#	token	The token returned from http::geturl
#	count	The amount transfered
#
# Side Effects
#	Invokes callbacks

proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state