2004-02-06  Don Porter	<dgp@users.sourceforge.net>

	* doc/clock.n:	Removed reference to non-existent [file ctime].

2004-02-05  David Gravereaux <davygrvy@pobo.co>

	* docs/tclvars.n: Added clarification of the tcl_platform(debug)
	var that it only refers to the flavor of the C run-time, and not
	whether the core contains symbols.

2004-02-05  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclFileName.c (SkipToChar):	Corrected CONST and
	type-casting issues that caused compiler warnings.

2004-02-04  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclCmdAH.c (StoreStatData):	Removed improper refcount
	decrement of the varName parameter.  This error was causing
	segfaults following test cmdAH-28.7.

	* library/tcltest/tcltest.tcl:	Corrected references to
	non-existent $name variable in [cleanupTests]. [Bug 833637]

2004-02-03  Don Porter	<dgp@users.sourceforge.net>

	* library/tcltest/tcltest.tcl:	Corrected parsing of single
	command line argument (option with missing value) [Bug 833910]
	* library/tcltest/pkgIndex.tcl:	Bump to version 2.2.5.

2004-02-02  David Gravereaux <davygrvy@pobox.com>

	* generic/tclIO.c (Tcl_Ungets): Fixes improper filling of the
	channel buffer. This is the buffer before the splice. [Bug 405995]

2004-02-01  David Gravereaux <davygrvy@pobox.com>

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

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

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

2004-01-30  David Gravereaux <davygrvy@pobox.com>

	* win/makefile.vc: Use the -GZ compiler switch when building for
	symbols.  This is supposed to emulate the release build better to
	avoid hiding problems that only show themselves in a release
	build.

2004-01-29  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclPathObj.c: fix to [Bug 883143] in file normalization

2004-01-29  Vince Darley  <vincentdarley@users.sourceforge.net>

	* doc/file.n: 
	* generic/tclFCmd.c
	* generic/tclTest.c
	* library/init.tcl
	* mac/tclMacFile.c
	* tests/fileSystem.test: fix to [Bug 886352] where 'file copy
	-force' had inconsistent behaviour wrt target files with
	insufficient permissions, particular from vfs->native fs.
	Behaviour of '-force' is now always consistent (and now
	consistent with behaviour of 'file delete -force').  Added new
	tests and documentation and cleaned up the 'simplefs' test
	filesystem.
	
	* generic/tclIOUtil.c
	* unix/tclUnixFCmd.c
	* unix/tclUnixFile.c
	* win/tclWinFile.c: made native filesystems more robust to C code
	which asks for mount lists.
	
	* generic/tclPathObj.c: fix to [Bug 886607] removing warning/error
	with some compilers.
	
2004-01-28  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclObj.c (SetBooleanFromAny): Rewrite to do more
	efficient string->bool conversion.
	Many other minor whitespace/style fixes to this file too.

2004-01-27  David Gravereaux <davygrvy@pobox.com>

	* win/nmakehlp.c: Use '.\nul' as the sourcefile name instead of
	'nul' so VC 5.2 doesn't try searching the path for it and failing
	with a possible dialogbox popping up about having to add a CD to
	an empty drive.  Also added a SetErrorMode() call to disable any
	dialogs that cl.exe or link.exe might create.  [Bug 885537]

2004-01-22  Vince Darley  <vincentdarley@users.sourceforge.net>

	* doc/file.n: clarified documentation of 'file system' [Bug 883825]
	* tests/fCmd.test: improved test result in failure case.
	
2004-01-22  Vince Darley  <vincentdarley@users.sourceforge.net>

	* tests/fileSystem.test: 3 new tests
	* generic/tclPathObj.c: fix to [Bug 879555] in file normalization. 
	* doc/filename.n: small clarification to Windows behaviour with
	filenames like '.....', 'a.....', '.....a'.
	
	* generic/tclIOUtil.c: slight improvement to native cwd caching
	on Windows.

2004-01-21  David Gravereaux <davygrvy@pobox.com>

	* doc/Panic.3:  Mentions of 'panic' and 'panicVA' removed from
	the documentation.

2004-01-21  Vince Darley  <vincentdarley@users.sourceforge.net>

	* doc/FileSystem.3: 
	* generic/tcl.decls: 
	* generic/tclCmdAH.c
	* generic/tclDecls.h
	* generic/tclFCmd.c
	* generic/tclFileName.c
	* generic/tclFileSystem.h
	* generic/tclIOUtil.c
	* generic/tclInt.decls
	* generic/tclInt.h
	* generic/tclIntDecls.h
	* generic/tclPathObj.c
	* generic/tclStubInit.c
	* generic/tclTest.c
	* mac/tclMacFile.c
	* tests/fileName.test
	* tests/fileSystem.test
	* tests/winFCmd.test
	* unix/tclUnixFile.c
	* win/tclWin32Dll.c
	* win/tclWinFCmd.c
	* win/tclWinFile.c
	* win/tclWinInt.h
	
	Three main issues accomplished: (1) cleaned up variable names in
	the filesystem code so that 'pathPtr' is used throughout.  (2)
	applied a round of filesystem optimisation with better handling
	and caching of relative and absolute paths, requiring fewer
	conversions.  (3) clarifications to the documentation,
	particularly regarding the acceptable refCounts of objects.
	Some new tests added.  Tcl benchmarks show a significant
	improvement over 8.4.5, and on Windows typically a small
	improvement over 8.3.5 (Unix still appears to require
	optimisation).  TCL_FILESYSTEM_VERSION_2 introduced, but for
	internal use only.  There should be no public incompatibilities
	from these changes.  Thanks to dgp for extensive testing.
	
2004-01-19  David Gravereaux <davygrvy@pobox.com>

	* win/tclWinPipe.c (Tcl_WaitPid): Fixed a thread-safety problem
	with the process list.  The delayed cut operation after the wait
	was going stale by being outside the list lock.  It now cuts
	within the lock and does a locked splice for when it needs to
	instead.  [Bug 859820]

2004-01-18  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclCompile.c, generic/tclCompile.h: Two new opcodes,
	INST_LIST_INDEX_IMM and INST_LIST_RANGE_IMM, that have operand(s)
	of new type OPERAND_IDX4 which represents indexes into things like
	lists (and perhaps other things eventually.)
	* generic/tclExecute.c (TclExecuteByteCode): Implementation of the
	new opcodes.  INST_LIST_INDEX_IMM does a simple [lindex] with
	either front- or end-based simple indexing.  INST_LIST_RANGE_IMM
	does an [lrange] with front- or end-based simple indexing for both
	the reference to the first and last items in the range.
	* generic/tclCompCmds.c (TclCompileLassignCmd): Generate bytecode
	for the [lassign] command.

2004-01-17  David Gravereaux <davygrvy@pobox.com>

	* win/tclWinInit.c:  added #pragma comment(lib, "advapi32.lib")
	when compiling under VC++ so we don't need to specify it
	when linking.

2004-01-17  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclCmdIL.c (Tcl_LassignObjCmd): Add more shimmering
	protection for when the list is also one of the variables.

	BASIC IMPLEMENTATION OF TIP#57
	* generic/tclCmdIL.c (Tcl_LassignObjCmd): Implementation of the
	[lassign] command that takes full advantage of Tcl's object API.
	* doc/lassign.n: New file documenting the command.
	* tests/cmdIL.test (cmdIL-6.*): Test suite for the command.

2004-01-15  David Gravereaux <davygrvy@pobox.com>

	* win/tclWinReg.c:  Placed the requirement for advapi.lib into
	the object file itself with #paragma comment (lib, ...) when
	built with VC++.  This will simplify linking for users of the
	static library.

	* win/rules.vc:  Added new 'fullwarn' to the CHECKS commandline
	macro; sets $(FULLWARNINGS).

	* win/makefile.vc:  Removed 'advapi.lib' from $(baselibs).
	Added new logic to crank-up the warning levels for both compile
	and link when $(FULLWARNINGS) is set.  Some clean-up with how
	the resource files are built and how -DTCL_USE_STATIC_PACKAGES
	is sent when compiling the shells.

	* win/tclAppInit.c: Small change in how TCL_USE_STATIC_PACKAGES
	is used.

	* win/tcl.rc:
	* win/tclsh.rc: Some clean-up with how the resource files are
	built.  Fixed 'OriginalFilename' problem that still thought
	a debug suffix was still 'd', now is 'g'.

2004-01-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclDictObj.c (TraceDictPath, DictExistsCmd): Adjusted
	behaviour of [dict exists] so a failure to look up a dictionary
	along the path of dicts doesn't trigger an error.  This is how it
	was documented to behave previously...  [Bug 871387]

	* generic/tclDictObj.c: Assorted dict fixes from Peter Spjuth
	relating to [Bug 876170].
	(SetDictFromAny): Make sure that lists retain their ordering even
	when converted to dictionaries and back.
	(TraceDictPath): Correct object reference count handling!
	(DictReplaceCmd, DictRemoveCmd): Stop object leak.
	(DictIncrCmd,DictLappendCmd,DictAppendCmd,DictSetCmd,DictUnsetCmd): 
	Simpler handling of reference counts when assigning to variables.
	* tests/dict.test (dict-19.2): Memory leak stress test

2004-01-13  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):  Silence compiler warnings.

	Patch 876451: restores performance of [return].  Also allows forms
	such as [return -code error $msg] to be bytecompiled.

	* generic/tclInt.h:	Factored Tcl_ReturnObjCmd() into two pieces:
	* generic/tclCmdMZ.c:	TclMergeReturnOptions(), which can parse the
	options to [return], check their validity, and create the
	corresponding return options dictionary, and TclProcessReturn(),
	which takes that return options dictionary and performs the
	[return] operation.

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

	* generic/tclCompile.h:	New utilities include TclEmitInt4 macro
	* generic/tclCompile.c:	and TclWordKnownAtCompileTime().
	
	End Patch 876451.

	* generic/tclFileName.c (Tcl_GlobObjCmd):  Latest changes to
	management of the interp result by Tcl_GetIndexFromObj() exposed
	improper interp result management in the [glob] command procedure.
	Corrected by adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern.
	This stopped a segfault in test filename-11.36. [Bug 877677]

2004-01-13  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs):
	Create fresh objects instead of using the one currently in the
	interpreter, which isn't guaranteed to be fresh and unshared. The
	cost for the core will be minimal because of the object cache, and
	this fixes [Bug 875395].

2004-01-12  Miguel Sofer <msofer@users.sf.net>

	* generic/tclCompExpr.c (CompileLandOrLorExpr): cosmetic changes. 

2004-01-12  Miguel Sofer <msofer@users.sf.net>

	* generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer
	instructions. As a side effect, the instructions INST_LOR and
	INST_LAND are now never used.
	* generic/tclExecute.c (INST_JUMP*): small optimisation; fix a
	bug in debug code.

2004-01-11  David Gravereaux <davygrvy@pobox.com>

	* win/tclWinThrd.c (Tcl_ConditionNotify): condPtr must be
	dereferenced to see if there are waiters else uninitialized
	datum is manipulated.  [Bug 849007 789338 745068]

2004-01-09  David Gravereaux <davygrvy@pobox.com>

	* generic/tcl.h: Renamed and deprecated #defines moved to within
	the #ifndef TCL_NO_DEPRECATED block.  This allows us to build Tcl
	to check for deprecated functions in use, such as panic() and
	Tcl_Ckalloc().  By request from DKF.  Extensions that build
	with -DTCL_NO_DEPRECATED now have these macros as restricted.
	***POTENTIAL INCOMPATIBILITY***

	* win/makefile.vc:
	* win/rules.vc:  Added -DTCL_NO_DEPRECATED usage to makefile.vc.
	Called like this:   nmake -af makefile.vc CHECKS=nodep

2004-01-09  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclIOUtil.c: fix to infinite loop in 
	TclFinalizeFilesystem [Bug 873311]

2003-12-25  Mo DeJong  <mdejong@users.sourceforge.net>

	* win/tclWin32Dll.c (DllMain): Add HAVE_NO_SEH
	blocks in place of __try and __except statements
	to support gcc builds. This is needed after
	David's changes on 2003-12-21. [Tcl patch 858493]

2003-12-23  David Gravereaux <davygrvy@pobox.com>

	* generic/tclAlloc.c:	All uses of 'panic' (the macro) changed
	* generic/tclBasic.c:	to 'Tcl_Panic' (the function).  The
	* generic/tclBinary.c:	#define of panic in tcl.h clearly states
	* generic/tclCkalloc.c:	it is deprecated in the comments.
	* generic/tclCmdAH.c:	[Patch 865264]
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclConfig.c:
	* generic/tclDictObj.c:
	* generic/tclEncoding.c:
	* generic/tclEvent.c:
	* generic/tclExecute.c:
	* generic/tclHash.c:
	* generic/tclInterp.c:
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclIOUtil.c:
	* generic/tclListObj.c:
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclParse.c:
	* generic/tclPathObj.c:
	* generic/tclPkg.c:
	* generic/tclPreserve.c:
	* generic/tclProc.c:
	* generic/tclStringObj.c:
	* generic/tclTest.c:
	* generic/tclThreadAlloc.c:
	* generic/tclTimer.c:
	* generic/tclTrace.c:
	* generic/tclVar.c:
	* mac/tclMacChan.c:
	* mac/tclMacOSA.c:
	* mac/tclMacResource.c:
	* mac/tclMacSock.c
	* mac/tclMacThrd.c:
	* unix/tclUnixChan.c:
	* unix/tclUnixNotfy.c:
	* unix/tclUnixThrd.c:
	* unix/tclXtNotify.c:
	* win/tclWin32Dll.c:
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:
	* win/tclWinNotify.c:
	* win/tclWinPipe.c:
	* win/tclWinSock.c:
	* win/tclWinThrd.c:

	* generic/tclInt.h:  Deprecated use of Tcl_Ckalloc changed to
	Tcl_Alloc in the TclAllocObjStorage macro.

2003-12-22  David Gravereaux <davygrvy@pobox.com>

	* win/nmakehlp.c:
	* win/rules.vc:  New feature for extensions that use rules.vc.
	Now reads header files for version strings.  No more hard coding
	TCL_VERSION = 8.5 and having to edit it when you swap cores.

	* win/makefile.vc: VERSION macro now set by reading tcl.h for it.

	* generic/tcl.h: Removed note that makefile.vc needs to have a
	version number changed.

2003-12-21  David Gravereaux <davygrvy@pobox.com>

	* win/tclWin32Dll.c: Structured Exception Handling added around
	Tcl_Finalize called from DllMain's DLL_PROCESS_DETACH.  We can't
	be 100% assured that Tcl is being unloaded by the OS in a stable
	condition and we need to protect the exit handlers should the
	stack be in a hosed state.  AT&T style assembly for SEH under
	MinGW has not been added yet.  This is a first part change for
	[Patch 858493]

2003-12-17  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclBinary.c (DeleteScanNumberCache): fixed crashing bug
	when numeric scan-value cache contains NULL value.

2003-12-17  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclCmdAH.c: 
	* unix/tclUnixFile.c: 
	* win/tclWinFCmd.c: 
	* tests/fCmd.test: 
	* tests/fileSystem.test: 
	* doc/file.n: final fix to support for relative links and
	its implications on normalization and other parts of the
	filesystem code.  Fixes [Bug 859251] and some Windows
	problems with recursive file delete/copy and symbolic links.
	
2003-12-17  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclPathObj.c: 
	* tests/fileSystem.test: fix and tests for [Bug 860402] in new 
	file normalization code.
	
2003-12-17  Zoran Vasiljevic  <zv@archiware.com>

	* generic/tclIOUtil.c: fixed 2 memory (object) leaks.
	This fixes Tcl Bug #839519.

	* generic/tclPathObj.c: fixed Tcl_FSGetTranslatedPath
	to always return properly refcounted path object.
	This fixes Tcl Bug #861515.

2003-12-16  Vince Darley  <vincentdarley@users.sourceforge.net>

	* tests/fCmd.test: marking fCmd-9.14.2, as nonPortable, since
	on Solaris one can change the name of the current directory
	with 'file rename'.
	* doc/FileSystem.3: clarified documentation on ownership
	of return objects/strings of some Tcl_FS* calls.

2003-12-16  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclThreadAlloc.c (binfo): Made variable file-local.

2003-12-15  David Gravereaux <davygrvy@pobox.com>

	* win/tcl.rc:
	* win/tclsh.rc: Slight modification to the STRINGIFY macro to
	support Borland's rc tool.

	* win/tclWinFile.c (TclpUtime) : utimbuf struct not a problem 
	with Borland.

	* win/tclWinTime.c (TclpGetDate) : Borland's localtime() has
	a slight behavioral difference.

	From Helmut Giese <hgiese@ratiosoft.com> [Patch 758097].

2003-12-14  David Gravereaux <davygrvy@pobox.com>

	* generic/tclInt.decls: commented-out entry for
	TclpCheckStackSpace, removing it from the Stubs table.  It's
	already declared in tclInt.h and labeled as a function that is
	not to be exported.  Regened tables.

2003-12-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): TIP#75 Implementation
	* tests/switch.test:	Can now get submatch information when
	* doc/switch.n:		using -regexp matching in [switch].

2003-12-14  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclPathObj.c: complete rewrite of generic file 
	normalization code to cope with links followed by '..'.
	[Bug 849514], and parts of [859251]

2003-12-12  David Gravereaux <davygrvy@pobox.com>

	* win/tclWinChan.c: Win32's SetFilePointer() takes LONGs not
	DWORDs (a signed/unsigned mismatch).  Redid local vars to
	avoid all casting except where truly required.

2003-12-12  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclCmdAH.c: fix to normalization of non-existent user
	name ('file normalize ~nobody') [Bug 858937]
	* doc/file.n: clarify behaviour of 'file link' when the target
	is not an absolute path.
	* doc/filename.n: correct documentation to say that Windows Tcl 
	does handle '~user', for recent Windows releases, and clarified
	distinction between MacOS 'classic' and MacOS X.
	* doc/glob.n: clarification of glob's behaviour when returning
	filenames starting with a '~'.
	
	* tests/fileSystem.test:
	* tests/fileName.test: new tests added for the normalization
	problem above and other recentlt reported issues.

	* win/tclWinFile.c: corrected unclear comments
	
	* unix/tclUnixFile.c: allow creation of relative links
	[Bug 833713]

2003-12-11  David Gravereaux <davygrvy@pobox.com>

	* win/tclWinSock.c (SocketThreadExitHandler) : added a
	TerminateThread fallback just in case the socket handler thread
	is really in a paused state.  This can happen when Tcl is being
	unloaded by the OS from an exception handler.  See MSDN docs on
	DllMain, it states this behavior.

