2010-04-29  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Another stab at getting the /lib,
	* library/platform/pkgIndex.tcl: /lib64 difference right for
	* unix/Makefile.in: linux. Package updated to version 1.0.7.
	* win/Makefile.in:

2010-04-29  Kevin B. Kenny  <kennykb@acm.org>
	
	* library/tzdata/Antarctica/Macquarie:
	* library/tzdata/Africa/Casablanca:
	* library/tzdata/Africa/Tunis:
	* library/tzdata/America/Santiago:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/Antarctica/Casey:
	* library/tzdata/Antarctica/Davis:
	* library/tzdata/Asia/Anadyr:
	* library/tzdata/Asia/Damascus:
	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Kamchatka:
	* library/tzdata/Asia/Karachi:
	* library/tzdata/Asia/Taipei:
	* library/tzdata/Europe/Samara:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Fiji:   Olson's tzdata2010i.
	
2010-04-29  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make
	* generic/tclStringObj.c (Tcl_AppendObjToObj): an append of a byte
	array to another into an efficent operation. The problem was the (lack
	of) a proper growth management strategy for the byte array.

2010-04-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/dirent2.h:	Include "tcl.h", not <tcl.h>, like everywhere
	* compat/dlfcn.h:	else, to ensure that the version in the Tcl
	* compat/stdlib.h:	distribution is used, not some version from
	* compat/string.h:	somewhere else.
	* compat/unistd.h:

2010-04-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:	Remove unused @MAN2TCLFLAGS@
	* win/tclWinPort.h:	Move <limits.h> include from tclInt.h to
	* generic/tclInt.h:	tclWinPort.h, and eliminate unneeded
	* generic/tclEnv.c:	<stdlib.h>, <stdio.h> and <string.h>, which
				are already in tclInt.h
	* generic/regcustom.h:	Move "tclInt.h" from regcustom.h up to
	* generic/regex.h:	regex.h.
	* generic/tclAlloc.c:	Unneeded <stdio.h> include.
	* generic/tclExecute.c:	Fix gcc warning: comparison between signed and
				unsigned.

2010-04-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclInt.h (TclIsVarDirectUnsettable): Corrected flags so that
	deletion of traces is not optimized out...

	* generic/tclExecute.c (ExecuteExtendedBinaryMathOp)
	(TclCompareTwoNumbers,ExecuteExtendedUnaryMathOp,TclExecuteByteCode):
	[Patch 2981677]: Move the less common arithmetic operations (i.e.,
	exponentiation and operations on non-longs) out of TEBC for a big drop
	in the overall size of the stack frame for most code. Net effect on
	speed is minimal (slightly faster overall in tclbench). Also extended
	the number of places where TRESULT handling is replaced with a jump to
	dedicated code.

2010-04-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Rearrange location of an
	assignment to shorten the object code.

2010-04-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIOUtil.c (Tcl_FSGetNativePath): [Bug 2992292]:
	tclIOUtil.c assignment type mismatch compiler warning
	* generic/regguts.h:     If tclInt.h or tclPort.h is already
	* generic/tclBasic.c:    included, don't include <limits.h>
	* generic/tclExecute.c:  again. Follow-up to [Bug 2991415]:
	* generic/tclIORChan.c:  tclport.h #included before limits.h
	* generic/tclIORTrans.c: See comments in [Bug 2991415]
	* generic/tclObj.c:
	* generic/tclOOInt.h:
	* generic/tclStrToD.c:
	* generic/tclTomMath.h:
	* generic/tclTomMathInterface.c:
	* generic/tclUtil.c:
	* compat/strtod.c:
	* compat/strtol.c:

2010-04-27  Kevin B. Kenny  <kennykb@acm.org>

	* unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Simplified the logic
	so that the casts added in Donal Fellows's change for the same bug are
	no longer necessary.

2010-04-26  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Added an explicit cast
	because auto-casting between function and non-function types is never
	naturally warning-free.

	* generic/tclStubInit.c:   Add a small amount of gcc-isms (with #ifdef
	* generic/tclOOStubInit.c: guards) to ensure that warnings are issued
	when these files are older than the various *.decls files.

2010-04-25  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:    Add unsupported [yieldm] command. Credit
	* generic/tclInt.h:      Lars Hellstrom for the basic idea.

2010-04-24  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:    Modify api of TclSpliceTailcall() to fix
	* generic/tclExecute.c:  [yieldTo], which had not survived the latest
	* generic/tclInt.h:      mods to tailcall. Thanks kbk for detecting
	the problem.

2010-04-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixPort.h: [Bug 2991415]: tclport.h #included before
	limits.h

2010-04-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPlatDecls.h:  Move TCHAR fallback typedef from tcl.h to
	* generic/tcl.h:           tclPlatDecls.h (as suggested by dgp)
	* generic/tclInt.h:        fix typo
	* generic/tclIOUtil.c:     Eliminate various unnecessary
	* unix/tclUnixFile.c:      type casts.
	* unix/tclUnixPipe.c:
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinLoad.c:
	* win/tclWinPipe.c:

2010-04-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c:  Use function prototypes from the FS API.
	* compat/zlib/*:      Upgrade to zlib 1.2.5

2010-04-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Improve commenting and
	reduce indentation for the Invocation Block.

2010-04-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIOUtil.c (Tcl_LoadFile): Corrections to previous commit
	* unix/tclLoadDyld.c (TclpDlopen):    to make it build on OSX.

2010-04-02  Kevin B. Kenny  <kennykb@acm.org>

	TIP #357 IMPLEMENTATION
	TIP #362 IMPLEMENTATION

	* generic/tclStrToD.c: [Bug 2952904]: Defer creation of the smallest
	floating point number until it is actually used. (This change avoids a
	bogus syslog message regarding a 'floating point software assist
	fault' on SGI systems.)

	* library/reg/pkgIndex.tcl:	[TIP #362]: Fixed first round of bugs
	* tests/registry.test:		resulting from the recent commits of

	* unix/tclLoadDyld.c:
	* unix/tclLoadNext.c:
	* unix/tclLoadOSF.c:
	* unix/tclLoadShl.c:
	* unix/tclUnixPipe.c:
	* win/Makefile.in:
	* win/tclWinLoad.c:

2010-03-31  Donal K. Fellows  <dkf@users.sf.net>

	* doc/registry.n: Added missing documentation of TIP#362 flags.

	* doc/package.n: [Bug 2980210]: Document the arguments taken by
	the [package present] command correctly.

	* generic/tclExecute.c: [Bug 2976508]: Tcl HEAD fails on HP-UX

2010-03-25  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixFCmd.c (TclUnixCopyFile): [Bug 2976504]: Corrected
	number of arguments to fstatfs() call.

	* macosx/tclMacOSXBundle.c, macosx/tclMacOSXFCmd.c:
	* macosx/tclMacOSXNotify.c: Reduce the level of ifdeffery in the
	functions of these files to improve readability. They need to be
	audited for whether complexity can be removed based on the minimum
	supported version of OSX, but that requires a real expert.

2010-03-24  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h: [Bug 2942081]: Reverted Tcl_ThreadDataKey type change
				Changed some Tcl_CallFrame fields from "char *"
				to "void *". This saves unnecessary space on
				Cray's (and it's simply more correct).

	* tools/genStubs.tcl:	No longer generate a space after "*" and
				immediately after a function name, so the
				format of function definitions in tcl*Decls.h
				match all other tcl*.h header files.
	* doc/ParseArgs.3:	Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc
	* generic/tcl.h:	and GetFrameInfoValueProc to be function
	* generic/tclInt.h:	definitions, not pointers, for consistency
	* generic/tclOOInt.h:	with all other Tcl function definitions.
	* generic/tclIndexObj.c:
	* generic/regguts.h:	CONST -> const

2010-01-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Improve error code
	generation from some of the tailcall-related bits of TEBC.

2010-01-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompile.h: NRE-enable direct eval on BC spoilage
	* generic/tclExecute.c: [Bug 2910748]
	* tests/nre.test:

2010-01-19  Donal K. Fellows  <dkf@users.sf.net>

	* doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict
	update] are doing with variables.

2010-01-03  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	[Bug 2724403]: Fix leak of coroutines on
	* generic/tclCompile.h: namespace deletion. Added a test for this
	* generic/tclNamesp.c:	leak, and also a test for leaks on namespace
	* tests/coroutine.test: deletion.
	* tests/namespace.test:

2009-12-30  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (AliasSource): [Bug 2923613]: Make the safer
	* tests/safe.test (safe-8.9):	  [source] handle a [return] at the
					  end of the file correctly.

2009-12-30  Miguel Sofer  <msofer@users.sf.net>

	* library/safe.tcl (AliasSource, AliasExeName): [Bug 2913625]: Stop
	information about paths from leaking through [info script] and [info
	nameofexecutable].

2009-12-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:		Install libtcl8.6.dll in bin directory
	* unix/Makefile.in:
	* unix/configure:	(regenerated)

2009-12-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): [Bug 2918962]: Stop crash when
	-index and -stride are used together.

/*
 * dirent.h --
 *
 *	Declarations of a library of directory-reading procedures
 *	in the POSIX style ("struct dirent").
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 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: dirent2.h,v 1.2.42.2 2010/04/29 23:32:23 dgp Exp $
 */

#ifndef _DIRENT
#define _DIRENT


#include "tcl.h"


/*
 * Dirent structure, which holds information about a single
 * directory entry.
 */

#define MAXNAMLEN 255

 *	Not derived from licensed software.
 *
 *	Permission is granted to freely use, copy, modify, and redistribute
 *	this software, provided that the author is not construed to be liable
 *	for any results of using the software, alterations are clearly marked
 *	as such, and this notice is not modified.
 *
 * RCS: @(#) $Id: dlfcn.h,v 1.2.42.3 2010/04/29 23:32:23 dgp Exp $
 */

/*
 * @(#)dlfcn.h	1.4 revision of 95/04/25  09:36:52
 * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
 * 30159 Hannover, Germany
 */

#ifndef __dlfcn_h__
#define __dlfcn_h__


#include "tcl.h"


#ifdef __cplusplus
extern "C" {
#endif

/*
 * Mode flags for the dlopen routine.

 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: stdlib.h,v 1.3.36.2 2010/04/29 23:32:23 dgp Exp $
 */

#ifndef _STDLIB
#define _STDLIB




extern void		abort(void);
extern double		atof(const char *string);
extern int		atoi(const char *string);
extern long		atol(const char *string);
extern char *		calloc(unsigned int numElements, unsigned int size);
extern void		exit(int status);
extern int		free(char *blockPtr);

/*
 * string.h --
 *
 *	Declarations of ANSI C library procedures for string handling.
 *
 * Copyright (c) 1991-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: string.h,v 1.4.20.4 2010/04/29 23:32:23 dgp Exp $
 */

#ifndef _STRING
#define _STRING

#include "tcl.h"

/*
 * The following #include is needed to define size_t. (This used to include
 * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g.
 * 4.0.2, so I'm trying sys/types.h now.... hopefully it exists everywhere)
 */

extern char *		strcpy(char *dst, const char *src);
extern size_t		strcspn(const char *string, const char *chars);
extern char *		strdup(const char *string);
extern char *		strerror(int error);
extern size_t		strlen(const char *string);
extern int		strncasecmp(const char *s1, const char *s2, size_t n);
extern char *		strncat(char *dst, const char *src, size_t numChars);
extern int		strncmp(const char *s1, const char *s2, size_t nChars);
extern char *		strncpy(char *dst, const char *src, size_t numChars);
extern char *		strpbrk(const char *string, const char *chars);
extern char *		strrchr(const char *string, int c);
extern size_t		strspn(const char *string, const char *chars);
extern char *		strstr(const char *string, const char *substring);
extern char *		strtok(char *s, const char *delim);

#endif /* _STRING */

/* 
 * strtod.c --
 *
 *	Source code for the "strtod" library procedure.
 *
 * Copyright (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1994 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: strtod.c,v 1.6.4.5 2010/04/29 23:32:23 dgp Exp $
 */

#include "tclInt.h"


#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#ifndef NULL
#define NULL 0

/* 
 * strtol.c --
 *
 *	Source code for the "strtol" library procedure.
 *
 * Copyright (c) 1988 The Regents of the University of California.
 * Copyright (c) 1994 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: strtol.c,v 1.4.4.4 2010/04/29 23:32:23 dgp Exp $
 */


#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * strtol --
 *

/*
 * unistd.h --
 *
 *      Macros, constants and prototypes for Posix conformance.
 *
 * Copyright 1989 Regents of the University of California Permission to use,
 * copy, modify, and distribute this software and its documentation for any
 * purpose and without fee is hereby granted, provided that the above
 * copyright notice appear in all copies. The University of California makes
 * no representations about the suitability of this software for any purpose.
 * It is provided "as is" without express or implied warranty.
 *
 * RCS: @(#) $Id: unistd.h,v 1.2.42.2 2010/04/29 23:32:23 dgp Exp $
 */

#ifndef _UNISTD
#define _UNISTD

#include "tcl.h"

#include <sys/types.h>


#ifndef NULL
#define NULL    0
#endif

/* 
 * Strict POSIX stuff goes here. Extensions go down below, in the ifndef

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * Headers if any.
 */

#include "regex.h"

/*
 * Overrides for regguts.h definitions, if any.
 */

#define	FUNCPTR(name, args)	(*name)args
#define	MALLOC(n)		VS(attemptckalloc(n))

#define AllocVars(vPtr) \
    register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars))
#define FreeVars(vPtr) \
    FREE(vPtr)
#endif

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

#ifndef _REGEX_H_
#define	_REGEX_H_	/* never again */

