path: root/generic/tclExecute.c

/* 
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl
 *	commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 *
 * 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.16 2000/11/24 15:29:51 dkf Exp $
 */

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

#ifdef NO_FLOAT_H
#   include "../compat/float.h"
#else
#   include <float.h>
#endif
#ifndef TCL_NO_MATH
#include "tclMath.h"
#endif

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

#ifndef TCL_GENERIC_ONLY
#include "tclPort.h"
#else
#define NO_ERRNO_H
#endif

#ifdef NO_ERRNO_H
int errno;
#define EDOM 33
#define ERANGE 34
#endif

/*
 * Boolean flag indicating whether the Tcl bytecode interpreter has been
 * initialized.
 */

static int execInitialized = 0;
TCL_DECLARE_MUTEX(execMutex)

/*
 * Variable that controls whether execution tracing is enabled and, if so,
 * what level of tracing is desired:
 *    0: no execution tracing
 *    1: trace invocations of Tcl procs only
 *    2: trace invocations of all (not compiled away) commands
 *    3: display each instruction executed
 * This variable is linked to the Tcl variable "tcl_traceExec".
 */

int tclTraceExec = 0;

typedef struct ThreadSpecificData {
    /*
     * The following global variable is use to signal matherr that Tcl
     * is responsible for the arithmetic, so errors can be handled in a
     * fashion appropriate for Tcl.  Zero means no Tcl math is in
     * progress;  non-zero means Tcl is doing math.
     */
    
    int mathInProgress;

} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The variable below serves no useful purpose except to generate
 * a reference to matherr, so that the Tcl version of matherr is
 * linked in rather than the system version. Without this reference
 * the need for matherr won't be discovered during linking until after
 * libtcl.a has been processed, so Tcl's version won't be used.
 */

#ifdef NEED_MATHERR
extern int matherr();
int (*tclMatherrPtr)() = matherr;
#endif

/*
 * Mapping from expression instruction opcodes to strings; used for error
 * messages. Note that these entries must match the order and number of the
 * expression opcodes (e.g., INST_LOR) in tclCompile.h.
 */

static char *operatorStrings[] = {
    "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
    "+", "-", "*", "/", "%", "+", "-", "~", "!",
    "BUILTIN FUNCTION", "FUNCTION",
    "", "", "", "", "", "", "", "", "eq", "ne",
};
    
/*
 * Mapping from Tcl result codes to strings; used for error and debugging
 * messages. 
 */

#ifdef TCL_COMPILE_DEBUG
static char *resultStrings[] = {
    "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
};
#endif

/*
 * These are used by evalstats to monitor object usage in Tcl.
 */

#ifdef TCL_COMPILE_STATS
long		tclObjsAlloced = 0;
long		tclObjsFreed   = 0;
#define TCL_MAX_SHARED_OBJ_STATS 5
long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */

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

#define IS_NAN(v) ((v) != (v))
#ifdef DBL_MAX
#   define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
#else
#   define IS_INF(v) 0
#endif

/*
 * Macro to adjust the program counter and restart the instruction execution
 * loop after each instruction is executed.
 */

#define ADJUST_PC(instBytes) \
    pc += (instBytes); \
    continue

/*
 * Macros used to cache often-referenced Tcl evaluation stack information
 * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
 * pair must surround any call inside TclExecuteByteCode (and a few other
 * procedures that use this scheme) that could result in a recursive call
 * to TclExecuteByteCode.
 */

#define CACHE_STACK_INFO() \
    stackPtr = eePtr->stackPtr; \
    stackTop = eePtr->stackTop

#define DECACHE_STACK_INFO() \
    eePtr->stackTop = stackTop

/*
 * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
 * increments the object's ref count since it makes the stack have another
 * reference pointing to the object. However, POP_OBJECT does not decrement
 * the ref count. This is because the stack may hold the only reference to
 * the object, so the object would be destroyed if its ref count were
 * decremented before the caller had a chance to, e.g., store it in a
 * variable. It is the caller's responsibility to decrement the ref count
 * when it is finished with an object.
 *
 * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
 * macro. The actual parameter might be an expression with side effects,
 * and this ensures that it will be executed only once. 
 */
    
#define PUSH_OBJECT(objPtr) \
    Tcl_IncrRefCount(stackPtr[++stackTop] = (objPtr))
    
#define POP_OBJECT() \
    (stackPtr[stackTop--])

/*
 * Macros used to trace instruction execution. The macros TRACE,
 * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
 * O2S is only used in TRACE* calls to get a string from an object.
 */

#ifdef TCL_COMPILE_DEBUG
#define TRACE(a) \
    if (traceInstructions) { \
        fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
	       (unsigned int)(pc - codePtr->codeStart), \
	       GetOpcodeName(pc)); \
	printf a; \
    }
#define TRACE_WITH_OBJ(a, objPtr) \
    if (traceInstructions) { \
        fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
	       (unsigned int)(pc - codePtr->codeStart), \
	       GetOpcodeName(pc)); \
	printf a; \
        TclPrintObject(stdout, (objPtr), 30); \
        fprintf(stdout, "\n"); \
    }
#define O2S(objPtr) \
    Tcl_GetString(objPtr)
#else
#define TRACE(a)
#define TRACE_WITH_OBJ(a, objPtr)
#define O2S(objPtr)
#endif /* TCL_COMPILE_DEBUG */

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

static void		CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
			    Trace *tracePtr, Command *cmdPtr,
			    char *command, int numChars,
			    int objc, Tcl_Obj *objv[]));
static void		DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr));
static int		ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprCallMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, int objc, Tcl_Obj **objv));
static int		ExprDoubleFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprIntFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprRandFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
static int		ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
			    ExecEnv *eePtr, ClientData clientData));
#ifdef TCL_COMPILE_STATS
static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
#endif
static void		FreeCmdNameInternalRep _ANSI_ARGS_((
    			    Tcl_Obj *objPtr));
#ifdef TCL_COMPILE_DEBUG
static char *		GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
#endif
static ExceptionRange *	GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc,
			    int catchOnly, ByteCode* codePtr));
static char *		GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
        		    ByteCode* codePtr, int *lengthPtr));
static void		GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
static void		IllegalExprOperandType _ANSI_ARGS_((
			    Tcl_Interp *interp, unsigned char *pc,
			    Tcl_Obj *opndPtr));
static void		InitByteCodeExecution _ANSI_ARGS_((
			    Tcl_Interp *interp));
#ifdef TCL_COMPILE_DEBUG
static void		PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
#endif
static int		SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
#ifdef TCL_COMPILE_DEBUG
static char *		StringForResultCode _ANSI_ARGS_((int result));
static void		ValidatePcAndStackTop _ANSI_ARGS_((
			    ByteCode *codePtr, unsigned char *pc,
			    int stackTop, int stackLowerBound,
			    int stackUpperBound));
#endif
static int		VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));

/*
 * Table describing the built-in math functions. Entries in this table are
 * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
 * operand byte.
 */

