2005-05-11  Kevin Kenny  <kennykb@acm.org>

	* generic/tclStrToD.c (TclStrToD, RefineResult, ParseNaN):
	Changed the code to cast 'char' to UCHAR explicitly when
	using ctype macros, to silence complaints from the Solaris
	compiler.
	
2005-05-10  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/tclUnixFCmd.c: add lint attr to enum to satisfy strictly
	compliant compilers that don't like trailing ,s.

	* tests/string.test: string-10.[21-30]
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to
	prevent possible UMR in unichar cmp function for string map.

2005-05-10  Kevin Kenny  <kennykb@acm.org>

	* generic/tclBinary.c (FormatNumber): Fixed a bug where NaN's
	resulted in reads of uninitialized memory when using 'd',
	'q', or 'Q' format.
	* generic/tclStrToD.c (ParseNaN, TclFormatNaN): Added code to
	handle the peculiarities of HP's PA_RISC, which uses a different
	'quiet' bit in NaN from everyone else.
	* libtommath/tommath_superclass.h: Corrected C++-style comment.
	
2005-05-10  Kevin Kenny  <kennykb@acm.org>

	Merged all changes on kennykb-numerics-branch back into the
	HEAD.  TIP's 132 and 232 are now Final.
	
2005-05-10  Kevin Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch] Merged changes from HEAD.
	
2005-05-10  Miguel Sofer <msofer@users.sf.net>

	* generic/tclExecute.c (ExponLong, ExponWide): 
	* tests/expr.test (expr-23.34/35): fixed special case 'i**0' for
	i>0 [Bug 1198892] 

2005-05-09  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]
	* win/tclWin32Dll.c (TclpCheckStackSpace, TclWinCPUID):
	        Reworked structured event handling to function even
		with -fomit-frame-pointers.
	
2005-05-08  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]
	* generic/tclStrToD.c: Made code more portable by finding a
	                       workaround for MSVC's 'volatile' issue that
			       does not require conditional compilation.
	* win/tclWin32Dll.c (TclWinCPUID): Removed structured event
	                                   handling from the GCC code
					   since (a) bad code is generated
					   by the instruction scheduling
					   with -O2, and (b) it's not
					   needed on any reasonably modern
					   CPU.
	
2005-05-07  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]
	* generic/tclEvent.c:  Moved initialization of tclStrToD.c's
	* generic/tclInt.h:    static constants into a procedure called
	* generic/tclStrToD.c: from TclInitSubsystems to avoid double
	                       checked locking protocol. Cleaned up
			       an issue where MSVC ignored the 'volatile'
			       specifier, causing incorrect comparison
			       of an underflowed number against zero.
	
2005-05-06  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/tcl.m4, unix/configure: correct Solaris 10 (5.10) check and
	add support for x86_64 Solaris cc builds.

2005-05-05  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch] Merged with HEAD.
	
2005-05-05  Kevin B. Kenny  <kennykb@acm.org>

	* win/tclWinThrd.c:  Corrected a compilation error on the
	                     --enable-threads configuration.
	
2005-05-05  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInt.decls:	Converted TclMatchIsTrivial to a macro.
	* generic/tclInt.h:
	* generic/tclUtil.c:
	* generic/tclIntDecls.h:	`make genstubs`
	* generic/tclStubInit.c:
	* generic/tclBasic.c:	Added callers of TclMatchIsTrivial where
	* generic/tclCmdIL.c:	a search can be done more efficiently
	* generic/tclCompCmds.c:when it is recognized that a pattern match
	* generic/tclDictObj.c:	is really an exact match. [Patch 1076088]
	* generic/tclIO.c:
	* generic/tclNamesp.c:
	* generic/tclVar.c:

	* generic/tclCompCmds.c:	Factored common efficiency trick into
	a macro named CompileWord.

	* generic/tclCompCmds.c:	Replaced all instance of
	* generic/tclCompile.c:		TCL_OUT_LINE_COMPILE with TCL_ERROR.
	* generic/tclInt.h:		Now that we've eradicated the mistaken
	* tests/appendComp.test:	notion of a "compile-time error", we
	can use the TCL_ERROR return code to signal any failure to produce
	bytecode.  

2005-05-03  Don Porter  <dgp@users.sourceforge.net>

	* doc/DString.3:	Eliminated use of identifier "string" in Tcl's
	* doc/Environment.3:	public C API to avoid conflict/confusion with
	* doc/Eval.3:		the std::string of C++.
	* doc/ExprLong.3, doc/ExprLongObj.3, doc/GetInt.3, doc/GetOpnFl.3:
	* doc/ParseCmd.3, doc/RegExp.3, doc/SetResult.3, doc/StrMatch.3:

	* generic/tclIOUtil.c (TclGetOpenModeEx):	New routine.
	* generic/tclInt.h:

	* generic/tclIO.c (Tcl_OpenObjCmd):	Support for "b" and
	* doc/open.n:		"BINARY" in "access" argument to [open].
	* tests/ioCmd.test:

2005-04-26  Kevin B. Kenny  <kennykb@users.sourceforge.net>

	* generic/tclBinary.c (FormatNumber):
	Dredge the NaN out of the internal representation if
	Tcl_GetDoubleFromObj returns TCL_ERROR on a NaN.
	
	* generic/tclObj.c (Tcl_GetDoubleFromObj): 
	Restored silent overflow/underflow behaviour that the merge
	of 2004-04-25 messed up.  Thanks to Don Porter for calling 
	attention to this bug. Also removed an uninitialised memory
	reference in this function that valgrind caught. Also changed
	to return TCL_ERROR on a pure NaN.
	
	* generic/tclStrToD.c (RefineResult):
	Added a test for the initial approximation being HUGE_VAL;
	this test avoids EDOM being returned from ldexp on some platforms
	on input values exceeding the floating point range.
	
	* tests/expr.test (expr-29.*, expr-30.*): 
	Added further tests of overflow/underflow on input conversions.
	
2005-04-25  Kevin B. Kenny  <kennykb@users.sourceforge.net>

	[kennykb-numerics-branch] Merged with HEAD.

	* doc/CrtMathFunc.n:		Revised documentation for TIP 232
	
2005-04-25  Daniel Steffen  <das@users.sourceforge.net>

	* compat/string.h: fixed memchr() protoype for __APPLE__ so that we
	build on Mac OS X 10.1 again.

	* generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being
	finalized in unthreaded core (was testing for notifier initialization in

	values like "47" and "0xac" to be accepted as booleans.

	* generic/tclLiteral.c:	Disabled the code that forces some literals
	into the "int" Tcl_ObjType during registration.  We can re-enable it
	if this change causes trouble, but it seems more sensible to let
	Tcl's "on-demand" shimmering rule, and not try to pre-guess things.

2005-04-20  Kevin B. Kenny <kennykb@acm.org>

	[kennykb-numerics-branch]
	* doc/expr.n:
	* doc/mathfunc.n (new file):	Revised documentation for TIP 232
	
2005-04-20  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclGet.c (Tcl_GetInt):	Corrected error that did not
	* generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be 
	recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869].

2005-04-20  Kevin B. Kenny  <kennykb@acm.org>

	
2005-04-11  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>

	* tools/tclZIC.tcl: Rewrote to take advantage of more features of
	Tcl 8.5 (on which it was dependent anyway). Also added a [package
	require] line to formalize the relationship.

2005-04-11  Kevin Kenny <kennykb@users.sf.net>

        [kennykb-numerics-branch] Merged with HEAD. Updated to libtommath 0.35.

	* generic/tclBasic.c: Attempted to repeat changes that applied
	to tclExecute.c in Miguel Sofer's commit of 2005-04-01, together
	with (possibly) a few more uses of his new object creation macros.
	Also plugged a memory leak in TclObjInvoke. [Bug 1180368]
	
2005-04-10  Kevin Kenny  <kennykb@acm.org>

	* library/tzdata/America/Montevideo:
	* library/tzdata/Asia/Almaty:
	* library/tzdata/Asia/Aqtau:
	* library/tzdata/Asia/Aqtobe:
	* library/tzdata/Asia/Baku:

	* tests/winFCMd.test: fix to 'file pathtype' and 'file norm' 
	failures on reserved filenames like 'COM1:', etc.

2005-03-15  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* unix/tcl.m4:    Updated the OpenBSD configuration and regenerated
	* unix/configure: the configure script.
	
2005-03-15  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch] Merged with HEAD.
	
	* generic/tclBasic.c (many):
	* generic/tclCompExpr.c (CompileMathFuncCall):
	* generic/tclCompile.h:
	* generic/tclExecute.c (many):
	* generic/tclParseExpr.c (ParsePrimaryExpr):
	* tests/compExpr-old.test:
	* tests/compExpr.test:
	* tests/compile.test:
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/for.test:
	* tests/parseExpr.test:
	Initial implementation of TIP #232.

	* generic/tclObj.c (Tcl_DbNewBignumObj): Fixed typo that broke
	--enable-symbols=mem build
	* tests/binary.test (binary-40.3, binary-40.6): Corrected tests
	to allow NaN(7ffffffffffff).
	
2005-03-14  Miguel Sofer <msofer@users.sf.net>

	* generic/tclExecute.c: fixed INST_PUSH1's debugging code (wrong
	obj ref passed to TRACE_WITH_OBJ).

2005-03-14  Miguel Sofer <msofer@users.sf.net>

	cast of ClientData to (TraceCommandInfo *) when not warranted.
	Thanks to Yuri Victorovich for the report.  [Bug 1153871]
	* generic/tcl.h:	Moved flag values TCL_TRACE_ENTER_EXEC and
	* generic/tclInt.h:	TCL_TRACE_LEAVE_EXEC from public interface
	into private.  Should be used only by internal workings of
	execution traces.

2005-03-09  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch] Merged from HEAD.

	* doc/PrintDbl.3:
	* doc/tclVars.n: Documented new semantics for tcl_precision.
	* generic/tclExecute.c (Tcl_ExecuteByteCode): Removed the check
	for division-by-zero on IEEE-754 machines.
	* generic/tclUtil.c (Tcl_PrintDouble): Corrected bug where numbers
	in the range [1e-4 .. 1.) were printed incorrectly.
	* tests/compExpr-old.test (compExpr-old-11.13): Revised test
	case for division by zero
	* tests/expr-old.test (expr-34.11, expr-34.12): Revised test
	cases for overflow in pow() to deal with infinities.
	* tests/expr.test (expr-11.13, expr-29.1, expr-29.2): Revised
	test case for division by zero and for underflow on input
	conversions.
	* tests/parseExpr.test (parseExpr-16.11): Revised test case for
	overflow on input conversion.
	* tests/string.test (string-6.38 deleted): Removed test case
	for underflow on input conversion, which is no longer an error.
	* tests/util.test (util-10.*): Added test case for the bug in
	tclUtil.c.
	
2005-03-08  Jeff Hobbs  <jeffh@ActiveState.com>

	* win/makefile.vc: clarify necessary defined vars that can come
	from MSVC or the Platform SDK.

2005-03-07  Donal K. Fellows  <dkf@users.sf.net>

	* doc/string.n: Minor typo. [Bug 1158247]

2005-03-07  Miguel Sofer <msofer@users.sf.net>

	* generic/tclExecute.c: new peephole optimisation for INST_PUSH1;
	fixed the peephole opt in INST_POP so that it is not used when
	TCL_COMPILE_DEBUG is defined.

2005-03-04  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]
	
	* generic/tclCmdMZ.c: Changed [scan] to treat out-of-range
	floating point values as infinities and zeroes.
	* generic/tclExecute.c: Changed [expr] to be permissive about
	infinities, allowing them to propagate.
	* generic/tclGet.c: Changed Tcl_GetDouble to be permissive about
	over/underflow.
	* generic/tclObj.c: Changed SetDoubleFromAny to be permissive
	about over/underflow.
	* generic/tclParseExpr.c: Made [expr] permissive about input
	numbers out of range.
	
2005-03-03  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]

	* generic/tclInt.h:
	* generic/tclStrToD.c (Tcl_DoubleDigits, TclFormatNaN):
	* generic/tclUtil.c (Tcl_PrintDouble):   
		Changed the signature of TclDoubleDigits so that it
		accepts a pointer to the signum of the argument, and
		returns the signum via that pointer.  Added very
		hacky code to handle IEEE signed zeroes in Tcl_DoubleDigits.
		(It can't be done other than as a hack until C9x;
		C89 simply doesn't deal with the concept of -0.0).
		Added output conversion of tagged NaN values.
	* generic/tclBinary.c (FormatNumber):
		Changed to allow [binary format] to handle NaN.
	* tests/binary.test (binary-60.1):
		Added a quick-n-dirty test to make sure that NaN's
		can be scanned and formatted.
	* generic/tclParseExpr.c (GetLexeme, ParseMaxDoubleLength):
		Modified so that tagged NaN (e.g., NaN(DEADBEEF)) can
		be recognized.
	
2005-03-02  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch] Merged with HEAD as of 2005-02-23.
	
	* generic/tclExecute.c:
		Broadened test for NaN to work on Windows.
	* generic/tclInt.h:		  
	* generic/tclStrToD.c (Tcl_DoubleDigits):
	* generic/tclUtil.c (Tcl_PrintDouble, TclPrecTraceProc):
		Added Tcl_DoubleDigits to format 'double' numbers
	        with the minimum number of significant digits to
	        yield correct rounding.  Modified tcl_precision to
	        accept 0 as a precision (meaning "minimum digits"), and
	        made 0 the default.  [TIP #132]
	* generic/tclObj.c:
		Made NaN's throw an error in Tcl_GetDoubleFromObj.
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:
		Added libtommath/bn_mp_init_set.c to the build.
	* libtommath/tommath.h (mp_iseven): 
		Fixed a bug that caused zero to test 'odd'.
	* generic/tommath.h: 
		Regenerated.
	* tests/binary.test: 
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/scan.test:
		Corrected a number of tests that depended on
		tcl_precision, and removed the {eformat} condition
		from tests that no longer require it.
	* tests/util.test: 
		Corrected a number of tests that depended on
		tcl_precision, and removed the {eformat} condition
		from tests that no longer require it.  Added a series
		of tests for correct rounding in Tcl_PrintDouble. [TIP
		#132].
	
2005-03-01  David N. Welton  <davidw@dedasys.com>

	* doc/CrtSlave.3: Changed to Tcl_Object to Tcl_Obj in the man
	page.

2005-02-24  Don Porter  <dgp@users.sourceforge.net>

	* doc/binary.n: Made the documentation of sign bit masking and
	[binary scan] consistent. [Bug 1117017]

2005-02-08  David N. Welton  <davidw@dedasys.com>

	* doc/CrtChannel.3: Typo: return->returns.

2005-02-06  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]
	
	* generic/tclStrToD.c (TclStrToD, SafeLdExp):
	    Added code to manage the FPU precision on gcc+x86.
	    Enabled fast conversion of floats with small exponents
	    now that precision is correct.
	* tests/expr.test: Corrected test for the smallest representible
	    value to the right IEEE values.
	
2005-02-06  David N. Welton  <davidw@dedasys.com>

	* doc/Thread.3: One-word grammar fix.

2005-02-05  David N. Welton  <davidw@dedasys.com>

	* doc/Thread.3: Fixed sentence describing flags for
	Tcl_CreateThread.

	* doc/FileSystem.3: Cleaned up typo in Tcl_FSNewNativePath
	documentation.

	* generic/tclPathObj.c: Cleaned up typo in comment.

2005-02-03  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]
	
	* generic/tclStrToD.c (TclStrToD, RefineResult, SafeLdExp):
	    Added code to ensure that 'ldexp' is never called with
	    a value that will underflow.
	* tests/expr.test: Added tests for the smallest representible
	    value, and rounding between it and zero. (The tests reflect
	    current behaviour; plan is to change the specification of
	    Tcl so that input conversion of doubles underflows silently.)
	
2005-02-02  Mo DeJong  <mdejong@users.sourceforge.net>

	* generic/tclProc.c (TclInitCompiledLocals):
	Add check for type of the framePtr->procPtr->bodyPtr
	passed to TclInitCompiledLocals and panic if
	it is not the correct type. If the body of the proc
	is not of the compiled byte code type then the
	code will crash. This was discovered while tracking
	down a crash in Itcl, that crash is fixed by
	Itcl patch 1115085.

2005-02-01  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]  Merged with HEAD as of today.
	
	* generic/tclInt.decls: 
	    Changed numbers of new stubs to resolve a conflict.
	* generic/tclInt.h:
	    Added new TclStrToD routine that replaces the native
	    'strtod' thro
	ughout Tcl.
	* generic/tclCmdMZ (Tcl_StringObjCmd):
	* generic/tclGet.c (Tcl_GetDouble):
	* generic/tclObj.c (SetBooleanFromAny, SetDoubleFromAny):
	* generic/tclParseExpr.c (GetLexeme):
	* generic/tclScan.c (Tcl_ScanObjCmd):
	    Replaced all uses of the native 'strtod' with a TclStrToD
	    routine that performs correct rounding and handles denormals.
	* generic/tclStrToD.c: (new file)
	    New scanning function for extracting 'double' from a string
	    that rounds correctly, and handles denormals and infinities.
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:
	    Added tclStrToD.c and the tommath routines that support it.

	These changes represent a partial implementation of TIP #132.
	Output conversion of floating point numbers, and proper handling
	of infinities within expressions, still need to be addressed.
	