#include "tclInt.h"

/*
 * regular expressions
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics

 * more C++ voodoo
 */
#ifdef __cplusplus
}
#endif

#endif

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

 */
#include "regcustom.h"

/*
 * Things that regcustom.h might override.
 */










/* assertions */
#ifndef assert
#ifndef REG_DEBUG
#ifndef NDEBUG
#define	NDEBUG		/* no assertions */
#endif
#endif /* !REG_DEBUG */

#define	REALLOC(p, n)	realloc(VS(p), n)
#endif
#ifndef FREE
#define	FREE(p)		free(VS(p))
#endif

/* want size of a char in bits, and max value in bounded quantifiers */



#ifndef _POSIX2_RE_DUP_MAX
#define	_POSIX2_RE_DUP_MAX 255	/* normally from <limits.h> */
#endif

/*
 * misc
 */

 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclAlloc.c,v 1.16.4.13 2010/04/29 23:32:23 dgp Exp $
 */

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

/*
 * numMallocs[i] is the difference between the number of mallocs and frees for
 * a given block size.
 */

static	unsigned int numMallocs[NBUCKETS+1];

#endif

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

 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 Miguel Sofer <msofer@users.sourceforge.net>
 *
 * 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.169 2010/04/29 23:32:23 dgp Exp $
 */

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

#include <math.h>


#if NRE_ENABLE_ASSERTS
#include <assert.h>
#endif

#define INTERP_STACK_INITIAL_SIZE 2000
#define CORO_STACK_INITIAL_SIZE    200

/*
 * 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.34 2010/04/29 23:32:24 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"

#include <math.h>

    } else {
	for (i = 0; i < length; i++) {
	    dst += Tcl_UniCharToUtf(src[i], dst);
	}
	*dst = '\0';
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclAppendBytesToByteArray --
 *
 *	This function appends an array of bytes to a byte array object. Note
 *	that the object *must* be unshared, and the array of bytes *must not*
 *	refer to the object being appended to.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates enough memory for an array of bytes of the requested total
 *	size, or possibly larger. [Bug 2992970]
 *
 *----------------------------------------------------------------------
 */

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    unsigned len)
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    /*
     * If we need to, resize the allocated space in the byte array.
     */

    if (byteArrayPtr->used + (int)len > byteArrayPtr->allocated) {
	unsigned int attempt, used = byteArrayPtr->used;
	ByteArray *tmpByteArrayPtr;

	attempt = byteArrayPtr->allocated;
	do {
	    attempt *= 2;
	} while (attempt < used+len);

	tmpByteArrayPtr = (ByteArray *)
		attemptckrealloc((char *) byteArrayPtr,
			BYTEARRAY_SIZE(attempt));

	if (tmpByteArrayPtr == NULL) {
	    attempt = used + len;
	    tmpByteArrayPtr = (ByteArray *) ckrealloc((char *) byteArrayPtr,
		    BYTEARRAY_SIZE(attempt));
	}

	byteArrayPtr = tmpByteArrayPtr;
	byteArrayPtr->allocated = attempt;
	byteArrayPtr->used = used;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }

    /*
     * Do the append if there's any point.
     */

    if (len > 0) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
	byteArrayPtr->used += len;
	Tcl_InvalidateStringRep(objPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitBinaryCmd --
 *
 *	This function is called to create the "binary" Tcl command. See the

 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEnv.c,v 1.21.2.17 2010/04/29 23:32:24 dgp Exp $
 */

#include "tclInt.h"

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */

static struct {

	/*
	 * If this is Path, eliminate any PATH variable, to prevent any
	 * confusion.
	 */

	if (strcmp(name, "Path") == 0) {
#ifdef __WIN32__
	    SetEnvironmentVariableA("PATH", NULL);
#endif
	    unsetenv("PATH");
	}

#ifdef __WIN32__
	SetEnvironmentVariableA(name, value);
#endif
    } else {
	char *buf;

	/*
	 * Eliminate any Path variable, to prevent any confusion.
	 */

#ifdef __WIN32__
	SetEnvironmentVariableA("Path", NULL);
#endif
	unsetenv("Path");

	if (value == NULL) {
	    buf = NULL;
	} else {
	    int size;

	    size = cygwin_posix_to_win32_path_list_buf_size(value);
	    buf = alloca(size + 1);
	    cygwin_posix_to_win32_path_list(value, buf);
	}

#ifdef __WIN32__
	SetEnvironmentVariableA(name, buf);
#endif
    }
}
#endif /* __CYGWIN__ */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 * Copyright (c) 2005-2007 by Donal K. Fellows.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  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.142 2010/04/29 23:32:24 dgp Exp $
 */

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

#include <math.h>


#if NRE_ENABLE_ASSERTS
#include <assert.h>
#endif

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is

    do {							\
	objPtr->internalRep.twoPtrValue.ptr2 = auxObjList;	\
	auxObjList = objPtr;					\
    } while (0)

#define POP_TAUX_OBJ() \
    do {								\
	tmpPtr = auxObjList;						\
	auxObjList = (Tcl_Obj *) tmpPtr->internalRep.twoPtrValue.ptr2;	\
	Tcl_DecrRefCount(tmpPtr);					\
    } while (0)

/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

    (Tcl_WideInt)161051*161051*161051*11*11,
    (Tcl_WideInt)161051*161051*161051*11*11*11,
    (Tcl_WideInt)248832*248832*248832*12*12,
    (Tcl_WideInt)371293*371293*371293*13*13
};
static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */

/*
 * Markers for ExecuteExtendedBinaryMathOp.
 */

#define DIVIDED_BY_ZERO		((Tcl_Obj *) -1)
#define EXPONENT_OF_ZERO	((Tcl_Obj *) -2)
#define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3)

/*
 * Declarations for local procedures to this file:
 */

#ifdef TCL_COMPILE_STATS
static int		EvalStatsCmd(ClientData clientData,

			    const unsigned char *pc, int stackTop,
			    int stackLowerBound, int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		DeleteExecStack(ExecStack *esPtr);
static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
			    int opcode, Tcl_Obj **constants,
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, int *lengthPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);

	int instructionCount;	/* Counter that is used to work out when to
				 * call Tcl_AsyncReady() */
	int checkInterp;	/* Indicates when a check of interp readyness
				 * is necessary. Set by CACHE_STACK_INFO() */
	const char *curInstName;
	int result;		/* Return code returned after execution.
				 * Result variable - needed only when going to
				 * checkForCatch or other error handlers; also
				 * used as local in some opcodes. */
    } TAUX = {
	NULL,
	NULL,
	NULL,
	NULL,
	NULL,

    /*
     * Locals - variables that are used within opcodes or bounded sections of
     * the file (jumps between opcodes within a family).
     * NOTE: These are now mostly defined locally where needed.
     */

    Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
    Tcl_Obj **objv;
    int opnd, objc, length, pcAdjustment;
    Var *varPtr, *arrayPtr;
#ifdef TCL_COMPILE_DEBUG
    int traceInstructions = (tclTraceExec == 3);
    char cmdNameBuf[21];
#endif

    TAUX.constants = &iPtr->execEnvPtr->constants[0];

    /*
     * Check for asynchronous handlers [Bug 746722]; we do the check every
     * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
     */

    if ((TAUX.instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {

	DECACHE_STACK_INFO();
	if (TclAsyncReady(iPtr)) {

	    TRESULT = Tcl_AsyncInvoke(interp, TRESULT);
	    if (TRESULT == TCL_ERROR) {
		CACHE_STACK_INFO();


		goto gotError;
	    }
	}


	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    CACHE_STACK_INFO();
	    goto gotError;



	}

	if (TclLimitReady(iPtr->limit)) {

	    if (Tcl_LimitCheck(interp) == TCL_ERROR) {
		CACHE_STACK_INFO();


		goto gotError;
	    }
	}
	CACHE_STACK_INFO();
    }

    TCL_DTRACE_INST_NEXT();

    /*
     * These two instructions account for 26% of all instructions (according
     * to measurements on tclbench by Ben Vitale

	TRACE(("%u %u => ", code, level));
	TRESULT = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
	if (TRESULT == TCL_OK) {
	    TRACE_APPEND(("continuing to next instruction (TRESULT=\"%.30s\")",
		    O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 0);

	}
	Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
	if (*pc == INST_SYNTAX) {
	    iPtr->flags &= ~ERR_ALREADY_LOGGED;
	}
	cleanup = 2;
	goto processExceptionReturn;

    }

    case INST_RETURN_STK:
	TRACE(("=> "));
	objResultPtr = POP_OBJECT();
	TRESULT = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
	Tcl_DecrRefCount(OBJ_AT_TOS);
	OBJ_AT_TOS = objResultPtr;
	if (TRESULT == TCL_OK) {
	    TRACE_APPEND(("continuing to next instruction (TRESULT=\"%.30s\")",
		    O2S(objResultPtr)));
	    NEXT_INST_F(1, 0, 0);

	}
	Tcl_SetObjResult(interp, objResultPtr);
	cleanup = 1;
	goto processExceptionReturn;


    case INST_DONE:
	if (tosPtr > initTosPtr) {
	    /*
	     * Set the interpreter's object result to point to the topmost
	     * object from the stack, and check for a possible [catch]. The
	     * stackTop's level and refCount will be handled by "processCatch"
	     * or "abnormalReturn".
	     */

	    Tcl_SetObjResult(interp, OBJ_AT_TOS);
#ifdef TCL_COMPILE_DEBUG
	    TRACE_WITH_OBJ(("=> return code=%d, result=", TRESULT),
		    iPtr->objResultPtr);
	    if (traceInstructions) {
		fprintf(stdout, "\n");
	    }
#endif
	    goto checkForCatch;

	}
	(void) POP_OBJECT();
	goto abnormalReturn;


    case INST_PUSH1:
    instPush1Peephole:
	PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
	TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
	pc += 2;
#if !TCL_COMPILE_DEBUG

	 * compileEpoch is modified, so that the epoch check also verifies
	 * that the interp is not deleted. If no outside call has been made
	 * since the last check, it is safe to omit the check.
	 */

	iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
	if (!TAUX.checkInterp) {
	    goto instStartCmdOK;

	} else if (((codePtr->compileEpoch == iPtr->compileEpoch)
		&& (codePtr->nsEpoch == iPtr->varFramePtr->nsPtr->resolverEpoch))
		|| (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
	    TAUX.checkInterp = 0;
	instStartCmdOK:
	    NEXT_INST_F(9, 0, 0);
	} else {
	    const char *bytes;

	    length = 0;

	    /*
	     * We used to switch to direct eval; for NRE-awareness we now
	     * compile and eval the command so that this evaluation does not
	     * add a new TEBC instance. [Bug 2910748]
	     */

	    if (TclInterpReady(interp) == TCL_ERROR) {

		goto gotError;
	    }

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));

    case INST_REVERSE: {
	Tcl_Obj **a, **b;

	opnd = TclGetUInt4AtPtr(pc+1);
	a = tosPtr-(opnd-1);
	b = tosPtr;
	while (a<b) {
	    tmpPtr = *a;

	    *a = *b;
	    *b = tmpPtr;
	    a++; b--;
	}
	NEXT_INST_F(5, 0, 0);
    }

    case INST_CONCAT1: {
	int appendLen = 0;

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) CURR_DEPTH;
	PUSH_TAUX_OBJ(objPtr);
	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_STKTOP: {
	int i;

	ptrdiff_t moved;

	/*
	 * Make sure that the element at stackTop is a list; if not, just
	 * leave with an error. Note that the element from the expand list
	 * will be removed at checkForCatch.
	 */

	objPtr = OBJ_AT_TOS;
	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
		    Tcl_GetObjResult(interp));

	    goto gotError;
	}
	(void) POP_OBJECT();

	/*
	 * Make sure there is enough room in the stack to expand this list
	 * *and* process the rest of the command (at least up to the next
	 * argument expansion or command end). The operand is the current

	goto nonRecursiveCallStart;
    }

	/*
	 * INVOCATION BLOCK
	 */





    instEvalStk:
    case INST_EVAL_STK:
	/*
	 * Moved here to support transforming the eval of objects to a simple
	 * command invocation (for canonical lists) or a non-recursive TEBC
	 * call (compiled scripts).
	 */

	    if (objPtr->bytes == NULL || listRepPtr->canonicalFlag) {
		if (Tcl_IsShared(objPtr)) {
		    copyPtr = TclListObjCopy(interp, objPtr);
		    Tcl_IncrRefCount(copyPtr);
		    OBJ_AT_TOS = copyPtr;
		    listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;

		    /*
		     * Decrement the refcount on the *original* copy of the
		     * list directly; we know it was greater than 1 here so it
		     * can't be deallocated.
		     */

		    objPtr->refCount--;
		}
		objc = listRepPtr->elemCount;
		objv = &listRepPtr->elements;

		/*
		 * Fix for [Bug 2102930]
		 */

#endif /* TCL_COMPILE_DEBUG */
		iPtr->cmdFramePtr = bcFramePtr->nextPtr;
		TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);

		if (catchTop != initCatchTop) {
		    TclClearTailcall(interp, param);
		    iPtr->varFramePtr->tailcallPtr = NULL;

		    Tcl_SetResult(interp,
			    "tailcall called from within a catch environment",
			    TCL_STATIC);
		    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
			    NULL);
		    pc--;
		    goto gotError;
		}
		iPtr->varFramePtr->tailcallPtr = param;
		TclSpliceTailcall(interp, param, 1);
		goto abnormalReturn;
	    case TCL_NR_YIELD_TYPE: {		/* [yield] */
		CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

		if (!corPtr) {
		    Tcl_SetResult(interp,
			    "yield can only be called in a coroutine",
			    TCL_STATIC);
		    Tcl_SetErrorCode(interp, "TCL", "COROUTINE",
			    "ILLEGAL_YIELD", NULL);

		    pc--;
		    goto gotError;
		}

		NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
		NRE_ASSERT(corPtr->stackLevel != NULL);
		NRE_ASSERT(BP == corPtr->eePtr->bottomPtr);
		if (corPtr->stackLevel != &TAUX) {
		    Tcl_SetResult(interp, "cannot yield: C stack busy",
			    TCL_STATIC);
		    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
			    NULL);

		    pc--;
		    goto gotError;
		}

		/*
		 * Mark suspended, save our state and return
		 */

		corPtr->stackLevel = NULL;

	if (iPtr->varFramePtr->tailcallPtr) {
	    if (catchTop == initCatchTop) {
		goto abnormalReturn;
	    }

	    TclClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
	    iPtr->varFramePtr->tailcallPtr = NULL;

	    Tcl_SetResult(interp,
		    "tailcall called from within a catch environment",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
	    pc--;
	    goto gotError;
	}

	if (iPtr->execEnvPtr->rewind) {
	    TRESULT = TCL_ERROR;
	    goto abnormalReturn;
	}

	TclNewObj(objPtr);
	Tcl_IncrRefCount(objPtr);
	iPtr->objResultPtr = objPtr;
	NEXT_INST_V(0, cleanup, -1);

#if TCL_SUPPORT_84_BYTECODE
    case INST_CALL_BUILTIN_FUNC1:
	/*
	 * Call one of the built-in pre-8.5 Tcl math functions. This
	 * translates to INST_INVOKE_STK1 with the first argument of
	 * ::tcl::mathfunc::$objv[0]. We need to insert the named math
	 * function into the stack.
	 */




	opnd = TclGetUInt1AtPtr(pc+1);
	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
	    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
	    Tcl_Panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
	}

	TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
	Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);

	/*
	 * Only 0, 1 or 2 args.
	 */

	{
	    int numArgs = tclBuiltinFuncTable[opnd].numArgs;
	    Tcl_Obj *tmpPtr1, *tmpPtr2;

	    if (numArgs == 0) {
		PUSH_OBJECT(objPtr);
	    } else if (numArgs == 1) {
		tmpPtr1 = POP_OBJECT();
		PUSH_OBJECT(objPtr);
		PUSH_OBJECT(tmpPtr1);
		Tcl_DecrRefCount(tmpPtr1);
	    } else {
		tmpPtr2 = POP_OBJECT();
		tmpPtr1 = POP_OBJECT();
		PUSH_OBJECT(objPtr);
		PUSH_OBJECT(tmpPtr1);
		PUSH_OBJECT(tmpPtr2);
		Tcl_DecrRefCount(tmpPtr1);
		Tcl_DecrRefCount(tmpPtr2);
	    }

	    objc = numArgs + 1;
	}
	pcAdjustment = 2;
	goto doInvocation;


    case INST_CALL_FUNC1:
	/*
	 * Call a non-builtin Tcl math function previously registered by a
	 * call to Tcl_CreateMathFunc pre-8.5. This is essentially
	 * INST_INVOKE_STK1 converting the first arg to
	 * ::tcl::mathfunc::$objv[0].
	 */







	objc = TclGetUInt1AtPtr(pc+1);	/* Number of arguments. The function
					 * name is the 0-th argument. */

	objPtr = OBJ_AT_DEPTH(objc-1);
	TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
	Tcl_AppendObjToObj(tmpPtr, objPtr);
	Tcl_DecrRefCount(objPtr);

	/*
	 * Variation of PUSH_OBJECT.
	 */

	OBJ_AT_DEPTH(objc-1) = tmpPtr;
	Tcl_IncrRefCount(tmpPtr);

	pcAdjustment = 2;
	goto doInvocation;

