Tcl Source Code

2012-08-08  Jan Nijtmans  <[email protected]>

	* generic/tclfileName.c: [Bug #1536227]: Cygwin network pathname
	* tests/fileName.test:   support

2012-08-07  Don Porter  <[email protected]>

	* generic/tclIOUtil.c:	[Bug 3554250] Overlooked one field of
	cleanup in the thread exit handler for the filesystem subsystem.

2012-07-31  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (Tcl_GetInterpPath):
	* unix/tclUnixPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
	* win/tclWinPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
	Purge use of Tcl_AppendElement, and corrected conversion of PIDs to
	integer objects.

2012-07-31  Jan Nijtmans  <[email protected]>

	* win/nmakehlp.c:  Add -Q option from sampleextension.
	* win/Makefile.in: [FRQ 3544967]: Missing objectfiles in static lib
	* win/makefile.vc: (Thanks to Jos Decoster).

2012-07-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:  No longer build tcltest.exe to run the tests,
	but use tclsh86.exe in combination with tcltest86.dll to do that.
	* tests/*.test:     load tcltest86.dll if necessary.

2012-07-28  Jan Nijtmans  <[email protected]>

	* tests/clock.test:    [Bug 3549770]: Multiple test failures running
	* tests/registry.test: tcltest outside build tree
	* tests/winDde.test:

2012-07-27  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c:   Support Unicode 6.2 (Add Turkish lira sign)
	* generic/regc_locale.c:

2012-07-25  Alexandre Ferrieux  <[email protected]>

	* win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows
	pipe driver to its fate when needed to honour TIP#398.

2012-07-23  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: [Bug 3545365]: Never try a bg-flush  on a dead
	channel, just like before 2011-08-17.

2012-07-19  Joe Mistachkin  <[email protected]>

	* generic/tclTest.c: Fix several more missing mutex-locks in
	TestasyncCmd.

2012-07-19  Alexandre Ferrieux  <[email protected]>

	* generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in
	TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart
	Cassoff for spotting it.

2012-07-17  Jan Nijtmans  <[email protected]>

	* win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails

2012-07-16  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (UpdateStringOfEndOffset): [Bug 3544658]: Stop
	1-byte overrun in memcpy, that object placement rules made harmless
	but which still caused compiler complaints.

2012-07-16  Jan Nijtmans  <[email protected]>

	* library/reg/pkgIndex.tcl:  Make registry 1.3 package dynamically
	loadable when ::tcl::pkgconfig is available.

2012-07-11  Jan Nijtmans  <[email protected]>

	* win/tclWinReg.c: [Bug 3362446]: registry keys command fails
	with 8.5/8.6. Follow Microsofts example better in order to prevent
	problems when using HKEY_PERFORMANCE_DATA.

2012-07-10  Jan Nijtmans  <[email protected]>

	* unix/tclUnixNotfy.c: [Bug 3541646]: Don't panic on triggerPipe
	overrun.

2012-07-10  Donal K. Fellows  <[email protected]>

	* win/tclWinSock.c (InitializeHostName): Corrected logic that
	extracted the name of the computer from the gethostname call so that
	it would use the name on success, not failure. Also ensured that the
	buffer size is exactly that recommended by Microsoft.

2012-07-08  Reinhard Max  <[email protected]>

	* library/http/http.tcl: [Bug 3531209]: Add fix and test for URLs that
	* tests/http.test: 	 contain literal IPv6 addresses.

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

	* unix/tclUnixPipe.c:	[Bug 1189293]: Make "<<" binary safe.
	* win/tclWinPipe.c:

2012-07-03  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString):
	* generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear):
	* generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make
	common cases of appending to Tcl_DStrings simpler to write. Prompted
	by looking at [FRQ 1357401] (these are an _internal_ implementation of
	that FRQ).

2012-06-29  Jan Nijtmans  <[email protected]>

	* library/msgcat/msgcat.tcl:   Add tn, ro_MO and ru_MO to msgcat.

2012-06-29  Harald Oehlmann <[email protected]>

	* library/msgcat/msgcat.tcl:	[Bug 3536888]: Locale guessing of
	* library/msgcat/pkgIndex.tcl:	msgcat fails on (some) Windows 7. Bump
	* unix/Makefile.in:		to 1.4.5
	* win/Makefile.in:

2012-06-29  Donal K. Fellows  <[email protected]>

	* doc/GetIndex.3: Reinforced the description of the requirement for
	the tables of names to index over to be static, following posting to
	tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
	this rule correctly. This does not represent a functionality change,

2012-06-26  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
	* unix/tclUnixSock.c:

2012-06-25  Don Porter  <[email protected]>

	* generic/tclFileSystem.h:	[Bug 3024359]: Make sure that the
	* generic/tclIOUtil.c:	per-thread cache of the list of file systems
	* generic/tclPathObj.c:	currently registered is only updated at times
	when no active loops are traversing it.  Also reduce the amount of
	epoch storing and checking to where it can make a difference.

2012-06-25  Donal K. Fellows  <[email protected]>

	* {win,unix}/configure{,.in}: [Bug 2812981]: Clean up bundled
	packages' build directory from within Tcl's ./configure, to avoid
	stale configuration.

2012-05-09  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c: [Bug 3522560]: Fixed the crash, enabled the
	test case. Modified [chan postevent] to properly inject the event(s)
	into the owner thread's event queue for execution in the correct
	context. Renamed the ForwardOpTo...Thread() function to match with our
	terminology.

	* tests/ioCmd.test: [Bug 3522560]: Added a test which crashes the core
	if it were not disabled as knownBug. For a reflected channel
	transfered to a different thread the [chan postevent] run in the
	handler thread tries to execute the owner threads's fileevent scripts
	by itself, wrongly reaching across thread boundaries.

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

2012-04-27  Donal K. Fellows  <[email protected]>

	* library/init.tcl (auto_execok): Allow shell builtins to be detected
	even if they are upper-cased.

2012-04-26  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c:    Get rid of _ANSI_ARGS_ and CONST
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclTest.c:
	* unix/tclUnixChan.c:

2012-04-25  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringToObj): Added internal function to make
	the fairly-common operation of converting a DString into an Obj a more
	efficient one; for long strings, it can just transfer the ownership of
	the buffer directly. Replaces this:

	* win/tclWinInit.c:     [Bug 3448512]: clock scan "1958-01-01" fails
	* win/tcl.m4:           only in debug compilation.
	* win/configure:
	* unix/tcl.m4:          Use NDEBUG consistantly meaning: no debugging.
	* unix/configure:
	* generic/tclBasic.c:
	* library/dde/pkgIndex.tcl:  Use [::tcl::pkgconfig get debug] instead
	* library/reg/pkgIndex.tcl:  of [info exists ::tcl_platform(debug)]

2012-04-10  Donal K. Fellows  <[email protected]>

	* generic/tcl.h (TCL_DEPRECATED_API): [Bug 2458976]: Added macro that
	can be used to mark parts of Tcl's API as deprecated. Currently only
	used for fields of Tcl_Interp, which TIPs 330 and 336 have deprecated
	with a migration strategy; we want to encourage people to move away

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

	* generic/tcl.h:      [Bug 3508771]: Wrong Tcl_StatBuf used on MinGW.
	* generic/tclFCmd.c:  [Bug 2015723]: Duplicate inodes from file stat
	* generic/tclCmdAH.c: on windows (but now for cygwin as well).
	* generic/tclOODefineCmds.c: minor gcc warning
	* win/tclWinPort.h:   Use lower numbers, preventing integer overflow.
	Remove the workaround for mingw-w64 [Bug 3407992]. It's long fixed.

2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#397.

	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: Make the
	target object name optional when copying classes. [RFE 3485060]: Add

	* generic/tclPlatDecls.h:    a dummy TclWinCPUID) for Cygwin, so win32
	* generic/tclStubInit.c:     extensions using those can be loaded in
	* unix/tclUnixCompat.c:      the cygwin version of tclsh.

2012-03-19  Venkat Iyer <[email protected]>

	* library/tzdata/America/Atikokan: Update to tzdata2012b.
	* library/tzdata/America/Blanc-Sablon:
	* library/tzdata/America/Dawson_Creek:
	* library/tzdata/America/Edmonton:
	* library/tzdata/America/Glace_Bay:
	* library/tzdata/America/Goose_Bay:
	* library/tzdata/America/Halifax:
	* library/tzdata/America/Havana:
	* library/tzdata/America/Moncton:
	* library/tzdata/America/Montreal:
	* library/tzdata/America/Nipigon:
	* library/tzdata/America/Rainy_River:
	* library/tzdata/America/Regina:
	* library/tzdata/America/Santiago:
	* library/tzdata/America/St_Johns:
	* library/tzdata/America/Swift_Current:
	* library/tzdata/America/Toronto:
	* library/tzdata/America/Vancouver:
	* library/tzdata/America/Winnipeg:
	* library/tzdata/Antarctica/Casey:
	* library/tzdata/Antarctica/Davis:
	* library/tzdata/Antarctica/Palmer:
	* library/tzdata/Asia/Yerevan:
	* library/tzdata/Atlantic/Stanley:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Fakaofo:
	* library/tzdata/America/Creston: (new)

2012-03-19  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (Tcl_OpenTcpServer): Use the values returned
	by getaddrinfo() for all three arguments to socket() instead of
	only using ai_family. Try to keep the most meaningful error while
	iterating over the result list, because using the last error can
	be misleading.

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

	* generic/tcl.h: [Bug 3288345]: Wrong Tcl_StatBuf used on Cygwin
	* unix/tclUnixFile.c:
	* unix/tclUnixPort.h:
	* win/cat.c:           Remove cygwin stuff no longer needed
	* win/tclWinFile.c:
	* win/tclWinPort.h:

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

	* win/tclWinFile.c: [Bug 3388350]: mingw64 compiler warnings

2012-03-11  Donal K. Fellows  <[email protected]>

	caller might still overwrite, but we should at least avoid
	known-useless work.)

2012-02-29  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c:	[Bug 3466099]: BOM in Unicode
	* generic/tclEncoding.c:
	* tests/source.test:

2012-02-23  Donal K. Fellows  <[email protected]>

	* tests/reg.test (14.21-23): Add tests relating to Bug 1115587. Actual
	bug is characterised by test marked with 'knownBug'.

2012-02-17  Jan Nijtmans  <[email protected]>

	fail if one timezone abbreviation was a proper tail of another, and
	zic used the same bytes of the file to represent both of them. Added a
	test case for the bug, using the same data that caused the observed
	failure "in the wild."

2011-12-30  Venkat Iyer <[email protected]>

	* library/tzdata/America/Bahia:		Update to Olson's tzdata2011n
	* library/tzdata/America/Havana:
	* library/tzdata/Europe/Kiev:
	* library/tzdata/Europe/Simferopol:
	* library/tzdata/Europe/Uzhgorod:
	* library/tzdata/Europe/Zaporozhye:
	* library/tzdata/Pacific/Fiji:

2011-12-23  Jan Nijtmans  <[email protected]>

	* generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] is wrong.
	* generic/tclUniData.c:
	* generic/regc_locale.c:
	* tests/utf.test:

2011-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclCompileObj): Simplify and de-indent the
	logic so that it is easier to comprehend.

2011-11-22  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3354324]: Windows: [file mtime] sets wrong
	* win/tclWinFile.c: time (VS2005+ only).
	* generic/tclTest.c:

2011-11-20  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove unnecessary [after] calls from the thread
	tests.  Make error message matching more robust for tests that may

	* library/clock.tcl (::tcl::clock::GetSystemTimeZone): Cache the time
	zone only if it was detected by one of the expensive methods.
	Otherwise after unsetting TCL_TZ or TZ the previous value will still
	be used.

2011-10-15  Venkat Iyer <[email protected]>

	* library/tzdata/America/Sitka: Update to Olson's tzdata2011l
	* library/tzdata/Pacific/Fiji:
	* library/tzdata/Asia/Hebron: (New)

2011-10-11  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c:    [Bug 2935503]: Incorrect mode field returned by
	[file stat] command.

2011-10-09  Donal K. Fellows  <[email protected]>

	* win/tclWinInt.h:   Remove tclWinProcs, as it is no longer
	* win/tclWin32Dll.c: being used.

2011-10-03  Venkat Iyer <[email protected]>

	* library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k
	* library/tzdata/Africa/Kampala:
	* library/tzdata/Africa/Nairobi:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Europe/Kiev:
	* library/tzdata/Europe/Minsk:
	* library/tzdata/Europe/Simferopol:
	* library/tzdata/Europe/Uzhgorod:
	* library/tzdata/Europe/Zaporozhye:
	* library/tzdata/Pacific/Apia:

2011-09-29  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More
	refactoring so that more of the utility code is decently out of the
	way. Adjusted the header-material generator so that version numbers
	are only included in locations where there is room.

	* tests/ioCmd.test:	by `make valgrind'.
	* unix/Makefile.in:

2011-09-16  Jan Nijtmans  <[email protected]>

	IMPLEMENTATION OF TIP #388

	* doc/Tcl.n:
	* doc/re_syntax.n:
	* generic/regc_lex.c:
	* generic/regcomp.c:
	* generic/regcustom.h:
	* generic/tcl.h:
	* generic/tclParse.c:
	* tests/reg.test:
	* tests/utf.test:

2011-09-16  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
	Corrected the handling of procedure error messages (found by TclOO).

2011-09-16  Jan Nijtmans  <[email protected]>

	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Honolulu:
	* library/tzdata/Africa/Juba: (new)

2011-09-06  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:   [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx())
	* generic/tclDecls.h:
	* generic/tclMain.c:

2011-09-02  Don Porter  <[email protected]>

	* tests/http.test:	Convert [testthread] use to Thread package use.
	Eliminates memory leak seen in `make valgrind`.

2011-09-01  Alexandre Ferrieux  <[email protected]>

2011-08-18  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: [Bug 3096275]: Sync fcopy buffers input.

2011-08-18  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c: [Bug 3393714]: Overflow in toupper delta
	* tools/uniParse.tcl:
	* tests/utf.test:

2011-08-17  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c:  [Bug 2946474]: Consistently resume backgrounded
	* tests/ioCmd.test: flushes+closes when exiting.

2011-08-17  Alexandre Ferrieux  <[email protected]>

	* generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value.

2011-08-15  Jan Nijtmans  <[email protected]>

	* generic/tclPosixStr.c:    [Bug 3388350]: mingw64 compiler warnings
	* win/tclWinPort.h:
	* win/configure.in:
	* win/configure:

2011-08-14  Jan Nijtmans  <[email protected]>

	* doc/FindExec.3: [Patch 3124554]: Move WishPanic from Tk to Tcl
	* doc/Panic.3     Added Documentation

2011-08-12  Don Porter  <[email protected]>

	* generic/tclCompCmds.c: [Bug 3386417]: Avoid a reference loop between
	* generic/tclInt.h:      the bytecode and its companion errostack
	* generic/tclResult.c:   when compiling a syntax error.

2011-08-09  Jan Nijtmans  <[email protected]>

	* win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings
	* win/tclWinDde.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:

2011-08-09  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h: Change the signature of TclParseHex(), such that
	* generic/tclParse.c: it can now parse up to 8 hex characters.

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

	* generic/tclUtil.c:	  rooting all growth routines by default on a
	common tunable parameter TCL_MIN_GROWTH.

2011-05-25  Don Porter  <[email protected]>

	* library/msgcat/msgcat.tcl:	Bump to msgcat 1.4.4.
	* library/msgcat/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:

2011-05-25  Donal K. Fellows  <[email protected]>

	* generic/tclOO.h (TCLOO_VERSION): Bump version.

	IMPLEMENTATION OF TIP#381.

2011-03-22  Miguel Sofer  <[email protected]>

	* generic/tclThreadAlloc.c: Simpler initialization of Cache under
	HAVE_FAST_TSD, from mig-alloc-reform.

2011-03-21  Jan Nijtmans  <[email protected]>

	* unix/tclLoadDl.c:    [Bug 3216070]: Loading extension libraries
	* unix/tclLoadDyld.c:  from embedded Tcl applications.
	***POTENTIAL INCOMPATIBILITY***
	For extensions which rely on symbols from other extensions being
	present in the global symbol table. For an example and some discussion
	of workarounds, see http://stackoverflow.com/q/8330614/301832

2011-03-21  Miguel Sofer  <[email protected]>

2011-01-25  Jan Nijtmans  <[email protected]>

	* generic/tclPreserve.c:  Don't miss 64-bit address bits in panic
				  message.
	* win/tclWinChan.c:       Fix various gcc-4.5.2 64-bit warning
	* win/tclWinConsole.c:    messages, e.g. by using full 64-bits for
	* win/tclWinDde.c:	  socket fd's
	* win/tclWinPipe.c:
	* win/tclWinReg.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinThrd.c:

2011-01-19  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with
	* generic/tcl.decls   bad format specifier.
	* generic/tcl.h:
	* generic/tclDecls.h:

2011-01-18  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make
	sure that the cmdPtr field of the procPtr is correct and relevant at
	all times so that [info frame] can report sensible information about a
	frame after a return to it from a recursive call, instead of probably
	crashing (depending on what else has overwritten the Tcl stack!)

2011-01-18  Jan Nijtmans  <[email protected]>

	* generic/tclBasic.c:      Various mismatches between Tcl_Panic
	* generic/tclCompCmds.c:   format string and its arguments,
	* generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920]
	* generic/tclCompExpr.c:
	* generic/tclEnsemble.c:
	* generic/tclPreserve.c:
	* generic/tclTest.c:

2011-01-17  Jan Nijtmans  <[email protected]>

	* generic/tclIOCmd.c: [Bug 3148192]: Commands "read/puts" incorrectly
	* tests/chanio.test:  interpret parameters. Improved error-message
	* tests/io.test       regarding legacy form.
	* tests/ioCmd.test

	quarantined at the front of the file and function headers follow the
	modern Tcl style.

2010-12-06  Jan Nijtmans  <[email protected]>

	* generic/tclBinary.c:  [Bug 3129448]: Possible over-allocation on
	* generic/tclCkalloc.c: 64-bit platforms.
	* generic/tclTrace.c:

2010-12-05  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: [Patch 3116490]: Cross-compile support for unix
	* unix/configure: (autoconf-2.59)

2010-12-03  Jeff Hobbs  <[email protected]>

2010-11-16  Jan Nijtmans  <[email protected]>

	* win/tclAppInit.c:Bring compilation under mingw-w64 a bit closer
	* win/cat.c:       to reality. See for what's missing:
	* win/tcl.m4:      <https://sourceforge.net/apps/trac/mingw-w64/wiki/Unicode%20apps>
	* win/configure:   (re-generated)
	* win/tclWinPort.h: [Bug 3110161]: Extensions using TCHAR don't
	compile on VS2005 SP1

2010-11-15  Andreas Kupries  <[email protected]>

	* doc/interp.n: [Bug 3081184]: TIP #378.
	* doc/tclvars.n: Performance fix for TIP #280.
	* generic/tclBasic.c:

	* tests/httpd11.test:        modes (normal, -channel and -handler)
	* makefiles:                 package version set to 2.8.0

2009-04-10  Daniel Steffen  <[email protected]>

	* unix/tclUnixChan.c:		TclUnixWaitForFile(): use FD_* macros
	* macosx/tclMacOSXNotify.c:	to manipulate select masks (Cassoff).
					[FRQ 1960647] [Bug 3486554]

	* unix/tclLoadDyld.c:		Use RTLD_GLOBAL instead of RTLD_LOCAL.
					[Bug 1961211]

	* macosx/tclMacOSXNotify.c:	revise CoreFoundation notifier to allow
					embedding into applications that
					already have a CFRunLoop running and
					want to run the tcl event loop via
					Tcl_ServiceModeHook(TCL_SERVICE_ALL).

2009-03-16  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (TryPostBody): [Bug 2688063]: Extract information
	from list before getting rid of last reference to it.

2009-03-15  Joe Mistachkin  <[email protected]>

	* generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match
	* generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics


2009-03-15  Donal K. Fellows  <[email protected]>

	* generic/tclThreadStorage.c (TSDTableDelete):	[Bug 2687952]: Ensure
	* generic/tclThread.c (Tcl_GetThreadData):	that structures in
	Tcl's TSD system are all freed. Use the correct matching allocator.

	is significantly improved by this change (according to the MAP
	collection of benchmarks in tclbench).  Just in case there was some
	wisdom in the old ways that I missed, I left in the ability to restore
	the old patterns with a #define COMPAT 1 at the top of the file.

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

	* generic/tclPathObj.c:	[Bug 2571597]: Fixed mistaken logic in
	* tests/fileName.test:	TclFSGetPathType() that assumed (not
	"absolute") => "relative". This is a false assumption on Windows,
	where "volumerelative" is another possibility.

2009-02-18  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Simplify the logic of the
	Tcl_*SetObjLength() routines.

	* generic/tclStringObj.c:	Rewrite GrowStringBuffer() so that it

	in ExtendStringRepWithUnicode.  Use cheap checks to determine that
	no reallocation is necessary without cost of computing the precise
	number of bytes needed.  Also make use of the string growth algortihm
	in the case of repeated appends.

2009-02-16  Jan Nijtmans  <[email protected]>

	* generic/tclZlib.c:	Hack needed for official zlib1.dll build.
	* win/configure.in:	fix [Feature Request 2605263] use official
	* win/Makefile.in:	zlib build.
	* win/configure:	(regenerated)
	* compat/zlib/zdll.lib:	new files
	* compat/zlib/zlib1.dll:

	* win/Makefile.in:  [Bug 2605232]: tdbc doesn't build when Tcl is
	compiled with --disable-shared.

2009-02-15  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	[Bug 2603158]: Added protections from
	* generic/tclTestObj.c:		invalid memory accesses when we append
	* tests/stringObj.test:		(some part of) a Tcl_Obj to itself.
	Added the appendself and appendself2 subcommands to the
	[teststringobj] testing command and added tests to the test suite.

	* generic/tclStringObj.c:	Factor out duplicate code from
	Tcl_AppendObjToObj.

	* generic/tclStringObj.c:	Replace the 'size_t uallocated' field
	of the String struct, storing the number of bytes allocated to store
	the Tcl_UniChar array, with an 'int maxChars' field, storing the

	Simplify SetStringFromAny() by removing unreachable and duplicate code.
	Simplify Tcl_SetObjLength by removing unreachable code.
	Removed handling of (objPtr->bytes != NULL) from UpdateStringOfString,
	which is only called when objPtr->bytes is NULL.

2009-02-09  Jan Nijtmans  <[email protected]>

	* generic/tclCompile.c: [Bug 2555129]: const compiler warning (as
	error) in tclCompile.c

2009-02-07  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (TclZlibCmd): [Bug 2573172]: Ensure that when
	invalid subcommand name is given, the list of valid subcommands is
	produced. This gives a better experience when using the command
	interactively.

2009-02-05  Joe Mistachkin  <[email protected]>

	* generic/tclInterp.c: [Bug 2544618]: Fix argument checking for
	[interp cancel].
	* unix/Makefile.in: Fix build issue with zlib on FreeBSD (and possibly
	other platforms).

2009-02-05  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringIndexCmd, StringRangeCmd, StringLenCmd):
	Simplify the implementation of some commands now that the underlying

	Part of scheme to address [Bug 1665628] by making the basic string
	operations more efficient on byte arrays.
	(Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetRange): More special casing
	work for bytearrays.

2009-02-04  Don Porter  <[email protected]>

	* generic/tclStringObj.c: [Bug 2561794]: Added overflow protections to
	the AppendUtfToUtfRep routine to either avoid invalid arguments and
	crashes, or to replace them with controlled panics.

	* generic/tclCmdMZ.c:	[Bug 2561746]: Prevent crashes due to int
	overflow of the length of the result of [string repeat].

2009-02-03  Jan Nijtmans  <[email protected]>

	* macosx/tclMacOSXFCmd.c: Eliminate some unnessary type casts
	* unix/tclLoadDyld.c:	  some internal const decorations
	* unix/tclUnixCompat.c:	  spacing
	* unix/tclUnixFCmd.c

	* generic/tclObj.c (tclCmdNameType): [Bug 2558422]: Corrected the type
	of this structure so that extensions that write it (yuk!) will still
	be able to function correctly.

2009-02-03  Don Porter  <[email protected]>

	* generic/tclStringObj.c (SetUnicodeObj):	[Bug 2561488]:
	Corrected failure of Tcl_SetUnicodeObj() to panic on a shared object.
	Also factored out common code to reduce duplication.

	* generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication.

2009-02-02  Don Porter  <[email protected]>

	* generic/tclInterp.c:	Reverted the conversion of [interp] into an
	* tests/interp.test:	ensemble.  Such conversion is not necessary

	* generic/tclOODefineCmds.c (Tcl_ClassSetConstructor):
	[Bug 2531577]: Ensure that caches of constructor chains are cleared
	when the constructor is changed.

2009-01-26  Alexandre Ferrieux  <[email protected]>

	* generic/tclInt.h:   [Bug 1028264]: WSACleanup() too early.
	* generic/tclEvent.c: The fix introduces "late exit handlers" for
	* win/tclWinSock.c:   similar late process-wide cleanups.

2009-01-26  Alexandre Ferrieux  <[email protected]>

	* win/tclWinSock.c: [Bug 2446662]: Resync Win behavior on RST with
	that of unix (EOF).

2009-01-26  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ChanClose): [Bug 2536400]: Only generate error
	messages in the interpreter when the thread is not being closed down.

2009-01-23  Donal K. Fellows  <[email protected]>

	* doc/zlib.n: Added a note that 'zlib push' is reversed by 'chan pop'.

2009-01-22  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be
	${SHLIB_VERSION}).
	* unix/configure: Autoconf 2.59

2009-01-21  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (ReflectClose): [Bug 2458202]:
	* generic/tclIORTrans.c (ReflectClose): Closing a channel may supply
	NULL for the 'interp'. Test for finalization needs to be different,
	and one place has to pull the interp out of the channel instead.

2009-01-21  Don Porter  <[email protected]>

	* generic/tclStringObj.c: New fix for [Bug 2494093] replaces the
	flawed attempt committed 2009-01-09.

2009-01-19  Kevin B. Kenny  <[email protected]>

	* unix/Makefile.in: [Patch 907924]:Added a CONFIG_INSTALL_DIR
	* unix/tcl.m4:      parameter so that distributors can control where
	tclConfig.sh goes. Made the installation of 'ldAix' conditional upon
	actually being on an AIX system. Allowed for downstream packagers to
	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

	a Command when deleting it is important so that tests for certain
	classes of commands don't return false positives when applied to
	deleted command tokens. Overall change is now just replacement of a
	false comment with a true one.

2009-01-13  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
	using the native CC.
	* unix/configure (autoconf-2.59)

2009-01-13  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_ThrowObjCmd):	Move implementation of [throw]
	* library/init.tcl (throw):		to C from Tcl.

	setting to NULL, since any extension following the advice of the old
	comment is going to be broken by NRE anyway, and needs to shift to
	flag-based testing (or stop intruding into such internal matters).
	Part of [Bug 2486550].

2009-01-09  Don Porter  <[email protected]>

	* generic/tclStringObj.c (STRING_SIZE): [Bug 2494093]: Corrected
	failure to limit memory allocation requests to the sizes that can be
	supported by Tcl's memory allocation routines.

2009-01-09  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NamespaceEnsembleCmd): [Bug 1558654]: Error out
	when someone gives wrong # of args to [namespace ensemble create].

2009-01-08  Don Porter  <[email protected]>

	* generic/tclStringObj.c (STRING_UALLOC): [Bug 2494093]: Added missing
	parens required to get correct results out of things like
	STRING_UALLOC(num + append).

2009-01-08  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c, generic/tclIndexObj.c, generic/tclListObj.c,
	* generic/tclObj.c, generic/tclStrToD.c, generic/tclUtil.c,
	* generic/tclVar.c: Generate errorcodes for the error cases which
	approximate to "I can't interpret that string as one of those" and
	"You gave me the wrong number of arguments".

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

	* doc/dict.n: [Tk Bug 2491235]: Added more examples.

	* tests/oo.test (oo-22.1): Adjusted test to be less dependent on the
	specifics of how [info frame] reports general frame information, and
	instead to focus on what methods add to it; that's really what the
	test is about anyway.

2009-01-06  Don Porter  <[email protected]>

	* tests/stringObj.test:	Revise tests that demand a NULL Tcl_ObjType
	in certain values to construct those values with [testdstring] so
	there's no lack of robustness depending on the shimmer history of
	shared literals.

2009-01-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals
	of dictionaries so that literals can't get destroyed.

	* tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char.

	* generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd):
	[Bug 2489836]: Only delete pointers that were actually allocated!

	* generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance):
	[Bug 2481109]: Perform search for existing commands in right context.

2009-01-05  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (TclNRSourceObjCmd): [Bug 2412068]: Make
	* generic/tclIOUtil.c (TclNREvalFile):    implementation of the
	[source] command be NRE enabled so that [yield] inside a script
	sourced in a coroutine can work.

2009-01-04  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c: Tidy up spacing and code style.

2009-01-03  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (tcl::clock::add): Fixed error message formatting
	in the case where [clock add] is presented with a bad switch.
	* tests/clock.test (clock-65.1) Added a test case for the above
	problem [Bug 2481670].

2009-01-02  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the
	compatibility version of mkstemp() on IRIX.
	* unix/configure.in, unix/Makefile.in (mkstemp.o):
	* compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility
	implementation of the mkstemp() function, which is apparently needed
	on some platforms.

        ******************************************************************
        *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008"             ***
        *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007"        ***
        *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"             ***
        *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"             ***
        *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"             ***
        *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"             ***
        *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
        *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
        *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
        ******************************************************************

2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans)

2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows)

2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter)

2011-11-22 (bug fix)[3354324] Win: [file mtime] sets wrong time (nijtmans)

2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans)
=> tcltest 2.3.4

2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans)

2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans)

2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans)

2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter)

2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux)

2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)


2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows)

2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows)

2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann)
=> dde 1.4.0

2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event]
(fellows,ferrieux,kupries)

2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows)

2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans)
=> registry 1.3.0

2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows)

2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system]
and Tcl_FSMountsChanged(). (porter)

2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans)
=> msgcat 1.4.5

2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter)

2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max)
=> http 2.8.4

2012-07-24 (bug fix) stop mem corruption in stacked channel events (max,porter)

2012-07-25 (bug fix)[3546275] [auto_execok] search match [exec] (danckaert)

Many revisions to better support a Cygwin environment (nijtmans)

--- Released 8.6b3, July 30, 2012 --- See ChangeLog for details ---

    {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
    {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
    {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6},
    {0x1d00, 0x1de6}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
    {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
    {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
    {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
    {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20ba}, {0x20d0, 0x20f0},
    {0x2100, 0x2189}, {0x2190, 0x23f3}, {0x2400, 0x2426}, {0x2440, 0x244a},
    {0x2460, 0x26ff}, {0x2701, 0x2b4c}, {0x2b50, 0x2b59}, {0x2c00, 0x2c2e},
    {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67},
    {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
    {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
    {0x2dd8, 0x2dde}, {0x2de0, 0x2e3b}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3},
    {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096},

     *
     * But as we currently limit ourselves to the global namespace only for
     * the source, in order to avoid potential confusion, lets prevent "::" in
     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot use namespace qualifiers in hidden command"
		" token (rename)", -1));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
	return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't be
     * found. Look up the command only from the global namespace. Full path of

    cmdPtr = (Command *) cmd;

    /*
     * Check that the command is really in global namespace
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only hide global namespace commands (use rename then hide)",
                -1));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Initialize the hidden command table if necessary.
     */

     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */

    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "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

    /*
     * Check that we have a regular name for the command (that the user is not
     * trying to do an expose and a rename (to another namespace) at the same
     * time).
     */

    if (strstr(cmdName, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "cannot expose to a namespace (use expose to toplevel, then rename)",
                -1));
        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Get the command from the hidden command table:
     */

    hPtr = NULL;
    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr != NULL) {
	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown hidden command \"%s\"", hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
                hiddenCmdToken, NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	/*
	 * This case is theoritically impossible, we might rather Tcl_Panic
	 * than 'nicely' erroring out ?
	 */

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

    /*
     * This is the global table.
     */

    nsPtr = cmdPtr->nsPtr;

    /*
     * It is an error to overwrite an existing exposed command as a result of
     * exposing a previously hidden command.
     */

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "exposed command \"%s\" already exists", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL);
	return TCL_ERROR;
    }

    /*
     * Command resolvers (per-interp, per-namespace) might have resolved to a
     * command for the given namespace scope with this command not being

     * Find the existing command. An error is returned if cmdName can't be
     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't %s \"%s\": command doesn't exist",
		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
		oldName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
	return TCL_ERROR;
    }
    cmdNsPtr = cmdPtr->nsPtr;
    oldFullName = Tcl_NewObj();
    Tcl_IncrRefCount(oldFullName);
    Tcl_GetCommandFullName(interp, cmd, oldFullName);

     * create the containing namespaces just like Tcl_CreateCommand would.
     */

    TclGetNamespaceForQualName(interp, newName, NULL,
	    TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);

    if ((newNsPtr == NULL) || (newTail == NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't rename to \"%s\": bad command name", newName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	result = TCL_ERROR;
	goto done;
    }
    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't rename to \"%s\": command already exists", newName));
        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
                "TARGET_EXISTS", NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*

	}