2005-02-01  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclExecute.c (TclCompEvalObj): Removed stray statement
	left behind in prior code reorganization.

2005-01-31  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileName.c:

2005-01-21  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* doc/FileSystem.3: Add missing ARGUMENTS section definitions for
	arguments to Tcl_FSLink. [Bug 1106272]

2005-01-21  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]

	* unix/Makefile.in:     Updated Makefile to build libtommath on
				Unix as well as Windows. [Bug 1106865]

	* generic/tclTestObj.c (TestbignumobjCmd): 
	Silenced a compiler warning about a mismatched 'const'.
	
2005-01-20  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch] Development checkpoint.
	
	* compat/strtoll.c: 	Reverted to HEAD.
	* compat/strtoull.c:
	* doc/Ensemble.3:
	* generic/tclBasic.c:
	* generic/tclCmdIL.c:
	* generic/tclNamesp.c:
	* generic/tclPathObj.c:
	* generic/tclPort.h:
	* unix/configure:
	* unix/configure.in:
	* unix/tcl.m4:
	* win/configure:
	* win/configure.in:
	* win/rules.vc:
	* win/tcl.m4:

	* generic/tcl.h: Added declarations for bignum types, and
	                 for a 'bignumValue' in the Tcl_Obj structure.
	* generic/tclInt.h: Added declarations of interface procedures
	                    for memory allocation in libtommath.
	
	* generic/tcl.decls: Added new interface to bignum objects.
	* generic/tclInt.decls: Added internal stubs for bignum routines
	                        used by the test code in tclTestObj.c.
	
	* generic/tclDecls/h: 		Regen.
	* generic/tclIntDecls.h:
	* generic/tclStubInit.h:

	* tools/fix_tommath_h.tcl: (New file) Script to edit 
				   libtommath/tommath.h and produce
				   generic/tommath.h so that storage
				   classes, allocation routines, and
	                           data types conform to Tcl's
				   conventions.
	* generic/tommath.h: (New file) Generated by the above.

	* generic/tclTomMath.h: (New file) Additional declarations
				to be included in tommath.h when building
				Tcl.

	* generic/tclTomMathInterface.c: (New file) Small 'glue' routines
					 adapting tommath's API to Tcl.

	* libtommath/bn_fast_s_mp_mul_digs.c:
	* libtommath/bn_mp_mul_d.c:
	* libtommath/bn_mp_read_radix.c:
	* libtommath/tommath.h: Applied suggested changes from Tom St
	Denis that correct an off-by-one error in single-digit
	multiplication (leading to a pointer smash if uncorrected) and
	change the string argument to 'mp_read_radix' from 'char*' to
	'const char*'.

	* libtommath/bn_mp_radix_size.c:
	Local patch to ensure that sufficient memory is requested
	even if the number has a single digit.
	
	* libtommath/bn_mp_read_radix.c:
	Local patch to return MP_VAL if the input string contains
	an invalid character.

	* generic/tclObj.c: Added accessor functions for bignums.
	* generic/tclTestObj.c: Added a 'testbignumobj' command to
	exercise the accessor functions for bignums.

	* win/Makefile.in: Added rules for making libtommath.
	
2005-01-19  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	TIP#235 IMPLEMENTATION

	* doc/Ensemble.3: Documentation for the new public API.
	* generic/tclNamesp.c (Tcl_CreateEnsemble,...): Rename of
	* generic/tcl.decls:		existing API into TIPped form.

'\"
'\" 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: CrtMathFnc.3,v 1.7.2.5 2005/05/11 16:58:32 dgp Exp $
'\" 
.so man.macros
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
.SH SYNOPSIS

passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
.BE

.SH DESCRIPTION
.PP
Tcl allows a number of mathematical functions to be used in
expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
These functions are represented by commands in the namespace,
\fBtcl::mathfunc\fR.  The \fBTcl_CreateMathFunc\fR function is
an obsolete way for applications to add additional functions
to those already provided by Tcl or to replace existing functions.
It should not be used by new applications, which should create
math functions using \fBTcl_CreateObjCommand\fR to create a command
in the \fBtcl::mathfunc\fR namespace.
.PP
In the \fBTcl_CreateMathFunc\fR interface,
\fIName\fR is the name of the function as it will appear in expressions.
If \fIname\fR doesn't already exist in the \fB::tcl::mathfunc\fR
namespace, then a new command is created in that namespace.
If \fIname\fR does exist, then the existing function is replaced.
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
Each entry in the \fIargTypes\fR array must be
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR,
or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an
integer, a double-precision floating value, a wide (64-bit) integer,
or any, respectively.
.PP

\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
is returned and an error message is placed in the interpreter's
result.
.PP
If an error did not occur, the array reference placed in the variable
pointed to by \fIargTypesPtr\fR is newly allocated, and should be
released by passing it to \fBTcl_Free\fR.  Some functions (the
standard set implemented in the core, and those defined by placing
commands in the \fBtcl::mathfunc\fR namespace) do not have
argument type information; attempting to retrieve values for
them causes a NULL to be stored in the variable pointed to by 
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
will not be modified.  The variable pointed to by \fInumArgsPointer\fR
will contain -1, and no argument types will be stored in the variable
pointed to by \fIargTypesPointer\fR.
.PP
\fBTcl_ListMathFuncs\fR returns a Tcl object containing a list of all
the math functions defined in the interpreter whose name matches
\fIpattern\fR.  In the case of an error, NULL is returned and an error
message is left in the interpreter result, and otherwise the returned
object will have a reference count of zero.

.SH KEYWORDS
expression, mathematical function

.SH "SEE ALSO"
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)

'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: PrintDbl.3,v 1.2.42.5 2005/05/11 16:58:32 dgp Exp $
'\" 
.so man.macros
.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_PrintDouble \- Convert floating value to string
.SH SYNOPSIS

\fBTcl_PrintDouble\fR generates a string that represents the value
of \fIvalue\fR and stores it in memory at the location given by
\fIdst\fR.  It uses \fB%g\fR format to generate the string, with one
special twist: the string is guaranteed to contain either
a ``.'' or an ``e'' so that it doesn't look like an integer.  Where
\fB%g\fR would generate an integer with no decimal point, \fBTcl_PrintDouble\fR
adds ``.0''.
.VS 8.5
.PP
If the \fBtcl_precision\fR value is non-zero, the result will have
precisely that many digits of significance.  If the value is zero
(the default), the result will have the fewest digits needed to
represent the number in such a way that \fBTcl_NewDoubleObj\fR
will generate the same number when presented with the given string.
IEEE semantics of rounding to even apply to the conversion.
.VE

.SH KEYWORDS
conversion, double-precision, floating-point, string

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
.\" Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. 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: expr.n,v 1.10.4.7 2005/05/11 16:58:32 dgp Exp $
'\" 
.so man.macros
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression

will be used as the operand without any substitutions.
.IP [6]
As a Tcl command enclosed in brackets.
The command will be executed and its result will be used as
the operand.
.IP [7]
As a mathematical function whose arguments have any of the above
forms for operands, such as \fBsin($x)\fR.  See MATH FUNCTIONS below for
a discussion of how mathematical functions are handled.
.LP
Where the above substitutions occur (e.g. inside quoted strings), they
are performed by the expression's instructions.
However, the command parser may already have performed one round of
substitution before the expression processor was called.
As discussed below, it is usually best to enclose expressions
in braces to prevent the command parser from performing substitutions

only one of \fB[a]\fR or \fB[b]\fR will actually be evaluated,
depending on the value of \fB$v\fR.  Note, however, that this is
only true if the entire expression is enclosed in braces;  otherwise
the Tcl parser will evaluate both \fB[a]\fR and \fB[b]\fR before
invoking the \fBexpr\fR command.
.SS "MATH FUNCTIONS"
.PP
When the expression parser encounters a mathematical function









such as \fBsin($x)\fR, it replaces it with a call to an ordinary

































Tcl function in the \fBtcl::mathfunc\fR namespace.  The processing
of an expression such as:
.CS




\fBexpr {sin($x+$y)}\fR


.CE

is the same in every way as the processing of:

.CS



























\fBexpr {[tcl::mathfunc::sin [expr {$x+$y}]]}







.CE



















The executor will search for \fBtcl::mathfunc::sin\fR using the



usual rules for resolving functions in namespaces. Either
\fB::tcl::mathfunc::sin\fR or \fB[namespace current]::tcl::mathfunc::sin\fR
will satisfy the request.




.PP


See the \fBmathfunc(n)\fR manual page for the math functions that are
available by default.
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
All internal computations involving integers are done with the C type
\fIlong\fR, and all internal computations involving floating-point are
done with the C type \fIdouble\fR.
When converting a string to floating-point, exponent overflow is
detected and results in a Tcl error.

unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
.SH EXAMPLES
Define a procedure that computes an "interesting" mathematical
function:
.CS
proc tcl::mathfunc::calc {x y} {
    \fBexpr\fR { ($x**2 - $y**2) / exp($x**2 + $y**2) }
}
.CE
.PP
Convert polar coordinates into cartesian coordinates:
.CS
# convert from ($radius,$angle)

.PP
Generate a random integer in the range 0..99 inclusive:
.CS
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE

.SH "SEE ALSO"
array(n), for(n), if(n), mathfunc(n), namespace(n), proc(n), string(n), Tcl(n), while(n)

.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison

.SH COPYRIGHT
Copyright (c) 1993 The Regents of the University of California.
.br
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
.br
Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.

.\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. 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: mathfunc.n,v 1.2.2.2 2005/05/11 16:58:32 dgp Exp $
'\" 
.so man.macros
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
package require \fBTcl 8.5\fR
.sp
\fB::tcl::mathfunc::abs\fR \fIarg\fR
.br
\fB::tcl::mathfunc::acos\fR \fIarg\fR
.br
\fB::tcl::mathfunc::asin\fR \fIarg\fR
.br
\fB::tcl::mathfunc::atan\fR \fIarg\fR
.br
\fB::tcl::mathfunc::atan2\fR \fIy\fR \fIx\fR
.br
\fB::tcl::mathfunc::ceil\fR \fIarg\fR
.br
\fB::tcl::mathfunc::cos\fR \fIarg\fR
.br
\fB::tcl::mathfunc::cosh\fR \fIarg\fR
.br
\fB::tcl::mathfunc::double\fR \fIarg\fR
.br
\fB::tcl::mathfunc::exp\fR \fIarg\fR
.br
\fB::tcl::mathfunc::floor\fR \fIarg\fR
.br
\fB::tcl::mathfunc::fmod\fR \fIx\fR \fIy\fR
.br
\fB::tcl::mathfunc::hypot\fR \fIx\fR \fIy\fR
.br
\fB::tcl::mathfunc::int\fR \fIarg\fR
.br
\fB::tcl::mathfunc::log\fR \fIarg\fR
.br
\fB::tcl::mathfunc::log10\fR \fIarg\fR
.br
\fB::tcl::mathfunc::pow\fR \fIx\fR \fIy\fR
.br
\fB::tcl::mathfunc::rand\fR
.br
\fB::tcl::mathfunc::round\fR \fIarg\fR
.br
\fB::tcl::mathfunc::sin\fR \fIarg\fR
.br
\fB::tcl::mathfunc::sinh\fR \fIarg\fR
.br
\fB::tcl::mathfunc::sqrt\fR \fIarg\fR
.br
\fB::tcl::mathfunc::srand\fR \fIarg\fR
.br
\fB::tcl::mathfunc::tan\fR \fIarg\fR
.br
\fB::tcl::mathfunc::tanh\fR \fIarg\fR
.br
\fB::tcl::mathfunc::wide\fR \fIarg\fR
.sp
.BE
.SH "DESCRIPTION"
.PP
The \fBexpr\fR command handles mathematical functions of the form
\fBsin($x)\fR or \fBatan2($y,$x)\fR by converting them to calls of the
form \fB[tcl::math::sin [expr {$x}]]\fR or
\fB[tcl::math::atan2 [expr {$y}] [expr {$x}]]\fR.
A number of math functions are available by default within the
namespace \fB::tcl::mathfunc\fR; these functions are also available
for code apart from \fBexpr\fR, by invoking the given commands
directly.
.PP
Tcl supports the following mathematical functions in expressions, all
of which work solely with floating-point numbers unless otherwise noted:
.DS
.ta 3c 6c 9c
\fBabs\fR	\fBcosh\fR	\fBlog\fR	\fBsqrt\fR
\fBacos\fR	\fBdouble\fR	\fBlog10\fR	\fBsrand\fR
\fBasin\fR	\fBexp\fR	\fBpow\fR	\fBtan\fR
\fBatan\fR	\fBfloor\fR	\fBrand\fR	\fBtanh\fR
\fBatan2\fR	\fBfmod\fR	\fBround\fR	\fBwide\fR
\fBceil\fR	\fBhypot\fR	\fBsin\fR
\fBcos\fR	\fBint\fR	\fBsinh\fR
.DE
.PP
.TP
\fBabs(\fIarg\fB)\fR
Returns the absolute value of \fIarg\fR.  \fIArg\fR may be either
integer or floating-point, and the result is returned in the same form.
.TP
\fBacos(\fIarg\fB)\fR
Returns the arc cosine of \fIarg\fR, in the range [\fI0\fR,\fIpi\fR]
radians. \fIArg\fR should be in the range [\fI-1\fR,\fI1\fR].
.TP
\fBasin(\fIarg\fB)\fR
Returns the arc sine of \fIarg\fR, in the range [\fI-pi/2\fR,\fIpi/2\fR]
radians.  \fIArg\fR should be in the range [\fI-1\fR,\fI1\fR].
.TP
\fBatan(\fIarg\fB)\fR
Returns the arc tangent of \fIarg\fR, in the range [\fI-pi/2\fR,\fIpi/2\fR]
radians.
.TP
\fBatan2(\fIy, x\fB)\fR
Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [\fI-pi\fR,\fIpi\fR]
radians.  \fIx\fR and \fIy\fR cannot both be 0.  If \fIx\fR is greater
than \fI0\fR, this is equivalent to \fBatan(\fIy/x\fB)\fR.
.TP
\fBceil(\fIarg\fB)\fR
Returns the smallest integral floating-point value (i.e. with a zero
fractional part) not less than \fIarg\fR.
.TP
\fBcos(\fIarg\fB)\fR
Returns the cosine of \fIarg\fR, measured in radians.
.TP
\fBcosh(\fIarg\fB)\fR
Returns the hyperbolic cosine of \fIarg\fR.  If the result would cause
an overflow, an error is returned.
.TP
\fBdouble(\fIarg\fB)\fR
If \fIarg\fR is a floating-point value, returns \fIarg\fR, otherwise converts
\fIarg\fR to floating-point and returns the converted value.
.TP
\fBexp(\fIarg\fB)\fR
Returns the exponential of \fIarg\fR, defined as \fIe\fR**\fIarg\fR.
If the result would cause an overflow, an error is returned.
.TP
\fBfloor(\fIarg\fB)\fR
Returns the largest integral floating-point value (i.e. with a zero
fractional part) not greater than \fIarg\fR.
.TP
\fBfmod(\fIx, y\fB)\fR
Returns the floating-point remainder of the division of \fIx\fR by
\fIy\fR.  If \fIy\fR is 0, an error is returned.
.TP
\fBhypot(\fIx, y\fB)\fR
Computes the length of the hypotenuse of a right-angled triangle
\fBsqrt(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fB)\fR.
.TP
\fBint(\fIarg\fB)\fR
If \fIarg\fR is an integer value of the same width as the machine
word, returns \fIarg\fR, otherwise
converts \fIarg\fR to an integer (of the same size as a machine word,
i.e. 32-bits on 32-bit systems, and 64-bits on 64-bit systems) by
truncation and returns the converted value.
.TP
\fBlog(\fIarg\fB)\fR
Returns the natural logarithm of \fIarg\fR.  \fIArg\fR must be a
positive value.
.TP
\fBlog10(\fIarg\fB)\fR
Returns the base 10 logarithm of \fIarg\fR.  \fIArg\fR must be a
positive value.
.TP
\fBpow(\fIx, y\fB)\fR
Computes the value of \fIx\fR raised to the power \fIy\fR.  If \fIx\fR
is negative, \fIy\fR must be an integer value.
.TP
\fBrand()\fR
Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR).  
The generator algorithm is a simple linear congruential generator that
is not cryptographically secure.  Each result from \fBrand\fR completely
determines all future results from subsequent calls to \fBrand\fR, so
\fBrand\fR should not be used to generate a sequence of secrets, such as
one-time passwords.  The seed of the generator is initialized from the
internal clock of the machine or may be set with the \fBsrand\fR function.
.TP
\fBround(\fIarg\fB)\fR
If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
\fIarg\fR to integer by rounding and returns the converted value.
.TP
\fBsin(\fIarg\fB)\fR
Returns the sine of \fIarg\fR, measured in radians.
.TP
\fBsinh(\fIarg\fB)\fR
Returns the hyperbolic sine of \fIarg\fR.  If the result would cause
an overflow, an error is returned.
.TP
\fBsqrt(\fIarg\fB)\fR
Returns the square root of \fIarg\fR.  \fIArg\fR must be non-negative.
.TP
\fBsrand(\fIarg\fB)\fR
The \fIarg\fR, which must be an integer, is used to reset the seed for
the random number generator of \fBrand\fR.  Returns the first random
number (see \fBrand()\fR) from that seed.  Each interpreter has its own seed.
.TP
\fBtan(\fIarg\fB)\fR
Returns the tangent of \fIarg\fR, measured in radians.
.TP
\fBtanh(\fIarg\fB)\fR
Returns the hyperbolic tangent of \fIarg\fR.
.TP
\fBwide(\fIarg\fB)\fR
Converts \fIarg\fR to an integer value at least 64-bits wide (by sign-extension
if \fIarg\fR is a 32-bit number) if it is not one already.
.PP
In addition to these predefined functions, applications may
define additional functions by using \fBproc\fR (or any other method,
such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
new commands in the \fBtcl::mathfunc\fR namespace.  In addition, an
obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
extensions that are written in C. The latter interface is not recommended
for new implementations..
.SH "SEE ALSO"
expr(n), namespace(n)
.SH "COPYRIGHT"
Copyright (c) 1993 The Regents of the University of California.
.br
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
.br
Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.

'\"
'\" 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.8 2005/05/11 16:58:32 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

This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.RE
.TP
\fBtcl_precision\fR
This variable controls the number of digits to generate
when converting floating-point values to strings.  It defaults
.VS 8.5
to 0.  \fIApplications should not change this value;\fR it is
provided for compatibility with legacy code.
.PP
The default value of 0 is special, meaning that Tcl should
convert numbers using as few digits as possible while still
distinguishing any floating point number from its nearest
neighbours.  It differs from using an arbitrarily high value
for \fItcl_precision\fR in that an inexact number like \fI1.4\fR
will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR
even though the latter is nearer to the exact value of the
binary number.
.VE 8.5
.PP
17 digits is ``perfect'' for IEEE floating-point in that it allows
double-precision values to be converted to strings and back to
binary with no loss of information.  However, using 17 digits prevents
any rounding, which produces longer, less intuitive results.  For example,
\fBexpr 1.4\fR returns 1.3999999999999999 with \fBtcl_precision\fR
set to 17, vs. 1.4 if \fBtcl_precision\fR is 12.
.RS

# 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.12 2005/05/11 16:58:32 dgp Exp $

library tcl

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

	    Tcl_ScaleTimeProc** scaleProc,
	    ClientData* clientData)
}
# TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4
declare 554 generic {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr)
}