2003-12-09  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/configure:
	* unix/tcl.m4: updated OpenBSD build configuration based on
	[Patch #775246] (cassoff)

2003-12-09  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* unix/tclUnixPort.h:	#ifdef'd out declarations of errno which
	* tools/man2tcl.c:	are known to cause problems with recent
				glibc. [Bug 852369]

2003-12-09  Vince Darley  <vincentdarley@users.sourceforge.net>

	* win/tclWinFile.c: fix to NT file permissions code [Bug 855923]
	* tests/winFile.test: added tests for NT file permissions - patch
	and test scripts supplied by Benny.
	
	* tests/winFCmd.test: fixed one test for when not running in C:/
	
2003-12-02  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made
	the numeric scan-value cache have proper references to the objects
	within it so strange patterns of writes won't cause references to
	freed objects. [Bug 851747]

2003-12-01  Miguel Sofer <msofer@users.sf.net>

	* doc/lset.n: fix typo [Bug 852224]

2003-11-24  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclParse.c:	Corrected faulty check for trailing white
	space in {expand} parsing.  Thanks Andreas Leitgeb.  [Bug 848262].
	* tests/parse.test: 	New tests for the bug.

2003-11-24  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclPathObj.c: fix to [Bug 845778] - Infinite recursion 
	on [cd] (Windows only bug), for which new tests have just been 
	added.
	
2003-11-21  Don Porter	<dgp@users.sourceforge.net>

	* tests/winFCmd.test (winFCmd-16.10,11): Merged new tests from
	core-8-4-branch.

2003-11-20  Miguel Sofer <msofer@users.sf.net>

	* generic/tclVar.c: fix flag bit collision between
	LOOKUP_FOR_UPVAR and TCL_PARSE_PART1 (deprecated) [Bug 835020] 
	
2003-11-19  Don Porter	<dgp@users.sourceforge.net>

	* tests/compile.test (compile-16.22.0):	Improved test for the
	recent fix for Bug 845412.

2003-11-19  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclCompile.c (TclCompileScript): Added a guard for the
	expansion code so that long non-expanding commands don't get
	expansion infrastructure inserted in them, especially when that
	infrastructure isn't initialised.  [Bug 845412]

2003-11-18  David Gravereaux <davygrvy@pobox.com>

	* contrib/djgpp/Makefile:		Changes from Victor Wagner
	* contrib/djgpp/langinfo.c (new):	<vitus@45.free.net> for better
	* contrib/djgpp/langinfo.h (new):	DJGPP support.
	* unix/tclUnixInit.c:			.
	* unix/tclUnixChan.c:			.
	* unix/tclUnixFCmd.c:			.

2003-11-17  Don Porter	<dgp@users.sourceforge.net>

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

2003-11-16  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclExecute.c (TclExecuteByteCode): Make sure that
	Tcl_AsyncInvoke is called regularly when processing bytecodes.
	* generic/tclTest.c (AsyncThreadProc, TestasyncCmd): Extended
	testing harness to send an asynchronous marking without relying on
	UNIX signals.
	* tests/async.test (async-4.*): Tests to check that async events
	are handled by the bytecode core. [Bug 746722]

2003-11-15  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclTest.c (TestHashSystemHashCmd): Removed 'const'
	modifier from hash type structure; it should be const and the hash
	code assumes it behaves like const, but that's not how the API is
	defined. Like this, we are following in the same footsteps as
	Tcl_RegisterObjType() which has the same conditions on its
	argument. Stops VC++5.2 warning.  [Bug 842511]

2003-11-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclHash.c (Tcl_DeleteHashTable,Tcl_HashStats,RebuildTable): 
	* generic/tclTest.c (TestHashSystemHashCmd): TIP#138 implementation, 
	* tests/misc.test:	plus a new chunk of stuff to test the hash
				functions more thoroughly in the test
				suite. [Patch 731356, modified] 

	* doc/Tcl.n: Updated Tcl version number and changebars.

2003-11-14  Don Porter	<dgp@users.sourceforge.net>

	* doc/ParseCmd.3:	Implementation of TIP 157.  Adds recognition
	* doc/Tcl.n:		of the new leading {expand} syntax on words.
	* generic/tcl.h:	Parses such words as the new Tcl_Token type
	* generic/tclBasic.c:	TCL_TOKEN_EXPAND_WORD.  Updated Tcl_EvalEx
	* generic/tclCompile.c: and the bytecode compiler/execution engine
	* generic/tclCompile.h:	to recognize the new token type.  New opcodes
	* generic/tclExecute.c:	INST_LIST_VERIFY and INST_INVOKE_EXP and a new
	* generic/tclParse.c:	operand type OPERAND_ULIST1 are defined.  Docs
	* generic/tclTest.c:	and tests are included.
	* tests/basic.test:
	* tests/compile.test:
	* tests/parse.test:

	* library/auto.tcl:	Replaced several [eval]s used to perform
	* library/package.tcl:	argument expansion with the new syntax.
	* library/safe.tcl:	In the test files lindex.test and lset.test,
	* tests/cmdInfo.test:	replaced use of [eval] to force direct
	* tests/encoding.test:	string evaluation with use of [testevalex]
	* tests/execute.test:	which more directly and robustly serves the
	* tests/fCmd.test:	same purpose.
	* tests/http.test:
	* tests/init.test:
	* tests/interp.test:
	* tests/io.test:
	* tests/ioUtil.test:
	* tests/iogt.test:
	* tests/lindex.test:
	* tests/lset.test:
	* tests/namespace-old.test:
	* tests/namespace.test:
	* tests/pkg.test:
	* tests/pkgMkIndex.test:
	* tests/proc.test:
	* tests/reg.test:
	* tests/trace.test:
	* tests/upvar.test:
	* tests/winConsole.test:
	* tests/winFCmd.test:

2003-11-12  Jeff Hobbs  <jeffh@ActiveState.com>

	* tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more
	systems are using permissions caching, and this isn't really a Tcl
	controlled issue.

2003-11-11  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/configure:
	* unix/tcl.m4: improve AIX --enable-64bit handling
	remove -D__NO_STRING_INLINES -D__NO_MATH_INLINES from
	CFLAGS_OPTIMIZE on Linux.  Make default opt -O2 (was -O).

2003-11-11  David Gravereaux <davygrvy@pobox.com>

	* contrib/djgpp/Makefile:  Suggested changes from vitus@45.free.net
	(Victor Wagner)

	* unix/tclUnixPort.h:  added socklen_t typedef for DJGPP

2003-11-10  Don Porter	<dgp@users.sourceforge.net>

        * unix/tclUnixInit.c (TclpInitLibraryPath):     
        * win/tclWinInit.c (TclpInitLibraryPath):       Fix for [Bug 832657]
        that should not run afoul of startup constraints.

        * library/dde/pkgIndex.tcl:     Added safeguards so that registry
        * library/reg/pkgIndex.tcl:     and dde packages are not offered
        * win/tclWinDde.c:      on non-Windows platforms.  Bumped to
        * win/tclWinReg.c:      registry 1.1.3 and dde 1.3.
	* win/Makefile.in:
	* win/configure.in:
	* win/makefile.bc:
	* win/makefile.vc:

	* win/configure:	autoconf (2.57)

2003-11-10  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* tests/cmdIL.test: Stopped cmdIL-5.5 from stomping over the test
	command, and updated the tests to use some tcltest2 features in
	relation to cleanup. [Bug 838384]

2003-11-10  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclCmdAH.c:
	* tests/fCmd.test: fix to misleading error message in 'file link'
	[Bug 836208]
	
2003-11-07  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclIOUtil.c: fix to compiler warning/error with
	some compilers [Bug 835918]
	
2003-11-07  Daniel Steffen  <das@users.sourceforge.net>

	* macosx/Makefile: optimized builds define NDEBUG to turn off
	ThreadAlloc range checking.

2003-11-05  Don Porter	<dgp@users.sourceforge.net>

	* tests/unixInit.test (unixInit-2.10):  New test to expose [Bug 832657]
	failure of TclpInitLibraryPath() to properly handle .. in the path
	of the executable.

2003-11-04  Daniel Steffen  <das@users.sourceforge.net>

	* macosx/Makefile: added 'test' target.

2003-11-03  Vince Darley  <vincentdarley@users.sourceforge.net>

	* generic/tclIOUtil.c
	* generic/tclInt.h: added comments and re-arranged code to
	clarify distinction between Tcl_LoadHandle, ClientData for
	'load'ed code, and point out limitations of the design 
	introduced with Tcl 8.4.
	
	* unix/tclUnixFile.c: fix to memory leak
	
	* generic/tclCmdIL.c: removed warning on Windows.
	
2003-11-01  Donal K. Fellows  <fellowsd@cs.man.ac.uk>

	* generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Check for sensible list
	lengths and allow for soft failure of the memory subsystem in the
	[lconcat] command [Bug 829027].  Uses direct list creation to
	avoid extra copies when working near the limit of available
	memory.  Also reorganized to encourage optimizing compilers to
	optimize heavily.
	* generic/tclListObj.c (TclNewListObjDirect): New list constructor
	that does not copy the array of objects. Useful for creating
	potentially very large lists or where you are about to throw away
	the array argument which is being used in its entirety.

2003-10-28  Miguel Sofer <msofer@users.sf.net>

	* generic/tclExecute.c (NEXT_INST macros): replaced macro variable
	"result" by "resultHandling" to avoid confusion.

2003-10-23  Andreas Kupries  <andreask@activestate.com>

	* unix/tclUnixChan.c (Tcl_MakeFileChannel): Applied [Patch 813606]
	  fixing [Bug 813087]. Detection of sockets was off for Mac OS X
	  which implements pipes as local sockets. The new code ensures
	  that only IP sockets are detected as such.

	* win/tclWinSock.c (TcpWatchProc): Watch for FD_CLOSE too when
	  asked for writable events by the generic layer.
	  (SocketEventProc): Generate a writable event too when a close is
	  detected.

	  Together the changes fix [Bug 599468].

2003-10-23  Vince Darley  <vincentdarley@users.sourceforge.net>

	* tests/resource.test:
	* mac/tclMacResource.c: fix to resource freeing problem in 'resource'
	command reported by Bernard Desgraupes.
	
	* doc/FileSystem.3: updated documentation for 'glob' fix on 2003-10-13
	below

2003-10-22  Donal K. Fellows  <fellowsd@cs.man.ac.uk>

	* generic/tclCmdAH.c (Tcl_FileObjCmd): Changed FILE_ prefix to FCMD_
	to stop symbol/#def clashes on Cygwin/Mingw32 on NT. [Bug 822528]

2003-10-21   Daniel Steffen  <das@users.sourceforge.net>

	* tools/tcltk-man2html.tcl: fixed incorrect html generated for
	.IP/.TP lists, now use <DL><DT>...<DD>...<P><DT>...<DD>...</DL>
	instead of illegal  <DL><P><DT>...<DD>...<P><DT>...<DD>...</DL>.
	Added skipping of directives directly after .TP to avoid them
	being used as item descriptions, e.g. .TP\n.VS in clock.n.

2003-10-21  Andreas Kupries  <andreask@pliers.activestate.com>

	* win/tclWinPipe.c (BuildCommandLine): Applied the patch coming
	  with [Bug 805605] to the code, fixing the incorrect use of
	  ispace noted by Ronald Dauster <ronaldd@users.sourceforge.net>.

2003-10-20  Kevin B. Kenny  <kennykb@users.sourceforge.net>

	* doc/msgcat.n:
	* library/msgcat/msgcat.tcl (mclocale,mcload):
	* tools/tcl.wse.in:
	* unix/Makefile.in:     Implementation of TIP#156
	* win/makefile.bc:      adding a "root locale" to
	* win/Makefile.in:      the 'msgcat' package. Advanced
	* win/Makefile.vc:      msgcat version number to 1.4.
	
2003-10-15  Donal K. Fellows  <fellowsd@cs.man.ac.uk>

	* generic/tclCmdIL.c (SortInfo,etc): Reorganized so that SortInfo
	carries an array of integer indices instead of a Tcl list.  This
	nips shimmering problems in the bud and simplifies SelectObjFromSublist
	at the cost of making setup slightly more complex. [Bug 823768]

'\"
'\" Copyright (c) 2001 Vincent Darley
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: FileSystem.3,v 1.32.4.4 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem
.SH SYNOPSIS

rename operation.
.AP "CONST char" *encodingName in
The encoding of the data stored in the
file identified by \fBpathPtr\fR and to be evaluted.
.AP "CONST char" *pattern in
Only files or directories matching this pattern will be returned by
\fBTcl_FSMatchInDirectory\fR.
.AP Tcl_GlobTypeData *types in
Only files or directories matching the type descriptions contained in
this structure will be returned by \fBTcl_FSMatchInDirectory\fR.  It
is very important that the 'directory' and 'mount' flags are properly handled.
This parameter may be NULL.
.AP Tcl_Interp *interp in
Interpreter to use either for results, evaluation, or reporting error 
messages.
.AP ClientData clientData in
The native description of the path object to create.
.AP Tcl_Obj *firstPtr in

\fBTcl_FSPathSeparator\fR returns the separator character to be used for 
most specific element of the path specified by pathPtr (i.e. the last 
part of the path).
.PP
The separator is returned as a Tcl_Obj containing a string of length
1.  If the path is invalid, NULL is returned.
.PP
\fBTcl_FSJoinPath\fR takes the given Tcl_Obj, which should be a valid
list (which is allowed to have a refCount of zero), and returns the path
object given by considering the first 'elements' elements as valid path
segments.  If elements < 0, we use the entire list.

.PP
Returns object, typically with refCount of zero (but it could be shared
under some conditions) , containing the joined path.  The caller must
add a refCount to the object before using it.  In particular, the
returned object could be an element of the given list, so freeing the
list might free the object prematurely if no refCount has been taken.
.PP
\fBTcl_FSSplitPath\fR takes the given Tcl_Obj, which should be a valid path,
and returns a Tcl List object containing each segment of that path as
an element.
.PP
Returns list object with refCount of zero.  If the passed in lenPtr is
non-NULL, we use it to return the number of elements in the returned
list.
.PP
\fBTcl_FSEqualPaths\fR tests whether the two paths given represent the same
filesystem object
.PP
It returns 1 if the paths are equal, and 0 if they are different.  If 
either path is NULL, 0 is always returned.
.PP
\fBTcl_FSGetNormalizedPath\fR this important function attempts to extract
from the given Tcl_Obj a unique normalized path representation, whose
string value can be used as a unique identifier for the file.
.PP
It returns the normalized path object, owned by Tcl, or NULL if the path
was invalid or could otherwise not be successfully converted.
Extraction of absolute, normalized paths is very efficient (because the
filesystem operates on these representations internally), although the
result when the filesystem contains numerous symbolic links may not be
the most user-friendly version of a path.  The return value is owned by
Tcl and has a lifetime equivalent to that of the \fIpathPtr\fR passed in
(unless that is a relative path, in which case the normalized path
object may be freed any time the cwd changes) - the caller can of
course increment the refCount if it wishes to maintain a copy for longer.
.PP
\fBTcl_FSJoinToPath\fR takes the given object, which should usually be a
valid path or NULL, and joins onto it the array of paths segments
given.
.PP
Returns object, typically with refCount of zero (but it could be shared
under some conditions), containing the joined path.  The caller must
add a refCount to the object before using it.  If any of the objects
passed into this function (pathPtr or path elements) have a refCount
of zero, they will be freed when this function returns.
.PP
\fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid
Tcl path type, taking account of the fact that the cwd may have changed
even if this object is already supposedly of the correct type.
The filename may begin with "~" (to indicate current user's home
directory) or "~<user>" (to indicate any user's home directory).
.PP

Returns NULL or a valid internal path representation.  This internal
representation is cached, so that repeated calls to this function will
not require additional conversions.
.PP
\fBTcl_FSGetTranslatedPath\fR attempts to extract the translated path
from the given Tcl_Obj.  
.PP
If the translation succeeds (i.e. the object is a valid path), then it is
returned.  Otherwise NULL will be returned, and an error message may be
left in the interpreter.  A "translated" path is one which contains no
"~" or "~user" sequences (these have been expanded to their current
representation in the filesystem).  The object returned is owned by the
caller, which must store it or call Tcl_DecrRefCount to ensure memory is
freed.  This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
The string returned is dynamically allocated and owned by the caller,
which must store it or call ckfree to ensure it is freed.  Again,
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSNewNativePath\fR performs something like that reverse of the
usual obj->path->nativerep conversions.  If some code retrieves a path
in native form (from, e.g. readlink or a native dialog), and that path
is to be used at the Tcl level, then calling this function is an
efficient way of creating the appropriate path object type.
.PP
The resulting object is a pure 'path' object, which will only receive 
a Utf-8 string representation if that is required by some Tcl code.
.PP
\fBTcl_FSGetNativePath\fR is for use by the Win/Unix/MacOS native
filesystems, so that they can easily retrieve the native (char* or
TCHAR*) representation of a path.  This function is a convenience
wrapper around \fBTcl_FSGetInternalRep\fR, and assumes the native
representation is string-based.  It may be desirable in the future to
have non-string-based native representations (for example, on MacOS, a
representation using a fileSpec of FSRef structure would probably be
more efficient).  On Windows a full Unicode representation would allow
for paths of unlimited length.  Currently the representation is simply a
character string which may contain either the relative path or a
complete, absolute normalized path in the native encoding (complex
conditions dictate which of these will be provided, so neither can be
relied upon, unless the path is known to be absolute).  If you need a
native path which must be absolute, then you should ask for the native
version of a normalized path.  If for some reason a non-absolute,
non-normalized version of the path is needed, that must be constructed
separately (e.g. using \fBTcl_FSGetTranslatedPath\fR).
.PP
The native representation is cached so that repeated calls to this
function will not require additional conversions.  The return value is
owned by Tcl and has a lifetime equivalent to that of the \fIpathPtr\fR
passed in (unless that is a relative path, in which case the native
representation may be freed any time the cwd changes).
.PP
\fBTcl_FSFileSystemInfo\fR returns a list of two elements.  The first
element is the name of the filesystem (e.g. "native" or "vfs" or "zip"
or "prowrap", perhaps), and the second is the particular type of the
given path within that filesystem (which is filesystem dependent).  The
second element may be empty if the filesystem does not provide a
further categorization of files.

rather results should be added to the \fIresult\fR object given
(which can be assumed to be a valid Tcl list).  The matches added
to \fIresult\fR should include any path prefix given in \fIpathPtr\fR 
(this usually means they will be absolute path specifications). 
Note that if no matches are found, that simply leads to an empty 
result --- errors are only signaled for actual file or filesystem
problems which may occur during the matching process.
.PP
There are two specific cases which it is important to handle correctly,
both when \fItypes\fR is non-NULL. The two cases are when \fItypes->types
& TCL_GLOB_TYPE_DIR\fR or \fItypes->types & TCL_GLOB_TYPE_MOUNT\fR are
true (and in particular when the other flags are false).  In the first of
these cases, the function must list the contained directories.  Tcl uses
this to implement recursive globbing, so it is critical that filesystems
implement directory matching correctly.  In the second of these cases,
with \fITCL_GLOB_TYPE_MOUNT\fR, the filesystem must list the mount points
which lie within the given \fIpathPtr\fR (and in this case, \fIpathPtr\fR
need not lie within the same filesystem - different to all other cases in
which this function is called).  Support for this is critical if Tcl is
to have seamless transitions between from one filesystem to another.
.SH UTIMEPROC       
.PP
Function to process a \fBTcl_FSUtime()\fR call.  Required to allow setting
(not reading) of times with 'file mtime', 'file atime' and the
open-r/open-w/fcopy implementation of 'file copy'.
.PP
.CS

	Tcl_Interp * \fIinterp\fR, 
	Tcl_Obj *\fIpathPtr\fR, 
	Tcl_LoadHandle * \fIhandlePtr\fR,
	Tcl_FSUnloadFileProc * \fIunloadProcPtr\fR);
.CE
.PP
Returns a standard Tcl completion code.  If an error occurs, an error
message is left in the interp's result.  The function dynamically loads a
binary code file into memory.  On a successful load, the \fIhandlePtr\fR
should be filled with a token for the dynamically loaded file, and the

\fIunloadProcPtr\fR should be filled in with the address of a procedure.
The unload procedure will be called with the given Tcl_LoadHandle as its
only parameter when Tcl needs to unload the file.  For example, for the
native filesystem, the \fBTcl_LoadHandle\fR returned is currently a token
which can be used in the private \fBTclpFindSymbol\fR to access functions
in the new code.  Each filesystem is free to define the
\fBTcl_LoadHandle\fR as it requires.
.SH UNLOADFILEPROC	    
.PP
Function to unload a previously successfully loaded file.  If load was
implemented, then this should also be implemented, if there is any
cleanup action required.
.PP
.CS

'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Hash.3,v 1.10.4.2 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
.SH SYNOPSIS

.PP
The \fIflags\fR member is one or more of the following values OR'ed together:
.IP \fBTCL_HASH_KEY_RANDOMIZE_HASH\fR 25
There are some things, pointers for example which don't hash well 
because they do not use the lower bits. If this flag is set then the
hash table will attempt to rectify this by randomising the bits and 
then using the upper N bits as the index into the table.
.VS 8.5 br
.IP \fBTCL_HASH_KEY_SYSTEM_HASH\fR 25
This flag forces Tcl to use the memory allocation 
procedures provided by the operating system when allocating
and freeing memory used to store the hash table data structures,
and not any of Tcl's own customized memory allocation routines.
This is important if the hash table is to be used in the
implementation of a custom set of allocation routines, or something
that a custom set of allocation routines might depend on, in
order to avoid any circular dependency.
.VE 8.5
.PP
The \fIhashKeyProc\fR member contains the address of a function 
called to calculate a hash value for the key.
.CS
typedef unsigned int (Tcl_HashKeyProc) (
    Tcl_HashTable *\fItablePtr\fR,
    VOID *\fIkeyPtr\fR);

'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Panic.3,v 1.3.14.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
.BS
'\"  Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp






.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "CONST char*" format in
A printf-style format string.
.AP "" arg in
Arguments matching the format string.
.AP va_list argList in

Although the primary callers of \fBTcl_Panic\fR are the procedures of
the Tcl library, \fBTcl_Panic\fR is a public function and may be called
by any extension or application that wishes to abort the process and
have a panic message displayed the same way that panic messages from Tcl
will be displayed.
.PP
\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of
taking a variable number of arguments it takes an argument list.





.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)