BuiltinFunc builtinFuncTable[] = {
#ifndef TCL_NO_MATH
    {"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
    {"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
    {"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
    {"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
    {"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
    {"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
    {"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
    {"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
    {"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
    {"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
    {"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
    {"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
    {"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
    {"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
    {"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
    {"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
    {"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
    {"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
    {"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
#endif
    {"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
    {"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
    {"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
    {"rand", 0, {TCL_EITHER}, ExprRandFunc, 0},	/* NOTE: rand takes no args. */
    {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
    {"srand", 1, {TCL_INT}, ExprSrandFunc, 0},
    {0},
};

/*
 * The structure below defines the command name Tcl object type by means of
 * procedures that can be invoked by generic object code. Objects of this
 * type cache the Command pointer that results from looking up command names
 * in the command hashtable. Such objects appear as the zeroth ("command
 * name") argument in a Tcl command.
 */

Tcl_ObjType tclCmdNameType = {
    "cmdName",				/* name */
    FreeCmdNameInternalRep,		/* freeIntRepProc */
    DupCmdNameInternalRep,		/* dupIntRepProc */
    (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
    SetCmdNameFromAny			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * InitByteCodeExecution --
 *
 *	This procedure is called once to initialize the Tcl bytecode
 *	interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This procedure initializes the array of instruction names. If
 *	compiling with the TCL_COMPILE_STATS flag, it initializes the
 *	array that counts the executions of each instruction and it
 *	creates the "evalstats" command. It also registers the command name
 *	Tcl_ObjType. It also establishes the link between the Tcl
 *	"tcl_traceExec" and C "tclTraceExec" variables.
 *
 *----------------------------------------------------------------------
 */

static void
InitByteCodeExecution(interp)
    Tcl_Interp *interp;		/* Interpreter for which the Tcl variable
				 * "tcl_traceExec" is linked to control
				 * instruction tracing. */
{
    Tcl_RegisterObjType(&tclCmdNameType);
    if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
		    TCL_LINK_INT) != TCL_OK) {
	panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
    }

#ifdef TCL_COMPILE_STATS    
    Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
#endif /* TCL_COMPILE_STATS */
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateExecEnv --
 *
 *	This procedure creates a new execution environment for Tcl bytecode
 *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv
 *	is typically created once for each Tcl interpreter (Interp
 *	structure) and recursively passed to TclExecuteByteCode to execute
 *	ByteCode sequences for nested commands.
 *
 * Results:
 *	A newly allocated ExecEnv is returned. This points to an empty
 *	evaluation stack of the standard initial size.
 *
 * Side effects:
 *	The bytecode interpreter is also initialized here, as this
 *	procedure will be called before any call to TclExecuteByteCode.
 *
 *----------------------------------------------------------------------
 */

#define TCL_STACK_INITIAL_SIZE 2000

ExecEnv *
TclCreateExecEnv(interp)
    Tcl_Interp *interp;		/* Interpreter for which the execution
				 * environment is being created. */
{
    ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));

    eePtr->stackPtr = (Tcl_Obj **)
	ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
    eePtr->stackTop = -1;
    eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);

    Tcl_MutexLock(&execMutex);
    if (!execInitialized) {
	TclInitAuxDataTypeTable();
	InitByteCodeExecution(interp);
	execInitialized = 1;
    }
    Tcl_MutexUnlock(&execMutex);

    return eePtr;
}
#undef TCL_STACK_INITIAL_SIZE

/*
 *----------------------------------------------------------------------
 *
 * TclDeleteExecEnv --
 *
 *	Frees the storage for an ExecEnv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Storage for an ExecEnv and its contained storage (e.g. the
 *	evaluation stack) is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclDeleteExecEnv(eePtr)
    ExecEnv *eePtr;		/* Execution environment to free. */
{
    ckfree((char *) eePtr->stackPtr);
    ckfree((char *) eePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecution --
 *
 *	Finalizes the execution environment setup so that it can be
 *	later reinitialized.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	After this call, the next time TclCreateExecEnv will be called
 *	it will call InitByteCodeExecution.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeExecution()
{
    Tcl_MutexLock(&execMutex);
    execInitialized = 0;
    Tcl_MutexUnlock(&execMutex);
    TclFinalizeAuxDataTypeTable();
}

/*
 *----------------------------------------------------------------------
 *
 * GrowEvaluationStack --
 *
 *	This procedure grows a Tcl evaluation stack stored in an ExecEnv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The size of the evaluation stack is doubled.
 *
 *----------------------------------------------------------------------
 */

static void
GrowEvaluationStack(eePtr)
    register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
			      * stack to enlarge. */
{
    /*
     * The current Tcl stack elements are stored from eePtr->stackPtr[0]
     * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
     */

    int currElems = (eePtr->stackEnd + 1);
    int newElems  = 2*currElems;
    int currBytes = currElems * sizeof(Tcl_Obj *);
    int newBytes  = 2*currBytes;
    Tcl_Obj **newStackPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);

    /*
     * Copy the existing stack items to the new stack space, free the old
     * storage if appropriate, and mark new space as malloc'ed.
     */
 
    memcpy((VOID *) newStackPtr, (VOID *) eePtr->stackPtr,
	   (size_t) currBytes);
    ckfree((char *) eePtr->stackPtr);
    eePtr->stackPtr = newStackPtr;
    eePtr->stackEnd = (newElems - 1); /* i.e. index of last usable item */
}

/*
 *----------------------------------------------------------------------
 *
 * TclExecuteByteCode --
 *
 *	This procedure executes the instructions of a ByteCode structure.
 *	It returns when a "done" instruction is executed or an error occurs.
 *
 * Results:
 *	The return value is one of the return codes defined in tcl.h
 *	(such as TCL_OK), and interp->objResultPtr refers to a Tcl object
 *	that either contains the result of executing the code or an
 *	error message.
 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */

int
TclExecuteByteCode(interp, codePtr)
    Tcl_Interp *interp;		/* Token for command interpreter. */
    ByteCode *codePtr;		/* The bytecode sequence to interpret. */
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    				/* Points to the execution environment. */
    register Tcl_Obj **stackPtr = eePtr->stackPtr;
    				/* Cached evaluation stack base pointer. */
    register int stackTop = eePtr->stackTop;
    				/* Cached top index of evaluation stack. */
    register unsigned char *pc = codePtr->codeStart;
				/* The current program counter. */
    int opnd;			/* Current instruction's operand byte. */
    int pcAdjustment;		/* Hold pc adjustment after instruction. */
    int initStackTop = stackTop;/* Stack top at start of execution. */
    ExceptionRange *rangePtr;	/* Points to closest loop or catch exception
				 * range enclosing the pc. Used by various
				 * instructions and processCatch to
				 * process break, continue, and errors. */
    int result = TCL_OK;	/* Return code returned after execution. */
    int traceInstructions = (tclTraceExec == 3);
    Tcl_Obj *valuePtr, *value2Ptr, *objPtr;
    char *bytes;
    int length;
    long i;

    /*
     * This procedure uses a stack to hold information about catch commands.
     * This information is the current operand stack top when starting to
     * execute the code for each catch command. It starts out with stack-
     * allocated space but uses dynamically-allocated storage if needed.
     */

#define STATIC_CATCH_STACK_SIZE 4
    int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
    int *catchStackPtr = catchStackStorage;
    int catchTop = -1;

#ifdef TCL_COMPILE_DEBUG
    if (tclTraceExec >= 2) {
	PrintByteCodeInfo(codePtr);
	fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
	fflush(stdout);
    }
#endif
    
#ifdef TCL_COMPILE_STATS
    iPtr->stats.numExecutions++;
#endif

    /*
     * Make sure the catch stack is large enough to hold the maximum number
     * of catch commands that could ever be executing at the same time. This
     * will be no more than the exception range array's depth.
     */

    if (codePtr->maxExceptDepth > STATIC_CATCH_STACK_SIZE) {
	catchStackPtr = (int *)
	        ckalloc(codePtr->maxExceptDepth * sizeof(int));
    }

    /*
     * Make sure the stack has enough room to execute this ByteCode.
     */

    while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
        GrowEvaluationStack(eePtr); 
        stackPtr = eePtr->stackPtr;
    }

    /*
     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
     * or some error.
     */

    for (;;) {
#ifdef TCL_COMPILE_DEBUG
	ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
		eePtr->stackEnd);
#else /* not TCL_COMPILE_DEBUG */
        if (traceInstructions) {
            fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
            TclPrintInstruction(codePtr, pc);
            fflush(stdout);
        }
#endif /* TCL_COMPILE_DEBUG */
	
#ifdef TCL_COMPILE_STATS    
	iPtr->stats.instructionCount[*pc]++;
#endif
        switch (*pc) {
	case INST_DONE:
	    /*
	     * Pop the topmost object from the stack, set the interpreter's
	     * object result to point to it, and return.
	     */
	    valuePtr = POP_OBJECT();
	    Tcl_SetObjResult(interp, valuePtr);
	    TclDecrRefCount(valuePtr);
	    if (stackTop != initStackTop) {
		fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d != entry stack top %d\n",
			(unsigned int)(pc - codePtr->codeStart),
			(unsigned int) stackTop,
			(unsigned int) initStackTop);
		panic("TclExecuteByteCode execution failure: end stack top != start stack top");
	    }
	    TRACE_WITH_OBJ(("=> return code=%d, result=", result),
		    iPtr->objResultPtr);
#ifdef TCL_COMPILE_DEBUG	    
	    if (traceInstructions) {
		fprintf(stdout, "\n");
	    }
#endif
	    goto done;
	    
	case INST_PUSH1:
#ifdef TCL_COMPILE_DEBUG
	    valuePtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), valuePtr);
#else
	    PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
#endif /* TCL_COMPILE_DEBUG */
	    ADJUST_PC(2);
	    
	case INST_PUSH4:
	    valuePtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), valuePtr);
	    ADJUST_PC(5);
	    
	case INST_POP:
	    valuePtr = POP_OBJECT();
	    TRACE_WITH_OBJ(("=> discarding "), valuePtr);
	    TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
	    ADJUST_PC(1);

	case INST_DUP:
	    valuePtr = stackPtr[stackTop];
	    PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
	    TRACE_WITH_OBJ(("=> "), valuePtr);
	    ADJUST_PC(1);

	case INST_CONCAT1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    {
		Tcl_Obj *concatObjPtr;
		int totalLen = 0;

		/*
		 * Concatenate strings (with no separators) from the top
		 * opnd items on the stack starting with the deepest item.
		 * First, determine how many characters are needed.
		 */

		for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
		    bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
		    if (bytes != NULL) {
			totalLen += length;
		    }
                }

		/*
		 * Initialize the new append string object by appending the
		 * strings of the opnd stack objects. Also pop the objects. 
		 */

		TclNewObj(concatObjPtr);
		if (totalLen > 0) {
		    char *p = (char *) ckalloc((unsigned) (totalLen + 1));
		    concatObjPtr->bytes = p;
		    concatObjPtr->length = totalLen;
		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
			valuePtr = stackPtr[i];
			bytes = Tcl_GetStringFromObj(valuePtr, &length);
			if (bytes != NULL) {
			    memcpy((VOID *) p, (VOID *) bytes,
			            (size_t) length);
			    p += length;
			}
			TclDecrRefCount(valuePtr);
		    }
		    *p = '\0';
		} else {
		    for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
			Tcl_DecrRefCount(stackPtr[i]);
		    }
		}
		stackTop -= opnd;
		
		PUSH_OBJECT(concatObjPtr);
		TRACE_WITH_OBJ(("%u => ", opnd), concatObjPtr);
		ADJUST_PC(2);
            }
	    
	case INST_INVOKE_STK4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pcAdjustment = 5;
	    goto doInvocation;

	case INST_INVOKE_STK1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	    doInvocation:
	    {
		int objc = opnd; /* The number of arguments. */
		Tcl_Obj **objv;	 /* The array of argument objects. */
		Command *cmdPtr; /* Points to command's Command struct. */
		int newPcOffset; /* New inst offset for break, continue. */
#ifdef TCL_COMPILE_DEBUG
		int isUnknownCmd = 0;
		char cmdNameBuf[21];
#endif /* TCL_COMPILE_DEBUG */
		
		/*
		 * If the interpreter was deleted, return an error.
		 */
		
		if (iPtr->flags & DELETED) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		            "attempt to call eval in deleted interpreter", -1);
		    Tcl_SetErrorCode(interp, "CORE", "IDELETE",
			    "attempt to call eval in deleted interpreter",
			    (char *) NULL);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
    
		/*
		 * Find the procedure to execute this command. If the
		 * command is not found, handle it with the "unknown" proc.
		 */

		objv = &(stackPtr[stackTop - (objc-1)]);
		cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
		if (cmdPtr == NULL) {
		    cmdPtr = (Command *) Tcl_FindCommand(interp, "unknown",
                            (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY);
                    if (cmdPtr == NULL) {
			Tcl_ResetResult(interp);
			Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			        "invalid command name \"",
				Tcl_GetString(objv[0]), "\"",
				(char *) NULL);
			TRACE(("%u => unknown proc not found: ", objc));
			result = TCL_ERROR;
			goto checkForCatch;
		    }
#ifdef TCL_COMPILE_DEBUG
		    isUnknownCmd = 1;
#endif /*TCL_COMPILE_DEBUG*/			
		    stackTop++; /* need room for new inserted objv[0] */
		    for (i = objc-1;  i >= 0;  i--) {
			objv[i+1] = objv[i];
		    }
		    objc++;
		    objv[0] = Tcl_NewStringObj("unknown", -1);
		    Tcl_IncrRefCount(objv[0]);
		}
		
		/*
		 * Call any trace procedures.
		 */

		if (iPtr->tracePtr != NULL) {
		    Trace *tracePtr, *nextTracePtr;

		    for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
		            tracePtr = nextTracePtr) {
			nextTracePtr = tracePtr->nextPtr;
			if (iPtr->numLevels <= tracePtr->level) {
			    int numChars;
			    char *cmd = GetSrcInfoForPc(pc, codePtr,
				    &numChars);
			    if (cmd != NULL) {
				DECACHE_STACK_INFO();
				CallTraceProcedure(interp, tracePtr, cmdPtr,
				        cmd, numChars, objc, objv);
				CACHE_STACK_INFO();
			    }
			}
		    }
		}
		
		/*
		 * Finally, invoke the command's Tcl_ObjCmdProc. First reset
		 * the interpreter's string and object results to their
		 * default empty values since they could have gotten changed
		 * by earlier invocations.
		 */
		
		Tcl_ResetResult(interp);
		if (tclTraceExec >= 2) {
#ifdef TCL_COMPILE_DEBUG
		    if (traceInstructions) {
			strncpy(cmdNameBuf, Tcl_GetString(objv[0]), 20);
			TRACE(("%u => call ", (isUnknownCmd? objc-1:objc)));
		    } else {
			fprintf(stdout, "%d: (%u) invoking ",
			        iPtr->numLevels,
				(unsigned int)(pc - codePtr->codeStart));
		    }
		    for (i = 0;  i < objc;  i++) {
			TclPrintObject(stdout, objv[i], 15);
			fprintf(stdout, " ");
		    }
		    fprintf(stdout, "\n");
		    fflush(stdout);
#else /* TCL_COMPILE_DEBUG */
		    fprintf(stdout, "%d: (%u) invoking %s\n",
			    iPtr->numLevels,
		            (unsigned int)(pc - codePtr->codeStart),
			    Tcl_GetString(objv[0]));
#endif /*TCL_COMPILE_DEBUG*/
		}

		iPtr->cmdCount++;
		DECACHE_STACK_INFO();
		result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
					    objc, objv);
		if (Tcl_AsyncReady()) {
		    result = Tcl_AsyncInvoke(interp, result);
		}
		CACHE_STACK_INFO();

		/*
		 * If the interpreter has a non-empty string result, the
		 * result object is either empty or stale because some
		 * procedure set interp->result directly. If so, move the
		 * string result to the result object, then reset the
		 * string result.
		 */

		if (*(iPtr->result) != 0) {
		    (void) Tcl_GetObjResult(interp);
		}
		
		/*
		 * Pop the objc top stack elements and decrement their ref
		 * counts. 
		 */

		for (i = 0;  i < objc;  i++) {
		    valuePtr = stackPtr[stackTop];
		    TclDecrRefCount(valuePtr);
		    stackTop--;
		}

		/*
		 * Process the result of the Tcl_ObjCmdProc call.
		 */
		
		switch (result) {
		case TCL_OK:
		    /*
		     * Push the call's object result and continue execution
		     * with the next instruction.
		     */
		    PUSH_OBJECT(Tcl_GetObjResult(interp));
		    TRACE_WITH_OBJ(("%u => ...after \"%.20s\", result=",
		            objc, cmdNameBuf), Tcl_GetObjResult(interp));
		    ADJUST_PC(pcAdjustment);
		    
		case TCL_BREAK:
		case TCL_CONTINUE:
		    /*
		     * The invoked command requested a break or continue.
		     * Find the closest enclosing loop or catch exception
		     * range, if any. If a loop is found, terminate its
		     * execution or skip to its next iteration. If the
		     * closest is a catch exception range, jump to its
		     * catchOffset. If no enclosing range is found, stop
		     * execution and return the TCL_BREAK or TCL_CONTINUE.
		     */
		    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
			    codePtr);
		    if (rangePtr == NULL) {
		        TRACE(("%u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
		                objc, cmdNameBuf,
			        StringForResultCode(result)));
			goto abnormalReturn; /* no catch exists to check */
		    }
		    newPcOffset = 0;
		    switch (rangePtr->type) {
		    case LOOP_EXCEPTION_RANGE:
			if (result == TCL_BREAK) {
			    newPcOffset = rangePtr->breakOffset;
			} else if (rangePtr->continueOffset == -1) {
			    TRACE(("%u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
				   objc, cmdNameBuf,
				   StringForResultCode(result)));
			    goto checkForCatch;
			} else {
			    newPcOffset = rangePtr->continueOffset;
			}
			TRACE(("%u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
			       objc, cmdNameBuf,
			       StringForResultCode(result),
			       rangePtr->codeOffset, newPcOffset));
			break;
		    case CATCH_EXCEPTION_RANGE:
			TRACE(("%u => ... after \"%.20s\", %s...\n",
			       objc, cmdNameBuf,
			       StringForResultCode(result)));
			goto processCatch; /* it will use rangePtr */
		    default:
			panic("TclExecuteByteCode: bad ExceptionRange type\n");
		    }
		    result = TCL_OK;
		    pc = (codePtr->codeStart + newPcOffset);
		    continue;	/* restart outer instruction loop at pc */
		    
		case TCL_ERROR:
		    /*
		     * The invoked command returned an error. Look for an
		     * enclosing catch exception range, if any.
		     */
		    TRACE_WITH_OBJ(("%u => ... after \"%.20s\", TCL_ERROR ",
		            objc, cmdNameBuf), Tcl_GetObjResult(interp));
		    goto checkForCatch;

		case TCL_RETURN:
		    /*
		     * The invoked command requested that the current
		     * procedure stop execution and return. First check
		     * for an enclosing catch exception range, if any.
		     */
		    TRACE(("%u => ... after \"%.20s\", TCL_RETURN\n",
		            objc, cmdNameBuf));
		    goto checkForCatch;

		default:
		    TRACE_WITH_OBJ(("%u => ... after \"%.20s\", OTHER RETURN CODE %d ",
		            objc, cmdNameBuf, result),
			    Tcl_GetObjResult(interp));
		    goto checkForCatch;
		}
	    }
	    
	case INST_EVAL_STK:
	    objPtr = POP_OBJECT();
	    DECACHE_STACK_INFO();
	    result = Tcl_EvalObjEx(interp, objPtr, 0);
	    CACHE_STACK_INFO();
	    if (result == TCL_OK) {
		/*
		 * Normal return; push the eval's object result.
		 */
		PUSH_OBJECT(Tcl_GetObjResult(interp));
		TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
			Tcl_GetObjResult(interp));
		TclDecrRefCount(objPtr);
		ADJUST_PC(1);
	    } else if ((result == TCL_BREAK) || (result == TCL_CONTINUE)) {
		/*
		 * Find the closest enclosing loop or catch exception range,
		 * if any. If a loop is found, terminate its execution or
		 * skip to its next iteration. If the closest is a catch
		 * exception range, jump to its catchOffset. If no enclosing
		 * range is found, stop execution and return that same
		 * TCL_BREAK or TCL_CONTINUE.
		 */

		int newPcOffset = 0; /* Pc offset computed during break,
				      * continue, error processing. Init.
				      * to avoid compiler warning. */

		rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
			codePtr);
		if (rangePtr == NULL) {
		    TRACE(("\"%.30s\" => no encl. loop or catch, returning %s\n",
			    O2S(objPtr), StringForResultCode(result)));
		    Tcl_DecrRefCount(objPtr);
		    goto abnormalReturn;    /* no catch exists to check */
		}
		switch (rangePtr->type) {
		case LOOP_EXCEPTION_RANGE:
		    if (result == TCL_BREAK) {
			newPcOffset = rangePtr->breakOffset;
		    } else if (rangePtr->continueOffset == -1) {
			TRACE(("\"%.30s\" => %s, loop w/o continue, checking for catch\n",
			       O2S(objPtr), StringForResultCode(result)));
			Tcl_DecrRefCount(objPtr);
			goto checkForCatch;
		    } else {
			newPcOffset = rangePtr->continueOffset;
		    }
		    result = TCL_OK;
		    TRACE_WITH_OBJ(("\"%.30s\" => %s, range at %d, new pc %d ",
			    O2S(objPtr), StringForResultCode(result),
			    rangePtr->codeOffset, newPcOffset), valuePtr);
		    break;
		case CATCH_EXCEPTION_RANGE:
		    TRACE_WITH_OBJ(("\"%.30s\" => %s ",
			    O2S(objPtr), StringForResultCode(result)),
			    valuePtr);
		    Tcl_DecrRefCount(objPtr);
		    goto processCatch;  /* it will use rangePtr */
		default:
		    panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
		}
		Tcl_DecrRefCount(objPtr);
		pc = (codePtr->codeStart + newPcOffset);
		continue;	/* restart outer instruction loop at pc */
	    } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
		TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
		        Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		goto checkForCatch;
	    }

	case INST_EXPR_STK:
	    objPtr = POP_OBJECT();
	    Tcl_ResetResult(interp);
	    DECACHE_STACK_INFO();
	    result = Tcl_ExprObj(interp, objPtr, &valuePtr);
	    CACHE_STACK_INFO();
	    if (result != TCL_OK) {
		TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", 
		        O2S(objPtr)), Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		goto checkForCatch;
	    }
	    stackPtr[++stackTop] = valuePtr; /* already has right refct */
	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
	    TclDecrRefCount(objPtr);
	    ADJUST_PC(1);

	case INST_LOAD_SCALAR1:
#ifdef TCL_COMPILE_DEBUG
	    opnd = TclGetUInt1AtPtr(pc+1);
	    DECACHE_STACK_INFO();
	    valuePtr = TclGetIndexedScalar(interp, opnd,
		    /*leaveErrorMsg*/ 1);
	    CACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
		        Tcl_GetObjResult(interp));
		result = TCL_ERROR;
		goto checkForCatch;
            }
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
#else /* TCL_COMPILE_DEBUG */
	    DECACHE_STACK_INFO();
	    opnd = TclGetUInt1AtPtr(pc+1);
	    valuePtr = TclGetIndexedScalar(interp, opnd, /*leaveErrorMsg*/ 1);
	    CACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		result = TCL_ERROR;
		goto checkForCatch;
            }
	    PUSH_OBJECT(valuePtr);
#endif /* TCL_COMPILE_DEBUG */
	    ADJUST_PC(2);

	case INST_LOAD_SCALAR4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    DECACHE_STACK_INFO();
	    valuePtr = TclGetIndexedScalar(interp, opnd,
					   /*leaveErrorMsg*/ 1);
	    CACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
		        Tcl_GetObjResult(interp));
		result = TCL_ERROR;
		goto checkForCatch;
            }
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
	    ADJUST_PC(5);

	case INST_LOAD_SCALAR_STK:
	    objPtr = POP_OBJECT(); /* scalar name */
	    DECACHE_STACK_INFO();
	    valuePtr = Tcl_ObjGetVar2(interp, objPtr, NULL, TCL_LEAVE_ERR_MSG);
	    CACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
		        Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		result = TCL_ERROR;
		goto checkForCatch;
            }
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
	    TclDecrRefCount(objPtr);
	    ADJUST_PC(1);

	case INST_LOAD_ARRAY4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pcAdjustment = 5;
	    goto doLoadArray;

	case INST_LOAD_ARRAY1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	    doLoadArray:
	    {
		Tcl_Obj *elemPtr = POP_OBJECT();
		
		DECACHE_STACK_INFO();
		valuePtr = TclGetElementOfIndexedArray(interp, opnd,
	                elemPtr, /*leaveErrorMsg*/ 1);
		CACHE_STACK_INFO();
		if (valuePtr == NULL) {
		    TRACE_WITH_OBJ(("%u \"%.30s\" => ERROR: ",
			    opnd, O2S(elemPtr)), Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(elemPtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(valuePtr);
		TRACE_WITH_OBJ(("%u \"%.30s\" => ",
		        opnd, O2S(elemPtr)),valuePtr);
		TclDecrRefCount(elemPtr);
	    }
	    ADJUST_PC(pcAdjustment);

	case INST_LOAD_ARRAY_STK:
	    {
		Tcl_Obj *elemPtr = POP_OBJECT();
		
		objPtr = POP_OBJECT();	/* array name */
		DECACHE_STACK_INFO();
		valuePtr = Tcl_ObjGetVar2(interp, objPtr, elemPtr,
		        TCL_LEAVE_ERR_MSG);
		CACHE_STACK_INFO();
		if (valuePtr == NULL) {
		    TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ERROR: ",
		            O2S(objPtr), O2S(elemPtr)),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(objPtr);
		    Tcl_DecrRefCount(elemPtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(valuePtr);
		TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ",
		        O2S(objPtr), O2S(elemPtr)), valuePtr);
		TclDecrRefCount(objPtr);
		TclDecrRefCount(elemPtr);
	    }
	    ADJUST_PC(1);

	case INST_LOAD_STK:
	    objPtr = POP_OBJECT(); /* variable name */
	    DECACHE_STACK_INFO();
	    valuePtr = Tcl_ObjGetVar2(interp, objPtr, NULL, TCL_LEAVE_ERR_MSG);
	    CACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
		        O2S(objPtr)), Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(valuePtr);
	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
	    TclDecrRefCount(objPtr);
	    ADJUST_PC(1);
	    
	case INST_STORE_SCALAR4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pcAdjustment = 5;
	    goto doStoreScalar;

	case INST_STORE_SCALAR1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	  doStoreScalar:
	    valuePtr = POP_OBJECT();
	    DECACHE_STACK_INFO();
	    value2Ptr = TclSetIndexedScalar(interp, opnd, valuePtr,
	            /*leaveErrorMsg*/ 1);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ",
			opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(valuePtr);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("%u <- \"%.30s\" => ",
		    opnd, O2S(valuePtr)), value2Ptr);
	    TclDecrRefCount(valuePtr);
	    ADJUST_PC(pcAdjustment);

	case INST_STORE_SCALAR_STK:
	    valuePtr = POP_OBJECT();
	    objPtr = POP_OBJECT(); /* scalar name */
	    DECACHE_STACK_INFO();
	    value2Ptr = Tcl_ObjSetVar2(interp, objPtr, NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ",
		        O2S(objPtr), O2S(valuePtr)),
			Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		Tcl_DecrRefCount(valuePtr);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
		    O2S(objPtr), O2S(valuePtr)), value2Ptr);
	    TclDecrRefCount(objPtr);
	    TclDecrRefCount(valuePtr);
	    ADJUST_PC(1);

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

	case INST_STORE_ARRAY1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	    doStoreArray:
	    {
		Tcl_Obj *elemPtr;

		valuePtr = POP_OBJECT();
		elemPtr = POP_OBJECT();
		DECACHE_STACK_INFO();
		value2Ptr = TclSetElementOfIndexedArray(interp, opnd,
		        elemPtr, valuePtr, TCL_LEAVE_ERR_MSG);
		CACHE_STACK_INFO();
		if (value2Ptr == NULL) {
		    TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ERROR: ",
			    opnd, O2S(elemPtr), O2S(valuePtr)),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(elemPtr);
		    Tcl_DecrRefCount(valuePtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(value2Ptr);
		TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ",
		        opnd, O2S(elemPtr), O2S(valuePtr)), value2Ptr);
		TclDecrRefCount(elemPtr);
		TclDecrRefCount(valuePtr);
	    }
	    ADJUST_PC(pcAdjustment);

	case INST_STORE_ARRAY_STK:
	    {
		Tcl_Obj *elemPtr;

		valuePtr = POP_OBJECT();
		elemPtr = POP_OBJECT();
		objPtr = POP_OBJECT();	/* array name */
		DECACHE_STACK_INFO();
		value2Ptr = Tcl_ObjSetVar2(interp, objPtr, elemPtr, valuePtr,
			TCL_LEAVE_ERR_MSG);
		CACHE_STACK_INFO();
		if (value2Ptr == NULL) {
		    TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
		            O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(objPtr);
		    Tcl_DecrRefCount(elemPtr);
		    Tcl_DecrRefCount(valuePtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(value2Ptr);
		TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
		        O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
			value2Ptr);
		TclDecrRefCount(objPtr);
		TclDecrRefCount(elemPtr);
		TclDecrRefCount(valuePtr);
	    }
	    ADJUST_PC(1);

	case INST_STORE_STK:
	    valuePtr = POP_OBJECT();
	    objPtr = POP_OBJECT(); /* variable name */
	    DECACHE_STACK_INFO();
	    value2Ptr = Tcl_ObjSetVar2(interp, objPtr, NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ",
		        O2S(objPtr), O2S(valuePtr)),
			Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		Tcl_DecrRefCount(valuePtr);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
		    O2S(objPtr), O2S(valuePtr)), value2Ptr);
	    TclDecrRefCount(objPtr);
	    TclDecrRefCount(valuePtr);
	    ADJUST_PC(1);

	case INST_INCR_SCALAR1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    valuePtr = POP_OBJECT(); 
	    if (valuePtr->typePtr != &tclIntType) {
		result = tclIntType.setFromAnyProc(interp, valuePtr);
		if (result != TCL_OK) {
		    TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
		            opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(valuePtr);
		    goto checkForCatch;
		}
	    }
	    i = valuePtr->internalRep.longValue;
	    DECACHE_STACK_INFO();
	    value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("%u (by %ld) => ERROR: ", opnd, i),
			Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(valuePtr);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("%u (by %ld) => ", opnd, i), value2Ptr);
	    TclDecrRefCount(valuePtr);
	    ADJUST_PC(2);

	case INST_INCR_SCALAR_STK:
	case INST_INCR_STK:
	    valuePtr = POP_OBJECT();
	    objPtr = POP_OBJECT(); /* scalar name */
	    if (valuePtr->typePtr != &tclIntType) {
		result = tclIntType.setFromAnyProc(interp, valuePtr);
		if (result != TCL_OK) {
		    TRACE_WITH_OBJ(("\"%.30s\" (by %s) => ERROR converting increment amount to int: ",
		            O2S(objPtr), O2S(valuePtr)),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(objPtr);
		    Tcl_DecrRefCount(valuePtr);
		    goto checkForCatch;
		}
	    }
	    i = valuePtr->internalRep.longValue;
	    DECACHE_STACK_INFO();
	    value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i,
		    TCL_LEAVE_ERR_MSG);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ERROR: ",
		        O2S(objPtr), i), Tcl_GetObjResult(interp));
		Tcl_DecrRefCount(objPtr);
		Tcl_DecrRefCount(valuePtr);
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ", O2S(objPtr), i),
		    value2Ptr);
	    Tcl_DecrRefCount(objPtr);
	    Tcl_DecrRefCount(valuePtr);
	    ADJUST_PC(1);

	case INST_INCR_ARRAY1:
	    {
		Tcl_Obj *elemPtr;

		opnd = TclGetUInt1AtPtr(pc+1);
		valuePtr = POP_OBJECT();
		elemPtr = POP_OBJECT();
		if (valuePtr->typePtr != &tclIntType) {
		    result = tclIntType.setFromAnyProc(interp, valuePtr);
		    if (result != TCL_OK) {
			TRACE_WITH_OBJ(("%u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
		                opnd, O2S(elemPtr), O2S(valuePtr)),
			        Tcl_GetObjResult(interp));
			Tcl_DecrRefCount(elemPtr);
			Tcl_DecrRefCount(valuePtr);
			goto checkForCatch;
		    }
		}
		i = valuePtr->internalRep.longValue;
		DECACHE_STACK_INFO();
		value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
		        elemPtr, i);
		CACHE_STACK_INFO();
		if (value2Ptr == NULL) {
		    TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ",
		            opnd, O2S(elemPtr), i),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(elemPtr);
		    Tcl_DecrRefCount(valuePtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(value2Ptr);
		TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
	                opnd, O2S(elemPtr), i), value2Ptr);
		Tcl_DecrRefCount(elemPtr);
		Tcl_DecrRefCount(valuePtr);
	    }
	    ADJUST_PC(2);
	    
	case INST_INCR_ARRAY_STK:
	    {
		Tcl_Obj *elemPtr;

		valuePtr = POP_OBJECT();
		elemPtr = POP_OBJECT();
		objPtr = POP_OBJECT();	/* array name */
		if (valuePtr->typePtr != &tclIntType) {
		    result = tclIntType.setFromAnyProc(interp, valuePtr);
		    if (result != TCL_OK) {
		        TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
		                O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
			        Tcl_GetObjResult(interp));
			Tcl_DecrRefCount(objPtr);
			Tcl_DecrRefCount(elemPtr);
			Tcl_DecrRefCount(valuePtr);
			goto checkForCatch;
		    }
		}
		i = valuePtr->internalRep.longValue;
		DECACHE_STACK_INFO();
		value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i,
			TCL_LEAVE_ERR_MSG);
		CACHE_STACK_INFO();
		if (value2Ptr == NULL) {
		    TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ",
		            O2S(objPtr), O2S(elemPtr), i),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(objPtr);
		    Tcl_DecrRefCount(elemPtr);
		    Tcl_DecrRefCount(valuePtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(value2Ptr);
		TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
	                O2S(objPtr), O2S(elemPtr), i), value2Ptr);
		Tcl_DecrRefCount(objPtr);
		Tcl_DecrRefCount(elemPtr);
		Tcl_DecrRefCount(valuePtr);
	    }
	    ADJUST_PC(1);
	    
	case INST_INCR_SCALAR1_IMM:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    i = TclGetInt1AtPtr(pc+2);
	    DECACHE_STACK_INFO();
	    value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("%u %ld => ERROR: ", opnd, i),
			Tcl_GetObjResult(interp));
		result = TCL_ERROR;
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("%u %ld => ", opnd, i), value2Ptr);
	    ADJUST_PC(3);

	case INST_INCR_SCALAR_STK_IMM:
	case INST_INCR_STK_IMM:
	    objPtr = POP_OBJECT(); /* variable name */
	    i = TclGetInt1AtPtr(pc+1);
	    DECACHE_STACK_INFO();
	    value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i,
		    TCL_LEAVE_ERR_MSG);
	    CACHE_STACK_INFO();
	    if (value2Ptr == NULL) {
		TRACE_WITH_OBJ(("\"%.30s\" %ld => ERROR: ",
		        O2S(objPtr), i), Tcl_GetObjResult(interp));
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		goto checkForCatch;
	    }
	    PUSH_OBJECT(value2Ptr);
	    TRACE_WITH_OBJ(("\"%.30s\" %ld => ", O2S(objPtr), i),
		    value2Ptr);
	    TclDecrRefCount(objPtr);
	    ADJUST_PC(2);

	case INST_INCR_ARRAY1_IMM:
	    {
		Tcl_Obj *elemPtr;

		opnd = TclGetUInt1AtPtr(pc+1);
		i = TclGetInt1AtPtr(pc+2);
		elemPtr = POP_OBJECT();
		DECACHE_STACK_INFO();
		value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
		        elemPtr, i);
		CACHE_STACK_INFO();
		if (value2Ptr == NULL) {
		    TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ",
		            opnd, O2S(elemPtr), i),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(elemPtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(value2Ptr);
		TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
	                opnd, O2S(elemPtr), i), value2Ptr);
		Tcl_DecrRefCount(elemPtr);
	    }
	    ADJUST_PC(3);
	    
	case INST_INCR_ARRAY_STK_IMM:
	    {
		Tcl_Obj *elemPtr;

		i = TclGetInt1AtPtr(pc+1);
		elemPtr = POP_OBJECT();
		objPtr = POP_OBJECT();	/* array name */
		DECACHE_STACK_INFO();
		value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i,
			TCL_LEAVE_ERR_MSG);
		CACHE_STACK_INFO();
		if (value2Ptr == NULL) {
		    TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ",
		            O2S(objPtr), O2S(elemPtr), i),
			    Tcl_GetObjResult(interp));
		    Tcl_DecrRefCount(objPtr);
		    Tcl_DecrRefCount(elemPtr);
		    result = TCL_ERROR;
		    goto checkForCatch;
		}
		PUSH_OBJECT(value2Ptr);
		TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
	                O2S(objPtr), O2S(elemPtr), i), value2Ptr);
		Tcl_DecrRefCount(objPtr);
		Tcl_DecrRefCount(elemPtr);
	    }
	    ADJUST_PC(2);

	case INST_JUMP1:
#ifdef TCL_COMPILE_DEBUG
	    opnd = TclGetInt1AtPtr(pc+1);
	    TRACE(("%d => new pc %u\n", opnd,
		   (unsigned int)(pc + opnd - codePtr->codeStart)));
	    pc += opnd;
#else
	    pc += TclGetInt1AtPtr(pc+1);
#endif /* TCL_COMPILE_DEBUG */
	    continue;

	case INST_JUMP4:
	    opnd = TclGetInt4AtPtr(pc+1);
	    TRACE(("%d => new pc %u\n", opnd,
		   (unsigned int)(pc + opnd - codePtr->codeStart)));
	    ADJUST_PC(opnd);

	case INST_JUMP_TRUE4:
	    opnd = TclGetInt4AtPtr(pc+1);
	    pcAdjustment = 5;
	    goto doJumpTrue;

	case INST_JUMP_TRUE1:
	    opnd = TclGetInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	    doJumpTrue:
	    {
		int b;
		
		valuePtr = POP_OBJECT();
		if (valuePtr->typePtr == &tclIntType) {
		    b = (valuePtr->internalRep.longValue != 0);
		} else if (valuePtr->typePtr == &tclDoubleType) {
		    b = (valuePtr->internalRep.doubleValue != 0.0);
		} else {
		    result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
		    if (result != TCL_OK) {
			TRACE_WITH_OBJ(("%d => ERROR: ", opnd),
				Tcl_GetObjResult(interp));
			Tcl_DecrRefCount(valuePtr);
			goto checkForCatch;
		    }
		}
		if (b) {
		    TRACE(("%d => %.20s true, new pc %u\n",
			    opnd, O2S(valuePtr),
		            (unsigned int)(pc+opnd - codePtr->codeStart)));
		    TclDecrRefCount(valuePtr);
		    ADJUST_PC(opnd);
		} else {
		    TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
		    TclDecrRefCount(valuePtr);
		    ADJUST_PC(pcAdjustment);
		}
	    }
	    
	case INST_JUMP_FALSE4:
	    opnd = TclGetInt4AtPtr(pc+1);
	    pcAdjustment = 5;
	    goto doJumpFalse;

	case INST_JUMP_FALSE1:
	    opnd = TclGetInt1AtPtr(pc+1);
	    pcAdjustment = 2;
	    
	    doJumpFalse:
	    {
		int b;
		
		valuePtr = POP_OBJECT();
		if (valuePtr->typePtr == &tclIntType) {
		    b = (valuePtr->internalRep.longValue != 0);
		} else if (valuePtr->typePtr == &tclDoubleType) {
		    b = (valuePtr->internalRep.doubleValue != 0.0);
		} else {
		    result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
		    if (result != TCL_OK) {
			TRACE_WITH_OBJ(("%d => ERROR: ", opnd),
				Tcl_GetObjResult(interp));
			Tcl_DecrRefCount(valuePtr);
			goto checkForCatch;
		    }
		}
		if (b) {
		    TRACE(("%d => %.20s true\n", opnd, O2S(valuePtr)));
		    TclDecrRefCount(valuePtr);
		    ADJUST_PC(pcAdjustment);
		} else {
		    TRACE(("%d => %.20s false, new pc %u\n",
			   opnd, O2S(valuePtr),
			   (unsigned int)(pc + opnd - codePtr->codeStart)));
		    TclDecrRefCount(valuePtr);
		    ADJUST_PC(opnd);
		}
	    }
	    
	case INST_LOR:
	case INST_LAND:
	    {
		/*
		 * Operands must be boolean or numeric. No int->double
		 * conversions are performed.
		 */
		
		int i1, i2;
		int iResult;
		char *s;
		Tcl_ObjType *t1Ptr, *t2Ptr;
		
		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();
		t1Ptr = valuePtr->typePtr;
		t2Ptr = value2Ptr->typePtr;
		
		if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
		    i1 = (valuePtr->internalRep.longValue != 0);
		} else if (t1Ptr == &tclDoubleType) {
		    i1 = (valuePtr->internalRep.doubleValue != 0.0);
		} else {
		    s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
			i1 = (i != 0);
		    } else {
			result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
				valuePtr, &i1);
			i1 = (i1 != 0);
		    }
		    if (result != TCL_OK) {
			TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
			        O2S(valuePtr),
			        (t1Ptr? t1Ptr->name : "null")));
			IllegalExprOperandType(interp, pc, valuePtr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		}
		
		if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
		    i2 = (value2Ptr->internalRep.longValue != 0);
		} else if (t2Ptr == &tclDoubleType) {
		    i2 = (value2Ptr->internalRep.doubleValue != 0.0);
		} else {
		    s = Tcl_GetStringFromObj(value2Ptr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				value2Ptr, &i);
			i2 = (i != 0);
		    } else {
			result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
				value2Ptr, &i2);
		    }
		    if (result != TCL_OK) {
			TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
			        O2S(value2Ptr),
			        (t2Ptr? t2Ptr->name : "null")));
			IllegalExprOperandType(interp, pc, value2Ptr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		}
		
		/*
		 * Reuse the valuePtr object already on stack if possible.
		 */

		if (*pc == INST_LOR) {
		    iResult = (i1 || i2);
		} else {
		    iResult = (i1 && i2);
		}
		if (Tcl_IsShared(valuePtr)) {
		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
		    TRACE(("%.20s %.20s => %d\n",
			   O2S(valuePtr), O2S(value2Ptr), iResult));
		    TclDecrRefCount(valuePtr);
		} else {	/* reuse the valuePtr object */
		    TRACE(("%.20s %.20s => %d\n", 
			   O2S(valuePtr), O2S(value2Ptr), iResult));
		    Tcl_SetLongObj(valuePtr, iResult);
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		}
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);

	case INST_STR_EQ:
	case INST_STR_NEQ:
	    {
		/*
		 * String (in)equality check
		 */
		char *s1, *s2;
		int s1len, s2len, iResult;

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();

		if (valuePtr == value2Ptr) {
		    /*
		     * On the off-chance that the objects are the same,
		     * we don't really have to think hard about equality.
		     */
		    iResult = (*pc == INST_STR_EQ);
		} else {
		    s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
		    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
		    if (s1len == s2len) {
			/*
			 * We only need to check (in)equality when
			 * we have equal length strings.
			 */
			if (*pc == INST_STR_NEQ) {
			    iResult = (strcmp(s1, s2) != 0);
			} else {
			    /* INST_STR_EQ */
			    iResult = (strcmp(s1, s2) == 0);
			}
		    } else {
			iResult = (*pc == INST_STR_NEQ);
		    }
		}

		PUSH_OBJECT(Tcl_NewIntObj(iResult));
		TRACE(("%.20s %.20s => %d\n",
			O2S(valuePtr), O2S(value2Ptr), iResult));
		TclDecrRefCount(valuePtr);
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);

	case INST_STR_CMP:
	    {
		/*
		 * String compare
		 */
		char *s1, *s2;
		int s1len, s2len, iResult;

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();

		s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
		/*
		 * Compare up to the minimum byte length
		 */
		iResult = memcmp(s1, s2,
			(size_t) ((s1len < s2len) ? s1len : s2len));
		if (iResult == 0) {
		    iResult = s1len - s2len;
		} else if (iResult < 0) {
		    iResult = -1;
		} else {
		    iResult = 1;
		}

		PUSH_OBJECT(Tcl_NewIntObj(iResult));
		TRACE(("%.20s %.20s => %d\n",
			O2S(valuePtr), O2S(value2Ptr), iResult));
		TclDecrRefCount(valuePtr);
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);

       case INST_STR_LEN:
	    {
		int length1;
		 
		valuePtr = POP_OBJECT();

		if (valuePtr->typePtr == &tclByteArrayType) {
		    (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
		} else {
		    length1 = Tcl_GetCharLength(valuePtr);
		}
		PUSH_OBJECT(Tcl_NewIntObj(length1));
		TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
		TclDecrRefCount(valuePtr);
	    }
	    ADJUST_PC(1);
	    
       case INST_STR_INDEX:
	    {
		/*
		 * String compare
		 */
		int index;
		bytes = NULL; /* lint */

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();

		/*
		 * If we have a ByteArray object, avoid indexing in the
		 * Utf string since the byte array contains one byte per
		 * character.  Otherwise, use the Unicode string rep to
		 * get the index'th char.
		 */

		if (valuePtr->typePtr == &tclByteArrayType) {
		    bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
		} else {
		    /*
		     * Get Unicode char length to calulate what 'end' means.
		     */
		    length = Tcl_GetCharLength(valuePtr);
		}

		result = TclGetIntForIndex(interp, value2Ptr, length - 1,
			&index);
		if (result != TCL_OK) {
		    Tcl_DecrRefCount(value2Ptr);
		    Tcl_DecrRefCount(valuePtr);
		    goto checkForCatch;
		}

		if ((index >= 0) && (index < length)) {
		    if (valuePtr->typePtr == &tclByteArrayType) {
			objPtr = Tcl_NewByteArrayObj((unsigned char *)
				(&bytes[index]), 1);
		    } else {
			char buf[TCL_UTF_MAX];
			Tcl_UniChar ch;

			ch     = Tcl_GetUniChar(valuePtr, index);
			length = Tcl_UniCharToUtf(ch, buf);
			objPtr = Tcl_NewStringObj(buf, length);
		    }
		} else {
		    objPtr = Tcl_NewObj();
		}

		PUSH_OBJECT(objPtr);
		TRACE(("%.20s %.20s => %s\n",
			O2S(valuePtr), O2S(value2Ptr), O2S(objPtr)));
		TclDecrRefCount(valuePtr);
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);

	case INST_STR_MATCH:
	    {
		int nocase, match;

		valuePtr  = POP_OBJECT();	/* String */
		value2Ptr = POP_OBJECT();	/* Pattern */
		objPtr    = POP_OBJECT();	/* Case Sensitivity */

		Tcl_GetBooleanFromObj(interp, objPtr, &nocase);
		match = Tcl_UniCharCaseMatch(Tcl_GetUnicode(valuePtr),
			Tcl_GetUnicode(value2Ptr), nocase);

		/*
		 * Reuse the casePtr object already on stack if possible.
		 */

		TRACE(("%.20s %.20s => %d\n",
			O2S(valuePtr), O2S(value2Ptr), match));
		if (Tcl_IsShared(objPtr)) {
		    PUSH_OBJECT(Tcl_NewIntObj(match));
		    TclDecrRefCount(objPtr);
		} else {	/* reuse the valuePtr object */
		    Tcl_SetIntObj(objPtr, match);
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		}
		TclDecrRefCount(valuePtr);
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);

	case INST_EQ:
	case INST_NEQ:
	case INST_LT:
	case INST_GT:
	case INST_LE:
	case INST_GE:
	    {
		/*
		 * Any type is allowed but the two operands must have the
	         * same type. We will compute value op value2.
		 */

		Tcl_ObjType *t1Ptr, *t2Ptr;
		char *s1 = NULL;   /* Init. avoids compiler warning. */
		char *s2 = NULL;   /* Init. avoids compiler warning. */
		long i2 = 0;	   /* Init. avoids compiler warning. */
		double d1 = 0.0;   /* Init. avoids compiler warning. */
		double d2 = 0.0;   /* Init. avoids compiler warning. */
		long iResult = 0;  /* Init. avoids compiler warning. */

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();
		t1Ptr = valuePtr->typePtr;
		t2Ptr = value2Ptr->typePtr;

		/*
		 * We only want to coerce numeric validation if
		 * neither type is NULL.  A NULL type means the arg is
		 * essentially an empty object ("", {} or [list]).
		 */
		if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL))
			|| (valuePtr->bytes && (valuePtr->length == 0)))
			|| (((t2Ptr == NULL) && (value2Ptr->bytes == NULL))
				|| (value2Ptr->bytes && (value2Ptr->length == 0))))) {
		    if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
			s1 = Tcl_GetStringFromObj(valuePtr, &length);
			if (TclLooksLikeInt(s1, length)) {
			    (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				    valuePtr, &i);
			} else {
			    (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				    valuePtr, &d1);
			}
			t1Ptr = valuePtr->typePtr;
		    }
		    if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
			s2 = Tcl_GetStringFromObj(value2Ptr, &length);
			if (TclLooksLikeInt(s2, length)) {
			    (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				    value2Ptr, &i2);
			} else {
			    (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				    value2Ptr, &d2);
			}
			t2Ptr = value2Ptr->typePtr;
		    }
		}
		if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
		        || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
		    /*
		     * One operand is not numeric. Compare as strings.
		     */
		    int cmpValue;
		    s1 = Tcl_GetString(valuePtr);
		    s2 = Tcl_GetString(value2Ptr);
		    cmpValue = strcmp(s1, s2);
		    switch (*pc) {
		    case INST_EQ:
			iResult = (cmpValue == 0);
			break;
		    case INST_NEQ:
			iResult = (cmpValue != 0);
			break;
		    case INST_LT:
			iResult = (cmpValue < 0);
			break;
		    case INST_GT:
			iResult = (cmpValue > 0);
			break;
		    case INST_LE:
			iResult = (cmpValue <= 0);
			break;
		    case INST_GE:
			iResult = (cmpValue >= 0);
			break;
		    }
		} else if ((t1Ptr == &tclDoubleType)
		        || (t2Ptr == &tclDoubleType)) {
		    /*
		     * Compare as doubles.
		     */
		    if (t1Ptr == &tclDoubleType) {
			d1 = valuePtr->internalRep.doubleValue;
			if (t2Ptr == &tclIntType) {
			    d2 = value2Ptr->internalRep.longValue;
			} else {
			    d2 = value2Ptr->internalRep.doubleValue;
			}
		    } else {	/* t1Ptr is int, t2Ptr is double */
			d1 = valuePtr->internalRep.longValue;
			d2 = value2Ptr->internalRep.doubleValue;
		    }
		    switch (*pc) {
		    case INST_EQ:
			iResult = d1 == d2;
			break;
		    case INST_NEQ:
			iResult = d1 != d2;
			break;
		    case INST_LT:
			iResult = d1 < d2;
			break;
		    case INST_GT:
			iResult = d1 > d2;
			break;
		    case INST_LE:
			iResult = d1 <= d2;
			break;
		    case INST_GE:
			iResult = d1 >= d2;
			break;
		    }
		} else {
		    /*
		     * Compare as ints.
		     */
		    i  = valuePtr->internalRep.longValue;
		    i2 = value2Ptr->internalRep.longValue;
		    switch (*pc) {
		    case INST_EQ:
			iResult = i == i2;
			break;
		    case INST_NEQ:
			iResult = i != i2;
			break;
		    case INST_LT:
			iResult = i < i2;
			break;
		    case INST_GT:
			iResult = i > i2;
			break;
		    case INST_LE:
			iResult = i <= i2;
			break;
		    case INST_GE:
			iResult = i >= i2;
			break;
		    }
		}

		/*
		 * Reuse the valuePtr object already on stack if possible.
		 */
		
		if (Tcl_IsShared(valuePtr)) {
		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
		    TRACE(("%.20s %.20s => %ld\n",
			   O2S(valuePtr), O2S(value2Ptr), iResult));
		    TclDecrRefCount(valuePtr);
		} else {	/* reuse the valuePtr object */
		    TRACE(("%.20s %.20s => %ld\n",
			    O2S(valuePtr), O2S(value2Ptr), iResult));
		    Tcl_SetLongObj(valuePtr, iResult);
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		}
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);
	    
	case INST_MOD:
	case INST_LSHIFT:
	case INST_RSHIFT:
	case INST_BITOR:
	case INST_BITXOR:
	case INST_BITAND:
	    {
		/*
		 * Only integers are allowed. We compute value op value2.
		 */

		long i2, rem, negative;
		long iResult = 0; /* Init. avoids compiler warning. */
		
		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT(); 
		if (valuePtr->typePtr == &tclIntType) {
		    i = valuePtr->internalRep.longValue;
		} else {	/* try to convert to int */
		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
			    valuePtr, &i);
		    if (result != TCL_OK) {
			TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
			      O2S(valuePtr), O2S(value2Ptr),
			      (valuePtr->typePtr?
				   valuePtr->typePtr->name : "null")));
			IllegalExprOperandType(interp, pc, valuePtr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		}
		if (value2Ptr->typePtr == &tclIntType) {
		    i2 = value2Ptr->internalRep.longValue;
		} else {
		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
			    value2Ptr, &i2);
		    if (result != TCL_OK) {
			TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
			      O2S(valuePtr), O2S(value2Ptr),
			      (value2Ptr->typePtr?
				   value2Ptr->typePtr->name : "null")));
			IllegalExprOperandType(interp, pc, value2Ptr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		}

		switch (*pc) {
		case INST_MOD:
		    /*
		     * This code is tricky: C doesn't guarantee much about
		     * the quotient or remainder, but Tcl does. The
		     * remainder always has the same sign as the divisor and
		     * a smaller absolute value.
		     */
		    if (i2 == 0) {
			TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto divideByZero;
		    }
		    negative = 0;
		    if (i2 < 0) {
			i2 = -i2;
			i = -i;
			negative = 1;
		    }
		    rem  = i % i2;
		    if (rem < 0) {
			rem += i2;
		    }
		    if (negative) {
			rem = -rem;
		    }
		    iResult = rem;
		    break;
		case INST_LSHIFT:
		    iResult = i << i2;
		    break;
		case INST_RSHIFT:
		    /*
		     * The following code is a bit tricky: it ensures that
		     * right shifts propagate the sign bit even on machines
		     * where ">>" won't do it by default.
		     */
		    if (i < 0) {
			iResult = ~((~i) >> i2);
		    } else {
			iResult = i >> i2;
		    }
		    break;
		case INST_BITOR:
		    iResult = i | i2;
		    break;
		case INST_BITXOR:
		    iResult = i ^ i2;
		    break;
		case INST_BITAND:
		    iResult = i & i2;
		    break;
		}

		/*
		 * Reuse the valuePtr object already on stack if possible.
		 */
		
		if (Tcl_IsShared(valuePtr)) {
		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
		    TRACE(("%ld %ld => %ld\n", i, i2, iResult));
		    TclDecrRefCount(valuePtr);
		} else {	/* reuse the valuePtr object */
		    TRACE(("%ld %ld => %ld\n", i, i2, iResult));
		    Tcl_SetLongObj(valuePtr, iResult);
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		}
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);
	    
	case INST_ADD:
	case INST_SUB:
	case INST_MULT:
	case INST_DIV:
	    {
		/*
		 * Operands must be numeric and ints get converted to floats
		 * if necessary. We compute value op value2.
		 */

		Tcl_ObjType *t1Ptr, *t2Ptr;
		long i2, quot, rem;
		double d1, d2;
		long iResult = 0;     /* Init. avoids compiler warning. */
		double dResult = 0.0; /* Init. avoids compiler warning. */
		int doDouble = 0;     /* 1 if doing floating arithmetic */
		
		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();
		t1Ptr = valuePtr->typePtr;
		t2Ptr = value2Ptr->typePtr;
		
		if (t1Ptr == &tclIntType) {
		    i  = valuePtr->internalRep.longValue;
		} else if ((t1Ptr == &tclDoubleType)
			&& (valuePtr->bytes == NULL)) {
		    /*
		     * We can only use the internal rep directly if there is
		     * no string rep.  Otherwise the string rep might actually
		     * look like an integer, which is preferred.
		     */

		    d1 = valuePtr->internalRep.doubleValue;
		} else {
		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d1);
		    }
		    if (result != TCL_OK) {
			TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
			       s, O2S(valuePtr),
			       (valuePtr->typePtr?
				    valuePtr->typePtr->name : "null")));
			IllegalExprOperandType(interp, pc, valuePtr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		    t1Ptr = valuePtr->typePtr;
		}
		
		if (t2Ptr == &tclIntType) {
		    i2 = value2Ptr->internalRep.longValue;
		} else if ((t2Ptr == &tclDoubleType)
			&& (value2Ptr->bytes == NULL)) {
		    /*
		     * We can only use the internal rep directly if there is
		     * no string rep.  Otherwise the string rep might actually
		     * look like an integer, which is preferred.
		     */

		    d2 = value2Ptr->internalRep.doubleValue;
		} else {
		    char *s = Tcl_GetStringFromObj(value2Ptr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				value2Ptr, &i2);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				value2Ptr, &d2);
		    }
		    if (result != TCL_OK) {
			TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
			       O2S(value2Ptr), s,
			       (value2Ptr->typePtr?
				    value2Ptr->typePtr->name : "null")));
			IllegalExprOperandType(interp, pc, value2Ptr);
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		    t2Ptr = value2Ptr->typePtr;
		}

		if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
		    /*
		     * Do double arithmetic.
		     */
		    doDouble = 1;
		    if (t1Ptr == &tclIntType) {
			d1 = i;       /* promote value 1 to double */
		    } else if (t2Ptr == &tclIntType) {
			d2 = i2;      /* promote value 2 to double */
		    }
		    switch (*pc) {
		    case INST_ADD:
			dResult = d1 + d2;
			break;
		    case INST_SUB:
			dResult = d1 - d2;
			break;
		    case INST_MULT:
			dResult = d1 * d2;
			break;
		    case INST_DIV:
			if (d2 == 0.0) {
			    TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
			    Tcl_DecrRefCount(valuePtr);
			    Tcl_DecrRefCount(value2Ptr);
			    goto divideByZero;
			}
			dResult = d1 / d2;
			break;
		    }
		    
		    /*
		     * Check now for IEEE floating-point error.
		     */
		    
		    if (IS_NAN(dResult) || IS_INF(dResult)) {
			TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
			       O2S(valuePtr), O2S(value2Ptr)));
			TclExprFloatError(interp, dResult);
			result = TCL_ERROR;
			Tcl_DecrRefCount(valuePtr);
			Tcl_DecrRefCount(value2Ptr);
			goto checkForCatch;
		    }
		} else {
		    /*
		     * Do integer arithmetic.
		     */
		    switch (*pc) {
		    case INST_ADD:
			iResult = i + i2;
			break;
		    case INST_SUB:
			iResult = i - i2;
			break;
		    case INST_MULT:
			iResult = i * i2;
			break;
		    case INST_DIV:
			/*
			 * This code is tricky: C doesn't guarantee much
			 * about the quotient or remainder, but Tcl does.
			 * The remainder always has the same sign as the
			 * divisor and a smaller absolute value.
			 */
			if (i2 == 0) {
			    TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
			    Tcl_DecrRefCount(valuePtr);
			    Tcl_DecrRefCount(value2Ptr);
			    goto divideByZero;
			}
			if (i2 < 0) {
			    i2 = -i2;
			    i = -i;
			}
			quot = i / i2;
			rem  = i % i2;
			if (rem < 0) {
			    quot -= 1;
			}
			iResult = quot;
			break;
		    }
		}

		/*
		 * Reuse the valuePtr object already on stack if possible.
		 */
		
		if (Tcl_IsShared(valuePtr)) {
		    if (doDouble) {
			PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
			TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
		    } else {
			PUSH_OBJECT(Tcl_NewLongObj(iResult));
			TRACE(("%ld %ld => %ld\n", i, i2, iResult));
		    } 
		    TclDecrRefCount(valuePtr);
		} else {	    /* reuse the valuePtr object */
		    if (doDouble) { /* NB: stack top is off by 1 */
			TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
			Tcl_SetDoubleObj(valuePtr, dResult);
		    } else {
			TRACE(("%ld %ld => %ld\n", i, i2, iResult));
			Tcl_SetLongObj(valuePtr, iResult);
		    }
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		}
		TclDecrRefCount(value2Ptr);
	    }
	    ADJUST_PC(1);
	    
	case INST_UPLUS:
	    {
	        /*
	         * Operand must be numeric.
	         */

		double d;
		Tcl_ObjType *tPtr;
		
		valuePtr = stackPtr[stackTop];
		tPtr = valuePtr->typePtr;
		if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
			|| (valuePtr->bytes != NULL))) {
		    char *s = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s, length)) {
			result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d);
		    }
		    if (result != TCL_OK) { 
			TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
			        s, (tPtr? tPtr->name : "null")));
			IllegalExprOperandType(interp, pc, valuePtr);
			goto checkForCatch;
		    }
		    tPtr = valuePtr->typePtr;
		}

		/*
		 * Ensure that the operand's string rep is the same as the
		 * formatted version of its internal rep. This makes sure
		 * that "expr +000123" yields "83", not "000123". We
		 * implement this by _discarding_ the string rep since we
		 * know it will be regenerated, if needed later, by
		 * formatting the internal rep's value.
		 */

		if (Tcl_IsShared(valuePtr)) {
		    if (tPtr == &tclIntType) {
			i = valuePtr->internalRep.longValue;
			objPtr = Tcl_NewLongObj(i);
		    } else {
			d = valuePtr->internalRep.doubleValue;
			objPtr = Tcl_NewDoubleObj(d);
		    }
		    Tcl_IncrRefCount(objPtr);
		    Tcl_DecrRefCount(valuePtr);
		    valuePtr = objPtr;
		    stackPtr[stackTop] = valuePtr;
		} else {
		    Tcl_InvalidateStringRep(valuePtr);
		}
		TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
	    }
	    ADJUST_PC(1);
	    
	case INST_UMINUS:
	case INST_LNOT:
	    {
		/*
		 * The operand must be numeric. If the operand object is
		 * unshared modify it directly, otherwise create a copy to
		 * modify: this is "copy on write". free any old string
		 * representation since it is now invalid.
		 */
		
		double d;
		int boolvar;
		Tcl_ObjType *tPtr;
		
		valuePtr = POP_OBJECT();
		tPtr = valuePtr->typePtr;
		if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
			|| (valuePtr->bytes != NULL))) {
		    if ((tPtr == &tclBooleanType) 
			    && (valuePtr->bytes == NULL)) {
			valuePtr->typePtr = &tclIntType;
		    } else {
			char *s = Tcl_GetStringFromObj(valuePtr, &length);
			if (TclLooksLikeInt(s, length)) {
			    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				    valuePtr, &i);
			} else {
			    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				    valuePtr, &d);
			}
			if (result == TCL_ERROR && *pc == INST_LNOT) {
			    result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL,
				    valuePtr, &boolvar);
			    i = (long)boolvar; /* i is long, not int! */
			}
			if (result != TCL_OK) {
			    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
				    s, (tPtr? tPtr->name : "null")));
			    IllegalExprOperandType(interp, pc, valuePtr);
			    Tcl_DecrRefCount(valuePtr);
			    goto checkForCatch;
			}
		    }
		    tPtr = valuePtr->typePtr;
		}
		
		if (Tcl_IsShared(valuePtr)) {
		    /*
		     * Create a new object.
		     */
		    if (tPtr == &tclIntType) {
			i = valuePtr->internalRep.longValue;
			objPtr = Tcl_NewLongObj(
			        (*pc == INST_UMINUS)? -i : !i);
			TRACE_WITH_OBJ(("%ld => ", i), objPtr);
		    } else {
			d = valuePtr->internalRep.doubleValue;
			if (*pc == INST_UMINUS) {
			    objPtr = Tcl_NewDoubleObj(-d);
			} else {
			    /*
			     * Should be able to use "!d", but apparently
			     * some compilers can't handle it.
			     */
			    objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
			}
			TRACE_WITH_OBJ(("%.6g => ", d), objPtr);
		    }
		    PUSH_OBJECT(objPtr);
		    TclDecrRefCount(valuePtr);
		} else {
		    /*
		     * valuePtr is unshared. Modify it directly.
		     */
		    if (tPtr == &tclIntType) {
			i = valuePtr->internalRep.longValue;
			Tcl_SetLongObj(valuePtr,
			        (*pc == INST_UMINUS)? -i : !i);
			TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
		    } else {
			d = valuePtr->internalRep.doubleValue;
			if (*pc == INST_UMINUS) {
			    Tcl_SetDoubleObj(valuePtr, -d);
			} else {
			    /*
			     * Should be able to use "!d", but apparently
			     * some compilers can't handle it.
			     */
			    Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
			}
			TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
		    }
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		}
	    }
	    ADJUST_PC(1);
	    
	case INST_BITNOT:
	    {
		/*
		 * The operand must be an integer. If the operand object is
		 * unshared modify it directly, otherwise modify a copy. 
		 * Free any old string representation since it is now
		 * invalid.
		 */
		
		Tcl_ObjType *tPtr;
		
		valuePtr = POP_OBJECT();
		tPtr = valuePtr->typePtr;
		if (tPtr != &tclIntType) {
		    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
			    valuePtr, &i);
		    if (result != TCL_OK) {   /* try to convert to double */
			TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
			       O2S(valuePtr), (tPtr? tPtr->name : "null")));
			IllegalExprOperandType(interp, pc, valuePtr);
			Tcl_DecrRefCount(valuePtr);
			goto checkForCatch;
		    }
		}
		
		i = valuePtr->internalRep.longValue;
		if (Tcl_IsShared(valuePtr)) {
		    PUSH_OBJECT(Tcl_NewLongObj(~i));
		    TRACE(("0x%lx => (%lu)\n", i, ~i));
		    TclDecrRefCount(valuePtr);
		} else {
		    /*
		     * valuePtr is unshared. Modify it directly.
		     */
		    Tcl_SetLongObj(valuePtr, ~i);
		    ++stackTop; /* valuePtr now on stk top has right r.c. */
		    TRACE(("0x%lx => (%lu)\n", i, ~i));
		}
	    }
	    ADJUST_PC(1);
	    
	case INST_CALL_BUILTIN_FUNC1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    {
		/*
		 * Call one of the built-in Tcl math functions.
		 */

		BuiltinFunc *mathFuncPtr;
		ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

		if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
		    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
		    panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
		}
		mathFuncPtr = &(builtinFuncTable[opnd]);
		DECACHE_STACK_INFO();
		tsdPtr->mathInProgress++;
		result = (*mathFuncPtr->proc)(interp, eePtr,
		        mathFuncPtr->clientData);
		tsdPtr->mathInProgress--;
		CACHE_STACK_INFO();
		if (result != TCL_OK) {
		    goto checkForCatch;
		}
		TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
	    }
	    ADJUST_PC(2);
		    
	case INST_CALL_FUNC1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    {
		/*
		 * Call a non-builtin Tcl math function previously
		 * registered by a call to Tcl_CreateMathFunc.
		 */
		
		int objc = opnd;   /* Number of arguments. The function name
				    * is the 0-th argument. */
		Tcl_Obj **objv;	   /* The array of arguments. The function
				    * name is objv[0]. */
		ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

		objv = &(stackPtr[stackTop - (objc-1)]); /* "objv[0]" */
		DECACHE_STACK_INFO();
		tsdPtr->mathInProgress++;
		result = ExprCallMathFunc(interp, eePtr, objc, objv);
		tsdPtr->mathInProgress--;
		CACHE_STACK_INFO();
		if (result != TCL_OK) {
		    goto checkForCatch;
		}
		TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
		ADJUST_PC(2);
	    }

	case INST_TRY_CVT_TO_NUMERIC:
	    {
		/*
		 * Try to convert the topmost stack object to an int or
		 * double object. This is done in order to support Tcl's
		 * policy of interpreting operands if at all possible as
		 * first integers, else floating-point numbers.
		 */
		
		double d;
		char *s;
		Tcl_ObjType *tPtr;
		int converted, shared;

		valuePtr = stackPtr[stackTop];
		tPtr = valuePtr->typePtr;
		converted = 0;
		if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
			|| (valuePtr->bytes != NULL))) {
		    if ((tPtr == &tclBooleanType) 
			    && (valuePtr->bytes == NULL)) {
			valuePtr->typePtr = &tclIntType;
			converted = 1;
		    } else {
			s = Tcl_GetStringFromObj(valuePtr, &length);
			if (TclLooksLikeInt(s, length)) {
			    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				    valuePtr, &i);
			} else {
			    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				    valuePtr, &d);
			}
			if (result == TCL_OK) {
			    converted = 1;
                       }
			result = TCL_OK; /* reset the result variable */
		    }
		    tPtr = valuePtr->typePtr;
		}

		/*
		 * Ensure that the topmost stack object, if numeric, 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
		 * regenerated, if needed later, by formatting the internal
		 * rep's value. Also check if there has been an IEEE
		 * floating point error.
		 */

		if ((tPtr == &tclIntType) || (tPtr == &tclDoubleType)) {
		    shared = 0;
		    if (Tcl_IsShared(valuePtr)) {
			shared = 1;
			if (valuePtr->bytes != NULL) {
			    /*
			     * We only need to make a copy of the object
			     * when it already had a string rep
			     */
			    if (tPtr == &tclIntType) {
				i = valuePtr->internalRep.longValue;
				objPtr = Tcl_NewLongObj(i);
			    } else {
				d = valuePtr->internalRep.doubleValue;
				objPtr = Tcl_NewDoubleObj(d);
			    }
			    Tcl_IncrRefCount(objPtr);
			    TclDecrRefCount(valuePtr);
			    valuePtr = objPtr;
			    stackPtr[stackTop] = valuePtr;
			    tPtr = valuePtr->typePtr;
			}
		    } else {
			Tcl_InvalidateStringRep(valuePtr);
		    }
		
		    if (tPtr == &tclDoubleType) {
			d = valuePtr->internalRep.doubleValue;
			if (IS_NAN(d) || IS_INF(d)) {
			    TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			           O2S(valuePtr)));
			    TclExprFloatError(interp, d);
			    result = TCL_ERROR;
			    goto checkForCatch;
			}
		    }
		    shared = shared;        /* lint, shared not used. */
		    converted = converted;  /* lint, converted not used. */
		    TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
			   (converted? "converted" : "not converted"),
			   (shared? "shared" : "not shared")));
		} else {
		    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
		}
	    }
	    ADJUST_PC(1);

	case INST_BREAK:
	    /*
	     * First reset the interpreter's result. Then find the closest
	     * enclosing loop or catch exception range, if any. If a loop is
	     * found, terminate its execution. If the closest is a catch
	     * exception range, jump to its catchOffset. If no enclosing
	     * range is found, stop execution and return TCL_BREAK.
	     */

	    Tcl_ResetResult(interp);
	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
	    if (rangePtr == NULL) {
		TRACE(("=> no encl. loop or catch, returning TCL_BREAK\n"));
		result = TCL_BREAK;
		goto abnormalReturn; /* no catch exists to check */
	    }
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		result = TCL_OK;
		TRACE(("=> range at %d, new pc %d\n",
		       rangePtr->codeOffset, rangePtr->breakOffset));
		break;
	    case CATCH_EXCEPTION_RANGE:
		result = TCL_BREAK;
		TRACE(("=> ...\n"));
		goto processCatch; /* it will use rangePtr */
	    default:
		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
	    }
	    pc = (codePtr->codeStart + rangePtr->breakOffset);
	    continue;	/* restart outer instruction loop at pc */

	case INST_CONTINUE:
            /*
	     * Find the closest enclosing loop or catch exception range,
	     * if any. If a loop is found, skip to its next iteration.
	     * If the closest is a catch exception range, jump to its
	     * catchOffset. If no enclosing range is found, stop
	     * execution and return TCL_CONTINUE.
	     */

	    Tcl_ResetResult(interp);
	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
	    if (rangePtr == NULL) {
		TRACE(("=> no encl. loop or catch, returning TCL_CONTINUE\n"));
		result = TCL_CONTINUE;
		goto abnormalReturn;
	    }
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		if (rangePtr->continueOffset == -1) {
		    TRACE(("=> loop w/o continue, checking for catch\n"));
		    goto checkForCatch;
		} else {
		    result = TCL_OK;
		    TRACE(("=> range at %d, new pc %d\n",
			   rangePtr->codeOffset, rangePtr->continueOffset));
		}
		break;
	    case CATCH_EXCEPTION_RANGE:
		result = TCL_CONTINUE;
		TRACE(("=> ...\n"));
		goto processCatch; /* it will use rangePtr */
	    default:
		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
	    }
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    continue;	/* restart outer instruction loop at pc */

	case INST_FOREACH_START4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    {
	        /*
		 * Initialize the temporary local var that holds the count
		 * of the number of iterations of the loop body to -1.
		 */

		ForeachInfo *infoPtr = (ForeachInfo *)
		    codePtr->auxDataArrayPtr[opnd].clientData;
		int iterTmpIndex = infoPtr->loopCtTemp;
		Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
		Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
		Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;

		if (oldValuePtr == NULL) {
		    iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
		    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
		} else {
		    Tcl_SetLongObj(oldValuePtr, -1);
		}
		TclSetVarScalar(iterVarPtr);
		TclClearVarUndefined(iterVarPtr);
		TRACE(("%u => loop iter count temp %d\n", 
		        opnd, iterTmpIndex));
	    }
	    ADJUST_PC(5);
	
	case INST_FOREACH_STEP4:
	    opnd = TclGetUInt4AtPtr(pc+1);
	    {
	        /*
		 * "Step" a foreach loop (i.e., begin its next iteration) by
		 * assigning the next value list element to each loop var.
		 */

		ForeachInfo *infoPtr = (ForeachInfo *)
		        codePtr->auxDataArrayPtr[opnd].clientData;
		ForeachVarList *varListPtr;
		int numLists = infoPtr->numLists;
		Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
		Tcl_Obj *listPtr;
		List *listRepPtr;
		Var *iterVarPtr, *listVarPtr;
		int iterNum, listTmpIndex, listLen, numVars;
		int varIndex, valIndex, continueLoop, j;

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

		iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
		valuePtr = iterVarPtr->value.objPtr;
		iterNum = (valuePtr->internalRep.longValue + 1);
		Tcl_SetLongObj(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 = &(compiledLocals[listTmpIndex]);
		    listPtr = listVarPtr->value.objPtr;
		    result = Tcl_ListObjLength(interp, listPtr, &listLen);
		    if (result != TCL_OK) {
			TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
			        opnd, i, O2S(listPtr)),
				Tcl_GetObjResult(interp));
			goto checkForCatch;
		    }
		    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.
		 */
		
		if (continueLoop) {
		    listTmpIndex = infoPtr->firstValueTemp;
		    for (i = 0;  i < numLists;  i++) {
			varListPtr = infoPtr->varLists[i];
			numVars = varListPtr->numVars;

			listVarPtr = &(compiledLocals[listTmpIndex]);
			listPtr = listVarPtr->value.objPtr;
			listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
			listLen = listRepPtr->elemCount;
			
			valIndex = (iterNum * numVars);
			for (j = 0;  j < numVars;  j++) {
			    int setEmptyStr = 0;
			    if (valIndex >= listLen) {
				setEmptyStr = 1;
				valuePtr = Tcl_NewObj();
			    } else {
				valuePtr = listRepPtr->elements[valIndex];
			    }
			    
			    varIndex = varListPtr->varIndexes[j];
			    DECACHE_STACK_INFO();
			    value2Ptr = TclSetIndexedScalar(interp,
			           varIndex, valuePtr, /*leaveErrorMsg*/ 1);
			    CACHE_STACK_INFO();
			    if (value2Ptr == NULL) {
				TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
				       opnd, varIndex),
				       Tcl_GetObjResult(interp));
				if (setEmptyStr) {
				    Tcl_DecrRefCount(valuePtr);
				}
				result = TCL_ERROR;
				goto checkForCatch;
			    }
			    valIndex++;
			}
			listTmpIndex++;
		    }
		}
		
		/*
		 * Push 1 if at least one value list had a remaining element
		 * and the loop should continue. Otherwise push 0.
		 */

		PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
		TRACE(("%u => %d lists, iter %d, %s loop\n", 
		        opnd, numLists, iterNum,
		        (continueLoop? "continue" : "exit")));
	    }
	    ADJUST_PC(5);

	case INST_BEGIN_CATCH4:
	    /*
	     * Record start of the catch command with exception range index
	     * equal to the operand. Push the current stack depth onto the
	     * special catch stack.
	     */
	    catchStackPtr[++catchTop] = stackTop;
	    TRACE(("%u => catchTop=%d, stackTop=%d\n",
		    TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
	    ADJUST_PC(5);

	case INST_END_CATCH:
	    catchTop--;
	    result = TCL_OK;
	    TRACE(("=> catchTop=%d\n", catchTop));
	    ADJUST_PC(1);

	case INST_PUSH_RESULT:
	    PUSH_OBJECT(Tcl_GetObjResult(interp));
	    TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
	    ADJUST_PC(1);

	case INST_PUSH_RETURN_CODE:
	    PUSH_OBJECT(Tcl_NewLongObj(result));
	    TRACE(("=> %u\n", result));
	    ADJUST_PC(1);

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

	/*
	 * Division by zero in an expression. Control only reaches this
	 * point by "goto divideByZero".
	 */
	
        divideByZero:
	Tcl_ResetResult(interp);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
			 (char *) NULL);
	result = 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.
	 */
	
        checkForCatch:
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
	    if (bytes != NULL) {
		Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
        }
	rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
	if (rangePtr == NULL) {
#ifdef TCL_COMPILE_DEBUG
	    if (traceInstructions) {
		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
		        StringForResultCode(result));
	    }
#endif
	    goto abnormalReturn;
	}

	/*
	 * A catch exception range (rangePtr) was found to handle an
	 * "exception". It was found either by checkForCatch just above or
	 * by an instruction during break, continue, or error processing.
	 * Jump to its catchOffset after unwinding the operand stack to
	 * the depth it had when starting to execute the range's catch
	 * command.
	 */

        processCatch:
	while (stackTop > catchStackPtr[catchTop]) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
	        rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
	        (unsigned int)(rangePtr->catchOffset));
	}