# TIP #237:

declare 555 generic {
    Tcl_Obj* Tcl_NewBignumObj( mp_int* value )
}
declare 556 generic {
    Tcl_Obj* Tcl_DbNewBignumObj( mp_int* value, CONST char* file, int line )
}
declare 557 generic {
    void Tcl_SetBignumObj( Tcl_Obj* obj, mp_int* value )
}
declare 558 generic {
    int Tcl_GetBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat

 * 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.21 2005/05/11 16:58:32 dgp Exp $
 */

#ifndef _TCL
#define _TCL

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

	double doubleValue;	/*   - a double-precision floating value */
	VOID *otherValuePtr;	/*   - another, type-specific value */
	Tcl_WideInt wideValue;	/*   - a long long value */
	struct {		/*   - internal rep as two pointers */
	    VOID *ptr1;
	    VOID *ptr2;
	} twoPtrValue;
	struct {		/*   - internal rep as a wide int,
				 *     tightly packed fields */
	    VOID *digits;	/* Pointer to digits */
	    unsigned long misc;	/* Alloc, used, and signum packed
				 * into a single word */
	} bignumValue;
    } internalRep;
} Tcl_Obj;


/*
 * Macros to increment and decrement a Tcl_Obj's reference count, and to
 * test whether an object is shared (i.e. has reference count > 1).

/*
 * Macros and definitions that help to debug the use of Tcl objects.
 * When TCL_MEM_DEBUG is defined, the Tcl_New declarations are 
 * overridden to call debugging versions of the object creation procedures.
 */

#ifdef TCL_MEM_DEBUG
#  define Tcl_NewBignumObj(val) \
     Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
#  define Tcl_NewBooleanObj(val) \
     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
#  define Tcl_NewByteArrayObj(bytes, len) \
     Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
#  define Tcl_NewDoubleObj(val) \
     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
#  define Tcl_NewIntObj(val) \

 * when a command- or time-limit is exceeded by an interpreter.
 */

typedef void (Tcl_LimitHandlerProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp));
typedef void (Tcl_LimitHandlerDeleteProc) _ANSI_ARGS_((ClientData clientData));


#ifndef MP_INT_DECLARED
typedef struct mp_int mp_int;
#define MP_INT_DECLARED
#endif
#ifndef MP_DIGIT_DECLARED
typedef unsigned long mp_digit;
#define MP_DIGIT_DECLARED
#endif

#ifndef TCL_NO_DEPRECATED

    /*
     * Deprecated Tcl procedures:
     */

 * 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.26 2005/05/11 16:58:32 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#ifndef TCL_NO_MATH
#include <math.h>
#endif

/*
 * The following structure defines the client data for a math function
 * registered with Tcl_CreateMathFunc
 */

typedef struct OldMathFuncData {
    Tcl_MathProc* proc;		/* Handler procedure */
    int numArgs;		/* Number of args expected */
    Tcl_ValueType* argTypes;	/* Types of the args */
    ClientData clientData;	/* Client data for the handler function */
} OldMathFuncData;

/*
 * Static procedures in this file:
 */

static char *		CallCommandTraces _ANSI_ARGS_((Interp *iPtr, 
			    Command *cmdPtr, CONST char *oldName, 
			    CONST char* newName, int flags));
static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
static void		ProcessUnexpectedResult _ANSI_ARGS_((
			    Tcl_Interp *interp, int returnCode));

static int		OldMathFuncProc _ANSI_ARGS_((ClientData clientData,
						     Tcl_Interp* interp,
						     int argc,
						     Tcl_Obj *CONST *objv ));

static void		OldMathFuncDeleteProc _ANSI_ARGS_((ClientData));

static int		ExprAbsFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprBinaryFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprDoubleFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprIntFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprRandFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprRoundFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprSrandFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprUnaryFunc _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		ExprWideFunc  _ANSI_ARGS_((ClientData clientData,
						 Tcl_Interp *interp,
						 int argc,
						 Tcl_Obj *CONST *objv));
static int		VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));

static void		MathFuncWrongNumArgs 
				_ANSI_ARGS_((Tcl_Interp* interp,
					     int expected,
					     int actual,
					     Tcl_Obj *CONST *objv ));

#ifndef TCL_WIDE_INT_IS_LONG
/*
 * Extract a double value from a general numeric object.
 */
#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)			\
    if ((typePtr) == &tclIntType) {					\
	(doubleVar) = (double) (objPtr)->internalRep.longValue;		\
    } else if ((typePtr) == &tclWideIntType) {				\
	(doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\
    } else {								\
	(doubleVar) = (objPtr)->internalRep.doubleValue;		\
    }
#else /* TCL_WIDE_INT_IS_LONG */
#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)			\
    if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \
	(doubleVar) = (double) (objPtr)->internalRep.longValue;		\
    } else {								\
	(doubleVar) = (objPtr)->internalRep.doubleValue;		\
    }
#endif /* TCL_WIDE_INT_IS_LONG */
#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)		\
    (resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr),	\
	    &(wideVar));						\
    if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN)	\
	    && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) {			\
	(objPtr)->typePtr = &tclIntType;				\
	(objPtr)->internalRep.longValue = (longVar)			\
		= Tcl_WideAsLong(wideVar);				\
    }
#define IS_INTEGER_TYPE(typePtr)					\
	((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
#define IS_NUMERIC_TYPE(typePtr)					\
	(IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)

/*
 * Macros for testing floating-point values for certain special cases. Test
 * for not-a-number by comparing a value against itself; test for infinity
 * by comparing against the largest floating-point value.
 */

#ifdef _MSC_VER
#define IS_NAN(f) (_isnan((f)))
#define IS_INF(f) ( ! (_finite((f))))
#else
#define IS_NAN(f) ((f) != (f))
#define IS_INF(f) ( (f) > DBL_MAX || (f) < -DBL_MAX )
#endif

extern TclStubs tclStubs;

/*
 * The following structure defines the commands in the Tcl core.
 */

    {"vwait",		Tcl_VwaitObjCmd,	(CompileProc *) NULL,	1},
    {"exec",		Tcl_ExecObjCmd,		(CompileProc *) NULL,	0},
    {"source",		Tcl_SourceObjCmd,	(CompileProc *) NULL,	0},
#endif /* TCL_GENERIC_ONLY */
    {NULL,	(Tcl_ObjCmdProc *) NULL,	(CompileProc *) NULL,	0}
};

/*
 * Math functions
 */

typedef struct {
    CONST char* name;		/* Name of the function */
    Tcl_ObjCmdProc* objCmdProc;	/* Procedure that evaluates the function */
    ClientData clientData;	/* Client data for the procedure */
} BuiltinFuncDef;
BuiltinFuncDef BuiltinFuncTable[] = {
    { "::tcl::mathfunc::abs",	ExprAbsFunc,	NULL 			},
#ifndef TCL_NO_MATH
    { "::tcl::mathfunc::acos",	ExprUnaryFunc,	(ClientData) acos 	},
    { "::tcl::mathfunc::asin",	ExprUnaryFunc,	(ClientData) asin 	},
    { "::tcl::mathfunc::atan",	ExprUnaryFunc,	(ClientData) atan 	},
    { "::tcl::mathfunc::atan2",	ExprBinaryFunc,	(ClientData) atan2 	},
    { "::tcl::mathfunc::ceil",	ExprUnaryFunc,	(ClientData) ceil 	},
    { "::tcl::mathfunc::cos",	ExprUnaryFunc,	(ClientData) cos 	},
    { "::tcl::mathfunc::cosh",	ExprUnaryFunc,	(ClientData) cosh	},
#endif
    { "::tcl::mathfunc::double",ExprDoubleFunc,	NULL			},
#ifndef TCL_NO_MATH
    { "::tcl::mathfunc::exp",	ExprUnaryFunc,	(ClientData) exp	},
    { "::tcl::mathfunc::floor",	ExprUnaryFunc,	(ClientData) floor 	},
    { "::tcl::mathfunc::fmod",	ExprBinaryFunc,	(ClientData) fmod	},
    { "::tcl::mathfunc::hypot",	ExprBinaryFunc,	(ClientData) hypot 	},
#endif
    { "::tcl::mathfunc::int",	ExprIntFunc,	NULL			},
#ifndef TCL_NO_MATH
    { "::tcl::mathfunc::log",	ExprUnaryFunc,	(ClientData) log 	},
    { "::tcl::mathfunc::log10",	ExprUnaryFunc,  (ClientData) log10 	},
    { "::tcl::mathfunc::pow",	ExprBinaryFunc,	(ClientData) pow 	},
#endif
    { "::tcl::mathfunc::rand",	ExprRandFunc,	NULL			},
    { "::tcl::mathfunc::round",	ExprRoundFunc,	NULL			},
#ifndef TCL_NO_MATH
    { "::tcl::mathfunc::sin",	ExprUnaryFunc,	(ClientData) sin 	},
    { "::tcl::mathfunc::sinh",	ExprUnaryFunc,	(ClientData) sinh 	},
    { "::tcl::mathfunc::sqrt",	ExprUnaryFunc,	(ClientData) sqrt 	},
#endif
    { "::tcl::mathfunc::srand",	ExprSrandFunc,	NULL			},
#ifndef TCL_NO_MATH
    { "::tcl::mathfunc::tan",	ExprUnaryFunc,	(ClientData) tan 	},
    { "::tcl::mathfunc::tanh",	ExprUnaryFunc,	(ClientData) tanh 	},
#endif
    { "::tcl::mathfunc::wide",	ExprWideFunc,	NULL		 	},
    { NULL, NULL, NULL }
};


/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
 *	Create a new TCL command interpreter.

Tcl_Interp *
Tcl_CreateInterp()
{
    Interp *iPtr;
    Tcl_Interp *interp;
    Command *cmdPtr;
    BuiltinFuncDef *builtinFuncPtr;


    const CmdInfo *cmdInfoPtr;
    Tcl_Namespace* mathfuncNSPtr;
    int i;
    union {
	char c[sizeof(short)];
	short s;
    } order;
#ifdef TCL_COMPILE_STATS
    ByteCodeStats *statsPtr;

    iPtr->errorLine		= 0;
    iPtr->objResultPtr		= Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle		= TclHandleCreate(iPtr);
    iPtr->globalNsPtr		= NULL;
    iPtr->hiddenCmdTablePtr	= NULL;
    iPtr->interpInfo		= NULL;


    iPtr->numLevels = 0;
    iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
    iPtr->framePtr = NULL;
    iPtr->varFramePtr = NULL;
    iPtr->activeVarTracePtr = NULL;

    iPtr->returnOpts = NULL;
    iPtr->errorInfo = NULL;
    iPtr->eiVar = Tcl_NewStringObj( "errorInfo", -1 );
    Tcl_IncrRefCount(iPtr->eiVar);
    iPtr->errorCode = NULL;
    iPtr->ecVar = Tcl_NewStringObj( "errorCode", -1 );
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 0;
    iPtr->returnCode = TCL_OK;

    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;

	    (Tcl_CmdDeleteProc*) NULL );
    Tcl_CreateObjCommand( interp,	"::tcl::clock::Mktime",
	    TclClockMktimeObjCmd,	(ClientData) NULL,
	    (Tcl_CmdDeleteProc*) NULL );
    Tcl_CreateObjCommand( interp,	"::tcl::clock::Oldscan",
	    TclClockOldscanObjCmd,	(ClientData) NULL,
	    (Tcl_CmdDeleteProc*) NULL );

    /*
     * Register the built-in functions
     */


    /* Register the default [interp bgerror] handler. */

    Tcl_CreateObjCommand( interp,	"::tcl::Bgerror",
	    TclDefaultBgErrorHandlerObjCmd,	(ClientData) NULL,
	    (Tcl_CmdDeleteProc*) NULL );

    /* Register the unsupported encoding search path command */
    Tcl_CreateObjCommand (interp, "::tcl::unsupported::EncodingDirs",
	    TclEncodingDirsObjCmd, NULL, NULL);

    /*
     * Register the builtin math functions.
     */

    mathfuncNSPtr = Tcl_CreateNamespace( interp, "::tcl::mathfunc",
					 (ClientData) NULL,
					 (Tcl_NamespaceDeleteProc*) NULL );
    if ( mathfuncNSPtr == NULL ) {
	Tcl_Panic( "Can't create math function namespace" );
    }
    i = 0;
    for ( ; ; ) {
	CONST char* tail;
	builtinFuncPtr = &(BuiltinFuncTable[ i++ ]);
	if ( builtinFuncPtr->name == NULL ) {
	    break;
	}
	Tcl_CreateObjCommand( interp, builtinFuncPtr->name,
			      builtinFuncPtr->objCmdProc,


			      builtinFuncPtr->clientData,
			      (Tcl_CmdDeleteProc*) NULL );
	tail = builtinFuncPtr->name + strlen( "::tcl::mathfunc::" );



	Tcl_Export( interp, mathfuncNSPtr, tail, 0 );

    }

    /*
     * Do Multiple/Safe Interps Tcl init stuff
     */

    TclInterpInit(interp);

	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp,
		    (Tcl_Command) Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree((char *) hTablePtr);
    }











    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != (Tcl_HashTable *) NULL) {

    Tcl_ValueType *argTypes;		/* Array of types acceptable for
					 * each argument. */
    Tcl_MathProc *proc;			/* Procedure that implements the
					 * math function. */
    ClientData clientData;		/* Additional value to pass to the
					 * function. */
{

    Tcl_DString bigName;

    OldMathFuncData* data
	= (OldMathFuncData*) Tcl_Alloc( sizeof ( OldMathFuncData ) );

    if ( numArgs > MAX_MATH_ARGS ) {
	Tcl_Panic( "attempt to create a math function with too many args" );
    }

    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes
	= (Tcl_ValueType*) Tcl_Alloc( numArgs * sizeof( Tcl_ValueType ) );
    memcpy( data->argTypes, argTypes, numArgs * sizeof( Tcl_ValueType ) );
    data->clientData = clientData;

    Tcl_DStringInit( &bigName );
    Tcl_DStringAppend( &bigName, "::tcl::mathfunc::", -1 );
    Tcl_DStringAppend( &bigName, name, -1 );

    Tcl_CreateObjCommand( interp, Tcl_DStringValue( &bigName ),
			  OldMathFuncProc, (ClientData) data,
			  OldMathFuncDeleteProc );
    Tcl_DStringFree( &bigName );
}

/*
 *----------------------------------------------------------------------
 *
 * OldMathFuncProc --
 *
 *	Dispatch to a math function created with Tcl_CreateMathFunc
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Whatever the math function does.
 *
 *----------------------------------------------------------------------
 */

static int
OldMathFuncProc( clientData, interp, objc, objv )
     ClientData clientData;	/* Ponter to OldMathFuncData describing
				 * the function being called */
     Tcl_Interp* interp;	/* Tcl interpreter */
     int objc;			/* Actual parameter count */
     Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    Tcl_Obj* valuePtr;
    OldMathFuncData* dataPtr = (OldMathFuncData*) clientData;
    Tcl_Value args[MAX_MATH_ARGS];
    Tcl_Value funcResult;
    int result;
    int i, j, k;
    double d;

    /* Check argument count */

    if ( objc != dataPtr->numArgs + 1 ) {
	MathFuncWrongNumArgs( interp, dataPtr->numArgs+1, objc, objv );
	return TCL_ERROR;
    }

    /* Convert arguments from Tcl_Obj's to Tcl_Value's */

    for ( j = 1, k = 0; j < objc; ++j, ++k ) {
	valuePtr = objv[j];
	if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*

	 * Copy the object's numeric value to the argument record,
	 * converting it if necessary. 




	 */

	if (valuePtr->typePtr == &tclIntType) {
	    i = valuePtr->internalRep.longValue;
	    if (dataPtr->argTypes[k] == TCL_DOUBLE) {
		args[k].type = TCL_DOUBLE;
		args[k].doubleValue = i;
	    } else if (dataPtr->argTypes[k] == TCL_WIDE_INT) {
		args[k].type = TCL_WIDE_INT;
		args[k].wideValue = Tcl_LongAsWide(i);
	    } else {
		args[k].type = TCL_INT;
		args[k].intValue = i;
	    }
	} else if (valuePtr->typePtr == &tclWideIntType) {
	    Tcl_WideInt w;
	    TclGetWide(w,valuePtr);
	    if (dataPtr->argTypes[k] == TCL_DOUBLE) {
		args[k].type = TCL_DOUBLE;
		args[k].doubleValue = Tcl_WideAsDouble(w);
	    } else if (dataPtr->argTypes[k] == TCL_INT) {
		args[k].type = TCL_INT;
		args[k].intValue = Tcl_WideAsLong(w);
	    } else {
		args[k].type = TCL_WIDE_INT;
		args[k].wideValue = w;
	    }
	} else {

	    d = valuePtr->internalRep.doubleValue;
	    if (dataPtr->argTypes[k] == TCL_INT) {
		args[k].type = TCL_INT;
		args[k].intValue = (long) d;

	    } else if (dataPtr->argTypes[k] == TCL_WIDE_INT) {
		args[k].type = TCL_WIDE_INT;
		args[k].wideValue = Tcl_DoubleAsWide(d);
	    } else {
		args[k].type = TCL_DOUBLE;
		args[k].doubleValue = d;
	    }
	}
    }

    /* Call the function */

    result = (*dataPtr->proc)(dataPtr->clientData, interp, args,
	    &funcResult);
    if (result != TCL_OK) {
	return result;
    }

    /* Return the result of the call */

    if (funcResult.type == TCL_INT) {
	TclNewLongObj(valuePtr, funcResult.intValue);
    } else if (funcResult.type == TCL_WIDE_INT) {
	TclNewWideIntObj(valuePtr, funcResult.wideValue);
    } else {
	d = funcResult.doubleValue;
	if (IS_NAN(d) || IS_INF(d)) {
	    TclExprFloatError(interp, d);
	    return TCL_ERROR;
	}

	TclNewDoubleObj(valuePtr, d);
    }
    Tcl_SetObjResult( interp, valuePtr );
    return TCL_OK;

}