.SH KEYWORDS
abort, fatal, error

'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ParseCmd.3,v 1.11.2.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
.SH SYNOPSIS

number of sub-tokens that make up the word, including sub-tokens
of \fBTCL_TOKEN_VARIABLE\fR and \fBTCL_TOKEN_BS\fR tokens.
.TP
\fBTCL_TOKEN_SIMPLE_WORD\fR
This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
the word is guaranteed to consist of a single \fBTCL_TOKEN_TEXT\fR
sub-token.  The \fInumComponents\fR field is always 1.
.VS 8.5
.TP
\fBTCL_TOKEN_EXPAND_WORD\fR
This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
the command parser notes this word began with the expansion
prefix \fB{expand}\fR, indicating that after substitution,
the list value of this word should be expanded to form multiple
arguments in command evaluation.  This
token type can only be created by Tcl_ParseCommand.
.VE
.TP
\fBTCL_TOKEN_TEXT\fR
The token describes a range of literal text that is part of a word.
The \fInumComponents\fR field is always 0.
.TP
\fBTCL_TOKEN_BS\fR
The token describes a backslash sequence such as \fB\en\fR or \fB\e0xa3\fR.

\fIx\fR, \fIy\fR, and \fIz\fR.
The \fInumComponents\fR field for a \fBTCL_TOKEN_OPERATOR\fR token
is always 0.
.PP
After \fBTcl_ParseCommand\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
Tcl_Parse structure always has type \fBTCL_TOKEN_WORD\fR or
.VS 8.5
\fBTCL_TOKEN_SIMPLE_WORD\fR or \fBTCL_TOKEN_EXPAND_WORD\fR.  
It is followed by the sub-tokens
that must be concatenated to produce the value of that word.
The next token is the \fBTCL_TOKEN_WORD\fR or \fBTCL_TOKEN_SIMPLE_WORD\fR
of \fBTCL_TOKEN_EXPAND_WORD\fR token for the second word,
followed by sub-tokens for that
word, and so on until all \fInumWords\fR have been accounted
for.
.VE 8.5
.PP
After \fBTcl_ParseExpr\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
Tcl_Parse structure always has type \fBTCL_TOKEN_SUB_EXPR\fR.
It is followed by the sub-tokens that must be evaluated
to produce the value of the expression.
Only the token information in the Tcl_Parse structure

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Tcl.n,v 1.9.4.1 2004/02/07 05:47:59 dgp Exp $
'\"
.so man.macros
.TH Tcl n "8.5" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
Tcl \- Tool Command Language
.SH SYNOPSIS
Summary of Tcl language syntax.
.BE
.SH DESCRIPTION

the word is terminated by the next double-quote character.
If semi-colons, close brackets, or white space characters
(including newlines) appear between the quotes then they are treated
as ordinary characters and included in the word.
Command substitution, variable substitution, and backslash substitution
are performed on the characters between the quotes as described below.
The double-quotes are not retained as part of the word.
.VS 8.5 br
.IP "[5] \fBArgument expansion.\fR"
If a word starts with the string ``{expand}'' followed by a 
non-whitespace character, then the leading ``{expand}'' is removed
and the rest of the word is parsed and substituted as any other other 
word. After substitution, the word is parsed again without
substitutions, and its words are added to the command being
substituted. For instance, ``cmd a {expand}{b c} d {expand}{e f}'' is
equivalent to ``cmd a b c d e f''. 
.VE 8.5
.IP "[6] \fBBraces.\fR"
If the first character of a word is an open brace (``{'') and
rule [5] does not apply, then
the word is terminated by the matching close brace (``}'').
Braces nest within the word: for each additional open
brace there must be an additional close brace (however,
if an open brace or close brace within the word is
quoted with a backslash then it is not counted in locating the
matching close brace).
No substitutions are performed on the characters between the
braces except for backslash-newline substitutions described
below, nor do semi-colons, newlines, close brackets,
or white space receive any special interpretation.
The word will consist of exactly the characters between the
outer braces, not including the braces themselves.
.IP "[7] \fBCommand substitution.\fR"
If a word contains an open bracket (``['') then Tcl performs
\fIcommand substitution\fR.
To do this it invokes the Tcl interpreter recursively to process
the characters following the open bracket as a Tcl script.
The script may contain any number of commands and must be terminated
by a close bracket (``]'').
The result of the script (i.e. the result of its last command) is
substituted into the word in place of the brackets and all of the
characters between them.
There may be any number of command substitutions in a single word.
Command substitution is not performed on words enclosed in braces.
.IP "[8] \fBVariable substitution.\fR"
If a word contains a dollar-sign (``$'') then Tcl performs \fIvariable
substitution\fR:  the dollar-sign and the following characters are
replaced in the word by the value of a variable.
Variable substitution may take any of the following forms:
.RS
.TP 15
\fB$\fIname\fR

\fB${\fIname\fB}\fR
\fIName\fR is the name of a scalar variable.  It may contain any
characters whatsoever except for close braces.
.LP
There may be any number of variable substitutions in a single word.
Variable substitution is not performed on words enclosed in braces.
.RE
.IP "[9] \fBBackslash substitution.\fR"
If a backslash (``\e'') appears within a word then
\fIbackslash substitution\fR occurs.
In all cases but those described below the backslash is dropped and
the following character is treated as an ordinary
character and included in the word.
This allows characters such as double quotes, close brackets,
and dollar signs to be included in words without triggering

is replaced in a separate pre-pass before the command is actually parsed.
This means that it will be replaced even when it occurs between braces,
and the resulting space will be treated as a word separator if it isn't
in braces or quotes.
.TP 7
\e\e
Backslash (``\e'').

.TP 7
\e\fIooo\fR 
.
The digits \fIooo\fR (one, two, or three of them) give an eight-bit octal 
value for the Unicode character that will be inserted.  The upper bits of the
Unicode character will be 0.
.TP 7
\e\fBx\fIhh\fR 
.
The hexadecimal digits \fIhh\fR give an eight-bit hexadecimal value for the
Unicode character that will be inserted.  Any number of hexadecimal digits
may be present; however, all but the last two are ignored (the result is
always a one-byte quantity).  The upper bits of the Unicode character will
be 0.
.TP 7
\e\fBu\fIhhhh\fR 
.
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
inserted.

.LP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE
.IP "[10] \fBComments.\fR"
If a hash character (``#'') appears at a point where Tcl is
expecting the first character of the first word of a command,
then the hash character and the characters that follow it, up
through the next newline, are treated as a comment and ignored.
The comment character only has significance when it appears
at the beginning of a command.
.IP "[11] \fBOrder of substitution.\fR"
Each character is processed exactly once by the Tcl interpreter
as part of creating the words of a command.
For example, if variable substitution occurs then no further
substitutions are performed on the value of the variable;  the
value is inserted into the word verbatim.
If command substitution occurs then the nested command is
processed entirely by the recursive call to the Tcl interpreter;
no substitutions are performed before making the recursive
call and no additional substitutions are performed on the result
of the nested script.
.RS
.LP
Substitutions take place from left to right, and each substitution is
evaluated completely before attempting to evaluate the next.  Thus, a
sequence like
.CS
set y [set x 0][incr x][incr x]
.CE
will always set the variable \fIy\fR to the value, \fI012\fR.
.RE
.IP "[12] \fBSubstitution and word boundaries.\fR"
Substitutions do not affect the word boundaries of a command,
except for argument expansion as specified in rule [5].
For example, during variable substitution the entire value of
the variable becomes part of a single word, even if the variable's
value contains spaces.

'\"
'\" Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" Copyright (c) 2002 ActiveState Corporation
'\"
'\" This documentation is derived from the time and date facilities of
'\" TclX, by Mark Diekhans and Karl Lehenbauer.
'\" 
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: clock.n,v 1.12.2.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH clock n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
clock \- Obtain and manipulate time

speed up the clock frequency slightly until it's back in synchronization.
For this reason, most Tcl programmers need never worry about such
phenomena as leap seconds.
.VE 8.5
.TP
\fBclock format \fIclockValue\fR ?\fB\-format \fIstring\fR? ?\fB\-gmt \fIboolean\fR?
Converts an integer time value, typically returned by
\fBclock seconds\fR, \fBclock scan\fR, or the \fBatime\fR or \fBmtime\fR
options of the \fBfile\fR command, to human-readable
form.  If the \fB\-format\fR argument is present the next argument is a
string that describes how the date and time are to be formatted.
Field descriptors consist of a \fB%\fR followed by a field
descriptor character.  All other characters are copied into the result.
Valid field descriptors are:
.RS
.IP \fB%%\fR

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: file.n,v 1.24.2.2 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH file n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
file \- Manipulate file names and attributes

.RS
The first form makes a copy of the file or directory \fIsource\fR under
the pathname \fItarget\fR. If \fItarget\fR is an existing directory,
then the second form is used.  The second form makes a copy inside
\fItargetDir\fR of each \fIsource\fR file listed.  If a directory is
specified as a \fIsource\fR, then the contents of the directory will be
recursively copied into \fItargetDir\fR. Existing files will not be
overwritten unless the \fB\-force\fR option is specified (when Tcl will
also attempt to adjust permissions on the destination file or directory
if that is necessary to allow the copy to proceed).  When copying
within a single filesystem, \fIfile copy\fR will copy soft links (i.e.
the links themselves are copied, not the things they point to).  Trying
to overwrite a non-empty directory, overwrite a directory with a file,
or overwrite a file with a directory will all result in errors even if
\fI\-force\fR was specified.  Arguments are processed in the order
specified, halting at the first error, if any.  A \fB\-\|\-\fR marks
the end of switches; the argument following the \fB\-\|\-\fR will be
treated as a \fIsource\fR even if it starts with a \fB\-\fR.
.RE
.TP
\fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIpathname\fR ?\fIpathname\fR ... ?

If only one argument is given, that argument is assumed to be
\fIlinkName\fR, and this command returns the value of the link given by
\fIlinkName\fR (i.e. the name of the file it points to).  If
\fIlinkName\fR isn't a link or its value cannot be read (as, for example,
seems to be the case with hard links, which look just like ordinary
files), then an error is returned.
.
If 2 arguments are given, then these are assumed to be \fIlinkName\fR
and \fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR
doesn't exist, an error will be returned.  Otherwise, Tcl creates a new
link called \fIlinkName\fR which points to the existing filesystem
object at \fItarget\fR (which is also the returned value), where the
type of the link is platform-specific (on Unix a symbolic link will be
the default).  This is useful for the case where the user wishes to
create a link in a cross-platform way, and doesn't care what type of
link is created.
.
If the user wishes to make a link of a specific type only, (and signal an
error if for some reason that is not possible), then the optional
\fI-linktype\fR argument should be given.  Accepted values for
\fI-linktype\fR are "-symbolic" and "-hard".
.
On Unix, symbolic links can be made to relative paths, and those paths
must be relative to the actual \fIlinkName\fR's location (not to the
cwd), but on all other platforms where relative links are not supported,
target paths will always be converted to absolute, normalized form
before the link is created (and therefore relative paths are interpreted
as relative to the cwd).  Furthermore, "~user" paths are always expanded
to absolute form.  When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
error message will be returned.  In particular Windows 95, 98 and ME do
not support any links at present, but most Unix platforms support both
symbolic and hard links (the latter for files only), MacOS supports
symbolic links and Windows NT/2000/XP (on NTFS drives) support symbolic
directory links and hard file links.
.TP
\fBfile lstat \fIname varName\fR
.
Same as \fBstat\fR option (see below) except uses the \fIlstat\fR
kernel call instead of \fIstat\fR.  This means that if \fIname\fR
refers to a symbolic link the information returned in \fIvarName\fR
is for the link rather than the file it refers to.  On systems that

see the manual entry for \fBstat\fR for details on the meanings of the
values.  The \fBtype\fR element gives the type of the file in the same
form returned by the command \fBfile type\fR.  This command returns an
empty string.
.TP
\fBfile system \fIname\fR
.
Returns a list of one or two elements, the first of which is the name of
the filesystem to use for the file, and the second, if given, an
arbitrary string representing the filesystem-specific nature or type of
the location within that filesystem.  If a filesystem only supports one
type of file, the second element may not be supplied.  For example the
native files have a first element 'native', and a second element which
when given is a platform-specific type name for the file's system (e.g.

'NTFS', 'FAT', on Windows).  A generic virtual file system might return
the list 'vfs ftp' to represent a file on a remote ftp site mounted as a
virtual filesystem through an extension called 'vfs'.  If the file does
not belong to any filesystem, an error is generated.
.TP
\fBfile tail \fIname\fR
.
Returns all of the characters in the last filesystem component of
\fIname\fR.  Any trailing directory separator in \fIname\fR is ignored.

'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: filename.n,v 1.7.14.2 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH filename n 7.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
filename \- File name conventions supported by Tcl commands

.SH "PATH SYNTAX"
.PP
The rules for native names depend on the value reported in the Tcl
array element \fBtcl_platform(platform)\fR:
.TP 10
\fBmac\fR
On Apple Macintosh Classic systems (i.e. with MacOS 9.x or older), Tcl
supports two forms of path names.  The normal Mac style names use colons
as path separators.  Paths may be relative or absolute, and file names
may contain any character other than colon.  A leading colon causes the
rest of the path to be interpreted relative to the current directory.
If a path contains a colon that is not at the beginning, then the path
is interpreted as an absolute path.  Sequences of two or more colons
anywhere in the path are used to construct relative paths where \fB::\fR
refers to the parent of the current directory, \fB:::\fR refers to the
parent of the parent, and so forth.
.RS
.PP
In addition to Macintosh style names, Tcl also supports a subset of
Unix-like names.  If a path contains no colons, then it is interpreted
like a Unix path.  Slash is used as the path separator.  The file name
\fB\&.\fR refers to the current directory, and \fB\&..\fR refers to the
parent of the current directory.  However, some names like \fB/\fR or

.TP 15
\fB\&../MyFile\fR
Relative path to a file named \fBMyFile\fR in the folder above the
current folder.
.RE
.TP
\fBunix\fR
On Unix and Apple MacOS X platforms, Tcl uses path names where the
components are separated by slashes.  Path names may be relative or
absolute, and file names may contain any character other than slash.
The file names \fB\&.\fR and \fB\&..\fR are special and refer to the
current directory and the parent of the current directory respectively.
Multiple adjacent slash characters are interpreted as a single
separator.  The following examples illustrate various forms of path
names:
.RS
.TP 15
\fB/\fR
Absolute path to the root directory.
.TP 15
\fB/etc/passwd\fR
Absolute path to the file named \fBpasswd\fR in the directory

volume.  This is not a valid UNC path, so the assumption is that the
extra backslashes are superfluous.
.RE

.SH "TILDE SUBSTITUTION"
.PP
In addition to the file name rules described above, Tcl also supports
\fIcsh\fR-style tilde substitution.  If a file name starts with a tilde,
then the file name will be interpreted as if the first element is
replaced with the location of the home directory for the given user.  If
the tilde is followed immediately by a separator, then the \fB$HOME\fR
environment variable is substituted.  Otherwise the characters between
the tilde and the next separator are taken as a user name, which is used
to retrieve the user's home directory for substitution.  This works on
Unix, MacOS X and Windows (except very old releases).
.PP
The Classic Macintosh (OS 9 and older) platform and old Windows
platforms do not support tilde substitution when a user name follows the
tilde.  On these platforms, attempts to use a tilde followed by a user
name will generate an error that the user does not exist when Tcl
attempts to interpret that part of the path or otherwise access the

file.  The behaviour of these paths when not trying to interpret them is
the same as on Unix.  File names that have a tilde without a user name
will be correctly substituted using the \fB$HOME\fR environment
variable, just like for Unix.

.SH "PORTABILITY ISSUES"
.PP
Not all file systems are case sensitive, so scripts should avoid code
that depends on the case of characters in a file name.  In addition,
the character sets allowed on different devices may differ, so scripts
should choose file names that do not contain special characters like:

On Windows platforms there are file and path length restrictions. 
Complete paths or filenames longer than about 260 characters will lead
to errors in most file operations.
.PP
Another Windows peculiarity is that any number of trailing dots '.'  in
filenames are totally ignored, so, for example, attempts to create a
file or directory with a name "foo." will result in the creation of a
file/directory with name "foo".  This fact is reflected in in the
results of 'file normalize'.  Furthermore, a file name consisting only
of dots '.........' or dots with trailing characters '.....abc' is
illegal.
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability

.SH "SEE ALSO"
file(n), glob(n)

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: glob.n,v 1.12.4.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH glob n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
glob \- Return names of files that match patterns