#endif	
	pc = (codePtr->codeStart + rangePtr->catchOffset);
	continue;		/* restart the execution loop at pc */
    } /* end of infinite loop dispatching on instructions */

    /*
     * Abnormal return code. Restore the stack to state it had when starting
     * to execute the ByteCode.
     */

    abnormalReturn:
    while (stackTop > initStackTop) {
	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr);
    }

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

    done:
    if (catchStackPtr != catchStackStorage) {
	ckfree((char *) catchStackPtr);
    }
    eePtr->stackTop = initStackTop;
    return result;
#undef STATIC_CATCH_STACK_SIZE
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * PrintByteCodeInfo --
 *
 *	This procedure prints a summary about a bytecode object to stdout.
 *	It is called by TclExecuteByteCode when starting to execute the
 *	bytecode object if tclTraceExec has the value 2 or more.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PrintByteCodeInfo(codePtr)
    register ByteCode *codePtr;	/* The bytecode whose summary is printed
				 * to stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;

    fprintf(stdout, "\nExecuting ByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
	    (unsigned int) codePtr, codePtr->refCount,
	    codePtr->compileEpoch, (unsigned int) iPtr,
	    iPtr->compileEpoch);
    
    fprintf(stdout, "  Source: ");
    TclPrintSource(stdout, codePtr->source, 60);

    fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
            codePtr->numCommands, codePtr->numSrcBytes,
	    codePtr->numCodeBytes, codePtr->numLitObjects,
	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    (codePtr->numSrcBytes?
	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
#else
	    0.0);
#endif
#ifdef TCL_COMPILE_STATS
    fprintf(stdout, "  Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
	    codePtr->structureSize,
	    (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
	    codePtr->numCodeBytes,
	    (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (codePtr->numExceptRanges * sizeof(ExceptionRange)),
	    (codePtr->numAuxDataItems * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
    if (procPtr != NULL) {
	fprintf(stdout,
		"  Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
		(unsigned int) procPtr, procPtr->refCount,
		procPtr->numArgs, procPtr->numCompiledLocals);
    }
}
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * ValidatePcAndStackTop --
 *
 *	This procedure is called by TclExecuteByteCode when debugging to
 *	verify that the program counter and stack top are valid during
 *	execution.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Prints a message to stderr and panics if either the pc or stack
 *	top are invalid.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
        stackUpperBound)
    register ByteCode *codePtr; /* The bytecode whose summary is printed
				 * to stdout. */
    unsigned char *pc;		/* Points to first byte of a bytecode
				 * instruction. The program counter. */
    int stackTop;		/* Current stack top. Must be between
				 * stackLowerBound and stackUpperBound
				 * (inclusive). */
    int stackLowerBound;	/* Smallest legal value for stackTop. */
    int stackUpperBound;	/* Greatest legal value for stackTop. */
{
    unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
    unsigned int codeStart = (unsigned int) codePtr->codeStart;
    unsigned int codeEnd = (unsigned int)
	    (codePtr->codeStart + codePtr->numCodeBytes);
    unsigned char opCode = *pc;

    if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
	fprintf(stderr, "\nBad instruction pc 0x%x in TclExecuteByteCode\n",
		(unsigned int) pc);
	panic("TclExecuteByteCode execution failure: bad pc");
    }
    if ((unsigned int) opCode > LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
		(unsigned int) opCode, relativePc);
	panic("TclExecuteByteCode execution failure: bad opcode");
    }
    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
	int numChars;
	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
	char *ellipsis = "";
	
	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode",
		stackTop, relativePc);
	if (cmd != NULL) {
	    if (numChars > 100) {
		numChars = 100;
		ellipsis = "...";
	    }
	    fprintf(stderr, "\n executing %.*s%s\n", numChars, cmd,
		    ellipsis);
	} else {
	    fprintf(stderr, "\n");
	}
	panic("TclExecuteByteCode execution failure: bad stack top");
    }
}
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * IllegalExprOperandType --
 *
 *	Used by TclExecuteByteCode to add an error message to errorInfo
 *	when an illegal operand type is detected by an expression
 *	instruction. The argument opndPtr holds the operand object in error.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	An error message is appended to errorInfo.
 *
 *----------------------------------------------------------------------
 */