/*
 *----------------------------------------------------------------------
 *
 * OldMathFuncDeleteProc --
 *
 *	Cleans up after deleting a math function registered with
 *	Tcl_CreateMathFunc
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees allocated memory.
 *
 *----------------------------------------------------------------------
 */

static void
OldMathFuncDeleteProc( clientData )
     ClientData clientData;
{
    OldMathFuncData* dataPtr = (OldMathFuncData*) clientData;
    Tcl_Free( (VOID*) dataPtr->argTypes );
    Tcl_Free( (VOID*) dataPtr );
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMathFuncInfo --
 *

    Tcl_Interp *interp;
    CONST char *name;
    int *numArgsPtr;
    Tcl_ValueType **argTypesPtr;
    Tcl_MathProc **procPtr;
    ClientData *clientDataPtr;
{

    Tcl_Obj* cmdNameObj;
    Command* cmdPtr;

    /* Get the command that implements the math function */

    cmdNameObj = Tcl_NewStringObj( "tcl::mathfunc::", -1 );

    Tcl_AppendToObj( cmdNameObj, name, -1 );
    Tcl_IncrRefCount( cmdNameObj );
    cmdPtr = (Command*) Tcl_GetCommandFromObj( interp, cmdNameObj );
    Tcl_DecrRefCount( cmdNameObj );

    /* Report unknown functions */

    if ( cmdPtr == NULL ) {
	Tcl_Obj* message;
	message = Tcl_NewStringObj( "unknown math function \"", -1 );
	Tcl_AppendToObj( message, name, -1 );
	Tcl_AppendToObj( message, "\"", 1 );
	*numArgsPtr = -1; *argTypesPtr = NULL; 
	*procPtr = NULL;

	*clientDataPtr = NULL;
	return TCL_ERROR;
    }




    
    /* 
     * Retrieve function info for user defined functions; return
     * dummy information for builtins.
     */

    if ( cmdPtr->objProc == &OldMathFuncProc ) {
	OldMathFuncData* dataPtr = (OldMathFuncData*) cmdPtr->clientData;
	*procPtr = dataPtr->proc;
	*numArgsPtr = dataPtr->numArgs;
	*argTypesPtr = dataPtr->argTypes;
	*clientDataPtr = dataPtr->clientData;
    } else {
	*procPtr = NULL;
	*numArgsPtr = -1;
	*argTypesPtr = NULL;
	*procPtr = NULL;
	*clientDataPtr = NULL;
    }

    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListMathFuncs --
 *

 */

Tcl_Obj *
Tcl_ListMathFuncs(interp, pattern)
    Tcl_Interp *interp;
    CONST char *pattern;
{
    Namespace* globalNsPtr = (Namespace*) Tcl_GetGlobalNamespace( interp );
    Namespace* nsPtr;
    Namespace* dummy1NsPtr;
    Namespace* dummy2NsPtr;
    CONST char* dummyNamePtr;
    Tcl_Obj* result = Tcl_NewObj();
    Tcl_HashEntry* cmdHashEntry;
    Tcl_HashSearch cmdHashSearch;
    CONST char* cmdNamePtr;
    
    TclGetNamespaceForQualName( interp, "::tcl::mathfunc",
				globalNsPtr, 
				TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
				&nsPtr, &dummy1NsPtr, &dummy2NsPtr,
				&dummyNamePtr );

    if ( nsPtr != NULL ) {
	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	    if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(pattern,-1));
	    }
	} else {
	    for ( cmdHashEntry =
		    Tcl_FirstHashEntry( &nsPtr->cmdTable, &cmdHashSearch );
		    cmdHashEntry != NULL;
		    cmdHashEntry = Tcl_NextHashEntry( &cmdHashSearch ) ) {
		cmdNamePtr = Tcl_GetHashKey( &nsPtr->cmdTable, cmdHashEntry );
		if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {

		    Tcl_ListObjAppendElement( NULL, result,
			    Tcl_NewStringObj( cmdNamePtr, -1 ) );


		}
	    }
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterpReady --
 *

     */

    if ((result == TCL_ERROR)
	    && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
	    && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
	int length;
	Tcl_Obj *command = Tcl_NewListObj(objc, objv);
	CONST char* cmdString;
	Tcl_IncrRefCount( command );
	cmdString = Tcl_GetStringFromObj(command, &length);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
	Tcl_DecrRefCount(command);
	iPtr->flags &= ~ERR_ALREADY_LOGGED;
    }
    return result;
}


    if (patchLevelV != NULL) {
        *patchLevelV = TCL_RELEASE_SERIAL;
    }
    if (type != NULL) {
        *type = TCL_RELEASE_LEVEL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Math Functions --
 *
 *	This page contains the procedures that implement all of the
 *	built-in math functions for expressions.
 *
 * Results:
 *	Each procedure returns TCL_OK if it succeeds and pushes an
 *	Tcl object holding the result. If it fails it returns TCL_ERROR
 *	and leaves an error message in the interpreter's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExprUnaryFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Contains the address of a procedure that
				 * takes one double argument and returns a
				 * double result. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Actual parameter list */
{
    double d, dResult;
    Tcl_Obj* oResult;
    
    double (*func) _ANSI_ARGS_((double)) =
	(double (*)_ANSI_ARGS_((double))) clientData;

    /*
     * Convert the function's argument to a double if necessary.
     */ 

    if ( objc != 2 ) {
	MathFuncWrongNumArgs( interp, 2, objc, objv );
    } else if ( Tcl_GetDoubleFromObj( interp, objv[1], &d ) == TCL_OK ) {

	/* Evaluate the function */
	
	dResult = (*func)(d);
	if ((errno != 0 ) || IS_NAN(dResult)) {
	    if ( errno != ERANGE || ( dResult != 0.0 && !IS_INF(dResult) )) {
		TclExprFloatError(interp, dResult);
		return TCL_ERROR;
	    }
	}
	TclNewDoubleObj( oResult, dResult );
	Tcl_SetObjResult( interp, oResult );
	return TCL_OK;
    }

    return TCL_ERROR;
}

static int
ExprBinaryFunc( clientData, interp, objc, objv )
    ClientData clientData;	/* Contains the address of a procedure that
				 * takes two double arguments and
				 * returns a double result. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    double d1, d2, dResult;
    Tcl_Obj* oResult;
    
    double (*func) _ANSI_ARGS_((double, double))
	= (double (*)_ANSI_ARGS_((double, double))) clientData;

    /*
     * Convert the function's two arguments to doubles if necessary.
     */

    if ( objc != 3 ) {
	MathFuncWrongNumArgs( interp, 3, objc, objv );
    } else if ( Tcl_GetDoubleFromObj( interp, objv[1], &d1 ) == TCL_OK
		&& Tcl_GetDoubleFromObj( interp, objv[2], &d2 ) == TCL_OK ) {

	/* Evaluate the function */

	errno = 0;
	dResult = (*func)(d1, d2);
	if ((errno != 0) || IS_NAN(dResult)) {
	    if ( errno != ERANGE || ( dResult != 0.0 && !IS_INF( dResult ) ) ) {
		TclExprFloatError(interp, dResult);
		return TCL_ERROR;
	    }
	}
	TclNewDoubleObj( oResult, dResult );
	Tcl_SetObjResult( interp, oResult );
	return TCL_OK;
    }

    return TCL_ERROR;

}

static int
ExprAbsFunc( clientData, interp, objc, objv )
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    register Tcl_Obj *valuePtr;
    long i, iResult;
    double d, dResult;
    Tcl_Obj* oResult;

    if ( objc != 2 ) {
	MathFuncWrongNumArgs( interp, 2, objc, objv );
	return TCL_ERROR;
    }
    valuePtr = objv[1];

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Derive the absolute value according to the arg type.
     */
    if (valuePtr->typePtr == &tclIntType) {
	i = valuePtr->internalRep.longValue;
	if (i < 0) {
	    iResult = -i;
	    if (iResult < 0) {
		/* FIXME: This should promote to wide! */
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
		        "integer value too large to represent", -1));
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			"integer value too large to represent", (char *) NULL);
		return TCL_ERROR;
	    }
	} else {
	    iResult = i;
	}	    
	TclNewLongObj( oResult, iResult );
	Tcl_SetObjResult( interp, oResult );
    } else if (valuePtr->typePtr == &tclWideIntType) {
	Tcl_WideInt wResult, w;
	TclGetWide(w,valuePtr);
	if (w < (Tcl_WideInt)0) {
	    wResult = -w;
	    if (wResult < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
		        "integer value too large to represent", -1));
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			"integer value too large to represent", (char *) NULL);
		return TCL_ERROR;
	    }
	} else {
	    wResult = w;
	}	    
	TclNewWideIntObj( oResult, wResult );
	Tcl_SetObjResult( interp, oResult );
    } else {
	d = valuePtr->internalRep.doubleValue;
	if (d < 0.0) {
	    dResult = -d;
	} else {
	    dResult = d;
	}
	if (IS_NAN(dResult)) {
	    TclExprFloatError(interp, dResult);
	    return TCL_ERROR;
	}
	TclNewDoubleObj( oResult, dResult );
	Tcl_SetObjResult( interp, oResult );
    }

    return TCL_OK;
}

static int
ExprDoubleFunc(clientData, interp, objc, objv )
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Actual parameter vector */
{
    Tcl_Obj* valuePtr;
    double dResult;
    Tcl_Obj* oResult;

    /*
     * Check parameter type
     */

    if ( objc != 2 ) {
	MathFuncWrongNumArgs( interp, 2, objc, objv );
    } else {
	valuePtr = objv[1];
	if ( VerifyExprObjType( interp, valuePtr ) == TCL_OK ) {
	    GET_DOUBLE_VALUE( dResult, valuePtr, valuePtr->typePtr );
	    TclNewDoubleObj( oResult, dResult );
	    Tcl_SetObjResult( interp, oResult );
	    return TCL_OK;
	}
    }

    return TCL_ERROR;
}

static int
ExprIntFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Actual parameter vector */
{
    
    register Tcl_Obj *valuePtr;
    long iResult;
    double d;
    Tcl_Obj* oResult;

    if ( objc != 2 ) {
	MathFuncWrongNumArgs( interp, 2, objc, objv );
    } else {
	valuePtr = objv[1];
        if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
	    if (valuePtr->typePtr == &tclIntType) {
		iResult = valuePtr->internalRep.longValue;
	    } else if (valuePtr->typePtr == &tclWideIntType) {
		TclGetLongFromWide(iResult,valuePtr);
	    } else {
		d = valuePtr->internalRep.doubleValue;
		if (d < 0.0) {
		    if (d < (double) (long) LONG_MIN) {
		    tooLarge:
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
		             "integer value too large to represent", -1));
			Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent",
                            (char *) NULL);
			return TCL_ERROR;
		    }
		} else {
		    if (d > (double) LONG_MAX) {
			goto tooLarge;
		    }
		}
		if (IS_NAN(d) || IS_INF(d)) {
		    TclExprFloatError(interp, d);
		    return TCL_ERROR;
		}
		iResult = (long) d;
	    }
	    TclNewIntObj( oResult, iResult );
	    Tcl_SetObjResult( interp, oResult );
	    return TCL_OK;
	}
    }
    return TCL_ERROR;
}

static int
ExprWideFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Actual parameter vector */
{
    
    register Tcl_Obj *valuePtr;
    Tcl_WideInt wResult;
    double d;
    Tcl_Obj* oResult;

    if ( objc != 2 ) {
	MathFuncWrongNumArgs( interp, 2, objc, objv );
    } else {
	valuePtr = objv[1];
        if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
	    if (valuePtr->typePtr == &tclIntType) {
		wResult = valuePtr->internalRep.longValue;
	    } else if (valuePtr->typePtr == &tclWideIntType) {
		wResult = valuePtr->internalRep.wideValue;
	    } else {
		d = valuePtr->internalRep.doubleValue;
		if (d < 0.0) {
		    if (d < Tcl_WideAsDouble( LLONG_MIN ) ) {
		    tooLarge:
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
		             "integer value too large to represent", -1));
			Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent",
                            (char *) NULL);
			return TCL_ERROR;
		    }
		} else {
		    if (d > Tcl_WideAsDouble( LLONG_MAX ) ) {
			goto tooLarge;
		    }
		}
		if (IS_NAN(d) || IS_INF(d)) {
		    TclExprFloatError(interp, d);
		    return TCL_ERROR;
		}
		wResult = (Tcl_WideInt) d;
	    }
	    TclNewWideIntObj( oResult, wResult );
	    Tcl_SetObjResult( interp, oResult );
	    return TCL_OK;
	}
    }
    return TCL_ERROR;
}