#else
    /*
     * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
     * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
     * remains for existing bytecode precompiled files.
     */

    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");
#endif


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



    case INST_LOAD_SCALAR1:
    instLoadScalar1:
	opnd = TclGetUInt1AtPtr(pc+1);
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;

		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
		NEXT_INST_F(pcAdjustment, 1, 1);
	    }
	}
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));


	    goto gotError;
	}
	cleanup = 1;
	goto doCallPtrGetVar;

    case INST_LOAD_ARRAY_STK:
	cleanup = 2;
	part2Ptr = OBJ_AT_TOS;		/* element name */

	TRACE(("\"%.30s\" => ", O2S(objPtr)));

    doLoadStk:
	part1Ptr = objPtr;
	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
		&arrayPtr);
	if (!varPtr) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}

	if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
	    /*
	     * No errors, no traces: just get the value.
	     */

	    objResultPtr = varPtr->value.objPtr;
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_V(1, cleanup, 1);
	}
	pcAdjustment = 1;
	opnd = -1;







    doCallPtrGetVar:
	/*
	 * There are either errors or the variable is traced: call
	 * TclPtrGetVar to process fully.
	 */

	DECACHE_STACK_INFO();
	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
	CACHE_STACK_INFO();
	if (!objResultPtr) {



	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));

	    goto gotError;
	}

	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);

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

    {
	int storeFlags;

    case INST_STORE_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	goto doStoreArrayDirect;

    case INST_STORE_ARRAY1:

    doStoreScalarDirect:
	valuePtr = OBJ_AT_TOS;
	varPtr = LOCAL(opnd);
	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (!TclIsVarDirectWritable(varPtr)) {
	    storeFlags = TCL_LEAVE_ERR_MSG;
	    part1Ptr = NULL;
	    goto doStoreScalar;
	}

	/*
	 * No traces, no errors, plain 'set': we can safely inline. The value
	 * *will* be set to what's requested, so that the stack top remains
	 * pointing to the same Tcl_Obj.
	 */

    doStoreVarDirect:
	valuePtr = varPtr->value.objPtr;
	if (valuePtr != NULL) {
	    TclDecrRefCount(valuePtr);
	}
	objResultPtr = OBJ_AT_TOS;
	varPtr->value.objPtr = objResultPtr;
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+pcAdjustment) == INST_POP) {
	    tosPtr--;
	    NEXT_INST_F((pcAdjustment+1), 0, 0);
	}
#else
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
#endif
	Tcl_IncrRefCount(objResultPtr);
	NEXT_INST_F(pcAdjustment, 0, 0);





    case INST_LAPPEND_STK:
	valuePtr = OBJ_AT_TOS; /* value to append */
	part2Ptr = NULL;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
		| TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreStk;

	} else {
	    TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
		    O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
	}
#endif
	varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (!varPtr) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	cleanup = ((part2Ptr == NULL)? 2 : 3);
	pcAdjustment = 1;
	opnd = -1;
	goto doCallPtrSetVar;






    case INST_LAPPEND_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
		| TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreArray;

	}
	cleanup = 2;
	part1Ptr = NULL;

    doStoreArrayDirectFailed:
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
	if (!varPtr) {


	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));

	    goto gotError;
	}
	goto doCallPtrSetVar;

    case INST_LAPPEND_SCALAR4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
		| TCL_LIST_ELEMENT | TCL_TRACE_READS);
	goto doStoreScalar;

	part1Ptr = part2Ptr = NULL;

    doCallPtrSetVar:
	DECACHE_STACK_INFO();
	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
	CACHE_STACK_INFO();
	if (!objResultPtr) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+pcAdjustment) == INST_POP) {
	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
	}