static void
IllegalExprOperandType(interp, pc, opndPtr)
    Tcl_Interp *interp;		/* Interpreter to which error information
				 * pertains. */
    unsigned char *pc;		/* Points to the instruction being executed
				 * when the illegal type was found. */
    Tcl_Obj *opndPtr;		/* Points to the operand holding the value
				 * with the illegal type. */
{
    unsigned char opCode = *pc;
    
    Tcl_ResetResult(interp);
    if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"can't use empty string as operand of \"",
		operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
    } else {
	char *msg = "non-numeric string";
	if (opndPtr->typePtr != &tclDoubleType) {
	    /*
	     * See if the operand can be interpreted as a double in order to
	     * improve the error message.
	     */

	    char *s = Tcl_GetString(opndPtr);
	    double d;

	    if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) {
		/*
		 * Make sure that what appears to be a double
		 * (ie 08) isn't really a bad octal
		 */
		if (TclCheckBadOctal(NULL, Tcl_GetString(opndPtr))) {
		    msg = "invalid octal number";
		} else {
		    msg = "floating-point value";
		}
	    }
	}
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
		msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
		"\"", (char *) NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CallTraceProcedure --
 *
 *	Invokes a trace procedure registered with an interpreter. These
 *	procedures trace command execution. Currently this trace procedure
 *	is called with the address of the string-based Tcl_CmdProc for the
 *	command, not the Tcl_ObjCmdProc.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Those side effects made by the trace procedure.
 *
 *----------------------------------------------------------------------
 */