static int
ExprRandFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Actual parameter vector */
{
    Interp *iPtr = (Interp *) interp;
    double dResult;
    long tmp;			/* Algorithm assumes at least 32 bits.
				 * Only long guarantees that.  See below. */
    Tcl_Obj* oResult;

    if ( objc != 1 ) {
	MathFuncWrongNumArgs( interp, 1, objc, objv );
	return TCL_ERROR;
    }

    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
	iPtr->flags |= RAND_SEED_INITIALIZED;
        
        /* 
	 * Take into consideration the thread this interp is running in order
	 * to insure different seeds in different threads (bug #416643)
	 */

	iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12);

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2.  See below.
	 */

        iPtr->randSeed &= (unsigned long) 0x7fffffff;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	    iPtr->randSeed ^= 123459876;
	}
    }

    /*
     * Generate the random number using the linear congruential
     * generator defined by the following recurrence:
     *		seed = ( IA * seed ) mod IM
     * where IA is 16807 and IM is (2^31) - 1.  The recurrence maps
     * a seed in the range [1, IM - 1] to a new seed in that same range.
     * The recurrence maps IM to 0, and maps 0 back to 0, so those two
     * values must not be allowed as initial values of seed.
     *
     * In order to avoid potential problems with integer overflow, the
     * recurrence is implemented in terms of additional constants
     * IQ and IR such that
     *		IM = IA*IQ + IR
     * None of the operations in the implementation overflows a 32-bit
     * signed integer, and the C type long is guaranteed to be at least
     * 32 bits wide.
     *
     * For more details on how this algorithm works, refer to the following
     * papers: 
     *
     *	S.K. Park & K.W. Miller, "Random number generators: good ones
     *	are hard to find," Comm ACM 31(10):1192-1201, Oct 1988
     *
     *	W.H. Press & S.A. Teukolsky, "Portable random number
     *	generators," Computers in Physics 6(5):522-524, Sep/Oct 1992.
     */

#define RAND_IA		16807
#define RAND_IM		2147483647
#define RAND_IQ		127773
#define RAND_IR		2836
#define RAND_MASK	123459876

    tmp = iPtr->randSeed/RAND_IQ;
    iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
    if (iPtr->randSeed < 0) {
	iPtr->randSeed += RAND_IM;
    }

    /*
     * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
     * dividing by RAND_IM yields a double in the range (0, 1).
     */

    dResult = iPtr->randSeed * (1.0/RAND_IM);

    /*
     * Push a Tcl object with the result.
     */

    TclNewDoubleObj( oResult, dResult );
    Tcl_SetObjResult( interp, oResult );
    return TCL_OK;
}

static int
ExprRoundFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    Tcl_Obj *valuePtr, *resPtr;
    double d, a, f;

    /* Check the argument count. */

    if ( objc != 2 ) {
	MathFuncWrongNumArgs( interp, 1, objc, objv );
	return TCL_ERROR;
    }
    valuePtr = objv[1];

    /* Coerce the argument to a number. Integers are already rounded. */

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((valuePtr->typePtr == &tclIntType) ||
	    (valuePtr->typePtr == &tclWideIntType)) {
	return TCL_OK;
    }
    GET_DOUBLE_VALUE( d, valuePtr, valuePtr->typePtr );

    /* 
     * Round the number to the nearest integer.  I'd like to use rint()
     * or nearbyint(), but they are far from universal.
     */

    a = fabs( d );
    if ( a < Tcl_WideAsDouble( LLONG_MAX ) + 0.5 ) {
	d = valuePtr->internalRep.doubleValue;
	f = floor( d );
	d -= f;
	if ( d > 0.5 || ( d == 0.5 && fmod( f, 2.0 ) != 0.0 ) ) {
	    f = f + 1.0;
	}
	if ( f >= (double) LONG_MIN && f <= (double) LONG_MAX ) {
	    TclNewLongObj( resPtr, (long) f );
	} else {
	    TclNewWideIntObj( resPtr, Tcl_DoubleAsWide( f ) );
	}
	Tcl_SetObjResult( interp, resPtr );
	return TCL_OK;
    }

    /*
     * Error return: result cannot be represented as an integer.
     */
    
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "integer value too large to represent", -1));
    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
	    "integer value too large to represent",
	    (char *) NULL);

    return TCL_ERROR;

}

static int
ExprSrandFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *valuePtr;
    long i = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2 ) {
	MathFuncWrongNumArgs( interp, 2, objc, objv );
	return TCL_ERROR;
    }
    valuePtr = objv[1];

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	return TCL_ERROR;
    }

    if ( Tcl_GetLongFromObj( NULL, valuePtr, &i ) != TCL_OK ) {
	/*
	 * At this point, the only other possible type is double
	 */
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"can't use floating-point value as argument to srand", -1));
	return TCL_ERROR;
    }
    
    /*
     * Reset the seed.  Make sure 1 <= randSeed <= 2^31 - 2.
     * See comments in ExprRandFunc() for more details.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = i;
    iPtr->randSeed &= (unsigned long) 0x7fffffff;
    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	iPtr->randSeed ^= 123459876;
    }

    /*
     * To avoid duplicating the random number generation code we simply
     * clean up our state and call the real random number function. That
     * function will always succeed.
     */
    
    return ExprRandFunc(clientData, interp, 1, objv);

}

/*
 *----------------------------------------------------------------------
 *
 * VerifyExprObjType --
 *
 *	This procedure is called by the math functions to verify that
 *	the object is either an int or double, coercing it if necessary.
 *	If an error occurs during conversion, an error message is left
 *	in the interpreter's result unless "interp" is NULL.
 *
 * Results:
 *	TCL_OK if it was int or double, TCL_ERROR otherwise
 *
 * Side effects:
 *	objPtr is ensured to be of tclIntType, tclWideIntType or
 *	tclDoubleType.
 *
 *----------------------------------------------------------------------
 */

static int
VerifyExprObjType(interp, objPtr)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    Tcl_Obj *objPtr;		/* Points to the object to type check. */
{
    if (IS_NUMERIC_TYPE(objPtr->typePtr)) {
	return TCL_OK;
    } else {
	int length, result = TCL_OK;
	char *s = Tcl_GetStringFromObj(objPtr, &length);
	
	if (TclLooksLikeInt(s, length)) {
	    long i;     /* Set but never used, needed in GET_WIDE_OR_INT */
	    Tcl_WideInt w;
	    GET_WIDE_OR_INT(result, objPtr, i, w);
	} else {
	    double d;
	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
	}
	if ((result != TCL_OK) && (interp != NULL)) {
	    if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"argument to math function was an invalid octal number",
			-1));
	    } else {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"argument to math function didn't have numeric value",
			-1));
	    }
	}
	return result;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * MathFuncWrongNumArgs --
 *
 *	Generate an error message when a math function presents the
 *	wrong number of arguments
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	An error message is stored in the interpreter result
 *
 *----------------------------------------------------------------------
 */

static void
MathFuncWrongNumArgs( interp, expected, found, objv )
     Tcl_Interp* interp;	/* Tcl interpreter */
     int expected;		/* Formal parameter count */
     int found;			/* Actual parameter count */
     Tcl_Obj *CONST *objv;	/* Actual parameter vector */
{
    Tcl_Obj* errorMessage;
    CONST char* name = Tcl_GetString( objv[0] );
    CONST char* tail = name + strlen( name );
    while ( tail > name+1 ) {
	--tail;
	if ( *tail == ':' && tail[-1] == ':' ) {
	    name = tail+1;
	    break;
	}
    }
    errorMessage = Tcl_NewStringObj( "too ", -1 );
    if ( found < expected ) {
	Tcl_AppendToObj( errorMessage, "few", -1 );
    } else {
	Tcl_AppendToObj( errorMessage, "many", -1 );
    }
    Tcl_AppendToObj( errorMessage, " arguments for math function \"", -1 );
    Tcl_AppendToObj( errorMessage, name, -1 );
    Tcl_AppendToObj( errorMessage, "\"", -1 );
    Tcl_SetObjResult( interp, errorMessage );
}

/* 
 * 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.6 2005/05/11 16:58:32 dgp Exp $
 */

#include "tclInt.h"