#endif
	if (result != TCL_OK) {
	    /*
	     * We have a non-numeric argument.
	     */

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument to math function didn't have numeric value",
		    -1));
	    TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
	    ckfree(args);
	    return TCL_ERROR;
	}

	/*
	 * Copy the object's numeric value to the argument record, converting

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */

    if (iPtr->flags & DELETED) {

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to call eval in deleted interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "IDELETE",
		"attempt to call eval in deleted interpreter", NULL);
	return TCL_ERROR;
    }

    if (iPtr->execEnvPtr->rewind) {
	return TCL_ERROR;

     * probably because of an infinite loop somewhere.
     */

    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "too many nested evaluations (infinite loop?)", -1));
    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

        } else {
            id = "ICANCEL";
            if (length == 0) {
                message = "eval canceled";
            }
        }

        Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));

        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
    }

    /*
     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
     * itself) that indicates further processing of the script or command in
     * progress should halt gracefully and as soon as possible.

     *
     * In this case we worry a bit less about recursion for now, and call the
     * "blocking" interface.
     */

    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid command name \"%s\"", TclGetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
                TclGetString(objv[0]), NULL);

	/*
	 * Release any resources we locked and allocated during the handler
	 * call.
	 */

				 * result code was returned. */
    int returnCode)		/* The unexpected result code. */
{
    char buf[TCL_INTEGER_SPACE];

    Tcl_ResetResult(interp);
    if (returnCode == TCL_BREAK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"break\" outside of a loop", -1));
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", -1));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"command returned bad code: %d", returnCode));
    }
    sprintf(buf, "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
}

    int result;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    if ((objc < 1) || (objv == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "illegal argument vector", -1));
	return TCL_ERROR;
    }

    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }

    if (TclInterpReady(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid hidden command name \"%s\"", cmdName));

        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*

	mp_sqrt(&big, &root);
	mp_clear(&big);
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
    }
    return TCL_OK;

  negarg:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "square root of negative argument", -1));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
	    "domain error: argument not in valid range", NULL);
    return TCL_ERROR;
}