.LP
The \fBglob\fR command differs from csh globbing in two ways.
First, it does not sort its result list (use the \fBlsort\fR
command if you want the list sorted).
Second, \fBglob\fR only returns the names of files that actually
exist;  in csh no check for existence is made unless a pattern
contains a ?, *, or [] construct.
.LP
When the \fBglob\fR command returns relative paths whose filenames
start with a tilde ``~'' (for example through \fBglob *\fR or 
\fBglob -tails\fR, the returned list will not quote the tilde with
``./''.  This means care must be taken if those names are later to
be used with \fBfile join\fR, to avoid them being interpreted as
absolute paths pointing to a given user's home directory.

.SH "PORTABILITY ISSUES"
.PP
Unlike other Tcl commands that will accept both network and native
style names (see the \fBfilename\fR manual entry for details on how
native and network names are specified), the \fBglob\fR command only
accepts native names.  

'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans
'\" Copyright (c) 2004 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: lassign.n,v 1.1.2.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH lassign n 8.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lassign \- Assign list elements to variables
.SH SYNOPSIS
\fBlassign \fIlist varName \fR?\fIvarName ...\fR?
.BE

.SH DESCRIPTION
.PP
This command treats the value \fIlist\fR as a list and assigns
successive elements from that list to the variables given by the
\fIvarName\fR arguments in order.  If there are more variable names
than list elements, the remaining variables are set to the empty
string.  If there are more list elements than variables, a list of
unassigned elements is returned.
.SH EXAMPLES
An illustration of how multiple assignment works, and what happens
when there are either too few or too many elements.
.CS
lassign {a b c} x y z       ;# Empty return
puts $x                     ;# Prints "a"
puts $y                     ;# Prints "b"
puts $z                     ;# Prints "c"

lassign {d e} x y z         ;# Empty return
puts $x                     ;# Prints "d"
puts $y                     ;# Prints "e"
puts $z                     ;# Prints ""

lassign {f g h i} x y       ;# Returns "h i"
puts $x                     ;# Prints "f"
puts $y                     ;# Prints "g"
.CE
The \fBlassign\fR command has other uses.  It can be used to create
the analogue of the "shift" command in many shell languages like this:
.CS
set ::argv [lassign $::argv argumentToReadOff]
.CE
.SH "SEE ALSO"
lindex(n), list(n), lset(n), set(n)

.SH KEYWORDS
assign, element, list, multiple, set, variable

'\"
'\" Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: lset.n,v 1.6.4.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lset \- Change an element in a list

.CS
lset varName {} newValue
.CE
In this case, \fInewValue\fR replaces the old value of the variable
\fIvarName\fR.
.PP
When presented with a single index, the \fBlset\fR command
treats the content of the \fIvarName\fR variable as a Tcl list.
It addresses the \fIindex\fR'th element in it 
(0 refers to the first element of the list).
When interpreting the list, \fBlset\fR observes the same rules
concerning braces and quotes and backslashes as the Tcl command
interpreter; however, variable
substitution and command substitution do not occur.
The command constructs a new list in which the designated element is

'\"
'\" Copyright (c) 1998 Mark Harrison.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) msgcat.n
'\" 
.so man.macros
.TH "msgcat" n 1.4 msgcat "Tcl Bundled Packages"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.2\fR
.sp
\fBpackage require msgcat 1.4\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp

Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
preference.  The list is derived from the current
locale set in msgcat by \fBmsgcat::mclocale\fR, and
cannot be set independently.  For example, if the
current locale is en_US_funky, then \fBmsgcat::mcpreferences\fR
.VS 1.4
returns \fB{en_US_funky en_US en {}}\fR.
.VE
.TP
\fB::msgcat::mcload \fIdirname\fR
Searches the specified directory for files that match
the language specifications returned by \fB::msgcat::mcpreferences\fR
(note that these are all lowercase), extended by the file
extension ``.msg''.  Each matching file is 
read in order, assuming a UTF-8 encoding.  The file contents are

attempt to extract locale information from the
registry.  If all these attempts to discover an initial locale
from the user's environment fail, msgcat defaults to an initial
locale of ``C''.
.PP
When a locale is specified by the user, a ``best match'' search is
performed during string translation.  For example, if a user specifies
.VS 1.4
en_GB_Funky, the locales ``en_GB_Funky'', ``en_GB'', ``en'' and ``''
(the empty string)
.VE
are searched in order until a matching translation
string is found.  If no translation string is available, then
\fB::msgcat::unknown\fR is called.

.SH "NAMESPACES AND MESSAGE CATALOGS"
.PP
Strings stored in the message catalog are stored relative
to the namespace from which they were added.  This allows
multiple packages to use the same strings without fear
of collisions with other packages.  It also allows the

.IP [2]
The message file name is a msgcat locale specifier (all lowercase)
followed by ``.msg''.  For example:
.CS
es.msg    -- spanish
en_gb.msg -- United Kingdom English
.CE
.VS
\fIException:\fR The message file for the root locale ``'' is
called \fBROOT.msg\fR.  This exception is made so as not to
cause peculiar behavior, such as marking the message file as
``hidden'' on Unix file systems.
.VE
.IP [3]
The file contains a series of calls to \fBmcset\fR and
\fBmcmset\fR, setting the necessary translation strings
for the language, likely enclosed in a \fBnamespace eval\fR
so that all source strings are tied to the namespace of
the package. For example, a short \fBes.msg\fR might contain:
.CS

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: switch.n,v 1.5.20.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH switch n 7.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
switch \- Evaluate one of several scripts, depending on a given value

When matching \fIstring\fR to the patterns, use glob-style matching
(i.e. the same as implemented by the \fBstring match\fR command).
.TP 10
\fB\-regexp\fR
When matching \fIstring\fR to the patterns, use regular
expression matching
(as described in the \fBre_syntax\fR reference page).
'\" Options defined by TIP#75
.VS 8.5
.TP 10
\fB\-matchvar\fR \fIvarName\fR
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of matches
found by the regular expression engine will be written.  The first
element of the list written will be the overall substring of the input
string (i.e. the \fIstring\fR argument to \fBswitch\fR) matched, the
second element of the list will be the substring matched by the first
capturing parenthesis in the regular expression that matched, and so
on.  When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it.  This option may be specified at the same
time as the \fB\-indexvar\fR option.
.TP 10
\fB\-indexvar\fR \fIvarName\fR
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of indices
referring to matching substrings
found by the regular expression engine will be written.  The first
element of the list written will be a two-element list specifying the
index of the start and index of the first character after the end of
the overall substring of the input
string (i.e. the \fIstring\fR argument to \fBswitch\fR) matched, in a
similar way to the \fB\-indices\fR option to the \fBregexp\fR can
obtain.  Similarly, the second element of the list refers to the first
capturing parenthesis in the regular expression that matched, and so
on.  When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it.  This option may be specified at the same
time as the \fB\-matchvar\fR option.
.VE 8.5
.TP 10
\fB\-\|\-\fR
Marks the end of options.  The argument following this one will
be treated as \fIstring\fR even if it starts with a \fB\-\fR.
.PP
Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: tclvars.n,v 1.13.4.1 2004/02/07 05:47:59 dgp Exp $
'\" 
.so man.macros
.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tclvars \- Variables used by Tcl

.TP
\fBbyteOrder\fR
The native byte order of this machine: either \fBlittleEndian\fR or
\fBbigEndian\fR. 
.VE
.TP
\fBdebug\fR
If this variable exists, then the interpreter was compiled with and linked
to a debug enabled C run-time.  This variable will only exist on Windows,
so extension writers can specify which package to load depending on the
C run-time library that is in use.  This is not an indication that this core
contains symbols.
.TP
\fBmachine\fR
The instruction set executed by this machine, such as
\fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR.  On UNIX machines, this
is the value returned by \fBuname -m\fR.
.TP
\fBos\fR 

	slist = NULL;
	for (a = pre->outs; a != NULL; a = a->outchain) {
		s = a->to;
		for (b = s->ins; b != NULL; b = b->inchain)
			if (b->from != pre)
				break;
		if (b != NULL) {		/* must be split */
			if (s->tmp == NULL) {  /* if not already in the list */
			                       /* (fixes bugs 505048, 230589, */
			                       /* 840258, 504785) */
				s->tmp = slist;
				slist = s;
			}
		}
	}

	/* do the splits */
	for (s = slist; s != NULL; s = s2) {
		s2 = newstate(nfa);
		copyouts(nfa, s, s2);

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h,
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.97.2.5 2004/02/07 05:47:59 dgp Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

declare 461 generic {
    Tcl_Obj* Tcl_FSSplitPath(Tcl_Obj* pathPtr, int *lenPtr)
}
declare 462 generic {
    int Tcl_FSEqualPaths(Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)
}
declare 463 generic {
    Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
}
declare 464 generic {
    Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
	    Tcl_Obj *CONST objv[])
}
declare 465 generic {
    ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathPtr,
	    Tcl_Filesystem *fsPtr)
}
declare 466 generic {
    Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
}
declare 467 generic {
    int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
declare 468 generic {
    Tcl_Obj* Tcl_FSNewNativePath(Tcl_Filesystem* fromFilesystem,
	    ClientData clientData)
}
declare 469 generic {
    CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathPtr)
}
declare 470 generic {
    Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathPtr)
}
declare 471 generic {
    Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathPtr)
}
declare 472 generic {
    Tcl_Obj* Tcl_FSListVolumes(void)
}
declare 473 generic {
    int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
}
declare 474 generic {
    int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
}
declare 475 generic {
    ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
}
declare 476 generic {
    CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj* pathPtr)
}
declare 477 generic {
    Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathPtr)
}
declare 478 generic {
    Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
}
# New function due to TIP#49
declare 479 generic {
    int Tcl_OutputBuffered(Tcl_Channel chan)
}
declare 480 generic {
    void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tcl.h,v 1.157.2.6 2004/02/07 05:48:00 dgp Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"

 * When version numbers change here, must also go into the following files
 * and update the version numbers:
 *
 * library/init.tcl	(only if Major.minor changes, not patchlevel) 1 LOC
 * unix/configure.in	(2 LOC Major, 2 LOC minor, 1 LOC patch)
 * win/configure.in	(as above)
 * win/tcl.m4		(not patchlevel)

 * win/makefile.bc	(not patchlevel) 2 LOC
 * README		(sections 0 and 2)
 * mac/README		(2 LOC, not patchlevel)
 * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 2 LOC
 * win/README.binary	(sections 0-4)
 * win/README		(not patchlevel) (sections 0 and 2)
 * unix/tcl.spec	(2 LOC Major/Minor, 1 LOC patch)

 * TCL_HASH_KEY_RANDOMIZE_HASH:
 *				There are some things, pointers for example
 *				which don't hash well because they do not use
 *				the lower bits. If this flag is set then the
 *				hash table will attempt to rectify this by
 *				randomising the bits and then using the upper
 *				N bits as the index into the table.
 * TCL_HASH_KEY_SYSTEM_HASH:
 *				If this flag is set then all memory internally
 *                              allocated for the hash table that is not for an
 *                              entry will use the system heap.
 */
#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
#define TCL_HASH_KEY_SYSTEM_HASH    0x2

/*
 * Structure definition for the methods associated with a hash table
 * key type.
 */
#define TCL_HASH_KEY_TYPE_VERSION 1
struct Tcl_HashKeyType {

#define TCL_TOKEN_SIMPLE_WORD	2
#define TCL_TOKEN_TEXT		4
#define TCL_TOKEN_BS		8
#define TCL_TOKEN_COMMAND	16
#define TCL_TOKEN_VARIABLE	32
#define TCL_TOKEN_SUB_EXPR	64
#define TCL_TOKEN_OPERATOR	128
#define TCL_TOKEN_EXPAND_WORD	256

/*
 * Parsing error types.  On any parsing error, one of these values
 * will be stored in the error field of the Tcl_Parse structure
 * defined below.
 */
#define TCL_PARSE_SUCCESS		0

typedef struct Tcl_Config {
    CONST char* key;   /* Configuration key to register. ASCII encoded, thus UTF-8 */
    CONST char* value; /* The value associated with the key. System encoding */
} Tcl_Config;


#ifndef TCL_NO_DEPRECATED

    /*
     * Deprecated Tcl procedures:
     */

#   define Tcl_EvalObj(interp,objPtr) \
	Tcl_EvalObjEx((interp),(objPtr),0)
#   define Tcl_GlobalEvalObj(interp,objPtr) \
	Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)



    /*
     * These function have been renamed. The old names are deprecated, but
     * we define these macros for backwards compatibilty.
     */

#   define Tcl_Ckalloc Tcl_Alloc
#   define Tcl_Ckfree Tcl_Free
#   define Tcl_Ckrealloc Tcl_Realloc
#   define Tcl_Return Tcl_SetResult
#   define Tcl_TildeSubst Tcl_TranslateFileName
#   define panic Tcl_Panic
#   define panicVA Tcl_PanicVA
#endif


/*
 * The following constant is used to test for older versions of Tcl
 * in the stubs tables.
 *
 * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different

 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclAlloc.c,v 1.16.4.1 2004/02/07 05:48:00 dgp Exp $
 */

/*
 * Windows and Unix use an alternative allocator when building with threads
 * that has significantly reduced lock contention.
 */

 */

static	unsigned int nmalloc[NBUCKETS+1];
#include <stdio.h>
#endif

#if defined(DEBUG) || defined(RCHECK)
#define	ASSERT(p)   if (!(p)) Tcl_Panic(# p)
#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
#else
#define	ASSERT(p)
#define RANGE_ASSERT(p)
#endif

/*
 * Prototypes for functions used only in this file.

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.82.2.6 2004/02/07 05:48:00 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#ifndef TCL_GENERIC_ONLY
#   include "tclPort.h"
#endif

        TclCompileIncrCmd,		1},
    {"info",		(Tcl_CmdProc *) NULL,	Tcl_InfoObjCmd,
        (CompileProc *) NULL,		1},
    {"join",		(Tcl_CmdProc *) NULL,	Tcl_JoinObjCmd,
        (CompileProc *) NULL,		1},
    {"lappend",		(Tcl_CmdProc *) NULL,	Tcl_LappendObjCmd,
        TclCompileLappendCmd,		1},
    {"lassign",		(Tcl_CmdProc *) NULL,	Tcl_LassignObjCmd,
        TclCompileLassignCmd,		1},
    {"lindex",		(Tcl_CmdProc *) NULL,	Tcl_LindexObjCmd,
        TclCompileLindexCmd,		1},
    {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
        (CompileProc *) NULL,		1},
    {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
        TclCompileListCmd,		1},
    {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,

    /*
     * Panic if someone updated the CallFrame structure without
     * also updating the Tcl_CallFrame structure (or vice versa).
     */  

    if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
	/*NOTREACHED*/
        Tcl_Panic("Tcl_CallFrame and CallFrame are not the same size");
    }

    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the
     * Tcl object type table and other object management code.
     */

    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->resultSpace[0] = 0;

    iPtr->globalNsPtr = NULL;	/* force creation of global ns below */
    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
	    (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
    if (iPtr->globalNsPtr == NULL) {
        Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
    }

    /*
     * Initialize support for code compilation and execution. We call
     * TclCreateExecEnv after initializing namespaces since it tries to
     * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
     * variable).

	    cmdInfoPtr++) {
	int new;
	Tcl_HashEntry *hPtr;

	if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL)
	        && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
	        && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
	    Tcl_Panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n");
	}
	
	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
	        cmdInfoPtr->name, &new);
	if (new) {
	    cmdPtr = (Command *) ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;

	    builtinFuncPtr++) {
	Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name,
		builtinFuncPtr->numArgs, builtinFuncPtr->argTypes,
		(Tcl_MathProc *) NULL, (ClientData) 0);
	hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
		builtinFuncPtr->name);
	if (hPtr == NULL) {
	    Tcl_Panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", builtinFuncPtr->name);
	    return NULL;
	}
	mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
	mathFuncPtr->builtinFuncIndex = i;
	i++;
    }
    iPtr->flags |= EXPR_INITIALIZED;

    ResolverScheme *resPtr, *nextResPtr;

    /*
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
     */
    
    if (iPtr->numLevels > 0) {
        Tcl_Panic("DeleteInterpProc called with active evals");
    }

    /*
     * The interpreter should already be marked deleted; otherwise how
     * did we get here?
     */

    if (!(iPtr->flags & DELETED)) {
        Tcl_Panic("DeleteInterpProc called on interpreter not marked deleted");
    }

    TclHandleFree(iPtr->handle);

    /*
     * Dismantle everything in the global namespace except for the
     * "errorInfo" and "errorCode" variables. These remain until the

     * 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_AppendStringsToObj(Tcl_GetObjResult(interp),
                "trying to expose a non global command name space command",
		(char *) NULL);
        return TCL_ERROR;
    }
    

/* 
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBinary.c,v 1.13.4.1 2004/02/07 05:48:00 dgp Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <math.h>

/*

static int		GetFormatSpec _ANSI_ARGS_((char **formatPtr,
			    char *cmdPtr, int *countPtr));
static Tcl_Obj *	ScanNumber _ANSI_ARGS_((unsigned char *buffer,
			    int type, Tcl_HashTable **numberCachePtr));
static int		SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
static void		UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
static void		DeleteScanNumberCache _ANSI_ARGS_((
			    Tcl_HashTable *numberCachePtr));

/*
 * The following object type represents an array of bytes.  An array of
 * bytes is not equivalent to an internationalized string.  Conceptually, a
 * string is an array of 16-bit quantities organized as a sequence of properly
 * formed UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
 * Accessor functions are provided to convert a ByteArray to a String or a

    int length;			/* Length of the array of bytes, which must
				 * be >= 0. */
{
    Tcl_ObjType *typePtr;
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("Tcl_SetByteArrayObj called with shared object");
    }
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    Tcl_InvalidateStringRep(objPtr);

Tcl_SetByteArrayLength(objPtr, length)
    Tcl_Obj *objPtr;		/* The ByteArray object. */
    int length;			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr, *newByteArrayPtr;
    
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("Tcl_SetObjLength called with shared object");
    }
    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {

			} else {
			    offset = count;
			}
			break;
		    }
		    default: {
			errorString = str;
			goto badField;
		    }
		}
	    }
	    if (offset > length) {
		length = offset;
	    }
	    if (length == 0) {

		}
		switch (cmd) {
		    case 'a':
		    case 'A': {
			unsigned char *src;

			if (arg >= objc) {
			    DeleteScanNumberCache(numberCachePtr);


			    goto badIndex;
			}
			if (count == BINARY_ALL) {
			    count = length - offset;
			} else {
			    if (count == BINARY_NOCOUNT) {
				count = 1;

			    }
			}
			valuePtr = Tcl_NewByteArrayObj(src, size);
			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
			arg++;
			if (resultPtr == NULL) {
			    DeleteScanNumberCache(numberCachePtr);


			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
			    return TCL_ERROR;
			}
			offset += count;
			break;
		    }
		    case 'b':
		    case 'B': {
			unsigned char *src;
			char *dest;

			if (arg >= objc) {
			    DeleteScanNumberCache(numberCachePtr);


			    goto badIndex;
			}
			if (count == BINARY_ALL) {
			    count = (length - offset) * 8;
			} else {
			    if (count == BINARY_NOCOUNT) {
				count = 1;

			    }
			}
			
			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
			arg++;
			if (resultPtr == NULL) {
			    DeleteScanNumberCache(numberCachePtr);


			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
			    return TCL_ERROR;
			}
			offset += (count + 7 ) / 8;
			break;
		    }
		    case 'h':
		    case 'H': {
			char *dest;
			unsigned char *src;
			int i;
			static char hexdigit[] = "0123456789abcdef";

			if (arg >= objc) {
			    DeleteScanNumberCache(numberCachePtr);


			    goto badIndex;
			}
			if (count == BINARY_ALL) {
			    count = (length - offset)*2;
			} else {
			    if (count == BINARY_NOCOUNT) {
				count = 1;

			    }
			}
			
			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
			arg++;
			if (resultPtr == NULL) {
			    DeleteScanNumberCache(numberCachePtr);


			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
			    return TCL_ERROR;
			}
			offset += (count + 1) / 2;
			break;
		    }
		    case 'c': {

			unsigned char *src;

			size = sizeof(double);
			/* fall through */
			
			scanNumber:
			if (arg >= objc) {
			    DeleteScanNumberCache(numberCachePtr);


			    goto badIndex;
			}
			if (count == BINARY_NOCOUNT) {
			    if ((length - offset) < size) {
				goto done;
			    }
			    valuePtr = ScanNumber(buffer+offset, cmd,

			    offset += count*size;
			}

			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
			arg++;
			if (resultPtr == NULL) {
			    DeleteScanNumberCache(numberCachePtr);


			    Tcl_DecrRefCount(valuePtr);	/* unneeded */
			    return TCL_ERROR;
			}
			break;
		    }
		    case 'x': {
			if (count == BINARY_NOCOUNT) {

			} else {
			    offset -= count;
			}
			break;
		    }
		    case '@': {
			if (count == BINARY_NOCOUNT) {
			    DeleteScanNumberCache(numberCachePtr);


			    goto badCount;
			}
			if ((count == BINARY_ALL) || (count > length)) {
			    offset = length;
			} else {
			    offset = count;
			}
			break;
		    }
		    default: {
			DeleteScanNumberCache(numberCachePtr);


			errorString = str;
			goto badField;
		    }
		}
	    }

	    /*
	     * Set the result to the last position of the cursor.
	     */

	    done:
	    Tcl_ResetResult(interp);
	    Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
	    DeleteScanNumberCache(numberCachePtr);


	    break;
	}
    }
    return TCL_OK;

    badValue:
    Tcl_ResetResult(interp);
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
	    " string but got \"", errorValue, "\" instead", NULL);
    return TCL_ERROR;

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

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

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

	Tcl_UtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
	return TCL_ERROR;

		     * a LOT of varied binary data in a single call!
		     * Bail out by switching back to the old behaviour
		     * for the rest of the scan.
		     *
		     * Note that anyone just using the 'c' conversion
		     * (for bytes) cannot trigger this.
		     */
		    DeleteScanNumberCache(tablePtr);
		    *numberCachePtrPtr = NULL;
		    return Tcl_NewLongObj(value);
		} else {
		    register Tcl_Obj *objPtr = Tcl_NewLongObj(value);

		    Tcl_IncrRefCount(objPtr);
		    Tcl_SetHashValue(hPtr, (ClientData) objPtr);
		    return objPtr;
		}
	    }

	    /*
	     * Do not cache wide values; they are already too large to
	     * use as keys.
	     */
	case 'w':
	    uwvalue =  ((Tcl_WideUInt) buffer[0])
		    | (((Tcl_WideUInt) buffer[1]) << 8)
		    | (((Tcl_WideUInt) buffer[2]) << 16)
		    | (((Tcl_WideUInt) buffer[3]) << 24)
		    | (((Tcl_WideUInt) buffer[4]) << 32)
		    | (((Tcl_WideUInt) buffer[5]) << 40)
		    | (((Tcl_WideUInt) buffer[6]) << 48)
		    | (((Tcl_WideUInt) buffer[7]) << 56);
	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
	case 'W':
	    uwvalue =  ((Tcl_WideUInt) buffer[7])
		    | (((Tcl_WideUInt) buffer[6]) << 8)
		    | (((Tcl_WideUInt) buffer[5]) << 16)
		    | (((Tcl_WideUInt) buffer[4]) << 24)
		    | (((Tcl_WideUInt) buffer[3]) << 32)
		    | (((Tcl_WideUInt) buffer[2]) << 40)
		    | (((Tcl_WideUInt) buffer[1]) << 48)
		    | (((Tcl_WideUInt) buffer[0]) << 56);
	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);

	    /*
	     * Do not cache double values; they are already too large
	     * to use as keys and the values stored are utterly
	     * incompatible too.
	     */
	case 'f': {
	    float fvalue;
	    memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
	    return Tcl_NewDoubleObj(fvalue);
	}
	case 'd': {
	    double dvalue;
	    memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
	    return Tcl_NewDoubleObj(dvalue);
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteScanNumberCache --
 * 
 *	Deletes the hash table acting as a scan number cache.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Decrements the reference counts of the objects in the cache.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteScanNumberCache(numberCachePtr)
    Tcl_HashTable *numberCachePtr;	/* Pointer to the hash table, or
					 * NULL (when the cache has already
					 * been deleted due to overflow.) */
{
    Tcl_HashEntry *hEntry;
    Tcl_HashSearch search;

    if (numberCachePtr == NULL) {
	return;
    }

    hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
    while (hEntry != NULL) {
	register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry);

	if (value != NULL) {
	    Tcl_DecrRefCount(value);
	}
	hEntry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(numberCachePtr);
}

 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 *
 * RCS: @(#) $Id: tclCkalloc.c,v 1.19.4.1 2004/02/07 05:48:00 dgp Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

#define FALSE	0
#define TRUE	1

    if (guard_failed) {
        TclDumpMemoryInfo (stderr);
        fprintf(stderr, "low guard failed at %lx, %s %d\n",
                 (long unsigned int) memHeaderP->body, file, line);
        fflush(stderr);  /* In case name pointer is bad. */
        fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
		memHeaderP->file, memHeaderP->line);
        Tcl_Panic("Memory validation failure");
    }

    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
        byte = *(hiPtr + idx);
        if (byte != GUARD_VALUE) {
            guard_failed = TRUE;

        TclDumpMemoryInfo (stderr);
        fprintf(stderr, "high guard failed at %lx, %s %d\n",
                 (long unsigned int) memHeaderP->body, file, line);
        fflush(stderr);  /* In case name pointer is bad. */
        fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
		memHeaderP->length, memHeaderP->file,
		memHeaderP->line);
        Tcl_Panic("Memory validation failure");
    }

    if (nukeGuards) {
        memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); 
        memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE); 
    }

        Tcl_ValidateAllMemory (file, line);

    result = (struct mem_header *) TclpAlloc((unsigned)size + 
                              sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    if (result == NULL) {
        fflush(stdout);
        TclDumpMemoryInfo(stderr);
        Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }

    /*
     * Fill in guard zones and size.  Also initialize the contents of
     * the block with bogus bytes to detect uses of initialized data.
     * Link into allocated list.
     */


/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkfree - debugging ckfree
 *
 *        Verify that the low and high guards are intact, and if so
 *        then free the buffer else Tcl_Panic.
 *
 *        The guards are erased after being checked to catch duplicate
 *        frees.
 *
 *        The second and third arguments are file and line, these contain
 *        the filename and line number corresponding to the caller.
 *        These are sent by the ckfree macro; it uses the preprocessor

     * by returning NULL, so we have to check that the NULL we get is
     * not in response to alloc(0).
     *
     * The ANSI spec actually says that systems either return NULL *or*
     * a special pointer on failure, but we only check for NULL
     */
    if ((result == NULL) && size) {
	Tcl_Panic("unable to alloc %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkalloc(size, file, line)
    unsigned int size;
    CONST char  *file;
    int          line;
{
    char *result;

    result = (char *) TclpAlloc(size);

    if ((result == NULL) && size) {
        fflush(stdout);
        Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

    unsigned int size;
{
    char *result;

    result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkrealloc(ptr, size, file, line)
    char        *ptr;
    unsigned int size;
    CONST char  *file;
    int          line;
{
    char *result;

    result = (char *) TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
        fflush(stdout);
        Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

/* 
 * tclClock.c --
 *
 *	Contains the time and date related commands.  This code
 *	is derived from the time and date facilities of TclX,
 *	by Mark Diekhans and Karl Lehenbauer.
 *
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclClock.c,v 1.23.2.1 2004/02/07 05:48:00 dgp Exp $
 */

#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"

/*

    int clickType = 2;
    int dummy;
    unsigned long baseClock, clockVal;
    long zone;
    Tcl_Obj *baseObjPtr = NULL;
    char *scanStr;
    Tcl_Time now;		/* Current time */

    static CONST char *switches[] = {
	"clicks", "format", "scan", "seconds", (char *) NULL
    };
    enum command {
	COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN, COMMAND_SECONDS
    };
    static CONST char *clicksSwitches[] = {
	"-milliseconds", "-microseconds", (char*) NULL
    };
    static CONST char *formatSwitches[] = {
	"-format", "-gmt", (char *) NULL
    };
    static CONST char *scanSwitches[] = {
	"-base", "-gmt", (char *) NULL
    };

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

    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum command) index) {
	case COMMAND_CLICKS:	{		/* clicks */

	    if (objc == 3) {
		if (Tcl_GetIndexFromObj(interp, objv[2], clicksSwitches,
			"option", 0, &clickType) != TCL_OK) {

		    return TCL_ERROR;
		}
	    } else if (objc != 2) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");
		return TCL_ERROR;
	    }
	    switch (clickType) {
	    case 0: 		/* milliseconds */
		Tcl_GetTime(&now);
		Tcl_SetWideIntObj(resultPtr,
			((Tcl_WideInt) now.sec * 1000 + now.usec / 1000));

		break;
	    case 1:		/* microseconds */
		Tcl_GetTime(&now);
		Tcl_SetWideIntObj(resultPtr,
			((Tcl_WideInt) now.sec * 1000000 + now.usec));

		break;
	    case 2:		/* native clicks */

		Tcl_SetWideIntObj(resultPtr, (Tcl_WideInt) TclpGetClicks());
		break;
	    }

	    return TCL_OK;
	}

	case COMMAND_FORMAT:			/* format */
	    if ((objc < 3) || (objc > 7)) {
		wrongFmtArgs:
		Tcl_WrongNumArgs(interp, 2, objv,
			"clockval ?-format string? ?-gmt boolean?");
		return TCL_ERROR;
	    }

	    if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal)
		    != TCL_OK) {
		return TCL_ERROR;
	    }

	    objPtr = objv+3;
	    objc -= 3;
	    while (objc > 1) {
		if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
			"switch", 0, &index) != TCL_OK) {
		    return TCL_ERROR;
		}

     * This is a kludge for systems not having the timezone string in
     * struct tm.  No matter what was specified, they use the local
     * timezone string.  Since this kludge requires fiddling with the
     * TZ environment variable, it will mess up if done on multiple
     * threads at once.  Protect it with a the clock mutex.
     */

    Tcl_MutexLock(&clockMutex);
    if (useGMT) {
        CONST char *varValue;

        varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
        if (varValue != NULL) {
	    savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
        } else {
            savedTZEnv = NULL;
	}
        Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
        savedTimeZone = timezone;
        timezone = 0;
        tzset();
    }
#endif

    tclockVal = clockVal;
    timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);

    /*
     * Make a guess at the upper limit on the substituted string size
     * based on the number of percents in the string.
     */

    for (bufSize = 1, p = format; *p != '\0'; p++) {
	if (*p == '%') {

    Tcl_DStringSetLength(&buffer, bufSize);

    /* If we haven't locked the clock mutex up above, lock it now. */

#if defined(HAVE_TM_ZONE) || defined(WIN32)
    Tcl_MutexLock(&clockMutex);
#endif
    result = TclpStrftime(buffer.string, (unsigned int) bufSize, format,
	    timeDataPtr, useGMT);
#if defined(HAVE_TM_ZONE) || defined(WIN32)
    Tcl_MutexUnlock(&clockMutex);
#endif

#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
    if (useGMT) {
        if (savedTZEnv != NULL) {
            Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
            ckfree(savedTZEnv);
        } else {
            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
        }
        timezone = savedTimeZone;
        tzset();
    }
    Tcl_MutexUnlock(&clockMutex);
#endif

    if (result == 0) {
	/*
	 * A zero return is the error case (can also mean the strftime
	 * didn't get enough space to write into).  We know it doesn't
	 * mean that we wrote zero chars because the check for an empty
	 * format string is above.
	 */
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad format string \"", format, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    Tcl_SetStringObj(Tcl_GetObjResult(interp), buffer.string, -1);

    Tcl_DStringFree(&buffer);
    return TCL_OK;
}

/* 
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	A to H.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdAH.c,v 1.33.2.2 2004/02/07 05:48:00 dgp Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int mode));
static int		GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_FSStatProc *statProc,
			    Tcl_StatBuf *statPtr));
static char *		GetTypeFromMode _ANSI_ARGS_((int mode));
static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *varName, Tcl_StatBuf *statPtr));

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command.

	"pathtype",	"readable",	"readlink",	"rename",
	"rootname",	"separator",    "size",		"split",	
	"stat",         "system", 
	"tail",		"type",		"volumes",	"writable",
	(char *) NULL
    };
    enum options {
	FCMD_ATIME,	FCMD_ATTRIBUTES, FCMD_CHANNELS,	FCMD_COPY,
	FCMD_DELETE,
	FCMD_DIRNAME,	FCMD_EXECUTABLE, FCMD_EXISTS,	FCMD_EXTENSION,
	FCMD_ISDIRECTORY, FCMD_ISFILE,	FCMD_JOIN,	FCMD_LINK, 
	FCMD_LSTAT,     FCMD_MTIME,	FCMD_MKDIR,	FCMD_NATIVENAME, 
	FCMD_NORMALIZE, FCMD_OWNED,
	FCMD_PATHTYPE,	FCMD_READABLE,	FCMD_READLINK,	FCMD_RENAME,
	FCMD_ROOTNAME,	FCMD_SEPARATOR, FCMD_SIZE,	FCMD_SPLIT,	
	FCMD_STAT,      FCMD_SYSTEM, 
	FCMD_TAIL,	FCMD_TYPE,	FCMD_VOLUMES,	FCMD_WRITABLE
    };

    if (objc < 2) {
    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
	    &index) != TCL_OK) {
    	return TCL_ERROR;
    }

    switch ((enum options) index) {
    	case FCMD_ATIME: {
	    Tcl_StatBuf buf;
	    struct utimbuf tval;

	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
		return TCL_ERROR;
	    }

		if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
	    return TCL_OK;
	}
	case FCMD_ATTRIBUTES:
            return TclFileAttrsCmd(interp, objc, objv);

	case FCMD_CHANNELS:
	    if ((objc < 2) || (objc > 3)) {
		Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
		return TCL_ERROR;
	    }
	    return Tcl_GetChannelNamesEx(interp,
		    ((objc == 2) ? NULL : Tcl_GetString(objv[2])));

	case FCMD_COPY:
	    return TclFileCopyCmd(interp, objc, objv);

	case FCMD_DELETE:
	    return TclFileDeleteCmd(interp, objc, objv);

    	case FCMD_DIRNAME: {
	    Tcl_Obj *dirPtr;

	    if (objc != 3) {
		goto only3Args;
	    }
	    dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME);
	    if (dirPtr == NULL) {
	        return TCL_ERROR;
	    } else {
		Tcl_SetObjResult(interp, dirPtr);
		Tcl_DecrRefCount(dirPtr);
		return TCL_OK;
	    }
	}
	case FCMD_EXECUTABLE:
	    if (objc != 3) {
		goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], X_OK);

	case FCMD_EXISTS:
	    if (objc != 3) {
		goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], F_OK);
	case FCMD_EXTENSION: {
	    Tcl_Obj *ext;
	    


	    if (objc != 3) {
	    	goto only3Args;
	    }
	    ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION);

	    if (ext != NULL) {
	        Tcl_SetObjResult(interp, ext);
		Tcl_DecrRefCount(ext);
		return TCL_OK;
	    } else {
		return TCL_ERROR;
	    }
	}
    	case FCMD_ISDIRECTORY: {
	    int value;
	    Tcl_StatBuf buf;

	    if (objc != 3) {
		goto only3Args;
	    }
	    value = 0;
	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
		value = S_ISDIR(buf.st_mode);
	    }
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
	    return TCL_OK;
	}
    	case FCMD_ISFILE: {
	    int value;
	    Tcl_StatBuf buf;
	    
    	    if (objc != 3) {
    	    	goto only3Args;
    	    }
	    value = 0;
	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
		value = S_ISREG(buf.st_mode);
	    }
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
	    return TCL_OK;
	}
	case FCMD_JOIN: {
	    Tcl_Obj *resObj;

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
		return TCL_ERROR;
	    }
	    resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
	    Tcl_SetObjResult(interp, resObj);
	    return TCL_OK;
	}
	case FCMD_LINK: {
	    Tcl_Obj *contents;
	    int index;
	    
	    if (objc < 3 || objc > 5) {
		Tcl_WrongNumArgs(interp, 2, objv, 
				 "?-linktype? linkname ?target?");
		return TCL_ERROR;

		if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
		    return TCL_ERROR;
		}
		/* Create link from source to target */
		contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
		if (contents == NULL) {
		    /* 
		     * We handle three common error cases specially, and
		     * for all other errors, we use the standard posix
		     * error message.
		     */
		    if (errno == EEXIST) {
			Tcl_AppendResult(interp, "could not create new link \"", 
				Tcl_GetString(objv[index]), 
				"\": that path already exists", (char *) NULL);
		    } 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_AppendResult(interp, 
			            "could not create new link \"", 
				    Tcl_GetString(objv[index]), 
				    "\": no such file or directory", 
				    (char *) NULL);
			} else {
			    Tcl_AppendResult(interp, 
			            "could not create new link \"", 
				    Tcl_GetString(objv[index]), 
				    "\": target \"", 
				    Tcl_GetString(objv[index+1]), 
				    "\" doesn't exist", 
				    (char *) NULL);
			}
		    } else {
			Tcl_AppendResult(interp, "could not create new link \"", 
				Tcl_GetString(objv[index]), "\" pointing to \"", 
				Tcl_GetString(objv[index+1]), "\": ", 
				Tcl_PosixError(interp), (char *) NULL);
		    }
		    return TCL_ERROR;

		 * result refCount.  If we are creating a link, this
		 * will just be objv[index+1], and so we don't own it.
		 */
		Tcl_DecrRefCount(contents);
	    }
	    return TCL_OK;
	}
    	case FCMD_LSTAT: {

	    Tcl_StatBuf buf;

    	    if (objc != 4) {
    	    	Tcl_WrongNumArgs(interp, 2, objv, "name varName");
    	    	return TCL_ERROR;
    	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }

	    return StoreStatData(interp, objv[3], &buf);
	}
	case FCMD_MTIME: {
	    Tcl_StatBuf buf;
	    struct utimbuf tval;

	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
		return TCL_ERROR;
	    }

		if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime);
	    return TCL_OK;
	}
	case FCMD_MKDIR:
	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
		return TCL_ERROR;
	    }
	    return TclFileMakeDirsCmd(interp, objc, objv);

	case FCMD_NATIVENAME: {
	    CONST char *fileName;
	    Tcl_DString ds;

	    if (objc != 3) {
		goto only3Args;
	    }
	    fileName = Tcl_GetString(objv[2]);
	    fileName = Tcl_TranslateFileName(interp, fileName, &ds);
	    if (fileName == NULL) {
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, 
			     Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	    return TCL_OK;
	}
	case FCMD_NORMALIZE: {
	    Tcl_Obj *fileName;

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

	    fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
	    if (fileName == NULL) {
	        return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, fileName);
	    return TCL_OK;
	}
	case FCMD_OWNED: {
	    int value;
	    Tcl_StatBuf buf;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    value = 0;

#else
		value = (geteuid() == buf.st_uid);
#endif
	    }	    
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
	    return TCL_OK;
	}
	case FCMD_PATHTYPE:
	    if (objc != 3) {
		goto only3Args;
	    }
	    switch (Tcl_FSGetPathType(objv[2])) {
	    case TCL_PATH_ABSOLUTE:
		Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1);
		break;
	    case TCL_PATH_RELATIVE:
		Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1);
		break;
	    case TCL_PATH_VOLUME_RELATIVE:
		Tcl_SetStringObj(Tcl_GetObjResult(interp), "volumerelative",
			-1);
		break;
	    }
	    return TCL_OK;

    	case FCMD_READABLE:
	    if (objc != 3) {
		goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], R_OK);

	case FCMD_READLINK: {
	    Tcl_Obj *contents;
		
	    if (objc != 3) {
		goto only3Args;
	    }
	    
	    if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {

	    		Tcl_PosixError(interp), (char *) NULL);
	    	return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, contents);
	    Tcl_DecrRefCount(contents);
	    return TCL_OK;
	}
	case FCMD_RENAME:
	    return TclFileRenameCmd(interp, objc, objv);

	case FCMD_ROOTNAME: {

	    Tcl_Obj *root;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);

	    if (root != NULL) {
		Tcl_SetObjResult(interp, root);
		Tcl_DecrRefCount(root);
		return TCL_OK;
	    } else {

		return TCL_ERROR;
	    }

	}
	case FCMD_SEPARATOR:
	    if ((objc < 2) || (objc > 3)) {
		Tcl_WrongNumArgs(interp, 2, objv, "?name?");
		return TCL_ERROR;
	    }
	    if (objc == 2) {
	        char *separator = NULL; /* lint */
		switch (tclPlatform) {
		case TCL_PLATFORM_UNIX:
		    separator = "/";
		    break;
		case TCL_PLATFORM_WINDOWS:
		    separator = "\\";
		    break;
		case TCL_PLATFORM_MAC:
		    separator = ":";
		    break;
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(separator,1));
	    } else {
		Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
		if (separatorObj != NULL) {
		    Tcl_SetObjResult(interp, separatorObj);
		} else {
		    Tcl_SetObjResult(interp, 
			    Tcl_NewStringObj("Unrecognised path",-1));
		    return TCL_ERROR;
		}
	    }
	    return TCL_OK;

	case FCMD_SIZE: {
	    Tcl_StatBuf buf;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp),
		    (Tcl_WideInt) buf.st_size);
	    return TCL_OK;
	}
	case FCMD_SPLIT: {
	    Tcl_Obj *res;
	    
	    if (objc != 3) {
		goto only3Args;
	    }
	    res = Tcl_FSSplitPath(objv[2], NULL);
	    if (res == NULL) {
		if (interp != NULL) {
		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
			"could not read \"", Tcl_GetString(objv[2]),
			"\": no such file or directory", 
			(char *) NULL);
		}
		return TCL_ERROR;
	    } else {
		Tcl_SetObjResult(interp, res);
		return TCL_OK;
	    }
	}
	case FCMD_STAT: {

	    Tcl_StatBuf buf;
	    
	    if (objc != 4) {
	    	Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
		return TCL_ERROR;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }

	    return StoreStatData(interp, objv[3], &buf);
	}
	case FCMD_SYSTEM: {
	    Tcl_Obj* fsInfo;

	    if (objc != 3) {
		goto only3Args;
	    }
	    fsInfo = Tcl_FSFileSystemInfo(objv[2]);
	    if (fsInfo != NULL) {
		Tcl_SetObjResult(interp, fsInfo);
		return TCL_OK;
	    } else {
		Tcl_SetObjResult(interp, 
				 Tcl_NewStringObj("Unrecognised path",-1));
		return TCL_ERROR;
	    }
	}
    	case FCMD_TAIL: {

	    Tcl_Obj *dirPtr;

	    if (objc != 3) {
		goto only3Args;
	    }










	    dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
	    if (dirPtr == NULL) {
		return TCL_ERROR;



	    } else {











		Tcl_SetObjResult(interp, dirPtr);


		Tcl_DecrRefCount(dirPtr);
		return TCL_OK;
	    }
	}
	case FCMD_TYPE: {
	    Tcl_StatBuf buf;

	    if (objc != 3) {
	    	goto only3Args;
	    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
		    GetTypeFromMode((unsigned short) buf.st_mode), -1);
	    return TCL_OK;
	}
	case FCMD_VOLUMES:
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_FSListVolumes());
	    return TCL_OK;

	case FCMD_WRITABLE:
	    if (objc != 3) {
	    	goto only3Args;
	    }
	    return CheckAccess(interp, objv[2], W_OK);

    }

    only3Args:
    Tcl_WrongNumArgs(interp, 2, objv, "name");
    return TCL_ERROR;
}


 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
  