#endif
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);





    }

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

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

    {
	Tcl_Obj *incrPtr;

#ifndef NO_WIDE_TYPE
	Tcl_WideInt w;
#endif
	long increment;

    case INST_INCR_SCALAR1:
    case INST_INCR_ARRAY1:
    case INST_INCR_ARRAY_STK:
    case INST_INCR_SCALAR_STK:
    case INST_INCR_STK:
	opnd = TclGetUInt1AtPtr(pc+1);

	    pcAdjustment = 1;
	    goto doIncrStk;
	}

    case INST_INCR_ARRAY_STK_IMM:
    case INST_INCR_SCALAR_STK_IMM:
    case INST_INCR_STK_IMM:
	increment = TclGetInt1AtPtr(pc+1);
	incrPtr = Tcl_NewIntObj(increment);
	Tcl_IncrRefCount(incrPtr);
	pcAdjustment = 2;

    doIncrStk:
	if ((*pc == INST_INCR_ARRAY_STK_IMM)
		|| (*pc == INST_INCR_ARRAY_STK)) {
	    part2Ptr = OBJ_AT_TOS;
	    objPtr = OBJ_UNDER_TOS;
	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
		    O2S(objPtr), O2S(part2Ptr), increment));
	} else {
	    part2Ptr = NULL;
	    objPtr = OBJ_AT_TOS;
	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
	}
	part1Ptr = objPtr;
	opnd = -1;
	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
	if (!varPtr) {



	    Tcl_AddObjErrorInfo(interp,
		    "\n    (reading value of variable to increment)", -1);
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));

	    Tcl_DecrRefCount(incrPtr);
	    goto gotError;
	}
	cleanup = ((part2Ptr == NULL)? 1 : 2);
	goto doIncrVar;

    case INST_INCR_ARRAY1_IMM:
	opnd = TclGetUInt1AtPtr(pc+1);
	increment = TclGetInt1AtPtr(pc+2);
	incrPtr = Tcl_NewIntObj(increment);
	Tcl_IncrRefCount(incrPtr);
	pcAdjustment = 3;

    doIncrArray:
	part1Ptr = NULL;
	part2Ptr = OBJ_AT_TOS;
	arrayPtr = LOCAL(opnd);
	cleanup = 1;
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment));
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
	if (!varPtr) {


	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));

	    Tcl_DecrRefCount(incrPtr);
	    goto gotError;
	}
	goto doIncrVar;

    case INST_INCR_SCALAR1_IMM:
	opnd = TclGetUInt1AtPtr(pc+1);
	increment = TclGetInt1AtPtr(pc+2);
	pcAdjustment = 3;
	cleanup = 0;
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}

	if (TclIsVarDirectModifyable(varPtr)) {
	    ClientData ptr;
	    int type;

	    objPtr = varPtr->value.objPtr;
	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
		if (type == TCL_NUMBER_LONG) {
		    long augend = *((const long *)ptr);
		    long sum = augend + increment;

		    /*
		     * Overflow when (augend and sum have different sign) and
		     * (augend and increment have the same sign). This is
		     * encapsulated in the Overflowing macro.
		     */

		    if (!Overflowing(augend, increment, sum)) {
			TRACE(("%u %ld => ", opnd, increment));
			if (Tcl_IsShared(objPtr)) {
			    objPtr->refCount--;	/* We know it's shared. */
			    TclNewLongObj(objResultPtr, sum);
			    Tcl_IncrRefCount(objResultPtr);
			    varPtr->value.objPtr = objResultPtr;
			} else {
			    objResultPtr = objPtr;
			    TclSetLongObj(objPtr, sum);
			}
			goto doneIncr;
		    }
#ifndef NO_WIDE_TYPE
		    w = (Tcl_WideInt)augend;

		    TRACE(("%u %ld => ", opnd, increment));
		    if (Tcl_IsShared(objPtr)) {
			objPtr->refCount--;	/* We know it's shared. */
			objResultPtr = Tcl_NewWideIntObj(w+increment);
			Tcl_IncrRefCount(objResultPtr);
			varPtr->value.objPtr = objResultPtr;
		    } else {
			objResultPtr = objPtr;

			/*
			 * We know the sum value is outside the long range;
			 * use macro form that doesn't range test again.
			 */

			TclSetWideIntObj(objPtr, w+increment);
		    }
		    goto doneIncr;
#endif
		}	/* end if (type == TCL_NUMBER_LONG) */
#ifndef NO_WIDE_TYPE
		if (type == TCL_NUMBER_WIDE) {
		    Tcl_WideInt sum;

		    w = *((const Tcl_WideInt *) ptr);
		    sum = w + increment;

		    /*
		     * Check for overflow.
		     */

		    if (!Overflowing(w, increment, sum)) {
			TRACE(("%u %ld => ", opnd, increment));
			if (Tcl_IsShared(objPtr)) {
			    objPtr->refCount--;	/* We know it's shared. */
			    objResultPtr = Tcl_NewWideIntObj(sum);
			    Tcl_IncrRefCount(objResultPtr);
			    varPtr->value.objPtr = objResultPtr;
			} else {
			    objResultPtr = objPtr;

		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);
		Tcl_IncrRefCount(objResultPtr);
		varPtr->value.objPtr = objResultPtr;
	    } else {
		objResultPtr = objPtr;
	    }
	    TclNewLongObj(incrPtr, increment);
	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
		Tcl_DecrRefCount(incrPtr);



		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    Tcl_DecrRefCount(incrPtr);
	    goto doneIncr;
	}

	/*
	 * All other cases, flow through to generic handling.
	 */

	TclNewLongObj(incrPtr, increment);
	Tcl_IncrRefCount(incrPtr);

    doIncrScalar:
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	arrayPtr = NULL;
	part1Ptr = part2Ptr = NULL;
	cleanup = 0;
	TRACE(("%u %ld => ", opnd, increment));

    doIncrVar:
	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
	    objPtr = varPtr->value.objPtr;
	    if (Tcl_IsShared(objPtr)) {
		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);
		Tcl_IncrRefCount(objResultPtr);
		varPtr->value.objPtr = objResultPtr;
	    } else {
		objResultPtr = objPtr;
	    }
	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
		Tcl_DecrRefCount(incrPtr);



		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    Tcl_DecrRefCount(incrPtr);
	} else {
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();
	    Tcl_DecrRefCount(incrPtr);
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));

		goto gotError;
	    }
	}
    doneIncr:
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+pcAdjustment) == INST_POP) {
	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);

    /*
     *	   End of INST_EXIST instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_UNSET instructions.
     */

    {
	int flags;

    case INST_UNSET_SCALAR:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	opnd = TclGetUInt4AtPtr(pc+2);
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd));
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    /*
	     * No errors, no traces, no searches: just make the variable cease
	     * to exist.
	     */

	    if (!TclIsVarUndefined(varPtr)) {
		TclDecrRefCount(varPtr->value.objPtr);
	    } else if (flags & TCL_LEAVE_ERR_MSG) {
		goto slowUnsetScalar;
	    }
	    varPtr->value.objPtr = NULL;
	    NEXT_INST_F(6, 0, 0);
	}

    slowUnsetScalar:
	DECACHE_STACK_INFO();
	if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,


		opnd) != TCL_OK && flags) {
	    goto errorInUnset;
	}
	CACHE_STACK_INFO();
	NEXT_INST_F(6, 0, 0);

    case INST_UNSET_ARRAY:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	opnd = TclGetUInt4AtPtr(pc+2);
	part2Ptr = OBJ_AT_TOS;
	arrayPtr = LOCAL(opnd);
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%s %u \"%.30s\"\n",
		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
		/*
		 * No nasty traces and element exists, so we can proceed to
		 * unset it. Might still not exist though...
		 */

		if (!TclIsVarUndefined(varPtr)) {
		    TclDecrRefCount(varPtr->value.objPtr);
		} else if (flags & TCL_LEAVE_ERR_MSG) {
		    goto slowUnsetArray;
		}
		varPtr->value.objPtr = NULL;
		NEXT_INST_F(6, 1, 0);
	    } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
		/*
		 * Don't need to do anything here.
		 */

		NEXT_INST_F(6, 1, 0);
	    }
	}
    slowUnsetArray:
	DECACHE_STACK_INFO();
	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
		0, 0, arrayPtr, opnd);
	if (!varPtr) {
	    if (flags & TCL_LEAVE_ERR_MSG) {

		goto errorInUnset;
	    }

	} else if (TclPtrUnsetVar(interp, varPtr, arrayPtr, NULL, part2Ptr,





		flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}
	CACHE_STACK_INFO();
	NEXT_INST_F(6, 1, 0);

    case INST_UNSET_ARRAY_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 2;
	part2Ptr = OBJ_AT_TOS;		/* element name */
	part1Ptr = OBJ_UNDER_TOS;	/* array name */
	TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
		O2S(part1Ptr), O2S(part2Ptr)));
	goto doUnsetStk;

    case INST_UNSET_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 1;
	part2Ptr = NULL;
	part1Ptr = OBJ_AT_TOS;		/* variable name */
	TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));

    doUnsetStk:
	DECACHE_STACK_INFO();
	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK

		&& (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}
	CACHE_STACK_INFO();
	NEXT_INST_V(2, cleanup, 0);

    errorInUnset:
	CACHE_STACK_INFO();
	TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	goto gotError;
    }

    /*
     *	   End of INST_UNSET instructions.
     * -----------------------------------------------------------------
     *	   Start of variable linking instructions.
     */

    {
	Var *otherPtr;


	CallFrame *framePtr, *savedFramePtr;
	Tcl_Namespace *nsPtr;
	Namespace *savedNsPtr;

    case INST_UPVAR:
	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);

	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {


	    goto gotError;
	}

	/*
	 * Locate the other variable.
	 */

	savedFramePtr = iPtr->varFramePtr;
	iPtr->varFramePtr = framePtr;
	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
		TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
		/*createPart2*/ 1, &varPtr);
	iPtr->varFramePtr = savedFramePtr;
	if (!otherPtr) {
	    goto gotError;
	}

	goto doLinkVars;


    case INST_NSUPVAR:



	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
	if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {

	    goto gotError;
	}

	/*
	 * Locate the other variable.
	 */

	savedNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
	iPtr->varFramePtr->nsPtr = savedNsPtr;
	if (!otherPtr) {
	    goto gotError;
	}
	goto doLinkVars;




    case INST_VARIABLE:
	TRACE(("variable "));
	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
	if (!otherPtr) {

	    goto gotError;
	}

	/*
	 * Do the [variable] magic.
	 */

	TclSetVarNamespaceVar(otherPtr);

    doLinkVars:

	/*
	 * If we are here, the local variable has already been created: do the
	 * little work of TclPtrMakeUpvar that remains to be done right here
	 * if there are no errors; otherwise, let it handle the case.
	 */

	opnd = TclGetInt4AtPtr(pc+1);;
	varPtr = LOCAL(opnd);
	if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {

	    if (!TclIsVarUndefined(varPtr)) {
		/*
		 * Then it is a defined link.
		 */

		Var *linkPtr = varPtr->value.linkPtr;

		}
	    }
	    TclSetVarLink(varPtr);
	    varPtr->value.linkPtr = otherPtr;
	    if (TclIsVarInHash(otherPtr)) {
		VarHashRefCount(otherPtr)++;
	    }

	} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
		opnd) != TCL_OK) {
	    goto gotError;

	}

	/*
	 * Do not pop the namespace or frame index, it may be needed for other
	 * variables - and [variable] did not push it at all.
	 */

	jmpOffset[1] = TclGetInt1AtPtr(pc+1);

    doCondJump:
	valuePtr = OBJ_AT_TOS;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for constants */
	if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {

	    TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
		    ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
		    ? 0 : 1]), Tcl_GetObjResult(interp));
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	if (b) {
	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
		TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1],
			O2S(valuePtr),

	 * performed.
	 */

	int i1, i2, iResult;

	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {

	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto gotError;
	}

	if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {

	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto gotError;
	}

	if (*pc == INST_LOR) {
	    iResult = (i1 || i2);
	} else {
	    iResult = (i1 && i2);
	}
	objResultPtr = TCONST(iResult);
	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
	NEXT_INST_F(1, 2, 1);
    }

    /*
     * -----------------------------------------------------------------
     *	   Start of INST_LIST and related instructions.
     */

    {
	int index, numIndices, fromIdx, toIdx;
	int nocase, match, length2, cflags, s1len, s2len;
	const char *s1, *s2;

    case INST_LIST:
	/*
	 * Pop the opnd (objc) top stack elements into a new list obj and then
	 * decrement their ref counts.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(5, opnd, 1);

    case INST_LIST_LENGTH:
	valuePtr = OBJ_AT_TOS;

	if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {

	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
		    Tcl_GetObjResult(interp));
	    goto gotError;
	}
	TclNewIntObj(objResultPtr, length);
	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */











	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (value2Ptr->typePtr != &tclListType)
		&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
			&index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}

	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
	if (!objResultPtr) {
	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
	    goto gotError;
	}

	/*
	 * Stash the list element on the stack.
	 */

	TRACE(("%.20s %.20s => %s\n",
		O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, -1);	/* Already has the correct refCount */







    case INST_LIST_INDEX_IMM:	/* lindex with objc==3 and index in bytecode

				 * stream */


	/*
	 * Pop the list and get the index.
	 */

	valuePtr = OBJ_AT_TOS;
	opnd = TclGetInt4AtPtr(pc+1);

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {


	    TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
		    Tcl_GetObjResult(interp));
	    goto gotError;
	}

	/*
	 * Select the list item based on the index. Negative operand means
	 * end-based indexing.
	 */

	if (opnd < -1) {
	    index = opnd+1 + objc;
	} else {
	    index = opnd;
	}
	pcAdjustment = 5;

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
		objResultPtr);
	NEXT_INST_F(pcAdjustment, 1, 1);





    case INST_LIST_INDEX_MULTI:	/* 'lindex' with multiple index args */
	/*


	 * Determine the count of index args.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	numIndices = opnd-1;

	/*
	 * Do the 'lindex' operation.
	 */

	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
		numIndices, &OBJ_AT_DEPTH(numIndices - 1));
	if (!objResultPtr) {
	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
	    goto gotError;
	}





	/*
	 * Set result.
	 */

	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
	NEXT_INST_V(5, opnd, -1);






    case INST_LSET_FLAT:
	/*
	 * Lset with 3, 5, or more args. Get the number of index args.
	 */

	opnd = TclGetUInt4AtPtr(pc + 1);
	numIndices = opnd - 2;

	/*
	 * Get the old value of variable, and remove the stack ref. This is
	 * safe because the variable still references the object; the ref
	 * count will never go zero here - we can use the smaller macro
	 * Tcl_DecrRefCount.
	 */

	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr); /* This one should be done here */







	/*
	 * Compute the new variable value.
	 */

	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	if (!objResultPtr) {
	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
	    goto gotError;
	}





	/*
	 * Set result.
	 */

	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
	NEXT_INST_V(5, numIndices+1, -1);







    case INST_LSET_LIST:	/* 'lset' with 4 args */
	/*


	 * Get the old value of variable, and remove the stack ref. This is
	 * safe because the variable still references the object; the ref
	 * count will never go zero here - we can use the smaller macro
	 * Tcl_DecrRefCount.
	 */

	objPtr = POP_OBJECT();

	value2Ptr = OBJ_UNDER_TOS;

	/*
	 * Compute the new variable value.
	 */

	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);





	if (!objResultPtr) {
	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
		    Tcl_GetObjResult(interp));

	    goto gotError;
	}

	/*
	 * Set result.
	 */

	TRACE(("=> %s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, -1);

    case INST_LIST_RANGE_IMM:	/* lrange with objc==4 and both indices in
				 * bytecode stream */




	/*
	 * Pop the list and get the indices.
	 */

	valuePtr = OBJ_AT_TOS;
	fromIdx = TclGetInt4AtPtr(pc+1);
	toIdx = TclGetInt4AtPtr(pc+5);

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
		    fromIdx, toIdx), Tcl_GetObjResult(interp));
	    goto gotError;
	}

	/*
	 * Skip a lot of work if we're about to throw the result away (common
	 * with uses of [lassign]).
	 */


#ifndef TCL_COMPILE_DEBUG
	if (*(pc+9) == INST_POP) {
	    NEXT_INST_F(10, 1, 0);
	}
#endif






	/*
	 * Adjust the indices for end-based handling.
	 */

	if (fromIdx < -1) {
	    fromIdx += 1+objc;
	    if (fromIdx < -1) {
		fromIdx = -1;
	    }
	} else if (fromIdx > objc) {
	    fromIdx = objc;
	}
	if (toIdx < -1) {
	    toIdx += 1 + objc;
	    if (toIdx < -1) {
		toIdx = -1;
	    }
	} else if (toIdx > objc) {
	    toIdx = objc;
	}

	/*
	 * Check if we are referring to a valid, non-empty list range, and if
	 * so, build the list of elements in that range.
	 */

	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
	    if (fromIdx<0) {
		fromIdx = 0;
	    }
	    if (toIdx >= objc) {
		toIdx = objc-1;
	    }
	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
		TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr);
	NEXT_INST_F(9, 1, 1);


    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */







	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	/* TODO: Consider more efficient tests than strcmp() */
	s1 = TclGetStringFromObj(valuePtr, &s1len);
	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {

	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    int i = 0;
	    Tcl_Obj *o;

	    /*
	     * An empty list doesn't match anything.
	     */


	    do {


		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		if (o != NULL) {
		    s2 = TclGetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (strcmp(s1, s2) == 0);
		}
		i++;
	    } while (i < length && match == 0);
	}

	if (*pc == INST_LIST_NOT_IN) {
	    match = !match;
	}

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 * We're saving the effort of pushing a boolean value only to pop it
	 * for branching.
	 */

	pc++;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);


    /*
     *	   End of INST_LIST and related instructions.
     * -----------------------------------------------------------------
     *	   Start of string-related instructions.
     */

    case INST_STR_EQ:
    case INST_STR_NEQ:		/* String (in)equality check */
	/*

	 * TODO: Consider merging into INST_STR_CMP
	 */



	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	if (valuePtr == value2Ptr) {
	    /*
	     * On the off-chance that the objects are the same, we don't
	     * really have to think hard about equality.
	     */

	    match = (*pc == INST_STR_EQ);
	} else {



	    s1 = TclGetStringFromObj(valuePtr, &s1len);
	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
	    if (s1len == s2len) {
		/*
		 * We only need to check (in)equality when we have equal
		 * length strings.
		 */

		if (*pc == INST_STR_NEQ) {
		    match = (strcmp(s1, s2) != 0);
		} else {
		    /* INST_STR_EQ */
		    match = (strcmp(s1, s2) == 0);
		}
	    } else {
		match = (*pc == INST_STR_NEQ);
	    }
	}

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	pc++;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);

    stringCompare:
    case INST_STR_CMP:		/* String compare. */








	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	/*
	 * The comparison function should compare up to the minimum byte
	 * length only.
	 */

	if (valuePtr == value2Ptr) {
	    /*
	     * In the pure equality case, set lengths too for the checks below
	     * (or we could goto beyond it).
	     */

	    match = s1len = s2len = 0;
	} else if (TclIsPureByteArray(valuePtr)
		&& TclIsPureByteArray(value2Ptr)) {
	    s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	    match = memcmp(s1, s2,
		    (size_t) ((s1len < s2len) ? s1len : s2len));
	} else if (((valuePtr->typePtr == &tclStringType)
		&& (value2Ptr->typePtr == &tclStringType))) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    s1len = Tcl_GetCharLength(valuePtr);
	    s2len = Tcl_GetCharLength(value2Ptr);
	    if ((s1len == valuePtr->length) && (s2len == value2Ptr->length)) {
		match = memcmp(valuePtr->bytes, value2Ptr->bytes,
			(unsigned) ((s1len < s2len) ? s1len : s2len));
	    } else {
		match = TclUniCharNcmp(Tcl_GetUnicode(valuePtr),
			Tcl_GetUnicode(value2Ptr),
			(unsigned) ((s1len < s2len) ? s1len : s2len));
	    }
	} else {
	    /*
	     * We can't do a simple memcmp in order to handle the special Tcl
	     * \xC0\x80 null encoding for utf-8.
	     */

	    s1 = TclGetStringFromObj(valuePtr, &s1len);
	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
	    match = TclpUtfNcmp2(s1, s2,
		    (size_t) ((s1len < s2len) ? s1len : s2len));
	}

	/*
	 * Make sure only -1,0,1 is returned
	 * TODO: consider peephole opt.
	 */

	if (match == 0) {
	    match = s1len - s2len;
	}

	if (*pc != INST_STR_CMP) {
	    /*
	     * Take care of the opcodes that goto'ed into here.
	     */

	    switch (*pc) {
	    case INST_EQ:
		match = (match == 0);
		break;
	    case INST_NEQ:
		match = (match != 0);
		break;
	    case INST_LT:
		match = (match < 0);
		break;
	    case INST_GT:
		match = (match > 0);
		break;
	    case INST_LE:
		match = (match <= 0);
		break;
	    case INST_GE:
		match = (match >= 0);
		break;
	    }
	}
	if (match < 0) {
	    TclNewIntObj(objResultPtr, -1);

	} else {
	    objResultPtr = TCONST(match > 0);


	}
	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
		O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);


    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;

	length = Tcl_GetCharLength(valuePtr);
	TclNewIntObj(objResultPtr, length);
	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_INDEX:






	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

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

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

	    goto gotError;
	}

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[TCL_UTF_MAX];


	    Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */

	    length = Tcl_UniCharToUtf(ch, buf);
	    objResultPtr = Tcl_NewStringObj(buf, length);



	}

	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
		O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);


    case INST_STR_MATCH:


	nocase = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;		/* String */
	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */

	/*
	 * Check that at least one of the objects is Unicode before promoting
	 * both.
	 */

	if ((valuePtr->typePtr == &tclStringType)
		|| (value2Ptr->typePtr == &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;

	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
	    match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

	/*
	 * Reuse value2Ptr object already on stack if possible. Adjustment is

	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);


    case INST_REGEXP:



	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
	valuePtr = OBJ_AT_TOS;		/* String */
	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */

	/*
	 * Compile and match the regular expression.
	 */

	{
	    Tcl_RegExp regExpr =
		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);

	    if (regExpr == NULL) {


		goto regexpFailure;
	    }




	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);

	    if (match < 0) {
	    regexpFailure:
#ifdef TCL_COMPILE_DEBUG
		objResultPtr = Tcl_GetObjResult(interp);
		TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
			O2S(valuePtr), O2S(value2Ptr)), objResultPtr);