static int
ExprSqrtFunc(

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
	return TCL_ERROR;
    }

    if (!iPtr->varFramePtr->isProcCallFrame) {	/* or is upleveled */
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "tailcall can only be called from a proc or lambda", -1));

        Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Invocation without args just clears a scheduled tailcall; invocation
     * with an argument replaces any previously scheduled tailcall.

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yield can only be called in a coroutine", -1));

	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    if (objc == 2) {
	Tcl_SetObjResult(interp, objv[1]);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yieldto can only be called in a coroutine", -1));

	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    /*
     * Add the tailcall in the caller env, then just yield.
     *

        iPtr->numLevels += numLevels;
    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != stackLevel) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "cannot yield: C stack busy", -1));

            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
                    NULL);
            return TCL_ERROR;
        }

        if (type == CORO_ACTIVATE_YIELD) {
            corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a coroutine", -1));

        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }

    corPtr = cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(

                "coroutine \"%s\" is already running",
                Tcl_GetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine

     */

    fullName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": unknown namespace",
                fullName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
	return TCL_ERROR;
    }
    if (procName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": bad procedure name",
                fullName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
	return TCL_ERROR;
    }
    if ((nsPtr != iPtr->globalNsPtr)
	    && (procName != NULL) && (procName[0] == ':')) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\" in non-global namespace with"
                " name starting with \":\"", procName));

        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
	return TCL_ERROR;
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.

		    return TCL_ERROR;
		}
		arg++;

		if (count == BINARY_ALL) {
		    count = listc;
		} else if (count > listc) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "number of elements in list does not match count",
			    -1));
		    return TCL_ERROR;
		}
	    }
	    offset += count*size;
	    break;

	case 'x':
	    if (count == BINARY_ALL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot use \"*\" in format string with \"x\"", -1));

		return TCL_ERROR;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    offset += count;
	    break;
	case 'X':

	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;

 badValue:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue));
    return TCL_ERROR;

 badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;

 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch;
	char buf[TCL_UTF_MAX + 1];

	Tcl_UtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryScanCmd --

 badField:
    {
	Tcl_UniChar ch;
	char buf[TCL_UTF_MAX + 1];

	Tcl_UtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * GetFormatSpec --

 *
 *	Display the global memory management statistics.
 *
 *----------------------------------------------------------------------
 */

int
TclDumpMemoryInfo(
    ClientData clientData,
    int flags)
{
    char buf[1024];

    if (clientData == NULL) {
        return 0;
    }
    sprintf(buf,
	    "total mallocs             %10d\n"
	    "total frees               %10d\n"
	    "current packets allocated %10d\n"
	    "current bytes allocated   %10lu\n"
	    "maximum packets allocated %10d\n"
	    "maximum bytes allocated   %10lu\n",

    const char *fileName;
    FILE *fileP;
    Tcl_DString buffer;
    int result;
    size_t len;

    if (argc < 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "wrong # args: should be \"%s option [args..]\"", argv[0]));
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) {
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "wrong # args: should be \"%s %s file\"",
                    argv[0], argv[1]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
                    argv[2], Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"break_on_malloc") == 0) {
	if (argc != 3) {
	    goto argError;

		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", (unsigned long)current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(argv[1], "init") == 0) {
	if (argc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }
    if (strcmp(argv[1], "objs") == 0) {
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "wrong # args: should be \"%s objs file\"", argv[0]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "cannot open output file: %s",
                    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(argv[1],"onexit") == 0) {
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "wrong # args: should be \"%s onexit file\"", argv[0]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	onExitMemDumpFileName = dumpFile;
	strcpy(onExitMemDumpFileName,fileName);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(argv[1],"tag") == 0) {
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "wrong # args: should be \"%s tag string\"", argv[0]));
	    return TCL_ERROR;
	}
	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
	    TclpFree((char *) curTagPtr);
	}
	len = strlen(argv[2]);
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));

	if (argc != 3) {
	    goto bad_suboption;
	}
	validate_memory = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "bad option \"%s\": should be active, break_on_malloc, info, "
            "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
            argv[1]));
    return TCL_ERROR;

  argError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
    return TCL_ERROR;

  bad_suboption:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * CheckmemCmd --

CheckmemCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter for evaluation. */
    int argc,			/* Number of arguments. */
    const char *argv[])		/* String values of arguments. */
{
    if (argc != 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "wrong # args: should be \"%s fileName\"", argv[0]));
	return TCL_ERROR;
    }
    tclMemDumpFileName = dumpFile;
    strcpy(tclMemDumpFileName, argv[1]);
    return TCL_OK;
}


Tcl_ValidateAllMemory(
    const char *file,
    int line)
{
}

int
TclDumpMemoryInfo(
    ClientData clientData,
    int flags)
{
    return 1;
}

#endif	/* TCL_MEM_DEBUG */

/*

    /*
     * If conversion fails, report an error.
     */

    if (localErrno != 0
	    || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"time value too large/small to represent", -1));

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

    /*
     * Use 'localtime' to determine local year, month, day, time of day.
     */

    tock = (time_t) fields->seconds;
    if ((Tcl_WideInt) tock != fields->seconds) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"number too large to represent as a Posix time", -1));
	Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
	return TCL_ERROR;
    }
    TzsetIfNecessary();
    timeVal = ThreadSafeLocalTime(&tock);
    if (timeVal == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"localtime failed (clock value may be too "
		"large/small to represent)", -1));
	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.
     */

	int patObjc, j;
	const char **patObjv;
	const char *pat;
	unsigned char *p;

	if (i == caseObjc-1) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "extra case pattern with no body", -1));
	    return TCL_ERROR;
	}

	/*
	 * Check for special case of single pattern (no list) with no
	 * backslash sequences.
	 */

	Tcl_IncrRefCount(dir);
    }
    if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
	result = TCL_ERROR;
    } else {
	result = Tcl_FSChdir(dir);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't change working directory to \"%s\": %s",
		    TclGetString(dir), Tcl_PosixError(interp)));
	    result = TCL_ERROR;
	}
    }
    if (objc != 2) {
	Tcl_DecrRefCount(dir);
    }
    return result;

    if (objc == 2) {
	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
	return TCL_OK;
    }

    dirListObj = objv[2];
    if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"expected directory list but got \"%s\"",
		TclGetString(dirListObj)));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
		NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirListObj);
    return TCL_OK;
}

	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = buf.st_mtime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));

	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * atime - hopefully the same as the one we sent in. However, fs's
	 * like FAT don't even know what atime is.

	    return TCL_ERROR;
	}

	tval.actime = buf.st_atime;
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set modification time for file \"%s\": %s",

		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * mtime - hopefully the same as the one we sent in.
	 */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fsInfo = Tcl_FSFileSystemInfo(objv[1]);
    if (fsInfo == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		Tcl_GetString(objv[1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, fsInfo);
    return TCL_OK;
}

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], NULL);
    if (res == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

	    break;
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
    } else {
	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);

	if (separatorObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unrecognised path", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		    Tcl_GetString(objv[1]), NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, separatorObj);
    }
    return TCL_OK;

	return TCL_ERROR;
    }

    status = statProc(pathPtr, statPtr);

    if (status < 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));

	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

	if (statePtr->vCopyList[i] == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
		&statePtr->varcList[i], &statePtr->varvList[i]);
	if (statePtr->varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "foreach varlist is empty", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH",
		    "NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}

	statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);

/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked
 * lists.
 */

typedef struct SortElement {
    union {			/* The value that we sorting by. */
	const char *strValuePtr;
	long intValue;
	double doubleValue;
	Tcl_Obj *objValuePtr;
    } collationKey;
    union {			/* Object being sorted, or its index. */
	Tcl_Obj *objPtr;
	int index;
    } payload;
    struct SortElement *nextPtr;/* Next element in the list, or NULL for end
				 * of list. */
} SortElement;