static int
CheckAccess(interp, pathPtr, mode)
    Tcl_Interp *interp;		/* Interp for status return.  Must not be
				 * NULL. */
    Tcl_Obj *pathPtr;		/* Name of file to check. */
    int mode;			/* Attribute to check; passed as argument to
				 * access(). */
{
    int value;
    
    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	value = 0;
    } else {
	value = (Tcl_FSAccess(pathPtr, mode) == 0);
    }
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);

    return TCL_OK;
}

/*

 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
GetStatBuf(interp, pathPtr, statProc, statPtr)
    Tcl_Interp *interp;		/* Interp for error return.  May be NULL. */
    Tcl_Obj *pathPtr;		/* Path name to examine. */
    Tcl_FSStatProc *statProc;	/* Either stat() or lstat() depending on
				 * desired behavior. */
    Tcl_StatBuf *statPtr;	/* Filled with info about file obtained by
				 * calling (*statProc)(). */
{
    int status;
    
    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    status = (*statProc)(pathPtr, statPtr);
    
    if (status < 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    Tcl_GetString(pathPtr), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}


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

static int
StoreStatData(interp, varName, statPtr)
    Tcl_Interp *interp;			/* Interpreter for error reports. */
    Tcl_Obj *varName;			/* Name of associative array variable
					 * in which to store stat results. */
    Tcl_StatBuf *statPtr;		/* Pointer to buffer containing
					 * stat data to store in varName. */
{

    Tcl_Obj *field = Tcl_NewObj();
    Tcl_Obj *value;
    register unsigned short mode;

    /*
     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
     *
     * Might be a better idea to call Tcl_SetVar2Ex() instead so we
     * don't have to make assumptions that might go wrong later.
     */
#define STORE_ARY(fieldName, object) \
    Tcl_SetStringObj(field, (fieldName), -1); \
    value = (object); \
    if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \

	Tcl_DecrRefCount(field); \
	Tcl_DecrRefCount(value); \
	return TCL_ERROR; \
    }


    Tcl_IncrRefCount(field);
    STORE_ARY("dev",   Tcl_NewLongObj((long)statPtr->st_dev));
    /*
     * Watch out porters; the inode is meant to be an *unsigned* value,
     * so the cast might fail when there isn't a real arithmentic 'long
     * long' type...
     */

    STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
    STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
    STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",  Tcl_NewIntObj(mode));
    STORE_ARY("type",  Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    Tcl_DecrRefCount(field);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	     * this happens, which can lead to some wierd crashes,
	     * like Bug #494348...)
	     */

	    result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
		    &varcList[i], &varvList[i]);
	    if (result != TCL_OK) {
		Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
	    }
	    result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
		    &argcList[i], &argvList[i]);
	    if (result != TCL_OK) {
		Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
	    }
	    
	    for (v = 0;  v < varcList[i];  v++) {
		int k = index[i]++;
		Tcl_Obj *valuePtr, *varValuePtr;
		int isEmptyObj = 0;
		

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdIL.c,v 1.50.2.4 2004/02/07 05:48:00 dgp Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LassignObjCmd --
 *
 *	This object-based procedure is invoked to process the "lassign" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
Tcl_LassignObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Obj *valueObj;		/* Value to assign to variable, as read from
				 * the list object or created in the emptyObj
				 * variable. */
    Tcl_Obj *emptyObj = NULL;	/* If non-NULL, an empty object created for
				 * being assigned to variables once we have
				 * run out of values from the list object. */
    Tcl_Obj **listObjv;		/* The contents of the list. */
    int listObjc;		/* The length of the list. */
    int i;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list varname ?varname ...?");
	return TCL_ERROR;
    }

    /*
     * First assign values out of the list to variables.
     */

    for (i=0 ; i+2<objc ; i++) {
	/*
	 * We do this each time round the loop because that is robust
	 * against shimmering nasties.
	 */
	if (Tcl_ListObjIndex(interp, objv[1], i, &valueObj) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (valueObj == NULL) {
	    if (emptyObj == NULL) {
		TclNewObj(emptyObj);
		Tcl_IncrRefCount(emptyObj);
	    }
	    valueObj = emptyObj;
	}
	/*
	 * Make sure the reference count for the value being assigned
	 * is greater than one (other reference minimally in the list)
	 * so we can't get hammered by shimmering.
	 */
	Tcl_IncrRefCount(valueObj);
	if (Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_DecrRefCount(valueObj);
	    if (emptyObj != NULL) {
		Tcl_DecrRefCount(emptyObj);
	    }
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(valueObj);
    }
    if (emptyObj != NULL) {
	Tcl_DecrRefCount(emptyObj);
    }

    /*
     * Now place a list of any values left over into the interpreter
     * result.
     *
     * First, figure out how many values were not assigned by getting
     * the length of the list.  Note that I do not expect this
     * operation to fail.
     */

    if (Tcl_ListObjGetElements(interp, objv[1],
	    &listObjc, &listObjv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listObjc > objc-2) {
	/*
	 * OK, there were left-overs.  Make a list of them and slap
	 * that back in the interpreter result.
	 */
	Tcl_SetObjResult(interp,
		Tcl_NewListObj(listObjc - objc + 2, listObjv + objc - 2));
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LindexObjCmd --
 *
 *	This object-based procedure is invoked to process the "lindex" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.

int
Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    register int objc;			/* Number of arguments. */
    register Tcl_Obj *CONST objv[];	/* The argument objects. */
{
    int elementCount, i, result;
    Tcl_Obj **dataArray;

    /* 
     * Check arguments for legality:
     *		lrepeat posInt value ?value ...?
     */

    objv += 2;

    /*
     * Create workspace array large enough to hold each init value
     * elementCount times.  Note that we don't bother with stack
     * allocation for this, as we expect this function to be used
     * mainly when stack allocation would be inappropriate anyway.
     * First check to see if we'd overflow and try to allocate an
     * object larger than our memory allocator allows.  Note that this
     * is actually a fairly small value when you're on a serious
     * 64-bit machine, but that requires API changes to fix.
     *


     * We allocate using attemptckalloc() because if we ask for
     * something big but can't get it, we've still got a high chance
     * of having a proper failover strategy.  If *that* fails to get
     * memory, Tcl_Panic() will happen just a few lines lower...
     */

    if ((unsigned)elementCount > INT_MAX/sizeof(Tcl_Obj *)/objc) {
	Tcl_AppendResult(interp, "overflow of maximum list length", NULL);
	return TCL_ERROR;
    }

    dataArray = (Tcl_Obj **)
	    attemptckalloc(elementCount * objc * sizeof(Tcl_Obj *));

    if (dataArray == NULL) {
	Tcl_AppendResult(interp, "insufficient memory to create list", NULL);
	return TCL_ERROR;
    }

    /*
     * Set the elements.  Note that we handle the common degenerate
     * case of a single value being repeated separately to permit the
     * compiler as much room as possible to optimize a loop that might
     * be run a very large number of times.
     */

    if (objc == 1) {
	register Tcl_Obj *tmpPtr = objv[0];

	for (i=0 ; i<elementCount ; i++) {
	    dataArray[i] = tmpPtr;
	}
    } else {
	int j, k = 0;

	for (i=0 ; i<elementCount ; i++) {
	    for (j=0 ; j<objc ; j++) {
		dataArray[k++] = objv[j];
	    }
	}
    }

    /*
     * Build the result list, clean up and return.
     */

    Tcl_SetObjResult(interp, TclNewListObjDirect(elementCount*objc,dataArray));

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LreplaceObjCmd --

/* 
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	M to Z.  It contains only commands in the generic core (i.e.
 *	those that don't depend much upon UNIX facilities).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.90.2.6 2004/02/07 05:48:00 dgp Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*

int
Tcl_ReturnObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int code, level;
    Tcl_Obj *returnOpts;

    /*
     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */
    int explicitResult = (0 == (objc % 2));
    int numOptionWords = objc - 1 - explicitResult;

    if (TCL_ERROR == TclMergeReturnOptions(interp, numOptionWords, objv+1,
	    &returnOpts, &code, &level)) {
	return TCL_ERROR;
    }

    code = TclProcessReturn(interp, code, level, returnOpts);
    if (explicitResult) {
	Tcl_SetObjResult(interp, objv[objc-1]);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessReturn --
 *
 *	Does the work of the [return] command based on the code,
 *	level, and returnOpts arguments.  Note that the code argument
 *	must agree with the -code entry in returnOpts and the level
 *	argument must agree with the -level entry in returnOpts, as
 *	is the case for values returned from TclMergeReturnOptions.
 *
 * Results:
 *	Returns the return code the [return] command should return.
 *
 * Side effects:
 *	When the return code is TCL_ERROR, the values of ::errorInfo
 *	and ::errorCode may be updated.
 *
 *----------------------------------------------------------------------
 */
int
TclProcessReturn(interp, code, level, returnOpts)
    Tcl_Interp *interp;
    int code;
    int level;
    Tcl_Obj *returnOpts;
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *valuePtr;

    /* Store the merged return options */
    if (iPtr->returnOpts != returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);














































	iPtr->returnOpts = returnOpts;




















	Tcl_IncrRefCount(iPtr->returnOpts);





































    }

    if (level == 0) {
	if (code == TCL_ERROR) {
	    valuePtr = NULL;
	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
		    iPtr->returnErrorinfoKey, &valuePtr);

			valuePtr, TCL_GLOBAL_ONLY);
		iPtr->flags |= ERROR_CODE_SET;
	    }
	}
    } else {
	code = TCL_RETURN;
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMergeReturnOptions --
 *
 *	Parses, checks, and stores the options to the [return] command.
 *
 * Results:
 *	Returns TCL_ERROR is any of the option values are invalid.
 *	Otherwise, returns TCL_OK, and writes the returnOpts, code,
 *	and level values to the pointers provided.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
    Tcl_Obj **optionsPtrPtr;	/* If not NULL, points to space for a
				 * (Tcl_Obj *) where the pointer to the
				 * merged return options dictionary should
				 * be written */
    int *codePtr;		/* If not NULL, points to space where the
				 * -code value should be written */
    int *levelPtr;		/* If not NULL, points to space where the
				 * -level value should be written */
{
    Interp *iPtr = (Interp *) interp;
    int code, level, size;
    Tcl_Obj *valuePtr;
    Tcl_Obj *returnOpts = Tcl_DuplicateObj(iPtr->defaultReturnOpts);

    for (;  objc > 1;  objv += 2, objc -= 2) {
	int optLen;
	CONST char *opt = Tcl_GetStringFromObj(objv[0], &optLen);
	int compareLen;
	CONST char *compare =
		Tcl_GetStringFromObj(iPtr->returnOptionsKey, &compareLen);

	if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) {
	    Tcl_DictSearch search;
	    int done = 0;
	    Tcl_Obj *keyPtr;
	    Tcl_Obj *dict = objv[1];

	    nestedOptions:
	    if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict,
		    &search, &keyPtr, &valuePtr, &done)) {
		/* Value is not a legal dictionary */
		Tcl_ResetResult(interp);
		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad ",
			compare, " value: expected dictionary but got \"",
			Tcl_GetString(objv[1]), "\"", (char *) NULL);
		return TCL_ERROR;
	    }

	    while (!done) {
		Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr);
		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	    }

	    valuePtr = NULL;
	    Tcl_DictObjGet(NULL, returnOpts, iPtr->returnOptionsKey, &valuePtr);
	    if (valuePtr != NULL) {
		dict = valuePtr;
		Tcl_DictObjRemove(NULL, returnOpts, iPtr->returnOptionsKey);
		goto nestedOptions;
	    }

	} else {
	    Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]);
	}
    }

    /* Check for bogus -code value */
    Tcl_DictObjGet(NULL, returnOpts, iPtr->returnCodeKey, &valuePtr);
    if (TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &code)) {
	static CONST char *returnCodes[] = {
	    "ok", "error", "return", "break", "continue", NULL
	};

	if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
		NULL, TCL_EXACT, &code)) {
	    /* Value is not a legal return code */
	    Tcl_ResetResult(interp);
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    "bad completion code \"",
		    Tcl_GetString(valuePtr),
		    "\": must be ok, error, return, break, ",
		    "continue, or an integer", (char *) NULL);
	    return TCL_ERROR;
	}
	/* Have a legal string value for a return code; convert to integer */
	Tcl_DictObjPut(NULL, returnOpts,
		iPtr->returnCodeKey, Tcl_NewIntObj(code));
    }

    /* Check for bogus -level value */
    Tcl_DictObjGet(NULL, returnOpts, iPtr->returnLevelKey, &valuePtr);
    if (TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &level) || (level < 0)) {
	/* Value is not a legal level */
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad -level value: expected non-negative integer but got \"",
		Tcl_GetString(valuePtr), "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /* 
     * Convert [return -code return -level X] to
     * [return -code ok -level X+1]
     */
    if (code == TCL_RETURN) {
	level++;
	Tcl_DictObjPut(NULL, returnOpts,
		iPtr->returnLevelKey, Tcl_NewIntObj(level));
	Tcl_DictObjPut(NULL, returnOpts,
		iPtr->returnCodeKey, Tcl_NewIntObj(TCL_OK));
    }

    /*
     * Check if we just have the default options.  If so, use them.
     * A dictionary equality test would be more robust, but seems
     * tricky, to say the least.
     */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 2 && code == TCL_OK && level == 1) {
	Tcl_DecrRefCount(returnOpts);
	returnOpts = iPtr->defaultReturnOpts;
    }
    if (codePtr != NULL) {
	*codePtr = code;
    }
    if (levelPtr != NULL) {
	*levelPtr = level;
    }
    if ((optionsPtrPtr == NULL) && (returnOpts != iPtr->defaultReturnOpts)) {
	/* not passing back the options (?!), so clean them up */
	Tcl_DecrRefCount(returnOpts);
    } else {
	*optionsPtrPtr = returnOpts;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SourceObjCmd --
 *

		break;
	    }
	    case SUBST_NOVARS: {
		flags &= ~TCL_SUBST_VARIABLES;
		break;
	    }
	    default: {
		Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
	    }
	}
    }
    if (i != (objc-1)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nobackslashes? ?-nocommands? ?-novariables? string");
	return TCL_ERROR;

int
Tcl_SwitchObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int i, j, index, mode, matched, result, splitObjs, numMatchesSaved;
    char *string, *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *CONST *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    static CONST char *options[] = {
	"-exact", "-glob", "-indexvar", "-matchvar", "-regexp", "--", 
	NULL
    };
    enum options {
	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_REGEXP, OPT_LAST
    };

    mode = OPT_EXACT;
    indexVarObj = NULL;
    matchVarObj = NULL;
    numMatchesSaved = 0;
    for (i = 1; i < objc; i++) {
	string = Tcl_GetString(objv[i]);
	if (string[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, 
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (index == OPT_LAST) {
	    i++;
	    break;
	}

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

	if (index == OPT_INDEXV) {
	    i++;
	    if (i == objc) {
		Tcl_AppendResult(interp,
			"missing variable name argument to -indexvar option",
			(char *) NULL);
		return TCL_ERROR;
	    }
	    indexVarObj = objv[i];
	    numMatchesSaved = -1;
	} else if (index == OPT_MATCHV) {
	    i++;
	    if (i == objc) {
		Tcl_AppendResult(interp,
			"missing variable name argument to -matchvar option",
			(char *) NULL);
		return TCL_ERROR;
	    }
	    matchVarObj = objv[i];
	    numMatchesSaved = -1;
	} else {
	    mode = index;
	}
    }

    if (objc - i < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?switches? string pattern body ... ?default body?");
	return TCL_ERROR;
    }
    if (indexVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_AppendResult(interp,
		"-indexvar option requires -regexp option", (char *) NULL);
	return TCL_ERROR;
    }
    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_AppendResult(interp,
		"-matchvar option requires -regexp option", (char *) NULL);
	return TCL_ERROR;
    }

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

    /*

	pattern = Tcl_GetString(objv[i]);

	matched = 0;
	if ((i == objc - 2) 
		&& (*pattern == 'd') 
		&& (strcmp(pattern, "default") == 0)) {
	    Tcl_Obj *emptyObj = NULL;

	    matched = 1;
	    /*
	     * If either indexVarObj or matchVarObj are non-NULL,
	     * we're in REGEXP mode but have reached the default
	     * clause anyway.  TIP#75 specifies that we set the
	     * variables to empty lists (== empty objects) in that
	     * case.
	     */
	    if (indexVarObj != NULL) {
		TclNewObj(emptyObj);
		if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    Tcl_DecrRefCount(emptyObj);
		    return TCL_ERROR;
		}
	    }
	    if (matchVarObj != NULL) {
		if (emptyObj == NULL) {
		    TclNewObj(emptyObj);
		}
		if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    if (indexVarObj == NULL) {
			Tcl_DecrRefCount(emptyObj);
		    }
		    return TCL_ERROR;
		}
	    }
	    numMatchesSaved = 0;
	} else {
	    switch (mode) {
	    case OPT_EXACT:
		matched = (strcmp(Tcl_GetString(stringObj), pattern) == 0);
		break;
	    case OPT_GLOB:
		matched = Tcl_StringMatch(Tcl_GetString(stringObj), pattern);

		break;
	    case OPT_REGEXP:
		regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
			TCL_REG_ADVANCED);
		if (regExpr == NULL) {
		    return TCL_ERROR;
		}
		matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0,
			numMatchesSaved, 0);
		if (matched < 0) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
	if (matched == 0) {
	    continue;
	}

	/*
	 * We are operating in REGEXP mode and we need to store
	 * information about what we matched in some user-nominated
	 * arrays.  So build the lists of values and indices to write
	 * here.  [TIP#75]
	 */

	if (numMatchesSaved) {
	    Tcl_RegExpInfo info;
	    Tcl_Obj *matchesObj, *indicesObj = NULL;

	    Tcl_RegExpGetInfo(regExpr, &info);
	    if (matchVarObj != NULL) {
		TclNewObj(matchesObj);
	    } else {
		matchesObj = NULL;
	    }
	    if (indexVarObj != NULL) {
		TclNewObj(indicesObj);
	    }
	    for (j=0 ; j<=info.nsubs ; j++) {
		if (indexVarObj != NULL) {
		    Tcl_Obj *rangeObjAry[2];

		    rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
		    rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
		    /*
		     * Never fails; the object is always clean at this point.
		     */
		    Tcl_ListObjAppendElement(NULL, indicesObj,
			    Tcl_NewListObj(2, rangeObjAry));
		}
		if (matchVarObj != NULL) {
		    Tcl_Obj *substringObj;

		    substringObj = Tcl_GetRange(stringObj,
			    info.matches[j].start, info.matches[j].end-1);
		    /*
		     * Never fails; the object is always clean at this point.
		     */
		    Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);
		}
	    }
	    if (indexVarObj != NULL) {
		if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    Tcl_DecrRefCount(indicesObj);
		    /*
		     * Careful!  Check to see if we have allocated the
		     * list of matched strings; if so (but there was
		     * an error assigning the indices list) we have a
		     * potential memory leak because the match list
		     * has not been written to a variable.  Except
		     * that we'll clean that up right now.
		     */
		    if (matchesObj != NULL) {
			Tcl_DecrRefCount(matchesObj);
		    }
		    return TCL_ERROR;
		}
	    }
	    if (matchVarObj != NULL) {
		if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    Tcl_DecrRefCount(matchesObj);
		    /*
		     * Unlike above, if indicesObj is non-NULL at this
		     * point, it will have been written to a variable
		     * already and will hence not be leaked.
		     */
		    return TCL_ERROR;
		}
	    }
	}

	/*
	 * We've got a match. Find a body to execute, skipping bodies
	 * that are "-".
	 */

	for (j = i + 1; ; j += 2) {
	    if (j >= objc) {
		/*
		 * This shouldn't happen since we've checked that the
		 * last body is not a continuation...
		 */
		Tcl_Panic("fall-out when searching for body to match pattern");
	    }
	    if (strcmp(Tcl_GetString(objv[j]), "-") != 0) {
		break;
	    }
	}
	result = Tcl_EvalObjEx(interp, objv[j], 0);
	if (result == TCL_ERROR) {

/* 
 * tclCompCmds.c --
 *
 *	This file contains compilation procedures that compile various
 *	Tcl commands into a sequence of instructions ("bytecodes"). 
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompCmds.c,v 1.49.2.2 2004/02/07 05:48:00 dgp Exp $
 */

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

/*
 * Prototypes for procedures defined later in this file:

	Tcl_ResetResult(interp);
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		"wrong # args: should be \"append varName ?value value ...?\"",
		-1);
	return TCL_ERROR;
    } else if (numWords == 2) {
	/*
	 * append varName == set varName
	 */
        return TclCompileSetCmd(interp, parsePtr, envPtr);
    } else if (numWords > 3) {
	/*
	 * APPEND instructions currently only handle one value
	 */
        return TCL_OUT_LINE_COMPILE;

	}
    }

    /*
     * We will compile the catch command. Emit a beginCatch instruction at
     * the start of the catch body: the subcommand it controls.
     */

    envPtr->exceptDepth++;
    envPtr->maxExceptDepth =
	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);

    /*

    if (code != TCL_OK) {
	code = TCL_OUT_LINE_COMPILE;
	goto done;
    }
    envPtr->exceptArrayPtr[range].numCodeBytes =
	    (envPtr->codeNext - envPtr->codeStart) - startOffset;

    /*
     * The "no errors" epilogue code: store the body's result into the
     * variable (if any), push "0" (TCL_OK) as the catch's "no error"
     * result, and jump around the "error case" code.
     */

    if (localIndex != -1) {

    /*
     * Update the target of the jump after the "no errors" code, then emit
     * an endCatch instruction at the end of the catch command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d\n",
		(envPtr->codeNext - envPtr->codeStart) - jumpFixup.codeOffset);
    }
    TclEmitOpcode(INST_END_CATCH, envPtr);

    done:
    envPtr->currStackDepth = savedStackDepth + 1;
    envPtr->exceptDepth--;

	if (code == TCL_ERROR) {
            Tcl_AddObjErrorInfo(interp,
	            "\n    (\"for\" initial command)", -1);
        }
	goto done;
    }
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump to the evaluation of the condition. This code uses the "loop
     * rotation" optimisation (which eliminates one branch from the loop).
     * "for start cond next body" produces then:
     *       start
     *       goto A
     *    B: body                : bodyCodeOffset

    jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
    if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
	bodyCodeOffset += 3;
	nextCodeOffset += 3;
	testCodeOffset += 3;
    }

    envPtr->currStackDepth = savedStackDepth;
    code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
    if (code != TCL_OK) {
	if (code == TCL_ERROR) {
	    Tcl_AddObjErrorInfo(interp,
				"\n    (\"for\" test expression)", -1);
	}
	goto done;
    }
    envPtr->currStackDepth = savedStackDepth + 1;

    jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
    if (jumpDist > 127) {
	TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
    } else {
	TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
    }

    /*
     * Set the loop's offsets and break target.
     */

    envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
    envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;

    envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;

    envPtr->exceptArrayPtr[bodyRange].breakOffset =
            envPtr->exceptArrayPtr[nextRange].breakOffset =
	    (envPtr->codeNext - envPtr->codeStart);

    /*
     * The for command's result is an empty string.
     */

    envPtr->currStackDepth = savedStackDepth;
    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    code = TCL_OK;

        varcList = (int *) ckalloc(numLists * sizeof(int));
        varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
    }
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
        varcList[loopIndex] = 0;
        varvList[loopIndex] = NULL;
    }

    /*
     * Set the exception stack depth.
     */ 

    envPtr->exceptDepth++;
    envPtr->maxExceptDepth =
	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);

    /*
     * Break up each var list and set the varcList and varvList arrays.
     * Don't compile the foreach inline if any var name needs substitutions
     * or isn't a scalar, or if any var list needs substitutions.
     */

		/*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
	if (loopIndex == 0) {
	    firstValueTemp = tempVar;
	}
    }
    loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
	    /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);

    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */

    infoPtr = (ForeachInfo *) ckalloc((unsigned)

    infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);

    /*
     * Evaluate then store each value list in the associated temporary.
     */

    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);

    loopIndex = 0;
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
	if ((i%2 == 0) && (i > 0)) {
	    code = TclCompileTokens(interp, tokenPtr+1,
		    tokenPtr->numComponents, envPtr);

    }

    /*
     * Initialize the temporary var that holds the count of loop iterations.
     */

    TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);

    /*
     * Top of loop code: assign each loop variable and check whether
     * to terminate the loop.
     */

    envPtr->exceptArrayPtr[range].continueOffset =
	    (envPtr->codeNext - envPtr->codeStart);
    TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */

    envPtr->exceptArrayPtr[range].codeOffset =
	    (envPtr->codeNext - envPtr->codeStart);
    code = TclCompileCmdWord(interp, bodyTokenPtr+1,

        }
	goto done;
    }
    envPtr->exceptArrayPtr[range].numCodeBytes =
	    (envPtr->codeNext - envPtr->codeStart)
	    - envPtr->exceptArrayPtr[range].codeOffset;
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump back to the test at the top of the loop. Generate a 4 byte jump
     * if the distance to the test is > 120 bytes. This is conservative and
     * ensures that we won't have to replace this jump if we later need to
     * replace the ifFalse jump with a 4 byte jump.
     */

    /*
     * Set the loop's break target.
     */

    envPtr->exceptArrayPtr[range].breakOffset =
	    (envPtr->codeNext - envPtr->codeStart);

    /*
     * The foreach command's result is an empty string.
     */

    envPtr->currStackDepth = savedStackDepth;
    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    envPtr->currStackDepth = savedStackDepth + 1;

				 * auxiliary data to duplicate. */
{
    register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
    ForeachInfo *dupPtr;
    register ForeachVarList *srcListPtr, *dupListPtr;
    int numLists = srcPtr->numLists;
    int numVars, i, j;

    dupPtr = (ForeachInfo *) ckalloc((unsigned)
	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
    dupPtr->numLists = numLists;
    dupPtr->firstValueTemp = srcPtr->firstValueTemp;
    dupPtr->loopCtTemp = srcPtr->loopCtTemp;

    for (i = 0;  i < numLists;  i++) {
	srcListPtr = srcPtr->varLists[i];
	numVars = srcListPtr->numVars;
	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
	        sizeof(ForeachVarList) + numVars*sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {

	    goto done;
	}

	/*
	 * Compile the test expression then emit the conditional jump
	 * around the "then" part. 
	 */

	envPtr->currStackDepth = savedStackDepth;
	testTokenPtr = tokenPtr;


	if (realCond) {
	    /*
	     * Find out if the condition is a constant. 
	     */

	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
		    testTokenPtr[1].size);
	    Tcl_IncrRefCount(boolObj);
	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
	    Tcl_DecrRefCount(boolObj);
	    if (code == TCL_OK) {
		/*

	}

	if (realCond) {
	    /*
	     * Jump to the end of the "if" command. Both jumpFalseFixupArray and
	     * jumpEndFixupArray are indexed by "jumpIndex".
	     */

	    if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
		TclExpandJumpFixupArray(&jumpEndFixupArray);
	    }
	    jumpEndFixupArray.next++;
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
	            &(jumpEndFixupArray.fixup[jumpIndex]));

	    /*
	     * Fix the target of the jumpFalse after the test. Generate a 4 byte
	     * jump if the distance is > 120 bytes. This is conservative, and
	     * ensures that we won't have to replace this jump if we later also
	     * need to replace the proceeding jump to the end of the "if" with a
	     * 4 byte jump.
	     */

	    if (TclFixupForwardJumpToHere(envPtr,
	            &(jumpFalseFixupArray.fixup[jumpIndex]), 120)) {
		/*
		 * Adjust the code offset for the proceeding jump to the end
		 * of the "if" command.
		 */

		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
	    }
	} else if (boolVal) {
	    /* 
	     *We were processing an "if 1 {...}"; stop compiling
	     * scripts
	     */

	    }
	}

	if (compileScripts) {
	    /*
	     * Compile the else command body.
	     */

	    code = TclCompileCmdWord(interp, tokenPtr+1,
		    tokenPtr->numComponents, envPtr);
	    if (code != TCL_OK) {
		if (code == TCL_ERROR) {
		    sprintf(buffer, "\n    (\"if\" else script line %d)",
			    interp->errorLine);
		    Tcl_AddObjErrorInfo(interp, buffer, -1);
		}
		goto done;
	    }
	}

	/*
	 * Make sure there are no words after the else clause.
	 */

	wordIdx++;
	if (wordIdx < numWords) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		    "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
	    code = TCL_ERROR;
	    goto done;

	    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
	}
    }

    /*
     * Fix the unconditional jumps to the end of the "if" command.
     */

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

		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */

		goto done;
	    }
	}
    } else {			/* no incr amount given so use 1 */
	haveImmValue = 1;
	immValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex >= 0) {

    } else {			/* non-simple variable name */
	if (haveImmValue) {
	    TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
	} else {
	    TclEmitOpcode(INST_INCR_STK, envPtr);
	}
    }

    done:
    return code;
}