#endif
		goto gotError;
	    }
	}

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 * Adjustment is 2 due to the nocase byte.
	 */

	pc += 2;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);

     * -----------------------------------------------------------------
     *	   Start of numeric operator instructions.
     */

    {
	ClientData ptr1, ptr2;
	int type1, type2;

	long l1, l2, lResult;



    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE: {
	int iResult = 0, compare = 0;


	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
	    /*
	     * At least one non-numeric argument - compare as strings.

	    /*
	     * NaN 2nd arg: NaN != to everything, other compares are false.
	     */

	    iResult = (*pc == INST_NEQ);
	    goto foundResult;
	}

	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    l1 = *((const long *)ptr1);


	    l2 = *((const long *)ptr2);

	    compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);

















































	} else {
	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);





























































































































































	}

	/*
	 * Turn comparison outcome into appropriate result for opcode.
	 */

    convertComparison:

#endif
	objResultPtr = TCONST(iResult);
	NEXT_INST_F(0, 2, 1);
    }

    case INST_MOD:
    case INST_LSHIFT:
    case INST_RSHIFT:
    case INST_BITOR:
    case INST_BITXOR:
    case INST_BITAND:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)

		|| (type1==TCL_NUMBER_DOUBLE) || (type1==TCL_NUMBER_NAN)) {

	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (valuePtr->typePtr?
		    valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto gotError;
	}

	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)

		|| (type2==TCL_NUMBER_DOUBLE) || (type2==TCL_NUMBER_NAN)) {

	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (value2Ptr->typePtr?
		    value2Ptr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto gotError;
	}


	/*
	 * Check for common, simple case.
	 */


	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    l1 = *((const long *)ptr1);
	    l2 = *((const long *)ptr2);

	    switch (*pc) {
	    case INST_MOD:
		if (l2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    goto divideByZero;

		} else if ((l2 == 1) || (l2 == -1)) {
		    /*
		     * Div. by |1| always yields remainder of 0.
		     */

		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);




		} else if (l1 == 0) {
		    /*
		     * 0 % (non-zero) always yields remainder of 0.
		     */

		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);





		} else {
		    lResult = l1 / l2;

		    /*
		     * Force Tcl's integer division rules.
		     * TODO: examine for logic simplification
		     */

		    if ((lResult < 0 || (lResult == 0 &&
			    ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
			    (lResult * l2 != l1)) {
			lResult -= 1;
		    }
		    lResult = l1 - l2*lResult;




		    goto longResultOfArithmetic;





		}























































































































	    case INST_RSHIFT:





		if (l2 < 0) {

		    Tcl_SetResult(interp, "negative shift argument",

			    TCL_STATIC);




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


#endif














		    goto gotError;



		} else if (l1 == 0) {

		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);


























































		} else {
		    /*
		     * Quickly force large right shifts to 0 or -1.
		     */


		    if (l2 >= (long)(CHAR_BIT*sizeof(long))) {

			/*

			 * We assume that INT_MAX is much larger than the


			 * number of bits in a long. This is a pretty safe
			 * assumption, given that the former is usually around
			 * 4e9 and the latter 32 or 64...
			 */


			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));


















			if (l1 > 0L) {
			    objResultPtr = TCONST(0);
			} else {
			    TclNewIntObj(objResultPtr, -1);
			}
			TRACE(("%s\n", O2S(objResultPtr)));
			NEXT_INST_F(1, 2, 1);
		    }

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

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

	    case INST_LSHIFT:
		if (l2 < 0) {
		    Tcl_SetResult(interp, "negative shift argument",
			    TCL_STATIC);
#if 0
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
#endif
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else if (l2 > (long) INT_MAX) {
		    /*
		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetResult(interp,
			    "integer value too large to represent",
			    TCL_STATIC);
#if 0
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
#endif
		    goto gotError;
		} else {
		    int shift = (int) l2;

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



		    if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0)











			    && !((l1>0 ? l1 : ~l1) &




				-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
















			lResult = l1 << shift;

			goto longResultOfArithmetic;










		    }

		}

















































		/*



		 * Too large; need to use the broken-out function.

















		 */






























		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));








		break;






















































































	    case INST_BITAND:





























		lResult = l1 & l2;

		goto longResultOfArithmetic;
	    case INST_BITOR:
		lResult = l1 | l2;

		goto longResultOfArithmetic;
	    case INST_BITXOR:
		lResult = l1 ^ l2;



	    longResultOfArithmetic:


		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		if (Tcl_IsShared(valuePtr)) {
		    TclNewLongObj(objResultPtr, lResult);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		}
		TclSetLongObj(valuePtr, lResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);
	    }
	}

	/*
	 * DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would
	 * encourage the compiler to inline ExecuteExtendedBinaryMathOp, which
	 * is highly undesirable due to the overall impact on size.
	 */

	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
		valuePtr, value2Ptr);
	if (objResultPtr == DIVIDED_BY_ZERO) {
	    TRACE_APPEND(("DIVIDE BY ZERO\n"));
	    goto divideByZero;
	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
	    TRACE_APPEND(("ERROR: %s\n",
		    TclGetString(Tcl_GetObjResult(interp))));
	    goto gotError;
	} else if (objResultPtr == NULL) {
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	} else {
	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 2, 1);
	}

    case INST_EXPON:
    case INST_ADD:
    case INST_SUB:
    case INST_DIV:
    case INST_MULT:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| IsErroringNaNType(type1)) {

	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto gotError;
	}

#ifdef ACCEPT_NAN
	if (type1 == TCL_NUMBER_NAN) {
	    /*
	     * NaN first argument -> result is also NaN.
	     */

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

	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
		|| IsErroringNaNType(type2)) {

	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    goto gotError;
	}

#ifdef ACCEPT_NAN
	if (type2 == TCL_NUMBER_NAN) {
	    /*
	     * NaN second argument -> result is also NaN.
	     */

	    objResultPtr = value2Ptr;
	    NEXT_INST_F(1, 2, 1);
	}