/*
 * These function pointer types are used with the "lsearch" and "lsort"

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *boolObj;

    if (objc <= 1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"wrong # args: no expression after \"%s\" argument",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	return TCL_ERROR;
    }

    /*
     * At this point, objv[1] refers to the main expression to test. The
     * arguments after the expression must be "then" (optional) and a script

	 * At this point in the loop, objv and objc refer to an expression to
	 * test, either for the main expression or an expression following an
	 * "elseif". The arguments after the expression must be "then"
	 * (optional) and a script to execute if the expression is true.
	 */

	if (i >= objc) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "wrong # args: no expression after \"%s\" argument",
		    clause));
	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	    return TCL_ERROR;
	}
	if (!thenScriptIndex) {
	    TclNewObj(boolObj);
	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
		    INT2PTR(i), boolObj);

    if (strcmp(clause, "else") == 0) {
	i++;
	if (i >= objc) {
	    goto missingScript;
	}
    }
    if (i < objc - 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"wrong # args: extra words after \"else\" clause in \"if\" command",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	return TCL_ERROR;
    }
    if (thenScriptIndex) {
	/*
	 * TIP #280. Make invoking context available to branch/else.
	 */

	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
		iPtr->cmdFramePtr, thenScriptIndex);
    }
    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);

  missingScript:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "wrong # args: no script following \"%s\" argument",
	    TclGetString(objv[i-1])));


    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
	return TCL_ERROR;
    }

    /*
     * Build a return list containing the arguments.
     */

	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
	return TCL_ERROR;
    }

    /*
     * Here we used to return procPtr->bodyPtr, except when the body was
     * bytecompiled - in that case, the return was a copy of the body's string

    }

    procName = TclGetString(objv[1]);
    argName = TclGetString(objv[2]);

    procPtr = TclFindProc(iPtr, procName);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", procName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
		NULL);
	return TCL_ERROR;
    }

    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {

		}
		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	    }
	    return TCL_OK;
	}
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "procedure \"%s\" doesn't have an argument \"%s\"",
	    procName, argName));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

    target = interp;
    if (objc == 2) {
	target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }

    iPtr = (Interp *) target;
    Tcl_SetObjResult(interp, iPtr->errorStack);

    return TCL_OK;
}

	    : iPtr->cmdFramePtr->level);

    if (corPtr) {
	/*
	 * A coroutine: must fix the level computations AND the cmdFrame chain,
	 * which is interrupted at the base.
	 */

	CmdFrame *lastPtr = NULL;

	runPtr = iPtr->cmdFramePtr;

	/* TODO - deal with overflow */
	topLevel += corPtr->caller.cmdFramePtr->level;
	while (runPtr) {
	    runPtr->level += corPtr->caller.cmdFramePtr->level;
	    lastPtr = runPtr;
	    runPtr = runPtr->nextPtr;
	}
	if (lastPtr) {
	    lastPtr->nextPtr = corPtr->caller.cmdFramePtr;

    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    if ((level > topLevel) || (level <= - topLevel)) {
    levelError:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad level \"%s\"", TclGetString(objv[1])));

	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
		TclGetString(objv[1]), NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*

     * Procedure CallFrame.
     */

    if (procPtr != NULL) {
	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;

	if (namePtr) {
	    Tcl_Obj *procNameObj;

	    /*
	     * This is a regular command.
	     */

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to

    }

    name = Tcl_GetHostName();
    if (name) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "unable to determine name of host", -1));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

	return TCL_OK;
    }

    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
    return TCL_ERROR;

  levelError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad level \"%s\"", TclGetString(objv[1])));

    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
	    TclGetString(objv[1]), NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

    }

    libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
    if (libDirName != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "no library has been specified for Tcl", -1));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
	return TCL_ERROR;
    }
    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad count \"%d\": must be integer >= 0", elementCount));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
     */

    objc -= 2;
    objv += 2;

    /* Final sanity check. Do not exceed limits on max list length. */

    if (elementCount && objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;

    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.

     * Complain if the user asked for a start element that is greater than the
     * list length. This won't ever trigger for the "end-*" case as that will
     * be properly constrained by TclGetIntForIndex because we use listLen-1
     * (to allow for replacing the last elem).
     */

    if ((first >= listLen) && (listLen > 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"list doesn't contain element %s", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
		NULL);
	return TCL_ERROR;
    }
    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;

	     * because it will either be replaced or there will be an error.
	     */

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
	    }
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing starting index", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;
	    if (objv[i] == objv[objc - 2]) {
		/*
		 * Take copy to prevent shimmering problems. Note that it does

	    if (sortInfo.indexc > 1) {
		TclStackFree(interp, sortInfo.indexv);
	    }
	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Store the extracted indices for processing by sublist
	     * extraction. Note that we don't do this using objects because
	     * that has shimmering problems.

     * Subindices only make sense if asked for with -index option set.
     */

    if (returnSubindices && sortInfo.indexc==0) {
	if (startPtr != NULL) {
	    Tcl_DecrRefCount(startPtr);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-subindices cannot be used without -index option", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	return TCL_ERROR;
    }

    if (bisect && (allMatches || negatedMatch)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-bisect is not compatible with -all or -not", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	return TCL_ERROR;
    }

    if (mode == REGEXP) {
	/*
	 * We can shimmer regexp/list if listv[i] == pattern, so get the
	 * regexp rep before the list rep. First time round, omit the interp

    /*
     * Check parameter count.
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"listVar ?index? ?index ...? value");
	return TCL_ERROR;
    }

    /*
     * Look up the list variable's value.
     */

	}
	switch ((enum Lsort_Switches) index) {
	case LSORT_ASCII:
	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-command\" option must be followed "
			"by comparison command", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    sortInfo.sortMode = SORTMODE_COMMAND;
	    cmdPtr = objv[i+1];
	    i++;
	    break;
	case LSORT_DECREASING:
	    sortInfo.isIncreasing = 0;
	    break;
	case LSORT_DICTIONARY:
	    sortInfo.sortMode = SORTMODE_DICTIONARY;
	    break;
	case LSORT_INCREASING:
	    sortInfo.isIncreasing = 1;
	    break;
	case LSORT_INDEX: {
	    int indexc, dummy;
	    Tcl_Obj **indexv;

	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
		    &indexv) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }

	    /*
	     * Check each of the indices for syntactic correctness. Note that
	     * we do not store the converted values here because we do not
	     * know if this is the only -index option yet and so we can't
	     * allocate any space; that happens after the scan through all the
	     * options is done.
	     */

	    for (j=0 ; j<indexc ; j++) {
		if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
			&dummy) != TCL_OK) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
		    sortInfo.resultCode = TCL_ERROR;
		    goto done2;
		}
	    }
	    indexPtr = objv[i+1];
	    i++;
	    break;
	}
	case LSORT_INTEGER:
	    sortInfo.sortMode = SORTMODE_INTEGER;
	    break;
	case LSORT_NOCASE:
	    nocase = 1;
	    break;
	case LSORT_REAL:
	    sortInfo.sortMode = SORTMODE_REAL;
	    break;
	case LSORT_UNIQUE:
	    sortInfo.unique = 1;
	    break;
	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (groupSize < 2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length must be at least 2", -1));

		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADSTRIDE", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    group = 1;
	    i++;
	    break;
	}
    }
    if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
	sortInfo.sortMode = SORTMODE_ASCII_NC;
    }

    /*
     * Now extract the -index list for real, if present. No failures are
     * expected here; the values are all of the right type or convertible to
     * it.
     */

    if (indexPtr) {
	Tcl_Obj **indexv;

	TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
	switch (sortInfo.indexc) {
	case 0:
	    sortInfo.indexv = NULL;
	    break;
	case 1:
	    sortInfo.indexv = &sortInfo.singleIndex;
	    break;
	default:
	    sortInfo.indexv =
		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
	    allocatedIndexVector = 1;	/* Cannot use indexc field, as it
					 * might be decreased by 1 later. */
	}
	for (j=0 ; j<sortInfo.indexc ; j++) {
	    TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
		    &sortInfo.indexv[j]);
	}
    }

    listObj = objv[objc-1];

    if (sortInfo.sortMode == SORTMODE_COMMAND) {
	Tcl_Obj *newCommandPtr, *newObjPtr;

    /*
     * Check for sanity when grouping elements of the overall list together
     * because of the -stride option. [TIP #326]
     */

    if (group) {
	if (length % groupSize) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list size must be a multiple of the stride length",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
		    NULL);
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	length = length / groupSize;
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = sortInfo.indexv[0];
	    if (groupOffset <= SORTIDX_END) {
		groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
	    }
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));

		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;
		sortInfo.indexv = NULL;
	    } else {

	/*
	 * Parse the result of the command.
	 */

	if (TclGetIntFromObj(infoPtr->interp,
		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {

	    Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
		    "-compare command returned non-integer result", -1));
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "COMPARISONFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return 0;
	}
    }
    if (!infoPtr->isIncreasing) {
	order = -order;
    }

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
		    "element %d missing from sublist \"%s\"",
		    index, TclGetString(objPtr)));
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;
    }
    return objPtr;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8

 * End:
 */

    /*
     * Check if the user requested -inline, but specified match variables; a
     * no-no.
     */

    if (doinline && ((objc - 2) != 0)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"regexp match variables not allowed when using -inline", -1));
	goto optionError;
    }

    /*
     * Handle the odd about case separately.
     */

    if (objc == 4) {
	const char *string = TclGetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", (size_t) length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }

    /*

	int length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", (size_t) length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));

		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string2));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*

		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string2));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*

	default:
	    if (foundmode) {
		/*
		 * Mode already set via -exact, -glob, or -regexp.
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad option \"%s\": %s option already found",
			TclGetString(objv[i]), options[mode]));

		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"DOUBLEOPT", NULL);
		return TCL_ERROR;
	    }
	    foundmode = 1;
	    mode = index;
	    break;

	    /*
	     * Check for TIP#75 options specifying the variables to write
	     * regexp information into.
	     */

	case OPT_INDEXV:
	    i++;
	    if (i >= objc-2) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"missing variable name argument to %s option",
			"-indexvar"));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", NULL);
		return TCL_ERROR;
	    }
	    indexVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	case OPT_MATCHV:
	    i++;
	    if (i >= objc-2) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"missing variable name argument to %s option",
			"-matchvar"));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", NULL);
		return TCL_ERROR;
	    }
	    matchVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	}
    }

  finishedOptions:
    if (objc - i < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-switch ...? string ?pattern body ...? ?default body?");
	return TCL_ERROR;
    }
    if (indexVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-indexvar"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", NULL);
	return TCL_ERROR;
    }
    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-matchvar"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", NULL);
	return TCL_ERROR;
    }

    stringObj = objv[i];
    objc -= i + 1;

    /*
     * Complain if there is an odd number of words in the list of patterns and
     * bodies.
     */

    if (objc % 2) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"extra switch pattern with no body", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		NULL);

	/*
	 * Check if this can be due to a badly placed comment in the switch
	 * block.
	 *
	 * The following is an heuristic to detect the infamous "comment in
	 * switch" error: just check if a pattern begins with '#'.
	 */

	if (splitObjs) {
	    for (i=0 ; i<objc ; i+=2) {
		if (TclGetString(objv[i])[0] == '#') {
		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
			    ", this may be due to a comment incorrectly"
			    " placed outside of a switch body - see the"
			    " \"switch\" documentation", -1);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			    "BADARM", "COMMENT?", NULL);
		    break;
		}
	    }
	}

	return TCL_ERROR;
    }

    /*
     * Complain if the last body is a continuation. Note that this check
     * assumes that the list is non-empty!
     */

    if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no body specified for pattern \"%s\"",
		TclGetString(objv[objc-2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		"FALLTHROUGH", NULL);
	return TCL_ERROR;
    }

    for (i = 0; i < objc; i += 2) {
	/*

    /*
     * The type must be a list of at least length 1.
     */

    if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
	return TCL_ERROR;
    } else if (len < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"type must be non-empty list", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Now prepare the result options dictionary. We use the list API as it is

		0, &type) != TCL_OK) {
	    Tcl_DecrRefCount(handlersObj);
	    return TCL_ERROR;
	}
	switch ((enum Handlers) type) {
	case TryFinally:	/* finally script */
	    if (i < objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"finally clause must be last", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"NONTERMINAL", NULL);
		return TCL_ERROR;
	    } else if (i == objc-1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to finally clause: must be"

			" \"... finally script\"", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    finallyObj = objv[++i];
	    break;

	case TryOn:		/* on code variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to on clause: must be \"... on code"
			" variableList script\"", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    if (TclGetCompletionCodeFromObj(interp, objv[i+1],
		    &code) != TCL_OK) {
		Tcl_DecrRefCount(handlersObj);
		return TCL_ERROR;
	    }
	    info[2] = NULL;
	    goto commonHandler;

	case TryTrap:		/* trap pattern variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to trap clause: "
			"must be \"... trap pattern variableList script\"",
			-1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    code = 1;
	    if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {

		    Tcl_NewListObj(5, info));
	    haveHandlers = 1;
	    i += 3;
	    break;
	}
    }
    if (bodyShared) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"last non-finally clause must not have a body of \"-\"", -1));

	Tcl_DecrRefCount(handlersObj);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
		NULL);
	return TCL_ERROR;
    }
    if (!haveHandlers) {
	Tcl_DecrRefCount(handlersObj);

    if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK
	    || pkgDict == NULL) {
	/*
	 * Maybe a Tcl_Panic is better, because the package data has to be
	 * present.
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
		Tcl_GetString(pkgName), NULL);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
		    Tcl_GetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, val);
	return TCL_OK;

    case CFG_LIST:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}

	Tcl_DictObjSize(interp, pkgDict, &n);
	listPtr = Tcl_NewListObj(n, NULL);

	if (!listPtr) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "insufficient memory to create list", -1));

	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    return TCL_ERROR;
	}

	if (n) {
	    Tcl_DictSearch s;
	    Tcl_Obj *key;

    dict->refcount = 1;
    objPtr->internalRep.otherValuePtr = dict;
    objPtr->typePtr = &tclDictType;
    return TCL_OK;

  missingValue:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing value to go with key", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
    result = TCL_ERROR;

  errorExit:
    if (interp != NULL) {
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);

	    int isNew;			/* Dummy */

	    if (flags & DICT_PATH_EXISTS) {
		return DICT_PATH_NON_EXISTENT;
	    }
	    if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(

			    "key \"%s\" not known in dictionary",
			    TclGetString(keyv[i])));
		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			    TclGetString(keyv[i]), NULL);
		}
		return NULL;
	    }

	    /*

	return TCL_ERROR;
    }
    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(

		"key \"%s\" not known in dictionary",
		TclGetString(objv[objc-1])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		TclGetString(objv[objc-1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}

    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    Dict *dict;
    char *statsStr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }

    dictPtr = objv[1];
    if (dictPtr->typePtr != &tclDictType) {
	int result = SetDictFromAny(interp, dictPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }
    dict = dictPtr->internalRep.otherValuePtr;

    statsStr = Tcl_HashStats(&dict->table);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
    ckfree(statsStr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictIncrCmd --

     * Parse arguments.
     */

    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));

	return TCL_ERROR;
    }
    searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
    if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
	    &done) != TCL_OK) {
	TclStackFree(interp, searchPtr);
	return TCL_ERROR;

	 * copying from the "dict for" implementation has occurred!
	 */

	if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (varc != 2) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "must have exactly two variable names", -1));

	    return TCL_ERROR;
	}
	keyVarObj = varv[0];
	valueVarObj = varv[1];
	scriptObj = objv[4];

	/*

	     */

	    Tcl_IncrRefCount(keyObj);
	    Tcl_IncrRefCount(valueObj);
	    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set key variable: \"%s\"",
			TclGetString(keyVarObj)));
		result = TCL_ERROR;
		goto abnormalResult;
	    }
	    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set value variable: \"%s\"",
			TclGetString(valueVarObj)));
		result = TCL_ERROR;
		goto abnormalResult;
	    }

	    /*
	     * TIP #280. Make invoking context available to loop body.
	     */

	    map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
	    Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
	    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
	}
    }

    if ((NULL == chan) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown encoding \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_DecrRefCount(fileNameObj);
    Tcl_DecrRefCount(nameObj);
    Tcl_DecrRefCount(searchPath);

    return chan;

	encoding = LoadTableEncoding(name, ENCODING_MULTIBYTE, chan);
	break;
    case 'E':
	encoding = LoadEscapeEncoding(name, chan);
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid encoding file \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_Close(NULL, chan);

    return encoding;
}