/*
 *----------------------------------------------------------------------
 *

    done:
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLassignCmd --
 *
 *	Procedure called to compile the "lassign" command.
 *
 * Results:
 *	The return value is a standard Tcl result, which is TCL_OK if the
 *	compilation was successful.  If the command cannot be byte-compiled,
 *	TCL_OUT_LINE_COMPILE is returned, indicating that the command should
 *	be compiled "out of line" by emitting code to invoke its command
 *	procedure (Tcl_LassignObjCmd) at runtime, which enforces in correct
 *	error handling.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lassign" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLassignCmd(interp, parsePtr, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
				 * command created by Tcl_ParseCommand. */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int simpleVarName, isScalar, localIndex, numWords, code, idx;

    numWords = parsePtr->numWords;
    /*
     * Check for command syntax error, but we'll punt that to runtime
     */
    if (numWords < 3) {
	return TCL_OUT_LINE_COMPILE;
    }

    /*
     * Generate code to push list being taken apart by [lassign].
     */
    tokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1);
    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, 
		tokenPtr[1].start, tokenPtr[1].size), envPtr);
    } else {
	code = TclCompileTokens(interp, tokenPtr+1,
		tokenPtr->numComponents, envPtr);
	if (code != TCL_OK) {
	    return code;
	}
    }

    /*
     * Generate code to assign values from the list to variables
     */
    for (idx=0 ; idx<numWords-2 ; idx++) {
	tokenPtr += tokenPtr->numComponents + 1;

	/*
	 * Generate the next variable name
	 */
	code = TclPushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR,
		&localIndex, &simpleVarName, &isScalar);
	if (code != TCL_OK) {
	    return code;
	}

	/*
	 * Emit instructions to get the idx'th item out of the list
	 * value on the stack and assign it to the variable.
	 */
	if (simpleVarName) {
	    if (isScalar) {
		if (localIndex >= 0) {
		    TclEmitOpcode(INST_DUP, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    if (localIndex <= 255) {
			TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
		    } else {
			TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
		    }
		} else {
		    TclEmitInstInt4(INST_OVER, 1, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
		}
	    } else {
		if (localIndex >= 0) {
		    TclEmitInstInt4(INST_OVER, 1, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    if (localIndex <= 255) {
			TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
		    } else {
			TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
		    }
		} else {
		    TclEmitInstInt4(INST_OVER, 2, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
		}
	    }
	} else {
	    TclEmitInstInt4(INST_OVER, 1, envPtr);
	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
	    TclEmitOpcode(INST_STORE_STK, envPtr);
	}
	TclEmitOpcode(INST_POP, envPtr);
    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */
    TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
    TclEmitInt4(-2, envPtr); /* -2 == "end" */

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLindexCmd --
 *
 *	Procedure called to compile the "lindex" command.
 *
 * Results:
 *	The return value is a standard Tcl result, which is TCL_OK if the
 *	compilation was successful.  If the command cannot be byte-compiled,

    int numWords;
    numWords = parsePtr->numWords;

    /*
     * Quit if too few args
     */

    if (numWords <= 1) {
	return TCL_OUT_LINE_COMPILE;
    }

    varTokenPtr = parsePtr->tokenPtr
	+ (parsePtr->tokenPtr->numComponents + 1);

    /*
     * Push the operands onto the stack.
     */

    for (i=1 ; i<numWords ; i++) {
	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    TclEmitPush(
		    TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
		    varTokenPtr[1].size), envPtr);
	} else {
	    code = TclCompileTokens(interp, varTokenPtr+1,
		    varTokenPtr->numComponents, envPtr);
	    if (code != TCL_OK) {
		return code;
	    }
	}
	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
    }

    /*
     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI
     * if there are multiple index args.
     */

    if (numWords == 3) {
	TclEmitOpcode(INST_LIST_INDEX, envPtr);
    } else {
 	TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
    }

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

 *	(7) Finally, INST_STORE_* stores the new value in the variable
 *	    and cleans up the stack.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLsetCmd(interp, parsePtr, envPtr)
    Tcl_Interp* interp;		/* Tcl interpreter for error reporting */
    Tcl_Parse* parsePtr;	/* Points to a parse structure for
				 * the command */
    CompileEnv* envPtr;		/* Holds the resulting instructions */
{

    int tempDepth;		/* Depth used for emitting one part
				 * of the code burst. */
    Tcl_Token* varTokenPtr;	/* Pointer to the Tcl_Token representing
				 * the parse of the variable name */

    int result;			/* Status return from library calls */

    int localIndex;		/* Index of var in local var table */
    int simpleVarName;		/* Flag == 1 if var name is simple */
    int isScalar;		/* Flag == 1 if scalar, 0 if array */

    int i;

    /* Check argument count */

    if (parsePtr->numWords < 3) {
	/* Fail at run time, not in compilation */
	return TCL_OUT_LINE_COMPILE;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we
     * need to emit code to compute and push the name at runtime. We use a
     * frame slot (entry in the array of local vars) if we are compiling a
     * procedure body and if the name is simple text that does not include
     * namespace qualifiers. 
     */

    varTokenPtr = parsePtr->tokenPtr
	    + (parsePtr->tokenPtr->numComponents + 1);
    result = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
	    &localIndex, &simpleVarName, &isScalar);
    if (result != TCL_OK) {
	return result;
    }

    /* Push the "index" args and the new element value. */

    for (i=2 ; i<parsePtr->numWords ; ++i) {

	/* Advance to next arg */

	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);

	/* Push an arg */

	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
		    varTokenPtr[1].size), envPtr);
	} else {
	    result = TclCompileTokens(interp, varTokenPtr+1,
		    varTokenPtr->numComponents, envPtr);
	    if (result != TCL_OK) {
		return result;
	    }
	}
    }

    /*
     * Duplicate the variable name if it's been pushed.  
     */

    if (!simpleVarName || localIndex < 0) {
	if (!simpleVarName || isScalar) {
	    tempDepth = parsePtr->numWords - 2;
	} else {
	    tempDepth = parsePtr->numWords - 1;
	}
	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
    }

    /*
     * Duplicate an array index if one's been pushed
     */

    if (simpleVarName && !isScalar) {
	if (localIndex < 0) {
	    tempDepth = parsePtr->numWords - 1;
	} else {
	    tempDepth = parsePtr->numWords - 2;
	}
	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
    }

    /*
     * Emit code to load the variable's value.
     */

    if (!simpleVarName) {
	TclEmitOpcode(INST_LOAD_STK, envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
	}
    }

    /*
     * Emit the correct variety of 'lset' instruction
     */

    if (parsePtr->numWords == 4) {
	TclEmitOpcode(INST_LSET_LIST, envPtr);
    } else {
	TclEmitInstInt4(INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr);
    }

    /*
     * Emit code to put the value back in the variable
     */

    if (!simpleVarName) {
	TclEmitOpcode(INST_STORE_STK, envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
	}
    }

    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileRegexpCmd --
 *

 *
 * TclCompileReturnCmd --
 *
 *	Procedure called to compile the "return" command.
 *
 * Results:
 *	The return value is a standard Tcl result, which is TCL_OK if the
 *	compilation was successful.  If analysis concludes that the
 *	command cannot be bytecompiled effectively, a return code of
 *	TCL__OUT_LINE_COMPILE is returned.



 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "return" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileReturnCmd(interp, parsePtr, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
				 * command created by Tcl_ParseCommand. */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{





    /*
     * General syntax: [return ?-option value ...? ?result?]

     * An even number of words means an explicit result argument is present.
     */



    int level = 1, code = TCL_OK, status = TCL_OK;
    int numWords = parsePtr->numWords;


    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *returnOpts = iPtr->defaultReturnOpts;



    Tcl_Token *wordTokenPtr = parsePtr->tokenPtr
		+ (parsePtr->tokenPtr->numComponents + 1);

    if (numOptionWords > 0) {
	/* 

	 * Scan through the return options.  If any are unknown at compile
	 * time, there is no value in bytecompiling.  Save the option values
	 * known in an objv array for merging into a return options dictionary.
	 */


	int objc;
	Tcl_Obj **objv = (Tcl_Obj **)
		ckalloc(numOptionWords * sizeof(Tcl_Obj *));
	for (objc = 0; objc < numOptionWords; objc++) {




	    objv[objc] = Tcl_NewObj();
	    Tcl_IncrRefCount(objv[objc]);
	    if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
		objc++;
		status = TCL_ERROR;
		goto cleanup;
	    }
	    wordTokenPtr += wordTokenPtr->numComponents + 1;
	}
	status = TclMergeReturnOptions(interp, objc, objv,
		&returnOpts, &code, &level);
    cleanup:
	while (--objc >= 0) {
	    Tcl_DecrRefCount(objv[objc]);
	}


	ckfree((char *)objv);
	if (TCL_ERROR == status) {
	    /* Something was bogus in the return options.  Clear the
	     * error message, and report back to the compiler that this

	     * must be interpreted at runtime. */
	    Tcl_ResetResult(interp);
	    return TCL_OUT_LINE_COMPILE;
	}
    }

    /* All options are known at compile time, so we're going to
     * bytecompile.   Emit instructions to push the result on
     * the stack */

    if (explicitResult) {
	if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    /* Explicit result is a simple word, so we can compile quickly to
	     * a simple push */
	    TclEmitPush(TclRegisterNewLiteral(envPtr, wordTokenPtr[1].start,
			wordTokenPtr[1].size), envPtr);
	} else {
	    /* More complex tokens get compiled */
	    status = TclCompileTokens(interp, wordTokenPtr+1,
		    wordTokenPtr->numComponents, envPtr);
	    if (TCL_OK != status) {
		return status;
	    }
	}
    } else {
	/* No explict result argument, so default result is empty string */
	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    }

    /* 

     * Check for optimization:  When [return] is in a proc, and there's
     * no enclosing [catch], and the default return options are in effect,
     * then the INST_DONE instruction is equivalent, and considerably more
     * efficient.
     */
    if (returnOpts == iPtr->defaultReturnOpts) {
	/* We have default return options... */
	if (envPtr->procPtr != NULL) {
	    /* ... and we're in a proc ... */
	    int index = envPtr->exceptArrayNext - 1;
	    int enclosingCatch = 0;
	    while (index >= 0) {
		ExceptionRange range = envPtr->exceptArrayPtr[index];
		if ((range.type == CATCH_EXCEPTION_RANGE)
			&& (range.catchOffset == -1)) {
		    enclosingCatch = 1;
		    break;
		}
		index--;
	    }
	    if (!enclosingCatch) {
		/* ... and there is no enclosing catch. */
		TclEmitOpcode(INST_DONE, envPtr);
		return TCL_OK;
	    }
	}
    }

    /*
     * Could not use the optimization, so we push the return options
     * dictionary, and emit the INST_RETURN instruction with code
     * and level as operands.
     */
    TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
    TclEmitInstInt4(INST_RETURN, code, envPtr);
    TclEmitInt4(level, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSetCmd --

		TclEmitOpcode((isAssignment?
		        INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
	    }
	}
    } else {
	TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
    }

    done:
    return code;
}