#endif


	/*

	 * Handle (long,long) arithmetic as best we can without going out to
	 * an external function.
	 */

	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    Tcl_WideInt w1, w2, wResult;

	    l1 = *((const long *)ptr1);
	    l2 = *((const long *)ptr2);

	    switch (*pc) {
	    case INST_ADD:
		w1 = (Tcl_WideInt) l1;


		w2 = (Tcl_WideInt) l2;


		wResult = w1 + w2;


#ifdef NO_WIDE_TYPE





		/*



		 * Check for overflow.
		 */




















		if (Overflowing(w1, w2, wResult)) {




		    goto overflow;
		}
#endif










		goto wideResultOfArithmetic;





	    case INST_SUB:

		w1 = (Tcl_WideInt) l1;

		w2 = (Tcl_WideInt) l2;
		wResult = w1 - w2;
#ifdef NO_WIDE_TYPE
		/*
		 * Must check for overflow. The macro tests for overflows in
		 * sums by looking at the sign bits. As we have a subtraction
		 * here, we are adding -w2. As -w2 could in turn overflow, we
		 * test with ~w2 instead: it has the opposite sign bit to w2
		 * so it does the job. Note that the only "bad" case (w2==0)
		 * is irrelevant for this macro, as in that case w1 and
		 * wResult have the same sign and there is no overflow anyway.

		 */

		if (Overflowing(w1, ~w2, wResult)) {




		    goto overflow;




		}

#endif
	    wideResultOfArithmetic:
		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		if (Tcl_IsShared(valuePtr)) {
		    objResultPtr = Tcl_NewWideIntObj(wResult);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		}
		Tcl_SetWideIntObj(valuePtr, wResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);

	    case INST_DIV:








		if (l2 == 0) {















































		    TRACE(("%s %s => DIVIDE BY ZERO\n",




































































































































































































			    O2S(valuePtr), O2S(value2Ptr)));










		    goto divideByZero;








		} else if ((l1 == LONG_MIN) && (l2 == -1)) {





		    /*

		     * Can't represent (-LONG_MIN) as a long.
		     */




































































































































		    goto overflow;
		}








		lResult = l1 / l2;





















































		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((lResult < 0) || ((lResult == 0) &&
			((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
			((lResult * l2) != l1)) {
		    lResult -= 1;
		}

		goto longResultOfArithmetic;




	    case INST_MULT:
		if (((sizeof(long) >= 2*sizeof(int))
			&& (l1 <= INT_MAX) && (l1 >= INT_MIN)
			&& (l2 <= INT_MAX) && (l2 >= INT_MIN))
			|| ((sizeof(long) >= 2*sizeof(short))
			&& (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN)
			&& (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) {
		    lResult = l1 * l2;
		    goto longResultOfArithmetic;
		}
	    }








	    /*
	     * Fall through with INST_EXPON, INST_DIV and large multiplies.
	     */
	}

    overflow:
	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
	objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
		valuePtr, value2Ptr);
	if (objResultPtr == DIVIDED_BY_ZERO) {












	    TRACE_APPEND(("DIVIDE BY ZERO\n"));




	    goto divideByZero;


	} else if (objResultPtr == EXPONENT_OF_ZERO) {






	    TRACE_APPEND(("EXPONENT OF ZERO\n"));



	    goto exponOfZero;


	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
	    TRACE_APPEND(("ERROR: %s\n",
		    TclGetString(Tcl_GetObjResult(interp))));




	    goto gotError;

	} else if (objResultPtr == NULL) {




	    TRACE_APPEND(("%s\n", O2S(valuePtr)));

	    NEXT_INST_F(1, 1, 0);
	} else {
	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 2, 1);
	}




    case INST_LNOT: {
	int b;

	valuePtr = OBJ_AT_TOS;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for constants */
	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {

	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto gotError;
	}
	/* TODO: Consider peephole opt. */
	objResultPtr = TCONST(!b);
	NEXT_INST_F(1, 1, 1);
    }

   case INST_BITNOT:
	valuePtr = OBJ_AT_TOS;
	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)

		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
	    /*
	     * ... ~$NonInteger => raise an error.
	     */


	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto gotError;
	}
	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l1);
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetLongObj(valuePtr, ~l1);
	    NEXT_INST_F(1, 0, 0);
	}



	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {
	    NEXT_INST_F(1, 1, 1);
	} else {

	    NEXT_INST_F(1, 0, 0);
	}












    case INST_UMINUS:
	valuePtr = OBJ_AT_TOS;
	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| IsErroringNaNType(type1)) {

	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    IllegalExprOperandType(interp, pc, valuePtr);
	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */





	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_LONG:
	    l1 = *((const long *) ptr1);
	    if (l1 != LONG_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewLongObj(objResultPtr, -l1);
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetLongObj(valuePtr, -l1);
		NEXT_INST_F(1, 0, 0);
	    }
	    /* FALLTHROUGH */






	}

	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {
	    NEXT_INST_F(1, 1, 1);












	} else {
















	    NEXT_INST_F(1, 0, 0);
	}

    case INST_UPLUS:
    case INST_TRY_CVT_TO_NUMERIC:
	/*
	 * Try to convert the topmost stack object to numeric object. This is
	 * done in order to support [expr]'s policy of interpreting operands
	 * if at all possible as numbers first, then strings.
	 */

	valuePtr = OBJ_AT_TOS;

	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */


		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		IllegalExprOperandType(interp, pc, valuePtr);
		goto gotError;
	    }

	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	if (IsErroringNaNType(type1)) {

	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		IllegalExprOperandType(interp, pc, valuePtr);
	    } else {
		/*
		 * Numeric conversion of NaN -> error.
		 */

		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			O2S(objResultPtr)));
		TclExprFloatError(interp, *((const double *) ptr1));
	    }
	    goto gotError;
	}

	/*
	 * Ensure that the numeric value has a string rep the same as the
	 * formatted version of its internal rep. This is used, e.g., to make
	 * sure that "expr {0001}" yields "1", not "0001". We implement this
	 * by _discarding_ the string rep since we know it will be

	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	*/
	TRESULT = TCL_CONTINUE;
	cleanup = 0;
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Var *iterVarPtr, *listVarPtr;
	Tcl_Obj *oldValuePtr, *listPtr, **elements;
	ForeachVarList *varListPtr;
	int numLists, iterNum, listTmpIndex, listLen, numVars;
	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
	long i;

    case INST_FOREACH_START4:
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */






	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	iterTmpIndex = infoPtr->loopCtTemp;
	iterVarPtr = LOCAL(iterTmpIndex);
	oldValuePtr = iterVarPtr->value.objPtr;

	if (oldValuePtr == NULL) {

	 */

	pc += 5;
	TCL_DTRACE_INST_NEXT();
#else
	NEXT_INST_F(5, 0, 0);
#endif


    case INST_FOREACH_STEP4:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */









	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;

	/*
	 * Increment the temp holding the loop iteration number.
	 */

	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
	valuePtr = iterVarPtr->value.objPtr;
	iterNum = valuePtr->internalRep.longValue + 1;
	TclSetLongObj(valuePtr, iterNum);

	/*
	 * Check whether all value lists are exhausted and we should stop the
	 * loop.
	 */

	continueLoop = 0;
	listTmpIndex = infoPtr->firstValueTemp;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;

	    listVarPtr = LOCAL(listTmpIndex);
	    listPtr = listVarPtr->value.objPtr;
	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
		goto gotError;
	    }
	    if (listLen > iterNum * numVars) {
		continueLoop = 1;
	    }
	    listTmpIndex++;





	}

	/*
	 * If some var in some var list still has a remaining list element
	 * iterate one more time. Assign to var the next element from its
	 * value list. We already checked above that each list temp holds a
	 * valid list object (by calling Tcl_ListObjLength), but cannot rely

				TclDecrRefCount(value2Ptr);
			    }
			    varPtr->value.objPtr = valuePtr;
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();

			    TRACE_WITH_OBJ((
				    "%u => ERROR init. index temp %d: ",
				    opnd,varIndex), Tcl_GetObjResult(interp));

			    TclDecrRefCount(listPtr);
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
		TclDecrRefCount(listPtr);
		listTmpIndex++;
	    }
	}

	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
	    if (dictPtr == NULL) {
		TRACE_WITH_OBJ((
			"%u => ERROR tracing dictionary path into \"%s\": ",
			opnd, O2S(OBJ_AT_DEPTH(opnd))),
			Tcl_GetObjResult(interp));

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





	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
		    "\" not known in dictionary", NULL);
	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
	} else {
	    TRACE_WITH_OBJ((
		    "%u => ERROR reading leaf dictionary key \"%s\": ",
		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
	}
	goto gotError;

    case INST_DICT_SET:
    case INST_DICT_UNSET:
    case INST_DICT_INCR_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);

	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
	    CACHE_STACK_INFO();
	    TclDecrRefCount(dictPtr);
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));

		goto gotError;
	    }
	}
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+9) == INST_POP) {
	    NEXT_INST_V(10, cleanup, 0);
	}
#endif
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(9, cleanup, 1);

    case INST_DICT_APPEND:
    case INST_DICT_LAPPEND:
	opnd = TclGetUInt4AtPtr(pc+1);

	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;

	} else {
	    allocateDict = Tcl_IsShared(dictPtr);
	    if (allocateDict) {
		dictPtr = Tcl_DuplicateObj(dictPtr);
	    }
	}

	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
		&valuePtr) != TCL_OK) {
	    if (allocateDict) {
		TclDecrRefCount(dictPtr);
	    }
	    goto gotError;
	}

	/*
	 * Note that a non-existent key results in a NULL valuePtr, which is a
	 * case handled separately below. What we *can* say at this point is
	 * that the write-back will always succeed.
	 */

	switch (*pc) {
	case INST_DICT_APPEND:
	    if (valuePtr == NULL) {
		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, OBJ_AT_TOS);

	    } else if (Tcl_IsShared(valuePtr)) {
		valuePtr = Tcl_DuplicateObj(valuePtr);
		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
	    } else {
		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
	    }
	    break;
	case INST_DICT_LAPPEND:
	    /*
	     * More complex because list-append can fail.
	     */

	    if (valuePtr == NULL) {
		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS,
			Tcl_NewListObj(1, &OBJ_AT_TOS));
		break;

	    } else if (Tcl_IsShared(valuePtr)) {
		valuePtr = Tcl_DuplicateObj(valuePtr);
		if (Tcl_ListObjAppendElement(interp, valuePtr,
			OBJ_AT_TOS) != TCL_OK) {
		    TclDecrRefCount(valuePtr);
		    if (allocateDict) {
			TclDecrRefCount(dictPtr);
		    }
		    goto gotError;
		}
		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
	    } else {
		if (Tcl_ListObjAppendElement(interp, valuePtr,
			OBJ_AT_TOS) != TCL_OK) {


		    if (allocateDict) {
			TclDecrRefCount(dictPtr);
		    }
		    goto gotError;
		}
	    }
	    break;
	default:
	    Tcl_Panic("Should not happen!");
	}



	if (TclIsVarDirectWritable(varPtr)) {
	    if (allocateDict) {
		value2Ptr = varPtr->value.objPtr;
		Tcl_IncrRefCount(dictPtr);
		if (value2Ptr != NULL) {
		    TclDecrRefCount(value2Ptr);
		}
		varPtr->value.objPtr = dictPtr;
	    }
	    objResultPtr = dictPtr;
	} else {
	    Tcl_IncrRefCount(dictPtr);
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();
	    TclDecrRefCount(dictPtr);
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));

		goto gotError;
	    }
	}
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+5) == INST_POP) {
	    NEXT_INST_F(6, 2, 0);
	}
#endif
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = (Tcl_DictSearch *) ckalloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    ckfree((char *) searchPtr);
	    goto gotError;
	}
	TclNewObj(statePtr);
	statePtr->typePtr = &dictIteratorType;
	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
	statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
	varPtr = LOCAL(opnd);
	if (varPtr->value.objPtr) {

	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
		    TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();
	    if (dictPtr == NULL) {
		goto gotError;
	    }
	}
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    goto gotError;
	}
	if (length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		goto gotError;
	    }
	    varPtr = LOCAL(duiPtr->varIndices[i]);
	    while (TclIsVarLink(varPtr)) {
		varPtr = varPtr->value.linkPtr;
	    }
	    DECACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		TclObjUnsetVar2(interp,
			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
			NULL, 0);
	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    valuePtr, TCL_LEAVE_ERR_MSG,
		    duiPtr->varIndices[i]) == NULL) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
	    CACHE_STACK_INFO();
	}
	NEXT_INST_F(9, 0, 0);




    case INST_DICT_UPDATE_END:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	varPtr = LOCAL(opnd);
	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
	while (TclIsVarLink(varPtr)) {

	}
	if (dictPtr == NULL) {
	    NEXT_INST_F(9, 1, 0);
	}
	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
		|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
			&keyPtrPtr) != TCL_OK) {

	    goto gotError;
	}
	allocdict = Tcl_IsShared(dictPtr);
	if (allocdict) {
	    dictPtr = Tcl_DuplicateObj(dictPtr);
	}
	for (i=0 ; i<length ; i++) {
	    Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);

	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();
	    if (objResultPtr == NULL) {
		if (allocdict) {
		    TclDecrRefCount(dictPtr);
		}

		goto gotError;
	    }
	}
	NEXT_INST_F(9, 1, 0);
    }

    /*
     *	   End of dictionary-related instructions.
     * -----------------------------------------------------------------
     */

    default:
	Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
    } /* end of switch on opCode */


























    /*
     * Block for variables needed to process exception returns.
     */

    {
	ExceptionRange *rangePtr;
				/* Points to closest loop or catch exception

	    if (TRESULT == TCL_BREAK) {
		TRESULT = TCL_OK;
		pc = (codePtr->codeStart + rangePtr->breakOffset);
		TRACE_APPEND(("%s, range at %d, new pc %d\n",
			StringForResultCode(TRESULT),
			rangePtr->codeOffset, rangePtr->breakOffset));
		NEXT_INST_F(0, 0, 0);

	    }
	    if (rangePtr->continueOffset == -1) {

		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
			StringForResultCode(TRESULT)));
		goto checkForCatch;
	    }
	    TRESULT = TCL_OK;
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
		    StringForResultCode(TRESULT),
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#if TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);
	    if ((TRESULT != TCL_ERROR) && (TRESULT != TCL_RETURN)) {
		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
			TRESULT, O2S(objPtr)));
	    } else {
		TRACE_APPEND(("%s, result= \"%s\"\n",
			StringForResultCode(TRESULT), O2S(objPtr)));
	    }
	}
#endif
	goto checkForCatch;

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

    divideByZero:
	Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
	goto gotError;

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

    exponOfZero:
	Tcl_SetResult(interp, "exponentiation of zero by negative power",
		TCL_STATIC);
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		"exponentiation of zero by negative power", NULL);

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

    gotError:
	TRESULT = TCL_ERROR;

	/*
	 * Execution has generated an "exception" such as TCL_ERROR. If the
	 * exception is an error, record information about what was being
	 * executed when the error occurred. Find the closest enclosing catch
	 * range, if any. If no enclosing catch range is found, stop execution
	 * and return the "exception" code.

}
#undef iPtr
#undef bcFramePtr
#undef initCatchTop
#undef initTosPtr
#undef auxObjList
#undef catchTop
#undef TCONST

/*
 *----------------------------------------------------------------------
 *
 * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
 *
 *	These functions do advanced math for binary and unary operators
 *	respectively, so that the main TEBC code does not bear the cost of
 *	them.
 *
 * Results:
 *	A Tcl_Obj* result, or a NULL (in which case valuePtr is updated to
 *	hold the result value), or one of the special flag values
 *	GENERAL_ARITHMETIC_ERROR, EXPONENT_OF_ZERO or DIVIDED_BY_ZERO. The
 *	latter two signify a zero value raised to a negative power or a value
 *	divided by zero, respectively. With GENERAL_ARITHMETIC_ERROR, all
 *	error information will have already been reported in the interpreter
 *	result.
 *
 * Side effects:
 *	May update the Tcl_Obj indicated valuePtr if it is unshared. Will
 *	return a NULL when that happens.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
ExecuteExtendedBinaryMathOp(
    Tcl_Interp *interp,		/* Where to report errors. */
    int opcode,			/* What operation to perform. */
    Tcl_Obj **constants,	/* The execution environment's constants. */
    Tcl_Obj *valuePtr,		/* The first operand on the stack. */
    Tcl_Obj *value2Ptr)		/* The second operand on the stack. */
{
#define LONG_RESULT(l) \
    if (Tcl_IsShared(valuePtr)) {		\
	TclNewLongObj(objResultPtr, l);		\
	return objResultPtr;			\
    } else {					\
	Tcl_SetLongObj(valuePtr, l);		\
	return NULL;				\
    }
#define WIDE_RESULT(w) \
    if (Tcl_IsShared(valuePtr)) {		\
	return Tcl_NewWideIntObj(w);		\
    } else {					\
	Tcl_SetWideIntObj(valuePtr, w);		\
	return NULL;				\
    }
#define BIG_RESULT(b) \
    if (Tcl_IsShared(valuePtr)) {		\
	return Tcl_NewBignumObj(b);		\
    } else {					\
	Tcl_SetBignumObj(valuePtr, b);		\
	return NULL;				\
    }
#define DOUBLE_RESULT(d) \
    if (Tcl_IsShared(valuePtr)) {		\
	TclNewDoubleObj(objResultPtr, (d));	\
	return objResultPtr;			\
    } else {					\
	Tcl_SetDoubleObj(valuePtr, (d));	\
	return NULL;				\
    }

    int type1, type2;
    ClientData ptr1, ptr2;
    double d1, d2, dResult;
    long l1, l2, lResult;
    Tcl_WideInt w1, w2, wResult, wQuotient, wRemainder;
    mp_int big1, big2, bigResult, bigRemainder;
    Tcl_Obj *objResultPtr;
    int invalid, numPos, zero;
    long shift;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (opcode) {
    case INST_MOD:
	/* TODO: Attempts to re-use unshared operands on stack */

	l2 = 0;			/* silence gcc warning */
	if (type2 == TCL_NUMBER_LONG) {
	    l2 = *((const long *)ptr2);
	    if (l2 == 0) {
		return DIVIDED_BY_ZERO;
	    }
	    if ((l2 == 1) || (l2 == -1)) {
		/*
		 * Div. by |1| always yields remainder of 0.
		 */

		return constants[0];
	    }
	}
#ifndef NO_WIDE_TYPE
	if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    if (type2 != TCL_NUMBER_BIG) {
		Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
		wQuotient = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((wQuotient < (Tcl_WideInt) 0)
			|| ((wQuotient == (Tcl_WideInt) 0)
			&& ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
			|| (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
			&& (wQuotient * w2 != w1)) {
		    wQuotient -= (Tcl_WideInt) 1;
		}
		wRemainder = w1 - w2*wQuotient;
		WIDE_RESULT(wRemainder);
	    }

	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);

	    /* TODO: internals intrusion */
	    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
		/*
		 * Arguments are opposite sign; remainder is sum.
		 */

		TclBNInitBignumFromWideInt(&big1, w1);
		mp_add(&big2, &big1, &big2);
		mp_clear(&big1);
		BIG_RESULT(&big2);
	    }

	    /*
	     * Arguments are same sign; remainder is first operand.
	     */

	    mp_clear(&big2);
	    return NULL;
	}
#endif
	Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	mp_init(&bigResult);
	mp_init(&bigRemainder);
	mp_div(&big1, &big2, &bigResult, &bigRemainder);
	if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
	    /*
	     * Convert to Tcl's integer division rules.
	     */

	    mp_sub_d(&bigResult, 1, &bigResult);
	    mp_add(&bigRemainder, &big2, &bigRemainder);
	}
	mp_copy(&bigRemainder, &bigResult);
	mp_clear(&bigRemainder);
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);

    case INST_LSHIFT:
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_LONG:
	    invalid = (*((const long *)ptr2) < 0L);
	    break;
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
#endif
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = (mp_cmp_d(&big2, 0) == MP_LT);
	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
	    Tcl_SetResult(interp, "negative shift argument", TCL_STATIC);
	    return GENERAL_ARITHMETIC_ERROR;
	}

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

	if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
	     * BEWARE! Can't use Tcl_GetIntFromObj() here because that
	     * converts values in the (unsigned) range to their signed int
	     * counterparts, leading to incorrect results.
	     */

	    if ((type2 != TCL_NUMBER_LONG)
		    || (*((const long *)ptr2) > (long) INT_MAX)) {
		/*
		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
		 * an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */

		Tcl_SetResult(interp, "integer value too large to represent",
			TCL_STATIC);
		return GENERAL_ARITHMETIC_ERROR;
	    }
	    shift = (int)(*((const long *)ptr2));

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

	    if ((type1 != TCL_NUMBER_BIG)
		    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
		TclGetWideIntFromObj(NULL, valuePtr, &w1);
		if (!((w1>0 ? w1 : ~w1)
			& -(((Tcl_WideInt)1)
			<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
		    WIDE_RESULT(w1 << shift);
		}
	    }
	} else {
	    /*
	     * Quickly force large right shifts to 0 or -1.
	     */

	    if ((type2 != TCL_NUMBER_LONG)
		    || (*(const long *)ptr2 > INT_MAX)) {
		/*
		 * Again, technically, the value to be shifted could be an
		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
		 * not take us to the result of 0 or -1, but since we're using
		 * mp_div_2d to do the work, and it takes only an int
		 * argument, we draw the line there.
		 */

		switch (type1) {
		case TCL_NUMBER_LONG:
		    zero = (*(const long *)ptr1 > 0L);
		    break;
#ifndef NO_WIDE_TYPE
		case TCL_NUMBER_WIDE:
		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
		    break;
#endif
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (mp_cmp_d(&big1, 0) == MP_GT);
		    mp_clear(&big1);
		    break;
		default:
		    /* Unused, here to silence compiler warning. */
		    zero = 0;
		}
		if (zero) {
		    return constants[0];
		}
		LONG_RESULT(-1);
	    }
	    shift = (int)(*(const long *)ptr2);

#ifndef NO_WIDE_TYPE
	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_WIDE) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= (Tcl_WideInt)0) {
			return constants[0];
		    }
		    LONG_RESULT(-1);
		}
		WIDE_RESULT(w1 >> shift);
	    }