#include "tclInt.h"
#include "tclCompile.h"

/*
 * Declarations for functions local to this file:
 */

static inline Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
			    EnsembleConfig *ensemblePtr, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
static int		NsEnsembleImplementationCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NsEnsembleImplementationCmdNR(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);

const Tcl_ObjType tclEnsembleCmdType = {
    "ensembleCommand",		/* the type's name */
    FreeEnsembleCmdRep,		/* freeIntRepProc */
    DupEnsembleCmdRep,		/* dupIntRepProc */
    StringOfEnsembleCmdRep,	/* updateStringProc */
    NULL			/* setFromAnyProc */
};

static inline Tcl_Obj *
NewNsObj(
    Tcl_Namespace *namespacePtr)
{
    register Namespace *nsPtr = (Namespace *) namespacePtr;

    if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
	return Tcl_NewStringObj("::", 2);
    } else {
	return Tcl_NewStringObj(nsPtr->fullName, -1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclNamespaceEnsembleCmd --
 *
 *	Invoked to implement the "namespace ensemble" command that creates and

    Tcl_Command token;
    Tcl_DictSearch search;
    Tcl_Obj *listObj;
    int index, done;

    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tried to manipulate ensemble of deleted namespace",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
	return TCL_ERROR;

			}
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    if (len < 1) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"ensemble subcommand implementations "
				"must be non-empty lists", -1));
			Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				"EMPTY_TARGET", NULL);
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    cmd = TclGetString(listv[0]);
		    if (!(cmd[0] == ':' && cmd[1] == ':')) {
			Tcl_Obj *newList = Tcl_NewListObj(len, listv);
			Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr);

			if (nsPtr->parentPtr) {
			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
			}
			Tcl_AppendObjToObj(newCmd, listv[0]);
			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
			if (patchedDict == NULL) {

		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    case CONF_NAMESPACE:
		namespacePtr = NULL;		/* silence gcc 4 warning */
		Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
		Tcl_SetObjResult(interp, NewNsObj(namespacePtr));

		break;
	    case CONF_PREFIX: {
		int flags = 0;			/* silence gcc 4 warning */

		Tcl_GetEnsembleFlags(NULL, token, &flags);
		Tcl_SetObjResult(interp,
			Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));

	    /* -namespace option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE],
			    -1));
	    namespacePtr = NULL;		/* silence gcc 4 warning */
	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
	    Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr));



	    /* -parameters option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1));
	    Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (len < 1) {
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "ensemble subcommand implementations "
				    "must be non-empty lists", -1));
			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				    "EMPTY_TARGET", NULL);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			cmd = TclGetString(listv[0]);
			if (!(cmd[0] == ':' && cmd[1] == ':')) {
			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);


			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
			    if (patchedDict == NULL) {

		    mapObj = (patchedDict ? patchedDict : objv[1]);
		    if (patchedDict) {
			allocatedMapFlag = 1;
		    }
		    continue;
		}
		case CONF_NAMESPACE:
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "option -namespace is read-only", -1));
		    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY",
			    NULL);
		    goto freeMapAndError;
		case CONF_PREFIX:
		    if (Tcl_GetBooleanFromObj(interp, objv[1],
			    &permitPrefix) != TCL_OK) {
			goto freeMapAndError;
		    }

    /*
     * Make the name of the ensemble into a fully qualified name. This might
     * allocate a temporary object.
     */

    if (!(name[0] == ':' && name[1] == ':')) {
	nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
	if (nsPtr->parentPtr == NULL) {
	    Tcl_AppendStringsToObj(nameObj, name, NULL);
	} else {
	    Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
	}
	Tcl_IncrRefCount(nameObj);
	name = TclGetString(nameObj);

    Tcl_Obj *subcmdList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	int length;

	if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) {
	    return TCL_ERROR;

{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    int length;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (paramList == NULL) {
	length = 0;
    } else {
	if (TclListObjLength(interp, paramList, &length) != TCL_OK) {
	    return TCL_ERROR;

    Tcl_Obj *mapDict)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	int size, done;
	Tcl_DictSearch search;
	Tcl_Obj *valuePtr;

	    if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdObjPtr) != TCL_OK) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	    bytes = TclGetString(cmdObjPtr);
	    if (bytes[0] != ':' || bytes[1] != ':') {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"ensemble target is not a fully-qualified command",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
			"UNQUALIFIED_TARGET", NULL);
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}

	if (size < 1) {
	    mapDict = NULL;

    Tcl_Obj *unknownList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	int length;

	if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
	    return TCL_ERROR;

    int flags)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;

    /*

    Tcl_Obj **subcmdListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *subcmdListPtr = ensemblePtr->subcmdList;
    return TCL_OK;

    Tcl_Obj **paramListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *paramListPtr = ensemblePtr->parameterList;
    return TCL_OK;

    Tcl_Obj **mapDictPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *mapDictPtr = ensemblePtr->subcommandDict;
    return TCL_OK;

    Tcl_Obj **unknownListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *unknownListPtr = ensemblePtr->unknownHandler;
    return TCL_OK;

    int *flagsPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *flagsPtr = ensemblePtr->flags;
    return TCL_OK;

    Tcl_Namespace **namespacePtrPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
    return TCL_OK;

	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj)));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }
	    return NULL;
	}
    }

    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
				 * the command that implements the
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:

    if (ensemblePtr->nsPtr->flags & NS_DYING) {
	/*
	 * Don't know how we got here, but make things give up quickly.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "ensemble activated for deleted namespace", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Determine if the table of subcommands is right. If so, we can just look
     * up in there and go straight to dispatch.

     * We cannot determine what subcommand to hand off to, so generate a
     * (standard) failure message. Note the one odd case compared with
     * standard ensemble-like command, which is where a namespace has no
     * exported commands at all...
     */

    Tcl_ResetResult(interp);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
	    TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
    if (ensemblePtr->subcommandTable.numEntries == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown subcommand \"%s\": namespace %s does not"
		" export any commands",
		TclGetString(objv[1+ensemblePtr->numParameters]),
		ensemblePtr->nsPtr->fullName));

	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
		TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
	return TCL_ERROR;
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(objv[1+ensemblePtr->numParameters]));

    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	int i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {

	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);
    }
    Tcl_SetObjResult(interp, errorObj);

    return TCL_ERROR;
}