/*
 *----------------------------------------------------------------------
 *

				 * command created by Tcl_ParseCommand. */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Tcl_Token *opTokenPtr, *varTokenPtr;
    Tcl_Obj *opObj;
    int index;
    int code;

    static CONST char *options[] = {
	"bytelength",	"compare",	"equal",	"first",
	"index",	"is",		"last",		"length",
	"map",		"match",	"range",	"repeat",
	"replace",	"tolower",	"toupper",	"totitle",
	"trim",		"trimleft",	"trimright",
	"wordend",	"wordstart",	(char *) NULL

    /*
     * Generate a test for each arm.
     */

    contFixIndex = -1;
    fixupArray = (JumpFixup *) ckalloc(sizeof(JumpFixup) * argc);
    fixupTargetArray = (int *) ckalloc(sizeof(int) * argc);
    (VOID *) memset(fixupTargetArray, 0, argc * sizeof(int));
    fixupCount = 0;
    foundDefault = 0;
    for (i=0 ; i<argc ; i+=2) {
	int code;		/* Return codes from sub-compiles. */
	int nextArmFixupIndex = -1;

	/*

	    case Switch_Glob:
		TclEmitPush(TclRegisterNewLiteral(envPtr, argv[i],
			(int) strlen(argv[i])), envPtr);
		TclEmitInstInt4(INST_OVER, 1, envPtr);
		TclEmitInstInt1(INST_STR_MATCH, /*nocase*/0, envPtr);
		break;
	    default:
		Tcl_Panic("unknown switch mode: %d",mode);
	    }
	    /*
	     * Process fall-through clauses here...
	     */
	    if (argv[i+1][0]=='-' && argv[i+1][1]=='\0') {
		if (contFixIndex == -1) {
		    contFixIndex = fixupCount;

    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
				 * command created by Tcl_ParseCommand. */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int i, numWords;
    CONST char *varName, *tail;

    if (envPtr->procPtr == NULL) {
	return TCL_OUT_LINE_COMPILE;
    }

    numWords = parsePtr->numWords;

    varTokenPtr = parsePtr->tokenPtr
	+ (parsePtr->tokenPtr->numComponents + 1);
    for (i = 1; i < numWords; i += 2) {
	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    varName = varTokenPtr[1].start;
	    tail = varName + varTokenPtr[1].size - 1;
	    if ((*tail == ')') || (tail < varName)) continue;

    if (loopMayEnd) {
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
	testCodeOffset = 0; /* avoid compiler warning */
    } else {
	testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
    }


    /*
     * Compile the loop body.
     */

    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
    code = TclCompileCmdWord(interp, bodyTokenPtr+1,

	    if (code == TCL_ERROR) {
		Tcl_AddObjErrorInfo(interp,
				    "\n    (\"while\" test expression)", -1);
	    }
	    goto error;
	}
	envPtr->currStackDepth = savedStackDepth + 1;

	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
	if (jumpDist > 127) {
	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
	} else {
	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
	}
    } else {

     * Set the loop's body, continue and break offsets.
     */

    envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
    envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
    envPtr->exceptArrayPtr[range].breakOffset =
	    (envPtr->codeNext - envPtr->codeStart);

    /*
     * The while command's result is an empty string.
     */

    pushResult:
    envPtr->currStackDepth = savedStackDepth;
    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);

	 * A simple variable name. Divide it up into "name" and "elName"
	 * strings. If it is not a local variable, look it up at runtime.
	 */
	simpleVarName = 1;

	name = varTokenPtr[1].start;
	nameChars = varTokenPtr[1].size;
	if (name[nameChars-1] == ')') {
	    /* 
	     * last char is ')' => potential array reference.
	     */

	    for (i=0,p=name ; i<nameChars ; i++,p++) {
		if (*p == '(') {
		    elName = p + 1;
		    elNameChars = nameChars - i - 2;
		    nameChars = i;
		    break;
		}
	    }

	    if ((elName != NULL) && elNameChars) {
		/*
		 * An array element, the element name is a simple

		elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

		/*
		 * Copy the remaining tokens.
		 */

		memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
			((n-1) * sizeof(Tcl_Token)));
	    } else {
		/*
		 * Use the already available tokens.
		 */

		elemTokenPtr = &varTokenPtr[2];
		elemTokenCount = n - 1;	    
	    }
	}
    }

    if (simpleVarName) {

/* 
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompExpr.c,v 1.14.2.3 2004/02/07 05:48:00 dgp Exp $
 */

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

/*
 * The stuff below is a bit of a hack so that this file can be used in

    Tcl_HashEntry *hPtr;
    CONST char *operator;
    Tcl_DString opBuf;
    int objIndex, opIndex, length, code;
    char buffer[TCL_UTF_MAX];

    if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
	Tcl_Panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
	        exprTokenPtr->type);
    }
    code = TCL_OK;

    /*
     * Switch on the type of the first token after the subexpression token.
     * After processing it, advance tokenPtr to point just after the

		    if (code != TCL_OK) {
			goto done;
		    }
		    tokenPtr = endPtr;
		    break;
		    
		default:
		    Tcl_Panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
		        opIndex);
	    } /* end switch on operator requiring special treatment */
	    infoPtr->hasOperators = 1;
	    break;

        default:
	    Tcl_Panic("CompileSubExpr: unexpected token type %d\n",
	            tokenPtr->type);
    }

    /*
     * Verify that the subexpression token had the required number of
     * subtokens: that we've advanced tokenPtr just beyond the
     * subexpression's last token. For example, a "*" subexpression must

    CompileEnv *envPtr;		 /* Holds resulting instructions. */
    Tcl_Token **endPtrPtr;	 /* If successful, a pointer to the token
				  * just after the last token in the
				  * subexpression is stored here. */
{
    JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
				  * after the first subexpression. */
    JumpFixup shortCircuitFixup2;/* Used to fix up the second jump to the
				  * short-circuit target. */
    JumpFixup endFixup;          /* Used to fix up jump to the end. */

    Tcl_Token *tokenPtr;
    int code;
    int savedStackDepth = envPtr->currStackDepth;

    /*
     * Emit code for the first operand.
     */

    tokenPtr = exprTokenPtr+2;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);

    /*



     * Emit the short-circuit jump.



















     */


    TclEmitForwardJump(envPtr,
	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
	    &shortCircuitFixup);

    /*
     * Emit code for the second operand.
     */

    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    tokenPtr += (tokenPtr->numComponents + 1);
	    
    /*

     * The result is the boolean value of the second operand. We 
     * code this in a somewhat contorted manner to be able to reuse
     * the shortCircuit value and save one INST_JUMP.
     */

    TclEmitForwardJump(envPtr,
	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
	    &shortCircuitFixup2);

    if (opIndex == OP_LAND) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
    } else {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);

    /*
     * Fixup the short-circuit jumps and push the shortCircuit value.
     * Note that shortCircuitFixup2 is always a short jump.
     */


    TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup2, 127);
    if (TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup, 127)) {
	/*
	 * shortCircuit jump grown by 3 bytes: update endFixup.
	 */
	    
	 endFixup.codeOffset += 3;
    }

    if (opIndex == OP_LAND) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
    } else {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
    }

    TclFixupForwardJumpToHere(envPtr, &endFixup, 127);
    *endPtrPtr = tokenPtr;

    done:
    envPtr->currStackDepth = savedStackDepth + 1;
    return code;
}


