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

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

(^Z) for all platforms. If you require a
.QW ^Z
in code for string comparison, you can use
.QW \ex1A ,
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.

It returns the result of the command and also modifies
the interpreter result in the same way as \fBTcl_Eval\fR.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
of arguments.  \fBTcl_VarEval\fR is now 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

.AP int index in
The index of the attribute in question.
.AP Tcl_Obj *objPtr in
The value to set in the operation.
.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

.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
The body of a script provided to \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
A pre-compiled script (loadable by the package
\fBtbcload\fR), and no further information is available.
.RE
.TP
\fBline\fR
.
The line number of of the command inside its script.  Not available for
\fBprecompiled\fR commands.  When the type is \fBsource\fR, the line number is

Tcl began, the current packets allocated (the current
number of calls to \fBTcl_Alloc\fR not met by a corresponding call
to \fBTcl_Free\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 */
    size_t 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 */
    size_t 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(void *ptr, const char *file, int line)
}
declare 8 {
    void *Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE 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 {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *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.
 */

#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif

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

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t 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(
    void *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.
     */

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

				 * TCL_EVAL_GLOBAL is currently supported. */
    size_t 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);

 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL ((size_t)-1)		/* Use all elements in the argument. */
#define BINARY_NOCOUNT ((size_t)-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.
 *

 */

typedef struct {
    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 (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 = Tcl_UniCharToLower(uniLeft);
	    uniRightLower = Tcl_UniCharToLower(uniRight);
	} else {

	/*
	 * 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) {
	const 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,*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;

	    }
	}
    }

    /*
     * 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;
	size_t *mapLens;
	int *u2lc = 0;

	/*
	 * 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 = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2);
	mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2);

		    /*
		     * 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 ((int)parsePtr->numWords<4 || (int)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);

    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 = (JumptableInfo *)Tcl_Alloc(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. */
#define COMMENT		6	/* Comment. Lasts to end of line or end of

				 * 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. */
    size_t 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 size_t
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */

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

    assert ((int)parsePtr->numWords > 0);

    /* Pre-Compile */

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

    /*

#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);
    int count = count1;

    /*
     * if this is actually a literal, handle continuation lines by
     * preallocating a small table to store the locations of any continuation
     * lines we find in this literal.  The table is extended if needed.
     *
     * Note: In contrast with the analagous code in 'TclSubstTokens()' the
     * 'adjust' variable seems unneeded here.  The code which merges
     * continuation line information of multiple words which concat'd at
     * runtime also seems unneeded. 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.

				 * code when new namespace resolution rules
				 * are put into effect. */
    Tcl_Size 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 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) {
	*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) {

		ch = UNICODE_REPLACE_CHAR;
	    } else {
		ch = (Tcl_UniChar)byte;
	    }
	}

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

	if ((unsigned)ch - 1 < 0x7F) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}

     * not be the same length as the number of arguments to this ensemble
     * command, and then handing it to the main command-lookup engine. In
     * theory, the command could be looked up right here using the namespace in
     * which it is guaranteed to exist,
     *
     *   ((Q: That's not true if the -map option is used, is it?))
     *
     * but don't do that because cacheing of the command object should help.
     */

    {
	Tcl_Obj *copyPtr;	/* The list of words to dispatch on.
				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;
	size_t copyObjc, prefixObjc;

    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, TCL_INDEX_NONE, &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("Tcl_InitSubsystems 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;

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

	slength = Tcl_GetCharLength(valuePtr);
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);

	    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. */
    TCL_UNUSED(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) != statePtr->bufSize + BUFFER_PADDING) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

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

    int bufExists;
    /*
     * 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);
    }

	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
		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) {
			Tcl_Size 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
				 * TCL_INDEX_NONE 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) == -1) {
        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 = TclListObjGetElementsM(NULL, msg, &lc, &lv);
    if (res != TCL_OK) {
	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
    }

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

    lvn = (Tcl_Obj **)Tcl_Alloc(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. */
    Tcl_Size nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    Tcl_Size 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	offsetof(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'. */
    size_t epoch;		/* Used to test validity of stored channelname
				 * lookup results. */
    int maxPerms;		/* TIP #220: Max access privileges
				 * the channel was created with. */
} 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.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FblockedObjCmd(
    TCL_UNUSED(void *),

    }

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

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

    void *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(
    void *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 © 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.
     *
     * A timer is used here as well in order to ensure at least on pass through
     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * ef28eb1f1516.
     */
} 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 (TclListObjGetElementsM(interp, msgObj, &lc, &lv) != TCL_OK) {
	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
    }
    if (interp == NULL) {

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

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

                TclGetString(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(
    void *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,
    void **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(
    void *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;

 *	Stores the resulting pathname in pathPtr and returns the offset of the
 *	last byte processed in pathPtr.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special notes:
 *	If the filesystem-specific normalizePathProcs can re-introduce ../, ./
 *	components into the pathname, this function does not return the correct
 *	result. This may be possible with symbolic links on unix.
 *
 *
 *---------------------------------------------------------------------------
 */


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *	Calls 'statProc' of the filesystem corresponding to pathPtr.
 *
 *	Replaces the standard library routines stat.
 *
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *

    Tcl_Size objc, t;
    int result;
    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 = TclListObjGetElementsM(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 nsPtr
 * and arrayPtr fields added at the end: in this way variables can find their
 * namespace and possibly containing array without having to copy a pointer in
 * their struct: they can access them via their hPtr->tablePtr.
 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;
    struct Namespace *nsPtr;
#if TCL_MAJOR_VERSION > 8
    struct Var *arrayPtr;

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

    Tcl_Size pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    Tcl_Size 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)

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

				 * 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_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, 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),

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	This function is a special purpose version of Tcl_ListObjAppendList:
 *	it appends a single object referenced by elemObj to the list object
 *	referenced by toObj. If toObj is not already a list object, an
 *	attempt will be made to convert it to one.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case elemObj is added to





 *	the end of toObj's list. If toObj does not refer to a list object
 *	and the object can not be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Side effects:


 *	The ref count of elemObj is incremented since the list now refers to
 *	it. toObj will be converted, if necessary, to a list object. Also,
 *	appending the new element may cause listObj's array of element
 *	pointers to grow. toObj's old string representation, if any, is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elemObj to. */

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 *	This function returns a pointer to the index'th object from the list
 *	referenced by listPtr. The first element has index 0. If index is
 *	negative or greater than or equal to the number of elements in the
 *	list, a NULL is returned. If listPtr is not a list object, an attempt
 *	will be made to convert it to a list.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case objPtrPtr is set to

 *	the Tcl_Obj pointer for the index'th list element or NULL if index is

 *	out of range. This object should be treated as readonly and its ref
 *	count is _not_ incremented; the caller must do that if it holds on to
 *	the reference. If listPtr does not refer to a list and can't be



 *	converted to one, TCL_ERROR is returned and an error message is left
 *	in the interpreter's result if interp is not NULL.
 *
 * Side effects:

 *	listPtr will be converted, if necessary, to a list object.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjIndex(
    Tcl_Interp *interp,  /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,    /* List object to index into. */

	 */
	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
    }
    LIST_ASSERT_TYPE(indexListCopy);
    ListObjGetElements(indexListCopy, indexCount, indices);

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

    retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);

    Tcl_DecrRefCount(indexListCopy);
    return retValueObj;
}

}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object. Note: This

 *	function does not invalidate an existing old string rep so storage
 *	will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	list-to-string conversion. This string will be empty if the list has
 *	no elements. The list internal representation should not be NULL and
 *	we assume it is not NULL.
 *
 *----------------------------------------------------------------------
 */
static void
UpdateStringOfList(
    Tcl_Obj *listObj)		/* List object with string rep to update. */
{

				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, 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 = (CompileEnv *)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;

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

	 */

	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_DYING) {
	/*
	 * 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.
	 */

	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, NULL, 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, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, 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 {
    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

 * Side effects:
 *	The process dies, entering the debugger if possible.
 *
 *----------------------------------------------------------------------
 */

/*
 * 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. */
    size_t numBytes,		/* Max number of bytes to scan. */
    size_t *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 4 bytes will be written there. */

     * 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(
    size_t elements,		/* Number of elements to use */
    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;
    size_t i;
    const Tcl_Filesystem *fsPtr = NULL;

    if (elements == 0) {
	TclNewObj(res);

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

				 * 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 = TCL_INDEX_NONE;

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

	Tcl_Free(min);
	Tcl_Free(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.
     */

    if (mp_init_u64(&significandBig, significand) != MP_OKAY) {
	return 0.0;
    }
    retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,

	    return approxResult;
	}
    }

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

    if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) {
	mp_clear(&twoMv);
	return approxResult;
    }
    for (i = 0; (i <= 8); ++i) {

}

/*
 *----------------------------------------------------------------------
 *
 * 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,
    size_t 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,
    size_t needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    size_t 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.
 *
 *----------------------------------------------------------------------
 */

				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch;

    /*
     * 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)) {
	size_t length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {

    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
{
    int ch = 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 indexing operation.
     */

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

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

#undef Tcl_GetUnicodeFromObj
Tcl_UniChar *
TclGetUnicodeFromObj(
    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);

	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 = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	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. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeInternalRep(objPtr);
    SetUnicodeObj(objPtr, unicode, 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. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars == TCL_INDEX_NONE) {
	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. */
    size_t length)		/* Number of chars in "unicode". */
{
    String *stringPtr;

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

     */

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

    /*
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects are pure so that the
     * bytearray faithfully represent the true value; Otherwise appending the
     * byte arrays together could lose information;
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && 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;

    if (numChars > stringPtr->maxChars) {
	size_t index = TCL_INDEX_NONE;

	/*
	 * 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) {
	    index = unicode - stringPtr->unicode;
	}

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

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

	if (index != TCL_INDEX_NONE) {
	    unicode = stringPtr->unicode + index;
	}
    }

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

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

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

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

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

	if (!inPlace || 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);
	    stringPtr = GET_STRING(objPtr);
	    while (--src >= from) {

 *	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 size_t
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    size_t numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    size_t i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars == TCL_INDEX_NONE) {

				 * calculated. Any other means that there is a valid
				 * Unicode rep, or that the number of UTF bytes ==
				 * the number of chars. */
    Tcl_Size allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    Tcl_Size 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 "teststaticlibrary" command.
 *	It is used to test the procedure Tcl_StaticLibrary.
 *
 * 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
TeststaticlibraryCmd(

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

    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    size_t 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. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;

    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. */
    void *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 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
TclUniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t 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 = Tcl_GetStringFromObj(objv[i], &elemLength);
	bytesNeeded += elemLength;
    }

		goto donePart1;
	    }
	}
	goto doneParsing;
    }

    /*
     * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
     */

    ParsedGetInternalRep(part1Ptr, parsed, arrayPtr, elem);
    if (parsed && arrayPtr) {
	    if (part2Ptr != NULL) {
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify

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

	unset state
    }
    return
}

# 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

    # Some machines do not have exec. Also, on all
    # platforms, safe interpreters do not have exec.

    set auto_noexec 1
}

# Define a log command (which can be overwitten to log errors
# differently, specially when stderr is not available)

if {[namespace which -command tclLog] eq ""} {
    proc tclLog {string} {
	catch {puts stderr $string}
    }
}

    variable LoadedLocales {}

    # Records the locale of the currently sourced message catalogue file
    variable FileLocale

    # Configuration values per Package (e.g. client namespace).
    # The dict key is of the form "<option> <namespace>" and the value is the
    # configuration option. A nonexisting key is an unset option.
    variable PackageConfig [dict create mcfolder {} loadcmd {} changecmd {}\
	    unknowncmd {} loadedlocales {} loclist {}]

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<namespace> <locale> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.

# msgcat::mcn --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the passed namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the translated
#	string.

#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	ns	Package namespace of the translation
#	src	The string to translate.
#	args	Args to pass to the format command

#	    unset	Clear option. return "".
#
#	Available options are:
#
#	mcfolder
#	    The message catalog folder of the package.
#	    This is automatically set by mcload.
#	    If the value is changed using the set subcommand, an evntual
#	    loadcmd is invoked and all message files of the package locale are
#	    loaded.
#
#	loadcmd
#	    The command gets executed before a message file would be
#	    sourced for this module.
#	    The command is invoked with the expanded locale list to load.

    # Array storing the parsed descriptions
    variable OptDesc
    array set OptDesc {}
    # Next potentially free key id (numeric)
    variable OptDescN 0

# Inside algorithm/mechanism description:
# (not for the faint hearted ;-)
#
# The argument description is parsed into a "program tree"
# It is called a "program" because it is the program used by
# the state machine interpreter that use that program to
# actually parse the arguments at run time.
#
# The general structure of a "program" is

# Performance/Implementation issues
# ---------------------------------
# We use tcl lists instead of arrays because with tcl8.0
# they should start to be much faster.
# But this code use a lot of helper procs (like Lvarset)
# which are quite slow and would be helpfully optimized
# for instance by being written in C. Also our struture
# is complex and there is maybe some places where the
# string rep might be calculated at great exense. to be checked.

#
# Parse a given description and saves it here under the given key
# generate a unused keyid if not given
#
proc ::tcl::OptKeyRegister {desc {key ""}} {
    variable OptDesc

        variable OptDesc
        if {![info exists OptDesc($descKey)]} {
            return -code error "Unknown option description key \"$descKey\""
        }
        set OptDesc($descKey)
    }

# Parse entry point for ppl who don't want to register with a key,
# for instance because the description changes dynamically.
#  (otherwise one should really use OptKeyRegister once + OptKeyParse
#   as it is way faster or simply OptProc which does it all)
# Assign a temporary key, call OptKeyParse and then free the storage
proc ::tcl::OptParse {desc arglist} {
    set tempkey [OptKeyRegister $desc]
    set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res]

	set item [lindex $descriptions $adress]
	if {[OptIsPrg $item]} {
	    return [OptCurAddr $item $start]
	} else {
	    return $start
	}
    }
    # Set the value field of the current instruction
    proc OptCurSetValue {descriptionsName value} {
	upvar $descriptionsName descriptions
	# get the current item full adress
        set adress [OptCurAddr $descriptions]
	# use the 3th field of the item  (see OptValue / OptNewInst)
	lappend adress 2
	Lvarset descriptions $adress [list 1 $value]
	#                                  ^hasBeenSet flag
    }

    # empty state means done/paste the end of the program
    proc OptState {item} {
        lindex $item 0
    }

    # current state
    proc OptCurState {descriptions} {
        OptState [OptCurDesc $descriptions]
    }

    #######
    # Arguments manipulation

    # Returns the argument that has to be processed now
    proc OptCurrentArg {lst} {
        lindex $lst 0
    }
    # Advance to next argument
    proc OptNextArg {argsName} {
        uplevel 1 [list Lvarpop1 $argsName]
    }
    #######

		set vnamesLst [OptTreeVars $item $level $vnamesLst]
	    } else {
		set vname [OptVarName $item]
		upvar $level $vname var
		if {[OptHasBeenSet $item]} {
#		    puts "adding $vname"
		    # lets use the input name for the returned list
		    # it is more usefull, for instance you can check that
		    # no flags at all was given with expr
		    # {![string match "*-*" $Args]}
		    lappend vnamesLst [OptName $item]
		    set var [OptValue $item]
		} else {
		    set var [OptDefaultValue $item]
		}

# Arguments:
# -direct		(optional) If this flag is present, the generated
#			code in pkgMkIndex.tcl will cause the package to be
#			loaded when "package require" is executed, rather
#			than lazily when the first reference to an exported
#			procedure in the package is made.
# -verbose		(optional) Verbose output; the name of each file that
#			was successfully rocessed is printed out. Additionally,
#			if processing of a file failed a message is printed.
# -load pat		(optional) Preload any packages whose names match
#			the pattern.  Used to handle DLLs that depend on
#			other packages during their Init procedure.
# dir -			Name of the directory in which to create the index.
# args -		Any number of additional arguments, each giving
#			a glob pattern that matches the names of one or

		    }
		}
	    }
	    proc tclPkgUnknown args {}
	    package unknown tclPkgUnknown

	    # Stub out the unknown command so package can call into each other
	    # during their initialilzation.

	    proc unknown {args} {}

	    # Stub out the auto_import mechanism

	    proc auto_import {args} {}

	error [format $err(valueMissing) "-version"]
    }

    if {!([llength $opts(-source)] || [llength $opts(-load)])} {
	error $err(noLoadOrSource)
    }

    # OK, now everything is good.  Generate the package ifneeded statment.
    set cmdline "package ifneeded $opts(-name) $opts(-version) "

    set cmdList {}
    set lazyFileList {}

    # Handle -load and -source specs
    foreach key {load source} {

    upvar 1 $vv v
    set libclist [lsort [glob -nocomplain -directory $base libc*]]

    if {![llength $libclist]} { return 0 }

    set libc [lindex $libclist 0]

    # Try executing the library first. This should suceed
    # for a glibc library, and return the version
    # information.

    if {![catch {
	set vdata [lindex [split [exec $libc] \n] 0]
    }]} {
	regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v

proc ::platform::shell::generic {shell} {
    # Argument is the path to a tcl shell.

    CHECK $shell
    LOCATE base out

    set     code {}
    # Forget any pre-existing platform package, it might be in
    # conflict with this one.
    lappend code {package forget platform}
    # Inject our platform package
    lappend code [list source $base]
    # Query and print the architecture
    lappend code {puts [platform::generic]}
    # And done

proc ::platform::shell::identify {shell} {
    # Argument is the path to a tcl shell.

    CHECK $shell
    LOCATE base out

    set     code {}
    # Forget any pre-existing platform package, it might be in
    # conflict with this one.
    lappend code {package forget platform}
    # Inject our platform package
    lappend code [list source $base]
    # Query and print the architecture
    lappend code {puts [platform::identify]}
    # And done

    return
}

proc ::platform::shell::LOCATE {bv ov} {
    upvar 1 $bv base $ov out

    # Locate the platform package for injection into the specified
    # shell. We are using package management to find it, whereever it
    # is, instead of using hardwired relative paths. This allows us to
    # install the two packages as TMs without breaking the code
    # here. If the found package is wrapped we copy the code somewhere
    # where the spawned shell will be able to read it.

    # This code is brittle, it needs has to adapt to whatever changes
    # are made to the TM code, i.e. the provide statement generated by
    # tm.tcl

    set pl [package ifneeded platform [package require platform]]
    set base [lindex $pl end]

    set out 0
    if {[lindex [file system $base]] ne "native"} {

		-deleteHook {
		    return [list -deleteHook $state(cleanupHook)]
		}
		-noStatics {
		    # it is most probably a set in fact but we would need
		    # then to jump to the set part and it is not *sure*
		    # that it is a set action that the user want, so force
		    # it to use the unambigous -statics ?value? instead:
		    return -code error\
			"ambigous query (get or set -noStatics ?)\
				use -statics instead"
		}
		-nestedLoadOk {
		    return -code error\
			"ambigous query (get or set -nestedLoadOk ?)\

		set nested     [InterpNested]
	    } else {
		set nested     $state(nestedok)
	    }
	    if {![::tcl::OptProcArgGiven -deleteHook]} {
		set deleteHook $state(cleanupHook)
	    }
	    # we can now reconfigure :
	    set withAutoPath [::tcl::OptProcArgGiven -autoPath]
	    InterpSetConfig $child $accessPath $statics $nested $deleteHook $autoPath $withAutoPath

	    # auto_reset the child (to completely synch the new access_path) tests safe-9.8 safe-9.9
	    if {$doreset} {
		if {[catch {::interp eval $child {auto_reset}} msg]} {
		    Log $child "auto_reset failed: $msg"
		} else {
		    Log $child "successful auto_reset" NOTICE
		}

				 0 [info library]]
	    Log $child "tcl_libray was not in first in auto_path,\
			moved it to front of child's access_path" NOTICE
	}

	set raw_auto_path $access_path

	# Add 1st level sub dirs (will searched by auto loading from tcl
	# code in the child using glob and thus fail, so we add them here
	# so by default it works the same).
	set access_path [AddSubDirs $access_path]
    } else {
        set raw_auto_path $autoPath
    }