#endif
	}

	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);

	mp_init(&bigResult);
	if (opcode == INST_LSHIFT) {
	    mp_mul_2d(&big1, shift, &bigResult);
	} else {
	    mp_init(&bigRemainder);
	    mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
	    if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
	    }
	    mp_clear(&bigRemainder);
	}
	mp_clear(&big1);
	BIG_RESULT(&bigResult);
    }

    case INST_BITOR:
    case INST_BITXOR:
    case INST_BITAND:
	if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
	    mp_int *First, *Second;

	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);

	    /*
	     * Count how many positive arguments we have. If only one of the
	     * arguments is negative, store it in 'Second'.
	     */

	    if (mp_cmp_d(&big1, 0) != MP_LT) {
		numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
		First = &big1;
		Second = &big2;
	    } else {
		First = &big2;
		Second = &big1;
		numPos = (mp_cmp_d(First, 0) != MP_LT);
	    }
	    mp_init(&bigResult);

	    switch (opcode) {
	    case INST_BITAND:
		switch (numPos) {
		case 2:
		    /*
		     * Both arguments positive, base case.
		     */

		    mp_and(First, Second, &bigResult);
		    break;
		case 1:
		    /*
		     * First is positive; second negative:
		     * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
		     */

		    mp_neg(Second, Second);
		    mp_sub_d(Second, 1, Second);
		    mp_xor(First, Second, &bigResult);
		    mp_and(First, &bigResult, &bigResult);
		    break;
		case 0:
		    /*
		     * Both arguments negative:
		     * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
		     */

		    mp_neg(First, First);
		    mp_sub_d(First, 1, First);
		    mp_neg(Second, Second);
		    mp_sub_d(Second, 1, Second);
		    mp_or(First, Second, &bigResult);
		    mp_neg(&bigResult, &bigResult);
		    mp_sub_d(&bigResult, 1, &bigResult);
		    break;
		}
		break;

	    case INST_BITOR:
		switch (numPos) {
		case 2:
		    /*
		     * Both arguments positive, base case.
		     */

		    mp_or(First, Second, &bigResult);
		    break;
		case 1:
		    /*
		     * First is positive; second negative:
		     * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
		     */

		    mp_neg(Second, Second);
		    mp_sub_d(Second, 1, Second);
		    mp_xor(First, Second, &bigResult);
		    mp_and(Second, &bigResult, &bigResult);
		    mp_neg(&bigResult, &bigResult);
		    mp_sub_d(&bigResult, 1, &bigResult);
		    break;
		case 0:
		    /*
		     * Both arguments negative:
		     * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
		     */

		    mp_neg(First, First);
		    mp_sub_d(First, 1, First);
		    mp_neg(Second, Second);
		    mp_sub_d(Second, 1, Second);
		    mp_and(First, Second, &bigResult);
		    mp_neg(&bigResult, &bigResult);
		    mp_sub_d(&bigResult, 1, &bigResult);
		    break;
		}
		break;

	    case INST_BITXOR:
		switch (numPos) {
		case 2:
		    /*
		     * Both arguments positive, base case.
		     */

		    mp_xor(First, Second, &bigResult);
		    break;
		case 1:
		    /*
		     * First is positive; second negative:
		     * P^N = ~(P^~N) = -(P^(-N-1))-1
		     */

		    mp_neg(Second, Second);
		    mp_sub_d(Second, 1, Second);
		    mp_xor(First, Second, &bigResult);
		    mp_neg(&bigResult, &bigResult);
		    mp_sub_d(&bigResult, 1, &bigResult);
		    break;
		case 0:
		    /*
		     * Both arguments negative:
		     * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
		     */

		    mp_neg(First, First);
		    mp_sub_d(First, 1, First);
		    mp_neg(Second, Second);
		    mp_sub_d(Second, 1, Second);
		    mp_xor(First, Second, &bigResult);
		    break;
		}
		break;
	    }

	    mp_clear(&big1);
	    mp_clear(&big2);
	    BIG_RESULT(&bigResult);
	}

#ifndef NO_WIDE_TYPE
	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_BITAND:
		wResult = w1 & w2;
		break;
	    case INST_BITOR:
		wResult = w1 | w2;
		break;
	    case INST_BITXOR:
		wResult = w1 ^ w2;
		break;
	    default:
		/* Unused, here to silence compiler warning. */
		wResult = 0;
	    }
	    WIDE_RESULT(wResult);
	}
#endif
	l1 = *((const long *)ptr1);
	l2 = *((const long *)ptr2);

	switch (opcode) {
	case INST_BITAND:
	    lResult = l1 & l2;
	    break;
	case INST_BITOR:
	    lResult = l1 | l2;
	    break;
	case INST_BITXOR:
	    lResult = l1 ^ l2;
	    break;
	default:
	    /* Unused, here to silence compiler warning. */
	    lResult = 0;
	}
	LONG_RESULT(lResult);

    case INST_EXPON: {
	int oddExponent = 0, negativeExponent = 0;
	unsigned short base;

	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);

	    if (d1==0.0 && d2<0.0) {
		return EXPONENT_OF_ZERO;
	    }
	    dResult = pow(d1, d2);
	    goto doubleResult;
	}
	l1 = l2 = 0;
	if (type2 == TCL_NUMBER_LONG) {
	    l2 = *((const long *) ptr2);
	    if (l2 == 0) {
		/*
		 * Anything to the zero power is 1.
		 */

		return constants[1];
	    } else if (l2 == 1) {
		/*
		 * Anything to the first power is itself
		 */

		return NULL;
	    }
	}

	switch (type2) {
	case TCL_NUMBER_LONG:
	    negativeExponent = (l2 < 0);
	    oddExponent = (int) (l2 & 1);
	    break;
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	    break;
#endif
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	    break;
	}

	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *)ptr1);
	}
	if (negativeExponent) {
	    if (type1 == TCL_NUMBER_LONG) {
		switch (l1) {
		case 0:
		    /*
		     * Zero to a negative power is div by zero error.
		     */

		    return EXPONENT_OF_ZERO;
		case -1:
		    if (oddExponent) {
			LONG_RESULT(-1);
		    }
		    /* fallthrough */
		case 1:
		    /*
		     * 1 to any power is 1.
		     */

		    return constants[1];
		}
	    }

	    /*
	     * Integers with magnitude greater than 1 raise to a negative
	     * power yield the answer zero (see TIP 123).
	     */

	    return constants[0];
	}

	if (type1 == TCL_NUMBER_LONG) {
	    switch (l1) {
	    case 0:
		/*
		 * Zero to a positive power is zero.
		 */

		return constants[0];
	    case 1:
		/*
		 * 1 to any power is 1.
		 */

		return constants[1];
	    case -1:
		if (!oddExponent) {
		    return constants[1];
		}
		LONG_RESULT(-1);
	    }
	}

	/*
	 * We refuse to accept exponent arguments that exceed one mp_digit
	 * which means the max exponent value is 2**28-1 = 0x0fffffff =
	 * 268435455, which fits into a signed 32 bit int which is within the
	 * range of the long int type. This means any numeric Tcl_Obj value
	 * not using TCL_NUMBER_LONG type must hold a value larger than we
	 * accept.
	 */

	if (type2 != TCL_NUMBER_LONG) {
	    Tcl_SetResult(interp, "exponent too large", TCL_STATIC);
	    return GENERAL_ARITHMETIC_ERROR;
	}

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

		if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
		    LONG_RESULT(1L << l2);
		}
#if !defined(TCL_WIDE_INT_IS_LONG)
		if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
		    WIDE_RESULT(((Tcl_WideInt) 1) << l2);
		}
#endif
		goto overflowExpon;
	    }
	    if (l1 == -2) {
		int signum = oddExponent ? -1 : 1;

		/*
		 * Reduce small powers of 2 to shifts.
		 */

		if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
		    LONG_RESULT(signum * (1L << l2));
		}
#if !defined(TCL_WIDE_INT_IS_LONG)
		if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
		    WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
		}
#endif
		goto overflowExpon;
	    }
#if (LONG_MAX == 0x7fffffff)
	    if (l2 - 2 < (long)MaxBase32Size
		    && l1 <= MaxBase32[l2 - 2]
		    && l1 >= -MaxBase32[l2 - 2]) {
		/*
		 * Small powers of 32-bit integers.
		 */

		lResult = l1 * l1;		/* b**2 */
		switch (l2) {
		case 2:
		    break;
		case 3:
		    lResult *= l1;		/* b**3 */
		    break;
		case 4:
		    lResult *= lResult;		/* b**4 */
		    break;
		case 5:
		    lResult *= lResult;		/* b**4 */
		    lResult *= l1;		/* b**5 */
		    break;
		case 6:
		    lResult *= l1;		/* b**3 */
		    lResult *= lResult;		/* b**6 */
		    break;
		case 7:
		    lResult *= l1;		/* b**3 */
		    lResult *= lResult;		/* b**6 */
		    lResult *= l1;		/* b**7 */
		    break;
		case 8:
		    lResult *= lResult;		/* b**4 */
		    lResult *= lResult;		/* b**8 */
		    break;
		}
		LONG_RESULT(lResult);
	    }

	    if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize
		    && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
		base = Exp32Index[l1 - 3]
			+ (unsigned short) (l2 - 2 - MaxBase32Size);
		if (base < Exp32Index[l1 - 2]) {
		    /*
		     * 32-bit number raised to intermediate power, done by
		     * table lookup.
		     */

		    LONG_RESULT(Exp32Value[base]);
		}
	    }
	    if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
		    && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
		base = Exp32Index[-l1 - 3]
			+ (unsigned short) (l2 - 2 - MaxBase32Size);
		if (base < Exp32Index[-l1 - 2]) {
		    /*
		     * 32-bit number raised to intermediate power, done by
		     * table lookup.
		     */

		    lResult = (oddExponent) ?
			    -Exp32Value[base] : Exp32Value[base];
		    LONG_RESULT(lResult);
		}
	    }