static void
CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
    Tcl_Interp *interp;		/* The current interpreter. */
    register Trace *tracePtr;	/* Describes the trace procedure to call. */
    Command *cmdPtr;		/* Points to command's Command struct. */
    char *command;		/* Points to the first character of the
				 * command's source before substitutions. */
    int numChars;		/* The number of characters in the
				 * command's source. */
    register int objc;		/* Number of arguments for the command. */
    Tcl_Obj *objv[];		/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    register char **argv;
    register int i;
    int length;
    char *p;

    /*
     * Get the string rep from the objv argument objects and place their
     * pointers in argv. First make sure argv is large enough to hold the
     * objc args plus 1 extra word for the zero end-of-argv word.
     */
    
    argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
    for (i = 0;  i < objc;  i++) {
	argv[i] = Tcl_GetStringFromObj(objv[i], &length);
    }
    argv[objc] = 0;

    /*
     * Copy the command characters into a new string.
     */

    p = (char *) ckalloc((unsigned) (numChars + 1));
    memcpy((VOID *) p, (VOID *) command, (size_t) numChars);
    p[numChars] = '\0';
    
    /*
     * Call the trace procedure then free allocated storage.
     */
    
    (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
                      p, cmdPtr->proc, cmdPtr->clientData, objc, argv);

    ckfree((char *) argv);
    ckfree((char *) p);
}

/*
 *----------------------------------------------------------------------
 *
 * GetSrcInfoForPc --
 *
 *	Given a program counter value, finds the closest command in the
 *	bytecode code unit's CmdLocation array and returns information about
 *	that command's source: a pointer to its first byte and the number of
 *	characters.
 *
 * Results:
 *	If a command is found that encloses the program counter value, a
 *	pointer to the command's source is returned and the length of the
 *	source is stored at *lengthPtr. If multiple commands resulted in
 *	code at pc, information about the closest enclosing command is
 *	returned. If no matching command is found, NULL is returned and
 *	*lengthPtr is unchanged.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
GetSrcInfoForPc(pc, codePtr, lengthPtr)
    unsigned char *pc;		/* The program counter value for which to
				 * return the closest command's source info.
				 * This points to a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr;		/* The bytecode sequence in which to look
				 * up the command source for the pc. */
    int *lengthPtr;		/* If non-NULL, the location where the
				 * length of the command's source should be
				 * stored. If NULL, no length is stored. */
{
    register int pcOffset = (pc - codePtr->codeStart);
    int numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */

    if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
	return NULL;
    }

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

    codeDeltaNext = codePtr->codeDeltaStart;
    codeLengthNext = codePtr->codeLengthStart;
    srcDeltaNext  = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
	    codeDeltaNext++;
	    delta = TclGetInt4AtPtr(codeDeltaNext);
	    codeDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(codeDeltaNext);
	    codeDeltaNext++;
	}
	codeOffset += delta;

	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
	    codeLengthNext++;
	    codeLen = TclGetInt4AtPtr(codeLengthNext);
	    codeLengthNext += 4;
	} else {
	    codeLen = TclGetInt1AtPtr(codeLengthNext);
	    codeLengthNext++;
	}
	codeEnd = (codeOffset + codeLen - 1);

	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
	    srcDeltaNext++;
	    delta = TclGetInt4AtPtr(srcDeltaNext);
	    srcDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(srcDeltaNext);
	    srcDeltaNext++;
	}
	srcOffset += delta;

	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
	    srcLengthNext++;
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}
	
	if (codeOffset > pcOffset) {      /* best cmd already found */
	    break;
	} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
	    int dist = (pcOffset - codeOffset);
	    if (dist <= bestDist) {
		bestDist = dist;
		bestSrcOffset = srcOffset;
		bestSrcLength = srcLen;
	    }
	}
    }

    if (bestDist == INT_MAX) {
	return NULL;
    }
    
    if (lengthPtr != NULL) {
	*lengthPtr = bestSrcLength;
    }
    return (codePtr->source + bestSrcOffset);
}

/*
 *----------------------------------------------------------------------
 *
 * GetExceptRangeForPc --
 *
 *	Given a program counter value, return the closest enclosing
 *	ExceptionRange.
 *
 * Results:
 *	In the normal case, catchOnly is 0 (false) and this procedure
 *	returns a pointer to the most closely enclosing ExceptionRange
 *	structure regardless of whether it is a loop or catch exception
 *	range. This is appropriate when processing a TCL_BREAK or
 *	TCL_CONTINUE, which will be "handled" either by a loop exception
 *	range or a closer catch range. If catchOnly is nonzero, this
 *	procedure ignores loop exception ranges and returns a pointer to the
 *	closest catch range. If no matching ExceptionRange is found that
 *	encloses pc, a NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static ExceptionRange *
GetExceptRangeForPc(pc, catchOnly, codePtr)
    unsigned char *pc;		/* The program counter value for which to
				 * search for a closest enclosing exception
				 * range. This points to a bytecode
				 * instruction in codePtr's code. */
    int catchOnly;		/* If 0, consider either loop or catch
				 * ExceptionRanges in search. If nonzero
				 * consider only catch ranges (and ignore
				 * any closer loop ranges). */
    ByteCode* codePtr;		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    register ExceptionRange *rangePtr;
    int pcOffset = (pc - codePtr->codeStart);
    register int i, level;

    if (numRanges == 0) {
	return NULL;
    }
    rangeArrayPtr = codePtr->exceptArrayPtr;

    for (level = codePtr->maxExceptDepth;  level >= 0;  level--) {
	for (i = 0;  i < numRanges;  i++) {
	    rangePtr = &(rangeArrayPtr[i]);
	    if (rangePtr->nestingLevel == level) {
		int start = rangePtr->codeOffset;
		int end   = (start + rangePtr->numCodeBytes);
		if ((start <= pcOffset) && (pcOffset < end)) {
		    if ((!catchOnly)
			    || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
			return rangePtr;
		    }
		}
	    }
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * GetOpcodeName --
 *
 *	This procedure is called by the TRACE and TRACE_WITH_OBJ macros
 *	used in TclExecuteByteCode when debugging. It returns the name of
 *	the bytecode instruction at a specified instruction pc.
 *
 * Results:
 *	A character string for the instruction.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_COMPILE_DEBUG
static char *
GetOpcodeName(pc)
    unsigned char *pc;		/* Points to the instruction whose name
				 * should be returned. */
{
    unsigned char opCode = *pc;
    
    return instructionTable[opCode].name;
}
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * VerifyExprObjType --
 *
 *	This procedure is called by the math functions to verify that
 *	the object is either an int or double, coercing it if necessary.
 *	If an error occurs during conversion, an error message is left
 *	in the interpreter's result unless "interp" is NULL.
 *
 * Results:
 *	TCL_OK if it was int or double, TCL_ERROR otherwise
 *
 * Side effects:
 *	objPtr is ensured to be either tclIntType of tclDoubleType.
 *
 *----------------------------------------------------------------------
 */

static int
VerifyExprObjType(interp, objPtr)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    Tcl_Obj *objPtr;		/* Points to the object to type check. */
{
    if ((objPtr->typePtr == &tclIntType) ||
	    (objPtr->typePtr == &tclDoubleType)) {
	return TCL_OK;
    } else {
	int length, result = TCL_OK;
	char *s = Tcl_GetStringFromObj(objPtr, &length);
	
	if (TclLooksLikeInt(s, length)) {
	    long i;
	    result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, objPtr, &i);
	} else {
	    double d;
	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
	}
	if ((result != TCL_OK) && (interp != NULL)) {
	    Tcl_ResetResult(interp);
	    if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
		Tcl_AppendToObj(Tcl_GetObjResult(interp),
			"argument to math function was an invalid octal number",
			-1);
	    } else {
		Tcl_AppendToObj(Tcl_GetObjResult(interp),
			"argument to math function didn't have numeric value",
			-1);
	    }
	}
	return result;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Math Functions --
 *
 *	This page contains the procedures that implement all of the
 *	built-in math functions for expressions.
 *
 * Results:
 *	Each procedure returns TCL_OK if it succeeds and pushes an
 *	Tcl object holding the result. If it fails it returns TCL_ERROR
 *	and leaves an error message in the interpreter's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExprUnaryFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Contains the address of a procedure that
				 * takes one double argument and returns a
				 * double result. */
{
    Tcl_Obj **stackPtr;		/* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    double d, dResult;
    int result;
    
    double (*func) _ANSI_ARGS_((double)) =
	(double (*)_ANSI_ARGS_((double))) clientData;

    /*
     * Set stackPtr and stackTop from eePtr.
     */

    result = TCL_OK;
    CACHE_STACK_INFO();

    /*
     * Pop the function's argument from the evaluation stack. Convert it
     * to a double if necessary.
     */

    valuePtr = POP_OBJECT();

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	result = TCL_ERROR;
	goto done;
    }
    
    if (valuePtr->typePtr == &tclIntType) {
	d = (double) valuePtr->internalRep.longValue;
    } else {
	d = valuePtr->internalRep.doubleValue;
    }

    errno = 0;
    dResult = (*func)(d);
    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
	TclExprFloatError(interp, dResult);
	result = TCL_ERROR;
	goto done;
    }
    
    /*
     * Push a Tcl object holding the result.
     */

    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
    
    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    Tcl_DecrRefCount(valuePtr);
    DECACHE_STACK_INFO();
    return result;
}

static int
ExprBinaryFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Contains the address of a procedure that
				 * takes two double arguments and
				 * returns a double result. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr, *value2Ptr;
    double d1, d2, dResult;
    int result;
    
    double (*func) _ANSI_ARGS_((double, double))
	= (double (*)_ANSI_ARGS_((double, double))) clientData;

    /*
     * Set stackPtr and stackTop from eePtr.
     */

    result = TCL_OK;
    CACHE_STACK_INFO();

    /*
     * Pop the function's two arguments from the evaluation stack. Convert
     * them to doubles if necessary.
     */

    value2Ptr = POP_OBJECT();
    valuePtr  = POP_OBJECT();

    if ((VerifyExprObjType(interp, valuePtr) != TCL_OK) ||
	    (VerifyExprObjType(interp, value2Ptr) != TCL_OK)) {
	result = TCL_ERROR;
	goto done;
    }

    if (valuePtr->typePtr == &tclIntType) {
	d1 = (double) valuePtr->internalRep.longValue;
    } else {
	d1 = valuePtr->internalRep.doubleValue;
    }

    if (value2Ptr->typePtr == &tclIntType) {
	d2 = (double) value2Ptr->internalRep.longValue;
    } else {
	d2 = value2Ptr->internalRep.doubleValue;
    }

    errno = 0;
    dResult = (*func)(d1, d2);
    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
	TclExprFloatError(interp, dResult);
	result = TCL_ERROR;
	goto done;
    }

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

    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
    
    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    Tcl_DecrRefCount(valuePtr);
    Tcl_DecrRefCount(value2Ptr);
    DECACHE_STACK_INFO();
    return result;
}

static int
ExprAbsFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Ignored. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    long i, iResult;
    double d, dResult;
    int result;

    /*
     * Set stackPtr and stackTop from eePtr.
     */

    result = TCL_OK;
    CACHE_STACK_INFO();

    /*
     * Pop the argument from the evaluation stack.
     */

    valuePtr = POP_OBJECT();

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	result = TCL_ERROR;
	goto done;
    }

    /*
     * Push a Tcl object with the result.
     */
    if (valuePtr->typePtr == &tclIntType) {
	i = valuePtr->internalRep.longValue;
	if (i < 0) {
	    iResult = -i;
	    if (iResult < 0) {
		Tcl_ResetResult(interp);
		Tcl_AppendToObj(Tcl_GetObjResult(interp),
		        "integer value too large to represent", -1);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			"integer value too large to represent", (char *) NULL);
		result = TCL_ERROR;
		goto done;
	    }
	} else {
	    iResult = i;
	}	    
	PUSH_OBJECT(Tcl_NewLongObj(iResult));
    } else {
	d = valuePtr->internalRep.doubleValue;
	if (d < 0.0) {
	    dResult = -d;
	} else {
	    dResult = d;
	}
	if (IS_NAN(dResult) || IS_INF(dResult)) {
	    TclExprFloatError(interp, dResult);
	    result = TCL_ERROR;
	    goto done;
	}
	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
    }

    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    Tcl_DecrRefCount(valuePtr);
    DECACHE_STACK_INFO();
    return result;
}

static int
ExprDoubleFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Ignored. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    double dResult;
    int result;

    /*
     * Set stackPtr and stackTop from eePtr.
     */

    result = TCL_OK;
    CACHE_STACK_INFO();

    /*
     * Pop the argument from the evaluation stack.
     */

    valuePtr = POP_OBJECT();

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	result = TCL_ERROR;
	goto done;
    }

    if (valuePtr->typePtr == &tclIntType) {
	dResult = (double) valuePtr->internalRep.longValue;
    } else {
	dResult = valuePtr->internalRep.doubleValue;
    }

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

    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));

    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    Tcl_DecrRefCount(valuePtr);
    DECACHE_STACK_INFO();
    return result;
}