#ifdef TCL_NO_MATH
#define fabs(x) (x<0 ? -x : x)
#else

    switch (type) {
    case 'd':
    case 'q':
    case 'Q':
	/*
	 * Double-precision floating point values.
	 * Tcl_GetDoubleFromObj returns TCL_ERROR for NaN, but
	 * we can check by comparing the object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    if ( src->typePtr != &tclDoubleType ) {
		return TCL_ERROR;
	    }
	    dvalue = src->internalRep.doubleValue;
	}
	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
	*cursorPtr += sizeof(double);
	return TCL_OK;

    case 'f':
    case 'r':
    case 'R':
	/*
	 * Single-precision floating point values.
	 * Tcl_GetDoubleFromObj returns TCL_ERROR for NaN, but
	 * we can check by comparing the object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    if ( src->typePtr != &tclDoubleType ) {
		return TCL_ERROR;
	    }
	    dvalue = src->internalRep.doubleValue;
	}

	/*
	 * Because some compilers will generate floating point exceptions
	 * on an overflow cast (e.g. Borland), we restrict the values
	 * to the valid range for float.
	 */

 * 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.10 2005/05/11 16:58:32 dgp Exp $
 */

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

/*
 * During execution of the "lsort" command, structures of the following

	    }
	}
	varPtr++;
	localPtr = localPtr->nextPtr;
    }

    if (localVarTablePtr != NULL) {
	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	    if (Tcl_FindHashEntry(localVarTablePtr, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr,
			Tcl_NewStringObj(pattern,-1));
	    }
	    return;
	}
	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
	    if (!TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);

 * 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.15 2005/05/11 16:58:32 dgp Exp $
 */

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

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

				result = 0;
				failat = -1;
			    }
			    break;
			}
		    }
		    errno = 0;
		    TclStrToD(string1, (CONST char **) &stop); /* INTL: Tcl source. */









		    if (stop == string1) {
			/*
			 * In this case, nothing like a number was found
			 */
			result = 0;
			failat = 0;
		    } else {
			/*

		 * This will be >30% faster on larger strings.
		 */
		int mapLen;
		Tcl_UniChar *mapString, u2lc;

		ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
		p = ustring1;
		if ((length2 > length1) || (length2 == 0)) {
		    /* match string is either longer than input or empty */
		    ustring1 = end;
		} else {
		    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
		    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
		    for (; ustring1 < end; ustring1++) {
			if (((*ustring1 == *ustring2) ||
				(nocase && (Tcl_UniCharToLower(*ustring1) ==

			 * Get the key string to match on.
			 */
			ustring2 = mapStrings[index];
			length2  = mapLens[index];
			if ((length2 > 0) && ((*ustring1 == *ustring2) ||
				(nocase && (Tcl_UniCharToLower(*ustring1) ==
					u2lc[index/2]))) &&
				/* restrict max compare length */
				((end - ustring1) >= length2) &&
				((length2 == 1) || strCmpFn(ustring2, ustring1,
					(unsigned long) length2) == 0)) {
			    if (p != ustring1) {
				/*
				 * Put the skipped chars onto the result first
				 */
				Tcl_AppendUnicodeToObj(resultPtr, p,

/* 
 * 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.8 2005/05/11 16:58:32 dgp Exp $
 */

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

/*
 * Macro that encapsulates an efficiency trick that avoids a function
 * call for the simplest of compiles.  The ANSI C "prototype" for this
 * macro is:
 *
 * static void		CompileWord _ANSI_ARGS((CompileEnv *envPtr,
 * 			    Tcl_Token *tokenPtr, Tcl_Inter *interp));
 */

#define CompileWord(envPtr, tokenPtr, interp) \
   if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
		(tokenPtr)[1].size), (envPtr)); \
    } else { \
	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
		(envPtr)); \
    }

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

static ClientData	DupForeachInfo _ANSI_ARGS_((ClientData clientData));
static void		FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
static int		PushVarName _ANSI_ARGS_((Tcl_Interp *interp,

 *
 * TclCompileAppendCmd --
 *
 *	Procedure called to compile the "append" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "append" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileAppendCmd(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 *varTokenPtr, *valueTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords;

    numWords = parsePtr->numWords;
    if (numWords == 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_ERROR;
    }

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

     * We are doing an assignment, otherwise TclCompileSetCmd was called,
     * so push the new value.  This will need to be extended to push a
     * value for each argument.
     */

    if (numWords > 2) {
	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);




	CompileWord(envPtr, valueTokenPtr, interp);


    }

    /*
     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {

 *
 * TclCompileBreakCmd --
 *
 *	Procedure called to compile the "break" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "break" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileBreakCmd(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. */
{
    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * Emit a break instruction.
     */

    TclEmitOpcode(INST_BREAK, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileCatchCmd --
 *
 *	Procedure called to compile the "catch" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "catch" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    int savedStackDepth = envPtr->currStackDepth;

    /*
     * If syntax does not match what we expect for [catch], do not
     * compile.  Let runtime checks determine if syntax has changed.
     */
    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
	return TCL_ERROR;
    }

    /*
     * If a variable was specified and the catch command is at global level
     * (not in a procedure), don't compile it inline: the payoff is
     * too small.
     */

    if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
	return TCL_ERROR;
    }

    /*
     * Make sure the variable name, if any, has no substitutions and just
     * refers to a local scaler.
     */

    localIndex = -1;
    cmdTokenPtr = parsePtr->tokenPtr
	    + (parsePtr->tokenPtr->numComponents + 1);
    if (parsePtr->numWords == 3) {
	nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
	/* DGP */
	if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    name = nameTokenPtr[1].start;
	    nameChars = nameTokenPtr[1].size;
	    if (!TclIsLocalScalar(name, nameChars)) {
		return TCL_ERROR;
	    }
	    localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
		    nameTokenPtr[1].size, /*create*/ 1, 
		    /*flags*/ VAR_SCALAR, envPtr->procPtr);
	} else {
	   return TCL_ERROR;
	}
    }

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

 *
 * TclCompileContinueCmd --
 *
 *	Procedure called to compile the "continue" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "continue" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileContinueCmd(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. */
{
    /*
     * There should be no argument after the "continue".
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * Emit a continue instruction.
     */

    TclEmitOpcode(INST_CONTINUE, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExprCmd --
 *
 *	Procedure called to compile the "expr" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "expr" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileExprCmd(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 *firstWordPtr;

    if (parsePtr->numWords == 1) {
	return TCL_ERROR;
    }

    firstWordPtr = parsePtr->tokenPtr
	    + (parsePtr->tokenPtr->numComponents + 1);
    TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1), envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileForCmd --
 *
 *	Procedure called to compile the "for" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "for" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
    int bodyRange, nextRange;
    int savedStackDepth = envPtr->currStackDepth;

    if (parsePtr->numWords != 5) {
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the for
     * command inline. E.g., the expression might cause the loop to never
     * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
     */

    startTokenPtr = parsePtr->tokenPtr
	    + (parsePtr->tokenPtr->numComponents + 1);
    testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
    if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*
     * Bail out also if the body or the next expression require substitutions
     * in order to insure correct behaviour [Bug 219166]
     */

    nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
    bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) 
	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
	return TCL_ERROR;
    }

    /*
     * Create ExceptionRange records for the body and the "next" command.
     * The "next" command's ExceptionRange supports break but not continue
     * (and has a -1 continueOffset).
     */

 *
 * TclCompileForeachCmd --
 *
 *	Procedure called to compile the "foreach" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "foreach" command
 *	at runtime.
 *
n*----------------------------------------------------------------------
 */

    /*
     * If the foreach command isn't in a procedure, don't compile it inline:
     * the payoff is too small.
     */

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

    numWords = parsePtr->numWords;
    if ((numWords < 4) || (numWords%2 != 0)) {
	return TCL_ERROR;
    }

    /*
     * Bail out if the body requires substitutions
     * in order to insure correct behaviour [Bug 219166]
     */
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
    }
    bodyTokenPtr = tokenPtr;
    if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*
     * Allocate storage for the varcList and varvList arrays if necessary.
     */

    numLists = (numWords - 2)/2;

    loopIndex = 0;
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
	if (i%2 == 1) {
	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		code = TCL_ERROR;
		goto done;
	    } else {
		/* Lots of copying going on here.  Need a ListObj wizard
		 * to show a better way. */

		Tcl_DString varList;

		Tcl_DStringInit(&varList);
		Tcl_DStringAppend(&varList, tokenPtr[1].start,
			tokenPtr[1].size);
		code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
			&varcList[loopIndex], &varvList[loopIndex]);
		Tcl_DStringFree(&varList);
		if (code != TCL_OK) {
		    code = TCL_ERROR;
		    goto done;
		}
		numVars = varcList[loopIndex];
		for (j = 0;  j < numVars;  j++) {
		    CONST char *varName = varvList[loopIndex][j];
		    if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
			code = TCL_ERROR;
			goto done;
		    }
		}
	    }
	    loopIndex++;
	}
    }

 *
 * TclCompileIfCmd --
 *
 *	Procedure called to compile the "if" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "if" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    numWords = parsePtr->numWords;

    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	tokenPtr += 2;
    }


    TclInitJumpFixupArray(&jumpFalseFixupArray);
    TclInitJumpFixupArray(&jumpEndFixupArray);

	        || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
	    tokenPtr += (tokenPtr->numComponents + 1);
	    wordIdx++;
	} else {
	    break;
	}
	if (wordIdx >= numWords) {
	    code = TCL_ERROR;
	    goto done;
	}

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

	/*
	 * Skip over the optional "then" before the then clause.
	 */

	tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
	wordIdx++;
	if (wordIdx >= numWords) {
	    code = TCL_ERROR;
	    goto done;
	}
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    word = tokenPtr[1].start;
	    numBytes = tokenPtr[1].size;
	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
		tokenPtr += (tokenPtr->numComponents + 1);
		wordIdx++;
		if (wordIdx >= numWords) {
		    code = TCL_ERROR;
		    goto done;
		}
	    }
	}

	/*
	 * Compile the "then" command body.

	word = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;
	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
	    tokenPtr += (tokenPtr->numComponents + 1);
	    wordIdx++;
	    if (wordIdx >= numWords) {
		code = TCL_ERROR;
		goto done;
	    }
	}

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

	    TclCompileCmdWord(interp, tokenPtr+1,
		    tokenPtr->numComponents, envPtr);
	}

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

	wordIdx++;
	if (wordIdx < numWords) {
	    code = TCL_ERROR;
	    goto done;
	}
    } else {
	/*
	 * No else clause: the "if" command's result is an empty string.
	 */

 *
 * TclCompileIncrCmd --
 *
 *	Procedure called to compile the "incr" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "incr" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIncrCmd(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 *varTokenPtr, *incrTokenPtr;
    int simpleVarName, isScalar, localIndex, haveImmValue, immValue;

    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
	return TCL_ERROR;
    }

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

    PushVarName(interp, varTokenPtr, envPtr, 
	    (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),

 *
 * TclCompileLappendCmd --
 *
 *	Procedure called to compile the "lappend" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lappend" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords;

    /*
     * If we're not in a procedure, don't compile.
     */
    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    }
    if (numWords != 3) {
	/*
	 * LAPPEND instructions currently only handle one value appends
	 */
        return TCL_ERROR;
    }

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

    /*
     * If we are doing an assignment, push the new value.
     * In the no values case, create an empty object.
     */

    if (numWords > 2) {
	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);




	CompileWord(envPtr, valueTokenPtr, interp);


    }

    /*
     * Emit instructions to set/get the variable.
     */

    /*

 *
 * TclCompileLassignCmd --
 *
 *	Procedure called to compile the "lassign" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lassign" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    int simpleVarName, isScalar, localIndex, numWords, idx;

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

    /*
     * Generate code to push list being taken apart by [lassign].
     */
    tokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1);


    CompileWord(envPtr, tokenPtr, interp);




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

 *
 * TclCompileLindexCmd --
 *
 *	Procedure called to compile the "lindex" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lindex" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    numWords = parsePtr->numWords;

    /*
     * Quit if too few args
     */

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

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

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

    for (i=1 ; i<numWords ; i++) {


	CompileWord(envPtr, varTokenPtr, interp);





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

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

 *
 * TclCompileListCmd --
 *
 *	Procedure called to compile the "list" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "list" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileListCmd(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. */
{
    /*
     * If we're not in a procedure, don't compile.
     */
    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    if (parsePtr->numWords == 1) {
	/*
	 * Empty args case
	 */

	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    } else {
	/*
	 * Push the all values onto the stack.
	 */
	Tcl_Token *valueTokenPtr;
	int i, numWords;

	numWords = parsePtr->numWords;

	valueTokenPtr = parsePtr->tokenPtr
	    + (parsePtr->tokenPtr->numComponents + 1);
	for (i = 1; i < numWords; i++) {




	    CompileWord(envPtr, valueTokenPtr, interp);


	    valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
	}
	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLlengthCmd --
 *
 *	Procedure called to compile the "llength" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "llength" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLlengthCmd(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 *varTokenPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    varTokenPtr = parsePtr->tokenPtr
	+ (parsePtr->tokenPtr->numComponents + 1);






    CompileWord(envPtr, varTokenPtr, interp);





    TclEmitOpcode(INST_LIST_LENGTH, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --
 *
 *	Procedure called to compile the "lset" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lset" command
 *	at runtime.
 *
 * The general template for execution of the "lset" command is:
 *	(1) Instructions to push the variable name, unless the

    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_ERROR;
    }

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

    for (i=2 ; i<parsePtr->numWords ; ++i) {
	/* Advance to next arg */

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

	/* Push an arg */


	CompileWord(envPtr, varTokenPtr, interp);





    }

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

    if (!simpleVarName || localIndex < 0) {

 *
 * TclCompileRegexpCmd --
 *
 *	Procedure called to compile the "regexp" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "regexp" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    /*
     * We are only interested in compiling simple regexp cases.
     * Currently supported compile cases are:
     *   regexp ?-nocase? ?--? staticString $var
     *   regexp ?-nocase? ?--? {^staticString$} $var
     */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    nocase = 0;
    varTokenPtr = parsePtr->tokenPtr;

    /*
     * We only look for -nocase and -- as options.  Everything else
     * gets pushed to runtime execution.  This is different than regexp's
     * runtime option handling, but satisfies our stricter needs.
     */
    for (i = 1; i < parsePtr->numWords - 2; i++) {
	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    /* Not a simple string - punt to runtime. */
	    return TCL_ERROR;
	}
	str = (char *) varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    i++;
	    break;
	} else if ((len > 1)
		&& (strncmp(str, "-nocase", (unsigned) len) == 0)) {
	    nocase = 1;
	} else {
	    /* Not an option we recognize. */
	    return TCL_ERROR;
	}
    }

    if ((parsePtr->numWords - i) != 2) {
	/* We don't support capturing to variables */
	return TCL_ERROR;
    }

    /*
     * Get the regexp string.  If it is not a simple string, punt to runtime.
     * If it has a '-', it could be an incorrectly formed regexp command.
     */
    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
    str = (char *) varTokenPtr[1].start;
    len = varTokenPtr[1].size;
    if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) {
	return TCL_ERROR;
    }

    if (len == 0) {
	/*
	 * The semantics of regexp are always match on re == "".
	 */
	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);

     * Don't do anything with REs with other special chars.  Also check if
     * this is a bad RE (do this at the end because it can be expensive).
     * If so, let it complain at runtime.
     */
    if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL)
	    || (Tcl_RegExpCompile(NULL, str) == NULL)) {
	ckfree((char *) str);
	return TCL_ERROR;
    }

    if (anchorLeft && anchorRight) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, str+start, len-start),
		envPtr);
    } else {
	/*

    }
    ckfree((char *) str);

    /*
     * Push the string arg
     */
    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);




    CompileWord(envPtr, varTokenPtr, interp);



    if (anchorLeft && anchorRight && !nocase) {
	TclEmitOpcode(INST_STR_EQ, envPtr);
    } else {
	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileReturnCmd --
 *
 *	Procedure called to compile the "return" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "return" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    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_ERROR;
    }

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

    if (explicitResult) {


	CompileWord(envPtr, wordTokenPtr, interp);






    } 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

 *
 * TclCompileSetCmd --
 *
 *	Procedure called to compile the "set" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSetCmd(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 *varTokenPtr, *valueTokenPtr;
    int isAssignment, isScalar, simpleVarName, localIndex, numWords;

    numWords = parsePtr->numWords;
    if ((numWords != 2) && (numWords != 3)) {
	return TCL_ERROR;
    }
    isAssignment = (numWords == 3);

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

    /*
     * If we are doing an assignment, push the new value.
     */

    if (isAssignment) {
	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);

	CompileWord(envPtr, valueTokenPtr, interp);





    }

    /*
     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {

 *
 * TclCompileStringCmd --
 *
 *	Procedure called to compile the "string" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

	STR_REPLACE,	STR_TOLOWER,	STR_TOUPPER,	STR_TOTITLE,
	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
	STR_WORDEND,	STR_WORDSTART
    };	  

    if (parsePtr->numWords < 2) {
	/* Fail at run time, not in compilation */
	return TCL_ERROR;
    }
    opTokenPtr = parsePtr->tokenPtr
	+ (parsePtr->tokenPtr->numComponents + 1);

    opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size);
    if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0,
	    &index) != TCL_OK) {
	Tcl_DecrRefCount(opObj);
	Tcl_ResetResult(interp);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(opObj);

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

    switch ((enum options) index) {
	case STR_BYTELENGTH:

	case STR_TRIMLEFT:
	case STR_TRIMRIGHT:
	case STR_WORDEND:
	case STR_WORDSTART:
	    /*
	     * All other cases: compile out of line.
	     */
	    return TCL_ERROR;

	case STR_COMPARE: 
	case STR_EQUAL: {
	    int i;
	    /*
	     * If there are any flags to the command, we can't byte compile it
	     * because the INST_STR_EQ bytecode doesn't support flags.
	     */

	    if (parsePtr->numWords != 4) {
		return TCL_ERROR;
	    }

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

	    for (i = 0; i < 2; i++) {




		CompileWord(envPtr, varTokenPtr, interp);


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

	    TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
		    INST_STR_CMP : INST_STR_EQ), envPtr);
	    return TCL_OK;
	}
	case STR_INDEX: {
	    int i;

	    if (parsePtr->numWords != 4) {
		/* Fail at run time, not in compilation */
		return TCL_ERROR;
	    }

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

	    for (i = 0; i < 2; i++) {




		CompileWord(envPtr, varTokenPtr, interp);


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

	    TclEmitOpcode(INST_STR_INDEX, envPtr);
	    return TCL_OK;
	}
	case STR_LENGTH: {
	    if (parsePtr->numWords != 3) {
		/* Fail at run time, not in compilation */
		return TCL_ERROR;
	    }

	    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
		/*
		 * Here someone is asking for the length of a static string.
		 * Just push the actual character (not byte) length.
		 */

	}
	case STR_MATCH: {
	    int i, length, exactMatch = 0, nocase = 0;
	    CONST char *str;

	    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
		/* Fail at run time, not in compilation */
		return TCL_ERROR;
	    }

	    if (parsePtr->numWords == 5) {
		if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		    return TCL_ERROR;
		}
		str    = varTokenPtr[1].start;
		length = varTokenPtr[1].size;
		if ((length > 1) &&
			strncmp(str, "-nocase", (size_t) length) == 0) {
		    nocase = 1;
		} else {
		    /* Fail at run time, not in compilation */
		    return TCL_ERROR;
		}
		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
	    }

	    for (i = 0; i < 2; i++) {
		if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
		    str = varTokenPtr[1].start;
		    length = varTokenPtr[1].size;
		    if (!nocase && (i == 0)) {
			/*


			 * Trivial matches can be done by 'string equal'.  

			 * If -nocase was specified, we can't do this
			 * because INST_STR_EQ has no support for nocase.

			 */
			Tcl_Obj *copy = Tcl_NewStringObj(str, length);
			Tcl_IncrRefCount(copy);
			exactMatch = TclMatchIsTrivial(Tcl_GetString(copy));

			Tcl_DecrRefCount(copy);
		    }
		    TclEmitPush(
			    TclRegisterNewLiteral(envPtr, str, length), envPtr);
		} else {
		    TclCompileTokens(interp, varTokenPtr+1,
			    varTokenPtr->numComponents, envPtr);

 *----------------------------------------------------------------------
 *
 * TclCompileSwitchCmd --
 *
 *	Procedure called to compile the "switch" command.
 *
 * Results:
 * 	Returns TCL_OK for successful compile, or TCL_ERROR
 * 	to defer evaluation to runtime (either when it is too complex
 * 	to get the semantics right, or when we know for sure that it
 * 	is an error but need the error to happen at the right time).
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "switch" command
 *	at runtime.

     * emulating the behaviour).
     *
     * Note that this parsing would probably be better done with a
     * loop, but it works for now...
     */

    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    } else {
	register int size = tokenPtr[1].size;
	register CONST char *chrs = tokenPtr[1].start;

	/*
	 * Assume that -e and -g are unique prefixes of -exact and -glob
	 */
	if (size < 2) {
	    return TCL_ERROR;
	}
	if ((size <= 6) && (numWords >= 4)
		&& !strncmp(chrs, "-exact", (unsigned) TclMin(size, 6))) {
	    mode = Switch_Exact;
	    tokenPtr += 2;
	    numWords--;
	} else if ((size <= 5) && (numWords >= 4)
		&& !strncmp(chrs, "-glob", (unsigned) TclMin(size, 5))) {
	    mode = Switch_Glob;
	    tokenPtr += 2;
	    numWords--;
	} else if ((size == 2) && (numWords >= 3) && !strncmp(chrs, "--", 2)) {
	    /*
	     * If no control flag present, use exact matching (the default).
	     *
	     * We end up re-checking this word, but that's the way things are.
	     */
	    mode = Switch_Exact;
	} else {
	    return TCL_ERROR;
	}
    }
    if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (tokenPtr[1].size != 2)
	    || strncmp(tokenPtr[1].start, "--", 2)) {
	return TCL_ERROR;
    }
    tokenPtr += 2;
    numWords--;

    /*
     * The value to test against is going to always get pushed on the
     * stack.  But not yet; we need to verify that the rest of the

	/*
	 * Test that we've got a suitable body list as a simple (i.e.
	 * braced) word, and that the elements of the body are simple
	 * words too.  This is really rather nasty indeed.
	 */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&bodyList);
	Tcl_DStringAppend(&bodyList, tokenPtr[1].start, tokenPtr[1].size);
	if (Tcl_SplitList(NULL, Tcl_DStringValue(&bodyList), &numWords,
		&argv) != TCL_OK) {
	    Tcl_DStringFree(&bodyList);
	    return TCL_ERROR;
	}
	Tcl_DStringFree(&bodyList);
	if (numWords == 0 || numWords % 2) {
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}
	bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords);
	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
	tokenStartPtr = tokenPtr[1].start;
	while (isspace(UCHAR(*tokenStartPtr))) {
	    tokenStartPtr++;
	}

	     */
	    if ((isTokenBraced && *(tokenStartPtr++) != '}') ||
		    (tokenStartPtr < tokenPtr[1].start+tokenPtr[1].size
		    && !isspace(UCHAR(*tokenStartPtr)))) {
		ckfree((char *) argv);
		ckfree((char *) bodyToken);
		ckfree((char *) bodyTokenArray);
		return TCL_ERROR;
	    }
	    while (isspace(UCHAR(*tokenStartPtr))) {
		tokenStartPtr++;
		if (tokenStartPtr >= tokenPtr[1].start+tokenPtr[1].size) {
		    break;
		}
	    }

	 * Check that we've parsed everything we thought we were going
	 * to parse. If not, something odd is going on and we should
	 * bail out.
	 */
	if (tokenStartPtr != tokenPtr[1].start+tokenPtr[1].size) {
	    ckfree((char *) bodyToken);
	    ckfree((char *) bodyTokenArray);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	return TCL_ERROR;
    } else {
	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more
	     * complex is a good reason to go to the interpreted case
	     * anyway due to traces, etc.
	     */
	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
		    tokenPtr->numComponents != 1) {
		ckfree((char *) bodyToken);
		return TCL_ERROR;
	    }
	    bodyToken[i] = tokenPtr+1;
	    tokenPtr += tokenPtr->numComponents+1;
	}
    }

    /*
     * Fall back to interpreted if the last body is a continuation
     * (it's illegal, but this makes the error happen at the right
     * time).
     */

    if (bodyToken[numWords-1]->size == 1 &&
	    bodyToken[numWords-1]->start[0] == '-') {
	ckfree((char *) bodyToken);
	if (bodyTokenArray != NULL) {
	    ckfree((char *) bodyTokenArray);
	}
	return TCL_ERROR;
    }

    /*
     * Now we commit to generating code; the parsing stage per se is
     * done.
     *
     * First, we push the value we're matching against on the stack.

 *
 * TclCompileVariableCmd --
 *
 *	Procedure called to reserve the local variables for the 
 *      "variable" command. The command itself is *not* compiled.
 *
 * Results:
 *      Always returns TCL_ERROR.
 *
 * Side effects:
 *      Indexed local variables are added to the environment.
 *
 *----------------------------------------------------------------------
 */
int
TclCompileVariableCmd(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 *varTokenPtr;
    int i, numWords;
    CONST char *varName, *tail;

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

    numWords = parsePtr->numWords;

    varTokenPtr = parsePtr->tokenPtr
	+ (parsePtr->tokenPtr->numComponents + 1);
    for (i = 1; i < numWords; i += 2) {

		tail++;
	    }
	    (void) TclFindCompiledLocal(tail, (tail-varName+1),
		    /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
	    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
	}
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileWhileCmd --
 *
 *	Procedure called to compile the "while" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "while" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

    int savedStackDepth = envPtr->currStackDepth;
    int loopMayEnd = 1;         /* This is set to 0 if it is recognized as
				 * an infinite loop. */
    Tcl_Obj *boolObj;
    int boolVal;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the
     * while command inline. E.g., the expression might cause the loop to
     * never execute or execute forever, as in "while "$x < 5" {}".
     *
     * Bail out also if the body expression requires substitutions
     * in order to insure correct behaviour [Bug 219166]
     */

    testTokenPtr = parsePtr->tokenPtr
	    + (parsePtr->tokenPtr->numComponents + 1);
    bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
    if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
	return TCL_ERROR;
    }

    /*
     * Find out if the condition is a constant. 
     */

    boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);

 * PushVarName --
 *
 *	Procedure used in the compiling where pushing a variable name
 *	is necessary (append, lappend, set).
 *
 * Results:
 * 	Returns TCL_OK for a successful compile.
 * 	Returns TCL_ERROR to defer evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