int
TclClearRootEnsemble(
    ClientData data[],
    Tcl_Interp *interp,

    EnsembleConfig *ensemblePtr,
    int objc,
    Tcl_Obj *const objv[],
    Tcl_Obj **prefixObjPtr)
{
    int paramc, i, result, prefixObjc;
    Tcl_Obj **paramv, *unknownCmd, *ensObj;


    /*
     * Create the unknown command callback to determine what to do.
     */

    unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
    TclNewObj(ensObj);

     * do that!
     */

    Tcl_Preserve(ensemblePtr);
    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
    result = Tcl_EvalObjv(interp, paramc, paramv, 0);
    if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unknown subcommand handler deleted its ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED",
		    NULL);
	}
	result = TCL_ERROR;
    }
    Tcl_Release(ensemblePtr);

    /*
     * If we succeeded, we should either have a list of words that form the
     * command to be executed, or an empty list. In the empty-list case, the

    /*
     * Oh no! An exceptional result. Convert to an error.
     */

    if (!Tcl_InterpDeleted(interp)) {
	if (result != TCL_ERROR) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unknown subcommand handler returned bad code: ", -1));

	    switch (result) {
	    case TCL_RETURN:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1);
		break;
	    case TCL_BREAK:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1);
		break;
	    case TCL_CONTINUE:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1);
		break;
	    default:
		Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);

	    }
	    Tcl_AddErrorInfo(interp, "\n    result of "
		    "ensemble unknown subcommand handler: ");
	    Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
		    NULL);
	} else {
	    Tcl_AddErrorInfo(interp,
		    "\n    (ensemble unknown subcommand handler)");
	}
    }
    TclDecrRefCount(unknownCmd);
    return TCL_ERROR;

	    /*
	     * Not there, so map onto the namespace. Note in this case that we
	     * do not guarantee that the command is actually there; that is
	     * the programmer's responsibility (or [::unknown] of course).
	     */

	    cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
	    } else {
		Tcl_AppendStringsToObj(cmdObj, name, NULL);
	    }
	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
	    Tcl_SetHashValue(hPtr, cmdPrefixObj);

    while (!done && foundEvent) {
	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    break;
	}
	if (Tcl_LimitExceeded(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
	    break;
	}
    }
    Tcl_UntraceVar(interp, nameString,
	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, &done);

    if (!foundEvent) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't wait for variable \"%s\": would wait forever",
		nameString));
	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
	return TCL_ERROR;
    }
    if (!done) {
	/*
	 * The interpreter's result was already set to the right error message
	 * prior to exiting the loop above.

    while (Tcl_DoOneEvent(flags) != 0) {
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (Tcl_LimitExceeded(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
	    return TCL_ERROR;
	}
    }

    /*
     * Must clear the interpreter's result because event handlers could have
     * executed commands.

		    }
		    lResult = l1 - l2*lResult;
		    goto longResultOfArithmetic;
		}

	    case INST_RSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));

#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif

		    lResult = l1 >> ((int) l2);
		    goto longResultOfArithmetic;
		}

	    case INST_LSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));

#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif

		    /*
		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "integer value too large to represent", -1));

#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
		    CACHE_STACK_INFO();
#endif
		    goto gotError;

	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {
	    if (objResultPtr) {
		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
		NEXT_INST_V(5, opnd+1, 1);
	    }
	    DECACHE_STACK_INFO();
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(

		    "key \"%s\" not known in dictionary",
		    TclGetString(OBJ_AT_TOS)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), NULL);
	    CACHE_STACK_INFO();
	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
	} else {
	    TRACE_WITH_OBJ((
		    "%u => ERROR reading leaf dictionary key \"%s\": ",

	/*
	 * Division by zero in an expression. Control only reaches this point
	 * by "goto divideByZero".
	 */

    divideByZero:
	DECACHE_STACK_INFO();
	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
	CACHE_STACK_INFO();
	goto gotError;

	/*
	 * Exponentiation of zero by negative number in an expression. Control
	 * only reaches this point by "goto exponOfZero".
	 */

    exponOfZero:
	DECACHE_STACK_INFO();
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"exponentiation of zero by negative power", -1));

	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		"exponentiation of zero by negative power", NULL);
	CACHE_STACK_INFO();

	/*
	 * Almost all error paths feed through here rather than assigning to
	 * result themselves (for a small but consistent saving).

	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "negative shift argument", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

		/*
		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
		 * an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"integer value too large to represent", -1));

		return GENERAL_ARITHMETIC_ERROR;
	    }
	    shift = (int)(*((const long *)ptr2));

	    /*
	     * Handle shifts within the native wide range.
	     */

	 * 268435455, which fits into a signed 32 bit int which is within the
	 * range of the long int type. This means any numeric Tcl_Obj value
	 * not using TCL_NUMBER_LONG type must hold a value larger than we
	 * accept.
	 */

	if (type2 != TCL_NUMBER_LONG) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	if (type1 == TCL_NUMBER_LONG) {
	    if (l1 == 2) {
		/*
		 * Reduce small powers of 2 to shifts.

	}
#endif

    overflowExpon:
	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	if (big2.used > 1) {
	    mp_clear(&big2);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d(&big1, big2.dp[0], &bigResult);
	mp_clear(&big1);
	mp_clear(&big2);

/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */






#include "tclInt.h"
#include "tclFileSystem.h"

/*
 * Declarations for local functions defined in this file:
 */

     * overwriting the symlink.
     */

    if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
	if ((objc - i) > 2) {
	    errno = ENOTDIR;
	    Tcl_PosixError(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error %s: target \"%s\" is not a directory",
		    (copyFlag?"copying":"renaming"), TclGetString(target)));
	    result = TCL_ERROR;
	} else {
	    /*
	     * Even though already have target == translated(objv[i+1]), pass
	     * the original argument down, so if there's an error, the error
	     * message will reflect the original arguments.
	     */

	}
	Tcl_DecrRefCount(split);
	split = NULL;
    }

  done:
    if (errfile != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create directory \"%s\": %s",
		TclGetString(errfile), Tcl_PosixError(interp)));
	result = TCL_ERROR;
    }
    if (split != NULL) {
	Tcl_DecrRefCount(split);
    }
    if (target != NULL) {
	Tcl_DecrRefCount(target);

	     * We own a reference count on errorBuffer, if it was set as a
	     * result of this call.
	     */

	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
	    if (result != TCL_OK) {
		if ((force == 0) && (errno == EEXIST)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error deleting \"%s\": directory not empty",
			    TclGetString(objv[i])));

		    Tcl_PosixError(interp);
		    goto done;
		}

		/*
		 * If possible, use the untranslated name for the file.
		 */

    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /*
	     * We try to accomodate poor error results from our Tcl_FS calls.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting unknown file: %s",
		    Tcl_PosixError(interp)));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));

	}
    }

  done:
    if (errorBuffer != NULL) {
	Tcl_DecrRefCount(errorBuffer);
    }

	 * implementations of copy and rename on all platforms also prevent
	 * this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
		&& !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't overwrite file \"%s\" with directory \"%s\"",
		    TclGetString(target), TclGetString(source)));
	    goto done;
	}
	if (!S_ISDIR(sourceStatBuf.st_mode)
		&& S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't overwrite directory \"%s\" with file \"%s\"",
		    TclGetString(target), TclGetString(source)));

	    goto done;
	}

	/*
	 * The destination exists, but appears to be ok to over-write, and
	 * -force is given. We now try to adjust permissions to ensure the
	 * operation succeeds. If we can't adjust permissions, we'll let the

    if (copyFlag == 0) {
	result = Tcl_FSRenameFile(source, target);
	if (result == TCL_OK) {
	    goto done;
	}

	if (errno == EINVAL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(

		    "error renaming \"%s\" to \"%s\": trying to rename a"
		    " volume or move a directory into itself",
		    TclGetString(source), TclGetString(target)));
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}

	/*

	 */

	if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
	    /*
	     * Actual file doesn't exist.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error copying \"%s\": the target of this link doesn't"
		    " exist", TclGetString(source)));
	    goto done;
	} else {
	    int counter = 0;

	    while (1) {
		Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
		if (path == NULL) {

	} else {
	    result = Tcl_FSDeleteFile(source);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));
	    errfile = NULL;
	}
    }

  done:
    if (errfile != NULL) {
	Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
		(copyFlag ? "copying" : "renaming"), TclGetString(source));

	if (errfile != source) {
	    Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
		    TclGetString(target));
	    if (errfile != target) {
		Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
			TclGetString(errfile));
	    }
	}
	Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
	Tcl_SetObjResult(interp, errorMsg);
    }
    if (errorBuffer != NULL) {
	Tcl_DecrRefCount(errorBuffer);
    }
    if (actualSource != NULL) {
	Tcl_DecrRefCount(actualSource);
    }

	if (objStrings == NULL) {
	    if (Tcl_GetErrno() != 0) {
		/*
		 * There was an error, probably that the filePtr is not
		 * accepted by any filesystem
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not read \"%s\": %s",
			TclGetString(filePtr), Tcl_PosixError(interp)));

	    }
	    return TCL_ERROR;
	}

	/*
	 * We own the object now.
	 */

	 * Get one attribute.
	 */

	int index;
	Tcl_Obj *objPtr = NULL;

	if (numObjStrings == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
		"option", 0, &index) != TCL_OK) {
	    goto end;

	/*
	 * Set option/value pairs.
	 */

	int i, index;

	if (numObjStrings == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", 0, &index) != TCL_OK) {
		goto end;
	    }
	    if (attributeStringsAllocated != NULL) {
		TclFreeIntRep(objv[i]);
	    }
	    if (i + 1 == objc) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"value for \"%s\" missing", TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", NULL);
		goto end;
	    }
	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
		    objv[i + 1]) != TCL_OK) {
		goto end;

	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);
	    } else if (errno == ENOENT) {
		/*
		 * There are two cases here: either the target doesn't exist,
		 * or the directory of the src doesn't exist.
		 */

		int access;
		Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
			TCL_PATH_DIRNAME);

		if (dirPtr == NULL) {
		    return TCL_ERROR;
		}
		access = Tcl_FSAccess(dirPtr, F_OK);
		Tcl_DecrRefCount(dirPtr);
		if (access != 0) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not create new link \"%s\": no such file"
			    " or directory", TclGetString(objv[index])));

		    Tcl_PosixError(interp);
		} else {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not create new link \"%s\": target \"%s\" "
			    "doesn't exist", TclGetString(objv[index]),
			    TclGetString(objv[index+1])));

		    errno = ENOENT;
		    Tcl_PosixError(interp);
		}
	    } else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\" pointing to \"%s\": %s",
			TclGetString(objv[index]),
			TclGetString(objv[index+1]), Tcl_PosixError(interp)));

	    }
	    return TCL_ERROR;
	}
    } else {
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Read link
	 */

	contents = Tcl_FSLink(objv[index], NULL, 0);
	if (contents == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read link \"%s\": %s",
		    TclGetString(objv[index]), Tcl_PosixError(interp)));

	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, contents);
    if (objc == 2) {
	/*
	 * If we are reading a link, we need to free this result refCount. If

    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }

    contents = Tcl_FSLink(objv[1], NULL, 0);

    if (contents == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read link \"%s\": %s",
		TclGetString(objv[1]), Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, contents);
    Tcl_DecrRefCount(contents);
    return TCL_OK;
}


     * Deal with results.
     */

    if (chan == NULL) {
	if (nameVarObj) {
	    TclDecrRefCount(nameObj);
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create temporary file: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    if (nameVarObj != NULL) {
	if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_UnregisterChannel(interp, chan);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	case TCL_PLATFORM_UNIX: {
	    const char *origPath = path;

	    /*
	     * Paths that begin with / are absolute.
	     */

	    if (path[0] == '/') {
		++path;
#if defined(__CYGWIN__) || defined(__QNX__)
		/*
		 * Check for "//" network path prefix
		 */

		if ((*path == '/') && path[1] && (path[1] != '/')) {
		    path += 2;
		    while (*path && *path != '/') {
			++path;
		    }
#if defined(__CYGWIN__)
		    /* UNC paths need to be followed by a share name */
		    if (*path++ && (*path && *path != '/')) {
			++path;
			while (*path && *path != '/') {
			    ++path;
			}
		    } else {
			path = origPath + 1;
		    }
#endif







		}
#endif
		if (driveNameLengthPtr != NULL) {
		    /*
		     * We need this addition in case the QNX or Cygwin code was used.
		     */

		    *driveNameLengthPtr = (path - origPath);
		}
	    } else {
		type = TCL_PATH_RELATIVE;
	    }
	    break;
	}
	case TCL_PLATFORM_WINDOWS: {

 */

static Tcl_Obj *
SplitUnixPath(
    const char *path)		/* Pointer to string containing a path. */
{
    int length;
    const char *origPath = path, *elementStart;
    Tcl_Obj *result = Tcl_NewObj();

    /*
     * Deal with the root directory as a special case.
     */

    if (*path == '/') {
	Tcl_Obj *rootElt;
	++path;
#if defined(__CYGWIN__) || defined(__QNX__)
	/*
	 * Check for "//" network path prefix
	 */
	if ((*path == '/') && path[1] && (path[1] != '/')) {
	    path += 2;
	    while (*path && *path != '/') {
		++path;
	    }
#if defined(__CYGWIN__)
	    /* UNC paths need to be followed by a share name */
	    if (*path++ && (*path && *path != '/')) {

		++path;
		while (*path && *path != '/') {
		    ++path;
		}
	    } else {
		path = origPath + 1;
	    }
#endif
	}

#endif
	rootElt = Tcl_NewStringObj(origPath, path - origPath);





	Tcl_ListObjAppendElement(NULL, result, rootElt);
	while (*path == '/') {

	    ++path;
	}


    }

    /*
     * Split on slashes. Embedded elements that start with tilde will be
     * prefixed with "./" so they are not affected by tilde substitution.
     */

    for (;;) {
	elementStart = path;
	while ((*path != '\0') && (*path != '/')) {
	    path++;
	}
	length = path - elementStart;
	if (length > 0) {
	    Tcl_Obj *nextElt;
	    if ((elementStart[0] == '~') && (elementStart != origPath)) {
		TclNewLiteralStringObj(nextElt, "./");
		Tcl_AppendToObj(nextElt, elementStart, length);
	    } else {
		nextElt = Tcl_NewStringObj(elementStart, length);
	    }
	    Tcl_ListObjAppendElement(NULL, result, nextElt);
	}
	if (*path++ == '\0') {
	    break;
	}
    }
    return result;
}

/*

    if (*user == '\0') {
	Tcl_DString dirString;

	dir = TclGetEnv("HOME", &dirString);
	if (dir == NULL) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"couldn't find HOME environment "
			"variable to expand path", -1));
		Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL);
	    }
	    return NULL;
	}
	Tcl_JoinPath(1, &dir, resultPtr);
	Tcl_DStringFree(&dirString);
    } else if (TclpGetUserHome(user, resultPtr) == NULL) {
	if (interp) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "user \"%s\" doesn't exist", user));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
	}
	return NULL;
    }
    return Tcl_DStringValue(resultPtr);
}

/*

	    i++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"\"-tails\" must be used with either "
		"\"-directory\" or \"-path\"", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
		"BADOPTIONCOMBINATION", NULL);
	return TCL_ERROR;
    }

    separators = NULL;		/* lint. */
    switch (tclPlatform) {

	     */

	    result = TCL_ERROR;
	    goto endOfGlob;
	}

	if (length == 0) {
	    Tcl_Obj *errorMsg =
		    Tcl_ObjPrintf("no files matched glob pattern%s \"",
			    (join || (objc == 1)) ? "" : "s");

	    if (join) {
		Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
	    } else {
		const char *sep = "";

		for (i = 0; i < objc; i++) {
		    Tcl_AppendPrintfToObj(errorMsg, "%s%s",
			    sep, Tcl_GetString(objv[i]));

		    sep = " ";
		}
	    }
	    Tcl_AppendToObj(errorMsg, "\"", -1);
	    Tcl_SetObjResult(interp, errorMsg);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
		    NULL);
	    result = TCL_ERROR;
	}
    }

  endOfGlob:

	    }
	    pathPrefix = TclDStringToObj(&buffer);
	    Tcl_IncrRefCount(pathPrefix);
	    globFlags |= TCL_GLOBMODE_DIR;
	    if (c != '\0') {
		tail++;
	    }
	    Tcl_DStringFree(&buffer);
	} else {
	    tail = pattern;
	}
    } else {
	Tcl_IncrRefCount(pathPrefix);
	tail = pattern;
    }

		/*
		 * Balanced braces.
		 */

		closeBrace = p;
		break;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched open-brace in file name", -1));

	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
	    return TCL_ERROR;

	} else if (*p == '}') {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched close-brace in file name", -1));

	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
	    return TCL_ERROR;
	}
    }

    /*

	 */

	active = 0;
	for (statePtr = tsdPtr->firstCSPtr;
		statePtr != NULL;
		statePtr = statePtr->nextCSPtr) {
	    chanPtr = statePtr->topChanPtr;
            if (GotFlag(statePtr, CHANNEL_DEAD)) {
                continue;
            }
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED )
                || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
                ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
		active = 1;
		break;
	    }
	}