static int
ExprIntFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Ignored. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    long iResult;
    double d;
    int result;

    /*
     * Set stackPtr and stackTop from eePtr.
     */

    result = TCL_OK;
    CACHE_STACK_INFO();

    /*
     * Pop the argument from the evaluation stack.
     */

    valuePtr = POP_OBJECT();
    
    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	result = TCL_ERROR;
	goto done;
    }
    
    if (valuePtr->typePtr == &tclIntType) {
	iResult = valuePtr->internalRep.longValue;
    } else {
	d = valuePtr->internalRep.doubleValue;
	if (d < 0.0) {
	    if (d < (double) (long) LONG_MIN) {
		tooLarge:
		Tcl_ResetResult(interp);
		Tcl_AppendToObj(Tcl_GetObjResult(interp),
		        "integer value too large to represent", -1);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			"integer value too large to represent", (char *) NULL);
		result = TCL_ERROR;
		goto done;
	    }
	} else {
	    if (d > (double) LONG_MAX) {
		goto tooLarge;
	    }
	}
	if (IS_NAN(d) || IS_INF(d)) {
	    TclExprFloatError(interp, d);
	    result = TCL_ERROR;
	    goto done;
	}
	iResult = (long) d;
    }

    /*
     * Push a Tcl object with the result.
     */
    
    PUSH_OBJECT(Tcl_NewLongObj(iResult));

    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    Tcl_DecrRefCount(valuePtr);
    DECACHE_STACK_INFO();
    return result;
}

static int
ExprRandFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Ignored. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    Interp *iPtr = (Interp *) interp;
    double dResult;
    int tmp;

    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
	iPtr->flags |= RAND_SEED_INITIALIZED;
	iPtr->randSeed = TclpGetClicks();
    }
    
    /*
     * Set stackPtr and stackTop from eePtr.
     */
    
    CACHE_STACK_INFO();

    /*
     * Generate the random number using the linear congruential
     * generator defined by the following recurrence:
     *		seed = ( IA * seed ) mod IM
     * where IA is 16807 and IM is (2^31) - 1.  In order to avoid
     * potential problems with integer overflow, the  code uses
     * additional constants IQ and IR such that
     *		IM = IA*IQ + IR
     * For details on how this algorithm works, refer to the following
     * papers: 
     *
     *	S.K. Park & K.W. Miller, "Random number generators: good ones
     *	are hard to find," Comm ACM 31(10):1192-1201, Oct 1988
     *
     *	W.H. Press & S.A. Teukolsky, "Portable random number
     *	generators," Computers in Physics 6(5):522-524, Sep/Oct 1992.
     */

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

    if (iPtr->randSeed == 0) {
	/*
	 * Don't allow a 0 seed, since it breaks the generator.  Shift
	 * it to some other value.
	 */

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

    /*
     * On 64-bit architectures we need to mask off the upper bits to
     * ensure we only have a 32-bit range.  The constant has the
     * bizarre form below in order to make sure that it doesn't
     * get sign-extended (the rules for sign extension are very
     * concat, particularly on 64-bit machines).
     */

    iPtr->randSeed &= ((((unsigned long) 0xfffffff) << 4) | 0xf);
    dResult = iPtr->randSeed * (1.0/RAND_IM);

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

    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
    
    /*
     * Reflect the change to stackTop back in eePtr.
     */

    DECACHE_STACK_INFO();
    return TCL_OK;
}

static int
ExprRoundFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Ignored. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    Tcl_Obj *valuePtr;
    long iResult;
    double d, temp;
    int result;

    /*
     * Set stackPtr and stackTop from eePtr.
     */

    result = TCL_OK;
    CACHE_STACK_INFO();

    /*
     * Pop the argument from the evaluation stack.
     */

    valuePtr = POP_OBJECT();

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	result = TCL_ERROR;
	goto done;
    }
    
    if (valuePtr->typePtr == &tclIntType) {
	iResult = valuePtr->internalRep.longValue;
    } else {
	d = valuePtr->internalRep.doubleValue;
	if (d < 0.0) {
	    if (d <= (((double) (long) LONG_MIN) - 0.5)) {
		tooLarge:
		Tcl_ResetResult(interp);
		Tcl_AppendToObj(Tcl_GetObjResult(interp),
		        "integer value too large to represent", -1);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			"integer value too large to represent",
			(char *) NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    temp = (long) (d - 0.5);
	} else {
	    if (d >= (((double) LONG_MAX + 0.5))) {
		goto tooLarge;
	    }
	    temp = (long) (d + 0.5);
	}
	if (IS_NAN(temp) || IS_INF(temp)) {
	    TclExprFloatError(interp, temp);
	    result = TCL_ERROR;
	    goto done;
	}
	iResult = (long) temp;
    }

    /*
     * Push a Tcl object with the result.
     */
    
    PUSH_OBJECT(Tcl_NewLongObj(iResult));

    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    Tcl_DecrRefCount(valuePtr);
    DECACHE_STACK_INFO();
    return result;
}

static int
ExprSrandFunc(interp, eePtr, clientData)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    ClientData clientData;	/* Ignored. */
{
    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *valuePtr;
    long i = 0;			/* Initialized to avoid compiler warning. */
    int result;

    /*
     * Set stackPtr and stackTop from eePtr.
     */
    
    CACHE_STACK_INFO();

    /*
     * Pop the argument from the evaluation stack.  Use the value
     * to reset the random number seed.
     */

    valuePtr = POP_OBJECT();

    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	result = TCL_ERROR;
	goto badValue;
    }

    if (valuePtr->typePtr == &tclIntType) {
	i = valuePtr->internalRep.longValue;
    } else {
	/*
	 * At this point, the only other possible type is double
	 */
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"can't use floating-point value as argument to srand",
		(char *) NULL);
	badValue:
	Tcl_DecrRefCount(valuePtr);
	DECACHE_STACK_INFO();
	return TCL_ERROR;
    }
    
    /*
     * Reset the seed.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = i;

    /*
     * To avoid duplicating the random number generation code we simply
     * clean up our state and call the real random number function. That
     * function will always succeed.
     */
    
    Tcl_DecrRefCount(valuePtr);
    DECACHE_STACK_INFO();

    ExprRandFunc(interp, eePtr, clientData);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ExprCallMathFunc --
 *
 *	This procedure is invoked to call a non-builtin math function
 *	during the execution of an expression. 
 *
 * Results:
 *	TCL_OK is returned if all went well and the function's value
 *	was computed successfully. If an error occurred, TCL_ERROR
 *	is returned and an error message is left in the interpreter's
 *	result.	After a successful return this procedure pushes a Tcl object
 *	holding the result. 
 *
 * Side effects:
 *	None, unless the called math function has side effects.
 *
 *----------------------------------------------------------------------
 */