/* 
 * 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.7 2005/05/11 16:58:33 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

    ExprInfo *infoPtr;		/* Describes the compilation state for the
				 * expression being compiled. */
    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. */
{
    Tcl_DString cmdName;
    int objIndex;


    Tcl_Token *tokenPtr, *afterSubexprPtr;
    int argCount;
    int code = TCL_OK;
		       
    /*
     * Prepend "tcl::mathfunc::" to the function name, to produce the 
     * name of a command that evaluates the function.  Push that
     * command name on the stack, in a literal registered to the
     * namespace so that resolution can be cached.
     */

    Tcl_DStringInit( &cmdName );


    Tcl_DStringAppend( &cmdName, "tcl::mathfunc::", -1 );
    Tcl_DStringAppend( &cmdName, funcName, -1 );

    objIndex = TclRegisterNewNSLiteral( envPtr,



					 Tcl_DStringValue( &cmdName ),



					 Tcl_DStringLength( &cmdName ) );

    TclEmitPush( objIndex, envPtr );

    Tcl_DStringFree( &cmdName );

    /*
     * Compile any arguments for the function.
     */

    argCount = 1;
    tokenPtr = exprTokenPtr+2;
    afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);


    while (tokenPtr != afterSubexprPtr) {

	++argCount;



	code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	if (code != TCL_OK) {

	    return code;
	}
	tokenPtr += (tokenPtr->numComponents + 1);
    }












    



    /* Invoke the function */









    if ( argCount < 255 ) {



	TclEmitInstInt1( INST_INVOKE_STK1, argCount, envPtr );


    } else {
	TclEmitInstInt4( INST_INVOKE_STK4, argCount, envPtr );
    }



    *endPtrPtr = afterSubexprPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LogSyntaxError --
 *

/* 
 * 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.18 2005/05/11 16:58:33 dgp Exp $
 */

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

/*
 * Table of all AuxData types.

	    int objIndex = TclRegisterNewNSLiteral(envPtr, tokenPtr[1].start,
		    tokenPtr[1].size);
	    Tcl_Obj *cmdName = envPtr->literalArrayPtr[objIndex].objPtr;
	    Command *cmdPtr = 
		    (Command *) Tcl_GetCommandFromObj(interp, cmdName);
	    int savedNumCmds = envPtr->numCommands;
	    unsigned int savedCodeNext = envPtr->codeNext - envPtr->codeStart;
	    int code = TCL_ERROR;

	    if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)
		    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
		    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
		Tcl_Parse parse;

		/*

/*
 * tclCompile.h --
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 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: tclCompile.h,v 1.36.2.13 2005/05/11 16:58:33 dgp Exp $
 */

#ifndef _TCLCOMPILATION
#define _TCLCOMPILATION 1

#include "tclInt.h"

    int numOperands;		/* Number of operands. */
    InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
				/* The type of each operand. */
} InstructionDesc;

MODULE_SCOPE InstructionDesc tclInstructionTable[];



























































/*
 * Compilation of some Tcl constructs such as if commands and the logical or
 * (||) and logical and (&&) operators in expressions requires the
 * generation of forward jumps. Since the PC target of these jumps isn't
 * known when the jumps are emitted, we record the offset of each jump in an
 * array of JumpFixup structures. There is one array for each sequence of
 * jumps to one target PC. When we learn the target PC, we update the jumps

/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * 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: tclDecls.h,v 1.95.2.15 2005/05/11 16:58:33 dgp Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl

#endif
#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
#define Tcl_ChannelThreadActionProc_TCL_DECLARED
/* 554 */
EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
				Tcl_ChannelType * chanTypePtr));
#endif
#ifndef Tcl_NewBignumObj_TCL_DECLARED
#define Tcl_NewBignumObj_TCL_DECLARED
/* 555 */
EXTERN Tcl_Obj*		Tcl_NewBignumObj _ANSI_ARGS_((mp_int* value));
#endif
#ifndef Tcl_DbNewBignumObj_TCL_DECLARED
#define Tcl_DbNewBignumObj_TCL_DECLARED
/* 556 */
EXTERN Tcl_Obj*		Tcl_DbNewBignumObj _ANSI_ARGS_((mp_int* value, 
				CONST char* file, int line));
#endif
#ifndef Tcl_SetBignumObj_TCL_DECLARED
#define Tcl_SetBignumObj_TCL_DECLARED
/* 557 */
EXTERN void		Tcl_SetBignumObj _ANSI_ARGS_((Tcl_Obj* obj, 
				mp_int* value));
#endif
#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
#define Tcl_GetBignumFromObj_TCL_DECLARED
/* 558 */
EXTERN int		Tcl_GetBignumFromObj _ANSI_ARGS_((Tcl_Interp* interp, 
				Tcl_Obj* obj, mp_int* value));
#endif

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    int (*tcl_GetEnsembleMappingDict) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** mapDictPtr)); /* 548 */
    int (*tcl_GetEnsembleUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** unknownListPtr)); /* 549 */
    int (*tcl_GetEnsembleFlags) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, int * flagsPtr)); /* 550 */
    int (*tcl_GetEnsembleNamespace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Namespace ** namespacePtrPtr)); /* 551 */
    void (*tcl_SetTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc* getProc, Tcl_ScaleTimeProc* scaleProc, ClientData clientData)); /* 552 */
    void (*tcl_QueryTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc** getProc, Tcl_ScaleTimeProc** scaleProc, ClientData* clientData)); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
    Tcl_Obj* (*tcl_NewBignumObj) _ANSI_ARGS_((mp_int* value)); /* 555 */
    Tcl_Obj* (*tcl_DbNewBignumObj) _ANSI_ARGS_((mp_int* value, CONST char* file, int line)); /* 556 */
    void (*tcl_SetBignumObj) _ANSI_ARGS_((Tcl_Obj* obj, mp_int* value)); /* 557 */
    int (*tcl_GetBignumFromObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 558 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclStubs *tclStubsPtr;
#ifdef __cplusplus

#define Tcl_QueryTimeProc \
	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
#endif
#ifndef Tcl_ChannelThreadActionProc
#define Tcl_ChannelThreadActionProc \
	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
#endif
#ifndef Tcl_NewBignumObj
#define Tcl_NewBignumObj \
	(tclStubsPtr->tcl_NewBignumObj) /* 555 */
#endif
#ifndef Tcl_DbNewBignumObj
#define Tcl_DbNewBignumObj \
	(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
#endif
#ifndef Tcl_SetBignumObj
#define Tcl_SetBignumObj \
	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
#endif
#ifndef Tcl_GetBignumFromObj
#define Tcl_GetBignumFromObj \
	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLDECLS */

/* 
 * tclDictObj.c --
 *
 *	This file contains procedures that implement the Tcl dict object
 *	type and its accessor command.
 *
 * Copyright (c) 2002 by 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: tclDictObj.c,v 1.10.2.10 2005/05/11 16:58:35 dgp Exp $
 */

#include "tclInt.h"

/*
 * Forward declaration.
 */

    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc == 4) {
	pattern = TclGetString(objv[3]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	Tcl_Obj *valuePtr = NULL;
	Tcl_DictObjGet(interp, objv[2], objv[3], &valuePtr);
	if (valuePtr != NULL) {
	    Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
	}
	goto searchDone;
    }
    for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) {
	if (pattern==NULL || Tcl_StringMatch(TclGetString(keyPtr), pattern)) {
	    /*
	     * Assume this operation always succeeds.
	     */
	    Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
	}
    }
searchDone:
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	 */
	if (Tcl_DictObjFirst(interp, objv[2], &search,
		&keyObj, &valueObj, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
	pattern = TclGetString(objv[4]);
	resultObj = Tcl_NewDictObj();
	if (TclMatchIsTrivial(pattern)) {
	    Tcl_DictObjGet(interp, objv[2], objv[4], &valueObj);
	    if (valueObj != NULL) {
		Tcl_DictObjPut(interp, resultObj, objv[4], valueObj);
	    }
	} else {
	    while (!done) {
		if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
		}
		Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
	    }
	}
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;

    case FILTER_VALUES:
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "dictionary value globPattern");

 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.29.2.11 2005/05/11 16:58:37 dgp Exp $
 */

#include "tclInt.h"

/*
 * The data structure below is used to report background errors.  One
 * such structure is allocated for each error;  it holds information

	    TclInitAlloc(); /* process wide mutex init */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc(); /* process wide mutex init */
#endif

	    TclpInitPlatform(); /* creates signal handler(s) */
	    TclInitDoubleConversion(); /* initializes constants for
					* converting to/from double */
    	    TclInitObjSubsystem(); /* register obj types, create mutexes */
	    TclInitIOSubsystem(); /* inits a tsd key (noop) */
	    TclInitEncodingSubsystem(); /* process wide encoding init */
	    TclpSetInterfaces();
    	    TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
	}
	TclpInitUnlock();

	 * Once load has been finalized, we will have deleted any
	 * temporary copies of shared libraries and can therefore
	 * reset the filesystem to its original state.
	 */

	TclFinalizeLoad();
	TclResetFilesystem();

	/* Now we can free constants for conversions to/from double */

	TclFinalizeDoubleConversion();
	
	/*
	 * There shouldn't be any malloc'ed memory after this.
	 */
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
  TclFinalizeThreadAlloc();
#endif

/* 
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl
 *	commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 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: tclExecute.c,v 1.101.2.20 2005/05/11 16:58:40 dgp Exp $
 */

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

#ifndef TCL_NO_MATH
#   include <math.h>
#endif
#include <float.h>

/*
 * Hack to determine whether we may expect IEEE floating point.
 * The hack is formally incorrect in that non-IEEE platforms might
 * have the same precision and range, but VAX, IBM, and Cray do not;
 * are there any other floating point units that we might care about?
 */

#if ( FLT_RADIX == 2 ) && ( DBL_MANT_DIG == 53 ) && ( DBL_MAX_EXP == 1024 )
#define IEEE_FLOATING_POINT
#endif

/*
 * The stuff below is a bit of a hack so that this file can be used
 * in environments that include no UNIX, i.e. no errno.  Just define
 * errno here.
 */

/*
 * Macros for testing floating-point values for certain special cases. Test
 * for not-a-number by comparing a value against itself; test for infinity
 * by comparing against the largest floating-point value.
 */

#ifdef _MSC_VER
#define IS_NAN(f) (_isnan((f)))
#define IS_INF(f) ( ! (_finite((f))))
#else
#define IS_NAN(f) ((f) != (f))
#define IS_INF(f) ( (f) > DBL_MAX || (f) < -DBL_MAX )
#endif

/*
 * The new macro for ending an instruction; note that a
 * reasonable C-optimiser will resolve all branches
 * at compile time. (result) is always a constant; the macro 
 * NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is
 * resolved at runtime for variable (nCleanup).

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

static int		TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
			    ByteCode *codePtr));




















#ifdef TCL_COMPILE_STATS
static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
#endif /* TCL_COMPILE_STATS */
#ifdef TCL_COMPILE_DEBUG
static char *		GetOpcodeName _ANSI_ARGS_((unsigned char *pc));

static void		PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
static char *		StringForResultCode _ANSI_ARGS_((int result));
static void		ValidatePcAndStackTop _ANSI_ARGS_((
			    ByteCode *codePtr, unsigned char *pc,
			    int stackTop, int stackLowerBound, 
			    int checkStack));
#endif /* TCL_COMPILE_DEBUG */


static Tcl_WideInt	ExponWide _ANSI_ARGS_((Tcl_WideInt w, Tcl_WideInt w2,
			    int *errExpon));
static long		ExponLong _ANSI_ARGS_((long i, long i2,
			    int *errExpon));







































/*
 *----------------------------------------------------------------------
 *
 * InitByteCodeExecution --
 *
 *	This procedure is called once to initialize the Tcl bytecode

	        case INST_SUB:
		    dResult = d1 - d2;
		    break;
	        case INST_MULT:
		    dResult = d1 * d2;
		    break;
	        case INST_DIV:
#ifndef IEEE_FLOATING_POINT
		    if (d2 == 0.0) {
			TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
			goto divideByZero;
		    }
#endif
		    /*
		     * We presume that we are running with zero-divide
		     * unmasked if we're on an IEEE box. Otherwise,
		     * this statement might cause demons to fly out
		     * our noses.
		     */
		    dResult = d1 / d2;
		    break;
		case INST_EXPON:
		    if (d1==0.0 && d2<0.0) {
			TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
			goto exponOfZero;
		    }
		    dResult = pow(d1, d2);
		    break;
	    }
		    
	    /*
	     * Check now for IEEE floating-point error.
	     */
		    
	    if (IS_NAN(dResult)) {
		TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
		        O2S(valuePtr), O2S(value2Ptr)));
		TclExprFloatError(interp, dResult);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	} else if ((t1Ptr == &tclWideIntType) 

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

    case INST_CALL_BUILTIN_FUNC1:
        {










	    Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
	}





		    





    case INST_CALL_FUNC1:
	{




	    Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");




	}













    case INST_TRY_CVT_TO_NUMERIC:
    {
	/*
	 * Try to convert the topmost stack object to an int or
	 * double object. This is done in order to support Tcl's
	 * policy of interpreting operands if at all possible as

		}
	    } else {
		Tcl_InvalidateStringRep(valuePtr);
	    }
		
	    if (tPtr == &tclDoubleType) {
		d = objResultPtr->internalRep.doubleValue;
		if (IS_NAN(d)) {
		    TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
		            O2S(objResultPtr)));
		    TclExprFloatError(interp, d);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
	    }

    return tclInstructionTable[opCode].name;
}
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *























































































































































































































































































































































































































































































































































































































































































































































































 * TclExprFloatError --
 *
 *	This procedure is called when an error occurs during a
 *	floating-point operation. It reads errno and sets
 *	interp->objResultPtr accordingly.
 *
 * Results:

	if (w2 < 0) {
	    return W0;
	} else if (w2 == 0) {
	    return Tcl_LongAsWide(1);
	}
    } else if (w == -1) {
	return (w2 & 1) ? Tcl_LongAsWide(-1) :  Tcl_LongAsWide(1);
    } else if ((w == 1) || (w2 == 0)) {
	return Tcl_LongAsWide(1);
    } else if (w>1 && w2<0) {
	return W0;
    }

    /*
     * The general case.  

        if (i2 < 0) {
            return 0L;
        } else if (i2 == 0) {
	    return 1L;
        }
    } else if (i == -1) {
        return (i2&1) ? -1L : 1L;
    } else if ((i == 1) || (i2 == 0)) {
        return 1L;
    } else if (i > 1 && i2 < 0) {
        return 0L;
    }

    /*
     * The general case

/* 
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIO.c,v 1.68.2.12 2005/05/11 16:58:41 dgp Exp $
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>



    /*
     * Get the channel table that stores the channels registered
     * for this interpreter.
     */

    hTblPtr = GetChannelTable(interp);
    TclNewObj(resultPtr);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)
	    && !((pattern[0] == 's') && (pattern[1] == 't')
	    && (pattern[2] == 'd'))) {
	if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL)
		&& (Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(pattern, -1)) != TCL_OK)) {
	    goto error;
	}
	goto done;
    }
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != (Tcl_HashEntry *) NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {

	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
	    name = "stdin";

	    name = statePtr->channelName;
	}

	if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
		(Tcl_ListObjAppendElement(interp, resultPtr,
			Tcl_NewStringObj(name, -1)) != TCL_OK)) {
error:
	    TclDecrRefCount(resultPtr);
	    return TCL_ERROR;
	}
    }
done:
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

#
# 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: tclInt.decls,v 1.61.2.12 2005/05/11 16:58:45 dgp Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

#}

declare 198 generic {
    int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CallFrame **framePtrPtr)
}

#declare 199 generic {
#    int TclMatchIsTrivial(CONST char *pattern)

#}

# 200-208 exported for use by the test suite [Bug 1054748]
declare 200 generic {
    int TclpObjRemoveDirectory (Tcl_Obj *pathPtr, int recursive,
	Tcl_Obj **errorPtr)
}
declare 201 generic {

    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame )
}
declare 218 generic {
    void TclPopStackFrame(Tcl_Interp *interp)
}

# Entries in tommath needed only by tcltest

declare 219 generic {
    int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d)
}
declare 220 generic {
    int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *c)
}
declare 221 generic {
    void TclBN_mp_clear(mp_int *a)
}
declare 222 generic {
    int TclBN_mp_init(mp_int *a)
}
declare 223 generic {
    int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

interface tclIntPlat

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-19/99 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: tclInt.h,v 1.127.2.24 2005/05/11 16:58:45 dgp Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are

/*
 * The type of procedures called by the Tcl bytecode compiler to compile
 * commands. Pointers to these procedures are kept in the Command structure
 * describing each command.  The integer value returned by a CompileProc
 * must be one of the following:
 *
 * TCL_OK		Compilation completed normally.
 * TCL_ERROR 		Compilation could not be completed.  This can
 * 			be just a judgment by the CompileProc that the
 * 			command is too complex to compile effectively,
 * 			or it can indicate that in the current state of
 * 			the interp, the command would raise an error.
 * 			The bytecode compiler will not do any error reporting
 * 			at compiler time.  Error reporting is deferred
 * 			until the actual runtime, because by then changes
 * 			in the interp state may allow the command to be
 * 			successfully evaluated.  
 * TCL_OUT_LINE_COMPILE	A source-compatible alias for TCL_ERROR, kept
 * 			for the sake of old code only.
 */

#define TCL_OUT_LINE_COMPILE	TCL_ERROR

typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp,
	Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr));

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.