#endif
	}
#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
	if (type1 == TCL_NUMBER_LONG) {
	    w1 = l1;
#ifndef NO_WIDE_TYPE
	} else if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *) ptr1);
#endif
	} else {
	    goto overflowExpon;
	}
	if (l2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[l2 - 2]
		&& w1 >= -MaxBase64[l2 - 2]) {
	    /*
	     * Small powers of integers whose result is wide.
	     */

	    wResult = w1 * w1;		/* b**2 */
	    switch (l2) {
	    case 2:
		break;
	    case 3:
		wResult *= l1;		/* b**3 */
		break;
	    case 4:
		wResult *= wResult;	/* b**4 */
		break;
	    case 5:
		wResult *= wResult;	/* b**4 */
		wResult *= w1;		/* b**5 */
		break;
	    case 6:
		wResult *= w1;		/* b**3 */
		wResult *= wResult;	/* b**6 */
		break;
	    case 7:
		wResult *= w1;		/* b**3 */
		wResult *= wResult;	/* b**6 */
		wResult *= w1;		/* b**7 */
		break;
	    case 8:
		wResult *= wResult;	/* b**4 */
		wResult *= wResult;	/* b**8 */
		break;
	    case 9:
		wResult *= wResult;	/* b**4 */
		wResult *= wResult;	/* b**8 */
		wResult *= w1;		/* b**9 */
		break;
	    case 10:
		wResult *= wResult;	/* b**4 */
		wResult *= w1;		/* b**5 */
		wResult *= wResult;	/* b**10 */
		break;
	    case 11:
		wResult *= wResult;	/* b**4 */
		wResult *= w1;		/* b**5 */
		wResult *= wResult;	/* b**10 */
		wResult *= w1;		/* b**11 */
		break;
	    case 12:
		wResult *= w1;		/* b**3 */
		wResult *= wResult;	/* b**6 */
		wResult *= wResult;	/* b**12 */
		break;
	    case 13:
		wResult *= w1;		/* b**3 */
		wResult *= wResult;	/* b**6 */
		wResult *= wResult;	/* b**12 */
		wResult *= w1;		/* b**13 */
		break;
	    case 14:
		wResult *= w1;		/* b**3 */
		wResult *= wResult;	/* b**6 */
		wResult *= w1;		/* b**7 */
		wResult *= wResult;	/* b**14 */
		break;
	    case 15:
		wResult *= w1;		/* b**3 */
		wResult *= wResult;	/* b**6 */
		wResult *= w1;		/* b**7 */
		wResult *= wResult;	/* b**14 */
		wResult *= w1;		/* b**15 */
		break;
	    case 16:
		wResult *= wResult;	/* b**4 */
		wResult *= wResult;	/* b**8 */
		wResult *= wResult;	/* b**16 */
		break;
	    }
	    WIDE_RESULT(wResult);
	}

	/*
	 * Handle cases of powers > 16 that still fit in a 64-bit word by
	 * doing table lookup.
	 */

	if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
		&& l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
	    base = Exp64Index[w1 - 3]
		    + (unsigned short) (l2 - 2 - MaxBase64Size);
	    if (base < Exp64Index[w1 - 2]) {
		/*
		 * 64-bit number raised to intermediate power, done by
		 * table lookup.
		 */

		WIDE_RESULT(Exp64Value[base]);
	    }
	}

	if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
		&& l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
	    base = Exp64Index[-w1 - 3]
		    + (unsigned short) (l2 - 2 - MaxBase64Size);
	    if (base < Exp64Index[-w1 - 2]) {
		/*
		 * 64-bit number raised to intermediate power, done by
		 * table lookup.
		 */

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}
#endif

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

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:
	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
	    /*
	     * At least one of the values is floating-point, so perform
	     * floating point calculations.
	     */

	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);

	    switch (opcode) {
	    case INST_ADD:
		dResult = d1 + d2;
		break;
	    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) {
		    return DIVIDED_BY_ZERO;
		}
#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;
	    default:
		/* Unused, here to silence compiler warning. */
		dResult = 0;
	    }

	doubleResult:
#ifndef ACCEPT_NAN
	    /*
	     * Check now for IEEE floating-point error.
	     */

	    if (TclIsNaN(dResult)) {
		TclExprFloatError(interp, dResult);
		return GENERAL_ARITHMETIC_ERROR;
	    }
#endif
	    DOUBLE_RESULT(dResult);
	}
	if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_ADD:
		wResult = w1 + w2;
#ifndef NO_WIDE_TYPE
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
		{
		    /*
		     * Check for overflow.
		     */

		    if (Overflowing(w1, w2, wResult)) {
			goto overflowBasic;
		    }
		}
		break;

	    case INST_SUB:
		wResult = w1 - w2;
#ifndef NO_WIDE_TYPE
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
		{
		    /*
		     * Must check for overflow. The macro tests for overflows
		     * in sums by looking at the sign bits. As we have a
		     * subtraction here, we are adding -w2. As -w2 could in
		     * turn overflow, we test with ~w2 instead: it has the
		     * opposite sign bit to w2 so it does the job. Note that
		     * the only "bad" case (w2==0) is irrelevant for this
		     * macro, as in that case w1 and wResult have the same
		     * sign and there is no overflow anyway.
		     */

		    if (Overflowing(w1, ~w2, wResult)) {
			goto overflowBasic;
		    }
		}
		break;

	    case INST_MULT:
		if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)
			|| (sizeof(Tcl_WideInt) < 2*sizeof(long))) {
		    goto overflowBasic;
		}
		wResult = w1 * w2;
		break;

	    case INST_DIV:
		if (w2 == 0) {
		    return DIVIDED_BY_ZERO;
		}

		/*
		 * Need a bignum to represent (LLONG_MIN / -1)
		 */

		if ((w1 == LLONG_MIN) && (w2 == -1)) {
		    goto overflowBasic;
		}
		wResult = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((wResult < 0) || ((wResult == 0) &&
			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
			(wResult*w2 != w1)) {
		    wResult -= 1;
		}
		break;

	    default:
		/*
		 * Unused, here to silence compiler warning.
		 */

		wResult = 0;
	    }

	    WIDE_RESULT(wResult);
	}

    overflowBasic:
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	mp_init(&bigResult);
	switch (opcode) {
	case INST_ADD:
	    mp_add(&big1, &big2, &bigResult);
	    break;
	case INST_SUB:
	    mp_sub(&big1, &big2, &bigResult);
	    break;
	case INST_MULT:
	    mp_mul(&big1, &big2, &bigResult);
	    break;
	case INST_DIV:
	    if (mp_iszero(&big2)) {
		mp_clear(&big1);
		mp_clear(&big2);
		mp_clear(&bigResult);
		return DIVIDED_BY_ZERO;
	    }
	    mp_init(&bigRemainder);
	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
	    /* TODO: internals intrusion */
	    if (!mp_iszero(&bigRemainder)
		    && (bigRemainder.sign != big2.sign)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
		mp_add(&bigRemainder, &big2, &bigRemainder);
	    }
	    mp_clear(&bigRemainder);
	    break;
	}
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);
    }

    Tcl_Panic("unexpected opcode");
    return NULL;
}

static Tcl_Obj *
ExecuteExtendedUnaryMathOp(
    int opcode,			/* What operation to perform. */
    Tcl_Obj *valuePtr)		/* The operand on the stack. */
{
    ClientData ptr;
    int type;
    Tcl_WideInt w;
    mp_int big;
    Tcl_Obj *objResultPtr;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);

    switch (opcode) {
    case INST_BITNOT:
#ifndef NO_WIDE_TYPE
	if (type == TCL_NUMBER_WIDE) {
	    w = *((const Tcl_WideInt *) ptr);
	    WIDE_RESULT(~w);
	}
#endif
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	/* ~a = - a - 1 */
	mp_neg(&big, &big);
	mp_sub_d(&big, 1, &big);
	BIG_RESULT(&big);
    case INST_UMINUS:
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    DOUBLE_RESULT(-(*((const double *) ptr)));
	case TCL_NUMBER_LONG:
	    w = (Tcl_WideInt) (*((const long *) ptr));
	    if (w != LLONG_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclBNInitBignumFromLong(&big, *(const long *) ptr);
	    break;
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
	    w = *((const Tcl_WideInt *) ptr);
	    if (w != LLONG_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclBNInitBignumFromWideInt(&big, w);
	    break;
#endif
	default:
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	}
	mp_neg(&big, &big);
	BIG_RESULT(&big);
    }

    Tcl_Panic("unexpected opcode");
    return NULL;
}
#undef LONG_RESULT
#undef WIDE_RESULT
#undef BIG_RESULT
#undef DOUBLE_RESULT

/*
 *----------------------------------------------------------------------
 *
 * CompareTwoNumbers --
 *
 *	This function compares a pair of numbers in Tcl_Objs. Each argument
 *	must already be known to be numeric and not NaN.
 *
 * Results:
 *	One of MP_LT, MP_EQ or MP_GT, depending on whether valuePtr is less
 *	than, equal to, or greater than value2Ptr (respectively).
 *
 * Side effects:
 *	None, provided both values are numeric.
 *
 *----------------------------------------------------------------------
 */

int
TclCompareTwoNumbers(
    Tcl_Obj *valuePtr,
    Tcl_Obj *value2Ptr)
{
    int type1, type2, compare;
    ClientData ptr1, ptr2;
    mp_int big1, big2;
    double d1, d2, tmp;
    long l1, l2;
    Tcl_WideInt w1, w2;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (type1) {
    case TCL_NUMBER_LONG:
	l1 = *((const long *)ptr1);
	switch (type2) {
	case TCL_NUMBER_LONG:
	    l2 = *((const long *)ptr2);
	longCompare:
	    return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    w1 = (Tcl_WideInt)l1;
	    goto wideCompare;
#endif
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    d1 = (double) l1;

	    /*
	     * If the double has a fractional part, or if the long can be
	     * converted to double without loss of precision, then compare as
	     * doubles.
	     */

	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1
		    || modf(d2, &tmp) != 0.0) {
		goto doubleCompare;
	    }

	    /*
	     * Otherwise, to make comparision based on full precision, need to
	     * convert the double to a suitably sized integer.
	     *
	     * Need this to get comparsions like
	     *	  expr 20000000000000003 < 20000000000000004.0
	     * right. Converting the first argument to double will yield two
	     * double values that are equivalent within double precision.
	     * Converting the double to an integer gets done exactly, then
	     * integer comparison can tell the difference.
	     */

	    if (d2 < (double)LONG_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)LONG_MAX) {
		return MP_LT;
	    }
	    l2 = (long) d2;
	    goto longCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_cmp_d(&big2, 0) == MP_LT) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}

#ifndef NO_WIDE_TYPE
    case TCL_NUMBER_WIDE:
	w1 = *((const Tcl_WideInt *)ptr1);
	switch (type2) {
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	wideCompare:
	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_LONG:
	    l2 = *((const long *)ptr2);
	    w2 = (Tcl_WideInt)l2;
	    goto wideCompare;
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    d1 = (double) w1;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
		    || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d2 < (double)LLONG_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)LLONG_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_cmp_d(&big2, 0) == MP_LT) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}
#endif

    case TCL_NUMBER_DOUBLE:
	d1 = *((const double *)ptr1);
	switch (type2) {
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	doubleCompare:
	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_LONG:
	    l2 = *((const long *)ptr2);
	    d2 = (double) l2;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2
		    || modf(d1, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d1 < (double)LONG_MIN) {
		return MP_LT;
	    }
	    if (d1 > (double)LONG_MAX) {
		return MP_GT;
	    }
	    l1 = (long) d1;
	    goto longCompare;
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    d2 = (double) w2;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
		    || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d1 < (double)LLONG_MIN) {
		return MP_LT;
	    }
	    if (d1 > (double)LLONG_MAX) {
		return MP_GT;
	    }
	    w1 = (Tcl_WideInt) d1;
	    goto wideCompare;
#endif
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
		if (mp_cmp_d(&big2, 0) == MP_LT) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;
	    }
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
		    && modf(d1, &tmp) != 0.0) {
		d2 = TclBignumToDouble(&big2);
		mp_clear(&big2);
		goto doubleCompare;
	    }
	    Tcl_InitBignumFromDouble(NULL, d1, &big1);
	    goto bigCompare;
	}

    case TCL_NUMBER_BIG:
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	switch (type2) {
#ifndef NO_WIDE_TYPE
	case TCL_NUMBER_WIDE:
#endif
	case TCL_NUMBER_LONG:
	    compare = mp_cmp_d(&big1, 0);
	    mp_clear(&big1);
	    return compare;
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    if (TclIsInfinite(d2)) {
		compare = (d2 > 0.0) ? MP_LT : MP_GT;
		mp_clear(&big1);
		return compare;
	    }
	    if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
		compare = mp_cmp_d(&big1, 0);
		mp_clear(&big1);
		return compare;
	    }
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
		    && modf(d2, &tmp) != 0.0) {
		d1 = TclBignumToDouble(&big1);
		mp_clear(&big1);
		goto doubleCompare;
	    }
	    Tcl_InitBignumFromDouble(NULL, d2, &big2);
	    goto bigCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	bigCompare:
	    compare = mp_cmp(&big1, &big2);
	    mp_clear(&big1);
	    mp_clear(&big2);
	    return compare;
	}
    default:
	Tcl_Panic("unexpected number type");
	return TCL_ERROR;
    }
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * PrintByteCodeInfo --
 *