{
    ChannelState *statePtr;	/* State of the real channel. */

    statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }

    if (DetachChannel(interp, chan) != TCL_OK) {
	return TCL_OK;
    }

	    name = chanPtr->state->channelName;
	}
    }

    hTblPtr = GetChannelTable(interp);
    hPtr = Tcl_FindHashEntry(hTblPtr, name);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can not find channel named \"%s\"", chanName));

	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
	return NULL;
    }

    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs

    while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
	statePtr = statePtr->nextCSPtr;
    }

    if (statePtr == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't find state for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	}
	return NULL;
    }

    /*
     * Here we check if the given "mask" matches the "flags" of the already
     * existing channel.
     *
     *	  | - | R | W | RW |
     *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
     *	- |   |   |   |    |
     *	R |   | + |   | +  |	The superceding channel is allowed to restrict
     *	W |   |   | + | +  |	the capabilities of the superceded one!
     *	RW|   | + | + | +  |
     *	--+---+---+---+----+
     */

    if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "reading and writing both disallowed for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	}
	return NULL;
    }

    /*
     * Flush the buffers. This ensures that any data still in them at this
     * time is not handled by the new transformation. Restrict this to

	statePtr->csPtrR = NULL;
	statePtr->csPtrW = NULL;

	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan)));
	    }
	    return NULL;
	}

	statePtr->csPtrR = csPtrR;
	statePtr->csPtrW = csPtrW;
    }

		 * Move error messages put by the driver into the chan/ip
		 * bypass area into the regular interpreter result. Fall back
		 * to the regular message if nothing was found in the
		 * bypasses.
		 */

		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "could not flush channel \"%s\"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));

		}
		return TCL_ERROR;
	    }

	    statePtr->csPtrR  = csPtrR;
	    statePtr->csPtrW = csPtrW;
	}

{
    if (!GotFlag(statePtr, CHANNEL_DEAD)) {
	return 0;
    }

    Tcl_SetErrno(EINVAL);
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unable to access channel: invalid channel", -1));

    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *

    if (statePtr->refCount > 0) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }
    SetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * When the channel has an escape sequence driven encoding such as

    statePtr = chanPtr->state;

    /*
     * Does the channel support half-close anyway? Error if not.
     */

    if (!chanPtr->typePtr->close2Proc) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "half-close of channels not supported by %ss",
		chanPtr->typePtr->typeName));
	return TCL_ERROR;
    }

    /*
     * Is the channel unstacked ? If not we fail.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"half-close not applicable to stack of transformations", -1));

	return TCL_ERROR;
    }

    /*
     * Check direction against channel mode. It is an error if we try to close
     * a direction not supported by the channel (already closed, or never
     * opened for that direction).
     */

    if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
	const char *msg;

	if (flags & TCL_CLOSE_READ) {
	    msg = "read";
	} else {
	    msg = "write";
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "Half-close of %s-side not possible, side not opened or"
                " already closed", msg));
	return TCL_ERROR;
    }

    /*
     * A user may try to call half-close from within a channel close
     * handler. That won't do.
     */

    if (statePtr->flags & CHANNEL_INCLOSE) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }

    if (flags & TCL_CLOSE_READ) {
	/*
	 * Call the finalization code directly. There are no events to handle,

{
    if (interp != NULL) {
	const char *genericopt =
		"blocking buffering buffersize encoding eofchar translation";
	const char **argv;
	int argc, i;
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, optionList, -1);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);

	errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
                optionName);
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);
	ckfree(argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}


    /*
     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtrR || statePtr->csPtrW) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "unable to set channel options: background copy in"
                    " progress", -1));
	}
	return TCL_ERROR;
    }

    /*
     * Disallow options on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit

	    ResetFlag(statePtr, CHANNEL_UNBUFFERED);
	    SetFlag(statePtr, CHANNEL_LINEBUFFERED);
	} else if ((newValue[0] == 'n') &&
		(strncmp(newValue, "none", len) == 0)) {
	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
	} else if (interp) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "bad value for -buffering: must be one of"
                    " full, line, or none", -1));
            return TCL_ERROR;
	}
	return TCL_OK;
    } else if (HaveOpt(7, "-buffersize")) {
	int newBufferSize;

	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {

	} else if (argc == 1 || argc == 2) {
	    int outIndex = (argc - 1);
	    int inValue = (int) argv[0][0];
	    int outValue = (int) argv[outIndex][0];

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: must be non-NUL ASCII"
                            " character", -1));
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = inValue;
	    }
	    if (GotFlag(statePtr, TCL_WRITABLE)) {
		statePtr->outEofChar = outValue;
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    ckfree(argv);
	}

	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
	} else if (argc == 2) {
	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: must be a one or two"
			" element list", -1));
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

		translation = TCL_TRANSLATE_CR;
	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));

		}
		ckfree(argv);
		return TCL_ERROR;
	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data

		statePtr->outputTranslation = TCL_TRANSLATE_CR;
	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));

		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	}
	ckfree(argv);
	return TCL_OK;

    /*
     * We must preserve the interpreter so we can report errors on it later.
     * Note that we do not need to preserve the channel because that is done
     * by Tcl_NotifyChannel before calling channel handlers.
     */

    Tcl_Preserve(interp);
    Tcl_Preserve(chanPtr);
    result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);

    /*
     * On error, cause a background error and remove the channel handler and
     * the script record.
     *
     * NOTE: Must delete channel handler before causing the background error
     * because the background error may want to reinstall the handler.
     */

    if (result != TCL_OK) {
	if (chanPtr->typePtr != NULL) {
	    DeleteScriptRecord(interp, chanPtr, mask);
	}
	Tcl_BackgroundException(interp, result);
    }
    Tcl_Release(chanPtr);
    Tcl_Release(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FileEventObjCmd --

    chan = Tcl_GetChannel(interp, chanName, NULL);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    if ((statePtr->flags & mask) == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
		(mask == TCL_READABLE) ? "readable" : "writable"));
	return TCL_ERROR;
    }

    /*
     * If we are supposed to return the script, do so.
     */

    int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;

    inStatePtr = inPtr->state;
    outStatePtr = outPtr->state;

    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
	}
	return TCL_ERROR;
    }
    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
	}
	return TCL_ERROR;
    }

    readFlags = inStatePtr->flags;
    writeFlags = outStatePtr->flags;