MODULE_SCOPE void	TclAppendLimitedToObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
			    CONST char *bytes, int length, int limit,
			    CONST char *ellipsis));
MODULE_SCOPE void	TclAppendObjToErrorInfo _ANSI_ARGS_((
			    Tcl_Interp *interp, Tcl_Obj *objPtr));
MODULE_SCOPE int	TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
MODULE_SCOPE double     TclBignumToDouble _ANSI_ARGS_((mp_int* bignum));
MODULE_SCOPE int	TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *value));
MODULE_SCOPE void	TclCleanupLiteralTable _ANSI_ARGS_((
			    Tcl_Interp* interp, LiteralTable* tablePtr));
MODULE_SCOPE void	TclDiscardInterpState _ANSI_ARGS_ ((
			    Tcl_InterpState state));
MODULE_SCOPE int	TclDoubleDigits _ANSI_ARGS_((char* buf,
						     double value,
						     int* signum));
MODULE_SCOPE int	TclEvalScriptTokens _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int length, int flags));
MODULE_SCOPE void	TclExpandTokenArray _ANSI_ARGS_((
			    Tcl_Parse *parsePtr));
MODULE_SCOPE int	TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
MODULE_SCOPE int	TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp, 
			    int objc, Tcl_Obj *CONST objv[])) ;
MODULE_SCOPE int	TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
MODULE_SCOPE int	TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[])) ;
MODULE_SCOPE int	TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[])) ;
MODULE_SCOPE void	TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeCompExecEnv _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeCompilation _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeDoubleConversion _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeEncodingSubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeEnvironment _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeExecution _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeIOSubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeFilesystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclResetFilesystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeLoad _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeNotifier _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeAsync _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeSynchronization _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeLock _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFinalizeThreadData _ANSI_ARGS_((void));
MODULE_SCOPE void	TclFormatNaN _ANSI_ARGS_((double value, char* buffer));
MODULE_SCOPE int	TclFSFileAttrIndex _ANSI_ARGS_((Tcl_Obj *pathPtr,
			    CONST char *attributeName, int *indexPtr));
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp));
MODULE_SCOPE int	TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr));
MODULE_SCOPE int        TclGetNamespaceFromObj _ANSI_ARGS_((
			    Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_Namespace **nsPtrPtr));
MODULE_SCOPE int	TclGetOpenModeEx _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *modeString, int *seekFlagPtr,
			    int *binaryPtr));
MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue _ANSI_ARGS_ ((
			    ProcessGlobalValue *pgvPtr));
MODULE_SCOPE Tcl_Token *TclGetTokensFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
			    Tcl_Token **lastTokenPtrPtr));
MODULE_SCOPE int	TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
			    char *pattern, Tcl_Obj *unquotedPrefix, 
			    int globFlags, Tcl_GlobTypeData* types));
MODULE_SCOPE void	TclInitAlloc _ANSI_ARGS_((void));
MODULE_SCOPE void	TclInitDbCkalloc _ANSI_ARGS_((void));
MODULE_SCOPE void	TclInitDoubleConversion _ANSI_ARGS_((void));
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation 
			    _ANSI_ARGS_((Tcl_Interp *interp));
MODULE_SCOPE void	TclInitEncodingSubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclInitIOSubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclInitLimitSupport _ANSI_ARGS_((Tcl_Interp *interp));
MODULE_SCOPE void	TclInitNamespaceSubsystem _ANSI_ARGS_((void));
MODULE_SCOPE void	TclInitNotifier _ANSI_ARGS_((void));

MODULE_SCOPE void	TclSetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix));
MODULE_SCOPE void	TclSetProcessGlobalValue _ANSI_ARGS_ ((
			    ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue,
			    Tcl_Encoding encoding));
MODULE_SCOPE VOID	TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
			    int result));
MODULE_SCOPE double	TclStrToD _ANSI_ARGS_((CONST char* string,
					       CONST char** endPtr));
MODULE_SCOPE int	TclSubstTokens _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    int *tokensLeftPtr, int flags));
MODULE_SCOPE void	TclTransferResult _ANSI_ARGS_((
			    Tcl_Interp *sourceInterp, int result,
			    Tcl_Interp *targetInterp));
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized _ANSI_ARGS_((

 */

#define TclInvalidateNsCmdLookup(nsPtr) \
    if ((nsPtr)->numExportPatterns) { \
	(nsPtr)->exportLookupEpoch++; \
    }

/*
 *----------------------------------------------------------------------
 *
 * Core procedures added to libtommath for bignum manipulation.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE void* TclBNAlloc( size_t nBytes );
MODULE_SCOPE void* TclBNRealloc( void* oldBlock, size_t newNBytes );
MODULE_SCOPE void TclBNFree( void* block );
MODULE_SCOPE void TclBNInitBignumFromLong( mp_int* bignum, long initVal );


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has
 * any characters special to [string match].
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial _ANSI_ARGS_((
 * 			    CONST char *pattern));
 *----------------------------------------------------------------
 */

#define TclMatchIsTrivial(pattern) strpbrk((pattern), "*[]]?\\") == NULL

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to set a Tcl_Obj's numeric representation
 * avoiding the corresponding function calls in time critical parts of the
 * core. They should only be called on unshared objects. The ANSI C
 * "prototypes" for these macros are:  
 *

/*
 * tclIntDecls.h --
 *
 *	This file contains the declarations for all unsupported
 *	functions that are exported by the Tcl library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * 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: tclIntDecls.h,v 1.50.2.14 2005/05/11 16:58:45 dgp Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

/* Slot 197 is reserved */
#ifndef TclObjGetFrame_TCL_DECLARED
#define TclObjGetFrame_TCL_DECLARED
/* 198 */
EXTERN int		TclObjGetFrame _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * objPtr, CallFrame ** framePtrPtr));
#endif


/* Slot 199 is reserved */


#ifndef TclpObjRemoveDirectory_TCL_DECLARED
#define TclpObjRemoveDirectory_TCL_DECLARED
/* 200 */
EXTERN int		TclpObjRemoveDirectory _ANSI_ARGS_((
				Tcl_Obj * pathPtr, int recursive, 
				Tcl_Obj ** errorPtr));
#endif

				Tcl_Namespace * namespacePtr, 
				int isProcCallFrame));
#endif
#ifndef TclPopStackFrame_TCL_DECLARED
#define TclPopStackFrame_TCL_DECLARED
/* 218 */
EXTERN void		TclPopStackFrame _ANSI_ARGS_((Tcl_Interp * interp));
#endif
#ifndef TclBN_mp_div_d_TCL_DECLARED
#define TclBN_mp_div_d_TCL_DECLARED
/* 219 */
EXTERN int		TclBN_mp_div_d _ANSI_ARGS_((mp_int * a, mp_digit b, 
				mp_int * c, mp_digit * d));
#endif
#ifndef TclBN_mp_mul_d_TCL_DECLARED
#define TclBN_mp_mul_d_TCL_DECLARED
/* 220 */
EXTERN int		TclBN_mp_mul_d _ANSI_ARGS_((mp_int * a, mp_digit b, 
				mp_int * c));
#endif
#ifndef TclBN_mp_clear_TCL_DECLARED
#define TclBN_mp_clear_TCL_DECLARED
/* 221 */
EXTERN void		TclBN_mp_clear _ANSI_ARGS_((mp_int * a));
#endif
#ifndef TclBN_mp_init_TCL_DECLARED
#define TclBN_mp_init_TCL_DECLARED
/* 222 */
EXTERN int		TclBN_mp_init _ANSI_ARGS_((mp_int * a));
#endif
#ifndef TclBN_mp_read_radix_TCL_DECLARED
#define TclBN_mp_read_radix_TCL_DECLARED
/* 223 */
EXTERN int		TclBN_mp_read_radix _ANSI_ARGS_((mp_int * a, 
				const char * str, int radix));
#endif

typedef struct TclIntStubs {
    int magic;
    struct TclIntStubHooks *hooks;

    void *reserved0;

    void (*tclThreadStorageDataKeySet) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, void * data)); /* 192 */
    void (*tclFinalizeThreadStorageThread) _ANSI_ARGS_((Tcl_ThreadId id)); /* 193 */
    void (*tclFinalizeThreadStorage) _ANSI_ARGS_((void)); /* 194 */
    void (*tclFinalizeThreadStorageData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr)); /* 195 */
    void (*tclFinalizeThreadStorageDataKey) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr)); /* 196 */
    void *reserved197;
    int (*tclObjGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CallFrame ** framePtrPtr)); /* 198 */
    void *reserved199;
    int (*tclpObjRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 200 */
    int (*tclpObjCopyDirectory) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 201 */
    int (*tclpObjCreateDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 202 */
    int (*tclpObjDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 203 */
    int (*tclpObjCopyFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 204 */
    int (*tclpObjRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 205 */
    int (*tclpObjStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 206 */
    int (*tclpObjAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 207 */
    Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, int mode, int permissions)); /* 208 */
    Tcl_Obj * (*tclGetEncodingSearchPath) _ANSI_ARGS_((void)); /* 209 */
    int (*tclSetEncodingSearchPath) _ANSI_ARGS_((Tcl_Obj * searchPath)); /* 210 */
    CONST char * (*tclpGetEncodingNameFromEnvironment) _ANSI_ARGS_((Tcl_DString * bufPtr)); /* 211 */
    void (*tclpFindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) _ANSI_ARGS_((void)); /* 213 */
    void (*tclSetObjNameOfExecutable) _ANSI_ARGS_((Tcl_Obj * name, Tcl_Encoding encoding)); /* 214 */
    char * (*tclStackAlloc) _ANSI_ARGS_((Tcl_Interp * interp, int numBytes)); /* 215 */
    void (*tclStackFree) _ANSI_ARGS_((Tcl_Interp * interp)); /* 216 */
    int (*tclPushStackFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_CallFrame ** framePtrPtr, Tcl_Namespace * namespacePtr, int isProcCallFrame)); /* 217 */
    void (*tclPopStackFrame) _ANSI_ARGS_((Tcl_Interp * interp)); /* 218 */
    int (*tclBN_mp_div_d) _ANSI_ARGS_((mp_int * a, mp_digit b, mp_int * c, mp_digit * d)); /* 219 */
    int (*tclBN_mp_mul_d) _ANSI_ARGS_((mp_int * a, mp_digit b, mp_int * c)); /* 220 */
    void (*tclBN_mp_clear) _ANSI_ARGS_((mp_int * a)); /* 221 */
    int (*tclBN_mp_init) _ANSI_ARGS_((mp_int * a)); /* 222 */
    int (*tclBN_mp_read_radix) _ANSI_ARGS_((mp_int * a, const char * str, int radix)); /* 223 */
} TclIntStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclIntStubs *tclIntStubsPtr;
#ifdef __cplusplus

	(tclIntStubsPtr->tclFinalizeThreadStorageDataKey) /* 196 */
#endif
/* Slot 197 is reserved */
#ifndef TclObjGetFrame
#define TclObjGetFrame \
	(tclIntStubsPtr->tclObjGetFrame) /* 198 */
#endif


/* Slot 199 is reserved */

#ifndef TclpObjRemoveDirectory
#define TclpObjRemoveDirectory \
	(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
#endif
#ifndef TclpObjCopyDirectory
#define TclpObjCopyDirectory \
	(tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */

#define TclPushStackFrame \
	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
#endif
#ifndef TclPopStackFrame
#define TclPopStackFrame \
	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
#endif
#ifndef TclBN_mp_div_d
#define TclBN_mp_div_d \
	(tclIntStubsPtr->tclBN_mp_div_d) /* 219 */
#endif
#ifndef TclBN_mp_mul_d
#define TclBN_mp_mul_d \
	(tclIntStubsPtr->tclBN_mp_mul_d) /* 220 */
#endif
#ifndef TclBN_mp_clear
#define TclBN_mp_clear \
	(tclIntStubsPtr->tclBN_mp_clear) /* 221 */
#endif
#ifndef TclBN_mp_init
#define TclBN_mp_init \
	(tclIntStubsPtr->tclBN_mp_init) /* 222 */
#endif
#ifndef TclBN_mp_read_radix
#define TclBN_mp_read_radix \
	(tclIntStubsPtr->tclBN_mp_read_radix) /* 223 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */

 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   mmclennan@lucent.com
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.31.4.14 2005/05/11 16:58:46 dgp Exp $
 */

#include "tclInt.h"

/*
 * Initial size of stack allocated space for tail list - used when resetting
 * shadowed command references in the functin: TclResetShadowedCmdRefs.

} EnsembleCmdRep;

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

static void		DeleteImportedCmd _ANSI_ARGS_((ClientData clientData));
static int		DoImport _ANSI_ARGS_((Tcl_Interp *interp,
			    Namespace *nsPtr, Tcl_HashEntry *hPtr,
			    CONST char *cmdName, CONST char *pattern,
			    Namespace *importNsPtr, int allowOverwrite));
static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr));
static char *		ErrorCodeRead _ANSI_ARGS_(( ClientData clientData,
			    Tcl_Interp *interp, CONST char *name1,
			    CONST char *name2, int flags));
static char *		ErrorInfoRead _ANSI_ARGS_(( ClientData clientData,
			    Tcl_Interp *interp, CONST char *name1,

    /*
     * Scan through the command table in the source namespace and look for
     * exported commands that match the string pattern. Create an "imported
     * command" in the current namespace for each imported command; these
     * commands redirect their invocations to the "real" command.
     */

    if ((simplePattern != NULL) && TclMatchIsTrivial(simplePattern)) {
	hPtr = Tcl_FindHashEntry(&importNsPtr->cmdTable, simplePattern);
	if (hPtr == NULL) {
	    return TCL_OK;
	}
	return DoImport(interp, nsPtr, hPtr, simplePattern, pattern,
		importNsPtr, allowOverwrite);
    }
    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
	    (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
	char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
	if (Tcl_StringMatch(cmdName, simplePattern)
		&& (TCL_ERROR == DoImport( interp, nsPtr, hPtr, cmdName,
		pattern, importNsPtr, allowOverwrite))) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

static int
DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
    Tcl_Interp *interp;
    Namespace *nsPtr;
    Tcl_HashEntry *hPtr;
    CONST char *cmdName;
    CONST char *pattern;
    Namespace *importNsPtr;
    int allowOverwrite;
{
    int i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the
     * pattern. Check whether it was exported. If it wasn't,
     * we ignore it.
     */



    while (!exported && (i < importNsPtr->numExportPatterns)) {
	exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]);


    }

    if (!exported) {

	return TCL_OK;
    }

    /*
     * Unless there is a name clash, create an imported command
     * in the current namespace that refers to cmdPtr.
     */

    found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
    if ((found == NULL) || allowOverwrite) {
	/*
	 * Create the imported command and its client data.
	 * To create the new command in the current namespace, 
	 * generate a fully qualified name for it.
	 */

	Tcl_DString ds;
	Tcl_Command importedCmd;
	ImportedCmdData *dataPtr;
	Command *cmdPtr;
	ImportRef *refPtr;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
	    Tcl_DStringAppend(&ds, "::", 2);
	}
	Tcl_DStringAppend(&ds, cmdName, -1);

	/*
	 * Check whether creating the new imported command in the
	 * current namespace would create a cycle of imported
	 * command references.
	 */

	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
	if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
	    Command *overwrite = (Command *) Tcl_GetHashValue(found);
	    Command *link = cmdPtr;

	    while (link->deleteProc == DeleteImportedCmd) {
		ImportedCmdData *dataPtr;

		dataPtr = (ImportedCmdData *) link->objClientData;
		link = dataPtr->realCmdPtr;
		if (overwrite == link) {
		    Tcl_AppendResult(interp, "import pattern \"",
			    pattern,
			    "\" would create a loop containing ",
			    "command \"", Tcl_DStringValue(&ds),
			    "\"", (char *) NULL);
		    Tcl_DStringFree(&ds);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_CreateObjCommand(interp, 
		Tcl_DStringValue(&ds), InvokeImportedCmd,
		(ClientData) dataPtr, DeleteImportedCmd);
	dataPtr->realCmdPtr = cmdPtr;
	dataPtr->selfPtr = (Command *) importedCmd;
	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
	Tcl_DStringFree(&ds);

	/*
	 * Create an ImportRef structure describing this new import
	 * command and add it to the import ref list in the "real"
	 * command.
	 */

	refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
	refPtr->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Tcl_AppendResult(interp, "can't import command \"", cmdName,
		"\": already exists", (char *) NULL);
	return TCL_ERROR;


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