static int
ExprCallMathFunc(interp, eePtr, objc, objv)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    ExecEnv *eePtr;		/* Points to the environment for executing
				 * the function. */
    int objc;			/* Number of arguments. The function name is
				 * the 0-th argument. */
    Tcl_Obj **objv;		/* The array of arguments. The function name
				 * is objv[0]. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **stackPtr;		/* Cached evaluation stack base pointer. */
    register int stackTop;	/* Cached top index of evaluation stack. */
    char *funcName;
    Tcl_HashEntry *hPtr;
    MathFunc *mathFuncPtr;	/* Information about math function. */
    Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
    Tcl_Value funcResult;	/* Result of function call as Tcl_Value. */
    register Tcl_Obj *valuePtr;
    long i;
    double d;
    int j, k, result;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_ResetResult(interp);

    /*
     * Set stackPtr and stackTop from eePtr.
     */
    
    CACHE_STACK_INFO();

    /*
     * Look up the MathFunc record for the function.
     */

    funcName = Tcl_GetString(objv[0]);
    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
    if (hPtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"unknown math function \"", funcName, "\"", (char *) NULL);
	result = TCL_ERROR;
	goto done;
    }
    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
    if (mathFuncPtr->numArgs != (objc-1)) {
	panic("ExprCallMathFunc: expected number of args %d != actual number %d",
	        mathFuncPtr->numArgs, objc);
	result = TCL_ERROR;
	goto done;
    }

    /*
     * Collect the arguments for the function, if there are any, into the
     * array "args". Note that args[0] will have the Tcl_Value that
     * corresponds to objv[1].
     */

    for (j = 1, k = 0;  j < objc;  j++, k++) {
	valuePtr = objv[j];

	if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}

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

	if (valuePtr->typePtr == &tclIntType) {
	    i = valuePtr->internalRep.longValue;
	    if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
		args[k].type = TCL_DOUBLE;
		args[k].doubleValue = i;
	    } else {
		args[k].type = TCL_INT;
		args[k].intValue = i;
	    }
	} else {
	    d = valuePtr->internalRep.doubleValue;
	    if (mathFuncPtr->argTypes[k] == TCL_INT) {
		args[k].type = TCL_INT;
		args[k].intValue = (long) d;
	    } else {
		args[k].type = TCL_DOUBLE;
		args[k].doubleValue = d;
	    }
	}
    }

    /*
     * Invoke the function and copy its result back into valuePtr.
     */

    tsdPtr->mathInProgress++;
    result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
	    &funcResult);
    tsdPtr->mathInProgress--;
    if (result != TCL_OK) {
	goto done;
    }

    /*
     * Pop the objc top stack elements and decrement their ref counts.
     */
		
    i = (stackTop - (objc-1));
    while (i <= stackTop) {
	valuePtr = stackPtr[i];
	Tcl_DecrRefCount(valuePtr);
	i++;
    }
    stackTop -= objc;
    
    /*
     * Push the call's object result.
     */
    
    if (funcResult.type == TCL_INT) {
	PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
    } else {
	d = funcResult.doubleValue;
	if (IS_NAN(d) || IS_INF(d)) {
	    TclExprFloatError(interp, d);
	    result = TCL_ERROR;
	    goto done;
	}
	PUSH_OBJECT(Tcl_NewDoubleObj(d));
    }

    /*
     * Reflect the change to stackTop back in eePtr.
     */

    done:
    DECACHE_STACK_INFO();
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclExprFloatError --
 *
 *	This procedure is called when an error occurs during a
 *	floating-point operation. It reads errno and sets
 *	interp->objResultPtr accordingly.
 *
 * Results:
 *	interp->objResultPtr is set to hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclExprFloatError(interp, value)
    Tcl_Interp *interp;		/* Where to store error message. */
    double value;		/* Value returned after error;  used to
				 * distinguish underflows from overflows. */
{
    char *s;

    Tcl_ResetResult(interp);
    if ((errno == EDOM) || (value != value)) {
	s = "domain error: argument not in valid range";
	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
    } else if ((errno == ERANGE) || IS_INF(value)) {
	if (value == 0.0) {
	    s = "floating-point value too small to represent";
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
	} else {
	    s = "floating-point value too large to represent";
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
	}
    } else {
	char msg[64 + TCL_INTEGER_SPACE];
	
	sprintf(msg, "unknown floating-point error, errno = %d", errno);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclMathInProgress --
 *
 *	This procedure is called to find out if Tcl is doing math
 *	in this thread.
 *
 * Results:
 *	0 or 1.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMathInProgress()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->mathInProgress;
}

#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
 *
 * TclLog2 --
 *
 *	Procedure used while collecting compilation statistics to determine
 *	the log base 2 of an integer.
 *
 * Results:
 *	Returns the log base 2 of the operand. If the argument is less
 *	than or equal to zero, a zero is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclLog2(value)
    register int value;		/* The integer for which to compute the
				 * log base 2. */
{
    register int n = value;
    register int result = 0;

    while (n > 1) {
	n = n >> 1;
	result++;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * EvalStatsCmd --
 *
 *	Implements the "evalstats" command that prints instruction execution
 *	counts to stdout.
 *
 * Results:
 *	Standard Tcl results.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EvalStatsCmd(unused, interp, argc, argv)
    ClientData unused;		/* Unused. */
    Tcl_Interp *interp;		/* The current interpreter. */
    int argc;			/* The number of arguments. */
    char **argv;		/* The argument strings. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &(iPtr->literalTable);
    ByteCodeStats *statsPtr = &(iPtr->stats);
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    long numCurrentByteCodes, numByteCodeLits;
    long refCountSum, literalMgmtBytes, sum;
    int numSharedMultX, numSharedOnce;
    int decadeHigh, minSizeDecade, maxSizeDecade, length, i;
    char *litTableStats;
    LiteralEntry *entryPtr;

    numInstructions = 0.0;
    for (i = 0;  i < 256;  i++) {
        if (statsPtr->instructionCount[i] != 0) {
            numInstructions += statsPtr->instructionCount[i];
        }
    }

    totalLiteralBytes = sizeof(LiteralTable)
	    + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)
	    + (statsPtr->numLiteralsCreated * sizeof(LiteralEntry))
	    + (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj))
	    + statsPtr->totalLitStringBytes;
    totalCodeBytes = statsPtr->totalByteCodeBytes + totalLiteralBytes;

    numCurrentByteCodes =
	    statsPtr->numCompilations - statsPtr->numByteCodesFreed;
    currentHeaderBytes = numCurrentByteCodes
	    * (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time)));
    literalMgmtBytes = sizeof(LiteralTable)
	    + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
	    + (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
    currentLiteralBytes = literalMgmtBytes
	    + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
	    + statsPtr->currentLitStringBytes;
    currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
    
    /*
     * Summary statistics, total and current source and ByteCode sizes.
     */

    fprintf(stdout, "\n----------------------------------------------------------------\n");
    fprintf(stdout,
	    "Compilation and execution statistics for interpreter 0x%x\n",
	    (unsigned int) iPtr);

    fprintf(stdout, "\nNumber ByteCodes executed	%ld\n",
	    statsPtr->numExecutions);
    fprintf(stdout, "Number ByteCodes compiled	%ld\n",
	    statsPtr->numCompilations);
    fprintf(stdout, "  Mean executions/compile	%.1f\n",
	    ((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
    
    fprintf(stdout, "\nInstructions executed		%.0f\n",
	    numInstructions);
    fprintf(stdout, "  Mean inst/compile		%.0f\n",
	    numInstructions / statsPtr->numCompilations);
    fprintf(stdout, "  Mean inst/execution		%.0f\n",
	    numInstructions / statsPtr->numExecutions);

    fprintf(stdout, "\nTotal ByteCodes			%ld\n",
	    statsPtr->numCompilations);
    fprintf(stdout, "  Source bytes			%.6g\n",
	    statsPtr->totalSrcBytes);
    fprintf(stdout, "  Code bytes			%.6g\n",
	    totalCodeBytes);
    fprintf(stdout, "    ByteCode bytes		%.6g\n",
	    statsPtr->totalByteCodeBytes);
    fprintf(stdout, "    Literal bytes		%.6g\n",
	    totalLiteralBytes);
    fprintf(stdout, "      table %d + bkts %d + entries %ld + objects %ld + strings %.6g\n",
	    sizeof(LiteralTable),
	    iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
	    statsPtr->numLiteralsCreated * sizeof(LiteralEntry),
	    statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
	    statsPtr->totalLitStringBytes);
    fprintf(stdout, "  Mean code/compile		%.1f\n",
	    totalCodeBytes / statsPtr->numCompilations);
    fprintf(stdout, "  Mean code/source		%.1f\n",
	    totalCodeBytes / statsPtr->totalSrcBytes);

    fprintf(stdout, "\nCurrent (active) ByteCodes	%ld\n",
	    numCurrentByteCodes);
    fprintf(stdout, "  Source bytes			%.6g\n",
	    statsPtr->currentSrcBytes);
    fprintf(stdout, "  Code bytes			%.6g\n",
	    currentCodeBytes);
    fprintf(stdout, "    ByteCode bytes		%.6g\n",
	    statsPtr->currentByteCodeBytes);
    fprintf(stdout, "    Literal bytes		%.6g\n",
	    currentLiteralBytes);
    fprintf(stdout, "      table %d + bkts %d + entries %d + objects %d + strings %.6g\n",
	    sizeof(LiteralTable),
	    iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
	    iPtr->literalTable.numEntries * sizeof(LiteralEntry),
	    iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
	    statsPtr->currentLitStringBytes);
    fprintf(stdout, "  Mean code/source		%.1f\n",
	    currentCodeBytes / statsPtr->currentSrcBytes);
    fprintf(stdout, "  Code + source bytes		%.6g (%0.1f mean code/src)\n",
	    (currentCodeBytes + statsPtr->currentSrcBytes),
	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);

    /*
     * Tcl_IsShared statistics check
     *
     * This gives the refcount of each obj as Tcl_IsShared was called
     * for it.  Shared objects must be duplicated before they can be
     * modified.
     */

    numSharedMultX = 0;
    fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
    fprintf(stdout, "  Object had refcount <=1 (not shared)	%ld\n",
	    tclObjsShared[1]);
    for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
	fprintf(stdout, "  refcount ==%d		%ld\n",
		i, tclObjsShared[i]);
	numSharedMultX += tclObjsShared[i];
    }
    fprintf(stdout, "  refcount >=%d		%ld\n",
	    i, tclObjsShared[0]);
    numSharedMultX += tclObjsShared[0];
    fprintf(stdout, "  Total shared objects			%d\n",
	    numSharedMultX);

    /*
     * Literal table statistics.
     */

    numByteCodeLits = 0;
    refCountSum = 0;
    numSharedMultX = 0;
    numSharedOnce  = 0;
    objBytesIfUnshared  = 0.0;
    strBytesIfUnshared  = 0.0;
    strBytesSharedMultX = 0.0;
    strBytesSharedOnce  = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
	        entryPtr = entryPtr->nextPtr) {
	    if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
		numByteCodeLits++;
	    }
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
	    if (entryPtr->refCount > 1) {
		numSharedMultX++;
		strBytesSharedMultX += (length+1);
	    } else {
		numSharedOnce++;
		strBytesSharedOnce += (length+1);
	    }
	}
    }
    sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
	    - currentLiteralBytes;

    fprintf(stdout, "\nTotal objects (all interps)	%ld\n",
	    tclObjsAlloced);
    fprintf(stdout, "Current objects			%ld\n",
	    (tclObjsAlloced - tclObjsFreed));
    fprintf(stdout, "Total literal objects		%ld\n",
	    statsPtr->numLiteralsCreated);

    fprintf(stdout, "\nCurrent literal objects		%d (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
    fprintf(stdout, "  ByteCode literals	 	%ld (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    (numByteCodeLits * 100.0) / globalTablePtr->numEntries);
    fprintf(stdout, "  Literals reused > 1x	 	%d\n",
	    numSharedMultX);
    fprintf(stdout, "  Mean reference count	 	%.2f\n",
	    ((double) refCountSum) / globalTablePtr->numEntries);
    fprintf(stdout, "  Mean len, str reused >1x 	%.2f\n",
	    (numSharedMultX? (strBytesSharedMultX/numSharedMultX) : 0.0));
    fprintf(stdout, "  Mean len, str used 1x	 	%.2f\n",
	    (numSharedOnce? (strBytesSharedOnce/numSharedOnce) : 0.0));
    fprintf(stdout, "  Total sharing savings	 	%.6g (%0.1f%% of bytes if no sharing)\n",
	    sharingBytesSaved,
	    (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared));
    fprintf(stdout, "    Bytes with sharing		%.6g\n",
	    currentLiteralBytes);
    fprintf(stdout, "      table %d + bkts %d + entries %d + objects %d + strings %.6g\n",
	    sizeof(LiteralTable),
	    iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
	    iPtr->literalTable.numEntries * sizeof(LiteralEntry),
	    iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
	    statsPtr->currentLitStringBytes);
    fprintf(stdout, "    Bytes if no sharing		%.6g = objects %.6g + strings %.6g\n",
	    (objBytesIfUnshared + strBytesIfUnshared),
	    objBytesIfUnshared, strBytesIfUnshared);
    fprintf(stdout, "  String sharing savings 	%.6g = unshared %.6g - shared %.6g\n",
	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
    fprintf(stdout, "  Literal mgmt overhead	 	%ld (%0.1f%% of bytes with sharing)\n",
	    literalMgmtBytes,
	    (literalMgmtBytes * 100.0) / currentLiteralBytes);
    fprintf(stdout, "    table %d + buckets %d + entries %d\n",
	    sizeof(LiteralTable),
	    iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
	    iPtr->literalTable.numEntries * sizeof(LiteralEntry));

    /*
     * Breakdown of current ByteCode space requirements.
     */
    
    fprintf(stdout, "\nBreakdown of current ByteCode requirements:\n");
    fprintf(stdout, "                         Bytes      Pct of    Avg per\n");
    fprintf(stdout, "                                     total    ByteCode\n");
    fprintf(stdout, "Total             %12.6g     100.00%%   %8.1f\n",
	    statsPtr->currentByteCodeBytes,
	    statsPtr->currentByteCodeBytes / numCurrentByteCodes);
    fprintf(stdout, "Header            %12.6g   %8.1f%%   %8.1f\n",
	    currentHeaderBytes,
	    ((currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes),
	    currentHeaderBytes / numCurrentByteCodes);
    fprintf(stdout, "Instructions      %12.6g   %8.1f%%   %8.1f\n",
	    statsPtr->currentInstBytes,
	    ((statsPtr->currentInstBytes * 100.0) / statsPtr->currentByteCodeBytes),
	    statsPtr->currentInstBytes / numCurrentByteCodes);
    fprintf(stdout, "Literal ptr array %12.6g   %8.1f%%   %8.1f\n",
	    statsPtr->currentLitBytes,
	    ((statsPtr->currentLitBytes * 100.0) / statsPtr->currentByteCodeBytes),
	    statsPtr->currentLitBytes / numCurrentByteCodes);
    fprintf(stdout, "Exception table   %12.6g   %8.1f%%   %8.1f\n",
	    statsPtr->currentExceptBytes,
	    ((statsPtr->currentExceptBytes * 100.0) / statsPtr->currentByteCodeBytes),
	    statsPtr->currentExceptBytes / numCurrentByteCodes);
    fprintf(stdout, "Auxiliary data    %12.6g   %8.1f%%   %8.1f\n",
	    statsPtr->currentAuxBytes,
	    ((statsPtr->currentAuxBytes * 100.0) / statsPtr->currentByteCodeBytes),
	    statsPtr->currentAuxBytes / numCurrentByteCodes);
    fprintf(stdout, "Command map       %12.6g   %8.1f%%   %8.1f\n",
	    statsPtr->currentCmdMapBytes,
	    ((statsPtr->currentCmdMapBytes * 100.0) / statsPtr->currentByteCodeBytes),
	    statsPtr->currentCmdMapBytes / numCurrentByteCodes);

    /*
     * Detailed literal statistics.
     */
    
    fprintf(stdout, "\nLiteral string sizes:\n");
    fprintf(stdout, "	 Up to length		Percentage\n");
    maxSizeDecade = 0;
    for (i = 31;  i >= 0;  i--) {
        if (statsPtr->literalCount[i] > 0) {
            maxSizeDecade = i;
	    break;
        }
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
        fprintf(stdout,	"	%10d		%8.0f%%\n",
		decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated);
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
            litTableStats);
    ckfree((char *) litTableStats);

    /*
     * Source and ByteCode size distributions.
     */

    fprintf(stdout, "\nSource sizes:\n");
    fprintf(stdout, "	 Up to size		Percentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
        if (statsPtr->srcCount[i] > 0) {
	    minSizeDecade = i;
	    break;
        }
    }
    for (i = 31;  i >= 0;  i--) {
        if (statsPtr->srcCount[i] > 0) {
            maxSizeDecade = i;
	    break;
        }
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->srcCount[i];
        fprintf(stdout,	"	%10d		%8.0f%%\n",
		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
    }

    fprintf(stdout, "\nByteCode sizes:\n");
    fprintf(stdout, "	 Up to size		Percentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
        if (statsPtr->byteCodeCount[i] > 0) {
	    minSizeDecade = i;
	    break;
        }
    }
    for (i = 31;  i >= 0;  i--) {
        if (statsPtr->byteCodeCount[i] > 0) {
            maxSizeDecade = i;
	    break;
        }
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->byteCodeCount[i];
        fprintf(stdout,	"	%10d		%8.0f%%\n",
		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
    }

    fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
    fprintf(stdout, "	       Up to ms		Percentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
        if (statsPtr->lifetimeCount[i] > 0) {
	    minSizeDecade = i;
	    break;
        }
    }
    for (i = 31;  i >= 0;  i--) {
        if (statsPtr->lifetimeCount[i] > 0) {
            maxSizeDecade = i;
	    break;
        }
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->lifetimeCount[i];
        fprintf(stdout,	"	%12.3f		%8.0f%%\n",
		decadeHigh / 1000.0,
		(sum * 100.0) / statsPtr->numByteCodesFreed);
    }

    /*
     * Instruction counts.
     */

    fprintf(stdout, "\nInstruction counts:\n");
    for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
        if (statsPtr->instructionCount[i]) {
            fprintf(stdout, "%20s %8ld %6.1f%%\n",
		    instructionTable[i].name,
		    statsPtr->instructionCount[i],
		    (statsPtr->instructionCount[i]*100.0) / numInstructions);
        }
    }

    fprintf(stdout, "\nInstructions NEVER executed:\n");
    for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
        if (statsPtr->instructionCount[i] == 0) {
            fprintf(stdout, "%20s\n",
		    instructionTable[i].name);
        }
    }

#ifdef TCL_MEM_DEBUG
    fprintf(stdout, "\nHeap Statistics:\n");
    TclDumpMemoryInfo(stdout);
#endif
    fprintf(stdout, "\n----------------------------------------------------------------\n");
    return TCL_OK;
}
#endif /* TCL_COMPILE_STATS */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFromObj --
 *
 *      Returns the command specified by the name in a Tcl_Obj.
 *
 * Results:
 *	Returns a token for the command if it is found. Otherwise, if it
 *	can't be found or there is an error, returns NULL.
 *
 * Side effects:
 *      May update the internal representation for the object, caching
 *      the command reference so that the next time this procedure is
 *	called with the same object, the command can be found quickly.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_GetCommandFromObj(interp, objPtr)
    Tcl_Interp *interp;		/* The interpreter in which to resolve the
				 * command and to report errors. */
    register Tcl_Obj *objPtr;	/* The object containing the command's
				 * name. If the name starts with "::", will
				 * be looked up in global namespace. Else,
				 * looked up first in the current namespace
				 * if contextNsPtr is NULL, then in global
				 * namespace. */
{
    Interp *iPtr = (Interp *) interp;
    register ResolvedCmdName *resPtr;
    register Command *cmdPtr;
    Namespace *currNsPtr;
    int result;

    /*
     * Get the internal representation, converting to a command type if
     * needed. The internal representation is a ResolvedCmdName that points
     * to the actual command.
     */
    
    if (objPtr->typePtr != &tclCmdNameType) {
        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
        if (result != TCL_OK) {
            return (Tcl_Command) NULL;
        }
    }
    resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;

    /*
     * Get the current namespace.
     */
    
    if (iPtr->varFramePtr != NULL) {
	currNsPtr = iPtr->varFramePtr->nsPtr;
    } else {
	currNsPtr = iPtr->globalNsPtr;
    }

    /*
     * Check the context namespace and the namespace epoch of the resolved
     * symbol to make sure that it is fresh. If not, then force another
     * conversion to the command type, to discard the old rep and create a
     * new one. Note that we verify that the namespace id of the context
     * namespace is the same as the one we cached; this insures that the
     * namespace wasn't deleted and a new one created at the same address
     * with the same command epoch.
     */
    
    cmdPtr = NULL;
    if ((resPtr != NULL)
	    && (resPtr->refNsPtr == currNsPtr)
	    && (resPtr->refNsId == currNsPtr->nsId)
	    && (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
        cmdPtr = resPtr->cmdPtr;
        if (cmdPtr->cmdEpoch != resPtr->cmdEpoch) {
            cmdPtr = NULL;
        }
    }

    if (cmdPtr == NULL) {
        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
        if (result != TCL_OK) {
            return (Tcl_Command) NULL;
        }
        resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
        if (resPtr != NULL) {
            cmdPtr = resPtr->cmdPtr;
        }
    }
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetCmdNameObj --
 *
 *	Modify an object to be an CmdName object that refers to the argument
 *	Command structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old internal rep is freed. It's string rep is not
 *	changed. The refcount in the Command structure is incremented to
 *	keep it from being freed if the command is later deleted until
 *	TclExecuteByteCode has a chance to recognize that it was deleted.
 *
 *----------------------------------------------------------------------
 */

void
TclSetCmdNameObj(interp, objPtr, cmdPtr)
    Tcl_Interp *interp;		/* Points to interpreter containing command
				 * that should be cached in objPtr. */
    register Tcl_Obj *objPtr;	/* Points to Tcl object to be changed to
				 * a CmdName object. */
    Command *cmdPtr;		/* Points to Command structure that the
				 * CmdName object should refer to. */
{
    Interp *iPtr = (Interp *) interp;
    register ResolvedCmdName *resPtr;
    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
    register Namespace *currNsPtr;

    if (oldTypePtr == &tclCmdNameType) {
	return;
    }
    
    /*
     * Get the current namespace.
     */
    
    if (iPtr->varFramePtr != NULL) {
	currNsPtr = iPtr->varFramePtr->nsPtr;
    } else {
	currNsPtr = iPtr->globalNsPtr;
    }
    
    cmdPtr->refCount++;
    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
    resPtr->cmdPtr = cmdPtr;
    resPtr->refNsPtr = currNsPtr;
    resPtr->refNsId  = currNsPtr->nsId;
    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
    resPtr->cmdEpoch = cmdPtr->cmdEpoch;
    resPtr->refCount = 1;
    
    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
	oldTypePtr->freeIntRepProc(objPtr);
    }
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    objPtr->typePtr = &tclCmdNameType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeCmdNameInternalRep --
 *
 *	Frees the resources associated with a cmdName object's internal
 *	representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Decrements the ref count of any cached ResolvedCmdName structure
 *	pointed to by the cmdName's internal representation. If this is 
 *	the last use of the ResolvedCmdName, it is freed. This in turn
 *	decrements the ref count of the Command structure pointed to by 
 *	the ResolvedSymbol, which may free the Command structure.
 *
 *----------------------------------------------------------------------
 */

static void
FreeCmdNameInternalRep(objPtr)
    register Tcl_Obj *objPtr;	/* CmdName object with internal
				 * representation to free. */
{
    register ResolvedCmdName *resPtr =
	(ResolvedCmdName *) objPtr->internalRep.otherValuePtr;

    if (resPtr != NULL) {
	/*
	 * Decrement the reference count of the ResolvedCmdName structure.
	 * If there are no more uses, free the ResolvedCmdName structure.
	 */
    
        resPtr->refCount--;
        if (resPtr->refCount == 0) {
            /*
	     * Now free the cached command, unless it is still in its
             * hash table or if there are other references to it
             * from other cmdName objects.
	     */
	    
            Command *cmdPtr = resPtr->cmdPtr;
            TclCleanupCommand(cmdPtr);
            ckfree((char *) resPtr);
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupCmdNameInternalRep --
 *
 *	Initialize the internal representation of an cmdName Tcl_Obj to a
 *	copy of the internal representation of an existing cmdName object. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	"copyPtr"s internal rep is set to point to the ResolvedCmdName
 *	structure corresponding to "srcPtr"s internal rep. Increments the
 *	ref count of the ResolvedCmdName structure pointed to by the
 *	cmdName's internal representation.
 *
 *----------------------------------------------------------------------
 */

static void
DupCmdNameInternalRep(srcPtr, copyPtr)
    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
{
    register ResolvedCmdName *resPtr =
        (ResolvedCmdName *) srcPtr->internalRep.otherValuePtr;

    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    if (resPtr != NULL) {
        resPtr->refCount++;
    }
    copyPtr->typePtr = &tclCmdNameType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetCmdNameFromAny --
 *
 *	Generate an cmdName internal form for the Tcl object "objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. The conversion always
 *	succeeds and TCL_OK is returned.
 *
 * Side effects:
 *	A pointer to a ResolvedCmdName structure that holds a cached pointer
 *	to the command with a name that matches objPtr's string rep is
 *	stored as objPtr's internal representation. This ResolvedCmdName
 *	pointer will be NULL if no matching command was found. The ref count
 *	of the cached Command's structure (if any) is also incremented.
 *
 *----------------------------------------------------------------------
 */

static int
SetCmdNameFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr;	/* The object to convert. */
{
    Interp *iPtr = (Interp *) interp;
    char *name;
    Tcl_Command cmd;
    register Command *cmdPtr;
    Namespace *currNsPtr;
    register ResolvedCmdName *resPtr;

    /*
     * Get "objPtr"s string representation. Make it up-to-date if necessary.
     */

    name = objPtr->bytes;
    if (name == NULL) {
	name = Tcl_GetString(objPtr);
    }

    /*
     * Find the Command structure, if any, that describes the command called
     * "name". Build a ResolvedCmdName that holds a cached pointer to this
     * Command, and bump the reference count in the referenced Command
     * structure. A Command structure will not be deleted as long as it is
     * referenced from a CmdName object.
     */

    cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
	    /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr != NULL) {
	/*
	 * Get the current namespace.
	 */
	
	if (iPtr->varFramePtr != NULL) {
	    currNsPtr = iPtr->varFramePtr->nsPtr;
	} else {
	    currNsPtr = iPtr->globalNsPtr;
	}
	
	cmdPtr->refCount++;
        resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
        resPtr->cmdPtr        = cmdPtr;
        resPtr->refNsPtr      = currNsPtr;
        resPtr->refNsId       = currNsPtr->nsId;
        resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
        resPtr->cmdEpoch      = cmdPtr->cmdEpoch;
        resPtr->refCount      = 1;
    } else {
	resPtr = NULL;	/* no command named "name" was found */
    }

    /*
     * Free the old internalRep before setting the new one. We do this as
     * late as possible to allow the conversion code, in particular
     * GetStringFromObj, to use that old internalRep. If no Command
     * structure was found, leave NULL as the cached value.
     */

    if ((objPtr->typePtr != NULL)
	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
	objPtr->typePtr->freeIntRepProc(objPtr);
    }
    
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    objPtr->typePtr = &tclCmdNameType;
    return TCL_OK;
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * StringForResultCode --
 *
 *	Procedure that returns a human-readable string representing a
 *	Tcl result code such as TCL_ERROR. 
 *
 * Results:
 *	If the result code is one of the standard Tcl return codes, the
 *	result is a string representing that code such as "TCL_ERROR".
 *	Otherwise, the result string is that code formatted as a
 *	sequence of decimal digit characters. Note that the resulting
 *	string must not be modified by the caller.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
StringForResultCode(result)
    int result;			/* The Tcl result code for which to
				 * generate a string. */
{
    static char buf[TCL_INTEGER_SPACE];
    
    if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
	return resultStrings[result];
    }
    TclFormatInt(buf, result);
    return buf;
}
#endif /* TCL_COMPILE_DEBUG */