/* 
 * tclCompile.c --
 *
 *	This file contains procedures that compile Tcl commands or parts
 *	of commands (like quoted strings or nested sub-commands) into a
 *	sequence of instructions ("bytecodes"). 
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompile.c,v 1.49.2.3 2004/02/07 05:48:00 dgp Exp $
 */

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

/*
 * Table of all AuxData types.

 * Note that the load, store, and incr instructions do not distinguish local
 * from global variables; the bytecode interpreter at runtime uses the
 * existence of a procedure call frame to distinguish these.
 */

InstructionDesc tclInstructionTable[] = {
   /* Name	      Bytes stackEffect #Opnds Operand types	Stack top, next	  */
    {"done",		  1,   -1,         0,   {OPERAND_NONE}},
	/* Finish ByteCode execution and return stktop (top stack item) */
    {"push1",		  2,   +1,         1,   {OPERAND_UINT1}},
	/* Push object at ByteCode objArray[op1] */
    {"push4",		  5,   +1,         1,   {OPERAND_UINT4}},
	/* Push object at ByteCode objArray[op4] */
    {"pop",		  1,   -1,         0,   {OPERAND_NONE}},
	/* Pop the topmost stack object */
    {"dup",		  1,   +1,         0,   {OPERAND_NONE}},
	/* Duplicate the topmost stack object and push the result */
    {"concat1",		  2,   INT_MIN,    1,   {OPERAND_UINT1}},
	/* Concatenate the top op1 items and push result */
    {"invokeStk1",	  2,   INT_MIN,    1,   {OPERAND_UINT1}},
	/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */

	/* Store scalar variable at op1<=255 in frame; value is stktop */
    {"storeScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
	/* Store scalar variable at op1 > 255 in frame; value is stktop */
    {"storeScalarStk",	  1,   -1,         0,   {OPERAND_NONE}},
	/* Store scalar; value is stktop, scalar name is stknext */
    {"storeArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
	/* Store array element; array at op1<=255, value is top then elem */
    {"storeArray4",	  5,   -1,         1,   {OPERAND_UINT4}},
	/* Store array element; array at op1>=256, value is top then elem */
    {"storeArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
	/* Store array element; value is stktop, then elem, array names */
    {"storeStk",	  1,   -1,         0,   {OPERAND_NONE}},
	/* Store general variable; value is stktop, then unparsed name */
    
    {"incrScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
	/* Incr scalar at index op1<=255 in frame; incr amount is stktop */
    {"incrScalarStk",	  1,   -1,         0,   {OPERAND_NONE}},
	/* Incr scalar; incr amount is stktop, scalar's name is stknext */
    {"incrArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
	/* Incr array elem; arr at slot op1<=255, amount is top then elem */
    {"incrArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
	/* Incr array element; amount is top then elem then array names */
    {"incrStk",		  1,   -1,         0,   {OPERAND_NONE}},
	/* Incr general variable; amount is stktop then unparsed var name */
    {"incrScalar1Imm",	  3,   +1,         2,   {OPERAND_UINT1, OPERAND_INT1}},
	/* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
    {"incrScalarStkImm",  2,   0,          1,   {OPERAND_INT1}},
	/* Incr scalar; scalar name is stktop; incr amount is op1 */
    {"incrArray1Imm",	  3,   0,          2,   {OPERAND_UINT1, OPERAND_INT1}},
	/* Incr array elem; array at slot op1 <= 255, elem is stktop,
	 * amount is 2nd operand byte */
    {"incrArrayStkImm",	  2,   -1,         1,   {OPERAND_INT1}},
	/* Incr array element; elem is top then array name, amount is op1 */
    {"incrStkImm",	  2,   0,	   1,   {OPERAND_INT1}},
	/* Incr general variable; unparsed name is top, amount is op1 */
    
    {"jump1",		  2,   0,          1,   {OPERAND_INT1}},
	/* Jump relative to (pc + op1) */
    {"jump4",		  5,   0,          1,   {OPERAND_INT4}},
	/* Jump relative to (pc + op4) */
    {"jumpTrue1",	  2,   -1,         1,   {OPERAND_INT1}},

	/* Str Length:	push (strlen stktop) */
    {"strindex",	  1,   -1,         0,   {OPERAND_NONE}},
	/* Str Index:	push (strindex stknext stktop) */
    {"strmatch",	  2,   -1,         1,   {OPERAND_INT1}},
	/* Str Match:	push (strmatch stknext stktop) opnd == nocase */
    {"list",		  5,   INT_MIN,    1,   {OPERAND_UINT4}},
	/* List:	push (stk1 stk2 ... stktop) */
    {"listIndex",	  1,   -1,         0,   {OPERAND_NONE}},
	/* List Index:	push (listindex stknext stktop) */
    {"listLength",	  1,   0,          0,   {OPERAND_NONE}},
	/* List Len:	push (listlength stktop) */
    {"appendScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
	/* Append scalar variable at op1<=255 in frame; value is stktop */
    {"appendScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
	/* Append scalar variable at op1 > 255 in frame; value is stktop */
    {"appendArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
	/* Append array element; array at op1<=255, value is top then elem */

	/* Lappend array element; array at op1<=255, value is top then elem */
    {"lappendArray4",	  5,   -1,         1,   {OPERAND_UINT4}},
	/* Lappend array element; array at op1>=256, value is top then elem */
    {"lappendArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
	/* Lappend array element; value is stktop, then elem, array names */
    {"lappendStk",	  1,   -1,         0,   {OPERAND_NONE}},
	/* Lappend general variable; value is stktop, then unparsed name */
    {"lindexMulti",	  5,   INT_MIN,    1,   {OPERAND_UINT4}},
        /* Lindex with generalized args, operand is number of stacked objs 
	 * used: (operand-1) entries from stktop are the indices; then list 
	 * to process. */
    {"over",		  5,   +1,         1,   {OPERAND_UINT4}},
        /* Duplicate the arg-th element from top of stack (TOS=0) */
    {"lsetList",          1,   -2,         0,   {OPERAND_NONE}},
        /* Four-arg version of 'lset'. stktop is old value; next is
         * new element value, next is the index list; pushes new value */
    {"lsetFlat",          5,   INT_MIN,    1,   {OPERAND_UINT4}},
        /* Three- or >=5-arg version of 'lset', operand is number of 
	 * stacked objs: stktop is old value, next is new element value, next 
	 * come (operand-2) indices; pushes the new value.
	 */
    {"return",		  9,   -2,         2,   {OPERAND_INT4, OPERAND_UINT4}},
	/* Compiled [return], code, level are operands; options and result
	 * are on the stack. */
    {"expon",		  1,   -1,	   0,	{OPERAND_NONE}},
	/* Binary exponentiation operator: push (stknext ** stktop) */
    {"listverify",	  1,    0,	   0,   {OPERAND_NONE}},
	/* Test that top of stack is a valid list; error if not */
    {"invokeExp",   INT_MIN,   INT_MIN,    2, {OPERAND_UINT4, OPERAND_ULIST1}},
	/* Invoke with expansion: <objc,objv> = expanded <op1,top op1> */
    {"listIndexImm",	  5,	0,	   1,	{OPERAND_IDX4}},
	/* List Index:	push (lindex stktop op4) */
    {"listRangeImm",	  9,	0,	   2,	{OPERAND_IDX4, OPERAND_IDX4}},
	/* List Range:	push (lrange stktop op4 op4) */
    {0}
};

/*
 * Prototypes for procedures defined later in this file:
 */

    int length, result;
    char *string;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
        if (Tcl_LinkVar(interp, "tcl_traceCompile",
	            (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
            Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
        }
        traceInitialized = 1;
    }
#endif

    string = Tcl_GetStringFromObj(objPtr, &length);
    TclInitCompileEnv(interp, &compEnv, string, length);

    if (envPtr->mallocedCmdMap) {
	ckfree((char *) envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
	ckfree((char *) envPtr->auxDataArrayPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclWordKnownAtCompileTime --
 *
 *	Test whether the value of a token is completely known at compile
 *	time.
 *
 * Results:
 *	Returns true if the tokenPtr argument points to a word value that
 *	is completely known at compile time.  Generally, values that are
 *	known at compile time can be compiled to their values, while values
 *	that cannot be	known until substitution at runtime must be compiled
 *	to bytecode instructions that perform that substitution.  For several
 *	commands, whether or not arguments are known at compile time determine
 *	whether it is worthwhile to compile at all.
 *
 * Side effects:
 *	When returning true, appends the known value of the word to
 *	the unshared Tcl_Obj (*valuePtr), unless valuePtr is NULL.
 *
 *----------------------------------------------------------------------
 */

int
TclWordKnownAtCompileTime(tokenPtr, valuePtr)
    Tcl_Token *tokenPtr;	/* Points to Tcl_Token we should check */
    Tcl_Obj *valuePtr;		/* If not NULL, points to an unshared Tcl_Obj
				 * to which we should append the known value
				 * of the word. */
{
    int numComponents = tokenPtr->numComponents;
    Tcl_Obj *tempPtr = NULL;

    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	if (valuePtr != NULL) {
	    Tcl_AppendToObj(valuePtr, tokenPtr->start, tokenPtr->size);
	}
	return 1;
    }
    if (tokenPtr->type != TCL_TOKEN_WORD) {
	return 0;
    }
    tokenPtr++;
    if (valuePtr != NULL) {
	tempPtr = Tcl_NewObj();
	Tcl_IncrRefCount(tempPtr);
    }
    while (numComponents--) {
	switch (tokenPtr->type) {
	    case TCL_TOKEN_TEXT:
		if (tempPtr != NULL) {
		    Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
		}
		continue;

	    case TCL_TOKEN_BS:
		if (tempPtr != NULL) {
		    char utfBuf[TCL_UTF_MAX];
		    int length = 
			    Tcl_UtfBackslash(tokenPtr->start, NULL, utfBuf);
		    Tcl_AppendToObj(tempPtr, utfBuf, length);
		}
		continue;
	    
	    default:
		if (tempPtr != NULL) {
		    Tcl_DecrRefCount(tempPtr);
		}
		return 0;
	}
    }
    if (valuePtr != NULL) {
	Tcl_AppendObjToObj(valuePtr, tempPtr);
	Tcl_DecrRefCount(tempPtr);
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileScript --
 *
 *	Compile a Tcl script in a string.

		}
		numObjsToConcat++;
		count -= tokenPtr->numComponents;
		tokenPtr += tokenPtr->numComponents;
		break;

	    default:
		Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
			tokenPtr->type, tokenPtr->size, tokenPtr->start);
	}
    }

    /*
     * Push any accumulated characters appearing at the end.
     */